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