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