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