0.13_04 commit
[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);
ca9aa2bf 5use BSE::Util::SQL qw(now_sqldate);
b553afa2 6use BSE::Util::Valid qw/valid_date/;
9168c88c 7use BSE::Permissions;
331fd099 8use Util qw(custom_class);
77804754 9use DevHelp::HTML;
ca9aa2bf
TC
10
11sub article_dispatch {
9168c88c
TC
12 my ($self, $req, $article, $articles) = @_;
13
14 BSE::Permissions->check_logon($req)
15 or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
16
17 my $cgi = $req->cgi;
ca9aa2bf
TC
18 my $action;
19 my %actions = $self->article_actions;
20 for my $check (keys %actions) {
21 if ($cgi->param($check) || $cgi->param("$check.x")) {
22 $action = $check;
23 last;
24 }
25 }
26 my @extraargs;
27 unless ($action) {
28 ($action, @extraargs) = $self->other_article_actions($cgi);
29 }
30 $action ||= 'edit';
31 my $method = $actions{$action};
9168c88c 32 return $self->$method($req, $article, $articles, @extraargs);
ca9aa2bf
TC
33}
34
35sub noarticle_dispatch {
9168c88c 36 my ($self, $req, $articles) = @_;
ca9aa2bf 37
9168c88c
TC
38 BSE::Permissions->check_logon($req)
39 or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
40
41 my $cgi = $req->cgi;
ca9aa2bf
TC
42 my $action = 'add';
43 my %actions = $self->noarticle_actions;
44 for my $check (keys %actions) {
45 if ($cgi->param($check) || $cgi->param("$check.x")) {
46 $action = $check;
47 last;
48 }
49 }
50 my $method = $actions{$action};
9168c88c 51 return $self->$method($req, $articles);
ca9aa2bf
TC
52}
53
ca9aa2bf
TC
54sub article_actions {
55 my ($self) = @_;
56
57 return
58 (
59 edit => 'edit_form',
60 save => 'save',
61 add_stepkid => 'add_stepkid',
62 del_stepkid => 'del_stepkid',
63 save_stepkids => 'save_stepkids',
64 add_stepparent => 'add_stepparent',
65 del_stepparent => 'del_stepparent',
66 save_stepparents => 'save_stepparents',
67 artimg => 'save_image_changes',
68 addimg => 'add_image',
6473c56f 69 remove => 'remove',
ca9aa2bf
TC
70 showimages => 'show_images',
71 process => 'save_image_changes',
72 removeimg => 'remove_img',
73 moveimgup => 'move_img_up',
74 moveimgdown => 'move_img_down',
75 filelist => 'filelist',
76 fileadd => 'fileadd',
77 fileswap => 'fileswap',
78 filedel => 'filedel',
79 filesave => 'filesave',
4010d92e
TC
80 hide => 'hide',
81 unhide => 'unhide',
ca9aa2bf
TC
82 );
83}
84
85sub other_article_actions {
86 my ($self, $cgi) = @_;
87
88 for my $param ($cgi->param) {
89 if ($param =~ /^removeimg_(\d+)(\.x)?$/) {
90 return ('removeimg', $1 );
91 }
92 }
93
94 return;
95}
96
97sub noarticle_actions {
98 return
99 (
100 add => 'add_form',
101 save => 'save_new',
102 );
103}
104
105sub get_parent {
106 my ($self, $parentid, $articles) = @_;
107
108 if ($parentid == -1) {
109 return
110 {
111 id => -1,
112 title=>'All Sections',
113 level => 0,
114 listed => 0,
115 parentid => undef,
116 };
117 }
118 else {
119 return $articles->getByPkey($parentid);
120 }
121}
122
123sub tag_hash {
124 my ($object, $args) = @_;
125
126 my $value = $object->{$args};
127 defined $value or $value = '';
7b81711b
TC
128 if ($value =~ /\cJ/ && $value =~ /\cM/) {
129 $value =~ tr/\cM//d;
130 }
77804754 131 escape_html($value);
ca9aa2bf
TC
132}
133
134sub tag_art_type {
135 my ($level, $cfg) = @_;
136
77804754 137 escape_html($cfg->entry('level names', $level, 'Article'));
ca9aa2bf
TC
138}
139
140sub tag_if_new {
141 my ($article) = @_;
142
143 !$article->{id};
144}
145
146sub reparent_updown {
147 return 1;
148}
149
150sub should_be_catalog {
151 my ($self, $article, $parent, $articles) = @_;
152
153 if ($article->{parentid} && (!$parent || $parent->{id} != $article->{parentid})) {
154 $parent = $articles->getByPkey($article->{id});
155 }
156
157 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
158
159 return $article->{parentid} && $parent &&
160 ($article->{parentid} == $shopid ||
161 $parent->{generator} eq 'Generate::Catalog');
162}
163
164sub possible_parents {
9168c88c 165 my ($self, $article, $articles, $req) = @_;
ca9aa2bf
TC
166
167 my %labels;
168 my @values;
169
170 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
171 my @parents = $articles->getBy('level', $article->{level}-1);
172 @parents = grep { $_->{generator} eq 'Generate::Article'
173 && $_->{id} != $shopid } @parents;
9168c88c
TC
174
175 # user can only select parent they can add to
176 @parents = grep $req->user_can('edit_add_child', $_), @parents;
ca9aa2bf
TC
177
178 @values = ( map {$_->{id}} @parents );
179 %labels = ( map { $_->{id} => "$_->{title} ($_->{id})" } @parents );
180
9168c88c 181 if ($article->{level} == 1 && $req->user_can('edit_add_child')) {
ca9aa2bf
TC
182 push @values, -1;
183 $labels{-1} = "No parent - this is a section";
184 }
185
186 if ($article->{id} && $self->reparent_updown($article)) {
187 # we also list the siblings and grandparent (if any)
188 my @siblings = grep $_->{id} != $article->{id} && $_->{id} != $shopid,
189 $articles->getBy(parentid => $article->{parentid});
9168c88c 190 @siblings = grep $req->user_can('edit_add_child', $_), @siblings;
ca9aa2bf
TC
191 push @values, map $_->{id}, @siblings;
192 @labels{map $_->{id}, @siblings} =
193 map { "-- move down a level -- $_->{title} ($_->{id})" } @siblings;
194
195 if ($article->{parentid} != -1) {
196 my $parent = $articles->getByPkey($article->{parentid});
197 if ($parent->{parentid} != -1) {
198 my $gparent = $articles->getByPkey($parent->{parentid});
9168c88c
TC
199 if ($req->user_can('edit_add_child', $gparent)) {
200 push @values, $gparent->{id};
201 $labels{$gparent->{id}} =
202 "-- move up a level -- $gparent->{title} ($gparent->{id})";
203 }
ca9aa2bf
TC
204 }
205 else {
9168c88c
TC
206 if ($req->user_can('edit_add_child')) {
207 push @values, -1;
208 $labels{-1} = "-- move up a level -- become a section";
209 }
ca9aa2bf
TC
210 }
211 }
212 }
213
214 return (\@values, \%labels);
215}
216
217sub tag_list {
9168c88c 218 my ($self, $article, $articles, $cgi, $req, $what) = @_;
ca9aa2bf
TC
219
220 if ($what eq 'listed') {
221 my @values = qw(0 1);
222 my %labels = ( 0=>"No", 1=>"Yes");
223 if ($article->{level} <= 2) {
224 $labels{2} = "In Sections, but not menu";
225 push(@values, 2);
226 }
227 else {
228 $labels{2} = "In content, but not menus";
229 push(@values, 2);
230 }
231 return $cgi->popup_menu(-name=>'listed',
232 -values=>\@values,
233 -labels=>\%labels,
234 -default=>$article->{listed});
235 }
236 else {
9168c88c 237 my ($values, $labels) = $self->possible_parents($article, $articles, $req);
ca9aa2bf
TC
238 my $html;
239 if (defined $article->{parentid}) {
240 $html = $cgi->popup_menu(-name=>'parentid',
241 -values=> $values,
242 -labels => $labels,
243 -default => $article->{parentid},
244 -override=>1);
245 }
246 else {
247 $html = $cgi->popup_menu(-name=>'parentid',
248 -values=> $values,
249 -labels => $labels,
250 -override=>1);
251 }
252
253 # munge the html - we display a default value, so we need to wrap the
254 # default <select /> around this one
255 $html =~ s!^<select[^>]+>|</select>!!gi;
256 return $html;
257 }
258}
259
260sub tag_checked {
261 my ($arg, $acts, $funcname, $templater) = @_;
262 my ($func, $args) = split ' ', $arg, 2;
263 return $templater->perform($acts, $func, $args) ? 'checked' : '';
264}
265
266sub iter_get_images {
daee3409 267 my ($self, $article) = @_;
ca9aa2bf
TC
268
269 $article->{id} or return;
daee3409 270 $self->get_images($article);
ca9aa2bf
TC
271}
272
273sub iter_get_kids {
274 my ($article, $articles) = @_;
275
15fb10f2 276 my @children;
ca9aa2bf
TC
277 $article->{id} or return;
278 if (UNIVERSAL::isa($article, 'Article')) {
15fb10f2 279 @children = $article->children;
ca9aa2bf
TC
280 }
281 elsif ($article->{id}) {
15fb10f2 282 @children = $articles->children($article->{id});
ca9aa2bf 283 }
15fb10f2
TC
284
285 return sort { $b->{displayOrder} <=> $a->{displayOrder} } @children;
ca9aa2bf
TC
286}
287
288sub tag_if_have_child_type {
289 my ($level, $cfg) = @_;
290
291 defined $cfg->entry("level names", $level+1);
292}
293
294sub tag_is {
295 my ($args, $acts, $isname, $templater) = @_;
296
297 my ($func, $funcargs) = split ' ', $args, 2;
298 return $templater->perform($acts, $func, $funcargs) ? 'Yes' : 'No';
299}
300
caa7299c
TC
301sub default_template {
302 my ($self, $article, $cfg, $templates) = @_;
303
304 if ($article->{parentid}) {
305 my $template = $cfg->entry("children of $article->{parentid}", "template");
306 return $template
307 if $template && grep $_ eq $template, @$templates;
308 }
309 if ($article->{level}) {
310 my $template = $cfg->entry("level $article->{level}", "template");
311 return $template
312 if $template && grep $_ eq $template, @$templates;
313 }
314 return $templates->[0];
315}
316
ca9aa2bf
TC
317sub tag_templates {
318 my ($self, $article, $cfg, $cgi) = @_;
319
320 my @templates = sort $self->templates($article);
321 my $default;
322 if ($article->{template} && grep $_ eq $article->{template}, @templates) {
323 $default = $article->{template};
324 }
325 else {
caa7299c
TC
326 my @options;
327 $default = $self->default_template($article, $cfg, \@templates);
ca9aa2bf
TC
328 }
329 return $cgi->popup_menu(-name=>'template',
330 -values=>\@templates,
331 -default=>$default,
332 -override=>1);
333}
334
335sub title_images {
336 my ($self, $article) = @_;
337
338 my @title_images;
339 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
340 if (opendir TITLE_IMAGES, "$imagedir/titles") {
341 @title_images = sort
342 grep -f "$imagedir/titles/$_" && /\.(gif|jpeg|jpg|png)$/i,
343 readdir TITLE_IMAGES;
344 closedir TITLE_IMAGES;
345 }
346
347 @title_images;
348}
349
350sub tag_title_images {
351 my ($self, $article, $cfg, $cgi) = @_;
352
353 my @images = $self->title_images($article);
354 my @values = ( '', @images );
355 my %labels = ( '' => 'None', map { $_ => $_ } @images );
356 return $cgi->
357 popup_menu(-name=>'titleImage',
358 -values=>\@values,
359 -labels=>\%labels,
360 -default=>$article->{id} ? $article->{titleImage} : '',
361 -override=>1);
362}
363
364sub base_template_dirs {
365 return ( "common" );
366}
367
368sub template_dirs {
369 my ($self, $article) = @_;
370
371 my @dirs = $self->base_template_dirs;
372 if (my $parentid = $article->{parentid}) {
373 my $section = "children of $parentid";
374 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
375 push @dirs, split /,/, $dirs;
376 }
377 }
378 if (my $id = $article->{id}) {
379 my $section = "article $id";
380 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
381 push @dirs, split /,/, $dirs;
382 }
383 }
caa7299c
TC
384 if ($article->{level}) {
385 push @dirs, $article->{level};
386 my $dirs = $self->{cfg}->entry("level $article->{level}", 'template_dirs');
387 push @dirs, split /,/, $dirs if $dirs;
388 }
ca9aa2bf
TC
389
390 @dirs;
391}
392
393sub templates {
394 my ($self, $article) = @_;
395
396 my @dirs = $self->template_dirs($article);
397 my @templates;
918735d1
TC
398 my @basedirs = BSE::Template->template_dirs($self->{cfg});
399 for my $basedir (@basedirs) {
400 for my $dir (@dirs) {
401 my $path = File::Spec->catdir($basedir, $dir);
402 if (-d $path) {
403 if (opendir TEMPLATE_DIR, $path) {
404 push(@templates, sort map "$dir/$_",
405 grep -f "$path/$_" && /\.(tmpl|html)$/i, readdir TEMPLATE_DIR);
406 closedir TEMPLATE_DIR;
407 }
ca9aa2bf
TC
408 }
409 }
410 }
918735d1
TC
411
412 # eliminate any dups, and order it nicely
413 my %seen;
414 @templates = sort { lc($a) cmp lc($b) }
415 grep !$seen{$_}++, @templates;
416
ca9aa2bf
TC
417 return (@templates, $self->extra_templates($article));
418}
419
420sub extra_templates {
421 my ($self, $article) = @_;
422
aefcabcb 423 my $basedir = $self->{cfg}->entryVar('paths', 'templates');
ca9aa2bf
TC
424 my @templates;
425 if (my $id = $article->{id}) {
426 push @templates, 'index.tmpl'
427 if $id == 1 && -f "$basedir/index.html";
428 push @templates, 'index2.tmpl'
429 if $id == 2 && -f "$basedir/index2.html";
430 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
431 push @templates, "shop_sect.tmpl"
432 if $id == $shopid && -f "$basedir/shop_sect.tmpl";
433 my $section = "article $id";
434 my $extras = $self->{cfg}->entry($section, 'extra_templates');
435 push @templates, grep /\.(tmpl|html)$/i, split /,/, $extras
436 if $extras;
437 }
438
439 @templates;
440}
441
442sub edit_parent {
443 my ($article) = @_;
444
445 return '' unless $article->{id} && $article->{id} != -1;
446 return <<HTML;
447<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
448HTML
449}
450
451sub iter_allkids {
452 my ($article) = @_;
453
454 return unless $article->{id} && $article->{id} > 0;
455 $article->allkids;
456}
457
458sub _load_step_kids {
459 my ($article, $step_kids) = @_;
460
461 my @stepkids = OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
462 %$step_kids = map { $_->{childId} => $_ } @stepkids;
463 use Data::Dumper;
464 print STDERR "stepkids:\n", Dumper($step_kids);
465 $step_kids->{loaded} = 1;
466}
467
468sub tag_if_step_kid {
469 my ($article, $allkids, $rallkid_index, $step_kids) = @_;
470
471 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
472
473 my $kid = $allkids->[$$rallkid_index]
474 or return;
475 exists $step_kids->{$kid->{id}};
476}
477
478sub tag_step_kid {
479 my ($article, $allkids, $rallkid_index, $step_kids, $arg) = @_;
480
481 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
482
483 my $kid = $allkids->[$$rallkid_index]
484 or return '';
485 print STDERR "found kid (want $arg): ", Dumper $kid;
77804754 486 escape_html($step_kids->{$kid->{id}}{$arg});
ca9aa2bf
TC
487}
488
489sub tag_move_stepkid {
8b0b2f34
TC
490 my ($self, $cgi, $req, $article, $allkids, $rallkids_index, $arg,
491 $acts, $funcname, $templater) = @_;
31a26b52
TC
492
493 $req->user_can(edit_reorder_children => $article)
494 or return '';
ca9aa2bf 495
aefcabcb
TC
496 @$allkids > 1 or return '';
497
8b0b2f34
TC
498 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
499 $img_prefix = '' unless defined $img_prefix;
500 $urladd = '' unless defined $urladd;
501
ca9aa2bf
TC
502 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
503 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
504 my $html = '';
505 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
506 if ($cgi->param('_t')) {
507 $url .= "&_t=".$cgi->param('_t');
508 }
8b0b2f34 509 $url .= $urladd;
ca9aa2bf
TC
510 $url .= "#step";
511 my $refreshto = CGI::escape($url);
d794b180 512 my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />!;
ca9aa2bf
TC
513 if ($$rallkids_index < $#$allkids) {
514 $html .= <<HTML;
64fa5b18 515<a href="$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index+1]{id}&refreshto=$refreshto"><img src="$images_uri/admin/${img_prefix}move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom" /></a>
ca9aa2bf
TC
516HTML
517 }
aefcabcb
TC
518 else {
519 $html .= $blank;
520 }
ca9aa2bf
TC
521 if ($$rallkids_index > 0) {
522 $html .= <<HTML;
64fa5b18 523<a href="$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index-1]{id}&refreshto=$refreshto"><img src="$images_uri/admin/${img_prefix}move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom" /></a>
ca9aa2bf
TC
524HTML
525 }
aefcabcb
TC
526 else {
527 $html .= $blank;
528 }
918735d1 529 $html =~ tr/\n//d;
ca9aa2bf
TC
530 return $html;
531}
532
533sub possible_stepkids {
31a26b52
TC
534 my ($req, $article, $articles, $stepkids) = @_;
535
536 $req->user_can(edit_stepkid_add => $article)
537 or return;
ca9aa2bf 538
31a26b52 539 my @possible = sort { lc $a->{title} cmp lc $b->{title} }
ca9aa2bf 540 grep !$stepkids->{$_->{id}}, $articles->all;
31a26b52
TC
541 if ($req->access_control) {
542 @possible = grep $req->user_can(edit_stepparent_add => $_), @possible;
543 }
544 return @possible;
ca9aa2bf
TC
545}
546
ca9aa2bf 547sub tag_possible_stepkids {
31a26b52 548 my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
ca9aa2bf
TC
549
550 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
31a26b52 551 @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
ca9aa2bf
TC
552 unless @$possstepkids;
553 my %labels = map { $_->{id} => "$_->{title} ($_->{id})" } @$possstepkids;
554 return
555 $cgi->popup_menu(-name=>'stepkid',
556 -values=> [ map $_->{id}, @$possstepkids ],
557 -labels => \%labels);
558}
559
560sub tag_if_possible_stepkids {
31a26b52 561 my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
ca9aa2bf
TC
562
563 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
31a26b52 564 @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
ca9aa2bf
TC
565 unless @$possstepkids;
566
567 @$possstepkids;
568}
569
570sub iter_get_stepparents {
571 my ($article) = @_;
572
573 return unless $article->{id} && $article->{id} > 0;
574
575 OtherParents->getBy(childId=>$article->{id});
576}
577
578sub tag_ifStepParents {
579 my ($args, $acts, $funcname, $templater) = @_;
580
581 return $templater->perform($acts, 'ifStepparents', '');
582}
583
584sub tag_stepparent_targ {
585 my ($article, $targs, $rindex, $arg) = @_;
586
587 if ($article->{id} && $article->{id} > 0 && !@$targs) {
588 @$targs = $article->step_parents;
589 }
77804754 590 escape_html($targs->[$$rindex]{$arg});
ca9aa2bf
TC
591}
592
593sub tag_move_stepparent {
8b0b2f34
TC
594 my ($self, $cgi, $req, $article, $stepparents, $rindex, $arg,
595 $acts, $funcname, $templater) = @_;
31a26b52
TC
596
597 $req->user_can(edit_reorder_stepparents => $article)
598 or return '';
ca9aa2bf 599
aefcabcb
TC
600 @$stepparents > 1 or return '';
601
8b0b2f34
TC
602 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
603 $img_prefix = '' unless defined $img_prefix;
604 $urladd = '' unless defined $urladd;
605
ca9aa2bf
TC
606 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
607 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
608 my $html = '';
609 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
610 if ($cgi->param('_t')) {
611 $url .= "&_t=".$cgi->param('_t');
612 }
8b0b2f34 613 $url .= $urladd;
ca9aa2bf 614 $url .= "#stepparents";
d794b180 615 my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />!;
ca9aa2bf
TC
616 my $refreshto = CGI::escape($url);
617 if ($$rindex < $#$stepparents) {
618 $html .= <<HTML;
64fa5b18 619<a href="$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex+1]{parentId}&refreshto=$refreshto&all=1"><img src="$images_uri/admin/${img_prefix}move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom" /></a>
ca9aa2bf
TC
620HTML
621 }
aefcabcb
TC
622 else {
623 $html .= $blank;
624 }
ca9aa2bf
TC
625 if ($$rindex > 0) {
626 $html .= <<HTML;
64fa5b18 627<a href="$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex-1]{parentId}&refreshto=$refreshto&all=1"><img src="$images_uri/admin/${img_prefix}move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom" /></a>
ca9aa2bf
TC
628HTML
629 }
aefcabcb
TC
630 else {
631 $html .= $blank;
632 }
918735d1 633 $html =~ tr/\n//d;
ca9aa2bf
TC
634 return $html;
635}
636
de193691
TC
637sub _stepparent_possibles {
638 my ($req, $article, $articles, $targs) = @_;
639
640 $req->user_can(edit_stepparent_add => $article)
641 or return;
642
643 @$targs = $article->step_parents unless @$targs;
644 my %targs = map { $_->{id}, 1 } @$targs;
645 my @possibles = grep !$targs{$_->{id}}, $articles->all;
646 if ($req->access_control) {
647 @possibles = grep $req->user_can(edit_stepkid_add => $_), @possibles;
648 }
649 @possibles = sort { lc $a->{title} cmp lc $b->{title} } @possibles;
650
651 return @possibles;
652}
653
ca9aa2bf 654sub tag_if_stepparent_possibles {
31a26b52 655 my ($req, $article, $articles, $targs, $possibles) = @_;
ca9aa2bf 656
de193691
TC
657 if ($article->{id} && $article->{id} > 0 && !@$possibles) {
658 @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
ca9aa2bf
TC
659 }
660 scalar @$possibles;
661}
662
663sub tag_stepparent_possibles {
31a26b52 664 my ($cgi, $req, $article, $articles, $targs, $possibles) = @_;
ca9aa2bf 665
de193691
TC
666 if ($article->{id} && $article->{id} > 0 && !@$possibles) {
667 @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
ca9aa2bf
TC
668 }
669 $cgi->popup_menu(-name=>'stepparent',
670 -values => [ map $_->{id}, @$possibles ],
671 -labels => { map { $_->{id}, "$_->{title} ($_->{id})" }
672 @$possibles });
673}
674
675sub iter_files {
676 my ($article) = @_;
677
678 return unless $article->{id} && $article->{id} > 0;
679
680 return $article->files;
681}
682
683sub tag_edit_parent {
684 my ($article) = @_;
685
686 return '' unless $article->{id} && $article->{id} != -1;
687
688 return <<HTML;
689<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
690HTML
691}
692
693sub tag_if_children {
694 my ($args, $acts, $funcname, $templater) = @_;
695
696 return $templater->perform($acts, 'ifChildren', '');
697}
698
699sub tag_movechild {
8b0b2f34
TC
700 my ($self, $req, $article, $kids, $rindex, $arg,
701 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
702
703 $req->user_can('edit_reorder_children', $article)
704 or return '';
ca9aa2bf 705
aefcabcb
TC
706 @$kids > 1 or return '';
707
ca9aa2bf
TC
708 $$rindex >=0 && $$rindex < @$kids
709 or return '** movechild can only be used in the children iterator **';
710
8b0b2f34
TC
711 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
712 $img_prefix = '' unless defined $img_prefix;
713 $urladd = '' unless defined $urladd;
714
ca9aa2bf
TC
715 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
716 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
cc9019d1
TC
717 my $urlbase = $req->cfg->entryVar('site', 'url');
718 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
719 my $t = $req->cgi->param('_t');
720 if ($t && $t =~ /^\w+$/) {
721 $url .= "&_t=$t";
722 }
723 $url .= $urladd;
77804754 724 $url = escape_uri($url);
ca9aa2bf 725 my $html = '';
d794b180 726 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />';
ca9aa2bf
TC
727 my $id = $kids->[$$rindex]{id};
728 if ($$rindex < $#$kids) {
729 $html .= <<HTML;
64fa5b18 730<a href="$cgi_uri/admin/move.pl?id=$id&d=down&edit=1&all=1&r=$url"><img src="$images_uri/admin/${img_prefix}move_down.gif" width="17" height="13" alt="Move Down" border="0" align="absbottom" /></a>
ca9aa2bf
TC
731HTML
732 }
733 else {
734 $html .= $nomove;
735 }
736 if ($$rindex > 0) {
737 $html .= <<HTML;
64fa5b18 738<a href="$cgi_uri/admin/move.pl?id=$id&d=up&edit=1&all=1&r=$url"><img src="$images_uri/admin/${img_prefix}move_up.gif" width="17" height="13" alt="Move Up" border="0" align="absbottom" /></a>
ca9aa2bf
TC
739HTML
740 }
741 else {
742 $html .= $nomove;
743 }
744 $html =~ tr/\n//d;
745
746 $html;
747}
748
749sub tag_edit_link {
750 my ($args, $acts, $funcname, $templater) = @_;
751 my ($which, $name) = split / /, $args, 2;
752 $name ||= 'Edit';
753 my $gen_class;
754 if ($acts->{$which}
755 && ($gen_class = $templater->perform($acts, $which, 'generator'))) {
756 eval "use $gen_class";
757 unless ($@) {
758 my $gen = $gen_class->new;
759 my $link = $gen->edit_link($templater->perform($acts, $which, 'id'));
760 return qq!<a href="$link">$name</a>!;
761 }
762 }
763 return '';
764}
765
766sub tag_imgmove {
8b0b2f34
TC
767 my ($req, $article, $rindex, $images, $arg,
768 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
769
770 $req->user_can(edit_images_reorder => $article)
771 or return '';
ca9aa2bf 772
aefcabcb
TC
773 @$images > 1 or return '';
774
ca9aa2bf
TC
775 $$rindex >= 0 && $$rindex < @$images
776 or return '** imgmove can only be used in image iterator **';
777
8b0b2f34
TC
778 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
779 $img_prefix = '' unless defined $img_prefix;
780 $urladd = '' unless defined $urladd;
781
782 my $urlbase = $req->cfg->entryVar('site', 'url');
cc9019d1
TC
783 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
784 my $t = $req->cgi->param('_t');
785 if ($t && $t =~ /^\w+$/) {
786 $url .= "&_t=$t";
787 }
788 $url .= $urladd;
8b0b2f34
TC
789 $url = CGI::escape($url);
790
ca9aa2bf 791 my $html = '';
d794b180 792 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />';
ca9aa2bf
TC
793 my $image = $images->[$$rindex];
794 if ($$rindex > 0) {
795 $html .= <<HTML
64fa5b18 796<a href="$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgup=1&imageid=$image->{id}&r=$url"><img src="/images/admin/${img_prefix}move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom" /></a>
ca9aa2bf
TC
797HTML
798 }
799 else {
800 $html .= $nomove;
801 }
802 if ($$rindex < $#$images) {
803 $html .= <<HTML
64fa5b18 804<a href="$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgdown=1&imageid=$image->{id}&r=$url"><img src="/images/admin/${img_prefix}move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom" /></a>
ca9aa2bf
TC
805HTML
806 }
807 else {
808 $html .= $nomove;
809 }
918735d1 810 $html =~ tr/\n//d;
ca9aa2bf
TC
811 return $html;
812}
813
814sub tag_movefiles {
8b0b2f34
TC
815 my ($self, $req, $article, $files, $rindex, $arg,
816 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
817
818 $req->user_can('edit_files_reorder', $article)
819 or return '';
ca9aa2bf 820
aefcabcb
TC
821 @$files > 1 or return '';
822
8b0b2f34
TC
823 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
824 $img_prefix = '' unless defined $img_prefix;
825 $urladd = '' unless defined $urladd;
826
ca9aa2bf
TC
827 my $html = '';
828
829 $$rindex >= 0 && $$rindex < @$files
830 or return '** movefiles can only be used in the files iterator **';
831
d794b180 832 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />';
ca9aa2bf 833 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
8b0b2f34
TC
834
835 my $urlbase = $self->{cfg}->entryVar('site', 'url');
836 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}&filelist=1$urladd";
837 $url = CGI::escape($url);
ca9aa2bf
TC
838
839 if ($$rindex < $#$files) {
840 $html .= <<HTML;
64fa5b18 841<a href="$ENV{SCRIPT_NAME}?fileswap=1&id=$article->{id}&file1=$files->[$$rindex]{id}&file2=$files->[$$rindex+1]{id}&r=$url"><img src="$images_uri/admin/${img_prefix}move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom" /></a>
ca9aa2bf
TC
842HTML
843 }
844 else {
845 $html .= $nomove;
846 }
847 if ($$rindex > 0) {
848 $html .= <<HTML;
64fa5b18 849<a href="$ENV{SCRIPT_NAME}?fileswap=1&id=$article->{id}&file1=$files->[$$rindex]{id}&file2=$files->[$$rindex-1]{id}&r=$url"><img src="$images_uri/admin/${img_prefix}move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom" /></a>
ca9aa2bf
TC
850HTML
851 }
852 else {
853 $html .= $nomove;
854 }
855 $html =~ tr/\n//d;
856 $html;
857}
858
859sub tag_old {
860 my ($article, $cgi, $args, $acts, $funcname, $templater) = @_;
861
862 my ($col, $func, $funcargs) = split ' ', $args, 3;
863 my $value = $cgi->param($col);
864 if (defined $value) {
77804754 865 return escape_html($value);
ca9aa2bf
TC
866 }
867 else {
868 if ($func) {
869 return $templater->perform($acts, $func, $funcargs);
870 }
871 else {
872 $value = $article->{$args};
873 defined $value or $value = '';
77804754 874 return escape_html($value);
ca9aa2bf
TC
875 }
876 }
877}
878
08123550
TC
879sub iter_admin_users {
880 require BSE::TB::AdminUsers;
881
882 BSE::TB::AdminUsers->all;
883}
884
885sub iter_admin_groups {
886 require BSE::TB::AdminGroups;
887
888 BSE::TB::AdminGroups->all;
889}
890
9168c88c
TC
891sub tag_if_field_perm {
892 my ($req, $article, $field) = @_;
893
abf5bbc6
TC
894 unless ($field =~ /^\w+$/) {
895 print STDERR "Bad fieldname '$field'\n";
896 return;
897 }
9168c88c 898 if ($article->{id}) {
abf5bbc6 899 return $req->user_can("edit_field_edit_$field", $article);
9168c88c
TC
900 }
901 else {
4010d92e 902 #print STDERR "adding, always successful\n";
abf5bbc6 903 return 1;
9168c88c
TC
904 }
905}
906
907sub tag_default {
908 my ($self, $req, $article, $args, $acts, $funcname, $templater) = @_;
909
910 my ($col, $func, $funcargs) = split ' ', $args, 3;
911 if ($article->{id}) {
912 if ($func) {
913 return $templater->perform($acts, $func, $funcargs);
914 }
915 else {
916 my $value = $article->{$args};
917 defined $value or $value = '';
77804754 918 return escape_html($value);
9168c88c
TC
919 }
920 }
921 else {
922 my $value = $self->default_value($req, $article, $col);
77804754 923 return escape_html($value);
9168c88c
TC
924 }
925}
926
918735d1
TC
927sub iter_flags {
928 my ($self) = @_;
929
930 $self->flags;
931}
932
933sub tag_if_flag_set {
934 my ($article, $arg, $acts, $funcname, $templater) = @_;
935
936 my @args = DevHelp::Tags->get_parms($arg, $acts, $templater);
937 @args or return;
938
939 return index($article->{flags}, $args[0]) >= 0;
940}
941
8b0b2f34
TC
942sub iter_crumbs {
943 my ($article, $articles) = @_;
944
945 my @crumbs;
946 my $temp = $article;
947 defined($temp->{parentid}) or return;
948 while ($temp->{parentid} > 0
949 and my $crumb = $articles->getByPkey($temp->{parentid})) {
950 unshift @crumbs, $crumb;
951 $temp = $crumb;
952 }
953
954 @crumbs;
955}
956
957sub tag_typename {
958 my ($args, $acts, $funcname, $templater) = @_;
959
960 exists $acts->{$args} or return "** need an article name **";
961 my $generator = $templater->perform($acts, $args, 'generator');
962
963 $generator =~ /^(?:BSE::)?Generate::(\w+)$/
964 or return "** invalid generator $generator **";
965
966 return $1;
967}
968
ca9aa2bf
TC
969sub low_edit_tags {
970 my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
971
972 my $cgi = $request->cgi;
6473c56f 973 $msg ||= $cgi->param('message');
ca9aa2bf
TC
974 $msg ||= '';
975 $errors ||= {};
976 if (keys %$errors && !$msg) {
977 # try to get the errors in the same order as the table
978 my @cols = $self->table_object($articles)->rowClass->columns;
979 my %work = %$errors;
980 my @out = grep defined, delete @work{@cols};
981
982 $msg = join "<br>", @out, values %work;
983 }
abf5bbc6
TC
984 my $parent;
985 if ($article->{id}) {
986 if ($article->{parentid} > 0) {
987 $parent = $article->parent;
988 }
989 else {
990 $parent = { title=>"No parent - this is a section", id=>-1 };
991 }
992 }
993 else {
994 $parent = { title=>"How did we get here?", id=>0 };
995 }
ca9aa2bf
TC
996 my @images;
997 my $image_index;
998 my @children;
999 my $child_index;
1000 my %stepkids;
1001 my $cfg = $self->{cfg};
1002 my @allkids;
1003 my $allkid_index;
1004 my @possstepkids;
1005 my @stepparents;
1006 my $stepparent_index;
1007 my @stepparent_targs;
1008 my @stepparentpossibles;
1009 my @files;
1010 my $file_index;
1011 return
1012 (
1013 BSE::Util::Tags->basic($acts, $cgi, $cfg),
1014 BSE::Util::Tags->admin($acts, $cfg),
9168c88c 1015 BSE::Util::Tags->secure($request),
ca9aa2bf
TC
1016 article => [ \&tag_hash, $article ],
1017 old => [ \&tag_old, $article, $cgi ],
9168c88c 1018 default => [ \&tag_default, $self, $request, $article ],
ca9aa2bf
TC
1019 articleType => [ \&tag_art_type, $article->{level}, $cfg ],
1020 parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
918735d1 1021 ifNew => [ \&tag_if_new, $article ],
9168c88c 1022 list => [ \&tag_list, $self, $article, $articles, $cgi, $request ],
ca9aa2bf
TC
1023 script => $ENV{SCRIPT_NAME},
1024 level => $article->{level},
1025 checked => \&tag_checked,
1026 DevHelp::Tags->make_iterator2
daee3409 1027 ([ \&iter_get_images, $self, $article ], 'image', 'images', \@images,
ca9aa2bf 1028 \$image_index),
abf5bbc6 1029 imgmove => [ \&tag_imgmove, $request, $article, \$image_index, \@images ],
ca9aa2bf
TC
1030 message => $msg,
1031 DevHelp::Tags->make_iterator2
1032 ([ \&iter_get_kids, $article, $articles ],
1033 'child', 'children', \@children, \$child_index),
1034 ifchildren => \&tag_if_children,
1035 childtype => [ \&tag_art_type, $article->{level}+1, $cfg ],
1036 ifHaveChildType => [ \&tag_if_have_child_type, $article->{level}, $cfg ],
abf5bbc6
TC
1037 movechild => [ \&tag_movechild, $self, $request, $article, \@children,
1038 \$child_index],
ca9aa2bf
TC
1039 is => \&tag_is,
1040 templates => [ \&tag_templates, $self, $article, $cfg, $cgi ],
1041 titleImages => [ \&tag_title_images, $self, $article, $cfg, $cgi ],
1042 editParent => [ \&tag_edit_parent, $article ],
1043 DevHelp::Tags->make_iterator2
1044 ([ \&iter_allkids, $article ], 'kid', 'kids', \@allkids, \$allkid_index),
1045 ifStepKid =>
1046 [ \&tag_if_step_kid, $article, \@allkids, \$allkid_index, \%stepkids ],
1047 stepkid => [ \&tag_step_kid, $article, \@allkids, \$allkid_index,
1048 \%stepkids ],
1049 movestepkid =>
31a26b52
TC
1050 [ \&tag_move_stepkid, $self, $cgi, $request, $article, \@allkids,
1051 \$allkid_index ],
ca9aa2bf 1052 possible_stepkids =>
31a26b52
TC
1053 [ \&tag_possible_stepkids, \%stepkids, $request, $article,
1054 \@possstepkids, $articles, $cgi ],
ca9aa2bf 1055 ifPossibles =>
31a26b52
TC
1056 [ \&tag_if_possible_stepkids, \%stepkids, $request, $article,
1057 \@possstepkids, $articles, $cgi ],
ca9aa2bf
TC
1058 DevHelp::Tags->make_iterator2
1059 ( [ \&iter_get_stepparents, $article ], 'stepparent', 'stepparents',
1060 \@stepparents, \$stepparent_index),
1061 ifStepParents => \&tag_ifStepParents,
1062 stepparent_targ =>
1063 [ \&tag_stepparent_targ, $article, \@stepparent_targs,
1064 \$stepparent_index ],
1065 movestepparent =>
31a26b52 1066 [ \&tag_move_stepparent, $self, $cgi, $request, $article, \@stepparents,
ca9aa2bf
TC
1067 \$stepparent_index ],
1068 ifStepparentPossibles =>
31a26b52
TC
1069 [ \&tag_if_stepparent_possibles, $request, $article, $articles,
1070 \@stepparent_targs, \@stepparentpossibles, ],
ca9aa2bf 1071 stepparent_possibles =>
31a26b52 1072 [ \&tag_stepparent_possibles, $cgi, $request, $article, $articles,
ca9aa2bf
TC
1073 \@stepparent_targs, \@stepparentpossibles, ],
1074 DevHelp::Tags->make_iterator2
1075 ([ \&iter_files, $article ], 'file', 'files', \@files, \$file_index ),
abf5bbc6
TC
1076 movefiles =>
1077 [ \&tag_movefiles, $self, $request, $article, \@files, \$file_index ],
08123550
TC
1078 DevHelp::Tags->make_iterator2
1079 (\&iter_admin_users, 'iadminuser', 'adminusers'),
1080 DevHelp::Tags->make_iterator2
1081 (\&iter_admin_groups, 'iadmingroup', 'admingroups'),
ca9aa2bf
TC
1082 edit => \&tag_edit_link,
1083 error => [ \&tag_hash, $errors ],
b553afa2 1084 error_img => [ \&tag_error_img, $cfg, $errors ],
9168c88c 1085 ifFieldPerm => [ \&tag_if_field_perm, $request, $article ],
abf5bbc6 1086 parent => [ \&tag_hash, $parent ],
918735d1
TC
1087 DevHelp::Tags->make_iterator2
1088 ([ \&iter_flags, $self ], 'flag', 'flags' ),
1089 ifFlagSet => [ \&tag_if_flag_set, $article ],
8b0b2f34
TC
1090 DevHelp::Tags->make_iterator2
1091 ([ \&iter_crumbs, $article, $articles ], 'crumb', 'crumbs' ),
1092 typename => \&tag_typename,
ca9aa2bf
TC
1093 );
1094}
1095
1096sub edit_template {
1097 my ($self, $article, $cgi) = @_;
1098
1099 my $base = $article->{level};
1100 my $t = $cgi->param('_t');
1101 if ($t && $t =~ /^\w+$/) {
1102 $base = $t;
1103 }
1104 return $self->{cfg}->entry('admin templates', $base,
1105 "admin/edit_$base");
1106}
1107
1108sub add_template {
1109 my ($self, $article, $cgi) = @_;
1110
1111 $self->edit_template($article, $cgi);
1112}
1113
1114sub low_edit_form {
1115 my ($self, $request, $article, $articles, $msg, $errors) = @_;
1116
1117 my $cgi = $request->cgi;
1118 my %acts;
1119 %acts = $self->low_edit_tags(\%acts, $request, $article, $articles, $msg,
1120 $errors);
1121 my $template = $article->{id} ?
1122 $self->edit_template($article, $cgi) : $self->add_template($article, $cgi);
1123
1124 return BSE::Template->get_response($template, $request->cfg, \%acts);
1125}
1126
1127sub edit_form {
1128 my ($self, $request, $article, $articles, $msg, $errors) = @_;
1129
1130 return $self->low_edit_form($request, $article, $articles, $msg, $errors);
1131}
1132
1133sub add_form {
9168c88c 1134 my ($self, $req, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
1135
1136 my $level;
9168c88c 1137 my $cgi = $req->cgi;
ca9aa2bf
TC
1138 my $parentid = $cgi->param('parentid');
1139 if ($parentid) {
1140 if ($parentid =~ /^\d+$/) {
1141 if (my $parent = $self->get_parent($parentid, $articles)) {
1142 $level = $parent->{level}+1;
1143 }
1144 else {
1145 $parentid = undef;
1146 }
1147 }
1148 elsif ($parentid eq "-1") {
1149 $level = 1;
1150 }
1151 }
1152 unless (defined $level) {
1153 $level = $cgi->param('level');
1154 undef $level unless defined $level && $level =~ /^\d+$/
1155 && $level > 0 && $level < 100;
1156 defined $level or $level = 3;
1157 }
1158
1159 my %article;
1160 my @cols = Article->columns;
1161 @article{@cols} = ('') x @cols;
1162 $article{id} = '';
1163 $article{parentid} = $parentid;
1164 $article{level} = $level;
1165 $article{body} = '<maximum of 64Kb>';
1166 $article{listed} = 1;
1167 $article{generator} = $self->generator;
1168
9168c88c
TC
1169 my ($values, $labels) = $self->possible_parents(\%article, $articles, $req);
1170 @$values
a0a8147b
TC
1171 or return $self->edit_sections($req, $articles,
1172 "You can't add children to any article at that level");
9168c88c
TC
1173
1174 return $self->low_edit_form($req, \%article, $articles, $msg, $errors);
ca9aa2bf
TC
1175}
1176
1177sub generator { 'Generate::Article' }
1178
331fd099
TC
1179sub typename {
1180 my ($self) = @_;
1181
1182 my $gen = $self->generator;
1183
1184 ($gen =~ /(\w+)$/)[0] || 'Article';
1185}
1186
ca9aa2bf 1187sub _validate_common {
b553afa2 1188 my ($self, $data, $articles, $errors, $article) = @_;
ca9aa2bf 1189
918735d1
TC
1190# if (defined $data->{parentid} && $data->{parentid} =~ /^(?:-1|\d+)$/) {
1191# unless ($data->{parentid} == -1 or
1192# $articles->getByPkey($data->{parentid})) {
1193# $errors->{parentid} = "Selected parent article doesn't exist";
1194# }
1195# }
1196# else {
1197# $errors->{parentid} = "You need to select a valid parent";
1198# }
1199 if (exists $data->{title} && $data->{title} !~ /\S/) {
1200 $errors->{title} = "Please enter a title";
ca9aa2bf
TC
1201 }
1202
1203 if (exists $data->{template} && $data->{template} =~ /\.\./) {
1204 $errors->{template} = "Please only select templates from the list provided";
1205 }
1206
1207}
1208
1209sub validate {
918735d1 1210 my ($self, $data, $articles, $errors) = @_;
ca9aa2bf
TC
1211
1212 $self->_validate_common($data, $articles, $errors);
331fd099
TC
1213 custom_class($self->{cfg})
1214 ->article_validate($data, undef, $self->typename, $errors);
ca9aa2bf
TC
1215
1216 return !keys %$errors;
1217}
1218
1219sub validate_old {
918735d1 1220 my ($self, $article, $data, $articles, $errors) = @_;
ca9aa2bf 1221
b553afa2 1222 $self->_validate_common($data, $articles, $errors, $article);
331fd099
TC
1223 custom_class($self->{cfg})
1224 ->article_validate($data, $article, $self->typename, $errors);
ca9aa2bf 1225
b553afa2
TC
1226 if (exists $data->{release} && !valid_date($data->{release})) {
1227 $errors->{release} = "Invalid release date";
1228 }
1229
ca9aa2bf
TC
1230 return !keys %$errors;
1231}
1232
1233sub validate_parent {
1234 1;
1235}
1236
1237sub fill_new_data {
1238 my ($self, $req, $data, $articles) = @_;
1239
331fd099
TC
1240 custom_class($self->{cfg})
1241 ->article_fill_new($data, $self->typename);
1242
ca9aa2bf
TC
1243 1;
1244}
1245
95989433
TC
1246sub link_path {
1247 my ($self, $article) = @_;
1248
1249 # check the config for the article and any of its ancestors
1250 my $work_article = $article;
1251 my $path = $self->{cfg}->entry('article uris', $work_article->{id});
1252 while (!$path) {
1253 last if $work_article->{parentid} == -1;
1254 $work_article = $work_article->parent;
1255 $path = $self->{cfg}->entry('article uris', $work_article->{id});
1256 }
1257 return $path if $path;
1258
1259 $self->default_link_path($article);
1260}
1261
1262sub default_link_path {
1263 my ($self, $article) = @_;
1264
1265 $self->{cfg}->entry('uri', 'articles', '/a');
1266}
1267
ca9aa2bf
TC
1268sub make_link {
1269 my ($self, $article) = @_;
1270
95989433 1271 my $article_uri = $self->link_path($article);
ca9aa2bf
TC
1272 my $link = "$article_uri/$article->{id}.html";
1273 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1274 if ($link_titles) {
1275 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1276 $link .= "/".$extra;
1277 }
1278
1279 $link;
1280}
1281
1282sub save_new {
1283 my ($self, $req, $articles) = @_;
1284
1285 my $cgi = $req->cgi;
1286 my %data;
1287 my $table_object = $self->table_object($articles);
1288 my @columns = $table_object->rowClass->columns;
1289 $self->save_thumbnail($cgi, undef, \%data);
1290 for my $name (@columns) {
9168c88c
TC
1291 $data{$name} = $cgi->param($name)
1292 if defined $cgi->param($name);
ca9aa2bf 1293 }
918735d1 1294 $data{flags} = join '', sort $cgi->param('flags');
ca9aa2bf
TC
1295
1296 my $msg;
1297 my %errors;
918735d1 1298 $self->validate(\%data, $articles, \%errors)
ca9aa2bf
TC
1299 or return $self->add_form($req, $articles, $msg, \%errors);
1300
1301 my $parent;
1302 if ($data{parentid} > 0) {
1303 $parent = $articles->getByPkey($data{parentid}) or die;
9168c88c
TC
1304 $req->user_can('edit_add_child', $parent)
1305 or return $self->add_form($req, $articles,
1306 "You cannot add a child to that article");
1307 for my $name (@columns) {
1308 if (exists $data{$name} &&
1309 !$req->user_can("edit_add_field_$name", $parent)) {
1310 delete $data{$name};
1311 }
1312 }
ca9aa2bf 1313 }
9168c88c
TC
1314 else {
1315 $req->user_can('edit_add_child')
1316 or return $self->add_form($req, $articles,
1317 "You cannot create a top-level article");
1318 for my $name (@columns) {
1319 if (exists $data{$name} &&
1320 !$req->user_can("edit_add_field_$name")) {
1321 delete $data{$name};
1322 }
1323 }
1324 }
1325
ca9aa2bf
TC
1326 $self->validate_parent(\%data, $articles, $parent, \$msg)
1327 or return $self->add_form($req, $articles, $msg);
1328
1329 $self->fill_new_data($req, \%data, $articles);
1330 my $level = $parent ? $parent->{level}+1 : 1;
9168c88c 1331 $data{displayOrder} = time;
ca9aa2bf
TC
1332 $data{titleImage} ||= '';
1333 $data{imagePos} = 'tr';
1334 $data{release} = sql_date($data{release}) || now_sqldate();
1335 $data{expire} = sql_date($data{expire}) || $Constants::D_99;
1336 unless ($data{template}) {
1337 $data{template} ||=
1338 $self->{cfg}->entry("children of $data{parentid}", 'template');
1339 $data{template} ||=
1340 $self->{cfg}->entry("level $level", 'template');
1341 }
1342 $data{link} ||= '';
1343 $data{admin} ||= '';
1344 if ($parent) {
1345 $data{threshold} = $parent->{threshold}
1346 if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1347 $data{summaryLength} = $parent->{summaryLength}
1348 if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1349 }
1350 else {
1351 $data{threshold} = $self->{cfg}->entry("level $level", 'threshold', 5)
1352 if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1353 $data{summaryLength} = 200
1354 if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1355 }
1356 $data{generator} = $self->generator;
1357 $data{lastModified} = now_sqldate();
1358 $data{level} = $level;
1359 $data{listed} = 1 unless defined $data{listed};
1360
1361 shift @columns;
1362 my $article = $table_object->add(@data{@columns});
1363
1364 # we now have an id - generate the links
1365
1366 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1367 $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1368 $article->setLink($self->make_link($article));
1369 $article->save();
1370
caa7299c
TC
1371 use Util 'generate_article';
1372 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1373
8b0b2f34
TC
1374 my $r = $cgi->param('r');
1375 if ($r) {
1376 $r .= ($r =~ /\?/) ? '&' : '?';
1377 $r .= "id=$article->{id}";
1378 }
1379 else {
1380 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1381 $r = $urlbase . $article->{admin};
1382 }
1383 return BSE::Template->get_refresh($r, $self->{cfg});
1384
ca9aa2bf
TC
1385}
1386
1387sub fill_old_data {
0d5ccc7f 1388 my ($self, $req, $article, $data) = @_;
ca9aa2bf 1389
4010d92e
TC
1390 if (exists $data->{body}) {
1391 $data->{body} =~ s/\x0D\x0A/\n/g;
1392 $data->{body} =~ tr/\r/\n/;
1393 }
ca9aa2bf 1394 for my $col (Article->columns) {
331fd099 1395 next if $col =~ /^custom/;
ca9aa2bf
TC
1396 $article->{$col} = $data->{$col}
1397 if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1398 }
331fd099
TC
1399 custom_class($self->{cfg})
1400 ->article_fill_old($article, $data, $self->typename);
ca9aa2bf
TC
1401
1402 return 1;
1403}
1404
1405sub save {
1406 my ($self, $req, $article, $articles) = @_;
4010d92e
TC
1407
1408 $req->user_can(edit_save => $article)
1409 or return $self->edit_form($req, $article, $articles,
1410 "You don't have access to save this article");
ca9aa2bf
TC
1411
1412 my $cgi = $req->cgi;
1413 my %data;
1414 for my $name ($article->columns) {
1415 $data{$name} = $cgi->param($name)
abf5bbc6
TC
1416 if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid'
1417 && $req->user_can("edit_field_edit_$name", $article);
ca9aa2bf 1418 }
918735d1
TC
1419 # possibly this needs tighter error checking
1420 $data{flags} = join '', sort $cgi->param('flags')
1421 if $req->user_can("edit_field_edit_flags", $article);
ca9aa2bf
TC
1422 my %errors;
1423 $self->validate_old($article, \%data, $articles, \%errors)
1424 or return $self->edit_form($req, $article, $articles, undef, \%errors);
abf5bbc6
TC
1425 $self->save_thumbnail($cgi, $article, \%data)
1426 if $req->user_can('edit_field_edit_thumbImage', $article);
ca9aa2bf
TC
1427 $self->fill_old_data($req, $article, \%data);
1428 if (exists $article->{template} &&
1429 $article->{template} =~ m|\.\.|) {
1430 my $msg = "Please only select templates from the list provided";
1431 return $self->edit_form($req, $article, $articles, $msg);
1432 }
1433
1434 # reparenting
1435 my $newparentid = $cgi->param('parentid');
abf5bbc6
TC
1436 if ($newparentid && $req->user_can('edit_field_edit_parentid', $article)) {
1437 if ($newparentid == $article->{parentid}) {
1438 # nothing to do
1439 }
1440 elsif ($newparentid != -1) {
1441 print STDERR "Reparenting...\n";
1442 my $newparent = $articles->getByPkey($newparentid);
1443 if ($newparent) {
1444 if ($newparent->{level} != $article->{level}-1) {
1445 # the article cannot become a child of itself or one of it's
1446 # children
1447 if ($article->{id} == $newparentid
1448 || $self->is_descendant($article->{id}, $newparentid, $articles)) {
1449 my $msg = "Cannot become a child of itself or of a descendant";
1450 return $self->edit_form($req, $article, $articles, $msg);
1451 }
1452 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1453 if ($self->is_descendant($article->{id}, $shopid, $articles)) {
1454 my $msg = "Cannot become a descendant of the shop";
1455 return $self->edit_form($req, $article, $articles, $msg);
1456 }
1457 my $msg;
1458 $self->reparent($article, $newparentid, $articles, \$msg)
1459 or return $self->edit_form($req, $article, $articles, $msg);
ca9aa2bf 1460 }
abf5bbc6
TC
1461 else {
1462 # stays at the same level, nothing special
1463 $article->{parentid} = $newparentid;
ca9aa2bf 1464 }
ca9aa2bf 1465 }
abf5bbc6
TC
1466 # else ignore it
1467 }
1468 else {
1469 # becoming a section
1470 my $msg;
1471 $self->reparent($article, -1, $articles, \$msg)
1472 or return $self->edit_form($req, $article, $articles, $msg);
ca9aa2bf 1473 }
ca9aa2bf
TC
1474 }
1475
abf5bbc6
TC
1476 $article->{listed} = $cgi->param('listed')
1477 if defined $cgi->param('listed') &&
1478 $req->user_can('edit_field_edit_listed', $article);
1479 $article->{release} = sql_date($cgi->param('release'))
1480 if defined $cgi->param('release') &&
1481 $req->user_can('edit_field_edit_release', $article);
1482
1483 $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99
1484 if defined $cgi->param('expire') &&
1485 $req->user_can('edit_field_edit_expire', $article);
ca9aa2bf
TC
1486 $article->{lastModified} = now_sqldate();
1487 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
95989433
TC
1488 if ($article->{link} &&
1489 !$self->{cfg}->entry('protect link', $article->{id})) {
1490 my $article_uri = $self->make_link($article);
1491 if ($link_titles) {
1492 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1493 $article_uri .= $extra;
1494 }
1495 $article->setLink($article_uri);
ca9aa2bf
TC
1496 }
1497
1498 $article->save();
caa7299c
TC
1499
1500 use Util 'generate_article';
1501 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1502
8b0b2f34 1503 return $self->refresh($article, $cgi, undef, 'Article saved');
ca9aa2bf
TC
1504}
1505
1506sub sql_date {
1507 my $str = shift;
1508 my ($year, $month, $day);
1509
1510 # look for a date
1511 if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
1512 $year += 2000 if $year < 100;
1513
1514 return sprintf("%04d-%02d-%02d", $year, $month, $day);
1515 }
1516 return undef;
1517}
1518
1519sub reparent {
1520 my ($self, $article, $newparentid, $articles, $rmsg) = @_;
1521
1522 my $newlevel;
1523 if ($newparentid == -1) {
1524 $newlevel = 1;
1525 }
1526 else {
1527 my $parent = $articles->getByPkey($newparentid);
1528 unless ($parent) {
1529 $$rmsg = "Cannot get new parent article";
1530 return;
1531 }
1532 $newlevel = $parent->{level} + 1;
1533 }
1534 # the caller will save this one
1535 $article->{parentid} = $newparentid;
1536 $article->{level} = $newlevel;
1537 $article->{displayOrder} = time;
1538
1539 my @change = ( [ $article->{id}, $newlevel ] );
1540 while (@change) {
1541 my $this = shift @change;
1542 my ($art, $level) = @$this;
1543
1544 my @kids = $articles->getBy(parentid=>$art);
1545 push @change, map { [ $_->{id}, $level+1 ] } @kids;
1546
1547 for my $kid (@kids) {
1548 $kid->{level} = $level+1;
1549 $kid->save;
1550 }
1551 }
1552
1553 return 1;
1554}
1555
1556# tests if $desc is a descendant of $art
1557# where both are article ids
1558sub is_descendant {
1559 my ($self, $art, $desc, $articles) = @_;
1560
1561 my @check = ($art);
1562 while (@check) {
1563 my $parent = shift @check;
1564 $parent == $desc and return 1;
1565 my @kids = $articles->getBy(parentid=>$parent);
1566 push @check, map $_->{id}, @kids;
1567 }
1568
1569 return 0;
1570}
1571
1572sub save_thumbnail {
1573 my ($self, $cgi, $original, $newdata) = @_;
1574
1575 unless ($original) {
1576 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1577 }
1578 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
1579 if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
1580 unlink("$imagedir/$original->{thumbImage}");
1581 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1582 }
1583 my $image = $cgi->param('thumbnail');
1584 if ($image && -s $image) {
1585 # where to put it...
1586 my $name = '';
1587 $image =~ /([\w.-]+)$/ and $name = $1;
1588 my $filename = time . "_" . $name;
1589
1590 use Fcntl;
1591 my $counter = "";
1592 $filename = time . '_' . $counter . '_' . $name
1593 until sysopen( OUTPUT, "$imagedir/$filename",
1594 O_WRONLY| O_CREAT| O_EXCL)
1595 || ++$counter > 100;
1596
1597 fileno(OUTPUT) or die "Could not open image file: $!";
1598 binmode OUTPUT;
1599 my $buffer;
1600
1601 #no strict 'refs';
1602
1603 # read the image in from the browser and output it to our
1604 # output filehandle
1605 print STDERR "\$image ",ref $image,"\n";
1606 seek $image, 0, 0;
1607 print OUTPUT $buffer while sysread $image, $buffer, 1024;
1608
1609 close OUTPUT
1610 or die "Could not close image output file: $!";
1611
1612 use Image::Size;
1613
1614 if ($original && $original->{thumbImage}) {
1615 #unlink("$imagedir/$original->{thumbImage}");
1616 }
1617 @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
1618 $newdata->{thumbImage} = $filename;
1619 }
1620}
1621
1622sub child_types {
1623 my ($self, $article) = @_;
1624
1625 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1626 if ($article && $article->{id} && $article->{id} == $shopid) {
1627 return ( 'BSE::Edit::Catalog' );
1628 }
1629 return ( 'BSE::Edit::Article' );
1630}
1631
1632sub add_stepkid {
1633 my ($self, $req, $article, $articles) = @_;
1634
31a26b52
TC
1635 $req->user_can(edit_stepkid_add => $article)
1636 or return $self->edit_form($req, $article, $articles,
1637 "You don't have access to add step children to this article");
1638
ca9aa2bf
TC
1639 my $cgi = $req->cgi;
1640 require 'BSE/Admin/StepParents.pm';
1641 eval {
1642 my $childId = $cgi->param('stepkid');
1643 defined $childId
1644 or die "No stepkid supplied to add_stepkid";
1645 $childId =~ /^\d+$/
1646 or die "Invalid stepkid supplied to add_stepkid";
1647 my $child = $articles->getByPkey($childId)
1648 or die "Article $childId not found";
31a26b52
TC
1649
1650 $req->user_can(edit_stepparent_add => $child)
1651 or die "You don't have access to add a stepparent to that article\n";
ca9aa2bf
TC
1652
1653 use BSE::Util::Valid qw/valid_date/;
1654 my $release = $cgi->param('release');
1655 valid_date($release) or $release = undef;
1656 my $expire = $cgi->param('expire');
1657 valid_date($expire) or $expire = undef;
1658
1659 my $newentry =
1660 BSE::Admin::StepParents->add($article, $child, $release, $expire);
1661 };
1662 if ($@) {
1663 return $self->edit_form($req, $article, $articles, $@);
1664 }
a0a8147b
TC
1665
1666 use Util 'generate_article';
1667 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1668
8b0b2f34 1669 return $self->refresh($article, $cgi, 'step', 'Stepchild added');
ca9aa2bf
TC
1670}
1671
1672sub del_stepkid {
1673 my ($self, $req, $article, $articles) = @_;
1674
31a26b52
TC
1675 $req->user_can(edit_stepkid_delete => $article)
1676 or return $self->edit_form($req, $article, $articles,
1677 "You don't have access to delete stepchildren from this article");
1678
ca9aa2bf
TC
1679 my $cgi = $req->cgi;
1680 require 'BSE/Admin/StepParents.pm';
1681 eval {
1682 my $childId = $cgi->param('stepkid');
1683 defined $childId
1684 or die "No stepkid supplied to add_stepkid";
1685 $childId =~ /^\d+$/
1686 or die "Invalid stepkid supplied to add_stepkid";
1687 my $child = $articles->getByPkey($childId)
1688 or die "Article $childId not found";
31a26b52
TC
1689
1690 $req->user_can(edit_stepparent_delete => $child)
1691 or die "You cannot remove stepparents from that article\n";
ca9aa2bf
TC
1692
1693 BSE::Admin::StepParents->del($article, $child);
1694 };
1695
1696 if ($@) {
1697 return $self->edit_form($req, $article, $articles, $@);
1698 }
a0a8147b
TC
1699 use Util 'generate_article';
1700 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1701
8b0b2f34 1702 return $self->refresh($article, $cgi, 'step', 'Stepchild deleted');
ca9aa2bf
TC
1703}
1704
1705sub save_stepkids {
1706 my ($self, $req, $article, $articles) = @_;
1707
31a26b52
TC
1708 $req->user_can(edit_stepkid_save => $article)
1709 or return $self->edit_form($req, $article, $articles,
1710 "No access to save stepkid data for this article");
1711
ca9aa2bf
TC
1712 my $cgi = $req->cgi;
1713 require 'BSE/Admin/StepParents.pm';
1714 my @stepcats = OtherParents->getBy(parentId=>$article->{id});
1715 my %stepcats = map { $_->{parentId}, $_ } @stepcats;
1716 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1717 for my $stepcat (@stepcats) {
31a26b52
TC
1718 $req->user_can(edit_stepparent_save => $stepcat->{childId})
1719 or next;
ca9aa2bf
TC
1720 for my $name (qw/release expire/) {
1721 my $date = $cgi->param($name.'_'.$stepcat->{childId});
1722 if (defined $date) {
1723 if ($date eq '') {
1724 $date = $datedefs{$name};
1725 }
1726 elsif (valid_date($date)) {
1727 use BSE::Util::SQL qw/date_to_sql/;
1728 $date = date_to_sql($date);
1729 }
1730 else {
1731 return $self->refresh($article, $cgi, '', "Invalid date '$date'");
1732 }
1733 $stepcat->{$name} = $date;
1734 }
1735 }
1736 eval {
1737 $stepcat->save();
1738 };
1739 $@ and return $self->refresh($article, $cgi, '', $@);
1740 }
a0a8147b
TC
1741 use Util 'generate_article';
1742 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1743
8b0b2f34 1744 return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
ca9aa2bf
TC
1745}
1746
1747sub add_stepparent {
1748 my ($self, $req, $article, $articles) = @_;
1749
31a26b52
TC
1750 $req->user_can(edit_stepparent_add => $article)
1751 or return $self->edit_form($req, $article, $articles,
1752 "You don't have access to add stepparents to this article");
1753
ca9aa2bf
TC
1754 my $cgi = $req->cgi;
1755 require 'BSE/Admin/StepParents.pm';
1756 eval {
1757 my $step_parent_id = $cgi->param('stepparent');
1758 defined($step_parent_id)
1759 or die "No stepparent supplied to add_stepparent";
1760 int($step_parent_id) eq $step_parent_id
1761 or die "Invalid stepcat supplied to add_stepcat";
1762 my $step_parent = $articles->getByPkey($step_parent_id)
31a26b52
TC
1763 or die "Parent $step_parent_id not found\n";
1764
1765 $req->user_can(edit_stepkid_add => $step_parent)
1766 or die "You don't have access to add a stepkid to that article\n";
ca9aa2bf
TC
1767
1768 my $release = $cgi->param('release');
1769 defined $release
1770 or $release = "01/01/2000";
1771 use BSE::Util::Valid qw/valid_date/;
1772 $release eq '' or valid_date($release)
1773 or die "Invalid release date";
1774 my $expire = $cgi->param('expire');
1775 defined $expire
1776 or $expire = '31/12/2999';
1777 $expire eq '' or valid_date($expire)
1778 or die "Invalid expire data";
1779
1780 my $newentry =
1781 BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
1782 };
1783 $@ and return $self->refresh($article, $cgi, 'step', $@);
1784
a0a8147b
TC
1785 use Util 'generate_article';
1786 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1787
8b0b2f34 1788 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
ca9aa2bf
TC
1789}
1790
1791sub del_stepparent {
1792 my ($self, $req, $article, $articles) = @_;
1793
31a26b52
TC
1794 $req->user_can(edit_stepparent_delete => $article)
1795 or return $self->edit_form($req, $article, $articles,
1796 "You cannot remove stepparents from that article");
1797
ca9aa2bf
TC
1798 my $cgi = $req->cgi;
1799 require 'BSE/Admin/StepParents.pm';
1800 my $step_parent_id = $cgi->param('stepparent');
1801 defined($step_parent_id)
1802 or return $self->refresh($article, $cgi, 'stepparents',
1803 "No stepparent supplied to add_stepcat");
1804 int($step_parent_id) eq $step_parent_id
1805 or return $self->refresh($article, $cgi, 'stepparents',
1806 "Invalid stepparent supplied to add_stepparent");
1807 my $step_parent = $articles->getByPkey($step_parent_id)
1808 or return $self->refresh($article, $cgi, 'stepparent',
1809 "Stepparent $step_parent_id not found");
1810
31a26b52
TC
1811 $req->user_can(edit_stepkid_delete => $step_parent)
1812 or die "You don't have access to remove the stepkid from that article\n";
1813
ca9aa2bf
TC
1814 eval {
1815 BSE::Admin::StepParents->del($step_parent, $article);
1816 };
1817 $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
1818
a0a8147b
TC
1819 use Util 'generate_article';
1820 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1821
8b0b2f34 1822 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
ca9aa2bf
TC
1823}
1824
1825sub save_stepparents {
1826 my ($self, $req, $article, $articles) = @_;
1827
31a26b52
TC
1828 $req->user_can(edit_stepparent_save => $article)
1829 or return $self->edit_form($req, $article, $articles,
1830 "No access to save stepparent data for this artice");
1831
ca9aa2bf
TC
1832 my $cgi = $req->cgi;
1833
1834 require 'BSE/Admin/StepParents.pm';
1835 my @stepparents = OtherParents->getBy(childId=>$article->{id});
1836 my %stepparents = map { $_->{parentId}, $_ } @stepparents;
1837 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1838 for my $stepparent (@stepparents) {
31a26b52
TC
1839 $req->user_can(edit_stepkid_save => $stepparent->{parentId})
1840 or next;
ca9aa2bf
TC
1841 for my $name (qw/release expire/) {
1842 my $date = $cgi->param($name.'_'.$stepparent->{parentId});
1843 if (defined $date) {
1844 if ($date eq '') {
1845 $date = $datedefs{$name};
1846 }
1847 elsif (valid_date($date)) {
1848 use BSE::Util::SQL qw/date_to_sql/;
1849 $date = date_to_sql($date);
1850 }
1851 else {
1852 return $self->refresh($article, $cgi, "Invalid date '$date'");
1853 }
1854 $stepparent->{$name} = $date;
1855 }
1856 }
1857 eval {
1858 $stepparent->save();
1859 };
1860 $@ and return $self->refresh($article, $cgi, '', $@);
1861 }
1862
a0a8147b
TC
1863 use Util 'generate_article';
1864 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1865
8b0b2f34
TC
1866 return $self->refresh($article, $cgi, 'stepparents',
1867 'Stepparent information saved');
ca9aa2bf
TC
1868}
1869
1870sub refresh {
1871 my ($self, $article, $cgi, $name, $message, $extras) = @_;
1872
8b0b2f34
TC
1873 my $url = $cgi->param('r');
1874 unless ($url) {
1875 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1876 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
1877 $url .= "&message=" . CGI::escape($message) if $message;
1878 if ($cgi->param('_t')) {
1879 $url .= "&_t=".CGI::escape($cgi->param('_t'));
1880 }
1881 $url .= $extras if defined $extras;
1882 my $cgiextras = $cgi->param('e');
1883 $url .= "#$name" if $name;
ca9aa2bf 1884 }
ca9aa2bf
TC
1885
1886 return BSE::Template->get_refresh($url, $self->{cfg});
1887}
1888
1889sub show_images {
918735d1 1890 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
1891
1892 my %acts;
918735d1 1893 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
1894 my $template = 'admin/article_img';
1895
1896 return BSE::Template->get_response($template, $req->cfg, \%acts);
1897}
1898
1899sub save_image_changes {
1900 my ($self, $req, $article, $articles) = @_;
1901
abf5bbc6 1902 $req->user_can(edit_images_save => $article)
cc9019d1 1903 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
1904 "You don't have access to save image information for this article");
1905
ca9aa2bf
TC
1906 my $cgi = $req->cgi;
1907 my $image_pos = $cgi->param('imagePos');
1908 if ($image_pos
1909 && $image_pos =~ /^(?:tl|tr|bl|br)$/
1910 && $image_pos ne $article->{imagePos}) {
1911 $article->{imagePos} = $image_pos;
1912 $article->save;
1913 }
daee3409 1914 my @images = $self->get_images($article);
4772671f
TC
1915
1916 @images or
1917 return $self->refresh($article, $cgi, undef, 'No images to save information for');
ca9aa2bf
TC
1918
1919 my $changed;
1920 my @alt = $cgi->param('alt');
1921 if (@alt) {
1922 ++$changed;
1923 for my $index (0..$#images) {
1924 $index < @alt or last;
1925 $images[$index]{alt} = $alt[$index];
1926 }
1927 }
1928 my @urls = $cgi->param('url');
1929 if (@urls) {
1930 ++$changed;
1931 for my $index (0..$#images) {
1932 $index < @urls or next;
1933 $images[$index]{url} = $urls[$index];
1934 }
1935 }
4772671f
TC
1936 my %errors;
1937 my @names = map scalar($cgi->param('name'.$_)), 0..$#images;
1938 if (@names) {
1939 # make sure there aren't any dups
1940 my %used;
1941 my $index = 0;
1942 for my $name (@names) {
1943 defined $name or $name = '';
1944 if ($name ne '') {
1945 if ($name =~ /^[a-z_]\w*$/i) {
1946 if ($used{lc $name}++) {
1947 $errors{"name$index"} = 'Names must be empty, or alphanumeric and unique to the article';
1948 }
1949 }
1950 else {
1951 $errors{"name$index"} = 'Image identifiers must be unique to the article';
1952 }
1953 }
daee3409
TC
1954 unless ($errors{"name$index"}) {
1955 my $msg;
1956 $self->validate_image_name($name, \$msg)
1957 or $errors{"name$index"} = $msg;
1958 }
1959
4772671f
TC
1960 ++$index;
1961 }
1962 }
1963 keys %errors
1964 and return $self->edit_form($req, $article, $articles, undef,
1965 \%errors);
1966 for my $index (0..$#images) {
1967 $images[$index]{name} = $names[$index];
1968 }
ca9aa2bf
TC
1969 if ($changed) {
1970 for my $image (@images) {
1971 $image->save;
1972 }
1973 }
a0a8147b
TC
1974
1975 use Util 'generate_article';
1976 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1977
cc9019d1 1978 return $self->refresh($article, $cgi, undef, 'Image information saved');
ca9aa2bf
TC
1979}
1980
1981sub add_image {
1982 my ($self, $req, $article, $articles) = @_;
1983
abf5bbc6 1984 $req->user_can(edit_images_add => $article)
cc9019d1 1985 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
1986 "You don't have access to add new images to this article");
1987
ca9aa2bf
TC
1988 my $cgi = $req->cgi;
1989
4772671f
TC
1990 my %errors;
1991 my $msg;
1992 my $imageref = $cgi->param('name');
d794b180 1993 if (defined $imageref && $imageref ne '') {
4772671f
TC
1994 if ($imageref =~ /^[a-z_]\w+$/i) {
1995 # make sure it's unique
daee3409 1996 my @images = $self->get_images($article);
4772671f
TC
1997 for my $img (@images) {
1998 if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
1999 $errors{name} = 'Duplicate image name';
2000 last;
2001 }
2002 }
2003 }
2004 else {
2005 $errors{name} = 'Name must be empty or alphanumeric';
2006 }
2007 }
2008 else {
2009 $imageref = '';
2010 }
daee3409
TC
2011 unless ($errors{name}) {
2012 $self->validate_image_name($imageref, \$msg)
2013 or $errors{name} = $msg;
2014 }
4772671f 2015
ca9aa2bf 2016 my $image = $cgi->param('image');
4772671f
TC
2017 if ($image) {
2018 if (-z $image) {
2019 $errors{image} = 'Image file is empty';
2020 }
ca9aa2bf 2021 }
4772671f
TC
2022 else {
2023 $msg = 'Enter or select the name of an image file on your machine';
2024 $errors{image} = 'Please enter an image filename';
2025 }
2026 if ($msg || keys %errors) {
2027 return $self->edit_form($req, $article, $articles, $msg, \%errors);
ca9aa2bf 2028 }
4772671f 2029
ca9aa2bf
TC
2030 my $imagename = $image;
2031 $imagename .= ''; # force it into a string
2032 my $basename = '';
2033 $imagename =~ /([\w.-]+)$/ and $basename = $1;
2034
2035 # create a filename that we hope is unique
2036 my $filename = time. '_'. $basename;
2037
2038 # for the sysopen() constants
2039 use Fcntl;
2040
2041 my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
2042 # loop until we have a unique filename
2043 my $counter="";
2044 $filename = time. '_' . $counter . '_' . $basename
2045 until sysopen( OUTPUT, "$imagedir/$filename", O_WRONLY| O_CREAT| O_EXCL)
2046 || ++$counter > 100;
2047
2048 fileno(OUTPUT) or die "Could not open image file: $!";
2049
2050 # for OSs with special text line endings
2051 binmode OUTPUT;
2052
2053 my $buffer;
2054
2055 no strict 'refs';
2056
2057 # read the image in from the browser and output it to our output filehandle
2058 print OUTPUT $buffer while read $image, $buffer, 1024;
2059
2060 # close and flush
2061 close OUTPUT
2062 or die "Could not close image file $filename: $!";
2063
2064 use Image::Size;
2065
2066
2067 my($width,$height) = imgsize("$imagedir/$filename");
2068
2069 my $alt = $cgi->param('altIn');
2070 defined $alt or $alt = '';
2071 my $url = $cgi->param('url');
2072 defined $url or $url = '';
2073 my %image =
2074 (
2075 articleId => $article->{id},
2076 image => $filename,
2077 alt=>$alt,
2078 width=>$width,
2079 height => $height,
2080 url => $url,
2081 displayOrder=>time,
4772671f 2082 name => $imageref,
ca9aa2bf
TC
2083 );
2084 require Images;
2085 my @cols = Image->columns;
2086 shift @cols;
2087 my $imageobj = Images->add(@image{@cols});
a0a8147b
TC
2088
2089 use Util 'generate_article';
2090 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2091
cc9019d1 2092 return $self->refresh($article, $cgi, undef, 'New image added');
ca9aa2bf
TC
2093}
2094
2095# remove an image
2096sub remove_img {
2097 my ($self, $req, $article, $articles, $imageid) = @_;
2098
abf5bbc6 2099 $req->user_can(edit_images_delete => $article)
cc9019d1 2100 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2101 "You don't have access to delete images from this article");
2102
ca9aa2bf
TC
2103 $imageid or die;
2104
daee3409 2105 my @images = $self->get_images($article);
ca9aa2bf
TC
2106 my ($image) = grep $_->{id} == $imageid, @images
2107 or return $self->show_images($req, $article, $articles, "No such image");
2108 my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
6473c56f 2109 unlink "$imagedir$image->{image}";
ca9aa2bf
TC
2110 $image->remove;
2111
a0a8147b
TC
2112 use Util 'generate_article';
2113 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2114
cc9019d1 2115 return $self->refresh($article, $req->cgi, undef, 'Image removed');
ca9aa2bf
TC
2116}
2117
2118sub move_img_up {
2119 my ($self, $req, $article, $articles) = @_;
2120
abf5bbc6 2121 $req->user_can(edit_images_reorder => $article)
cc9019d1 2122 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2123 "You don't have access to reorder images in this article");
2124
ca9aa2bf 2125 my $imageid = $req->cgi->param('imageid');
daee3409 2126 my @images = $self->get_images($article);
ca9aa2bf 2127 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 2128 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 2129 $imgindex > 0
cc9019d1 2130 or return $self->edit_form($req, $article, $articles, "Image is already at the top");
ca9aa2bf
TC
2131 my ($to, $from) = @images[$imgindex-1, $imgindex];
2132 ($to->{displayOrder}, $from->{displayOrder}) =
2133 ($from->{displayOrder}, $to->{displayOrder});
2134 $to->save;
2135 $from->save;
2136
a0a8147b
TC
2137 use Util 'generate_article';
2138 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2139
cc9019d1 2140 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
2141}
2142
2143sub move_img_down {
2144 my ($self, $req, $article, $articles) = @_;
2145
abf5bbc6 2146 $req->user_can(edit_images_reorder => $article)
cc9019d1 2147 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2148 "You don't have access to reorder images in this article");
2149
ca9aa2bf 2150 my $imageid = $req->cgi->param('imageid');
daee3409 2151 my @images = $self->get_images($article);
ca9aa2bf 2152 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 2153 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 2154 $imgindex < $#images
cc9019d1 2155 or return $self->edit_form($req, $article, $articles, "Image is already at the end");
ca9aa2bf
TC
2156 my ($to, $from) = @images[$imgindex+1, $imgindex];
2157 ($to->{displayOrder}, $from->{displayOrder}) =
2158 ($from->{displayOrder}, $to->{displayOrder});
2159 $to->save;
2160 $from->save;
2161
a0a8147b
TC
2162 use Util 'generate_article';
2163 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2164
cc9019d1 2165 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
2166}
2167
2168sub get_article {
2169 my ($self, $articles, $article) = @_;
2170
2171 return $article;
2172}
2173
2174sub table_object {
2175 my ($self, $articles) = @_;
2176
2177 $articles;
2178}
2179
2180my %types =
2181 (
2182 qw(
2183 pdf application/pdf
2184 txt text/plain
2185 htm text/html
2186 html text/html
2187 gif image/gif
2188 jpg image/jpeg
2189 jpeg image/jpeg
2190 doc application/msword
2191 rtf application/rtf
2192 zip application/zip
2193 png image/png
2194 bmp image/bmp
2195 tif image/tiff
2196 tiff image/tiff
2197 sgm text/sgml
2198 sgml text/sgml
2199 xml text/xml
2200 mov video/quicktime
2201 )
2202 );
2203
2204sub _refresh_filelist {
8b0b2f34 2205 my ($self, $req, $article, $msg) = @_;
ca9aa2bf 2206
cc9019d1 2207 return $self->refresh($article, $req->cgi, undef, $msg);
ca9aa2bf
TC
2208}
2209
2210sub filelist {
918735d1 2211 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
2212
2213 my %acts;
918735d1 2214 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
2215 my $template = 'admin/filelist';
2216
2217 return BSE::Template->get_response($template, $req->cfg, \%acts);
2218}
2219
2220sub fileadd {
2221 my ($self, $req, $article, $articles) = @_;
2222
abf5bbc6 2223 $req->user_can(edit_files_add => $article)
cc9019d1 2224 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2225 "You don't have access to add files to this article");
2226
ca9aa2bf
TC
2227 my %file;
2228 my $cgi = $req->cgi;
2229 require ArticleFile;
2230 my @cols = ArticleFile->columns;
2231 shift @cols;
2232 for my $col (@cols) {
2233 if (defined $cgi->param($col)) {
2234 $file{$col} = $cgi->param($col);
2235 }
2236 }
2237
2238 $file{forSale} = 0 + exists $file{forSale};
2239 $file{articleId} = $article->{id};
2240 $file{download} = 0 + exists $file{download};
2241 $file{requireUser} = 0 + exists $file{requireUser};
2242
2243 my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
2244
2245 # build a filename
2246 my $file = $cgi->param('file');
2247 unless ($file) {
cc9019d1 2248 return $self->edit_form($req, $article, $articles,
918735d1
TC
2249 "Enter or select the name of a file on your machine",
2250 { file => 'Please enter a filename' });
ca9aa2bf
TC
2251 }
2252 if (-z $file) {
cc9019d1 2253 return $self->edit_form($req, $article, $articles,
918735d1
TC
2254 "File is empty",
2255 { file => 'File is empty' });
ca9aa2bf
TC
2256 }
2257
2258 unless ($file{contentType}) {
2259 unless ($file =~ /\.([^.]+)$/) {
2260 $file{contentType} = "application/octet-stream";
2261 }
2262 unless ($file{contentType}) {
2263 my $ext = lc $1;
2264 my $type = $types{$ext};
2265 unless ($type) {
2266 $type = $self->{cfg}->entry('extensions', $ext)
2267 || $self->{cfg}->entry('extensions', ".$ext")
2268 || "application/octet-stream";
2269 }
2270 $file{contentType} = $type;
2271 }
2272 }
2273
2274 my $basename = '';
2275 $file =~ /([\w.-]+)$/ and $basename = $1;
2276
2277 my $filename = time. '_'. $basename;
2278
2279 # for the sysopen() constants
2280 use Fcntl;
2281
2282 # loop until we have a unique filename
2283 my $counter="";
2284 $filename = time. '_' . $counter . '_' . $basename
2285 until sysopen( OUTPUT, "$downloadPath/$filename",
2286 O_WRONLY| O_CREAT| O_EXCL)
2287 || ++$counter > 100;
2288
2289 fileno(OUTPUT) or die "Could not open file: $!";
2290
2291 # for OSs with special text line endings
2292 binmode OUTPUT;
2293
2294 my $buffer;
2295
2296 no strict 'refs';
2297
2298 # read the image in from the browser and output it to our output filehandle
2299 print OUTPUT $buffer while read $file, $buffer, 8192;
2300
2301 # close and flush
2302 close OUTPUT
2303 or die "Could not close file $filename: $!";
2304
2305 use BSE::Util::SQL qw/now_datetime/;
2306 $file{filename} = $filename;
2307 $file{displayName} = $basename;
2308 $file{sizeInBytes} = -s $file;
2309 $file{displayOrder} = time;
2310 $file{whenUploaded} = now_datetime();
2311
2312 require ArticleFiles;
2313 my $fileobj = ArticleFiles->add(@file{@cols});
2314
a0a8147b
TC
2315 use Util 'generate_article';
2316 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2317
8b0b2f34 2318 $self->_refresh_filelist($req, $article, 'New file added');
ca9aa2bf
TC
2319}
2320
2321sub fileswap {
2322 my ($self, $req, $article, $articles) = @_;
2323
abf5bbc6 2324 $req->user_can('edit_files_reorder', $article)
cc9019d1 2325 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2326 "You don't have access to reorder files in this article");
2327
ca9aa2bf
TC
2328 my $cgi = $req->cgi;
2329 my $id1 = $cgi->param('file1');
2330 my $id2 = $cgi->param('file2');
2331
2332 if ($id1 && $id2) {
2333 my @files = $article->files;
2334
2335 my ($file1) = grep $_->{id} == $id1, @files;
2336 my ($file2) = grep $_->{id} == $id2, @files;
2337
2338 if ($file1 && $file2) {
2339 ($file1->{displayOrder}, $file2->{displayOrder})
2340 = ($file2->{displayOrder}, $file1->{displayOrder});
2341 $file1->save;
2342 $file2->save;
2343 }
2344 }
2345
a0a8147b
TC
2346 use Util 'generate_article';
2347 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2348
8b0b2f34 2349 $self->_refresh_filelist($req, $article, 'File moved');
ca9aa2bf
TC
2350}
2351
2352sub filedel {
2353 my ($self, $req, $article, $articles) = @_;
2354
abf5bbc6 2355 $req->user_can('edit_files_delete', $article)
cc9019d1
TC
2356 or return $self->edit_form($req, $article, $articles,
2357 "You don't have access to delete files from this article");
abf5bbc6 2358
ca9aa2bf
TC
2359 my $cgi = $req->cgi;
2360 my $fileid = $cgi->param('file');
2361 if ($fileid) {
2362 my @files = $article->files;
2363
2364 my ($file) = grep $_->{id} == $fileid, @files;
2365
2366 if ($file) {
2367 my $downloadPath = $req->cfg->entryErr('paths', 'downloads');
2368 my $filename = $downloadPath . "/" . $file->{filename};
2369 my $debug_del = $req->cfg->entryBool('debug', 'file_unlink', 0);
2370 if ($debug_del) {
2371 unlink $filename
2372 or print STDERR "Error deleting $filename: $!\n";
2373 }
2374 else {
2375 unlink $filename;
2376 }
2377 $file->remove();
2378 }
2379 }
2380
a0a8147b
TC
2381 use Util 'generate_article';
2382 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2383
8b0b2f34 2384 $self->_refresh_filelist($req, $article, 'File deleted');
ca9aa2bf
TC
2385}
2386
2387sub filesave {
abf5bbc6 2388 my ($self, $req, $article, $articles) = @_;
ca9aa2bf 2389
abf5bbc6 2390 $req->user_can('edit_files_save', $article)
cc9019d1 2391 or return $self->edit_form($req, $article, $articles,
abf5bbc6 2392 "You don't have access to save file information for this article");
ca9aa2bf
TC
2393 my @files = $article->files;
2394
2395 my $cgi = $req->cgi;
2396 for my $file (@files) {
2397 if (defined $cgi->param("description_$file->{id}")) {
2398 $file->{description} = $cgi->param("description_$file->{id}");
2399 if (my $type = $cgi->param("contentType_$file->{id}")) {
2400 $file->{contentType} = $type;
2401 }
2402 $file->{download} = 0 + defined $cgi->param("download_$file->{id}");
2403 $file->{forSale} = 0 + defined $cgi->param("forSale_$file->{id}");
2404 $file->{requireUser} = 0 + defined $cgi->param("requireUser_$file->{id}");
2405 $file->save;
2406 }
2407 }
2408
a0a8147b
TC
2409 use Util 'generate_article';
2410 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2411
8b0b2f34 2412 $self->_refresh_filelist($req, $article, 'File information saved');
ca9aa2bf
TC
2413}
2414
6473c56f
TC
2415sub can_remove {
2416 my ($self, $req, $article, $articles, $rmsg) = @_;
2417
abf5bbc6
TC
2418 unless ($req->user_can('edit_delete_article', $article, $rmsg)) {
2419 $$rmsg ||= "Access denied";
2420 return;
2421 }
2422
6473c56f
TC
2423 if ($articles->children($article->{id})) {
2424 $$rmsg = "This article has children. You must delete the children first (or change their parents)";
2425 return;
2426 }
2427 if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
2428 $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
2429 return;
2430 }
2431 if ($article->{id} == $Constants::SHOPID) {
2432 $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the the store instead.";
2433 return;
2434 }
2435
2436 return 1;
2437}
2438
2439sub remove {
2440 my ($self, $req, $article, $articles) = @_;
2441
2442 my $why_not;
2443 unless ($self->can_remove($req, $article, $articles, \$why_not)) {
2444 return $self->edit_form($req, $article, $articles, $why_not);
2445 }
2446
2447 require Images;
2448 my @images = Images->getBy(articleId=>$article->{id});
2449 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
2450 for my $image (@images) {
2451 unlink("$imagedir/$image->{image}");
2452 $image->remove();
2453 }
2454
2455 # remove any step(child|parent) links
2456 require OtherParents;
2457 my @steprels = OtherParents->anylinks($article->{id});
2458 for my $link (@steprels) {
2459 $link->remove();
2460 }
2461
2462 my $parentid = $article->{parentid};
2463 $article->remove;
8b0b2f34
TC
2464 my $url = $req->cgi->param('r');
2465 unless ($url) {
2466 my $urlbase = $self->{cfg}->entryVar('site', 'url');
2467 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$parentid";
2468 $url .= "&message=Article+deleted";
2469 }
6473c56f
TC
2470 return BSE::Template->get_refresh($url, $self->{cfg});
2471}
2472
4010d92e
TC
2473sub unhide {
2474 my ($self, $req, $article, $articles) = @_;
2475
2476 if ($req->user_can(edit_field_edit_listed => $article)
2477 && $req->user_can(edit_save => $article)) {
2478 $article->{listed} = 1;
2479 $article->save;
2480
2481 use Util 'generate_article';
2482 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2483 }
8b0b2f34 2484 return $self->refresh($article, $req->cgi, undef, 'Article unhidden');
4010d92e
TC
2485}
2486
2487sub hide {
2488 my ($self, $req, $article, $articles) = @_;
2489
2490 if ($req->user_can(edit_field_edit_listed => $article)
2491 && $req->user_can(edit_save => $article)) {
2492 $article->{listed} = 0;
2493 $article->save;
2494
2495 use Util 'generate_article';
2496 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2497 }
2498 my $r = $req->cgi->param('r');
2499 unless ($r) {
2500 $r = $req->cfg->entryVar('site', 'url') . "/cgi-bin/admin/add.pl?id=" . $article->{parentid};
2501 }
8b0b2f34 2502 return $self->refresh($article, $req->cgi, undef, 'Article hidden');
4010d92e
TC
2503}
2504
9168c88c
TC
2505sub default_value {
2506 my ($self, $req, $article, $col) = @_;
2507
2508 if ($article->{parentid}) {
2509 my $section = "children of $article->{parentid}";
2510 my $value = $req->cfg->entry($section, $col);
2511 if (defined $value) {
77804754 2512 return $value;
9168c88c
TC
2513 }
2514 }
2515 my $section = "level $article->{level}";
2516 my $value = $req->cfg->entry($section, $col);
77804754 2517 defined($value) and return $value;
9168c88c
TC
2518
2519 return '';
2520}
2521
918735d1
TC
2522sub flag_sections {
2523 return ( 'article flags' );
2524}
2525
2526sub flags {
2527 my ($self) = @_;
2528
2529 my $cfg = $self->{cfg};
2530
2531 my @sections = $self->flag_sections;
2532
2533 my %flags = map $cfg->entriesCS($_), reverse @sections;
2534 my @valid = grep /^\w$/, keys %flags;
2535
2536 return map +{ id => $_, desc => $flags{$_} },
2537 sort { lc($flags{$a}) cmp lc($flags{$b}) }@valid;
2538}
2539
daee3409
TC
2540sub get_images {
2541 my ($self, $article) = @_;
2542
2543 $article->images;
2544}
2545
2546sub validate_image_name {
2547 my ($self, $name, $rmsg) = @_;
2548
2549 1; # no extra validation
2550}
2551
ca9aa2bf
TC
25521;
2553
2554=head1 NAME
2555
2556 BSE::Edit::Article - editing functionality for BSE articles
2557
2558=head1 AUTHOR
2559
2560Tony Cook <tony@develop-help.com>
2561
2562=head1 REVISION
2563
2564$Revision$
2565
2566=cut