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