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