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