actually supply the mail content when using IPC::Run to run gpg
[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
dfd483db 16our $VERSION = "1.007";
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
dfd483db
TC
1539sub save_columns {
1540 my ($self, $table_object) = @_;
1541
1542 return $table_object->rowClass->columns;
1543}
1544
ca9aa2bf 1545sub save_new {
d62f54f7 1546 my ($self, $req, $article, $articles) = @_;
aa6896b6
TC
1547
1548 $req->check_csrf("admin_add_article")
1549 or return $self->csrf_error($req, undef, "admin_add_article", "Add Article");
ca9aa2bf
TC
1550
1551 my $cgi = $req->cgi;
1552 my %data;
1553 my $table_object = $self->table_object($articles);
dfd483db 1554 my @columns = $self->save_columns($table_object);
ca9aa2bf
TC
1555 $self->save_thumbnail($cgi, undef, \%data);
1556 for my $name (@columns) {
9168c88c
TC
1557 $data{$name} = $cgi->param($name)
1558 if defined $cgi->param($name);
ca9aa2bf 1559 }
918735d1 1560 $data{flags} = join '', sort $cgi->param('flags');
ca9aa2bf
TC
1561
1562 my $msg;
1563 my %errors;
718a070d
TC
1564 if (!defined $data{parentid} || $data{parentid} eq '') {
1565 $errors{parentid} = "Please select a parent";
1566 }
1567 elsif ($data{parentid} !~ /^(?:-1|\d+)$/) {
1568 $errors{parentid} = "Invalid parent selection (template bug)";
1569 }
39c06424
TC
1570 $self->validate(\%data, $articles, \%errors);
1571 if (keys %errors) {
1572 if ($req->is_ajax) {
1573 return $req->json_content
1574 (
1575 success => 0,
1576 errors => \%errors,
1577 error_code => "FIELD",
1578 message => $req->message(\%errors),
1579 );
1580 }
1581 else {
d62f54f7 1582 return $self->add_form($req, $article, $articles, $msg, \%errors);
39c06424
TC
1583 }
1584 }
ca9aa2bf
TC
1585
1586 my $parent;
39c06424
TC
1587 my $parent_msg;
1588 my $parent_code;
ca9aa2bf
TC
1589 if ($data{parentid} > 0) {
1590 $parent = $articles->getByPkey($data{parentid}) or die;
39c06424
TC
1591 if ($req->user_can('edit_add_child', $parent)) {
1592 for my $name (@columns) {
1593 if (exists $data{$name} &&
1594 !$req->user_can("edit_add_field_$name", $parent)) {
1595 delete $data{$name};
1596 }
9168c88c
TC
1597 }
1598 }
39c06424
TC
1599 else {
1600 $parent_msg = "You cannot add a child to that article";
1601 $parent_code = "ACCESS";
1602 }
ca9aa2bf 1603 }
9168c88c 1604 else {
39c06424
TC
1605 if ($req->user_can('edit_add_child')) {
1606 for my $name (@columns) {
1607 if (exists $data{$name} &&
1608 !$req->user_can("edit_add_field_$name")) {
1609 delete $data{$name};
1610 }
9168c88c
TC
1611 }
1612 }
39c06424
TC
1613 else {
1614 $parent_msg = "You cannot create a top-level article";
1615 $parent_code = "ACCESS";
1616 }
1617 }
1618 if (!$parent_msg) {
1619 $self->validate_parent(\%data, $articles, $parent, \$parent_msg)
1620 or $parent_code = "PARENT";
1621 }
1622 if ($parent_msg) {
1623 if ($req->is_ajax) {
1624 return $req->json_content
1625 (
1626 success => 0,
1627 message => $parent_msg,
1628 error_code => $parent_code,
1629 errors => {},
1630 );
1631 }
1632 else {
d62f54f7 1633 return $self->add_form($req, $article, $articles, $parent_msg);
39c06424 1634 }
9168c88c 1635 }
ca9aa2bf 1636
ca9aa2bf 1637 my $level = $parent ? $parent->{level}+1 : 1;
0ec4ac8a 1638 $data{level} = $level;
9168c88c 1639 $data{displayOrder} = time;
ca9aa2bf
TC
1640 $data{link} ||= '';
1641 $data{admin} ||= '';
ca9aa2bf 1642 $data{generator} = $self->generator;
41f10371 1643 $data{lastModified} = now_sqldatetime();
ca9aa2bf
TC
1644 $data{listed} = 1 unless defined $data{listed};
1645
9604a90c
TC
1646# Added by adrian
1647 $data{pageTitle} = '' unless defined $data{pageTitle};
1648 my $user = $req->getuser;
1649 $data{createdBy} = $user ? $user->{logon} : '';
1650 $data{lastModifiedBy} = $user ? $user->{logon} : '';
1651 $data{created} = now_sqldatetime();
12bcb7ac
TC
1652# end adrian
1653
efcc5a30
TC
1654 $data{force_dynamic} = 0;
1655 $data{cached_dynamic} = 0;
1656 $data{inherit_siteuser_rights} = 1;
9604a90c 1657
12bcb7ac
TC
1658# Added by adrian
1659 $data{metaDescription} = '' unless defined $data{metaDescription};
1660 $data{metaKeywords} = '' unless defined $data{metaKeywords};
1661# end adrian
1662
0ec4ac8a 1663 $self->fill_new_data($req, \%data, $articles);
8f88bb20 1664 for my $col (qw(titleImage imagePos template keyword menu titleAlias linkAlias body author summary)) {
0ec4ac8a
TC
1665 defined $data{$col}
1666 or $data{$col} = $self->default_value($req, \%data, $col);
1667 }
1668
c2096d67
TC
1669 for my $col (qw/force_dynamic inherit_siteuser_rights/) {
1670 if ($req->user_can("edit_add_field_$col", $parent)
1671 && $cgi->param("save_$col")) {
1672 $data{$col} = $cgi->param($col) ? 1 : 0;
1673 }
1674 else {
1675 $data{$col} = $self->default_value($req, \%data, $col);
1676 }
1677 }
1678
8f88bb20
TC
1679 unless ($req->is_ajax) {
1680 for my $col (qw(release expire)) {
1681 $data{$col} = sql_date($data{$col});
1682 }
718a070d
TC
1683 }
1684
0ec4ac8a 1685 # these columns are handled a little differently
d7538448 1686 for my $col (qw(release expire threshold summaryLength )) {
0ec4ac8a
TC
1687 $data{$col}
1688 or $data{$col} = $self->default_value($req, \%data, $col);
1689 }
1690
dfd483db
TC
1691 my @cols = $table_object->rowClass->columns;
1692 shift @cols;
1693 $article = $table_object->add(@data{@cols});
1694
1695 $self->save_new_more($req, $article, \%data);
ca9aa2bf
TC
1696
1697 # we now have an id - generate the links
1698
a319d280 1699 $article->update_dynamic($self->{cfg});
ca9aa2bf
TC
1700 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1701 $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1702 $article->setLink($self->make_link($article));
1703 $article->save();
1704
78218ca8
TC
1705 my ($after_id) = $cgi->param("_after");
1706 if (defined $after_id) {
1707 Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
1708 # reload, the displayOrder probably changed
1709 $article = $articles->getByPkey($article->{id});
1710 }
1711
caa7299c
TC
1712 use Util 'generate_article';
1713 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1714
8f88bb20 1715 if ($req->is_ajax) {
8f88bb20
TC
1716 return $req->json_content
1717 (
1718 {
1719 success => 1,
1720 article => $self->_article_data($req, $article),
1721 },
1722 );
1723 }
1724
8b0b2f34
TC
1725 my $r = $cgi->param('r');
1726 if ($r) {
1727 $r .= ($r =~ /\?/) ? '&' : '?';
1728 $r .= "id=$article->{id}";
1729 }
1730 else {
41f10371 1731 $r = admin_base_url($req->cfg) . $article->{admin};
8b0b2f34
TC
1732 }
1733 return BSE::Template->get_refresh($r, $self->{cfg});
ca9aa2bf
TC
1734}
1735
1736sub fill_old_data {
0d5ccc7f 1737 my ($self, $req, $article, $data) = @_;
ca9aa2bf 1738
4010d92e
TC
1739 if (exists $data->{body}) {
1740 $data->{body} =~ s/\x0D\x0A/\n/g;
1741 $data->{body} =~ tr/\r/\n/;
1742 }
ca9aa2bf 1743 for my $col (Article->columns) {
331fd099 1744 next if $col =~ /^custom/;
ca9aa2bf
TC
1745 $article->{$col} = $data->{$col}
1746 if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1747 }
331fd099
TC
1748 custom_class($self->{cfg})
1749 ->article_fill_old($article, $data, $self->typename);
ca9aa2bf
TC
1750
1751 return 1;
1752}
1753
8f88bb20
TC
1754sub _article_data {
1755 my ($self, $req, $article) = @_;
1756
1757 my $article_data = $article->data_only;
1758 $article_data->{link} = $article->link($req->cfg);
1759 $article_data->{images} =
1760 [
ca6c0ac9 1761 map $self->_image_data($req->cfg, $_), $article->images
8f88bb20
TC
1762 ];
1763 $article_data->{files} =
1764 [
1765 map $_->data_only, $article->files,
1766 ];
1767
1768 return $article_data;
1769}
1770
dfd483db
TC
1771sub save_more {
1772 my ($self, $req, $article, $data) = @_;
1773 # nothing to do here
1774}
1775
1776sub save_new_more {
1777 my ($self, $req, $article, $data) = @_;
1778 # nothing to do here
1779}
1780
bf149413
TC
1781=item save
1782
1783Error codes:
1784
1785=over
1786
1787=item *
1788
1789ACCESS - user doesn't have access to this article.
1790
1791=item *
1792
1793LASTMOD - lastModified value doesn't match that in the article
1794
1795=item *
1796
1797PARENT - invalid parentid specified
1798
1799=back
1800
1801=cut
1802
ca9aa2bf
TC
1803sub save {
1804 my ($self, $req, $article, $articles) = @_;
4010d92e 1805
aa6896b6
TC
1806 $req->check_csrf("admin_save_article")
1807 or return $self->csrf_error($req, $article, "admin_save_article", "Save Article");
1808
4010d92e 1809 $req->user_can(edit_save => $article)
bf149413
TC
1810 or return $self->_service_error
1811 ($req, $article, $articles, "You don't have access to save this article",
1812 {}, "ACCESS");
efcc5a30
TC
1813
1814 my $old_dynamic = $article->is_dynamic;
ca9aa2bf
TC
1815 my $cgi = $req->cgi;
1816 my %data;
dfd483db
TC
1817 my $table_object = $self->table_object($articles);
1818 my @save_cols = $self->save_columns($table_object);
1819 for my $name (@save_cols) {
ca9aa2bf 1820 $data{$name} = $cgi->param($name)
abf5bbc6
TC
1821 if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid'
1822 && $req->user_can("edit_field_edit_$name", $article);
ca9aa2bf 1823 }
12b42a0b
TC
1824
1825# Added by adrian
1826# checks editor lastModified against record lastModified
1827 if ($self->{cfg}->entry('editor', 'check_modified')) {
1828 if ($article->{lastModified} ne $cgi->param('lastModified')) {
1829 my $whoModified = '';
1830 my $timeModified = ampm_time($article->{lastModified});
1831 if ($article->{lastModifiedBy}) {
1832 $whoModified = "by '$article->{lastModifiedBy}'";
1833 }
1834 print STDERR "non-matching lastModified, article not saved\n";
1835 my $msg = "Article changes not saved, this article was modified $whoModified at $timeModified since this editor was loaded";
bf149413 1836 return $self->_service_error($req, $article, $articles, $msg, {}, "LASTMOD");
12b42a0b
TC
1837 }
1838 }
1839# end adrian
1840
918735d1
TC
1841 # possibly this needs tighter error checking
1842 $data{flags} = join '', sort $cgi->param('flags')
1843 if $req->user_can("edit_field_edit_flags", $article);
ca9aa2bf 1844 my %errors;
bf149413
TC
1845 if (exists $article->{template} &&
1846 $article->{template} =~ m|\.\.|) {
1847 $errors{template} = "Please only select templates from the list provided";
1848 }
8f88bb20 1849 $self->validate_old($article, \%data, $articles, \%errors, scalar $req->is_ajax)
bf149413 1850 or return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD");
abf5bbc6
TC
1851 $self->save_thumbnail($cgi, $article, \%data)
1852 if $req->user_can('edit_field_edit_thumbImage', $article);
70c6e1e1 1853 if (exists $data{flags} && $data{flags} =~ /D/) {
a739c25d
TC
1854 $article->remove_html;
1855 }
ca9aa2bf 1856 $self->fill_old_data($req, $article, \%data);
12b42a0b 1857
ca9aa2bf
TC
1858 # reparenting
1859 my $newparentid = $cgi->param('parentid');
6d91d9dc
TC
1860 if ($newparentid
1861 && $req->user_can('edit_field_edit_parentid', $article)
1862 && $newparentid != $article->{parentid}) {
1863 my $newparent;
1864 my $parent_editor;
1865 if ($newparentid == -1) {
1866 require BSE::Edit::Site;
1867 $newparent = BSE::TB::Site->new;
1868 $parent_editor = BSE::Edit::Site->new(cfg => $req->cfg);
abf5bbc6 1869 }
6d91d9dc
TC
1870 else {
1871 $newparent = $articles->getByPkey($newparentid);
1872 ($parent_editor, $newparent) = $self->article_class($newparent, $articles, $req->cfg);
1873 }
1874 if ($newparent) {
1875 my $msg;
1876 if ($self->can_reparent_to($article, $newparent, $parent_editor, $articles, \$msg)
1877 && $self->reparent($article, $newparentid, $articles, \$msg)) {
1878 # nothing to do here
1879 }
1880 else {
1881 return $self->_service_error($req, $article, $articles, $msg, {}, "PARENT");
ca9aa2bf 1882 }
abf5bbc6
TC
1883 }
1884 else {
6d91d9dc 1885 return $self->_service_error($req, $article, $articles, "No such parent article", {}, "PARENT");
ca9aa2bf 1886 }
ca9aa2bf
TC
1887 }
1888
abf5bbc6 1889 $article->{listed} = $cgi->param('listed')
63e99d77 1890 if defined $cgi->param('listed') &&
abf5bbc6 1891 $req->user_can('edit_field_edit_listed', $article);
8f88bb20
TC
1892
1893 if ($req->user_can('edit_field_edit_release', $article)) {
1894 my $release = $cgi->param("release");
1895 if (defined $release && $release =~ /\S/) {
1896 if ($req->is_ajax) {
1897 $article->{release} = $release;
1898 }
1899 else {
1900 $article->{release} = sql_date($release)
1901 }
1902 }
1903 }
1904
abf5bbc6
TC
1905 $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99
1906 if defined $cgi->param('expire') &&
1907 $req->user_can('edit_field_edit_expire', $article);
41f10371 1908 $article->{lastModified} = now_sqldatetime();
c2096d67
TC
1909 for my $col (qw/force_dynamic inherit_siteuser_rights/) {
1910 if ($req->user_can("edit_field_edit_$col", $article)
1911 && $cgi->param("save_$col")) {
1912 $article->{$col} = $cgi->param($col) ? 1 : 0;
1913 }
1914 }
1915
1916# Added by adrian
1917 my $user = $req->getuser;
1918 $article->{lastModifiedBy} = $user ? $user->{logon} : '';
1919# end adrian
1920
1921 my @save_group_ids = $cgi->param('save_group_id');
1922 if ($req->user_can('edit_field_edit_group_id')
1923 && @save_group_ids) {
1924 require BSE::TB::SiteUserGroups;
1925 my %groups = map { $_->{id} => $_ }
1926 BSE::TB::SiteUserGroups->admin_and_query_groups($self->{cfg});
1927 my %set = map { $_ => 1 } $cgi->param('group_id');
1928 my %current = map { $_ => 1 } $article->group_ids;
1929
1930 for my $group_id (@save_group_ids) {
1931 $groups{$group_id} or next;
1932 if ($current{$group_id} && !$set{$group_id}) {
1933 $article->remove_group_id($group_id);
1934 }
1935 elsif (!$current{$group_id} && $set{$group_id}) {
1936 $article->add_group_id($group_id);
1937 }
1938 }
efcc5a30
TC
1939 }
1940
63e99d77 1941 my $old_link = $article->{link};
efcc5a30
TC
1942 # this need to go last
1943 $article->update_dynamic($self->{cfg});
a739c25d 1944 if (!$self->{cfg}->entry('protect link', $article->{id})) {
95989433 1945 my $article_uri = $self->make_link($article);
95989433 1946 $article->setLink($article_uri);
ca9aa2bf
TC
1947 }
1948
1949 $article->save();
caa7299c 1950
63e99d77 1951 # fix the kids too
efcc5a30 1952 my @extra_regen;
63e99d77
TC
1953 @extra_regen = $self->update_child_dynamic($article, $articles, $req);
1954
1955 if ($article->is_dynamic || $old_dynamic) {
1956 if (!$old_dynamic and $old_link) {
1957 unlink $article->link_to_filename($self->{cfg}, $old_link);
1958 }
16901a2a
TC
1959 elsif (!$article->is_dynamic) {
1960 unlink $article->cached_filename($self->{cfg});
1961 }
efcc5a30
TC
1962 }
1963
91fad97a
TC
1964 my ($after_id) = $cgi->param("_after");
1965 if (defined $after_id) {
1966 Articles->reorder_child($article->{parentid}, $article->{id}, $after_id);
1967 # reload, the displayOrder probably changed
1968 $article = $articles->getByPkey($article->{id});
1969 }
1970
caa7299c 1971 use Util 'generate_article';
efcc5a30
TC
1972 if ($Constants::AUTO_GENERATE) {
1973 generate_article($articles, $article);
1974 for my $regen_id (@extra_regen) {
1975 my $regen = $articles->getByPkey($regen_id);
63e99d77 1976 Util::generate_low($articles, $regen, $self->{cfg});
efcc5a30
TC
1977 }
1978 }
caa7299c 1979
dfd483db
TC
1980 $self->save_more($req, $article, \%data);
1981
8f88bb20
TC
1982 if ($req->is_ajax) {
1983 return $req->json_content
1984 (
1985 {
1986 success => 1,
1987 article => $self->_article_data($req, $article),
1988 },
1989 );
1990 }
1991
8b0b2f34 1992 return $self->refresh($article, $cgi, undef, 'Article saved');
ca9aa2bf
TC
1993}
1994
6d91d9dc
TC
1995sub can_reparent_to {
1996 my ($self, $article, $newparent, $parent_editor, $articles, $rmsg) = @_;
1997
6d91d9dc
TC
1998 my @child_types = $parent_editor->child_types;
1999 if (!grep $_ eq ref $self, @child_types) {
2000 my ($child_type) = (ref $self) =~ /(\w+)$/;
2001 my ($parent_type) = (ref $parent_editor) =~ /(\w+)$/;
2002
2003 $$rmsg = "A $child_type cannot be a child of a $parent_type";
2004 return;
2005 }
2006
2007 # the article cannot become a child of itself or one of it's
2008 # children
2009 if ($article->{id} == $newparent->id
2010 || $self->is_descendant($article->id, $newparent->id, $articles)) {
2011 $$rmsg = "Cannot become a child of itself or of a descendant";
2012 return;
2013 }
2014
2015 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
2016 if ($self->shop_article) { # if this article belongs in the shop
2017 unless ($newparent->id == $shopid
2018 || $self->is_descendant($shopid, $newparent->{id}, $articles)) {
2019 $$rmsg = "This article belongs in the shop";
2020 return;
2021 }
2022 }
2023 else {
2024 if ($newparent->id == $shopid
2025 || $self->is_descendant($shopid, $newparent->id, $articles)) {
2026 $$rmsg = "This article doesn't belong in the shop";
2027 return;
2028 }
2029 }
2030
2031 return 1;
2032}
2033
2034sub shop_article { 0 }
2035
efcc5a30
TC
2036sub update_child_dynamic {
2037 my ($self, $article, $articles, $req) = @_;
2038
2039 my $cfg = $req->cfg;
2040 my @stack = $article->children;
2041 my @regen;
2042 while (@stack) {
2043 my $workart = pop @stack;
2044 my $old_dynamic = $workart->is_dynamic; # before update
63e99d77 2045 my $old_link = $workart->{link};
3e37b5ba
TC
2046 my $editor;
2047 ($editor, $workart) = $self->article_class($workart, $articles, $cfg);
2048
efcc5a30
TC
2049 $workart->update_dynamic($cfg);
2050 if ($old_dynamic != $workart->is_dynamic) {
2051 # update the link
2052 if ($article->{link} && !$cfg->entry('protect link', $workart->{id})) {
efcc5a30
TC
2053 my $uri = $editor->make_link($workart);
2054 $workart->setLink($uri);
63e99d77 2055
8f84f3f1
TC
2056 !$old_dynamic && $old_link
2057 and unlink $workart->link_to_filename($cfg, $old_link);
2058 $workart->is_dynamic
16901a2a 2059 or unlink $workart->cached_filename($cfg);
efcc5a30
TC
2060 }
2061
2062 # save dynamic cache change and link if that changed
2063 $workart->save;
2064 }
2065 push @stack, $workart->children;
2066 push @regen, $workart->{id};
2067 }
2068
2069 @regen;
2070}
2071
ca9aa2bf
TC
2072sub sql_date {
2073 my $str = shift;
2074 my ($year, $month, $day);
2075
2076 # look for a date
2077 if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
2078 $year += 2000 if $year < 100;
2079
2080 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2081 }
2082 return undef;
2083}
2084
12b42a0b
TC
2085# Added by adrian
2086# Converts 24hr time to 12hr AM/PM time
2087sub ampm_time {
2088 my $str = shift;
2089 my ($hour, $minute, $second, $ampm);
2090
2091 # look for a time
2092 if (($hour, $minute, $second) = ($str =~ m!(\d+):(\d+):(\d+)!)) {
2093 if ($hour > 12) {
2094 $hour -= 12;
2095 $ampm = 'PM';
2096 }
2097 else {
c2096d67 2098 $hour = 12 if $hour == 0;
12b42a0b
TC
2099 $ampm = 'AM';
2100 }
2101 return sprintf("%02d:%02d:%02d $ampm", $hour, $minute, $second);
2102 }
2103 return undef;
2104}
2105# end adrian
2106
ca9aa2bf
TC
2107sub reparent {
2108 my ($self, $article, $newparentid, $articles, $rmsg) = @_;
2109
2110 my $newlevel;
2111 if ($newparentid == -1) {
2112 $newlevel = 1;
2113 }
2114 else {
2115 my $parent = $articles->getByPkey($newparentid);
2116 unless ($parent) {
2117 $$rmsg = "Cannot get new parent article";
2118 return;
2119 }
2120 $newlevel = $parent->{level} + 1;
2121 }
2122 # the caller will save this one
2123 $article->{parentid} = $newparentid;
2124 $article->{level} = $newlevel;
2125 $article->{displayOrder} = time;
2126
2127 my @change = ( [ $article->{id}, $newlevel ] );
2128 while (@change) {
2129 my $this = shift @change;
2130 my ($art, $level) = @$this;
2131
2132 my @kids = $articles->getBy(parentid=>$art);
2133 push @change, map { [ $_->{id}, $level+1 ] } @kids;
2134
2135 for my $kid (@kids) {
2136 $kid->{level} = $level+1;
2137 $kid->save;
2138 }
2139 }
2140
2141 return 1;
2142}
2143
2144# tests if $desc is a descendant of $art
2145# where both are article ids
2146sub is_descendant {
2147 my ($self, $art, $desc, $articles) = @_;
2148
2149 my @check = ($art);
2150 while (@check) {
2151 my $parent = shift @check;
2152 $parent == $desc and return 1;
2153 my @kids = $articles->getBy(parentid=>$parent);
2154 push @check, map $_->{id}, @kids;
2155 }
2156
2157 return 0;
2158}
2159
2160sub save_thumbnail {
2161 my ($self, $cgi, $original, $newdata) = @_;
2162
2163 unless ($original) {
2164 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
2165 }
ab2cd916 2166 my $imagedir = cfg_image_dir($self->{cfg});
ca9aa2bf
TC
2167 if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
2168 unlink("$imagedir/$original->{thumbImage}");
2169 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
2170 }
3f9c8a96
TC
2171 my $image_name = $cgi->param('thumbnail');
2172 my $image = $cgi->upload('thumbnail');
2173 if ($image_name && -s $image) {
ca9aa2bf
TC
2174 # where to put it...
2175 my $name = '';
3f9c8a96 2176 $image_name =~ /([\w.-]+)$/ and $name = $1;
ca9aa2bf
TC
2177 my $filename = time . "_" . $name;
2178
2179 use Fcntl;
2180 my $counter = "";
2181 $filename = time . '_' . $counter . '_' . $name
2182 until sysopen( OUTPUT, "$imagedir/$filename",
2183 O_WRONLY| O_CREAT| O_EXCL)
2184 || ++$counter > 100;
2185
2186 fileno(OUTPUT) or die "Could not open image file: $!";
2187 binmode OUTPUT;
2188 my $buffer;
2189
2190 #no strict 'refs';
2191
2192 # read the image in from the browser and output it to our
2193 # output filehandle
2194 print STDERR "\$image ",ref $image,"\n";
2195 seek $image, 0, 0;
2196 print OUTPUT $buffer while sysread $image, $buffer, 1024;
2197
2198 close OUTPUT
2199 or die "Could not close image output file: $!";
2200
2201 use Image::Size;
2202
2203 if ($original && $original->{thumbImage}) {
2204 #unlink("$imagedir/$original->{thumbImage}");
2205 }
2206 @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
2207 $newdata->{thumbImage} = $filename;
2208 }
2209}
2210
2211sub child_types {
2212 my ($self, $article) = @_;
2213
2214 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
2215 if ($article && $article->{id} && $article->{id} == $shopid) {
2216 return ( 'BSE::Edit::Catalog' );
2217 }
2218 return ( 'BSE::Edit::Article' );
2219}
2220
0b2a3da0
TC
2221=item add_stepkid
2222
2223Add a step child to an article.
2224
2225Parameters:
2226
2227=over
2228
2229=item *
2230
2231id - parent article id (required)
2232
2233=item *
2234
2235stepkid - child article id (required)
2236
2237=item *
2238
2239_after - id of the allkid of id to position the stepkid after
2240(optional)
2241
2242=back
2243
2244Returns a FIELD error for an invalid stepkid.
2245
2246Returns an ACCESS error for insufficient access.
2247
2248Return an ADD error for a general add failure.
2249
2250On success returns:
2251
2252 {
2253 success: 1,
2254 relationship: { childId: I<childid>, parentId: I<parentid> }
2255 }
2256
2257=back
2258
2259=cut
2260
ca9aa2bf
TC
2261sub add_stepkid {
2262 my ($self, $req, $article, $articles) = @_;
2263
aa6896b6
TC
2264 $req->check_csrf("admin_add_stepkid")
2265 or return $self->csrf_error($req, $article, "admin_add_stepkid", "Add Stepkid");
2266
31a26b52 2267 $req->user_can(edit_stepkid_add => $article)
0b2a3da0
TC
2268 or return $self->_service_error($req, $article, $articles,
2269 "You don't have access to add step children to this article", {}, "ACCESS");
31a26b52 2270
ca9aa2bf 2271 my $cgi = $req->cgi;
0b2a3da0
TC
2272 require BSE::Admin::StepParents;
2273
2274 my %errors;
2275 my $childId = $cgi->param('stepkid');
2276 defined $childId
2277 or $errors{stepkid} = "No stepkid supplied to add_stepkid";
2278 unless ($errors{stepkid}) {
ca9aa2bf 2279 $childId =~ /^\d+$/
0b2a3da0
TC
2280 or $errors{stepkid} = "Invalid stepkid supplied to add_stepkid";
2281 }
2282 my $child;
2283 unless ($errors{stepkid}) {
2284 $child = $articles->getByPkey($childId)
2285 or $errors{stepkid} = "Article $childId not found";
2286 }
2287 keys %errors
2288 and return $self->_service_error
2289 ($req, $article, $articles, $errors{stepkid}, \%errors, "FIELD");
31a26b52 2290
0b2a3da0
TC
2291 $req->user_can(edit_stepparent_add => $child)
2292 or return $self->_service_error($req, $article, $articles, "You don't have access to add a stepparent to that article", {}, "ACCESS");
2293
2294 my $new_entry;
2295 eval {
ca9aa2bf 2296
ca9aa2bf 2297 my $release = $cgi->param('release');
8f88bb20 2298 dh_parse_date($release) or $release = undef;
ca9aa2bf 2299 my $expire = $cgi->param('expire');
8f88bb20 2300 dh_parse_date($expire) or $expire = undef;
ca9aa2bf 2301
0b2a3da0 2302 $new_entry =
ca9aa2bf
TC
2303 BSE::Admin::StepParents->add($article, $child, $release, $expire);
2304 };
2305 if ($@) {
0b2a3da0
TC
2306 return $self->_service_error($req, $article, $articles, $@, {}, "ADD");
2307 }
2308
2309 my $after_id = $cgi->param("_after");
2310 if (defined $after_id) {
2311 Articles->reorder_child($article->id, $child->id, $after_id);
ca9aa2bf 2312 }
a0a8147b
TC
2313
2314 use Util 'generate_article';
2315 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2316
0b2a3da0
TC
2317 if ($req->is_ajax) {
2318 return $req->json_content
2319 (
2320 success => 1,
2321 relationship => $new_entry->data_only,
2322 );
2323 }
2324 else {
2325 $self->refresh($article, $cgi, 'step', 'Stepchild added');
2326 }
ca9aa2bf
TC
2327}
2328
0b2a3da0
TC
2329=item del_stepkid
2330
2331Remove a stepkid relationship.
2332
2333Parameters:
2334
2335=over
2336
2337=item *
2338
2339id - parent article id (required)
2340
2341=item *
2342
2343stepkid - child article id (required)
2344
2345=back
2346
2347Returns a FIELD error for an invalid stepkid.
2348
2349Returns an ACCESS error for insufficient access.
2350
2351Return a DELETE error for a general delete failure.
2352
2353=cut
2354
ca9aa2bf
TC
2355sub del_stepkid {
2356 my ($self, $req, $article, $articles) = @_;
2357
aa6896b6
TC
2358 $req->check_csrf("admin_remove_stepkid")
2359 or return $self->csrf_error($req, $article, "admin_del_stepkid", "Delete Stepkid");
31a26b52 2360 $req->user_can(edit_stepkid_delete => $article)
0b2a3da0
TC
2361 or return $self->_service_error($req, $article, $articles,
2362 "You don't have access to delete stepchildren from this article", {}, "ACCESS");
31a26b52 2363
ca9aa2bf 2364 my $cgi = $req->cgi;
0b2a3da0
TC
2365
2366 my %errors;
2367 my $childId = $cgi->param('stepkid');
2368 defined $childId
2369 or $errors{stepkid} = "No stepkid supplied to add_stepkid";
2370 unless ($errors{stepkid}) {
ca9aa2bf 2371 $childId =~ /^\d+$/
0b2a3da0
TC
2372 or $errors{stepkid} = "Invalid stepkid supplied to add_stepkid";
2373 }
2374 my $child;
2375 unless ($errors{stepkid}) {
2376 $child = $articles->getByPkey($childId)
2377 or $errors{stepkid} = "Article $childId not found";
2378 }
2379 keys %errors
2380 and return $self->_service_error
2381 ($req, $article, $articles, $errors{stepkid}, \%errors, "FIELD");
31a26b52 2382
0b2a3da0
TC
2383 $req->user_can(edit_stepparent_delete => $child)
2384 or return _service_error($req, $article, $article, "You cannot remove stepparents from that article", {}, "ACCESS");
ca9aa2bf 2385
0b2a3da0
TC
2386
2387 require BSE::Admin::StepParents;
2388 eval {
ca9aa2bf
TC
2389 BSE::Admin::StepParents->del($article, $child);
2390 };
2391
2392 if ($@) {
0b2a3da0 2393 return $self->_service_error($req, $article, $articles, $@, {}, "DELETE");
ca9aa2bf 2394 }
a0a8147b
TC
2395 use Util 'generate_article';
2396 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2397
0b2a3da0
TC
2398 if ($req->is_ajax) {
2399 return $req->json_content(success => 1);
2400 }
2401 else {
2402 return $self->refresh($article, $cgi, 'step', 'Stepchild deleted');
2403 }
ca9aa2bf
TC
2404}
2405
2406sub save_stepkids {
2407 my ($self, $req, $article, $articles) = @_;
2408
aa6896b6
TC
2409 $req->check_csrf("admin_save_stepkids")
2410 or return $self->csrf_error($req, $article, "admin_save_stepkids", "Save Stepkids");
2411
31a26b52
TC
2412 $req->user_can(edit_stepkid_save => $article)
2413 or return $self->edit_form($req, $article, $articles,
2414 "No access to save stepkid data for this article");
2415
ca9aa2bf
TC
2416 my $cgi = $req->cgi;
2417 require 'BSE/Admin/StepParents.pm';
2418 my @stepcats = OtherParents->getBy(parentId=>$article->{id});
2419 my %stepcats = map { $_->{parentId}, $_ } @stepcats;
2420 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
2421 for my $stepcat (@stepcats) {
31a26b52
TC
2422 $req->user_can(edit_stepparent_save => $stepcat->{childId})
2423 or next;
ca9aa2bf
TC
2424 for my $name (qw/release expire/) {
2425 my $date = $cgi->param($name.'_'.$stepcat->{childId});
2426 if (defined $date) {
2427 if ($date eq '') {
2428 $date = $datedefs{$name};
2429 }
8f88bb20 2430 elsif (dh_parse_date($date)) {
ca9aa2bf
TC
2431 use BSE::Util::SQL qw/date_to_sql/;
2432 $date = date_to_sql($date);
2433 }
2434 else {
2435 return $self->refresh($article, $cgi, '', "Invalid date '$date'");
2436 }
2437 $stepcat->{$name} = $date;
2438 }
2439 }
2440 eval {
2441 $stepcat->save();
2442 };
2443 $@ and return $self->refresh($article, $cgi, '', $@);
2444 }
a0a8147b
TC
2445 use Util 'generate_article';
2446 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2447
8b0b2f34 2448 return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
ca9aa2bf
TC
2449}
2450
8634bfaa
TC
2451=item a_restepkid
2452
2453Moves a stepkid from one parent to another, and sets the order within
2454that new stepparent.
2455
2456Parameters:
2457
2458=over
2459
2460=item *
2461
2462id - id of the step kid to move (required)
2463
2464=item *
2465
2466parentid - id of the parent in the stepkid relationship (required)
2467
2468=item *
2469
2470newparentid - the new parent for the stepkid relationship (optional)
2471
2472=item *
2473
2474_after - id of the allkid under newparentid (or parentid if
2475newparentid isn't supplied) to place the stepkid after (0 to place at
2476the start)
2477
2478=back
2479
2480Errors:
2481
2482=over
2483
2484=item *
2485
2486NOPARENTID - parentid parameter not supplied
2487
2488=item *
2489
2490BADPARENTID - non-numeric parentid supplied
2491
2492=item *
2493
2494NOTFOUND - no stepkid relationship from parentid was found
2495
2496=item *
2497
2498BADNEWPARENT - newparentid is non-numeric
2499
2500=item *
2501
2502UNKNOWNNEWPARENT - no article id newparentid found
2503
2504=item *
2505
2506NEWPARENTDUP - there's already a stepkid relationship between
2507newparentid and id.
2508
2509=back
2510
2511=cut
2512
2513sub req_restepkid {
2514 my ($self, $req, $article, $articles) = @_;
2515
2516 # first, identify the stepkid link
2517 my $cgi = $req->cgi;
2518 require OtherParents;
2519 my $parentid = $cgi->param("parentid");
2520 defined $parentid
2521 or return $self->_service_error($req, $article, $articles, "Missing parentid", {}, "NOPARENTID");
2522 $parentid =~ /^\d+$/
2523 or return $self->_service_error($req, $article, $articles, "Invalid parentid", {}, "BADPARENTID");
2524
2525 my ($step) = OtherParents->getBy(parentId => $parentid, childId => $article->id)
2526 or return $self->_service_error($req, $article, $articles, "Unknown relationship", {}, "NOTFOUND");
2527
2528 my $newparentid = $cgi->param("newparentid");
2529 if ($newparentid) {
2530 $newparentid =~ /^\d+$/
2531 or return $self->_service_error($req, $article, $articles, "Bad new parent id", {}, "BADNEWPARENT");
2532 my $new_parent = Articles->getByPkey($newparentid)
2533 or return $self->_service_error($req, $article, $articles, "Unknown new parent id", {}, "UNKNOWNNEWPARENT");
2534 my $existing =
2535 OtherParents->getBy(parentId=>$newparentid, childId=>$article->id)
2536 and return $self->_service_error($req, $article, $articles, "New parent is duplicate", {}, "NEWPARENTDUP");
2537
2538 $step->{parentId} = $newparentid;
2539 $step->save;
2540 }
2541
2542 my $after_id = $cgi->param("_after");
2543 if (defined $after_id) {
2544 Articles->reorder_child($step->{parentId}, $article->id, $after_id);
2545 }
2546
2547 if ($req->is_ajax) {
2548 return $req->json_content
2549 (
2550 success => 1,
2551 relationshop => $step->data_only,
2552 );
2553 }
2554 else {
2555 return $self->refresh($article, $cgi, 'step', "Stepchild moved");
2556 }
2557}
2558
ca9aa2bf
TC
2559sub add_stepparent {
2560 my ($self, $req, $article, $articles) = @_;
2561
aa6896b6
TC
2562 $req->check_csrf("admin_add_stepparent")
2563 or return $self->csrf_error($req, $article, "admin_add_stepparent", "Add Stepparent");
2564
31a26b52
TC
2565 $req->user_can(edit_stepparent_add => $article)
2566 or return $self->edit_form($req, $article, $articles,
2567 "You don't have access to add stepparents to this article");
2568
ca9aa2bf
TC
2569 my $cgi = $req->cgi;
2570 require 'BSE/Admin/StepParents.pm';
2571 eval {
2572 my $step_parent_id = $cgi->param('stepparent');
2573 defined($step_parent_id)
2574 or die "No stepparent supplied to add_stepparent";
2575 int($step_parent_id) eq $step_parent_id
2576 or die "Invalid stepcat supplied to add_stepcat";
2577 my $step_parent = $articles->getByPkey($step_parent_id)
31a26b52
TC
2578 or die "Parent $step_parent_id not found\n";
2579
2580 $req->user_can(edit_stepkid_add => $step_parent)
2581 or die "You don't have access to add a stepkid to that article\n";
ca9aa2bf
TC
2582
2583 my $release = $cgi->param('release');
2584 defined $release
2585 or $release = "01/01/2000";
8f88bb20 2586 $release eq '' or dh_parse_date($release)
ca9aa2bf
TC
2587 or die "Invalid release date";
2588 my $expire = $cgi->param('expire');
2589 defined $expire
2590 or $expire = '31/12/2999';
8f88bb20 2591 $expire eq '' or dh_parse_date($expire)
ca9aa2bf
TC
2592 or die "Invalid expire data";
2593
2594 my $newentry =
2595 BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
2596 };
2597 $@ and return $self->refresh($article, $cgi, 'step', $@);
2598
a0a8147b
TC
2599 use Util 'generate_article';
2600 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2601
8b0b2f34 2602 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
ca9aa2bf
TC
2603}
2604
2605sub del_stepparent {
2606 my ($self, $req, $article, $articles) = @_;
2607
aa6896b6
TC
2608 $req->check_csrf("admin_remove_stepparent")
2609 or return $self->csrf_error($req, $article, "admin_del_stepparent", "Delete Stepparent");
2610
31a26b52
TC
2611 $req->user_can(edit_stepparent_delete => $article)
2612 or return $self->edit_form($req, $article, $articles,
2613 "You cannot remove stepparents from that article");
2614
ca9aa2bf
TC
2615 my $cgi = $req->cgi;
2616 require 'BSE/Admin/StepParents.pm';
2617 my $step_parent_id = $cgi->param('stepparent');
2618 defined($step_parent_id)
2619 or return $self->refresh($article, $cgi, 'stepparents',
2620 "No stepparent supplied to add_stepcat");
2621 int($step_parent_id) eq $step_parent_id
2622 or return $self->refresh($article, $cgi, 'stepparents',
2623 "Invalid stepparent supplied to add_stepparent");
2624 my $step_parent = $articles->getByPkey($step_parent_id)
2625 or return $self->refresh($article, $cgi, 'stepparent',
2626 "Stepparent $step_parent_id not found");
2627
31a26b52
TC
2628 $req->user_can(edit_stepkid_delete => $step_parent)
2629 or die "You don't have access to remove the stepkid from that article\n";
2630
ca9aa2bf
TC
2631 eval {
2632 BSE::Admin::StepParents->del($step_parent, $article);
2633 };
2634 $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
2635
a0a8147b
TC
2636 use Util 'generate_article';
2637 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2638
8b0b2f34 2639 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
ca9aa2bf
TC
2640}
2641
2642sub save_stepparents {
2643 my ($self, $req, $article, $articles) = @_;
2644
aa6896b6
TC
2645 $req->check_csrf("admin_save_stepparents")
2646 or return $self->csrf_error($req, $article, "admin_save_stepparents", "Save Stepparents");
31a26b52
TC
2647 $req->user_can(edit_stepparent_save => $article)
2648 or return $self->edit_form($req, $article, $articles,
2649 "No access to save stepparent data for this artice");
2650
ca9aa2bf
TC
2651 my $cgi = $req->cgi;
2652
2653 require 'BSE/Admin/StepParents.pm';
2654 my @stepparents = OtherParents->getBy(childId=>$article->{id});
2655 my %stepparents = map { $_->{parentId}, $_ } @stepparents;
2656 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
2657 for my $stepparent (@stepparents) {
31a26b52
TC
2658 $req->user_can(edit_stepkid_save => $stepparent->{parentId})
2659 or next;
ca9aa2bf
TC
2660 for my $name (qw/release expire/) {
2661 my $date = $cgi->param($name.'_'.$stepparent->{parentId});
2662 if (defined $date) {
2663 if ($date eq '') {
2664 $date = $datedefs{$name};
2665 }
8f88bb20 2666 elsif (dh_parse_date($date)) {
ca9aa2bf
TC
2667 use BSE::Util::SQL qw/date_to_sql/;
2668 $date = date_to_sql($date);
2669 }
2670 else {
2671 return $self->refresh($article, $cgi, "Invalid date '$date'");
2672 }
2673 $stepparent->{$name} = $date;
2674 }
2675 }
2676 eval {
2677 $stepparent->save();
2678 };
2679 $@ and return $self->refresh($article, $cgi, '', $@);
2680 }
2681
a0a8147b
TC
2682 use Util 'generate_article';
2683 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2684
8b0b2f34
TC
2685 return $self->refresh($article, $cgi, 'stepparents',
2686 'Stepparent information saved');
ca9aa2bf
TC
2687}
2688
58baa27b 2689sub refresh_url {
ca9aa2bf
TC
2690 my ($self, $article, $cgi, $name, $message, $extras) = @_;
2691
8b0b2f34 2692 my $url = $cgi->param('r');
16ac5598
TC
2693 if ($url) {
2694 if ($url !~ /[?&](m|message)=/ && $message) {
2695 # add in messages if none in the provided refresh
2696 my @msgs = ref $message ? @$message : $message;
f3fc60c0 2697 my $sep = $url =~ /\?/ ? "&" : "?";
16ac5598 2698 for my $msg (@msgs) {
f3fc60c0 2699 $url .= $sep . "m=" . CGI::escape($msg);
16ac5598
TC
2700 }
2701 }
2702 }
2703 else {
41f10371 2704 my $urlbase = admin_base_url($self->{cfg});
8b0b2f34 2705 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
16ac5598
TC
2706 if ($message) {
2707 my @msgs = ref $message ? @$message : $message;
2708 for my $msg (@msgs) {
2709 $url .= "&m=" . CGI::escape($msg);
2710 }
2711 }
8b0b2f34
TC
2712 if ($cgi->param('_t')) {
2713 $url .= "&_t=".CGI::escape($cgi->param('_t'));
2714 }
2715 $url .= $extras if defined $extras;
2716 my $cgiextras = $cgi->param('e');
2717 $url .= "#$name" if $name;
ca9aa2bf 2718 }
ca9aa2bf 2719
58baa27b
TC
2720 return $url;
2721}
2722
2723sub refresh {
2724 my ($self, $article, $cgi, $name, $message, $extras) = @_;
2725
2726 my $url = $self->refresh_url($article, $cgi, $name, $message, $extras);
2727
ca9aa2bf
TC
2728 return BSE::Template->get_refresh($url, $self->{cfg});
2729}
2730
2731sub show_images {
918735d1 2732 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
2733
2734 my %acts;
918735d1 2735 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
2736 my $template = 'admin/article_img';
2737
4d764c34 2738 return $req->dyn_response($template, \%acts);
ca9aa2bf
TC
2739}
2740
2741sub save_image_changes {
2742 my ($self, $req, $article, $articles) = @_;
2743
aa6896b6
TC
2744 $req->check_csrf("admin_save_images")
2745 or return $self->csrf_error($req, $article, "admin_save_images", "Save Images");
2746
abf5bbc6 2747 $req->user_can(edit_images_save => $article)
cc9019d1 2748 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2749 "You don't have access to save image information for this article");
2750
b95fc3a0
TC
2751 my $image_dir = cfg_image_dir($req->cfg);
2752
ca9aa2bf
TC
2753 my $cgi = $req->cgi;
2754 my $image_pos = $cgi->param('imagePos');
2755 if ($image_pos
2756 && $image_pos =~ /^(?:tl|tr|bl|br)$/
2757 && $image_pos ne $article->{imagePos}) {
2758 $article->{imagePos} = $image_pos;
2759 $article->save;
2760 }
daee3409 2761 my @images = $self->get_images($article);
4772671f
TC
2762
2763 @images or
2764 return $self->refresh($article, $cgi, undef, 'No images to save information for');
ca9aa2bf 2765
b95fc3a0
TC
2766 my %changes;
2767 my %errors;
2768 my %names;
e63c3728 2769 my %old_images;
8326f275 2770 my @new_images;
b95fc3a0
TC
2771 for my $image (@images) {
2772 my $id = $image->{id};
2773
2774 my $alt = $cgi->param("alt$id");
2775 if ($alt ne $image->{alt}) {
2776 $changes{$id}{alt} = $alt;
ca9aa2bf 2777 }
b95fc3a0
TC
2778
2779 my $url = $cgi->param("url$id");
2780 if (defined $url && $url ne $image->{url}) {
2781 $changes{$id}{url} = $url;
ca9aa2bf 2782 }
b95fc3a0
TC
2783
2784 my $name = $cgi->param("name$id");
2785 if (defined $name && $name ne $image->{name}) {
547a26ad
TC
2786 if ($name eq '') {
2787 if ($article->{id} > 0) {
2788 $changes{$id}{name} = '';
2789 }
2790 else {
2791 $errors{"name$id"} = "Identifiers are required for global images";
2792 }
2d83755d
TC
2793 }
2794 elsif ($name =~ /^[a-z_]\w*$/i) {
b95fc3a0
TC
2795 my $msg;
2796 if ($self->validate_image_name($name, \$msg)) {
2797 # check for duplicates after the loop
2798 push @{$names{lc $name}}, $image->{id}
2799 if length $name;
2800 $changes{$id}{name} = $name;
4772671f
TC
2801 }
2802 else {
b95fc3a0 2803 $errors{"name$id"} = $msg;
4772671f
TC
2804 }
2805 }
b95fc3a0
TC
2806 else {
2807 $errors{"name$id"} = 'Image name must be empty or alphanumeric and unique to the article';
2808 }
2809 }
2810 else {
2811 push @{$names{lc $image->{name}}}, $image->{id}
2812 if length $image->{name};
2813 }
2814
2815 my $filename = $cgi->param("image$id");
2816 if (defined $filename && length $filename) {
2817 my $in_fh = $cgi->upload("image$id");
2818 if ($in_fh) {
2819 # work out where to put it
2820 require DevHelp::FileUpload;
daee3409 2821 my $msg;
b95fc3a0
TC
2822 my ($image_name, $out_fh) = DevHelp::FileUpload->make_img_filename
2823 ($image_dir, $filename . '', \$msg);
2824 if ($image_name) {
2825 local $/ = \8192;
2826 my $data;
2827 while ($data = <$in_fh>) {
2828 print $out_fh $data;
2829 }
2830 close $out_fh;
2831
2832 my $full_filename = "$image_dir/$image_name";
2833 require Image::Size;
2834 my ($width, $height, $type) = Image::Size::imgsize($full_filename);
2835 if ($width) {
e63c3728
TC
2836 $old_images{$id} =
2837 {
2838 image => $image->{image},
2839 storage => $image->{storage}
2840 };
8326f275
TC
2841 push @new_images, $image_name;
2842
b95fc3a0 2843 $changes{$id}{image} = $image_name;
e63c3728
TC
2844 $changes{$id}{storage} = 'local';
2845 $changes{$id}{src} = "/images/$image_name";
b95fc3a0
TC
2846 $changes{$id}{width} = $width;
2847 $changes{$id}{height} = $height;
5d1b1cbb 2848 $changes{$id}{ftype} = $self->_image_ftype($type);
b95fc3a0
TC
2849 }
2850 else {
2851 $errors{"image$id"} = $type;
2852 }
2853 }
2854 else {
2855 $errors{"image$id"} = $msg;
2856 }
2857 }
2858 else {
2859 # problem uploading
2860 $errors{"image$id"} = "No image file received";
2861 }
2862 }
2863 }
2864 # look for duplicate names
2865 for my $name (keys %names) {
2866 if (@{$names{$name}} > 1) {
2867 for my $id (@{$names{$name}}) {
2868 $errors{"name$id"} = 'Image name must be unique to the article';
daee3409 2869 }
4772671f
TC
2870 }
2871 }
8326f275
TC
2872 if (keys %errors) {
2873 # remove files that won't be stored because validation failed
2874 unlink map "$image_dir/$_", @new_images;
2875
2876 return $self->edit_form($req, $article, $articles, undef,
2877 \%errors);
2878 }
b95fc3a0 2879
e63c3728
TC
2880 my $mgr = $self->_image_manager($req->cfg);
2881 $req->flash('Image information saved');
2882 my $changes_found = 0;
2883 my $auto_store = $cgi->param('auto_storage');
2884 for my $image (@images) {
2885 my $id = $image->{id};
2886
2887 if ($changes{$id}) {
2888 my $changes = $changes{$id};
2889 ++$changes_found;
2890
2891 for my $field (keys %$changes) {
2892 $image->{$field} = $changes->{$field};
b95fc3a0 2893 }
ca9aa2bf
TC
2894 $image->save;
2895 }
a0a8147b 2896
e63c3728
TC
2897 my $old_storage = $image->{storage};
2898 my $new_storage = $auto_store ? '' : $cgi->param("storage$id");
2899 defined $new_storage or $new_storage = $image->{storage};
2900 $new_storage = $mgr->select_store($image->{image}, $new_storage, $image);
2901 if ($new_storage ne $old_storage) {
2902 eval {
2903 $image->{src} = $mgr->store($image->{image}, $new_storage, $image);
2904 $image->{storage} = $new_storage;
2905 $image->save;
2906 };
2907
2908 if ($old_storage ne 'local') {
2909 $mgr->unstore($image->{image}, $old_storage);
2910 }
2911 }
2912 }
2913
2914 # delete any image files that were replaced
2915 for my $old_image (values %old_images) {
2916 my ($image, $storage) = @$old_image{qw/image storage/};
2917 if ($storage ne 'local') {
2918 $mgr->unstore($image->{image}, $storage);
2919 }
2920 unlink "$image_dir/$image";
2921 }
2922
2923 if ($changes_found) {
b95fc3a0
TC
2924 use Util 'generate_article';
2925 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2926 }
e63c3728
TC
2927
2928 return $self->refresh($article, $cgi);
ca9aa2bf
TC
2929}
2930
58baa27b
TC
2931=item _service_error
2932
2933This function is called on various errors.
2934
2935If a _service parameter was supplied, returns text like:
2936
2937=over
2938
2939Result: failure
2940
2941Field-Error: I<field-name1> - I<message1>
2942
2943Field-Error: I<field-name2> - I<message2>
2944
2945=back
2946
2947If the request is detected as an ajax request or a _ parameter is
2948supplied, return JSON like:
2949
2950 { error: I<message> }
2951
2952Otherwise display the normal edit page with the error.
2953
2954=cut
2955
dbcd12e5 2956sub _service_error {
60bc6601 2957 my ($self, $req, $article, $articles, $msg, $error, $code) = @_;
dbcd12e5 2958
f3fc60c0
TC
2959 unless ($article) {
2960 my $mymsg;
2961 $article = $self->_dummy_article($req, $articles, \$mymsg);
2962 $article ||=
2963 {
2964 map $_ => '', Article->columns
2965 };
2966 }
2967
dbcd12e5
TC
2968 if ($req->cgi->param('_service')) {
2969 my $body = '';
2970 $body .= "Result: failure\n";
2971 if (ref $error) {
2972 for my $field (keys %$error) {
2973 my $text = $error->{$field};
2974 $text =~ tr/\n/ /;
2975 $body .= "Field-Error: $field - $text\n";
2976 }
2977 my $text = join ('/', values %$error);
2978 $text =~ tr/\n/ /;
2979 $body .= "Error: $text\n";
2980 }
58baa27b
TC
2981 elsif ($msg) {
2982 $body .= "Error: $msg\n";
2983 }
dbcd12e5
TC
2984 else {
2985 $body .= "Error: $error\n";
2986 }
2987 return
2988 {
2989 type => 'text/plain',
2990 content => $body,
2991 };
2992 }
58baa27b 2993 elsif ((() = $req->cgi->param('_')) ||
ca6c0ac9 2994 (exists $ENV{HTTP_X_REQUESTED_WITH}
58baa27b 2995 && $ENV{HTTP_X_REQUESTED_WITH} =~ /XMLHttpRequest/)) {
9b3a5df0 2996 $error ||= {};
60c9e2b7
TC
2997 my $result =
2998 {
2999 errors => $error,
3000 success => 0,
3001 };
9b3a5df0 3002 $msg and $result->{message} = $msg;
60bc6601 3003 $code and $result->{error_code} = $code;
ca6c0ac9
TC
3004 my $json_result = $req->json_content($result);
3005
3006 if (!exists $ENV{HTTP_X_REQUESTED_WITH}
3f9c8a96 3007 || $ENV{HTTP_X_REQUESTED_WITH} !~ /XMLHttpRequest/) {
ca6c0ac9
TC
3008 $json_result->{type} = "text/plain";
3009 }
3010
3011 return $json_result;
58baa27b 3012 }
dbcd12e5 3013 else {
bf87e97c 3014 return $self->edit_form($req, $article, $articles, $msg, $error);
dbcd12e5
TC
3015 }
3016}
3017
3018sub _service_success {
3019 my ($self, $results) = @_;
3020
3021 my $body = "Result: success\n";
3022 for my $field (keys %$results) {
3023 $body .= "$field: $results->{$field}\n";
3024 }
3025 return
3026 {
3027 type => 'text/plain',
3028 content => $body,
3029 };
3030}
3031
5d1b1cbb
TC
3032sub _image_ftype {
3033 my ($self, $type) = @_;
3034
3035 if ($type eq 'CWS' || $type eq 'SWF') {
3036 return "flash";
3037 }
3038
3039 return "img";
3040}
3041
bf87e97c
TC
3042sub do_add_image {
3043 my ($self, $cfg, $article, $image, %opts) = @_;
ca9aa2bf 3044
bf87e97c
TC
3045 my $errors = $opts{errors}
3046 or die "No errors parameter";
ca9aa2bf 3047
bf87e97c 3048 my $imageref = $opts{name};
d794b180 3049 if (defined $imageref && $imageref ne '') {
4772671f
TC
3050 if ($imageref =~ /^[a-z_]\w+$/i) {
3051 # make sure it's unique
daee3409 3052 my @images = $self->get_images($article);
4772671f
TC
3053 for my $img (@images) {
3054 if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
bf87e97c 3055 $errors->{name} = 'Image name must be unique to the article';
4772671f
TC
3056 last;
3057 }
3058 }
3059 }
3060 else {
bf87e97c 3061 $errors->{name} = 'Image name must be empty or alphanumeric beginning with an alpha character';
4772671f
TC
3062 }
3063 }
3064 else {
3065 $imageref = '';
3066 }
bf87e97c 3067 unless ($errors->{name}) {
d09682dd
TC
3068 my $workmsg;
3069 $self->validate_image_name($imageref, \$workmsg)
bf87e97c 3070 or $errors->{name} = $workmsg;
daee3409 3071 }
4772671f 3072
4772671f
TC
3073 if ($image) {
3074 if (-z $image) {
bf87e97c 3075 $errors->{image} = 'Image file is empty';
4772671f 3076 }
ca9aa2bf 3077 }
4772671f 3078 else {
bf87e97c 3079 $errors->{image} = 'Please enter an image filename';
ca9aa2bf 3080 }
bf87e97c
TC
3081 keys %$errors
3082 and return;
4772671f 3083
bf87e97c 3084 my $imagename = $opts{filename} || $image;
ca9aa2bf
TC
3085 $imagename .= ''; # force it into a string
3086 my $basename = '';
bf87e97c 3087 $imagename =~ tr/ //d;
ca9aa2bf
TC
3088 $imagename =~ /([\w.-]+)$/ and $basename = $1;
3089
ca9aa2bf
TC
3090 # for the sysopen() constants
3091 use Fcntl;
3092
bf87e97c 3093 my $imagedir = cfg_image_dir($cfg);
ca9aa2bf 3094
66b8c584
TC
3095 require DevHelp::FileUpload;
3096 my $msg;
3097 my ($filename, $fh) =
3098 DevHelp::FileUpload->make_img_filename($imagedir, $basename, \$msg);
3099 unless ($filename) {
3100 $errors->{image} = $msg;
3101 return;
3102 }
3103print STDERR "Gen filename '$filename'\n";
ca9aa2bf 3104 # for OSs with special text line endings
66b8c584 3105 binmode $fh;
ca9aa2bf
TC
3106
3107 my $buffer;
3108
3109 no strict 'refs';
3110
3111 # read the image in from the browser and output it to our output filehandle
66b8c584 3112 print $fh $buffer while read $image, $buffer, 1024;
ca9aa2bf
TC
3113
3114 # close and flush
66b8c584 3115 close $fh
ca9aa2bf
TC
3116 or die "Could not close image file $filename: $!";
3117
3118 use Image::Size;
3119
3120
f40af7e2 3121 my($width,$height, $type) = imgsize("$imagedir/$filename");
ca9aa2bf 3122
bf87e97c 3123 my $alt = $opts{alt};
ca9aa2bf 3124 defined $alt or $alt = '';
bf87e97c 3125 my $url = $opts{url};
ca9aa2bf
TC
3126 defined $url or $url = '';
3127 my %image =
3128 (
3129 articleId => $article->{id},
3130 image => $filename,
3131 alt=>$alt,
3132 width=>$width,
3133 height => $height,
3134 url => $url,
3135 displayOrder=>time,
4772671f 3136 name => $imageref,
e63c3728
TC
3137 storage => 'local',
3138 src => '/images/' . $filename,
5d1b1cbb 3139 ftype => $self->_image_ftype($type),
ca9aa2bf 3140 );
f40af7e2
TC
3141 require BSE::TB::Images;
3142 my @cols = BSE::TB::Image->columns;
ca9aa2bf 3143 shift @cols;
f40af7e2 3144 my $imageobj = BSE::TB::Images->add(@image{@cols});
a0a8147b 3145
bf87e97c 3146 my $storage = $opts{storage};
e63c3728 3147 defined $storage or $storage = 'local';
bf87e97c 3148 my $image_manager = $self->_image_manager($cfg);
e63c3728
TC
3149 local $SIG{__DIE__};
3150 eval {
3151 my $src;
3152 $storage = $image_manager->select_store($filename, $storage, $imageobj);
3153 $src = $image_manager->store($filename, $storage, $imageobj);
3154
3155 if ($src) {
3156 $imageobj->{src} = $src;
3157 $imageobj->{storage} = $storage;
3158 $imageobj->save;
3159 }
3160 };
3161 if ($@) {
bf87e97c 3162 $errors->{flash} = $@;
e63c3728
TC
3163 }
3164
bf87e97c
TC
3165 return $imageobj;
3166}
3167
ca6c0ac9
TC
3168sub _image_data {
3169 my ($self, $cfg, $image) = @_;
3170
3171 my $data = $image->data_only;
3172 $data->{src} = $image->image_url($cfg);
3173
3174 return $data;
3175}
3176
bf87e97c
TC
3177sub add_image {
3178 my ($self, $req, $article, $articles) = @_;
3179
aa6896b6
TC
3180 $req->check_csrf("admin_add_image")
3181 or return $self->csrf_error($req, $article, "admin_add_image", "Add Image");
bf87e97c
TC
3182 $req->user_can(edit_images_add => $article)
3183 or return $self->_service_error($req, $article, $articles,
3184 "You don't have access to add new images to this article");
3185
3186 my $cgi = $req->cgi;
3187 my %errors;
3188 my $imageobj =
3189 $self->do_add_image
3190 (
3191 $req->cfg,
3192 $article,
3f9c8a96 3193 scalar($cgi->upload('image')),
bf87e97c
TC
3194 name => scalar($cgi->param('name')),
3195 alt => scalar($cgi->param('altIn')),
3196 url => scalar($cgi->param('url')),
3197 storage => scalar($cgi->param('storage')),
3198 errors => \%errors,
3f9c8a96 3199 filename => scalar($cgi->param("image")),
bf87e97c
TC
3200 );
3201
3202 $imageobj
3203 or return $self->_service_error($req, $article, $articles, undef, \%errors);
3204
3205 # typically a soft failure from the storage
3206 $errors{flash}
3207 and $req->flash($errors{flash});
3208
a0a8147b
TC
3209 use Util 'generate_article';
3210 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3211
dbcd12e5
TC
3212 if ($cgi->param('_service')) {
3213 return $self->_service_success
3214 (
3215 {
3216 image => $imageobj->{id},
3217 },
3218 );
3219 }
a93c4cb8
TC
3220 elsif ($cgi->param("_") || $req->is_ajax) {
3221 my $resp = $req->json_content
3222 (
3223 success => 1,
ca6c0ac9 3224 image => $self->_image_data($req->cfg, $imageobj),
a93c4cb8
TC
3225 );
3226
3227 # the browser handles this directly, tell it that it's text
3228 $resp->{type} = "text/plain";
3229
3230 return $resp;
3231 }
dbcd12e5
TC
3232 else {
3233 return $self->refresh($article, $cgi, undef, 'New image added');
3234 }
ca9aa2bf
TC
3235}
3236
e63c3728
TC
3237sub _image_manager {
3238 my ($self) = @_;
3239
3240 require BSE::StorageMgr::Images;
3241
3242 return BSE::StorageMgr::Images->new(cfg => $self->cfg);
3243}
3244
ca9aa2bf
TC
3245# remove an image
3246sub remove_img {
3247 my ($self, $req, $article, $articles, $imageid) = @_;
3248
aa6896b6
TC
3249 $req->check_csrf("admin_remove_image")
3250 or return $self->csrf_error($req, $article, "admin_remove_image", "Remove Image");
3251
abf5bbc6 3252 $req->user_can(edit_images_delete => $article)
5273694f
TC
3253 or return $self->_service_error($req, $article, $articles,
3254 "You don't have access to delete images from this article", {}, "ACCESS");
abf5bbc6 3255
ca9aa2bf
TC
3256 $imageid or die;
3257
daee3409 3258 my @images = $self->get_images($article);
5273694f
TC
3259 my ($image) = grep $_->{id} == $imageid, @images;
3260 unless ($image) {
3261 if ($req->want_json_response) {
3262 return $self->_service_error($req, $article, $articles, "No such image", {}, "NOTFOUND");
3263 }
3264 else {
3265 return $self->show_images($req, $article, $articles, "No such image");
3266 }
3267 }
e63c3728
TC
3268
3269 if ($image->{storage} ne 'local') {
3270 my $mgr = $self->_image_manager($req->cfg);
3271 $mgr->unstore($image->{image}, $image->{storage});
3272 }
3273
ab2cd916 3274 my $imagedir = cfg_image_dir($req->cfg);
6473c56f 3275 unlink "$imagedir$image->{image}";
ca9aa2bf
TC
3276 $image->remove;
3277
a0a8147b
TC
3278 use Util 'generate_article';
3279 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3280
5273694f
TC
3281 if ($req->want_json_response) {
3282 return $req->json_content
3283 (
3284 success => 1,
3285 );
3286 }
3287
cc9019d1 3288 return $self->refresh($article, $req->cgi, undef, 'Image removed');
ca9aa2bf
TC
3289}
3290
3291sub move_img_up {
3292 my ($self, $req, $article, $articles) = @_;
3293
aa6896b6
TC
3294 $req->check_csrf("admin_move_image")
3295 or return $self->csrf_error($req, $article, "admin_move_image", "Move Image");
abf5bbc6 3296 $req->user_can(edit_images_reorder => $article)
cc9019d1 3297 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
3298 "You don't have access to reorder images in this article");
3299
ca9aa2bf 3300 my $imageid = $req->cgi->param('imageid');
daee3409 3301 my @images = $self->get_images($article);
ca9aa2bf 3302 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 3303 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 3304 $imgindex > 0
cc9019d1 3305 or return $self->edit_form($req, $article, $articles, "Image is already at the top");
ca9aa2bf
TC
3306 my ($to, $from) = @images[$imgindex-1, $imgindex];
3307 ($to->{displayOrder}, $from->{displayOrder}) =
3308 ($from->{displayOrder}, $to->{displayOrder});
3309 $to->save;
3310 $from->save;
3311
a0a8147b
TC
3312 use Util 'generate_article';
3313 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3314
cc9019d1 3315 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
3316}
3317
3318sub move_img_down {
3319 my ($self, $req, $article, $articles) = @_;
3320
aa6896b6
TC
3321 $req->check_csrf("admin_move_image")
3322 or return $self->csrf_error($req, $article, "admin_move_image", "Move Image");
abf5bbc6 3323 $req->user_can(edit_images_reorder => $article)
cc9019d1 3324 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
3325 "You don't have access to reorder images in this article");
3326
ca9aa2bf 3327 my $imageid = $req->cgi->param('imageid');
daee3409 3328 my @images = $self->get_images($article);
ca9aa2bf 3329 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 3330 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 3331 $imgindex < $#images
cc9019d1 3332 or return $self->edit_form($req, $article, $articles, "Image is already at the end");
ca9aa2bf
TC
3333 my ($to, $from) = @images[$imgindex+1, $imgindex];
3334 ($to->{displayOrder}, $from->{displayOrder}) =
3335 ($from->{displayOrder}, $to->{displayOrder});
3336 $to->save;
3337 $from->save;
3338
a0a8147b
TC
3339 use Util 'generate_article';
3340 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3341
cc9019d1 3342 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
3343}
3344
ab2cd916
TC
3345sub req_thumb {
3346 my ($self, $req, $article) = @_;
3347
3348 my $cgi = $req->cgi;
3349 my $cfg = $req->cfg;
3350 my $im_id = $cgi->param('im');
3351 my $image;
3352 if (defined $im_id && $im_id =~ /^\d+$/) {
6a8a6ac5 3353 ($image) = grep $_->{id} == $im_id, $self->get_images($article);
ab2cd916
TC
3354 }
3355 my $thumb_obj = $self->_get_thumbs_class();
3356 my ($data, $type);
3357 if ($image && $thumb_obj) {
195977cd
TC
3358 my $geometry_id = $cgi->param('g');
3359 defined $geometry_id or $geometry_id = 'editor';
dbcd12e5 3360 my $geometry = $cfg->entry('thumb geometries', $geometry_id, 'scale(200x200)');
ab2cd916
TC
3361 my $imagedir = $cfg->entry('paths', 'images', $Constants::IMAGEDIR);
3362
195977cd 3363 my $error;
6430ee52
TC
3364 ($data, $type) = $thumb_obj->thumb_data
3365 (
3366 filename => "$imagedir/$image->{image}",
3367 geometry => $geometry,
3368 error => \$error
3369 )
d9f8d6b9
TC
3370 or return
3371 {
3372 type => 'text/plain',
3373 content => 'Error: '.$error
3374 };
ab2cd916
TC
3375 }
3376
3377 if ($type && $data) {
3378
3379 return
3380 {
3381 type => $type,
3382 content => $data,
3383 headers => [
3384 "Content-Length: ".length($data),
3385 "Cache-Control: max-age=3600",
3386 ],
3387 };
3388 }
3389 else {
3390 # grab the nothumb image
3391 my $uri = $cfg->entry('editor', 'default_thumbnail', '/images/admin/nothumb.png');
5abe2da5 3392 my $filebase = $cfg->content_base_path;
ab2cd916
TC
3393 if (open IMG, "<$filebase/$uri") {
3394 binmode IMG;
3395 my $data = do { local $/; <IMG> };
3396 close IMG;
3397 my $type = $uri =~ /\.(\w+)$/ ? $1 : 'png';
3398 return
3399 {
3400 type => "image/$type",
3401 content => $data,
3402 headers => [ "Content-Length: ".length($data) ],
3403 };
3404 }
3405 else {
3406 return
3407 {
3408 type=>"text/html",
3409 content => "<html><body>Cannot make thumb or default image</body></html>",
3410 };
3411 }
3412 }
3413}
3414
b95fc3a0
TC
3415sub req_edit_image {
3416 my ($self, $req, $article, $articles, $errors) = @_;
3417
3418 my $cgi = $req->cgi;
3419
3420 my $id = $cgi->param('image_id');
3421
7303cf10 3422 my ($image) = grep $_->{id} == $id, $self->get_images($article)
b95fc3a0
TC
3423 or return $self->edit_form($req, $article, $articles,
3424 "No such image");
3425 $req->user_can(edit_images_save => $article)
3426 or return $self->edit_form($req, $article, $articles,
3427 "You don't have access to save image information for this article");
3428
3429 my %acts;
3430 %acts =