fix handling of date custom fields
[bse.git] / site / cgi-bin / modules / BSE / Edit / Article.pm
CommitLineData
ca9aa2bf
TC
1package BSE::Edit::Article;
2use strict;
ca9aa2bf 3use base qw(BSE::Edit::Base);
f738f7b4 4use BSE::Util::Tags qw(tag_error_img tag_article tag_object);
41f10371 5use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
9168c88c 6use BSE::Permissions;
3f9c8a96 7use BSE::Util::HTML qw(:default popup_menu);
d09682dd 8use BSE::Arrows;
771ab646 9use BSE::CfgInfo qw(custom_class admin_base_url cfg_image_dir cfg_dist_image_uri cfg_image_uri);
ab2cd916 10use BSE::Util::Iterate;
f2bf0d11 11use BSE::Template;
e63c3728 12use BSE::Util::ContentType qw(content_type);
2990391c 13use BSE::Regen 'generate_article';
8f88bb20 14use DevHelp::Date qw(dh_parse_date dh_parse_sql_date);
dbfbfb12 15use List::Util qw(first);
4b69925d 16use constant MAX_FILE_DISPLAYNAME_LENGTH => 255;
59fca225 17use constant ARTICLE_CUSTOM_FIELDS_CFG => "article custom fields";
ca9aa2bf 18
ea9b63f1 19our $VERSION = "1.042";
cb7fd78d 20
58baa27b
TC
21=head1 NAME
22
23 BSE::Edit::Article - editing functionality for BSE articles
24
25=head1 DESCRIPTION
26
27Provides the base article editing functionality.
28
29This is badly organized and documented.
30
31=head1 METHODS
32
33=over
34
35=cut
36
74b21f6d
TC
37sub not_logged_on {
38 my ($self, $req) = @_;
39
9b3a5df0 40 if ($req->is_ajax) {
74b21f6d 41 # AJAX/Prototype request
9b3a5df0
TC
42 return $req->json_content
43 (
44 {
60bc6601 45 success => 0,
9b3a5df0
TC
46 message => "Access forbidden: user not logged on",
47 errors => {},
60bc6601 48 error_code => "LOGON",
9b3a5df0
TC
49 }
50 );
51 }
52 elsif ($req->cgi->param('_service')) {
74b21f6d
TC
53 return
54 {
55 content => 'Access Forbidden: login timed out',
56 headers => [
57 "Status: 403", # forbidden
58 ],
59 };
60 }
61 else {
62 BSE::Template->get_refresh($req->url('logon'), $req->cfg);
63 }
64}
65
ca9aa2bf 66sub article_dispatch {
9168c88c
TC
67 my ($self, $req, $article, $articles) = @_;
68
69 BSE::Permissions->check_logon($req)
fc186852 70 or return $self->not_logged_on($req);
9168c88c
TC
71
72 my $cgi = $req->cgi;
ca9aa2bf
TC
73 my $action;
74 my %actions = $self->article_actions;
75 for my $check (keys %actions) {
76 if ($cgi->param($check) || $cgi->param("$check.x")) {
77 $action = $check;
78 last;
79 }
80 }
81 my @extraargs;
82 unless ($action) {
83 ($action, @extraargs) = $self->other_article_actions($cgi);
84 }
85 $action ||= 'edit';
86 my $method = $actions{$action};
9168c88c 87 return $self->$method($req, $article, $articles, @extraargs);
ca9aa2bf
TC
88}
89
90sub noarticle_dispatch {
9168c88c 91 my ($self, $req, $articles) = @_;
ca9aa2bf 92
9168c88c
TC
93 BSE::Permissions->check_logon($req)
94 or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
95
d62f54f7
TC
96 my $mymsg;
97 my $article = $self->_dummy_article($req, $articles, \$mymsg);
98 unless ($article) {
99 require BSE::Edit::Site;
100 my $site = BSE::Edit::Site->new(cfg=>$req->cfg, db=> BSE::DB->single);
101 return $site->edit_sections($req, $articles, $mymsg);
102 }
103
9168c88c 104 my $cgi = $req->cgi;
ca9aa2bf
TC
105 my $action = 'add';
106 my %actions = $self->noarticle_actions;
107 for my $check (keys %actions) {
108 if ($cgi->param($check) || $cgi->param("$check.x")) {
109 $action = $check;
110 last;
111 }
112 }
113 my $method = $actions{$action};
d62f54f7 114 return $self->$method($req, $article, $articles);
ca9aa2bf
TC
115}
116
ca9aa2bf
TC
117sub article_actions {
118 my ($self) = @_;
119
120 return
121 (
122 edit => 'edit_form',
123 save => 'save',
124 add_stepkid => 'add_stepkid',
125 del_stepkid => 'del_stepkid',
126 save_stepkids => 'save_stepkids',
127 add_stepparent => 'add_stepparent',
128 del_stepparent => 'del_stepparent',
129 save_stepparents => 'save_stepparents',
130 artimg => 'save_image_changes',
131 addimg => 'add_image',
b95fc3a0
TC
132 a_edit_image => 'req_edit_image',
133 a_save_image => 'req_save_image',
9833da10 134 a_order_images => 'req_order_images',
6473c56f 135 remove => 'remove',
ca9aa2bf
TC
136 showimages => 'show_images',
137 process => 'save_image_changes',
138 removeimg => 'remove_img',
139 moveimgup => 'move_img_up',
140 moveimgdown => 'move_img_down',
141 filelist => 'filelist',
142 fileadd => 'fileadd',
143 fileswap => 'fileswap',
144 filedel => 'filedel',
145 filesave => 'filesave',
b2a9e505
TC
146 a_edit_file => 'req_edit_file',
147 a_save_file => 'req_save_file',
4010d92e
TC
148 hide => 'hide',
149 unhide => 'unhide',
ab2cd916 150 a_thumb => 'req_thumb',
74b21f6d
TC
151 a_ajax_get => 'req_ajax_get',
152 a_ajax_save_body => 'req_ajax_save_body',
153 a_ajax_set => 'req_ajax_set',
36e373a9 154 a_filemeta => 'req_filemeta',
f3fc60c0 155 a_csrfp => 'req_csrfp',
60bc6601 156 a_tree => 'req_tree',
8f88bb20 157 a_article => 'req_article',
d62f54f7 158 a_config => 'req_config',
8634bfaa 159 a_restepkid => 'req_restepkid',
ca9aa2bf
TC
160 );
161}
162
163sub other_article_actions {
164 my ($self, $cgi) = @_;
165
166 for my $param ($cgi->param) {
167 if ($param =~ /^removeimg_(\d+)(\.x)?$/) {
168 return ('removeimg', $1 );
169 }
170 }
171
172 return;
173}
174
175sub noarticle_actions {
176 return
177 (
178 add => 'add_form',
179 save => 'save_new',
f3fc60c0 180 a_csrfp => 'req_csrfp',
d62f54f7 181 a_config => 'req_config',
ca9aa2bf
TC
182 );
183}
184
185sub get_parent {
186 my ($self, $parentid, $articles) = @_;
187
188 if ($parentid == -1) {
189 return
190 {
191 id => -1,
192 title=>'All Sections',
193 level => 0,
194 listed => 0,
195 parentid => undef,
196 };
197 }
198 else {
199 return $articles->getByPkey($parentid);
200 }
201}
202
203sub tag_hash {
204 my ($object, $args) = @_;
205
206 my $value = $object->{$args};
207 defined $value or $value = '';
7b81711b
TC
208 if ($value =~ /\cJ/ && $value =~ /\cM/) {
209 $value =~ tr/\cM//d;
210 }
77804754 211 escape_html($value);
ca9aa2bf
TC
212}
213
62533efa
TC
214sub tag_hash_mbcs {
215 my ($object, $args) = @_;
216
217 my $value = $object->{$args};
218 defined $value or $value = '';
219 if ($value =~ /\cJ/ && $value =~ /\cM/) {
220 $value =~ tr/\cM//d;
221 }
222 escape_html($value, '<>&"');
223}
224
ca9aa2bf
TC
225sub tag_art_type {
226 my ($level, $cfg) = @_;
227
77804754 228 escape_html($cfg->entry('level names', $level, 'Article'));
ca9aa2bf
TC
229}
230
231sub tag_if_new {
232 my ($article) = @_;
233
234 !$article->{id};
235}
236
237sub reparent_updown {
238 return 1;
239}
240
241sub should_be_catalog {
242 my ($self, $article, $parent, $articles) = @_;
243
244 if ($article->{parentid} && (!$parent || $parent->{id} != $article->{parentid})) {
245 $parent = $articles->getByPkey($article->{id});
246 }
247
6430ee52 248 my $shopid = $self->cfg->entryErr('articles', 'shop');
ca9aa2bf
TC
249
250 return $article->{parentid} && $parent &&
251 ($article->{parentid} == $shopid ||
252 $parent->{generator} eq 'Generate::Catalog');
253}
254
255sub possible_parents {
9168c88c 256 my ($self, $article, $articles, $req) = @_;
ca9aa2bf
TC
257
258 my %labels;
259 my @values;
260
6430ee52 261 my $shopid = $self->cfg->entryErr('articles', 'shop');
ca9aa2bf
TC
262 my @parents = $articles->getBy('level', $article->{level}-1);
263 @parents = grep { $_->{generator} eq 'Generate::Article'
264 && $_->{id} != $shopid } @parents;
9168c88c
TC
265
266 # user can only select parent they can add to
267 @parents = grep $req->user_can('edit_add_child', $_), @parents;
ca9aa2bf
TC
268
269 @values = ( map {$_->{id}} @parents );
270 %labels = ( map { $_->{id} => "$_->{title} ($_->{id})" } @parents );
271
9168c88c 272 if ($article->{level} == 1 && $req->user_can('edit_add_child')) {
ca9aa2bf
TC
273 push @values, -1;
274 $labels{-1} = "No parent - this is a section";
275 }
276
277 if ($article->{id} && $self->reparent_updown($article)) {
278 # we also list the siblings and grandparent (if any)
279 my @siblings = grep $_->{id} != $article->{id} && $_->{id} != $shopid,
280 $articles->getBy(parentid => $article->{parentid});
9168c88c 281 @siblings = grep $req->user_can('edit_add_child', $_), @siblings;
ca9aa2bf
TC
282 push @values, map $_->{id}, @siblings;
283 @labels{map $_->{id}, @siblings} =
284 map { "-- move down a level -- $_->{title} ($_->{id})" } @siblings;
285
286 if ($article->{parentid} != -1) {
287 my $parent = $articles->getByPkey($article->{parentid});
288 if ($parent->{parentid} != -1) {
289 my $gparent = $articles->getByPkey($parent->{parentid});
9168c88c
TC
290 if ($req->user_can('edit_add_child', $gparent)) {
291 push @values, $gparent->{id};
292 $labels{$gparent->{id}} =
293 "-- move up a level -- $gparent->{title} ($gparent->{id})";
294 }
ca9aa2bf
TC
295 }
296 else {
9168c88c
TC
297 if ($req->user_can('edit_add_child')) {
298 push @values, -1;
15ff79e8 299 $labels{-1} = $req->catmsg("msg:bse/admin/edit/uplabelsect");
9168c88c 300 }
ca9aa2bf
TC
301 }
302 }
303 }
304
305 return (\@values, \%labels);
306}
307
308sub tag_list {
9168c88c 309 my ($self, $article, $articles, $cgi, $req, $what) = @_;
ca9aa2bf
TC
310
311 if ($what eq 'listed') {
312 my @values = qw(0 1);
313 my %labels = ( 0=>"No", 1=>"Yes");
314 if ($article->{level} <= 2) {
315 $labels{2} = "In Sections, but not menu";
316 push(@values, 2);
317 }
318 else {
319 $labels{2} = "In content, but not menus";
320 push(@values, 2);
321 }
d09682dd
TC
322 return popup_menu(-name=>'listed',
323 -values=>\@values,
324 -labels=>\%labels,
325 -default=>$article->{listed});
ca9aa2bf
TC
326 }
327 else {
9168c88c 328 my ($values, $labels) = $self->possible_parents($article, $articles, $req);
ca9aa2bf
TC
329 my $html;
330 if (defined $article->{parentid}) {
d09682dd
TC
331 $html = popup_menu(-name=>'parentid',
332 -values=> $values,
333 -labels => $labels,
334 -default => $article->{parentid},
335 -override=>1);
ca9aa2bf
TC
336 }
337 else {
d09682dd
TC
338 $html = popup_menu(-name=>'parentid',
339 -values=> $values,
340 -labels => $labels,
341 -override=>1);
ca9aa2bf
TC
342 }
343
344 # munge the html - we display a default value, so we need to wrap the
345 # default <select /> around this one
346 $html =~ s!^<select[^>]+>|</select>!!gi;
347 return $html;
348 }
349}
350
351sub tag_checked {
352 my ($arg, $acts, $funcname, $templater) = @_;
353 my ($func, $args) = split ' ', $arg, 2;
354 return $templater->perform($acts, $func, $args) ? 'checked' : '';
355}
356
357sub iter_get_images {
daee3409 358 my ($self, $article) = @_;
ca9aa2bf
TC
359
360 $article->{id} or return;
daee3409 361 $self->get_images($article);
ca9aa2bf
TC
362}
363
364sub iter_get_kids {
365 my ($article, $articles) = @_;
366
15fb10f2 367 my @children;
ca9aa2bf
TC
368 $article->{id} or return;
369 if (UNIVERSAL::isa($article, 'Article')) {
15fb10f2 370 @children = $article->children;
ca9aa2bf
TC
371 }
372 elsif ($article->{id}) {
15fb10f2 373 @children = $articles->children($article->{id});
ca9aa2bf 374 }
15fb10f2
TC
375
376 return sort { $b->{displayOrder} <=> $a->{displayOrder} } @children;
ca9aa2bf
TC
377}
378
379sub tag_if_have_child_type {
380 my ($level, $cfg) = @_;
381
382 defined $cfg->entry("level names", $level+1);
383}
384
385sub tag_is {
386 my ($args, $acts, $isname, $templater) = @_;
387
388 my ($func, $funcargs) = split ' ', $args, 2;
389 return $templater->perform($acts, $func, $funcargs) ? 'Yes' : 'No';
390}
391
caa7299c
TC
392sub default_template {
393 my ($self, $article, $cfg, $templates) = @_;
394
395 if ($article->{parentid}) {
396 my $template = $cfg->entry("children of $article->{parentid}", "template");
397 return $template
398 if $template && grep $_ eq $template, @$templates;
399 }
400 if ($article->{level}) {
401 my $template = $cfg->entry("level $article->{level}", "template");
402 return $template
403 if $template && grep $_ eq $template, @$templates;
404 }
405 return $templates->[0];
406}
407
ca9aa2bf
TC
408sub tag_templates {
409 my ($self, $article, $cfg, $cgi) = @_;
410
fea96500 411 my @templates = sort { $a->{name} cmp $b->{name} } $self->templates_long($article);
ca9aa2bf 412 my $default;
fea96500 413 if ($article->{template} && grep $_->{name} eq $article->{template}, @templates) {
ca9aa2bf
TC
414 $default = $article->{template};
415 }
416 else {
13eba5e5
TC
417 my @template_names = map $_->{name}, @templates;
418 $default = $self->default_template($article, $cfg, \@template_names);
ca9aa2bf 419 }
fea96500
TC
420 my %labels =
421 (
422 map
423 { ;
424 $_->{name} =>
425 $_->{name} eq $_->{description}
426 ? $_->{name}
427 : "$_->{description} ($_->{name})"
428 } @templates
429 );
430 return popup_menu(-name => 'template',
431 -values => [ map $_->{name}, @templates ],
432 -labels => \%labels,
433 -default => $default,
434 -override => 1);
ca9aa2bf
TC
435}
436
437sub title_images {
438 my ($self, $article) = @_;
439
440 my @title_images;
6430ee52 441 my $imagedir = cfg_image_dir($self->cfg);
ca9aa2bf
TC
442 if (opendir TITLE_IMAGES, "$imagedir/titles") {
443 @title_images = sort
444 grep -f "$imagedir/titles/$_" && /\.(gif|jpeg|jpg|png)$/i,
445 readdir TITLE_IMAGES;
446 closedir TITLE_IMAGES;
447 }
448
449 @title_images;
450}
451
452sub tag_title_images {
453 my ($self, $article, $cfg, $cgi) = @_;
454
455 my @images = $self->title_images($article);
456 my @values = ( '', @images );
457 my %labels = ( '' => 'None', map { $_ => $_ } @images );
458 return $cgi->
459 popup_menu(-name=>'titleImage',
460 -values=>\@values,
461 -labels=>\%labels,
462 -default=>$article->{id} ? $article->{titleImage} : '',
463 -override=>1);
464}
465
466sub base_template_dirs {
467 return ( "common" );
468}
469
470sub template_dirs {
471 my ($self, $article) = @_;
472
473 my @dirs = $self->base_template_dirs;
474 if (my $parentid = $article->{parentid}) {
475 my $section = "children of $parentid";
6430ee52 476 if (my $dirs = $self->cfg->entry($section, 'template_dirs')) {
ca9aa2bf
TC
477 push @dirs, split /,/, $dirs;
478 }
479 }
480 if (my $id = $article->{id}) {
481 my $section = "article $id";
482 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
483 push @dirs, split /,/, $dirs;
484 }
485 }
caa7299c
TC
486 if ($article->{level}) {
487 push @dirs, $article->{level};
488 my $dirs = $self->{cfg}->entry("level $article->{level}", 'template_dirs');
489 push @dirs, split /,/, $dirs if $dirs;
490 }
ca9aa2bf
TC
491
492 @dirs;
493}
494
495sub templates {
496 my ($self, $article) = @_;
497
498 my @dirs = $self->template_dirs($article);
499 my @templates;
918735d1
TC
500 my @basedirs = BSE::Template->template_dirs($self->{cfg});
501 for my $basedir (@basedirs) {
502 for my $dir (@dirs) {
503 my $path = File::Spec->catdir($basedir, $dir);
504 if (-d $path) {
505 if (opendir TEMPLATE_DIR, $path) {
506 push(@templates, sort map "$dir/$_",
507 grep -f "$path/$_" && /\.(tmpl|html)$/i, readdir TEMPLATE_DIR);
508 closedir TEMPLATE_DIR;
509 }
ca9aa2bf
TC
510 }
511 }
512 }
918735d1
TC
513
514 # eliminate any dups, and order it nicely
515 my %seen;
516 @templates = sort { lc($a) cmp lc($b) }
517 grep !$seen{$_}++, @templates;
518
ca9aa2bf
TC
519 return (@templates, $self->extra_templates($article));
520}
521
522sub extra_templates {
523 my ($self, $article) = @_;
524
aefcabcb 525 my $basedir = $self->{cfg}->entryVar('paths', 'templates');
ca9aa2bf
TC
526 my @templates;
527 if (my $id = $article->{id}) {
528 push @templates, 'index.tmpl'
529 if $id == 1 && -f "$basedir/index.html";
530 push @templates, 'index2.tmpl'
531 if $id == 2 && -f "$basedir/index2.html";
532 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
533 push @templates, "shop_sect.tmpl"
534 if $id == $shopid && -f "$basedir/shop_sect.tmpl";
535 my $section = "article $id";
536 my $extras = $self->{cfg}->entry($section, 'extra_templates');
537 push @templates, grep /\.(tmpl|html)$/i, split /,/, $extras
538 if $extras;
539 }
540
541 @templates;
542}
543
dbfbfb12
TC
544sub categories {
545 my ($self, $articles) = @_;
546
547 return $articles->categories;
548}
549
ca9aa2bf
TC
550sub edit_parent {
551 my ($article) = @_;
552
553 return '' unless $article->{id} && $article->{id} != -1;
554 return <<HTML;
555<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
556HTML
557}
558
559sub iter_allkids {
560 my ($article) = @_;
561
562 return unless $article->{id} && $article->{id} > 0;
563 $article->allkids;
564}
565
566sub _load_step_kids {
567 my ($article, $step_kids) = @_;
568
0767d88b 569 require OtherParents;
ca9aa2bf
TC
570 my @stepkids = OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
571 %$step_kids = map { $_->{childId} => $_ } @stepkids;
ca9aa2bf
TC
572 $step_kids->{loaded} = 1;
573}
574
575sub tag_if_step_kid {
576 my ($article, $allkids, $rallkid_index, $step_kids) = @_;
577
578 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
579
580 my $kid = $allkids->[$$rallkid_index]
581 or return;
582 exists $step_kids->{$kid->{id}};
583}
584
585sub tag_step_kid {
586 my ($article, $allkids, $rallkid_index, $step_kids, $arg) = @_;
587
588 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
589
590 my $kid = $allkids->[$$rallkid_index]
591 or return '';
f0543260
TC
592 my $step_kid = $step_kids->{$kid->{id}}
593 or return '';
594 #use Data::Dumper;
595 #print STDERR "found kid (want $arg): ", Dumper($kid), Dumper($step_kid);
596 escape_html($step_kid->{$arg});
ca9aa2bf
TC
597}
598
599sub tag_move_stepkid {
8b0b2f34
TC
600 my ($self, $cgi, $req, $article, $allkids, $rallkids_index, $arg,
601 $acts, $funcname, $templater) = @_;
31a26b52
TC
602
603 $req->user_can(edit_reorder_children => $article)
604 or return '';
ca9aa2bf 605
aefcabcb
TC
606 @$allkids > 1 or return '';
607
8b0b2f34
TC
608 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
609 $img_prefix = '' unless defined $img_prefix;
610 $urladd = '' unless defined $urladd;
611
ca9aa2bf 612 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
ca9aa2bf
TC
613 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
614 if ($cgi->param('_t')) {
615 $url .= "&_t=".$cgi->param('_t');
616 }
8b0b2f34 617 $url .= $urladd;
ca9aa2bf 618 $url .= "#step";
d09682dd 619 my $down_url = '';
ca9aa2bf 620 if ($$rallkids_index < $#$allkids) {
d09682dd 621 $down_url = "$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index+1]{id}";
aefcabcb 622 }
d09682dd 623 my $up_url = '';
ca9aa2bf 624 if ($$rallkids_index > 0) {
d09682dd 625 $up_url = "$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index-1]{id}";
ca9aa2bf 626 }
d09682dd
TC
627
628 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
629}
630
631sub possible_stepkids {
31a26b52
TC
632 my ($req, $article, $articles, $stepkids) = @_;
633
634 $req->user_can(edit_stepkid_add => $article)
635 or return;
ca9aa2bf 636
147e99e8
TC
637 $article->{id} == -1
638 and return;
639
31a26b52 640 my @possible = sort { lc $a->{title} cmp lc $b->{title} }
147e99e8
TC
641 $article->possible_stepchildren;
642 if ($req->access_control && $req->cfg->entry('basic', 'access_filter_steps', 0)) {
643 @possible = grep $req->user_can(edit_stepparent_add => $_->{id}), @possible;
31a26b52
TC
644 }
645 return @possible;
ca9aa2bf
TC
646}
647
ca9aa2bf 648sub tag_possible_stepkids {
31a26b52 649 my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
ca9aa2bf
TC
650
651 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
31a26b52 652 @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
ca9aa2bf
TC
653 unless @$possstepkids;
654 my %labels = map { $_->{id} => "$_->{title} ($_->{id})" } @$possstepkids;
655 return
d09682dd
TC
656 popup_menu(-name=>'stepkid',
657 -values=> [ map $_->{id}, @$possstepkids ],
658 -labels => \%labels);
ca9aa2bf
TC
659}
660
661sub tag_if_possible_stepkids {
31a26b52 662 my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
ca9aa2bf
TC
663
664 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
31a26b52 665 @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
ca9aa2bf
TC
666 unless @$possstepkids;
667
668 @$possstepkids;
669}
670
671sub iter_get_stepparents {
672 my ($article) = @_;
673
674 return unless $article->{id} && $article->{id} > 0;
675
b51e9b24 676 require OtherParents;
ca9aa2bf
TC
677 OtherParents->getBy(childId=>$article->{id});
678}
679
680sub tag_ifStepParents {
681 my ($args, $acts, $funcname, $templater) = @_;
682
683 return $templater->perform($acts, 'ifStepparents', '');
684}
685
686sub tag_stepparent_targ {
687 my ($article, $targs, $rindex, $arg) = @_;
688
689 if ($article->{id} && $article->{id} > 0 && !@$targs) {
690 @$targs = $article->step_parents;
691 }
77804754 692 escape_html($targs->[$$rindex]{$arg});
ca9aa2bf
TC
693}
694
695sub tag_move_stepparent {
8b0b2f34
TC
696 my ($self, $cgi, $req, $article, $stepparents, $rindex, $arg,
697 $acts, $funcname, $templater) = @_;
31a26b52
TC
698
699 $req->user_can(edit_reorder_stepparents => $article)
700 or return '';
ca9aa2bf 701
aefcabcb
TC
702 @$stepparents > 1 or return '';
703
8b0b2f34
TC
704 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
705 $img_prefix = '' unless defined $img_prefix;
706 $urladd = '' unless defined $urladd;
707
ca9aa2bf 708 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
771ab646 709 my $images_uri = cfg_dist_image_uri();
ca9aa2bf
TC
710 my $html = '';
711 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
712 if ($cgi->param('_t')) {
713 $url .= "&_t=".$cgi->param('_t');
714 }
8b0b2f34 715 $url .= $urladd;
ca9aa2bf 716 $url .= "#stepparents";
d794b180 717 my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />!;
d09682dd 718 my $down_url = '';
ca9aa2bf 719 if ($$rindex < $#$stepparents) {
d09682dd 720 $down_url = "$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex+1]{parentId}";
aefcabcb 721 }
d09682dd 722 my $up_url = '';
ca9aa2bf 723 if ($$rindex > 0) {
d09682dd 724 $up_url = "$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex-1]{parentId}";
aefcabcb 725 }
d09682dd
TC
726
727 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
728}
729
de193691
TC
730sub _stepparent_possibles {
731 my ($req, $article, $articles, $targs) = @_;
732
733 $req->user_can(edit_stepparent_add => $article)
734 or return;
735
147e99e8
TC
736 $article->{id} == -1
737 and return;
738
de193691
TC
739 @$targs = $article->step_parents unless @$targs;
740 my %targs = map { $_->{id}, 1 } @$targs;
147e99e8
TC
741 my @possibles = $article->possible_stepparents;
742 if ($req->access_control && $req->cfg->entry('basic', 'access_filter_steps', 0)) {
743 @possibles = grep $req->user_can(edit_stepkid_add => $_->{id}), @possibles;
de193691
TC
744 }
745 @possibles = sort { lc $a->{title} cmp lc $b->{title} } @possibles;
746
747 return @possibles;
748}
749
ca9aa2bf 750sub tag_if_stepparent_possibles {
31a26b52 751 my ($req, $article, $articles, $targs, $possibles) = @_;
ca9aa2bf 752
de193691
TC
753 if ($article->{id} && $article->{id} > 0 && !@$possibles) {
754 @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
ca9aa2bf
TC
755 }
756 scalar @$possibles;
757}
758
759sub tag_stepparent_possibles {
31a26b52 760 my ($cgi, $req, $article, $articles, $targs, $possibles) = @_;
ca9aa2bf 761
de193691
TC
762 if ($article->{id} && $article->{id} > 0 && !@$possibles) {
763 @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
ca9aa2bf 764 }
d09682dd
TC
765 popup_menu(-name=>'stepparent',
766 -values => [ map $_->{id}, @$possibles ],
767 -labels => { map { $_->{id}, "$_->{title} ($_->{id})" }
768 @$possibles });
ca9aa2bf
TC
769}
770
771sub iter_files {
9366cd70
TC
772 my ($self, $article) = @_;
773
774 return $self->get_files($article);
775}
776
777sub get_files {
778 my ($self, $article) = @_;
ca9aa2bf
TC
779
780 return unless $article->{id} && $article->{id} > 0;
781
782 return $article->files;
783}
784
785sub tag_edit_parent {
786 my ($article) = @_;
787
788 return '' unless $article->{id} && $article->{id} != -1;
789
790 return <<HTML;
791<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
792HTML
793}
794
795sub tag_if_children {
796 my ($args, $acts, $funcname, $templater) = @_;
797
798 return $templater->perform($acts, 'ifChildren', '');
799}
800
801sub tag_movechild {
8b0b2f34
TC
802 my ($self, $req, $article, $kids, $rindex, $arg,
803 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
804
805 $req->user_can('edit_reorder_children', $article)
806 or return '';
ca9aa2bf 807
aefcabcb
TC
808 @$kids > 1 or return '';
809
ca9aa2bf
TC
810 $$rindex >=0 && $$rindex < @$kids
811 or return '** movechild can only be used in the children iterator **';
812
8b0b2f34
TC
813 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
814 $img_prefix = '' unless defined $img_prefix;
815 $urladd = '' unless defined $urladd;
816
ca9aa2bf 817 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
771ab646 818 my $images_uri = cfg_dist_image_uri();
41f10371 819 my $urlbase = admin_base_url($req->cfg);
d09682dd 820 my $refresh_url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
cc9019d1
TC
821 my $t = $req->cgi->param('_t');
822 if ($t && $t =~ /^\w+$/) {
d09682dd 823 $refresh_url .= "&_t=$t";
cc9019d1 824 }
d09682dd
TC
825
826 $refresh_url .= $urladd;
827
ca9aa2bf 828 my $id = $kids->[$$rindex]{id};
d09682dd 829 my $down_url = '';
ca9aa2bf 830 if ($$rindex < $#$kids) {
d09682dd 831 $down_url = "$cgi_uri/admin/move.pl?id=$id&d=down&edit=1&all=1";
ca9aa2bf 832 }
d09682dd 833 my $up_url = '';
ca9aa2bf 834 if ($$rindex > 0) {
d09682dd 835 $up_url = "$cgi_uri/admin/move.pl?id=$id&d=up&edit=1&all=1"
ca9aa2bf 836 }
ca9aa2bf 837
d09682dd 838 return make_arrows($req->cfg, $down_url, $up_url, $refresh_url, $img_prefix);
ca9aa2bf
TC
839}
840
dbfbfb12
TC
841sub tag_category {
842 my ($self, $articles, $article) = @_;
843
844 my @cats = $self->categories($articles);
845
846 my %labels = map { $_->{id}, $_->{name} } @cats;
847
848 return popup_menu(-name => 'category',
849 -values => [ map $_->{id}, @cats ],
850 -labels => \%labels,
851 -default => $article->{category});
852}
853
ca9aa2bf 854sub tag_edit_link {
f2bf0d11 855 my ($cfg, $article, $args, $acts, $funcname, $templater) = @_;
ca9aa2bf
TC
856 my ($which, $name) = split / /, $args, 2;
857 $name ||= 'Edit';
858 my $gen_class;
859 if ($acts->{$which}
860 && ($gen_class = $templater->perform($acts, $which, 'generator'))) {
861 eval "use $gen_class";
862 unless ($@) {
f2bf0d11 863 my $gen = $gen_class->new(top => $article, cfg => $cfg);
ca9aa2bf
TC
864 my $link = $gen->edit_link($templater->perform($acts, $which, 'id'));
865 return qq!<a href="$link">$name</a>!;
866 }
867 }
868 return '';
869}
870
871sub tag_imgmove {
8b0b2f34
TC
872 my ($req, $article, $rindex, $images, $arg,
873 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
874
875 $req->user_can(edit_images_reorder => $article)
876 or return '';
ca9aa2bf 877
aefcabcb
TC
878 @$images > 1 or return '';
879
ca9aa2bf
TC
880 $$rindex >= 0 && $$rindex < @$images
881 or return '** imgmove can only be used in image iterator **';
882
8b0b2f34
TC
883 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
884 $img_prefix = '' unless defined $img_prefix;
885 $urladd = '' unless defined $urladd;
886
41f10371 887 my $urlbase = admin_base_url($req->cfg);
cc9019d1
TC
888 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
889 my $t = $req->cgi->param('_t');
890 if ($t && $t =~ /^\w+$/) {
891 $url .= "&_t=$t";
892 }
893 $url .= $urladd;
8b0b2f34 894
ca9aa2bf 895 my $image = $images->[$$rindex];
aa6896b6
TC
896 my $csrfp = $req->get_csrf_token("admin_move_image");
897 my $baseurl = "$ENV{SCRIPT_NAME}?id=$article->{id}&imageid=$image->{id}&";
898 $baseurl .= "_csrfp=$csrfp&";
899 my $down_url = "";
ca9aa2bf 900 if ($$rindex < $#$images) {
aa6896b6 901 $down_url = $baseurl . "moveimgdown=1";
ca9aa2bf 902 }
aa6896b6 903 my $up_url = "";
d09682dd 904 if ($$rindex > 0) {
aa6896b6 905 $up_url = $baseurl . "moveimgup=1";
ca9aa2bf 906 }
d09682dd 907 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
908}
909
910sub tag_movefiles {
8b0b2f34
TC
911 my ($self, $req, $article, $files, $rindex, $arg,
912 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
913
914 $req->user_can('edit_files_reorder', $article)
915 or return '';
ca9aa2bf 916
aefcabcb
TC
917 @$files > 1 or return '';
918
8b0b2f34
TC
919 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
920 $img_prefix = '' unless defined $img_prefix;
921 $urladd = '' unless defined $urladd;
922
ca9aa2bf
TC
923 $$rindex >= 0 && $$rindex < @$files
924 or return '** movefiles can only be used in the files iterator **';
925
41f10371 926 my $urlbase = admin_base_url($req->cfg);
9063386f
TC
927 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}$urladd";
928 my $t = $req->cgi->param('_t');
929 if ($t && $t =~ /^\w+$/) {
930 $url .= "&_t=$t";
931 }
d09682dd
TC
932
933 my $down_url = "";
aa6896b6
TC
934 my $csrfp = $req->get_csrf_token("admin_move_file");
935 my $baseurl = "$ENV{SCRIPT_NAME}?fileswap=1&id=$article->{id}&";
936 $baseurl .= "_csrfp=$csrfp&";
ca9aa2bf 937 if ($$rindex < $#$files) {
aa6896b6 938 $down_url = $baseurl . "file1=$files->[$$rindex]{id}&file2=$files->[$$rindex+1]{id}";
ca9aa2bf 939 }
d09682dd 940 my $up_url = "";
ca9aa2bf 941 if ($$rindex > 0) {
aa6896b6 942 $up_url = $baseurl . "file1=$files->[$$rindex]{id}&file2=$files->[$$rindex-1]{id}";
ca9aa2bf 943 }
d09682dd
TC
944
945 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
946}
947
948sub tag_old {
949 my ($article, $cgi, $args, $acts, $funcname, $templater) = @_;
950
951 my ($col, $func, $funcargs) = split ' ', $args, 3;
952 my $value = $cgi->param($col);
953 if (defined $value) {
77804754 954 return escape_html($value);
ca9aa2bf
TC
955 }
956 else {
957 if ($func) {
958 return $templater->perform($acts, $func, $funcargs);
959 }
960 else {
961 $value = $article->{$args};
962 defined $value or $value = '';
77804754 963 return escape_html($value);
ca9aa2bf
TC
964 }
965 }
966}
967
08123550
TC
968sub iter_admin_users {
969 require BSE::TB::AdminUsers;
970
971 BSE::TB::AdminUsers->all;
972}
973
974sub iter_admin_groups {
975 require BSE::TB::AdminGroups;
976
977 BSE::TB::AdminGroups->all;
978}
979
9168c88c
TC
980sub tag_if_field_perm {
981 my ($req, $article, $field) = @_;
982
abf5bbc6
TC
983 unless ($field =~ /^\w+$/) {
984 print STDERR "Bad fieldname '$field'\n";
985 return;
986 }
9168c88c 987 if ($article->{id}) {
abf5bbc6 988 return $req->user_can("edit_field_edit_$field", $article);
9168c88c
TC
989 }
990 else {
4010d92e 991 #print STDERR "adding, always successful\n";
abf5bbc6 992 return 1;
9168c88c
TC
993 }
994}
995
996sub tag_default {
997 my ($self, $req, $article, $args, $acts, $funcname, $templater) = @_;
998
999 my ($col, $func, $funcargs) = split ' ', $args, 3;
1000 if ($article->{id}) {
1001 if ($func) {
1002 return $templater->perform($acts, $func, $funcargs);
1003 }
1004 else {
1005 my $value = $article->{$args};
1006 defined $value or $value = '';
b1d01e52 1007 return escape_html($value, '<>&"');
9168c88c
TC
1008 }
1009 }
1010 else {
1011 my $value = $self->default_value($req, $article, $col);
0ec4ac8a 1012 defined $value or $value = '';
b1d01e52 1013 return escape_html($value, '<>&"');
9168c88c
TC
1014 }
1015}
1016
918735d1
TC
1017sub iter_flags {
1018 my ($self) = @_;
1019
1020 $self->flags;
1021}
1022
1023sub tag_if_flag_set {
1024 my ($article, $arg, $acts, $funcname, $templater) = @_;
1025
1026 my @args = DevHelp::Tags->get_parms($arg, $acts, $templater);
1027 @args or return;
1028
1029 return index($article->{flags}, $args[0]) >= 0;
1030}
1031
8b0b2f34
TC
1032sub iter_crumbs {
1033 my ($article, $articles) = @_;
1034
1035 my @crumbs;
1036 my $temp = $article;
1037 defined($temp->{parentid}) or return;
1038 while ($temp->{parentid} > 0
1039 and my $crumb = $articles->getByPkey($temp->{parentid})) {
1040 unshift @crumbs, $crumb;
1041 $temp = $crumb;
1042 }
1043
1044 @crumbs;
1045}
1046
1047sub tag_typename {
1048 my ($args, $acts, $funcname, $templater) = @_;
1049
1050 exists $acts->{$args} or return "** need an article name **";
1051 my $generator = $templater->perform($acts, $args, 'generator');
1052
1053 $generator =~ /^(?:BSE::)?Generate::(\w+)$/
1054 or return "** invalid generator $generator **";
1055
1056 return $1;
1057}
1058
ab2cd916
TC
1059sub _get_thumbs_class {
1060 my ($self) = @_;
1061
1062 $self->{cfg}->entry('editor', 'allow_thumb', 0)
1063 or return;
1064
1065 my $class = $self->{cfg}->entry('editor', 'thumbs_class')
1066 or return;
1067
1068 (my $filename = "$class.pm") =~ s!::!/!g;
1069 eval { require $filename; };
1070 if ($@) {
1071 print STDERR "** Error loading thumbs_class $class ($filename): $@\n";
1072 return;
1073 }
1074 my $obj;
1075 eval { $obj = $class->new($self->{cfg}) };
1076 if ($@) {
1077 print STDERR "** Error creating thumbs objects $class: $@\n";
1078 return;
1079 }
1080
1081 return $obj;
1082}
1083
1084sub tag_thumbimage {
1085 my ($cfg, $thumbs_obj, $current_image, $args) = @_;
1086
6a8a6ac5
TC
1087 $thumbs_obj or return '';
1088
ab2cd916
TC
1089 $$current_image or return '** no current image **';
1090
1091 my $imagedir = cfg_image_dir($cfg);
1092
1093 my $filename = "$imagedir/$$current_image->{image}";
1094 -e $filename or return "** image file missing **";
1095
f40af7e2
TC
1096 defined $args && $args =~ /\S/
1097 or $args = "editor";
ab2cd916 1098
195977cd 1099 my $image = $$current_image;
f40af7e2
TC
1100 return $image->thumb
1101 (
1102 geo => $args,
1103 cfg => $cfg,
0769f639 1104 nolink => 1,
f40af7e2
TC
1105 );
1106}
ab2cd916 1107
8aa7eb30
TC
1108sub tag_file_display {
1109 my ($self, $files, $file_index) = @_;
1110
1111 $$file_index >= 0 && $$file_index < @$files
1112 or return "* file_display only usable inside a files iterator *";
1113 my $file = $files->[$$file_index];
1114
1115 my $disp_type = $self->cfg->entry("editor", "file_display", "");
1116
1117 return $file->inline
1118 (
1119 cfg => $self->cfg,
1120 field => $disp_type,
1121 );
1122}
1123
f40af7e2
TC
1124sub tag_image {
1125 my ($self, $cfg, $rcurrent, $args) = @_;
ab2cd916 1126
f40af7e2
TC
1127 my $im = $$rcurrent
1128 or return '';
195977cd 1129
f40af7e2
TC
1130 my ($align, $rest) = split ' ', $args, 2;
1131
1132 if ($align && exists $im->{$align}) {
1133 if ($align eq 'src') {
1134 return escape_html($im->image_url($self->{cfg}));
1135 }
1136 else {
1137 return escape_html($im->{$align});
1138 }
1139 }
1140 else {
1141 return $im->formatted
1142 (
1143 cfg => $cfg,
1144 align => $align,
1145 extras => $rest,
1146 );
1147 }
ab2cd916
TC
1148}
1149
76c6b28e
TC
1150sub iter_tags {
1151 my ($self, $article) = @_;
1152
1153 $article->{id}
1154 or return;
1155
1156 return $article->tag_objects;
1157}
1158
59fca225
TC
1159my %base_custom_validation =
1160 (
1161 customDate1 =>
1162 {
1163 rules => "date",
1164 htmltype => "text",
1165 width => 10,
1166 default => "",
ea9b63f1 1167 type => "date",
59fca225
TC
1168 },
1169 customDate2 =>
1170 {
1171 rules => "date",
1172 htmltype => "text",
1173 width => 10,
1174 default => "",
ea9b63f1 1175 type => "date",
59fca225
TC
1176 },
1177 customStr1 =>
1178 {
1179 htmltype => "text",
1180 default => "",
1181 },
1182 customStr2 =>
1183 {
1184 htmltype => "text",
1185 default => "",
1186 },
1187 customInt1 =>
1188 {
1189 rules => "integer",
1190 htmltype => "text",
1191 width => 10,
1192 default => "",
1193 },
1194 customInt2 =>
1195 {
1196 rules => "integer",
1197 htmltype => "text",
1198 width => 10,
1199 default => "",
1200 },
1201 customInt3 =>
1202 {
1203 rules => "integer",
1204 htmltype => "text",
1205 width => 10,
1206 default => "",
1207 },
1208 customInt4 =>
1209 {
1210 rules => "integer",
1211 htmltype => "text",
1212 width => 10,
1213 default => "",
1214 },
1215 );
1216
1217sub custom_fields {
1218 my $self = shift;
1219
1220 require DevHelp::Validate;
1221 DevHelp::Validate->import;
ea9b63f1 1222 my $fields = DevHelp::Validate::dh_configure_fields
59fca225
TC
1223 (
1224 \%base_custom_validation,
1225 $self->cfg,
1226 ARTICLE_CUSTOM_FIELDS_CFG,
1227 BSE::DB->single->dbh,
1228 );
ea9b63f1
TC
1229 my %active;
1230 for my $key (keys %$fields) {
1231 $fields->{$key}{description}
1232 and $active{$key} = $fields->{$key};
1233 }
1234
1235 return \%active;
59fca225
TC
1236}
1237
ca9aa2bf
TC
1238sub low_edit_tags {
1239 my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
1240
1241 my $cgi = $request->cgi;
ab2cd916 1242 my $show_full = $cgi->param('f_showfull');
6a5227d4 1243 my $if_error = $msg || ($errors && keys %$errors) || $request->cgi->param("_e");
c0bf9781
TC
1244 #$msg ||= join "\n", map escape_html($_), $cgi->param('message'), $cgi->param('m');
1245 $msg .= $request->message($errors);
abf5bbc6
TC
1246 my $parent;
1247 if ($article->{id}) {
1248 if ($article->{parentid} > 0) {
1249 $parent = $article->parent;
1250 }
1251 else {
1252 $parent = { title=>"No parent - this is a section", id=>-1 };
1253 }
1254 }
1255 else {
1256 $parent = { title=>"How did we get here?", id=>0 };
1257 }
0580ff34
TC
1258 $request->set_article(article => $article);
1259 $request->set_variable(ifnew => !$article->{id});
62533efa
TC
1260 my $cfg = $self->{cfg};
1261 my $mbcs = $cfg->entry('html', 'mbcs', 0);
1262 my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&tag_hash;
ab2cd916
TC
1263 my $thumbs_obj_real = $self->_get_thumbs_class();
1264 my $thumbs_obj = $show_full ? undef : $thumbs_obj_real;
ca9aa2bf
TC
1265 my @images;
1266 my $image_index;
ab2cd916 1267 my $current_image;
ca9aa2bf
TC
1268 my @children;
1269 my $child_index;
1270 my %stepkids;
ca9aa2bf
TC
1271 my @allkids;
1272 my $allkid_index;
1273 my @possstepkids;
1274 my @stepparents;
1275 my $stepparent_index;
1276 my @stepparent_targs;
1277 my @stepparentpossibles;
1278 my @files;
1279 my $file_index;
c2096d67
TC
1280 my @groups;
1281 my $current_group;
ab2cd916 1282 my $it = BSE::Util::Iterate->new;
76c6b28e 1283 my $ito = BSE::Util::Iterate::Objects->new;
ea71fc0d 1284 my $ita = BSE::Util::Iterate::Article->new(req => $request);
59fca225
TC
1285
1286 my $custom = $self->custom_fields;
3c8f6fb2 1287 # only return the fields that are defined
ea9b63f1 1288 $request->set_variable(custom => $custom);
c0c1747b 1289 $request->set_variable(errors => $errors || {});
59fca225 1290
ca9aa2bf
TC
1291 return
1292 (
58baa27b 1293 $request->admin_tags,
86dc77f9 1294 article => sub { tag_article($article, $cfg, $_[0]) },
ca9aa2bf 1295 old => [ \&tag_old, $article, $cgi ],
9168c88c 1296 default => [ \&tag_default, $self, $request, $article ],
ca9aa2bf
TC
1297 articleType => [ \&tag_art_type, $article->{level}, $cfg ],
1298 parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
918735d1 1299 ifNew => [ \&tag_if_new, $article ],
9168c88c 1300 list => [ \&tag_list, $self, $article, $articles, $cgi, $request ],
ca9aa2bf
TC
1301 script => $ENV{SCRIPT_NAME},
1302 level => $article->{level},
1303 checked => \&tag_checked,
ab2cd916 1304 $it->make_iterator
daee3409 1305 ([ \&iter_get_images, $self, $article ], 'image', 'images', \@images,
ab2cd916 1306 \$image_index, undef, \$current_image),
f40af7e2 1307 image => [ tag_image => $self, $cfg, \$current_image ],
ab2cd916
TC
1308 thumbimage => [ \&tag_thumbimage, $cfg, $thumbs_obj, \$current_image ],
1309 ifThumbs => defined($thumbs_obj),
1310 ifCanThumbs => defined($thumbs_obj_real),
abf5bbc6 1311 imgmove => [ \&tag_imgmove, $request, $article, \$image_index, \@images ],
ca9aa2bf 1312 message => $msg,
6a5227d4 1313 ifError => $if_error,
ea71fc0d
TC
1314 $ita->make
1315 (
1316 code => [ \&iter_get_kids, $article, $articles ],
1317 single => 'child',
1318 plural => 'children',
1319 data => \@children,
1320 index => \$child_index,
1321 ),
ca9aa2bf
TC
1322 ifchildren => \&tag_if_children,
1323 childtype => [ \&tag_art_type, $article->{level}+1, $cfg ],
1324 ifHaveChildType => [ \&tag_if_have_child_type, $article->{level}, $cfg ],
abf5bbc6
TC
1325 movechild => [ \&tag_movechild, $self, $request, $article, \@children,
1326 \$child_index],
ca9aa2bf
TC
1327 is => \&tag_is,
1328 templates => [ \&tag_templates, $self, $article, $cfg, $cgi ],
1329 titleImages => [ \&tag_title_images, $self, $article, $cfg, $cgi ],
1330 editParent => [ \&tag_edit_parent, $article ],
ea71fc0d
TC
1331 $ita->make
1332 (
1333 code => [ \&iter_allkids, $article ],
1334 single => 'kid',
1335 plural => 'kids',
1336 data => \@allkids,
1337 index => \$allkid_index,
1338 ),
ca9aa2bf
TC
1339 ifStepKid =>
1340 [ \&tag_if_step_kid, $article, \@allkids, \$allkid_index, \%stepkids ],
1341 stepkid => [ \&tag_step_kid, $article, \@allkids, \$allkid_index,
1342 \%stepkids ],
1343 movestepkid =>
31a26b52
TC
1344 [ \&tag_move_stepkid, $self, $cgi, $request, $article, \@allkids,
1345 \$allkid_index ],
ca9aa2bf 1346 possible_stepkids =>
31a26b52
TC
1347 [ \&tag_possible_stepkids, \%stepkids, $request, $article,
1348 \@possstepkids, $articles, $cgi ],
ca9aa2bf 1349 ifPossibles =>
31a26b52
TC
1350 [ \&tag_if_possible_stepkids, \%stepkids, $request, $article,
1351 \@possstepkids, $articles, $cgi ],
ea71fc0d
TC
1352 $ita->make
1353 (
1354 code => [ \&iter_get_stepparents, $article ],
1355 single => 'stepparent',
1356 plural => 'stepparents',
1357 data => \@stepparents,
1358 index => \$stepparent_index,
1359 ),
ca9aa2bf
TC
1360 ifStepParents => \&tag_ifStepParents,
1361 stepparent_targ =>
1362 [ \&tag_stepparent_targ, $article, \@stepparent_targs,
1363 \$stepparent_index ],
1364 movestepparent =>
31a26b52 1365 [ \&tag_move_stepparent, $self, $cgi, $request, $article, \@stepparents,
ca9aa2bf
TC
1366 \$stepparent_index ],
1367 ifStepparentPossibles =>
31a26b52
TC
1368 [ \&tag_if_stepparent_possibles, $request, $article, $articles,
1369 \@stepparent_targs, \@stepparentpossibles, ],
ca9aa2bf 1370 stepparent_possibles =>
31a26b52 1371 [ \&tag_stepparent_possibles, $cgi, $request, $article, $articles,
ca9aa2bf 1372 \@stepparent_targs, \@stepparentpossibles, ],
f738f7b4
TC
1373 $ito->make
1374 (
1375 code => [ iter_files => $self, $article ],
1376 single => 'file',
1377 plural => 'files',
1378 data => \@files,
1379 index => \$file_index,
1380 ),
abf5bbc6
TC
1381 movefiles =>
1382 [ \&tag_movefiles, $self, $request, $article, \@files, \$file_index ],
d745f64f
TC
1383 $it->make
1384 (
1385 code => [ iter_file_metas => $self, \@files, \$file_index ],
1386 plural => "file_metas",
1387 single => "file_meta",
1388 nocache => 1,
1389 ),
e05b1657
TC
1390 ifFileExists => sub {
1391 @files && $file_index >= 0 && $file_index < @files
1392 or return 0;
1393
1394 return -f ($files[$file_index]->full_filename($cfg));
1395 },
8aa7eb30 1396 file_display => [ tag_file_display => $self, \@files, \$file_index ],
08123550
TC
1397 DevHelp::Tags->make_iterator2
1398 (\&iter_admin_users, 'iadminuser', 'adminusers'),
1399 DevHelp::Tags->make_iterator2
1400 (\&iter_admin_groups, 'iadmingroup', 'admingroups'),
f2bf0d11 1401 edit => [ \&tag_edit_link, $cfg, $article ],
62533efa 1402 error => [ $tag_hash, $errors ],
b553afa2 1403 error_img => [ \&tag_error_img, $cfg, $errors ],
9168c88c 1404 ifFieldPerm => [ \&tag_if_field_perm, $request, $article ],
ea71fc0d 1405 parent => [ \&tag_article, $parent, $cfg ],
918735d1
TC
1406 DevHelp::Tags->make_iterator2
1407 ([ \&iter_flags, $self ], 'flag', 'flags' ),
1408 ifFlagSet => [ \&tag_if_flag_set, $article ],
8b0b2f34
TC
1409 DevHelp::Tags->make_iterator2
1410 ([ \&iter_crumbs, $article, $articles ], 'crumb', 'crumbs' ),
1411 typename => \&tag_typename,
c2096d67
TC
1412 $it->make_iterator([ \&iter_groups, $request ],
1413 'group', 'groups', \@groups, undef, undef,
1414 \$current_group),
e63c3728
TC
1415 $it->make_iterator([ iter_image_stores => $self],
1416 'image_store', 'image_stores'),
1417 $it->make_iterator([ iter_file_stores => $self],
1418 'file_store', 'file_stores'),
c2096d67 1419 ifGroupRequired => [ \&tag_ifGroupRequired, $article, \$current_group ],
dbfbfb12 1420 category => [ tag_category => $self, $articles, $article ],
76c6b28e
TC
1421 $ito->make
1422 (
1423 single => "tag",
1424 plural => "tags",
1425 code => [ iter_tags => $self, $article ],
1426 ),
ca9aa2bf
TC
1427 );
1428}
1429
e63c3728
TC
1430sub iter_image_stores {
1431 my ($self) = @_;
1432
1433 my $mgr = $self->_image_manager;
1434
1435 return map +{ name => $_->name, description => $_->description },
1436 $mgr->all_stores;
1437}
1438
1439sub _file_manager {
1440 my ($self) = @_;
1441
7646d96e 1442 require BSE::TB::ArticleFiles;
e63c3728 1443
7646d96e 1444 return BSE::TB::ArticleFiles->file_manager($self->cfg);
e63c3728
TC
1445}
1446
1447sub iter_file_stores {
1448 my ($self) = @_;
1449
7646d96e
TC
1450 require BSE::TB::ArticleFiles;
1451 my $mgr = $self->_file_manager($self->cfg);
e63c3728
TC
1452
1453 return map +{ name => $_->name, description => $_->description },
1454 $mgr->all_stores;
1455}
1456
c2096d67
TC
1457sub iter_groups {
1458 my ($req) = @_;
1459
1460 require BSE::TB::SiteUserGroups;
1461 BSE::TB::SiteUserGroups->admin_and_query_groups($req->cfg);
1462}
1463
1464sub tag_ifGroupRequired {
1465 my ($article, $rgroup) = @_;
1466
b876ce1c
TC
1467 $article->{id}
1468 or return 0;
1469
c2096d67
TC
1470 $$rgroup or return 0;
1471
1472 $article->is_accessible_to($$rgroup);
1473}
1474
ca9aa2bf
TC
1475sub edit_template {
1476 my ($self, $article, $cgi) = @_;
1477
1478 my $base = $article->{level};
1479 my $t = $cgi->param('_t');
1480 if ($t && $t =~ /^\w+$/) {
1481 $base = $t;
1482 }
1483 return $self->{cfg}->entry('admin templates', $base,
1484 "admin/edit_$base");
1485}
1486
1487sub add_template {
1488 my ($self, $article, $cgi) = @_;
1489
1490 $self->edit_template($article, $cgi);
1491}
1492
1493sub low_edit_form {
1494 my ($self, $request, $article, $articles, $msg, $errors) = @_;
1495
1496 my $cgi = $request->cgi;
1497 my %acts;
1498 %acts = $self->low_edit_tags(\%acts, $request, $article, $articles, $msg,
1499 $errors);
1500 my $template = $article->{id} ?
1501 $self->edit_template($article, $cgi) : $self->add_template($article, $cgi);
1502
f2bf0d11 1503 return $request->response($template, \%acts);
ca9aa2bf
TC
1504}
1505
1506sub edit_form {
1507 my ($self, $request, $article, $articles, $msg, $errors) = @_;
1508
1509 return $self->low_edit_form($request, $article, $articles, $msg, $errors);
1510}
1511
aa6896b6
TC
1512sub _dummy_article {
1513 my ($self, $req, $articles, $rmsg) = @_;
ca9aa2bf
TC
1514
1515 my $level;
9168c88c 1516 my $cgi = $req->cgi;
ca9aa2bf
TC
1517 my $parentid = $cgi->param('parentid');
1518 if ($parentid) {
1519 if ($parentid =~ /^\d+$/) {
1520 if (my $parent = $self->get_parent($parentid, $articles)) {
1521 $level = $parent->{level}+1;
1522 }
1523 else {
1524 $parentid = undef;
1525 }
1526 }
1527 elsif ($parentid eq "-1") {
1528 $level = 1;
1529 }
1530 }
1531 unless (defined $level) {
1532 $level = $cgi->param('level');
1533 undef $level unless defined $level && $level =~ /^\d+$/
1534 && $level > 0 && $level < 100;
1535 defined $level or $level = 3;
1536 }
1537
1538 my %article;
1539 my @cols = Article->columns;
1540 @article{@cols} = ('') x @cols;
1541 $article{id} = '';
1542 $article{parentid} = $parentid;
1543 $article{level} = $level;
1544 $article{body} = '<maximum of 64Kb>';
1545 $article{listed} = 1;
1546 $article{generator} = $self->generator;
1547
9168c88c 1548 my ($values, $labels) = $self->possible_parents(\%article, $articles, $req);
1b02d672 1549 unless (@$values) {
aa6896b6
TC
1550 $$rmsg = "You can't add children to any article at that level";
1551 return;
1552 }
1553
1554 return \%article;
1555}
1556
1557sub add_form {
d62f54f7 1558 my ($self, $req, $article, $articles, $msg, $errors) = @_;
9168c88c 1559
aa6896b6 1560 return $self->low_edit_form($req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
1561}
1562
1563sub generator { 'Generate::Article' }
1564
331fd099
TC
1565sub typename {
1566 my ($self) = @_;
1567
1568 my $gen = $self->generator;
1569
1570 ($gen =~ /(\w+)$/)[0] || 'Article';
1571}
1572
ca9aa2bf 1573sub _validate_common {
b553afa2 1574 my ($self, $data, $articles, $errors, $article) = @_;
ca9aa2bf 1575
918735d1
TC
1576# if (defined $data->{parentid} && $data->{parentid} =~ /^(?:-1|\d+)$/) {
1577# unless ($data->{parentid} == -1 or
1578# $articles->getByPkey($data->{parentid})) {
1579# $errors->{parentid} = "Selected parent article doesn't exist";
1580# }
1581# }
1582# else {
1583# $errors->{parentid} = "You need to select a valid parent";
1584# }
1585 if (exists $data->{title} && $data->{title} !~ /\S/) {
1586 $errors->{title} = "Please enter a title";
ca9aa2bf
TC
1587 }
1588
1589 if (exists $data->{template} && $data->{template} =~ /\.\./) {
1590 $errors->{template} = "Please only select templates from the list provided";
1591 }
c76e86ea
TC
1592 if (exists $data->{linkAlias}
1593 && length $data->{linkAlias}) {
90ee1626 1594 unless ($data->{linkAlias} =~ /\A[a-zA-Z0-9-_]+\z/
c76e86ea
TC
1595 && $data->{linkAlias} =~ /[A-Za-z]/) {
1596 $errors->{linkAlias} = "Link alias must contain only alphanumerics and contain at least one letter";
1597 }
1598 }
dbfbfb12
TC
1599
1600 if (defined $data->{category}) {
1601 unless (first { $_->{id} eq $data->{category} } $self->categories($articles)) {
1602 $errors->{category} = "msg:bse/admin/edit/category/unknown";
1603 }
1604 }
59fca225
TC
1605
1606 require DevHelp::Validate;
1607 DevHelp::Validate->import('dh_validate_hash');
1608 dh_validate_hash($data, $errors,
1609 {
1610 fields => $self->custom_fields,
1611 optional => 1,
b311d086 1612 dbh => BSE::DB->single->dbh,
59fca225
TC
1613 },
1614 $self->cfg, ARTICLE_CUSTOM_FIELDS_CFG);
ca9aa2bf
TC
1615}
1616
1617sub validate {
918735d1 1618 my ($self, $data, $articles, $errors) = @_;
ca9aa2bf
TC
1619
1620 $self->_validate_common($data, $articles, $errors);
c76e86ea
TC
1621 if (!$errors->{linkAlias} && defined $data->{linkAlias} && length $data->{linkAlias}) {
1622 my $other = $articles->getBy(linkAlias => $data->{linkAlias});
1623 $other
1624 and $errors->{linkAlias} =
1625 "Duplicate link alias - already used by article $other->{id}";
1626 }
331fd099
TC
1627 custom_class($self->{cfg})
1628 ->article_validate($data, undef, $self->typename, $errors);
ca9aa2bf
TC
1629
1630 return !keys %$errors;
1631}
1632
1633sub validate_old {
8f88bb20 1634 my ($self, $article, $data, $articles, $errors, $ajax) = @_;
ca9aa2bf 1635
b553afa2 1636 $self->_validate_common($data, $articles, $errors, $article);
331fd099
TC
1637 custom_class($self->{cfg})
1638 ->article_validate($data, $article, $self->typename, $errors);
ca9aa2bf 1639
8f88bb20
TC
1640 if (exists $data->{release}) {
1641 if ($ajax && !dh_parse_sql_date($data->{release})
1642 || !$ajax && !dh_parse_date($data->{release})) {
1643 $errors->{release} = "Invalid release date";
1644 }
b553afa2
TC
1645 }
1646
c76e86ea
TC
1647 if (!$errors->{linkAlias}
1648 && defined $data->{linkAlias}
1649 && length $data->{linkAlias}
1650 && $data->{linkAlias} ne $article->{linkAlias}) {
1651 my $other = $articles->getBy(linkAlias => $data->{linkAlias});
90ee1626 1652 $other && $other->{id} != $article->{id}
c76e86ea
TC
1653 and $errors->{linkAlias} = "Duplicate link alias - already used by article $other->{id}";
1654 }
1655
ca9aa2bf
TC
1656 return !keys %$errors;
1657}
1658
1659sub validate_parent {
1660 1;
1661}
1662
1663sub fill_new_data {
1664 my ($self, $req, $data, $articles) = @_;
1665
59fca225
TC
1666 my $custom = $self->custom_fields;
1667 for my $key (keys %$custom) {
1668 my ($value) = $req->cgi->param($key);
ea9b63f1 1669 if (defined $value) {
59fca225 1670 if ($key =~ /^customDate/) {
ea9b63f1
TC
1671 require DevHelp::Date;
1672 my $msg;
1673 if (my ($year, $month, $day) =
1674 DevHelp::Date::dh_parse_date($value, \$msg)) {
1675 $data->{$key} = sprintf("%04d-%02d-%02d", $year, $month, $day);
59fca225
TC
1676 }
1677 else {
1678 $data->{$key} = undef;
1679 }
1680 }
1681 elsif ($key =~ /^customInt/) {
1682 if ($value =~ /\S/) {
1683 $data->{$key} = $value;
1684 }
1685 else {
1686 $data->{$key} = undef;
1687 }
1688 }
1689 else {
1690 $data->{$key} = $value;
1691 }
1692 }
1693 }
1694
331fd099
TC
1695 custom_class($self->{cfg})
1696 ->article_fill_new($data, $self->typename);
1697
ca9aa2bf
TC
1698 1;
1699}
1700
95989433
TC
1701sub link_path {
1702 my ($self, $article) = @_;
1703
1704 # check the config for the article and any of its ancestors
1705 my $work_article = $article;
1706 my $path = $self->{cfg}->entry('article uris', $work_article->{id});
1707 while (!$path) {
1708 last if $work_article->{parentid} == -1;
1709 $work_article = $work_article->parent;
1710 $path = $self->{cfg}->entry('article uris', $work_article->{id});
1711 }
1712 return $path if $path;
1713
1714 $self->default_link_path($article);
1715}
1716
1717sub default_link_path {
1718 my ($self, $article) = @_;
1719
1720 $self->{cfg}->entry('uri', 'articles', '/a');
1721}
1722
ca9aa2bf
TC
1723sub make_link {
1724 my ($self, $article) = @_;
1725
a739c25d
TC
1726 $article->is_linked
1727 or return "";
1728
3f9c8a96 1729 my $title = $article->title;
efcc5a30 1730 if ($article->is_dynamic) {
d4336bdc
TC
1731 (my $extra = $title) =~ tr/A-Za-z0-9/-/sc;
1732 return "/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($extra);
efcc5a30
TC
1733 }
1734
95989433 1735 my $article_uri = $self->link_path($article);
ca9aa2bf
TC
1736 my $link = "$article_uri/$article->{id}.html";
1737 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1738 if ($link_titles) {
d4336bdc 1739 (my $extra = $title) =~ tr/A-Za-z0-9/-/sc;
d7538448 1740 $link .= "/" . $extra . "_html";
ca9aa2bf
TC
1741 }
1742
1743 $link;
1744}
1745
dfd483db
TC
1746sub save_columns {
1747 my ($self, $table_object) = @_;
1748
0e4b5b38
TC
1749 my @columns = $table_object->rowClass->columns;
1750 shift @columns;
1751
1752 return @columns;
dfd483db
TC
1753}
1754
ca9aa2bf 1755sub save_new {
d62f54f7 1756 my ($self, $req, $article, $articles) = @_;
aa6896b6
TC
1757
1758 $req->check_csrf("admin_add_article")
1759 or return $self->csrf_error($req, undef, "admin_add_article", "Add Article");
ca9aa2bf
TC
1760
1761 my $cgi = $req->cgi;
1762 my %data;
1763 my $table_object = $self->table_object($articles);
dfd483db 1764 my @columns = $self->save_columns($table_object);
ca9aa2bf
TC
1765 $self->save_thumbnail($cgi, undef, \%data);
1766 for my $name (@columns) {
9168c88c
TC
1767 $data{$name} = $cgi->param($name)
1768 if defined $cgi->param($name);
ca9aa2bf 1769 }
918735d1 1770 $data{flags} = join '', sort $cgi->param('flags');
ca9aa2bf
TC
1771
1772 my $msg;
1773 my %errors;
718a070d
TC
1774 if (!defined $data{parentid} || $data{parentid} eq '') {
1775 $errors{parentid} = "Please select a parent";
1776 }
1777 elsif ($data{parentid} !~ /^(?:-1|\d+)$/) {
1778 $errors{parentid} = "Invalid parent selection (template bug)";
1779 }
39c06424 1780 $self->validate(\%data, $articles, \%errors);
76c6b28e
TC
1781
1782 my $save_tags = $cgi->param("_save_tags");
1783 my @tags;
1784 if ($save_tags) {
1785 @tags = grep /\S/, $cgi->param("tags");
1786 my $error;
1787 for my $tag (@tags) {
1788 BSE::TB::Tags->valid_name($tag, \$error)
1789 or last;
1790 }
1791 if ($error) {
1792 $errors{tags} = "msg:bse/admin/edit/badtag/$error";
1793 }
1794 }
1795
39c06424
TC
1796 if (keys %errors) {
1797 if ($req->is_ajax) {
1798 return $req->json_content
1799 (
1800 success => 0,
1801 errors => \%errors,
1802 error_code => "FIELD",
1803 message => $req->message(\%errors),
1804 );
1805 }
1806 else {
d62f54f7 1807 return $self->add_form($req, $article, $articles, $msg, \%errors);
39c06424
TC
1808 }
1809 }
ca9aa2bf
TC
1810
1811 my $parent;
39c06424
TC
1812 my $parent_msg;
1813 my $parent_code;
ca9aa2bf
TC
1814 if ($data{parentid} > 0) {
1815 $parent = $articles->getByPkey($data{parentid}) or die;
39c06424
TC
1816 if ($req->user_can('edit_add_child', $parent)) {
1817 for my $name (@columns) {
1818 if (exists $data{$name} &&
1819 !$req->user_can("edit_add_field_$name", $parent)) {
1820 delete $data{$name};
1821 }
9168c88c
TC
1822 }
1823 }
39c06424
TC
1824 else {
1825 $parent_msg = "You cannot add a child to that article";
1826 $parent_code = "ACCESS";
1827 }
ca9aa2bf 1828 }
9168c88c 1829 else {
39c06424
TC
1830 if ($req->user_can('edit_add_child')) {
1831 for my $name (@columns) {
1832 if (exists $data{$name} &&
1833 !$req->user_can("edit_add_field_$name")) {
1834 delete $data{$name};
1835 }
9168c88c
TC
1836 }
1837 }
39c06424
TC
1838 else {
1839 $parent_msg = "You cannot create a top-level article";
1840 $parent_code = "ACCESS";
1841 }
1842 }
1843 if (!$parent_msg) {
1844 $self->validate_parent(\%data, $articles, $parent, \$parent_msg)
1845 or $parent_code = "PARENT";
1846 }
1847 if ($parent_msg) {
1848 if ($req->is_ajax) {
1849 return $req->json_content
1850 (
1851 success => 0,
1852 message => $parent_msg,
1853 error_code => $parent_code,
1854 errors => {},
1855 );
1856 }
1857 else {
d62f54f7 1858 return $self->add_form($req, $article, $articles, $parent_msg);
39c06424 1859 }
9168c88c 1860 }
ca9aa2bf 1861
ca9aa2bf 1862 my $level = $parent ? $parent->{level}+1 : 1;
0ec4ac8a 1863 $data{level} = $level;
9168c88c 1864 $data{displayOrder} = time;
ca9aa2bf
TC
1865 $data{link} ||= '';
1866 $data{admin} ||= '';
ca9aa2bf 1867 $data{generator} = $self->generator;
41f10371 1868 $data{lastModified} = now_sqldatetime();
ca9aa2bf
TC
1869 $data{listed} = 1 unless defined $data{listed};
1870
9604a90c
TC
1871# Added by adrian
1872 $data{pageTitle} = '' unless defined $data{pageTitle};
1873 my $user = $req->getuser;
1874 $data{createdBy} = $user ? $user->{logon} : '';
1875 $data{lastModifiedBy} = $user ? $user->{logon} : '';
1876 $data{created} = now_sqldatetime();
12bcb7ac
TC
1877# end adrian
1878
efcc5a30
TC
1879 $data{force_dynamic} = 0;
1880 $data{cached_dynamic} = 0;
1881 $data{inherit_siteuser_rights} = 1;
9604a90c 1882
12bcb7ac
TC
1883# Added by adrian
1884 $data{metaDescription} = '' unless defined $data{metaDescription};
1885 $data{metaKeywords} = '' unless defined $data{metaKeywords};
1886# end adrian
1887
0ec4ac8a 1888 $self->fill_new_data($req, \%data, $articles);
dbfbfb12 1889 for my $col (qw(titleImage imagePos template keyword menu titleAlias linkAlias body author summary category)) {
0ec4ac8a
TC
1890 defined $data{$col}
1891 or $data{$col} = $self->default_value($req, \%data, $col);
1892 }
1893
c2096d67
TC
1894 for my $col (qw/force_dynamic inherit_siteuser_rights/) {
1895 if ($req->user_can("edit_add_field_$col", $parent)
1896 && $cgi->param("save_$col")) {
1897 $data{$col} = $cgi->param($col) ? 1 : 0;
1898 }
1899 else {
1900 $data{$col} = $self->default_value($req, \%data, $col);
1901 }
1902 }
1903
8f88bb20
TC
1904 unless ($req->is_ajax) {
1905 for my $col (qw(release expire)) {
1906 $data{$col} = sql_date($data{$col});
1907 }
718a070d
TC
1908 }
1909
0ec4ac8a 1910 # these columns are handled a little differently
d7538448 1911 for my $col (qw(release expire threshold summaryLength )) {
0ec4ac8a
TC
1912 $data{$col}
1913 or $data{$col} = $self->default_value($req, \%data, $col);
1914 }
1915
dfd483db
TC
1916 my @cols = $table_object->rowClass->columns;
1917 shift @cols;
0e4b5b38
TC
1918
1919 # fill out anything else from defaults
1920 for my $col (@columns) {
1921 exists $data{$col}
1922 or $data{$col} = $self->default_value($req, \%data, $col);
1923 }
1924
dfd483db
TC
1925 $article = $table_object->add(@data{@cols});
1926
1927 $self->save_new_more($req, $article, \%data);
ca9aa2bf
TC
1928
1929 # we now have an id - generate the links
1930
a319d280 1931 $article->update_dynamic($self->{cfg});
ca9aa2bf
TC
1932 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1933 $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1934 $article->setLink($self->make_link($article));
1935 $article->save();
1936
78218ca8
TC
1937 my ($after_id) = $cgi->param("_after");
1938 if (defined $after_id) {
1939 Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
1940 # reload, the displayOrder probably changed
1941 $article = $articles->getByPkey($article->{id});
1942 }
1943
76c6b28e
TC
1944 if ($save_tags) {
1945 my $error;
1946 $article->set_tags(\@tags, \$error);
1947 }
1948
caa7299c
TC
1949 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1950
8f88bb20 1951 if ($req->is_ajax) {
8f88bb20
TC
1952 return $req->json_content
1953 (
1954 {
1955 success => 1,
1956 article => $self->_article_data($req, $article),
1957 },
1958 );
1959 }
1960
8b0b2f34
TC
1961 my $r = $cgi->param('r');
1962 if ($r) {
1963 $r .= ($r =~ /\?/) ? '&' : '?';
1964 $r .= "id=$article->{id}";
1965 }
1966 else {
41f10371 1967 $r = admin_base_url($req->cfg) . $article->{admin};
8b0b2f34
TC
1968 }
1969 return BSE::Template->get_refresh($r, $self->{cfg});
ca9aa2bf
TC
1970}
1971
1972sub fill_old_data {
0d5ccc7f 1973 my ($self, $req, $article, $data) = @_;
ca9aa2bf 1974
4010d92e
TC
1975 if (exists $data->{body}) {
1976 $data->{body} =~ s/\x0D\x0A/\n/g;
1977 $data->{body} =~ tr/\r/\n/;
1978 }
ca9aa2bf 1979 for my $col (Article->columns) {
331fd099 1980 next if $col =~ /^custom/;
ca9aa2bf
TC
1981 $article->{$col} = $data->{$col}
1982 if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1983 }
59fca225
TC
1984 my $custom = $self->custom_fields;
1985 for my $key (keys %$custom) {
ea9b63f1 1986 if (exists $data->{$key}) {
59fca225 1987 if ($key =~ /^customDate/) {
ea9b63f1
TC
1988 require DevHelp::Date;
1989 my $msg;
1990 if (my ($year, $month, $day) =
1991 DevHelp::Date::dh_parse_date($data->{$key}, \$msg)) {
1992 $article->set($key, sprintf("%04d-%02d-%02d", $year, $month, $day));
59fca225
TC
1993 }
1994 else {
1995 $article->set($key => undef);
1996 }
1997 }
1998 elsif ($key =~ /^customInt/) {
1999 if ($data->{$key} =~ /\S/) {
2000 $article->set($key => $data->{$key});
2001 }
2002 else {
2003 $article->set($key => undef);
2004 }
2005 }
2006 else {
2007 $article->set($key => $data->{$key});
2008 }
2009 }
2010 }
331fd099
TC
2011 custom_class($self->{cfg})
2012 ->article_fill_old($article, $data, $self->typename);
ca9aa2bf
TC
2013
2014 return 1;
2015}
2016
8f88bb20
TC
2017sub _article_data {
2018 my ($self, $req, $article) = @_;
2019
2020 my $article_data = $article->data_only;
2021 $article_data->{link} = $article->link($req->cfg);
2022 $article_data->{images} =
2023 [
ca6c0ac9 2024 map $self->_image_data($req->cfg, $_), $article->images
8f88bb20
TC
2025 ];
2026 $article_data->{files} =
2027 [
2028 map $_->data_only, $article->files,
2029 ];
76c6b28e
TC
2030 $article_data->{tags} =
2031 [
2032 $article->tags, # just the names
2033 ];
8f88bb20
TC
2034
2035 return $article_data;
2036}
2037
dfd483db
TC
2038sub save_more {
2039 my ($self, $req, $article, $data) = @_;
2040 # nothing to do here
2041}
2042
2043sub save_new_more {
2044 my ($self, $req, $article, $data) = @_;
2045 # nothing to do here
2046}
2047
bf149413
TC
2048=item save
2049
2050Error codes:
2051
2052=over
2053
2054=item *
2055
2056ACCESS - user doesn't have access to this article.
2057
2058=item *
2059
2060LASTMOD - lastModified value doesn't match that in the article
2061
2062=item *
2063
2064PARENT - invalid parentid specified
2065
2066=back
2067
2068=cut
2069
ca9aa2bf
TC
2070sub save {
2071 my ($self, $req, $article, $articles) = @_;
4010d92e 2072
aa6896b6
TC
2073 $req->check_csrf("admin_save_article")
2074 or return $self->csrf_error($req, $article, "admin_save_article", "Save Article");
2075
4010d92e 2076 $req->user_can(edit_save => $article)
bf149413
TC
2077 or return $self->_service_error
2078 ($req, $article, $articles, "You don't have access to save this article",
2079 {}, "ACCESS");
efcc5a30
TC
2080
2081 my $old_dynamic = $article->is_dynamic;
ca9aa2bf
TC
2082 my $cgi = $req->cgi;
2083 my %data;
dfd483db
TC
2084 my $table_object = $self->table_object($articles);
2085 my @save_cols = $self->save_columns($table_object);
2086 for my $name (@save_cols) {
ca9aa2bf 2087 $data{$name} = $cgi->param($name)
abf5bbc6
TC
2088 if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid'
2089 && $req->user_can("edit_field_edit_$name", $article);
ca9aa2bf 2090 }
12b42a0b
TC
2091
2092# Added by adrian
2093# checks editor lastModified against record lastModified
2094 if ($self->{cfg}->entry('editor', 'check_modified')) {
2095 if ($article->{lastModified} ne $cgi->param('lastModified')) {
2096 my $whoModified = '';
2097 my $timeModified = ampm_time($article->{lastModified});
2098 if ($article->{lastModifiedBy}) {
2099 $whoModified = "by '$article->{lastModifiedBy}'";
2100 }
2101 print STDERR "non-matching lastModified, article not saved\n";
2102 my $msg = "Article changes not saved, this article was modified $whoModified at $timeModified since this editor was loaded";
bf149413 2103 return $self->_service_error($req, $article, $articles, $msg, {}, "LASTMOD");
12b42a0b
TC
2104 }
2105 }
2106# end adrian
2107
918735d1
TC
2108 # possibly this needs tighter error checking
2109 $data{flags} = join '', sort $cgi->param('flags')
2110 if $req->user_can("edit_field_edit_flags", $article);
ca9aa2bf 2111 my %errors;
bf149413
TC
2112 if (exists $article->{template} &&
2113 $article->{template} =~ m|\.\.|) {
2114 $errors{template} = "Please only select templates from the list provided";
2115 }
76c6b28e
TC
2116
2117 my $save_tags = $cgi->param("_save_tags");
2118 my @tags;
2119 if ($save_tags) {
2120 @tags = grep /\S/, $cgi->param("tags");
2121 my $error;
2122 for my $tag (@tags) {
2123 BSE::TB::Tags->valid_name($tag, \$error)
2124 or last;
2125 }
2126 if ($error) {
2127 $errors{tags} = "msg:bse/admin/edit/badtag/$error";
2128 }
2129 }
8f88bb20 2130 $self->validate_old($article, \%data, $articles, \%errors, scalar $req->is_ajax)
bf149413 2131 or return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD");
abf5bbc6
TC
2132 $self->save_thumbnail($cgi, $article, \%data)
2133 if $req->user_can('edit_field_edit_thumbImage', $article);
70c6e1e1 2134 if (exists $data{flags} && $data{flags} =~ /D/) {
a739c25d
TC
2135 $article->remove_html;
2136 }
ca9aa2bf 2137 $self->fill_old_data($req, $article, \%data);
12b42a0b 2138
ca9aa2bf
TC
2139 # reparenting
2140 my $newparentid = $cgi->param('parentid');
6d91d9dc
TC
2141 if ($newparentid
2142 && $req->user_can('edit_field_edit_parentid', $article)
2143 && $newparentid != $article->{parentid}) {
2144 my $newparent;
2145 my $parent_editor;
2146 if ($newparentid == -1) {
2147 require BSE::Edit::Site;
2148 $newparent = BSE::TB::Site->new;
2149 $parent_editor = BSE::Edit::Site->new(cfg => $req->cfg);
abf5bbc6 2150 }
6d91d9dc
TC
2151 else {
2152 $newparent = $articles->getByPkey($newparentid);
2153 ($parent_editor, $newparent) = $self->article_class($newparent, $articles, $req->cfg);
2154 }
2155 if ($newparent) {
2156 my $msg;
2157 if ($self->can_reparent_to($article, $newparent, $parent_editor, $articles, \$msg)
2158 && $self->reparent($article, $newparentid, $articles, \$msg)) {
2159 # nothing to do here
2160 }
2161 else {
2162 return $self->_service_error($req, $article, $articles, $msg, {}, "PARENT");
ca9aa2bf 2163 }
abf5bbc6
TC
2164 }
2165 else {
6d91d9dc 2166 return $self->_service_error($req, $article, $articles, "No such parent article", {}, "PARENT");
ca9aa2bf 2167 }
ca9aa2bf
TC
2168 }
2169
abf5bbc6 2170 $article->{listed} = $cgi->param('listed')
63e99d77 2171 if defined $cgi->param('listed') &&
abf5bbc6 2172 $req->user_can('edit_field_edit_listed', $article);
8f88bb20
TC
2173
2174 if ($req->user_can('edit_field_edit_release', $article)) {
2175 my $release = $cgi->param("release");
2176 if (defined $release && $release =~ /\S/) {
2177 if ($req->is_ajax) {
2178 $article->{release} = $release;
2179 }
2180 else {
2181 $article->{release} = sql_date($release)
2182 }
2183 }
2184 }
2185
abf5bbc6
TC
2186 $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99
2187 if defined $cgi->param('expire') &&
2188 $req->user_can('edit_field_edit_expire', $article);
c2096d67
TC
2189 for my $col (qw/force_dynamic inherit_siteuser_rights/) {
2190 if ($req->user_can("edit_field_edit_$col", $article)
2191 && $cgi->param("save_$col")) {
2192 $article->{$col} = $cgi->param($col) ? 1 : 0;
2193 }
2194 }
2195
46e71678 2196 $article->mark_modified(actor => $req->getuser || "U");
c2096d67
TC
2197
2198 my @save_group_ids = $cgi->param('save_group_id');
2199 if ($req->user_can('edit_field_edit_group_id')
2200 && @save_group_ids) {
2201 require BSE::TB::SiteUserGroups;
2202 my %groups = map { $_->{id} => $_ }
2203 BSE::TB::SiteUserGroups->admin_and_query_groups($self->{cfg});
2204 my %set = map { $_ => 1 } $cgi->param('group_id');
2205 my %current = map { $_ => 1 } $article->group_ids;
2206
2207 for my $group_id (@save_group_ids) {
2208 $groups{$group_id} or next;
2209 if ($current{$group_id} && !$set{$group_id}) {
2210 $article->remove_group_id($group_id);
2211 }
2212 elsif (!$current{$group_id} && $set{$group_id}) {
2213 $article->add_group_id($group_id);
2214 }
2215 }
efcc5a30
TC
2216 }
2217
63e99d77 2218 my $old_link = $article->{link};
efcc5a30
TC
2219 # this need to go last
2220 $article->update_dynamic($self->{cfg});
a739c25d 2221 if (!$self->{cfg}->entry('protect link', $article->{id})) {
95989433 2222 my $article_uri = $self->make_link($article);
95989433 2223 $article->setLink($article_uri);
ca9aa2bf
TC
2224 }
2225
2226 $article->save();
caa7299c 2227
76c6b28e
TC
2228 if ($save_tags) {
2229 my $error;
2230 $article->set_tags(\@tags, \$error);
2231 }
2232
63e99d77 2233 # fix the kids too
efcc5a30 2234 my @extra_regen;
63e99d77
TC
2235 @extra_regen = $self->update_child_dynamic($article, $articles, $req);
2236
2237 if ($article->is_dynamic || $old_dynamic) {
2238 if (!$old_dynamic and $old_link) {
2239 unlink $article->link_to_filename($self->{cfg}, $old_link);
2240 }
16901a2a
TC
2241 elsif (!$article->is_dynamic) {
2242 unlink $article->cached_filename($self->{cfg});
2243 }
efcc5a30
TC
2244 }
2245
91fad97a
TC
2246 my ($after_id) = $cgi->param("_after");
2247 if (defined $after_id) {
2248 Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
2249 # reload, the displayOrder probably changed
2250 $article = $articles->getByPkey($article->{id});
2251 }
2252
efcc5a30
TC
2253 if ($Constants::AUTO_GENERATE) {
2254 generate_article($articles, $article);
2255 for my $regen_id (@extra_regen) {
2256 my $regen = $articles->getByPkey($regen_id);
f48fc7cf 2257 BSE::Regen::generate_low($articles, $regen, $self->{cfg});
efcc5a30
TC
2258 }
2259 }
caa7299c 2260
dfd483db
TC
2261 $self->save_more($req, $article, \%data);
2262
8f88bb20
TC
2263 if ($req->is_ajax) {
2264 return $req->json_content
2265 (
2266 {
2267 success => 1,
2268 article => $self->_article_data($req, $article),
2269 },
2270 );
2271 }
2272
8b0b2f34 2273 return $self->refresh($article, $cgi, undef, 'Article saved');
ca9aa2bf
TC
2274}
2275
6d91d9dc
TC
2276sub can_reparent_to {
2277 my ($self, $article, $newparent, $parent_editor, $articles, $rmsg) = @_;
2278
6d91d9dc
TC
2279 my @child_types = $parent_editor->child_types;
2280 if (!grep $_ eq ref $self, @child_types) {
2281 my ($child_type) = (ref $self) =~ /(\w+)$/;
2282 my ($parent_type) = (ref $parent_editor) =~ /(\w+)$/;
2283
2284 $$rmsg = "A $child_type cannot be a child of a $parent_type";
2285 return;
2286 }
2287
2288 # the article cannot become a child of itself or one of it's
2289 # children
2290 if ($article->{id} == $newparent->id
2291 || $self->is_descendant($article->id, $newparent->id, $articles)) {
2292 $$rmsg = "Cannot become a child of itself or of a descendant";
2293 return;
2294 }
2295
2296 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
2297 if ($self->shop_article) { # if this article belongs in the shop
2298 unless ($newparent->id == $shopid
2299 || $self->is_descendant($shopid, $newparent->{id}, $articles)) {
2300 $$rmsg = "This article belongs in the shop";
2301 return;
2302 }
2303 }
2304 else {
2305 if ($newparent->id == $shopid
2306 || $self->is_descendant($shopid, $newparent->id, $articles)) {
2307 $$rmsg = "This article doesn't belong in the shop";
2308 return;
2309 }
2310 }
2311
2312 return 1;
2313}
2314
2315sub shop_article { 0 }
2316
efcc5a30
TC
2317sub update_child_dynamic {
2318 my ($self, $article, $articles, $req) = @_;
2319
2320 my $cfg = $req->cfg;
2321 my @stack = $article->children;
2322 my @regen;
2323 while (@stack) {
2324 my $workart = pop @stack;
2325 my $old_dynamic = $workart->is_dynamic; # before update
63e99d77 2326 my $old_link = $workart->{link};
3e37b5ba
TC
2327 my $editor;
2328 ($editor, $workart) = $self->article_class($workart, $articles, $cfg);
2329
efcc5a30
TC
2330 $workart->update_dynamic($cfg);
2331 if ($old_dynamic != $workart->is_dynamic) {
2332 # update the link
2333 if ($article->{link} && !$cfg->entry('protect link', $workart->{id})) {
efcc5a30
TC
2334 my $uri = $editor->make_link($workart);
2335 $workart->setLink($uri);
63e99d77 2336
8f84f3f1
TC
2337 !$old_dynamic && $old_link
2338 and unlink $workart->link_to_filename($cfg, $old_link);
2339 $workart->is_dynamic
16901a2a 2340 or unlink $workart->cached_filename($cfg);
efcc5a30
TC
2341 }
2342
2343 # save dynamic cache change and link if that changed
2344 $workart->save;
2345 }
2346 push @stack, $workart->children;
2347 push @regen, $workart->{id};
2348 }
2349
2350 @regen;
2351}
2352
ca9aa2bf
TC
2353sub sql_date {
2354 my $str = shift;
2355 my ($year, $month, $day);
2356
2357 # look for a date
2358 if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
2359 $year += 2000 if $year < 100;
2360
2361 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2362 }
2363 return undef;
2364}
2365
12b42a0b
TC
2366# Added by adrian
2367# Converts 24hr time to 12hr AM/PM time
2368sub ampm_time {
2369 my $str = shift;
2370 my ($hour, $minute, $second, $ampm);
2371
2372 # look for a time
2373 if (($hour, $minute, $second) = ($str =~ m!(\d+):(\d+):(\d+)!)) {
2374 if ($hour > 12) {
2375 $hour -= 12;
2376 $ampm = 'PM';
2377 }
2378 else {
c2096d67 2379 $hour = 12 if $hour == 0;
12b42a0b
TC
2380 $ampm = 'AM';
2381 }
2382 return sprintf("%02d:%02d:%02d $ampm", $hour, $minute, $second);
2383 }
2384 return undef;
2385}
2386# end adrian
2387
ca9aa2bf
TC
2388sub reparent {
2389 my ($self, $article, $newparentid, $articles, $rmsg) = @_;
2390
2391 my $newlevel;
2392 if ($newparentid == -1) {
2393 $newlevel = 1;
2394 }
2395 else {
2396 my $parent = $articles->getByPkey($newparentid);
2397 unless ($parent) {
2398 $$rmsg = "Cannot get new parent article";
2399 return;
2400 }
2401 $newlevel = $parent->{level} + 1;
2402 }
2403 # the caller will save this one
2404 $article->{parentid} = $newparentid;
2405 $article->{level} = $newlevel;
2406 $article->{displayOrder} = time;
2407
2408 my @change = ( [ $article->{id}, $newlevel ] );
2409 while (@change) {
2410 my $this = shift @change;
2411 my ($art, $level) = @$this;
2412
2413 my @kids = $articles->getBy(parentid=>$art);
2414 push @change, map { [ $_->{id}, $level+1 ] } @kids;
2415
2416 for my $kid (@kids) {
2417 $kid->{level} = $level+1;
2418 $kid->save;
2419 }
2420 }
2421
2422 return 1;
2423}
2424
2425# tests if $desc is a descendant of $art
2426# where both are article ids
2427sub is_descendant {
2428 my ($self, $art, $desc, $articles) = @_;
2429
2430 my @check = ($art);
2431 while (@check) {
2432 my $parent = shift @check;
2433 $parent == $desc and return 1;
2434 my @kids = $articles->getBy(parentid=>$parent);
2435 push @check, map $_->{id}, @kids;
2436 }
2437
2438 return 0;
2439}
2440
2441sub save_thumbnail {
2442 my ($self, $cgi, $original, $newdata) = @_;
2443
2444 unless ($original) {
2445 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
2446 }
ab2cd916 2447 my $imagedir = cfg_image_dir($self->{cfg});
ca9aa2bf
TC
2448 if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
2449 unlink("$imagedir/$original->{thumbImage}");
2450 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
2451 }
3f9c8a96
TC
2452 my $image_name = $cgi->param('thumbnail');
2453 my $image = $cgi->upload('thumbnail');
2454 if ($image_name && -s $image) {
ca9aa2bf
TC
2455 # where to put it...
2456 my $name = '';
3f9c8a96 2457 $image_name =~ /([\w.-]+)$/ and $name = $1;
ca9aa2bf
TC
2458 my $filename = time . "_" . $name;
2459
2460 use Fcntl;
2461 my $counter = "";
2462 $filename = time . '_' . $counter . '_' . $name
2463 until sysopen( OUTPUT, "$imagedir/$filename",
2464 O_WRONLY| O_CREAT| O_EXCL)
2465 || ++$counter > 100;
2466
2467 fileno(OUTPUT) or die "Could not open image file: $!";
2468 binmode OUTPUT;
2469 my $buffer;
2470
2471 #no strict 'refs';
2472
2473 # read the image in from the browser and output it to our
2474 # output filehandle
2475 print STDERR "\$image ",ref $image,"\n";
2476 seek $image, 0, 0;
2477 print OUTPUT $buffer while sysread $image, $buffer, 1024;
2478
2479 close OUTPUT
2480 or die "Could not close image output file: $!";
2481
2482 use Image::Size;
2483
2484 if ($original && $original->{thumbImage}) {
2485 #unlink("$imagedir/$original->{thumbImage}");
2486 }
2487 @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
2488 $newdata->{thumbImage} = $filename;
2489 }
2490}
2491
2492sub child_types {
2493 my ($self, $article) = @_;
2494
2495 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
2496 if ($article && $article->{id} && $article->{id} == $shopid) {
2497 return ( 'BSE::Edit::Catalog' );
2498 }
2499 return ( 'BSE::Edit::Article' );
2500}
2501
0b2a3da0
TC
2502=item add_stepkid
2503
2504Add a step child to an article.
2505
2506Parameters:
2507
2508=over
2509
2510=item *
2511
2512id - parent article id (required)
2513
2514=item *
2515
2516stepkid - child article id (required)
2517
2518=item *
2519
2520_after - id of the allkid of id to position the stepkid after
2521(optional)
2522
2523=back
2524
2525Returns a FIELD error for an invalid stepkid.
2526
2527Returns an ACCESS error for insufficient access.
2528
2529Return an ADD error for a general add failure.
2530
2531On success returns:
2532
2533 {
2534 success: 1,
2535 relationship: { childId: I<childid>, parentId: I<parentid> }
2536 }
2537
2538=back
2539
2540=cut
2541
ca9aa2bf
TC
2542sub add_stepkid {
2543 my ($self, $req, $article, $articles) = @_;
2544
aa6896b6
TC
2545 $req->check_csrf("admin_add_stepkid")
2546 or return $self->csrf_error($req, $article, "admin_add_stepkid", "Add Stepkid");
2547
31a26b52 2548 $req->user_can(edit_stepkid_add => $article)
0b2a3da0
TC
2549 or return $self->_service_error($req, $article, $articles,
2550 "You don't have access to add step children to this article", {}, "ACCESS");
31a26b52 2551
ca9aa2bf 2552 my $cgi = $req->cgi;
0b2a3da0
TC
2553 require BSE::Admin::StepParents;
2554
2555 my %errors;
2556 my $childId = $cgi->param('stepkid');
2557 defined $childId
2558 or $errors{stepkid} = "No stepkid supplied to add_stepkid";
2559 unless ($errors{stepkid}) {
ca9aa2bf 2560 $childId =~ /^\d+$/
0b2a3da0
TC
2561 or $errors{stepkid} = "Invalid stepkid supplied to add_stepkid";
2562 }
2563 my $child;
2564 unless ($errors{stepkid}) {
2565 $child = $articles->getByPkey($childId)
2566 or $errors{stepkid} = "Article $childId not found";
2567 }
2568 keys %errors
2569 and return $self->_service_error
2570 ($req, $article, $articles, $errors{stepkid}, \%errors, "FIELD");
31a26b52 2571
0b2a3da0
TC
2572 $req->user_can(edit_stepparent_add => $child)
2573 or return $self->_service_error($req, $article, $articles, "You don't have access to add a stepparent to that article", {}, "ACCESS");
2574
2575 my $new_entry;
2576 eval {
ca9aa2bf 2577
ca9aa2bf 2578 my $release = $cgi->param('release');
8f88bb20 2579 dh_parse_date($release) or $release = undef;
ca9aa2bf 2580 my $expire = $cgi->param('expire');
8f88bb20 2581 dh_parse_date($expire) or $expire = undef;
ca9aa2bf 2582
0b2a3da0 2583 $new_entry =
ca9aa2bf
TC
2584 BSE::Admin::StepParents->add($article, $child, $release, $expire);
2585 };
2586 if ($@) {
0b2a3da0
TC
2587 return $self->_service_error($req, $article, $articles, $@, {}, "ADD");
2588 }
2589
2590 my $after_id = $cgi->param("_after");
2591 if (defined $after_id) {
2592 Articles->reorder_child($article->id, $child->id, $after_id);
ca9aa2bf 2593 }
a0a8147b 2594
a0a8147b
TC
2595 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2596
0b2a3da0
TC
2597 if ($req->is_ajax) {
2598 return $req->json_content
2599 (
2600 success => 1,
2601 relationship => $new_entry->data_only,
2602 );
2603 }
2604 else {
2605 $self->refresh($article, $cgi, 'step', 'Stepchild added');
2606 }
ca9aa2bf
TC
2607}
2608
0b2a3da0
TC
2609=item del_stepkid
2610
2611Remove a stepkid relationship.
2612
2613Parameters:
2614
2615=over
2616
2617=item *
2618
2619id - parent article id (required)
2620
2621=item *
2622
2623stepkid - child article id (required)
2624
2625=back
2626
2627Returns a FIELD error for an invalid stepkid.
2628
2629Returns an ACCESS error for insufficient access.
2630
2631Return a DELETE error for a general delete failure.
2632
2633=cut
2634
ca9aa2bf
TC
2635sub del_stepkid {
2636 my ($self, $req, $article, $articles) = @_;
2637
aa6896b6
TC
2638 $req->check_csrf("admin_remove_stepkid")
2639 or return $self->csrf_error($req, $article, "admin_del_stepkid", "Delete Stepkid");
31a26b52 2640 $req->user_can(edit_stepkid_delete => $article)
0b2a3da0
TC
2641 or return $self->_service_error($req, $article, $articles,
2642 "You don't have access to delete stepchildren from this article", {}, "ACCESS");
31a26b52 2643
ca9aa2bf 2644 my $cgi = $req->cgi;
0b2a3da0
TC
2645
2646 my %errors;
2647 my $childId = $cgi->param('stepkid');
2648 defined $childId
2649 or $errors{stepkid} = "No stepkid supplied to add_stepkid";
2650 unless ($errors{stepkid}) {
ca9aa2bf 2651 $childId =~ /^\d+$/
0b2a3da0
TC
2652 or $errors{stepkid} = "Invalid stepkid supplied to add_stepkid";
2653 }
2654 my $child;
2655 unless ($errors{stepkid}) {
2656 $child = $articles->getByPkey($childId)
2657 or $errors{stepkid} = "Article $childId not found";
2658 }
2659 keys %errors
2660 and return $self->_service_error
2661 ($req, $article, $articles, $errors{stepkid}, \%errors, "FIELD");
31a26b52 2662
0b2a3da0
TC
2663 $req->user_can(edit_stepparent_delete => $child)
2664 or return _service_error($req, $article, $article, "You cannot remove stepparents from that article", {}, "ACCESS");
ca9aa2bf 2665
0b2a3da0
TC
2666
2667 require BSE::Admin::StepParents;
2668 eval {
ca9aa2bf
TC
2669 BSE::Admin::StepParents->del($article, $child);
2670 };
2671
2672 if ($@) {
0b2a3da0 2673 return $self->_service_error($req, $article, $articles, $@, {}, "DELETE");
ca9aa2bf 2674 }
a0a8147b
TC
2675 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2676
0b2a3da0
TC
2677 if ($req->is_ajax) {
2678 return $req->json_content(success => 1);
2679 }
2680 else {
2681 return $self->refresh($article, $cgi, 'step', 'Stepchild deleted');
2682 }
ca9aa2bf
TC
2683}
2684
2685sub save_stepkids {
2686 my ($self, $req, $article, $articles) = @_;
2687
aa6896b6
TC
2688 $req->check_csrf("admin_save_stepkids")
2689 or return $self->csrf_error($req, $article, "admin_save_stepkids", "Save Stepkids");
2690
31a26b52
TC
2691 $req->user_can(edit_stepkid_save => $article)
2692 or return $self->edit_form($req, $article, $articles,
2693 "No access to save stepkid data for this article");
2694
ca9aa2bf
TC
2695 my $cgi = $req->cgi;
2696 require 'BSE/Admin/StepParents.pm';
2697 my @stepcats = OtherParents->getBy(parentId=>$article->{id});
2698 my %stepcats = map { $_->{parentId}, $_ } @stepcats;
2699 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
2700 for my $stepcat (@stepcats) {
31a26b52
TC
2701 $req->user_can(edit_stepparent_save => $stepcat->{childId})
2702 or next;
ca9aa2bf
TC
2703 for my $name (qw/release expire/) {
2704 my $date = $cgi->param($name.'_'.$stepcat->{childId});
2705 if (defined $date) {
2706 if ($date eq '') {
2707 $date = $datedefs{$name};
2708 }
8f88bb20 2709 elsif (dh_parse_date($date)) {
ca9aa2bf
TC
2710 use BSE::Util::SQL qw/date_to_sql/;
2711 $date = date_to_sql($date);
2712 }
2713 else {
2714 return $self->refresh($article, $cgi, '', "Invalid date '$date'");
2715 }
2716 $stepcat->{$name} = $date;
2717 }
2718 }
2719 eval {
2720 $stepcat->save();
2721 };
2722 $@ and return $self->refresh($article, $cgi, '', $@);
2723 }
a0a8147b
TC
2724 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2725
8b0b2f34 2726 return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
ca9aa2bf
TC
2727}
2728
8634bfaa
TC
2729=item a_restepkid
2730
2731Moves a stepkid from one parent to another, and sets the order within
2732that new stepparent.
2733
2734Parameters:
2735
2736=over
2737
2738=item *
2739
2740id - id of the step kid to move (required)
2741
2742=item *
2743
2744parentid - id of the parent in the stepkid relationship (required)
2745
2746=item *
2747
2748newparentid - the new parent for the stepkid relationship (optional)
2749
2750=item *
2751
2752_after - id of the allkid under newparentid (or parentid if
2753newparentid isn't supplied) to place the stepkid after (0 to place at
2754the start)
2755
2756=back
2757
2758Errors:
2759
2760=over
2761
2762=item *
2763
2764NOPARENTID - parentid parameter not supplied
2765
2766=item *
2767
2768BADPARENTID - non-numeric parentid supplied
2769
2770=item *
2771
2772NOTFOUND - no stepkid relationship from parentid was found
2773
2774=item *
2775
2776BADNEWPARENT - newparentid is non-numeric
2777
2778=item *
2779
2780UNKNOWNNEWPARENT - no article id newparentid found
2781
2782=item *
2783
2784NEWPARENTDUP - there's already a stepkid relationship between
2785newparentid and id.
2786
2787=back
2788
2789=cut
2790
2791sub req_restepkid {
2792 my ($self, $req, $article, $articles) = @_;
2793
2794 # first, identify the stepkid link
2795 my $cgi = $req->cgi;
2796 require OtherParents;
2797 my $parentid = $cgi->param("parentid");
2798 defined $parentid
2799 or return $self->_service_error($req, $article, $articles, "Missing parentid", {}, "NOPARENTID");
2800 $parentid =~ /^\d+$/
2801 or return $self->_service_error($req, $article, $articles, "Invalid parentid", {}, "BADPARENTID");
2802
2803 my ($step) = OtherParents->getBy(parentId => $parentid, childId => $article->id)
2804 or return $self->_service_error($req, $article, $articles, "Unknown relationship", {}, "NOTFOUND");
2805
2806 my $newparentid = $cgi->param("newparentid");
2807 if ($newparentid) {
2808 $newparentid =~ /^\d+$/
2809 or return $self->_service_error($req, $article, $articles, "Bad new parent id", {}, "BADNEWPARENT");
2810 my $new_parent = Articles->getByPkey($newparentid)
2811 or return $self->_service_error($req, $article, $articles, "Unknown new parent id", {}, "UNKNOWNNEWPARENT");
2812 my $existing =
2813 OtherParents->getBy(parentId=>$newparentid, childId=>$article->id)
2814 and return $self->_service_error($req, $article, $articles, "New parent is duplicate", {}, "NEWPARENTDUP");
2815
2816 $step->{parentId} = $newparentid;
2817 $step->save;
2818 }
2819
2820 my $after_id = $cgi->param("_after");
2821 if (defined $after_id) {
2822 Articles->reorder_child($step->{parentId}, $article->id, $after_id);
2823 }
2824
2825 if ($req->is_ajax) {
2826 return $req->json_content
2827 (
2828 success => 1,
2829 relationshop => $step->data_only,
2830 );
2831 }
2832 else {
2833 return $self->refresh($article, $cgi, 'step', "Stepchild moved");
2834 }
2835}
2836
ca9aa2bf
TC
2837sub add_stepparent {
2838 my ($self, $req, $article, $articles) = @_;
2839
aa6896b6
TC
2840 $req->check_csrf("admin_add_stepparent")
2841 or return $self->csrf_error($req, $article, "admin_add_stepparent", "Add Stepparent");
2842
31a26b52
TC
2843 $req->user_can(edit_stepparent_add => $article)
2844 or return $self->edit_form($req, $article, $articles,
2845 "You don't have access to add stepparents to this article");
2846
ca9aa2bf
TC
2847 my $cgi = $req->cgi;
2848 require 'BSE/Admin/StepParents.pm';
2849 eval {
2850 my $step_parent_id = $cgi->param('stepparent');
2851 defined($step_parent_id)
2852 or die "No stepparent supplied to add_stepparent";
2853 int($step_parent_id) eq $step_parent_id
2854 or die "Invalid stepcat supplied to add_stepcat";
2855 my $step_parent = $articles->getByPkey($step_parent_id)
31a26b52
TC
2856 or die "Parent $step_parent_id not found\n";
2857
2858 $req->user_can(edit_stepkid_add => $step_parent)
2859 or die "You don't have access to add a stepkid to that article\n";
ca9aa2bf
TC
2860
2861 my $release = $cgi->param('release');
2862 defined $release
2863 or $release = "01/01/2000";
8f88bb20 2864 $release eq '' or dh_parse_date($release)
ca9aa2bf
TC
2865 or die "Invalid release date";
2866 my $expire = $cgi->param('expire');
2867 defined $expire
2868 or $expire = '31/12/2999';
8f88bb20 2869 $expire eq '' or dh_parse_date($expire)
ca9aa2bf
TC
2870 or die "Invalid expire data";
2871
2872 my $newentry =
2873 BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
2874 };
2875 $@ and return $self->refresh($article, $cgi, 'step', $@);
2876
a0a8147b
TC
2877 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2878
8b0b2f34 2879 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
ca9aa2bf
TC
2880}
2881
2882sub del_stepparent {
2883 my ($self, $req, $article, $articles) = @_;
2884
aa6896b6
TC
2885 $req->check_csrf("admin_remove_stepparent")
2886 or return $self->csrf_error($req, $article, "admin_del_stepparent", "Delete Stepparent");
2887
31a26b52
TC
2888 $req->user_can(edit_stepparent_delete => $article)
2889 or return $self->edit_form($req, $article, $articles,
2890 "You cannot remove stepparents from that article");
2891
ca9aa2bf
TC
2892 my $cgi = $req->cgi;
2893 require 'BSE/Admin/StepParents.pm';
2894 my $step_parent_id = $cgi->param('stepparent');
2895 defined($step_parent_id)
2896 or return $self->refresh($article, $cgi, 'stepparents',
2897 "No stepparent supplied to add_stepcat");
2898 int($step_parent_id) eq $step_parent_id
2899 or return $self->refresh($article, $cgi, 'stepparents',
2900 "Invalid stepparent supplied to add_stepparent");
2901 my $step_parent = $articles->getByPkey($step_parent_id)
2902 or return $self->refresh($article, $cgi, 'stepparent',
2903 "Stepparent $step_parent_id not found");
2904
31a26b52
TC
2905 $req->user_can(edit_stepkid_delete => $step_parent)
2906 or die "You don't have access to remove the stepkid from that article\n";
2907
ca9aa2bf
TC
2908 eval {
2909 BSE::Admin::StepParents->del($step_parent, $article);
2910 };
2911 $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
2912
a0a8147b
TC
2913 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2914
8b0b2f34 2915 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
ca9aa2bf
TC
2916}
2917
2918sub save_stepparents {
2919 my ($self, $req, $article, $articles) = @_;
2920
aa6896b6
TC
2921 $req->check_csrf("admin_save_stepparents")
2922 or return $self->csrf_error($req, $article, "admin_save_stepparents", "Save Stepparents");
31a26b52
TC
2923 $req->user_can(edit_stepparent_save => $article)
2924 or return $self->edit_form($req, $article, $articles,
2925 "No access to save stepparent data for this artice");
2926
ca9aa2bf
TC
2927 my $cgi = $req->cgi;
2928
2929 require 'BSE/Admin/StepParents.pm';
2930 my @stepparents = OtherParents->getBy(childId=>$article->{id});
2931 my %stepparents = map { $_->{parentId}, $_ } @stepparents;
2932 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
2933 for my $stepparent (@stepparents) {
31a26b52
TC
2934 $req->user_can(edit_stepkid_save => $stepparent->{parentId})
2935 or next;
ca9aa2bf
TC
2936 for my $name (qw/release expire/) {
2937 my $date = $cgi->param($name.'_'.$stepparent->{parentId});
2938 if (defined $date) {
2939 if ($date eq '') {
2940 $date = $datedefs{$name};
2941 }
8f88bb20 2942 elsif (dh_parse_date($date)) {
ca9aa2bf
TC
2943 use BSE::Util::SQL qw/date_to_sql/;
2944 $date = date_to_sql($date);
2945 }
2946 else {
2947 return $self->refresh($article, $cgi, "Invalid date '$date'");
2948 }
2949 $stepparent->{$name} = $date;
2950 }
2951 }
2952 eval {
2953 $stepparent->save();
2954 };
2955 $@ and return $self->refresh($article, $cgi, '', $@);
2956 }
2957
a0a8147b
TC
2958 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2959
8b0b2f34
TC
2960 return $self->refresh($article, $cgi, 'stepparents',
2961 'Stepparent information saved');
ca9aa2bf
TC
2962}
2963
58baa27b 2964sub refresh_url {
ca9aa2bf
TC
2965 my ($self, $article, $cgi, $name, $message, $extras) = @_;
2966
8b0b2f34 2967 my $url = $cgi->param('r');
16ac5598
TC
2968 if ($url) {
2969 if ($url !~ /[?&](m|message)=/ && $message) {
2970 # add in messages if none in the provided refresh
2971 my @msgs = ref $message ? @$message : $message;
f3fc60c0 2972 my $sep = $url =~ /\?/ ? "&" : "?";
16ac5598 2973 for my $msg (@msgs) {
f3fc60c0 2974 $url .= $sep . "m=" . CGI::escape($msg);
16ac5598
TC
2975 }
2976 }
2977 }
2978 else {
41f10371 2979 my $urlbase = admin_base_url($self->{cfg});
8b0b2f34 2980 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
16ac5598
TC
2981 if ($message) {
2982 my @msgs = ref $message ? @$message : $message;
2983 for my $msg (@msgs) {
2984 $url .= "&m=" . CGI::escape($msg);
2985 }
2986 }
8b0b2f34
TC
2987 if ($cgi->param('_t')) {
2988 $url .= "&_t=".CGI::escape($cgi->param('_t'));
2989 }
2990 $url .= $extras if defined $extras;
2991 my $cgiextras = $cgi->param('e');
2992 $url .= "#$name" if $name;
ca9aa2bf 2993 }
ca9aa2bf 2994
58baa27b
TC
2995 return $url;
2996}
2997
2998sub refresh {
2999 my ($self, $article, $cgi, $name, $message, $extras) = @_;
3000
3001 my $url = $self->refresh_url($article, $cgi, $name, $message, $extras);
3002
ca9aa2bf
TC
3003 return BSE::Template->get_refresh($url, $self->{cfg});
3004}
3005
3006sub show_images {
918735d1 3007 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
3008
3009 my %acts;
918735d1 3010 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
3011 my $template = 'admin/article_img';
3012
4d764c34 3013 return $req->dyn_response($template, \%acts);
ca9aa2bf
TC
3014}
3015
3016sub save_image_changes {
3017 my ($self, $req, $article, $articles) = @_;
3018
aa6896b6
TC
3019 $req->check_csrf("admin_save_images")
3020 or return $self->csrf_error($req, $article, "admin_save_images", "Save Images");
3021
abf5bbc6 3022 $req->user_can(edit_images_save => $article)
cc9019d1 3023 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
3024 "You don't have access to save image information for this article");
3025
b95fc3a0
TC
3026 my $image_dir = cfg_image_dir($req->cfg);
3027
ca9aa2bf
TC
3028 my $cgi = $req->cgi;
3029 my $image_pos = $cgi->param('imagePos');
3030 if ($image_pos
1e60d3c4 3031 && $image_pos =~ /^(?:tl|tr|bl|br|xx)$/
ca9aa2bf
TC
3032 && $image_pos ne $article->{imagePos}) {
3033 $article->{imagePos} = $image_pos;
3034 $article->save;
3035 }
daee3409 3036 my @images = $self->get_images($article);
4772671f
TC
3037
3038 @images or
3039 return $self->refresh($article, $cgi, undef, 'No images to save information for');
ca9aa2bf 3040
b95fc3a0
TC
3041 my %changes;
3042 my %errors;
3043 my %names;
e63c3728 3044 my %old_images;
8326f275 3045 my @new_images;
b95fc3a0
TC
3046 for my $image (@images) {
3047 my $id = $image->{id};
3048
3049 my $alt = $cgi->param("alt$id");
3050 if ($alt ne $image->{alt}) {
3051 $changes{$id}{alt} = $alt;
ca9aa2bf 3052 }
b95fc3a0
TC
3053
3054 my $url = $cgi->param("url$id");
3055 if (defined $url && $url ne $image->{url}) {
3056 $changes{$id}{url} = $url;
ca9aa2bf 3057 }
b95fc3a0
TC
3058
3059 my $name = $cgi->param("name$id");
3060 if (defined $name && $name ne $image->{name}) {
547a26ad 3061 if ($name eq '') {
42c261c3 3062 $changes{$id}{name} = '';
2d83755d
TC
3063 }
3064 elsif ($name =~ /^[a-z_]\w*$/i) {
b95fc3a0
TC
3065 my $msg;
3066 if ($self->validate_image_name($name, \$msg)) {
3067 # check for duplicates after the loop
3068 push @{$names{lc $name}}, $image->{id}
3069 if length $name;
3070 $changes{$id}{name} = $name;
4772671f
TC
3071 }
3072 else {
b95fc3a0 3073 $errors{"name$id"} = $msg;
4772671f
TC
3074 }
3075 }
b95fc3a0
TC
3076 else {
3077 $errors{"name$id"} = 'Image name must be empty or alphanumeric and unique to the article';
3078 }
3079 }
3080 else {
3081 push @{$names{lc $image->{name}}}, $image->{id}
3082 if length $image->{name};
3083 }
3084
3085 my $filename = $cgi->param("image$id");
3086 if (defined $filename && length $filename) {
3087 my $in_fh = $cgi->upload("image$id");
3088 if ($in_fh) {
ec9b99b2
TC
3089 my $basename;
3090 my $image_error;
3091 my ($width, $height, $type) = $self->_validate_image
3092 ($filename, $in_fh, \$basename, \$image_error);
b95fc3a0 3093
ec9b99b2
TC
3094 unless ($type) {
3095 $errors{"image$id"} = $image_error;
3096 }
3097
3098 unless ($errors{"image$id"}) {
3099 # work out where to put it
3100 require DevHelp::FileUpload;
3101 my $msg;
3102 my ($image_name, $out_fh) = DevHelp::FileUpload->make_img_filename
3103 ($image_dir, $basename, \$msg);
3104 if ($image_name) {
3105 local $/ = \8192;
3106 my $data;
3107 while ($data = <$in_fh>) {
3108 print $out_fh $data;
3109 }
3110 close $out_fh;
3111
3112 my $full_filename = "$image_dir/$image_name";
3113 if ($width) {
3114 $old_images{$id} =
3115 {
3116 image => $image->{image},
3117 storage => $image->{storage}
3118 };
3119 push @new_images, $image_name;
3120
3121 $changes{$id}{image} = $image_name;
3122 $changes{$id}{storage} = 'local';
3123 $changes{$id}{src} = cfg_image_uri() . "/" . $image_name;
3124 $changes{$id}{width} = $width;
3125 $changes{$id}{height} = $height;
3126 $changes{$id}{ftype} = $self->_image_ftype($type);
3127 }
b95fc3a0
TC
3128 }
3129 else {
ec9b99b2 3130 $errors{"image$id"} = $msg;
b95fc3a0
TC
3131 }
3132 }
b95fc3a0
TC
3133 }
3134 else {
3135 # problem uploading
3136 $errors{"image$id"} = "No image file received";
3137 }
3138 }
3139 }
3140 # look for duplicate names
3141 for my $name (keys %names) {
3142 if (@{$names{$name}} > 1) {
3143 for my $id (@{$names{$name}}) {
3144 $errors{"name$id"} = 'Image name must be unique to the article';
daee3409 3145 }
4772671f
TC
3146 }
3147 }
8326f275
TC
3148 if (keys %errors) {
3149 # remove files that won't be stored because validation failed
3150 unlink map "$image_dir/$_", @new_images;
3151
3152 return $self->edit_form($req, $article, $articles, undef,
3153 \%errors);
3154 }
b95fc3a0 3155
e63c3728
TC
3156 my $mgr = $self->_image_manager($req->cfg);
3157 $req->flash('Image information saved');
3158 my $changes_found = 0;
3159 my $auto_store = $cgi->param('auto_storage');
3160 for my $image (@images) {
3161 my $id = $image->{id};
3162
3163 if ($changes{$id}) {
3164 my $changes = $changes{$id};
3165 ++$changes_found;
3166
3167 for my $field (keys %$changes) {
3168 $image->{$field} = $changes->{$field};
b95fc3a0 3169 }
ca9aa2bf
TC
3170 $image->save;
3171 }
a0a8147b 3172
e63c3728
TC
3173 my $old_storage = $image->{storage};
3174 my $new_storage = $auto_store ? '' : $cgi->param("storage$id");
3175 defined $new_storage or $new_storage = $image->{storage};
3176 $new_storage = $mgr->select_store($image->{image}, $new_storage, $image);
3177 if ($new_storage ne $old_storage) {
3178 eval {
3179 $image->{src} = $mgr->store($image->{image}, $new_storage, $image);
3180 $image->{storage} = $new_storage;
3181 $image->save;
3182 };
3183
3184 if ($old_storage ne 'local') {
3185 $mgr->unstore($image->{image}, $old_storage);
3186 }
3187 }
3188 }
3189
3190 # delete any image files that were replaced
3191 for my $old_image (values %old_images) {
3192 my ($image, $storage) = @$old_image{qw/image storage/};
3193 if ($storage ne 'local') {
3194 $mgr->unstore($image->{image}, $storage);
3195 }
3196 unlink "$image_dir/$image";
3197 }
3198
3199 if ($changes_found) {
b95fc3a0
TC
3200 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3201 }
e63c3728
TC
3202
3203 return $self->refresh($article, $cgi);
ca9aa2bf
TC
3204}
3205
58baa27b
TC
3206=item _service_error
3207
3208This function is called on various errors.
3209
3210If a _service parameter was supplied, returns text like:
3211
3212=over
3213
3214Result: failure
3215
3216Field-Error: I<field-name1> - I<message1>
3217
3218Field-Error: I<field-name2> - I<message2>
3219
3220=back
3221
3222If the request is detected as an ajax request or a _ parameter is
3223supplied, return JSON like:
3224
3225 { error: I<message> }
3226
3227Otherwise display the normal edit page with the error.
3228
3229=cut
3230
dbcd12e5 3231sub _service_error {
4d9eccec 3232 my ($self, $req, $article, $articles, $msg, $error, $code, $method) = @_;
dbcd12e5 3233
f3fc60c0
TC
3234 unless ($article) {
3235 my $mymsg;
3236 $article = $self->_dummy_article($req, $articles, \$mymsg);
3237 $article ||=
3238 {
3239 map $_ => '', Article->columns
3240 };
3241 }
3242
dbcd12e5
TC
3243 if ($req->cgi->param('_service')) {
3244 my $body = '';
3245 $body .= "Result: failure\n";
3246 if (ref $error) {
3247 for my $field (keys %$error) {
3248 my $text = $error->{$field};
3249 $text =~ tr/\n/ /;
3250 $body .= "Field-Error: $field - $text\n";
3251 }
3252 my $text = join ('/', values %$error);
3253 $text =~ tr/\n/ /;
3254 $body .= "Error: $text\n";
3255 }
58baa27b
TC
3256 elsif ($msg) {
3257 $body .= "Error: $msg\n";
3258 }
dbcd12e5
TC
3259 else {
3260 $body .= "Error: $error\n";
3261 }
3262 return
3263 {
3264 type => 'text/plain',
3265 content => $body,
3266 };
3267 }
58baa27b 3268 elsif ((() = $req->cgi->param('_')) ||
ca6c0ac9 3269 (exists $ENV{HTTP_X_REQUESTED_WITH}
58baa27b 3270 && $ENV{HTTP_X_REQUESTED_WITH} =~ /XMLHttpRequest/)) {
9b3a5df0 3271 $error ||= {};
60c9e2b7
TC
3272 my $result =
3273 {
3274 errors => $error,
3275 success => 0,
3276 };
9b3a5df0 3277 $msg and $result->{message} = $msg;
60bc6601 3278 $code and $result->{error_code} = $code;
ca6c0ac9
TC
3279 my $json_result = $req->json_content($result);
3280
3281 if (!exists $ENV{HTTP_X_REQUESTED_WITH}
3f9c8a96 3282 || $ENV{HTTP_X_REQUESTED_WITH} !~ /XMLHttpRequest/) {
ca6c0ac9
TC
3283 $json_result->{type} = "text/plain";
3284 }
3285
3286 return $json_result;
58baa27b 3287 }
dbcd12e5 3288 else {
4d9eccec
TC
3289 $method ||= "edit_form";
3290 return $self->$method($req, $article, $articles, $msg, $error);
dbcd12e5
TC
3291 }
3292}
3293
3294sub _service_success {
3295 my ($self, $results) = @_;
3296
3297 my $body = "Result: success\n";
3298 for my $field (keys %$results) {
3299 $body .= "$field: $results->{$field}\n";
3300 }
3301 return
3302 {
3303 type => 'text/plain',
3304 content => $body,
3305 };
3306}
3307
bd903bc5 3308# FIXME: eliminate this method and call get_ftype directly
5d1b1cbb
TC
3309sub _image_ftype {
3310 my ($self, $type) = @_;
3311
bd903bc5
TC
3312 require BSE::TB::Images;
3313 return BSE::TB::Images->get_ftype($type);
5d1b1cbb
TC
3314}
3315
ec9b99b2
TC
3316my %valid_exts =
3317 (
3318 tiff => "tiff,tif",
3319 jpg => "jpeg,jpg",
3320 pnm => "pbm,pgm,ppm",
3321 );
3322
3323sub _validate_image {
3324 my ($self, $filename, $fh, $rbasename, $error) = @_;
3325
3326 if ($fh) {
3327 if (-z $fh) {
3328 $$error = 'Image file is empty';
3329 return;
3330 }
3331 }
3332 else {
3333 $$error = 'Please enter an image filename';
3334 return;
3335 }
3336 my $imagename = $filename;
3337 $imagename .= ''; # force it into a string
3338 my $basename = '';
3339 $imagename =~ tr/ //d;
3340 $imagename =~ /([\w.-]+)$/ and $basename = $1;
3341
3342 # for OSs with special text line endings
3343 use Image::Size;
3344
3345 my($width,$height, $type) = imgsize($fh);
3346
3347 unless (defined $width) {
3348 $$error = "Unknown image file type";
3349 return;
3350 }
3351
3352 my $lctype = lc $type;
3353 my @valid_exts = split /,/,
3354 BSE::Cfg->single->entry("valid image extensions", $lctype,
3355 $valid_exts{$lctype} || $lctype);
3356
3357 my ($ext) = $basename =~ /\.(\w+)\z/;
3358 if (!$ext || !grep $_ eq lc $ext, @valid_exts) {
3359 $basename .= ".$valid_exts[0]";
3360 }
3361 $$rbasename = $basename;
3362
3363 return ($width, $height, $type);
3364}
3365
aa2caf81
TC
3366my $last_display_order = 0;
3367
bf87e97c
TC
3368sub do_add_image {
3369 my ($self, $cfg, $article, $image, %opts) = @_;
ca9aa2bf 3370
bf87e97c
TC
3371 my $errors = $opts{errors}
3372 or die "No errors parameter";
ca9aa2bf 3373
bf87e97c 3374 my $imageref = $opts{name};
d794b180 3375 if (defined $imageref && $imageref ne '') {
4772671f
TC
3376 if ($imageref =~ /^[a-z_]\w+$/i) {
3377 # make sure it's unique
daee3409 3378 my @images = $self->get_images($article);
4772671f
TC
3379 for my $img (@images) {
3380 if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
bf87e97c 3381 $errors->{name} = 'Image name must be unique to the article';
4772671f
TC
3382 last;
3383 }
3384 }
3385 }
3386 else {
bf87e97c 3387 $errors->{name} = 'Image name must be empty or alphanumeric beginning with an alpha character';
4772671f
TC
3388 }
3389 }
3390 else {
3391 $imageref = '';
3392 }
bf87e97c 3393 unless ($errors->{name}) {
d09682dd
TC
3394 my $workmsg;
3395 $self->validate_image_name($imageref, \$workmsg)
bf87e97c 3396 or $errors->{name} = $workmsg;
daee3409 3397 }
4772671f 3398
ec9b99b2
TC
3399 my $image_error;
3400 my $basename;
3401 my ($width, $height, $type) =
3402 $self->_validate_image($opts{filename} || $image, $image, \$basename,
3403 \$image_error);
3404 unless ($width) {
3405 $errors->{image} = $image_error;
ca9aa2bf 3406 }
ec9b99b2 3407
bf87e97c
TC
3408 keys %$errors
3409 and return;
4772671f 3410
ca9aa2bf
TC
3411 # for the sysopen() constants
3412 use Fcntl;
3413
bf87e97c 3414 my $imagedir = cfg_image_dir($cfg);
ca9aa2bf 3415
66b8c584
TC
3416 require DevHelp::FileUpload;
3417 my $msg;
3418 my ($filename, $fh) =
3419 DevHelp::FileUpload->make_img_filename($imagedir, $basename, \$msg);
3420 unless ($filename) {
3421 $errors->{image} = $msg;
3422 return;
3423 }
bd903bc5 3424
ca9aa2bf
TC
3425 my $buffer;
3426
ec9b99b2
TC
3427 binmode $fh;
3428
ca9aa2bf
TC
3429 no strict 'refs';
3430
3431 # read the image in from the browser and output it to our output filehandle
66b8c584 3432 print $fh $buffer while read $image, $buffer, 1024;
ca9aa2bf
TC
3433
3434 # close and flush
66b8c584 3435 close $fh
ca9aa2bf
TC
3436 or die "Could not close image file $filename: $!";
3437
aa2caf81
TC
3438 my $display_order = time;
3439 if ($display_order <= $last_display_order) {
3440 $display_order = $last_display_order + 1;
3441 }
3442 $last_display_order = $display_order;
3443
bf87e97c 3444 my $alt = $opts{alt};
ca9aa2bf 3445 defined $alt or $alt = '';
bf87e97c 3446 my $url = $opts{url};
ca9aa2bf
TC
3447 defined $url or $url = '';
3448 my %image =
3449 (
3450 articleId => $article->{id},
3451 image => $filename,
3452 alt=>$alt,
3453 width=>$width,
3454 height => $height,
3455 url => $url,
aa2caf81 3456 displayOrder => $display_order,
4772671f 3457 name => $imageref,
e63c3728 3458 storage => 'local',
771ab646 3459 src => cfg_image_uri() . '/' . $filename,