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