0.12_28 commit
[bse.git] / site / cgi-bin / modules / BSE / Edit / Article.pm
CommitLineData
ca9aa2bf
TC
1package BSE::Edit::Article;
2use strict;
3use HTML::Entities;
4use base qw(BSE::Edit::Base);
b553afa2 5use BSE::Util::Tags qw(tag_error_img);
ca9aa2bf 6use BSE::Util::SQL qw(now_sqldate);
b553afa2 7use BSE::Util::Valid qw/valid_date/;
9168c88c 8use BSE::Permissions;
331fd099 9use Util qw(custom_class);
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 }
ca9aa2bf
TC
151 encode_entities($value);
152}
153
154sub tag_art_type {
155 my ($level, $cfg) = @_;
156
157 encode_entities($cfg->entry('level names', $level, 'Article'));
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;
506 encode_entities($step_kids->{$kid->{id}}{$arg});
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);
aefcabcb 532 my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
ca9aa2bf
TC
533 if ($$rallkids_index < $#$allkids) {
534 $html .= <<HTML;
8b0b2f34 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;
8b0b2f34 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 }
610 encode_entities($targs->[$$rindex]{$arg});
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";
aefcabcb 635 my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" />!;
ca9aa2bf
TC
636 my $refreshto = CGI::escape($url);
637 if ($$rindex < $#$stepparents) {
638 $html .= <<HTML;
8b0b2f34 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;
8b0b2f34 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');
737 my $html = '';
738 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" alt="" align="absbottom">';
739 my $id = $kids->[$$rindex]{id};
740 if ($$rindex < $#$kids) {
741 $html .= <<HTML;
8b0b2f34 742<a href="$cgi_uri/admin/move.pl?id=$id&d=down&edit=1&all=1"><img src="$images_uri/admin/${img_prefix}move_down.gif" width="17" height="13" alt="Move Down" border="0" align="absbottom"></a>
ca9aa2bf
TC
743HTML
744 }
745 else {
746 $html .= $nomove;
747 }
748 if ($$rindex > 0) {
749 $html .= <<HTML;
8b0b2f34 750<a href="$cgi_uri/admin/move.pl?id=$id&d=up&edit=1&all=1"><img src="$images_uri/admin/${img_prefix}move_up.gif" width="17" height="13" alt="Move Up" border="0" align="absbottom"></a>
ca9aa2bf
TC
751HTML
752 }
753 else {
754 $html .= $nomove;
755 }
756 $html =~ tr/\n//d;
757
758 $html;
759}
760
761sub tag_edit_link {
762 my ($args, $acts, $funcname, $templater) = @_;
763 my ($which, $name) = split / /, $args, 2;
764 $name ||= 'Edit';
765 my $gen_class;
766 if ($acts->{$which}
767 && ($gen_class = $templater->perform($acts, $which, 'generator'))) {
768 eval "use $gen_class";
769 unless ($@) {
770 my $gen = $gen_class->new;
771 my $link = $gen->edit_link($templater->perform($acts, $which, 'id'));
772 return qq!<a href="$link">$name</a>!;
773 }
774 }
775 return '';
776}
777
778sub tag_imgmove {
8b0b2f34
TC
779 my ($req, $article, $rindex, $images, $arg,
780 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
781
782 $req->user_can(edit_images_reorder => $article)
783 or return '';
ca9aa2bf 784
aefcabcb
TC
785 @$images > 1 or return '';
786
ca9aa2bf
TC
787 $$rindex >= 0 && $$rindex < @$images
788 or return '** imgmove can only be used in image iterator **';
789
8b0b2f34
TC
790 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
791 $img_prefix = '' unless defined $img_prefix;
792 $urladd = '' unless defined $urladd;
793
794 my $urlbase = $req->cfg->entryVar('site', 'url');
795 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}&showimages=1$urladd";
796 $url = CGI::escape($url);
797
ca9aa2bf
TC
798 my $html = '';
799 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" alt="" align="absbottom">';
800 my $image = $images->[$$rindex];
801 if ($$rindex > 0) {
802 $html .= <<HTML
8b0b2f34 803<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
804HTML
805 }
806 else {
807 $html .= $nomove;
808 }
809 if ($$rindex < $#$images) {
810 $html .= <<HTML
8b0b2f34 811<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
812HTML
813 }
814 else {
815 $html .= $nomove;
816 }
918735d1 817 $html =~ tr/\n//d;
ca9aa2bf
TC
818 return $html;
819}
820
821sub tag_movefiles {
8b0b2f34
TC
822 my ($self, $req, $article, $files, $rindex, $arg,
823 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
824
825 $req->user_can('edit_files_reorder', $article)
826 or return '';
ca9aa2bf 827
aefcabcb
TC
828 @$files > 1 or return '';
829
8b0b2f34
TC
830 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
831 $img_prefix = '' unless defined $img_prefix;
832 $urladd = '' unless defined $urladd;
833
ca9aa2bf
TC
834 my $html = '';
835
836 $$rindex >= 0 && $$rindex < @$files
837 or return '** movefiles can only be used in the files iterator **';
838
839 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" alt="" align="absbottom">';
840 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
8b0b2f34
TC
841
842 my $urlbase = $self->{cfg}->entryVar('site', 'url');
843 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}&filelist=1$urladd";
844 $url = CGI::escape($url);
ca9aa2bf
TC
845
846 if ($$rindex < $#$files) {
847 $html .= <<HTML;
8b0b2f34 848<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
849HTML
850 }
851 else {
852 $html .= $nomove;
853 }
854 if ($$rindex > 0) {
855 $html .= <<HTML;
8b0b2f34 856<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
857HTML
858 }
859 else {
860 $html .= $nomove;
861 }
862 $html =~ tr/\n//d;
863 $html;
864}
865
866sub tag_old {
867 my ($article, $cgi, $args, $acts, $funcname, $templater) = @_;
868
869 my ($col, $func, $funcargs) = split ' ', $args, 3;
870 my $value = $cgi->param($col);
871 if (defined $value) {
872 return encode_entities($value);
873 }
874 else {
875 if ($func) {
876 return $templater->perform($acts, $func, $funcargs);
877 }
878 else {
879 $value = $article->{$args};
880 defined $value or $value = '';
881 return encode_entities($value);
882 }
883 }
884}
885
b553afa2
TC
886# sub tag_error_img {
887# my ($self, $errors, $args) = @_;
ca9aa2bf 888
b553afa2
TC
889# return '' unless $errors->{$args};
890# my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
891# my $encoded = encode_entities($errors->{$args});
892# return qq!<img src="$images_uri/admin/error.gif" alt="$encoded" title="$encoded" border="0" align="top">!;
893# }
ca9aa2bf 894
08123550
TC
895sub iter_admin_users {
896 require BSE::TB::AdminUsers;
897
898 BSE::TB::AdminUsers->all;
899}
900
901sub iter_admin_groups {
902 require BSE::TB::AdminGroups;
903
904 BSE::TB::AdminGroups->all;
905}
906
9168c88c
TC
907sub tag_if_field_perm {
908 my ($req, $article, $field) = @_;
909
abf5bbc6
TC
910 unless ($field =~ /^\w+$/) {
911 print STDERR "Bad fieldname '$field'\n";
912 return;
913 }
9168c88c 914 if ($article->{id}) {
abf5bbc6 915 return $req->user_can("edit_field_edit_$field", $article);
9168c88c
TC
916 }
917 else {
4010d92e 918 #print STDERR "adding, always successful\n";
abf5bbc6 919 return 1;
9168c88c
TC
920 }
921}
922
923sub tag_default {
924 my ($self, $req, $article, $args, $acts, $funcname, $templater) = @_;
925
926 my ($col, $func, $funcargs) = split ' ', $args, 3;
927 if ($article->{id}) {
928 if ($func) {
929 return $templater->perform($acts, $func, $funcargs);
930 }
931 else {
932 my $value = $article->{$args};
933 defined $value or $value = '';
934 return encode_entities($value);
935 }
936 }
937 else {
938 my $value = $self->default_value($req, $article, $col);
939 return encode_entities($value);
940 }
941}
942
918735d1
TC
943sub iter_flags {
944 my ($self) = @_;
945
946 $self->flags;
947}
948
949sub tag_if_flag_set {
950 my ($article, $arg, $acts, $funcname, $templater) = @_;
951
952 my @args = DevHelp::Tags->get_parms($arg, $acts, $templater);
953 @args or return;
954
955 return index($article->{flags}, $args[0]) >= 0;
956}
957
8b0b2f34
TC
958sub iter_crumbs {
959 my ($article, $articles) = @_;
960
961 my @crumbs;
962 my $temp = $article;
963 defined($temp->{parentid}) or return;
964 while ($temp->{parentid} > 0
965 and my $crumb = $articles->getByPkey($temp->{parentid})) {
966 unshift @crumbs, $crumb;
967 $temp = $crumb;
968 }
969
970 @crumbs;
971}
972
973sub tag_typename {
974 my ($args, $acts, $funcname, $templater) = @_;
975
976 exists $acts->{$args} or return "** need an article name **";
977 my $generator = $templater->perform($acts, $args, 'generator');
978
979 $generator =~ /^(?:BSE::)?Generate::(\w+)$/
980 or return "** invalid generator $generator **";
981
982 return $1;
983}
984
ca9aa2bf
TC
985sub low_edit_tags {
986 my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
987
988 my $cgi = $request->cgi;
6473c56f 989 $msg ||= $cgi->param('message');
ca9aa2bf
TC
990 $msg ||= '';
991 $errors ||= {};
992 if (keys %$errors && !$msg) {
993 # try to get the errors in the same order as the table
994 my @cols = $self->table_object($articles)->rowClass->columns;
995 my %work = %$errors;
996 my @out = grep defined, delete @work{@cols};
997
998 $msg = join "<br>", @out, values %work;
999 }
abf5bbc6
TC
1000 my $parent;
1001 if ($article->{id}) {
1002 if ($article->{parentid} > 0) {
1003 $parent = $article->parent;
1004 }
1005 else {
1006 $parent = { title=>"No parent - this is a section", id=>-1 };
1007 }
1008 }
1009 else {
1010 $parent = { title=>"How did we get here?", id=>0 };
1011 }
ca9aa2bf
TC
1012 my @images;
1013 my $image_index;
1014 my @children;
1015 my $child_index;
1016 my %stepkids;
1017 my $cfg = $self->{cfg};
1018 my @allkids;
1019 my $allkid_index;
1020 my @possstepkids;
1021 my @stepparents;
1022 my $stepparent_index;
1023 my @stepparent_targs;
1024 my @stepparentpossibles;
1025 my @files;
1026 my $file_index;
1027 return
1028 (
1029 BSE::Util::Tags->basic($acts, $cgi, $cfg),
1030 BSE::Util::Tags->admin($acts, $cfg),
9168c88c 1031 BSE::Util::Tags->secure($request),
ca9aa2bf
TC
1032 article => [ \&tag_hash, $article ],
1033 old => [ \&tag_old, $article, $cgi ],
9168c88c 1034 default => [ \&tag_default, $self, $request, $article ],
ca9aa2bf
TC
1035 articleType => [ \&tag_art_type, $article->{level}, $cfg ],
1036 parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
918735d1 1037 ifNew => [ \&tag_if_new, $article ],
9168c88c 1038 list => [ \&tag_list, $self, $article, $articles, $cgi, $request ],
ca9aa2bf
TC
1039 script => $ENV{SCRIPT_NAME},
1040 level => $article->{level},
1041 checked => \&tag_checked,
1042 DevHelp::Tags->make_iterator2
1043 ([ \&iter_get_images, $article ], 'image', 'images', \@images,
1044 \$image_index),
abf5bbc6 1045 imgmove => [ \&tag_imgmove, $request, $article, \$image_index, \@images ],
ca9aa2bf
TC
1046 message => $msg,
1047 DevHelp::Tags->make_iterator2
1048 ([ \&iter_get_kids, $article, $articles ],
1049 'child', 'children', \@children, \$child_index),
1050 ifchildren => \&tag_if_children,
1051 childtype => [ \&tag_art_type, $article->{level}+1, $cfg ],
1052 ifHaveChildType => [ \&tag_if_have_child_type, $article->{level}, $cfg ],
abf5bbc6
TC
1053 movechild => [ \&tag_movechild, $self, $request, $article, \@children,
1054 \$child_index],
ca9aa2bf
TC
1055 is => \&tag_is,
1056 templates => [ \&tag_templates, $self, $article, $cfg, $cgi ],
1057 titleImages => [ \&tag_title_images, $self, $article, $cfg, $cgi ],
1058 editParent => [ \&tag_edit_parent, $article ],
1059 DevHelp::Tags->make_iterator2
1060 ([ \&iter_allkids, $article ], 'kid', 'kids', \@allkids, \$allkid_index),
1061 ifStepKid =>
1062 [ \&tag_if_step_kid, $article, \@allkids, \$allkid_index, \%stepkids ],
1063 stepkid => [ \&tag_step_kid, $article, \@allkids, \$allkid_index,
1064 \%stepkids ],
1065 movestepkid =>
31a26b52
TC
1066 [ \&tag_move_stepkid, $self, $cgi, $request, $article, \@allkids,
1067 \$allkid_index ],
ca9aa2bf 1068 possible_stepkids =>
31a26b52
TC
1069 [ \&tag_possible_stepkids, \%stepkids, $request, $article,
1070 \@possstepkids, $articles, $cgi ],
ca9aa2bf 1071 ifPossibles =>
31a26b52
TC
1072 [ \&tag_if_possible_stepkids, \%stepkids, $request, $article,
1073 \@possstepkids, $articles, $cgi ],
ca9aa2bf
TC
1074 DevHelp::Tags->make_iterator2
1075 ( [ \&iter_get_stepparents, $article ], 'stepparent', 'stepparents',
1076 \@stepparents, \$stepparent_index),
1077 ifStepParents => \&tag_ifStepParents,
1078 stepparent_targ =>
1079 [ \&tag_stepparent_targ, $article, \@stepparent_targs,
1080 \$stepparent_index ],
1081 movestepparent =>
31a26b52 1082 [ \&tag_move_stepparent, $self, $cgi, $request, $article, \@stepparents,
ca9aa2bf
TC
1083 \$stepparent_index ],
1084 ifStepparentPossibles =>
31a26b52
TC
1085 [ \&tag_if_stepparent_possibles, $request, $article, $articles,
1086 \@stepparent_targs, \@stepparentpossibles, ],
ca9aa2bf 1087 stepparent_possibles =>
31a26b52 1088 [ \&tag_stepparent_possibles, $cgi, $request, $article, $articles,
ca9aa2bf
TC
1089 \@stepparent_targs, \@stepparentpossibles, ],
1090 DevHelp::Tags->make_iterator2
1091 ([ \&iter_files, $article ], 'file', 'files', \@files, \$file_index ),
abf5bbc6
TC
1092 movefiles =>
1093 [ \&tag_movefiles, $self, $request, $article, \@files, \$file_index ],
08123550
TC
1094 DevHelp::Tags->make_iterator2
1095 (\&iter_admin_users, 'iadminuser', 'adminusers'),
1096 DevHelp::Tags->make_iterator2
1097 (\&iter_admin_groups, 'iadmingroup', 'admingroups'),
ca9aa2bf
TC
1098 edit => \&tag_edit_link,
1099 error => [ \&tag_hash, $errors ],
b553afa2 1100 error_img => [ \&tag_error_img, $cfg, $errors ],
9168c88c 1101 ifFieldPerm => [ \&tag_if_field_perm, $request, $article ],
abf5bbc6 1102 parent => [ \&tag_hash, $parent ],
918735d1
TC
1103 DevHelp::Tags->make_iterator2
1104 ([ \&iter_flags, $self ], 'flag', 'flags' ),
1105 ifFlagSet => [ \&tag_if_flag_set, $article ],
8b0b2f34
TC
1106 DevHelp::Tags->make_iterator2
1107 ([ \&iter_crumbs, $article, $articles ], 'crumb', 'crumbs' ),
1108 typename => \&tag_typename,
ca9aa2bf
TC
1109 );
1110}
1111
1112sub edit_template {
1113 my ($self, $article, $cgi) = @_;
1114
1115 my $base = $article->{level};
1116 my $t = $cgi->param('_t');
1117 if ($t && $t =~ /^\w+$/) {
1118 $base = $t;
1119 }
1120 return $self->{cfg}->entry('admin templates', $base,
1121 "admin/edit_$base");
1122}
1123
1124sub add_template {
1125 my ($self, $article, $cgi) = @_;
1126
1127 $self->edit_template($article, $cgi);
1128}
1129
1130sub low_edit_form {
1131 my ($self, $request, $article, $articles, $msg, $errors) = @_;
1132
1133 my $cgi = $request->cgi;
1134 my %acts;
1135 %acts = $self->low_edit_tags(\%acts, $request, $article, $articles, $msg,
1136 $errors);
1137 my $template = $article->{id} ?
1138 $self->edit_template($article, $cgi) : $self->add_template($article, $cgi);
1139
1140 return BSE::Template->get_response($template, $request->cfg, \%acts);
1141}
1142
1143sub edit_form {
1144 my ($self, $request, $article, $articles, $msg, $errors) = @_;
1145
1146 return $self->low_edit_form($request, $article, $articles, $msg, $errors);
1147}
1148
1149sub add_form {
9168c88c 1150 my ($self, $req, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
1151
1152 my $level;
9168c88c 1153 my $cgi = $req->cgi;
ca9aa2bf
TC
1154 my $parentid = $cgi->param('parentid');
1155 if ($parentid) {
1156 if ($parentid =~ /^\d+$/) {
1157 if (my $parent = $self->get_parent($parentid, $articles)) {
1158 $level = $parent->{level}+1;
1159 }
1160 else {
1161 $parentid = undef;
1162 }
1163 }
1164 elsif ($parentid eq "-1") {
1165 $level = 1;
1166 }
1167 }
1168 unless (defined $level) {
1169 $level = $cgi->param('level');
1170 undef $level unless defined $level && $level =~ /^\d+$/
1171 && $level > 0 && $level < 100;
1172 defined $level or $level = 3;
1173 }
1174
1175 my %article;
1176 my @cols = Article->columns;
1177 @article{@cols} = ('') x @cols;
1178 $article{id} = '';
1179 $article{parentid} = $parentid;
1180 $article{level} = $level;
1181 $article{body} = '<maximum of 64Kb>';
1182 $article{listed} = 1;
1183 $article{generator} = $self->generator;
1184
9168c88c
TC
1185 my ($values, $labels) = $self->possible_parents(\%article, $articles, $req);
1186 @$values
a0a8147b
TC
1187 or return $self->edit_sections($req, $articles,
1188 "You can't add children to any article at that level");
9168c88c
TC
1189
1190 return $self->low_edit_form($req, \%article, $articles, $msg, $errors);
ca9aa2bf
TC
1191}
1192
1193sub generator { 'Generate::Article' }
1194
331fd099
TC
1195sub typename {
1196 my ($self) = @_;
1197
1198 my $gen = $self->generator;
1199
1200 ($gen =~ /(\w+)$/)[0] || 'Article';
1201}
1202
ca9aa2bf 1203sub _validate_common {
b553afa2 1204 my ($self, $data, $articles, $errors, $article) = @_;
ca9aa2bf 1205
918735d1
TC
1206# if (defined $data->{parentid} && $data->{parentid} =~ /^(?:-1|\d+)$/) {
1207# unless ($data->{parentid} == -1 or
1208# $articles->getByPkey($data->{parentid})) {
1209# $errors->{parentid} = "Selected parent article doesn't exist";
1210# }
1211# }
1212# else {
1213# $errors->{parentid} = "You need to select a valid parent";
1214# }
1215 if (exists $data->{title} && $data->{title} !~ /\S/) {
1216 $errors->{title} = "Please enter a title";
ca9aa2bf
TC
1217 }
1218
1219 if (exists $data->{template} && $data->{template} =~ /\.\./) {
1220 $errors->{template} = "Please only select templates from the list provided";
1221 }
1222
1223}
1224
1225sub validate {
918735d1 1226 my ($self, $data, $articles, $errors) = @_;
ca9aa2bf
TC
1227
1228 $self->_validate_common($data, $articles, $errors);
331fd099
TC
1229 custom_class($self->{cfg})
1230 ->article_validate($data, undef, $self->typename, $errors);
ca9aa2bf
TC
1231
1232 return !keys %$errors;
1233}
1234
1235sub validate_old {
918735d1 1236 my ($self, $article, $data, $articles, $errors) = @_;
ca9aa2bf 1237
b553afa2 1238 $self->_validate_common($data, $articles, $errors, $article);
331fd099
TC
1239 custom_class($self->{cfg})
1240 ->article_validate($data, $article, $self->typename, $errors);
ca9aa2bf 1241
b553afa2
TC
1242 if (exists $data->{release} && !valid_date($data->{release})) {
1243 $errors->{release} = "Invalid release date";
1244 }
1245
ca9aa2bf
TC
1246 return !keys %$errors;
1247}
1248
1249sub validate_parent {
1250 1;
1251}
1252
1253sub fill_new_data {
1254 my ($self, $req, $data, $articles) = @_;
1255
331fd099
TC
1256 custom_class($self->{cfg})
1257 ->article_fill_new($data, $self->typename);
1258
ca9aa2bf
TC
1259 1;
1260}
1261
1262sub make_link {
1263 my ($self, $article) = @_;
1264
1265 my $article_uri = $self->{cfg}->entry('uri', 'articles', '/a');
1266 my $link = "$article_uri/$article->{id}.html";
1267 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1268 if ($link_titles) {
1269 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1270 $link .= "/".$extra;
1271 }
1272
1273 $link;
1274}
1275
1276sub save_new {
1277 my ($self, $req, $articles) = @_;
1278
1279 my $cgi = $req->cgi;
1280 my %data;
1281 my $table_object = $self->table_object($articles);
1282 my @columns = $table_object->rowClass->columns;
1283 $self->save_thumbnail($cgi, undef, \%data);
1284 for my $name (@columns) {
9168c88c
TC
1285 $data{$name} = $cgi->param($name)
1286 if defined $cgi->param($name);
ca9aa2bf 1287 }
918735d1 1288 $data{flags} = join '', sort $cgi->param('flags');
ca9aa2bf
TC
1289
1290 my $msg;
1291 my %errors;
918735d1 1292 $self->validate(\%data, $articles, \%errors)
ca9aa2bf
TC
1293 or return $self->add_form($req, $articles, $msg, \%errors);
1294
1295 my $parent;
1296 if ($data{parentid} > 0) {
1297 $parent = $articles->getByPkey($data{parentid}) or die;
9168c88c
TC
1298 $req->user_can('edit_add_child', $parent)
1299 or return $self->add_form($req, $articles,
1300 "You cannot add a child to that article");
1301 for my $name (@columns) {
1302 if (exists $data{$name} &&
1303 !$req->user_can("edit_add_field_$name", $parent)) {
1304 delete $data{$name};
1305 }
1306 }
ca9aa2bf 1307 }
9168c88c
TC
1308 else {
1309 $req->user_can('edit_add_child')
1310 or return $self->add_form($req, $articles,
1311 "You cannot create a top-level article");
1312 for my $name (@columns) {
1313 if (exists $data{$name} &&
1314 !$req->user_can("edit_add_field_$name")) {
1315 delete $data{$name};
1316 }
1317 }
1318 }
1319
ca9aa2bf
TC
1320 $self->validate_parent(\%data, $articles, $parent, \$msg)
1321 or return $self->add_form($req, $articles, $msg);
1322
1323 $self->fill_new_data($req, \%data, $articles);
1324 my $level = $parent ? $parent->{level}+1 : 1;
9168c88c 1325 $data{displayOrder} = time;
ca9aa2bf
TC
1326 $data{titleImage} ||= '';
1327 $data{imagePos} = 'tr';
1328 $data{release} = sql_date($data{release}) || now_sqldate();
1329 $data{expire} = sql_date($data{expire}) || $Constants::D_99;
1330 unless ($data{template}) {
1331 $data{template} ||=
1332 $self->{cfg}->entry("children of $data{parentid}", 'template');
1333 $data{template} ||=
1334 $self->{cfg}->entry("level $level", 'template');
1335 }
1336 $data{link} ||= '';
1337 $data{admin} ||= '';
1338 if ($parent) {
1339 $data{threshold} = $parent->{threshold}
1340 if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1341 $data{summaryLength} = $parent->{summaryLength}
1342 if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1343 }
1344 else {
1345 $data{threshold} = $self->{cfg}->entry("level $level", 'threshold', 5)
1346 if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1347 $data{summaryLength} = 200
1348 if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1349 }
1350 $data{generator} = $self->generator;
1351 $data{lastModified} = now_sqldate();
1352 $data{level} = $level;
1353 $data{listed} = 1 unless defined $data{listed};
1354
1355 shift @columns;
1356 my $article = $table_object->add(@data{@columns});
1357
1358 # we now have an id - generate the links
1359
1360 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1361 $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1362 $article->setLink($self->make_link($article));
1363 $article->save();
1364
caa7299c
TC
1365 use Util 'generate_article';
1366 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1367
8b0b2f34
TC
1368 my $r = $cgi->param('r');
1369 if ($r) {
1370 $r .= ($r =~ /\?/) ? '&' : '?';
1371 $r .= "id=$article->{id}";
1372 }
1373 else {
1374 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1375 $r = $urlbase . $article->{admin};
1376 }
1377 return BSE::Template->get_refresh($r, $self->{cfg});
1378
ca9aa2bf
TC
1379}
1380
1381sub fill_old_data {
0d5ccc7f 1382 my ($self, $req, $article, $data) = @_;
ca9aa2bf 1383
4010d92e
TC
1384 if (exists $data->{body}) {
1385 $data->{body} =~ s/\x0D\x0A/\n/g;
1386 $data->{body} =~ tr/\r/\n/;
1387 }
ca9aa2bf 1388 for my $col (Article->columns) {
331fd099 1389 next if $col =~ /^custom/;
ca9aa2bf
TC
1390 $article->{$col} = $data->{$col}
1391 if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1392 }
331fd099
TC
1393 custom_class($self->{cfg})
1394 ->article_fill_old($article, $data, $self->typename);
ca9aa2bf
TC
1395
1396 return 1;
1397}
1398
1399sub save {
1400 my ($self, $req, $article, $articles) = @_;
4010d92e
TC
1401
1402 $req->user_can(edit_save => $article)
1403 or return $self->edit_form($req, $article, $articles,
1404 "You don't have access to save this article");
ca9aa2bf
TC
1405
1406 my $cgi = $req->cgi;
1407 my %data;
1408 for my $name ($article->columns) {
1409 $data{$name} = $cgi->param($name)
abf5bbc6
TC
1410 if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid'
1411 && $req->user_can("edit_field_edit_$name", $article);
ca9aa2bf 1412 }
918735d1
TC
1413 # possibly this needs tighter error checking
1414 $data{flags} = join '', sort $cgi->param('flags')
1415 if $req->user_can("edit_field_edit_flags", $article);
ca9aa2bf
TC
1416 my %errors;
1417 $self->validate_old($article, \%data, $articles, \%errors)
1418 or return $self->edit_form($req, $article, $articles, undef, \%errors);
abf5bbc6
TC
1419 $self->save_thumbnail($cgi, $article, \%data)
1420 if $req->user_can('edit_field_edit_thumbImage', $article);
ca9aa2bf
TC
1421 $self->fill_old_data($req, $article, \%data);
1422 if (exists $article->{template} &&
1423 $article->{template} =~ m|\.\.|) {
1424 my $msg = "Please only select templates from the list provided";
1425 return $self->edit_form($req, $article, $articles, $msg);
1426 }
1427
1428 # reparenting
1429 my $newparentid = $cgi->param('parentid');
abf5bbc6
TC
1430 if ($newparentid && $req->user_can('edit_field_edit_parentid', $article)) {
1431 if ($newparentid == $article->{parentid}) {
1432 # nothing to do
1433 }
1434 elsif ($newparentid != -1) {
1435 print STDERR "Reparenting...\n";
1436 my $newparent = $articles->getByPkey($newparentid);
1437 if ($newparent) {
1438 if ($newparent->{level} != $article->{level}-1) {
1439 # the article cannot become a child of itself or one of it's
1440 # children
1441 if ($article->{id} == $newparentid
1442 || $self->is_descendant($article->{id}, $newparentid, $articles)) {
1443 my $msg = "Cannot become a child of itself or of a descendant";
1444 return $self->edit_form($req, $article, $articles, $msg);
1445 }
1446 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1447 if ($self->is_descendant($article->{id}, $shopid, $articles)) {
1448 my $msg = "Cannot become a descendant of the shop";
1449 return $self->edit_form($req, $article, $articles, $msg);
1450 }
1451 my $msg;
1452 $self->reparent($article, $newparentid, $articles, \$msg)
1453 or return $self->edit_form($req, $article, $articles, $msg);
ca9aa2bf 1454 }
abf5bbc6
TC
1455 else {
1456 # stays at the same level, nothing special
1457 $article->{parentid} = $newparentid;
ca9aa2bf 1458 }
ca9aa2bf 1459 }
abf5bbc6
TC
1460 # else ignore it
1461 }
1462 else {
1463 # becoming a section
1464 my $msg;
1465 $self->reparent($article, -1, $articles, \$msg)
1466 or return $self->edit_form($req, $article, $articles, $msg);
ca9aa2bf 1467 }
ca9aa2bf
TC
1468 }
1469
abf5bbc6
TC
1470 $article->{listed} = $cgi->param('listed')
1471 if defined $cgi->param('listed') &&
1472 $req->user_can('edit_field_edit_listed', $article);
1473 $article->{release} = sql_date($cgi->param('release'))
1474 if defined $cgi->param('release') &&
1475 $req->user_can('edit_field_edit_release', $article);
1476
1477 $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99
1478 if defined $cgi->param('expire') &&
1479 $req->user_can('edit_field_edit_expire', $article);
ca9aa2bf
TC
1480 $article->{lastModified} = now_sqldate();
1481 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1482 if ($article->{id} != 1 && $article->{link} && $link_titles) {
1483 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1484 my $article_uri = $self->{cfg}->entry('uri', 'articles', '/a');
1485 $article->{link} = "$article_uri/$article->{id}.html/$extra";
1486 }
1487
1488 $article->save();
caa7299c
TC
1489
1490 use Util 'generate_article';
1491 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1492
8b0b2f34 1493 return $self->refresh($article, $cgi, undef, 'Article saved');
ca9aa2bf
TC
1494}
1495
1496sub sql_date {
1497 my $str = shift;
1498 my ($year, $month, $day);
1499
1500 # look for a date
1501 if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
1502 $year += 2000 if $year < 100;
1503
1504 return sprintf("%04d-%02d-%02d", $year, $month, $day);
1505 }
1506 return undef;
1507}
1508
1509sub reparent {
1510 my ($self, $article, $newparentid, $articles, $rmsg) = @_;
1511
1512 my $newlevel;
1513 if ($newparentid == -1) {
1514 $newlevel = 1;
1515 }
1516 else {
1517 my $parent = $articles->getByPkey($newparentid);
1518 unless ($parent) {
1519 $$rmsg = "Cannot get new parent article";
1520 return;
1521 }
1522 $newlevel = $parent->{level} + 1;
1523 }
1524 # the caller will save this one
1525 $article->{parentid} = $newparentid;
1526 $article->{level} = $newlevel;
1527 $article->{displayOrder} = time;
1528
1529 my @change = ( [ $article->{id}, $newlevel ] );
1530 while (@change) {
1531 my $this = shift @change;
1532 my ($art, $level) = @$this;
1533
1534 my @kids = $articles->getBy(parentid=>$art);
1535 push @change, map { [ $_->{id}, $level+1 ] } @kids;
1536
1537 for my $kid (@kids) {
1538 $kid->{level} = $level+1;
1539 $kid->save;
1540 }
1541 }
1542
1543 return 1;
1544}
1545
1546# tests if $desc is a descendant of $art
1547# where both are article ids
1548sub is_descendant {
1549 my ($self, $art, $desc, $articles) = @_;
1550
1551 my @check = ($art);
1552 while (@check) {
1553 my $parent = shift @check;
1554 $parent == $desc and return 1;
1555 my @kids = $articles->getBy(parentid=>$parent);
1556 push @check, map $_->{id}, @kids;
1557 }
1558
1559 return 0;
1560}
1561
1562sub save_thumbnail {
1563 my ($self, $cgi, $original, $newdata) = @_;
1564
1565 unless ($original) {
1566 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1567 }
1568 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
1569 if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
1570 unlink("$imagedir/$original->{thumbImage}");
1571 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1572 }
1573 my $image = $cgi->param('thumbnail');
1574 if ($image && -s $image) {
1575 # where to put it...
1576 my $name = '';
1577 $image =~ /([\w.-]+)$/ and $name = $1;
1578 my $filename = time . "_" . $name;
1579
1580 use Fcntl;
1581 my $counter = "";
1582 $filename = time . '_' . $counter . '_' . $name
1583 until sysopen( OUTPUT, "$imagedir/$filename",
1584 O_WRONLY| O_CREAT| O_EXCL)
1585 || ++$counter > 100;
1586
1587 fileno(OUTPUT) or die "Could not open image file: $!";
1588 binmode OUTPUT;
1589 my $buffer;
1590
1591 #no strict 'refs';
1592
1593 # read the image in from the browser and output it to our
1594 # output filehandle
1595 print STDERR "\$image ",ref $image,"\n";
1596 seek $image, 0, 0;
1597 print OUTPUT $buffer while sysread $image, $buffer, 1024;
1598
1599 close OUTPUT
1600 or die "Could not close image output file: $!";
1601
1602 use Image::Size;
1603
1604 if ($original && $original->{thumbImage}) {
1605 #unlink("$imagedir/$original->{thumbImage}");
1606 }
1607 @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
1608 $newdata->{thumbImage} = $filename;
1609 }
1610}
1611
1612sub child_types {
1613 my ($self, $article) = @_;
1614
1615 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1616 if ($article && $article->{id} && $article->{id} == $shopid) {
1617 return ( 'BSE::Edit::Catalog' );
1618 }
1619 return ( 'BSE::Edit::Article' );
1620}
1621
1622sub add_stepkid {
1623 my ($self, $req, $article, $articles) = @_;
1624
31a26b52
TC
1625 $req->user_can(edit_stepkid_add => $article)
1626 or return $self->edit_form($req, $article, $articles,
1627 "You don't have access to add step children to 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_add => $child)
1641 or die "You don't have access to add a stepparent to that article\n";
ca9aa2bf
TC
1642
1643 use BSE::Util::Valid qw/valid_date/;
1644 my $release = $cgi->param('release');
1645 valid_date($release) or $release = undef;
1646 my $expire = $cgi->param('expire');
1647 valid_date($expire) or $expire = undef;
1648
1649 my $newentry =
1650 BSE::Admin::StepParents->add($article, $child, $release, $expire);
1651 };
1652 if ($@) {
1653 return $self->edit_form($req, $article, $articles, $@);
1654 }
a0a8147b
TC
1655
1656 use Util 'generate_article';
1657 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1658
8b0b2f34 1659 return $self->refresh($article, $cgi, 'step', 'Stepchild added');
ca9aa2bf
TC
1660}
1661
1662sub del_stepkid {
1663 my ($self, $req, $article, $articles) = @_;
1664
31a26b52
TC
1665 $req->user_can(edit_stepkid_delete => $article)
1666 or return $self->edit_form($req, $article, $articles,
1667 "You don't have access to delete stepchildren from this article");
1668
ca9aa2bf
TC
1669 my $cgi = $req->cgi;
1670 require 'BSE/Admin/StepParents.pm';
1671 eval {
1672 my $childId = $cgi->param('stepkid');
1673 defined $childId
1674 or die "No stepkid supplied to add_stepkid";
1675 $childId =~ /^\d+$/
1676 or die "Invalid stepkid supplied to add_stepkid";
1677 my $child = $articles->getByPkey($childId)
1678 or die "Article $childId not found";
31a26b52
TC
1679
1680 $req->user_can(edit_stepparent_delete => $child)
1681 or die "You cannot remove stepparents from that article\n";
ca9aa2bf
TC
1682
1683 BSE::Admin::StepParents->del($article, $child);
1684 };
1685
1686 if ($@) {
1687 return $self->edit_form($req, $article, $articles, $@);
1688 }
a0a8147b
TC
1689 use Util 'generate_article';
1690 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1691
8b0b2f34 1692 return $self->refresh($article, $cgi, 'step', 'Stepchild deleted');
ca9aa2bf
TC
1693}
1694
1695sub save_stepkids {
1696 my ($self, $req, $article, $articles) = @_;
1697
31a26b52
TC
1698 $req->user_can(edit_stepkid_save => $article)
1699 or return $self->edit_form($req, $article, $articles,
1700 "No access to save stepkid data for this article");
1701
ca9aa2bf
TC
1702 my $cgi = $req->cgi;
1703 require 'BSE/Admin/StepParents.pm';
1704 my @stepcats = OtherParents->getBy(parentId=>$article->{id});
1705 my %stepcats = map { $_->{parentId}, $_ } @stepcats;
1706 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1707 for my $stepcat (@stepcats) {
31a26b52
TC
1708 $req->user_can(edit_stepparent_save => $stepcat->{childId})
1709 or next;
ca9aa2bf
TC
1710 for my $name (qw/release expire/) {
1711 my $date = $cgi->param($name.'_'.$stepcat->{childId});
1712 if (defined $date) {
1713 if ($date eq '') {
1714 $date = $datedefs{$name};
1715 }
1716 elsif (valid_date($date)) {
1717 use BSE::Util::SQL qw/date_to_sql/;
1718 $date = date_to_sql($date);
1719 }
1720 else {
1721 return $self->refresh($article, $cgi, '', "Invalid date '$date'");
1722 }
1723 $stepcat->{$name} = $date;
1724 }
1725 }
1726 eval {
1727 $stepcat->save();
1728 };
1729 $@ and return $self->refresh($article, $cgi, '', $@);
1730 }
a0a8147b
TC
1731 use Util 'generate_article';
1732 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1733
8b0b2f34 1734 return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
ca9aa2bf
TC
1735}
1736
1737sub add_stepparent {
1738 my ($self, $req, $article, $articles) = @_;
1739
31a26b52
TC
1740 $req->user_can(edit_stepparent_add => $article)
1741 or return $self->edit_form($req, $article, $articles,
1742 "You don't have access to add stepparents to this article");
1743
ca9aa2bf
TC
1744 my $cgi = $req->cgi;
1745 require 'BSE/Admin/StepParents.pm';
1746 eval {
1747 my $step_parent_id = $cgi->param('stepparent');
1748 defined($step_parent_id)
1749 or die "No stepparent supplied to add_stepparent";
1750 int($step_parent_id) eq $step_parent_id
1751 or die "Invalid stepcat supplied to add_stepcat";
1752 my $step_parent = $articles->getByPkey($step_parent_id)
31a26b52
TC
1753 or die "Parent $step_parent_id not found\n";
1754
1755 $req->user_can(edit_stepkid_add => $step_parent)
1756 or die "You don't have access to add a stepkid to that article\n";
ca9aa2bf
TC
1757
1758 my $release = $cgi->param('release');
1759 defined $release
1760 or $release = "01/01/2000";
1761 use BSE::Util::Valid qw/valid_date/;
1762 $release eq '' or valid_date($release)
1763 or die "Invalid release date";
1764 my $expire = $cgi->param('expire');
1765 defined $expire
1766 or $expire = '31/12/2999';
1767 $expire eq '' or valid_date($expire)
1768 or die "Invalid expire data";
1769
1770 my $newentry =
1771 BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
1772 };
1773 $@ and return $self->refresh($article, $cgi, 'step', $@);
1774
a0a8147b
TC
1775 use Util 'generate_article';
1776 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1777
8b0b2f34 1778 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
ca9aa2bf
TC
1779}
1780
1781sub del_stepparent {
1782 my ($self, $req, $article, $articles) = @_;
1783
31a26b52
TC
1784 $req->user_can(edit_stepparent_delete => $article)
1785 or return $self->edit_form($req, $article, $articles,
1786 "You cannot remove stepparents from that article");
1787
ca9aa2bf
TC
1788 my $cgi = $req->cgi;
1789 require 'BSE/Admin/StepParents.pm';
1790 my $step_parent_id = $cgi->param('stepparent');
1791 defined($step_parent_id)
1792 or return $self->refresh($article, $cgi, 'stepparents',
1793 "No stepparent supplied to add_stepcat");
1794 int($step_parent_id) eq $step_parent_id
1795 or return $self->refresh($article, $cgi, 'stepparents',
1796 "Invalid stepparent supplied to add_stepparent");
1797 my $step_parent = $articles->getByPkey($step_parent_id)
1798 or return $self->refresh($article, $cgi, 'stepparent',
1799 "Stepparent $step_parent_id not found");
1800
31a26b52
TC
1801 $req->user_can(edit_stepkid_delete => $step_parent)
1802 or die "You don't have access to remove the stepkid from that article\n";
1803
ca9aa2bf
TC
1804 eval {
1805 BSE::Admin::StepParents->del($step_parent, $article);
1806 };
1807 $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
1808
a0a8147b
TC
1809 use Util 'generate_article';
1810 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1811
8b0b2f34 1812 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
ca9aa2bf
TC
1813}
1814
1815sub save_stepparents {
1816 my ($self, $req, $article, $articles) = @_;
1817
31a26b52
TC
1818 $req->user_can(edit_stepparent_save => $article)
1819 or return $self->edit_form($req, $article, $articles,
1820 "No access to save stepparent data for this artice");
1821
ca9aa2bf
TC
1822 my $cgi = $req->cgi;
1823
1824 require 'BSE/Admin/StepParents.pm';
1825 my @stepparents = OtherParents->getBy(childId=>$article->{id});
1826 my %stepparents = map { $_->{parentId}, $_ } @stepparents;
1827 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1828 for my $stepparent (@stepparents) {
31a26b52
TC
1829 $req->user_can(edit_stepkid_save => $stepparent->{parentId})
1830 or next;
ca9aa2bf
TC
1831 for my $name (qw/release expire/) {
1832 my $date = $cgi->param($name.'_'.$stepparent->{parentId});
1833 if (defined $date) {
1834 if ($date eq '') {
1835 $date = $datedefs{$name};
1836 }
1837 elsif (valid_date($date)) {
1838 use BSE::Util::SQL qw/date_to_sql/;
1839 $date = date_to_sql($date);
1840 }
1841 else {
1842 return $self->refresh($article, $cgi, "Invalid date '$date'");
1843 }
1844 $stepparent->{$name} = $date;
1845 }
1846 }
1847 eval {
1848 $stepparent->save();
1849 };
1850 $@ and return $self->refresh($article, $cgi, '', $@);
1851 }
1852
a0a8147b
TC
1853 use Util 'generate_article';
1854 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1855
8b0b2f34
TC
1856 return $self->refresh($article, $cgi, 'stepparents',
1857 'Stepparent information saved');
ca9aa2bf
TC
1858}
1859
1860sub refresh {
1861 my ($self, $article, $cgi, $name, $message, $extras) = @_;
1862
8b0b2f34
TC
1863 my $url = $cgi->param('r');
1864 unless ($url) {
1865 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1866 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
1867 $url .= "&message=" . CGI::escape($message) if $message;
1868 if ($cgi->param('_t')) {
1869 $url .= "&_t=".CGI::escape($cgi->param('_t'));
1870 }
1871 $url .= $extras if defined $extras;
1872 my $cgiextras = $cgi->param('e');
1873 $url .= "#$name" if $name;
ca9aa2bf 1874 }
ca9aa2bf
TC
1875
1876 return BSE::Template->get_refresh($url, $self->{cfg});
1877}
1878
1879sub show_images {
918735d1 1880 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
1881
1882 my %acts;
918735d1 1883 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
1884 my $template = 'admin/article_img';
1885
1886 return BSE::Template->get_response($template, $req->cfg, \%acts);
1887}
1888
1889sub save_image_changes {
1890 my ($self, $req, $article, $articles) = @_;
1891
abf5bbc6
TC
1892 $req->user_can(edit_images_save => $article)
1893 or return $self->show_images($req, $article, $articles,
1894 "You don't have access to save image information for this article");
1895
ca9aa2bf
TC
1896 my $cgi = $req->cgi;
1897 my $image_pos = $cgi->param('imagePos');
1898 if ($image_pos
1899 && $image_pos =~ /^(?:tl|tr|bl|br)$/
1900 && $image_pos ne $article->{imagePos}) {
1901 $article->{imagePos} = $image_pos;
1902 $article->save;
1903 }
1904 my @images = $article->images;
1905
1906 my $changed;
1907 my @alt = $cgi->param('alt');
1908 if (@alt) {
1909 ++$changed;
1910 for my $index (0..$#images) {
1911 $index < @alt or last;
1912 $images[$index]{alt} = $alt[$index];
1913 }
1914 }
1915 my @urls = $cgi->param('url');
1916 if (@urls) {
1917 ++$changed;
1918 for my $index (0..$#images) {
1919 $index < @urls or next;
1920 $images[$index]{url} = $urls[$index];
1921 }
1922 }
1923 if ($changed) {
1924 for my $image (@images) {
1925 $image->save;
1926 }
1927 }
a0a8147b
TC
1928
1929 use Util 'generate_article';
1930 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1931
1932
8b0b2f34
TC
1933 return $self->refresh($article, $cgi, undef, 'Image information saved',
1934 '&showimages=1');
ca9aa2bf
TC
1935}
1936
1937sub add_image {
1938 my ($self, $req, $article, $articles) = @_;
1939
abf5bbc6
TC
1940 $req->user_can(edit_images_add => $article)
1941 or return $self->show_images($req, $article, $articles,
1942 "You don't have access to add new images to this article");
1943
ca9aa2bf
TC
1944 my $cgi = $req->cgi;
1945
1946 my $image = $cgi->param('image');
1947 unless ($image) {
1948 return $self->show_images($req, $article, $articles,
918735d1
TC
1949 'Enter or select the name of an image file on your machine',
1950 { image => 'Please enter an image filename' });
ca9aa2bf
TC
1951 }
1952 if (-z $image) {
1953 return $self->show_images($req, $article, $articles,
918735d1
TC
1954 'Image file is empty',
1955 { image => 'Image file is empty' });
ca9aa2bf
TC
1956 }
1957 my $imagename = $image;
1958 $imagename .= ''; # force it into a string
1959 my $basename = '';
1960 $imagename =~ /([\w.-]+)$/ and $basename = $1;
1961
1962 # create a filename that we hope is unique
1963 my $filename = time. '_'. $basename;
1964
1965 # for the sysopen() constants
1966 use Fcntl;
1967
1968 my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
1969 # loop until we have a unique filename
1970 my $counter="";
1971 $filename = time. '_' . $counter . '_' . $basename
1972 until sysopen( OUTPUT, "$imagedir/$filename", O_WRONLY| O_CREAT| O_EXCL)
1973 || ++$counter > 100;
1974
1975 fileno(OUTPUT) or die "Could not open image file: $!";
1976
1977 # for OSs with special text line endings
1978 binmode OUTPUT;
1979
1980 my $buffer;
1981
1982 no strict 'refs';
1983
1984 # read the image in from the browser and output it to our output filehandle
1985 print OUTPUT $buffer while read $image, $buffer, 1024;
1986
1987 # close and flush
1988 close OUTPUT
1989 or die "Could not close image file $filename: $!";
1990
1991 use Image::Size;
1992
1993
1994 my($width,$height) = imgsize("$imagedir/$filename");
1995
1996 my $alt = $cgi->param('altIn');
1997 defined $alt or $alt = '';
1998 my $url = $cgi->param('url');
1999 defined $url or $url = '';
2000 my %image =
2001 (
2002 articleId => $article->{id},
2003 image => $filename,
2004 alt=>$alt,
2005 width=>$width,
2006 height => $height,
2007 url => $url,
2008 displayOrder=>time,
2009 );
2010 require Images;
2011 my @cols = Image->columns;
2012 shift @cols;
2013 my $imageobj = Images->add(@image{@cols});
a0a8147b
TC
2014
2015 use Util 'generate_article';
2016 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2017
8b0b2f34
TC
2018 return $self->refresh($article, $cgi, undef, 'New image added',
2019 '&showimages=1');
ca9aa2bf
TC
2020}
2021
2022# remove an image
2023sub remove_img {
2024 my ($self, $req, $article, $articles, $imageid) = @_;
2025
abf5bbc6
TC
2026 $req->user_can(edit_images_delete => $article)
2027 or return $self->show_images($req, $article, $articles,
2028 "You don't have access to delete images from this article");
2029
ca9aa2bf
TC
2030 $imageid or die;
2031
2032 my @images = $article->images();
2033 my ($image) = grep $_->{id} == $imageid, @images
2034 or return $self->show_images($req, $article, $articles, "No such image");
2035 my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
6473c56f 2036 unlink "$imagedir$image->{image}";
ca9aa2bf
TC
2037 $image->remove;
2038
a0a8147b
TC
2039 use Util 'generate_article';
2040 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2041
8b0b2f34
TC
2042 return $self->refresh($article, $req->cgi, undef, 'Image removed',
2043 '&showimages=1');
ca9aa2bf
TC
2044}
2045
2046sub move_img_up {
2047 my ($self, $req, $article, $articles) = @_;
2048
abf5bbc6
TC
2049 $req->user_can(edit_images_reorder => $article)
2050 or return $self->show_images($req, $article, $articles,
2051 "You don't have access to reorder images in this article");
2052
ca9aa2bf
TC
2053 my $imageid = $req->cgi->param('imageid');
2054 my @images = $article->images;
2055 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
2056 or return $self->show_images($req, $article, $articles, "No such image");
2057 $imgindex > 0
2058 or return $self->show_images($req, $article, $articles, "Image is already at the top");
2059 my ($to, $from) = @images[$imgindex-1, $imgindex];
2060 ($to->{displayOrder}, $from->{displayOrder}) =
2061 ($from->{displayOrder}, $to->{displayOrder});
2062 $to->save;
2063 $from->save;
2064
a0a8147b
TC
2065 use Util 'generate_article';
2066 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2067
8b0b2f34
TC
2068 return $self->refresh($article, $req->cgi, undef, 'Image moved',
2069 '&showimages=1');
ca9aa2bf
TC
2070}
2071
2072sub move_img_down {
2073 my ($self, $req, $article, $articles) = @_;
2074
abf5bbc6
TC
2075 $req->user_can(edit_images_reorder => $article)
2076 or return $self->show_images($req, $article, $articles,
2077 "You don't have access to reorder images in this article");
2078
ca9aa2bf
TC
2079 my $imageid = $req->cgi->param('imageid');
2080 my @images = $article->images;
2081 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
2082 or return $self->show_images($req, $article, $articles, "No such image");
2083 $imgindex < $#images
2084 or return $self->show_images($req, $article, $articles, "Image is already at the end");
2085 my ($to, $from) = @images[$imgindex+1, $imgindex];
2086 ($to->{displayOrder}, $from->{displayOrder}) =
2087 ($from->{displayOrder}, $to->{displayOrder});
2088 $to->save;
2089 $from->save;
2090
a0a8147b
TC
2091 use Util 'generate_article';
2092 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2093
8b0b2f34
TC
2094 return $self->refresh($article, $req->cgi, undef, 'Image moved',
2095 '&showimages=1');
ca9aa2bf
TC
2096}
2097
2098sub get_article {
2099 my ($self, $articles, $article) = @_;
2100
2101 return $article;
2102}
2103
2104sub table_object {
2105 my ($self, $articles) = @_;
2106
2107 $articles;
2108}
2109
2110my %types =
2111 (
2112 qw(
2113 pdf application/pdf
2114 txt text/plain
2115 htm text/html
2116 html text/html
2117 gif image/gif
2118 jpg image/jpeg
2119 jpeg image/jpeg
2120 doc application/msword
2121 rtf application/rtf
2122 zip application/zip
2123 png image/png
2124 bmp image/bmp
2125 tif image/tiff
2126 tiff image/tiff
2127 sgm text/sgml
2128 sgml text/sgml
2129 xml text/xml
2130 mov video/quicktime
2131 )
2132 );
2133
2134sub _refresh_filelist {
8b0b2f34 2135 my ($self, $req, $article, $msg) = @_;
ca9aa2bf 2136
8b0b2f34 2137 return $self->refresh($article, $req->cgi, undef, $msg, '&filelist=1');
ca9aa2bf
TC
2138}
2139
2140sub filelist {
918735d1 2141 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
2142
2143 my %acts;
918735d1 2144 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
2145 my $template = 'admin/filelist';
2146
2147 return BSE::Template->get_response($template, $req->cfg, \%acts);
2148}
2149
2150sub fileadd {
2151 my ($self, $req, $article, $articles) = @_;
2152
abf5bbc6
TC
2153 $req->user_can(edit_files_add => $article)
2154 or return $self->filelist($req, $article, $articles,
2155 "You don't have access to add files to this article");
2156
ca9aa2bf
TC
2157 my %file;
2158 my $cgi = $req->cgi;
2159 require ArticleFile;
2160 my @cols = ArticleFile->columns;
2161 shift @cols;
2162 for my $col (@cols) {
2163 if (defined $cgi->param($col)) {
2164 $file{$col} = $cgi->param($col);
2165 }
2166 }
2167
2168 $file{forSale} = 0 + exists $file{forSale};
2169 $file{articleId} = $article->{id};
2170 $file{download} = 0 + exists $file{download};
2171 $file{requireUser} = 0 + exists $file{requireUser};
2172
2173 my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
2174
2175 # build a filename
2176 my $file = $cgi->param('file');
2177 unless ($file) {
2178 return $self->filelist($req, $article, $articles,
918735d1
TC
2179 "Enter or select the name of a file on your machine",
2180 { file => 'Please enter a filename' });
ca9aa2bf
TC
2181 }
2182 if (-z $file) {
2183 return $self->filelist($req, $article, $articles,
918735d1
TC
2184 "File is empty",
2185 { file => 'File is empty' });
ca9aa2bf
TC
2186 }
2187
2188 unless ($file{contentType}) {
2189 unless ($file =~ /\.([^.]+)$/) {
2190 $file{contentType} = "application/octet-stream";
2191 }
2192 unless ($file{contentType}) {
2193 my $ext = lc $1;
2194 my $type = $types{$ext};
2195 unless ($type) {
2196 $type = $self->{cfg}->entry('extensions', $ext)
2197 || $self->{cfg}->entry('extensions', ".$ext")
2198 || "application/octet-stream";
2199 }
2200 $file{contentType} = $type;
2201 }
2202 }
2203
2204 my $basename = '';
2205 $file =~ /([\w.-]+)$/ and $basename = $1;
2206
2207 my $filename = time. '_'. $basename;
2208
2209 # for the sysopen() constants
2210 use Fcntl;
2211
2212 # loop until we have a unique filename
2213 my $counter="";
2214 $filename = time. '_' . $counter . '_' . $basename
2215 until sysopen( OUTPUT, "$downloadPath/$filename",
2216 O_WRONLY| O_CREAT| O_EXCL)
2217 || ++$counter > 100;
2218
2219 fileno(OUTPUT) or die "Could not open file: $!";
2220
2221 # for OSs with special text line endings
2222 binmode OUTPUT;
2223
2224 my $buffer;
2225
2226 no strict 'refs';
2227
2228 # read the image in from the browser and output it to our output filehandle
2229 print OUTPUT $buffer while read $file, $buffer, 8192;
2230
2231 # close and flush
2232 close OUTPUT
2233 or die "Could not close file $filename: $!";
2234
2235 use BSE::Util::SQL qw/now_datetime/;
2236 $file{filename} = $filename;
2237 $file{displayName} = $basename;
2238 $file{sizeInBytes} = -s $file;
2239 $file{displayOrder} = time;
2240 $file{whenUploaded} = now_datetime();
2241
2242 require ArticleFiles;
2243 my $fileobj = ArticleFiles->add(@file{@cols});
2244
a0a8147b
TC
2245 use Util 'generate_article';
2246 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2247
8b0b2f34 2248 $self->_refresh_filelist($req, $article, 'New file added');
ca9aa2bf
TC
2249}
2250
2251sub fileswap {
2252 my ($self, $req, $article, $articles) = @_;
2253
abf5bbc6
TC
2254 $req->user_can('edit_files_reorder', $article)
2255 or return $self->filelist($req, $article, $articles,
2256 "You don't have access to reorder files in this article");
2257
ca9aa2bf
TC
2258 my $cgi = $req->cgi;
2259 my $id1 = $cgi->param('file1');
2260 my $id2 = $cgi->param('file2');
2261
2262 if ($id1 && $id2) {
2263 my @files = $article->files;
2264
2265 my ($file1) = grep $_->{id} == $id1, @files;
2266 my ($file2) = grep $_->{id} == $id2, @files;
2267
2268 if ($file1 && $file2) {
2269 ($file1->{displayOrder}, $file2->{displayOrder})
2270 = ($file2->{displayOrder}, $file1->{displayOrder});
2271 $file1->save;
2272 $file2->save;
2273 }
2274 }
2275
a0a8147b
TC
2276 use Util 'generate_article';
2277 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2278
8b0b2f34 2279 $self->_refresh_filelist($req, $article, 'File moved');
ca9aa2bf
TC
2280}
2281
2282sub filedel {
2283 my ($self, $req, $article, $articles) = @_;
2284
abf5bbc6
TC
2285 $req->user_can('edit_files_delete', $article)
2286 or return $self->filelist($req, $article, $articles,
2287 "You don't have access to delete files from this article");
2288
ca9aa2bf
TC
2289 my $cgi = $req->cgi;
2290 my $fileid = $cgi->param('file');
2291 if ($fileid) {
2292 my @files = $article->files;
2293
2294 my ($file) = grep $_->{id} == $fileid, @files;
2295
2296 if ($file) {
2297 my $downloadPath = $req->cfg->entryErr('paths', 'downloads');
2298 my $filename = $downloadPath . "/" . $file->{filename};
2299 my $debug_del = $req->cfg->entryBool('debug', 'file_unlink', 0);
2300 if ($debug_del) {
2301 unlink $filename
2302 or print STDERR "Error deleting $filename: $!\n";
2303 }
2304 else {
2305 unlink $filename;
2306 }
2307 $file->remove();
2308 }
2309 }
2310
a0a8147b
TC
2311 use Util 'generate_article';
2312 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2313
8b0b2f34 2314 $self->_refresh_filelist($req, $article, 'File deleted');
ca9aa2bf
TC
2315}
2316
2317sub filesave {
abf5bbc6 2318 my ($self, $req, $article, $articles) = @_;
ca9aa2bf 2319
abf5bbc6
TC
2320 $req->user_can('edit_files_save', $article)
2321 or return $self->filelist($req, $article, $articles,
2322 "You don't have access to save file information for this article");
ca9aa2bf
TC
2323 my @files = $article->files;
2324
2325 my $cgi = $req->cgi;
2326 for my $file (@files) {
2327 if (defined $cgi->param("description_$file->{id}")) {
2328 $file->{description} = $cgi->param("description_$file->{id}");
2329 if (my $type = $cgi->param("contentType_$file->{id}")) {
2330 $file->{contentType} = $type;
2331 }
2332 $file->{download} = 0 + defined $cgi->param("download_$file->{id}");
2333 $file->{forSale} = 0 + defined $cgi->param("forSale_$file->{id}");
2334 $file->{requireUser} = 0 + defined $cgi->param("requireUser_$file->{id}");
2335 $file->save;
2336 }
2337 }
2338
a0a8147b
TC
2339 use Util 'generate_article';
2340 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2341
8b0b2f34 2342 $self->_refresh_filelist($req, $article, 'File information saved');
ca9aa2bf
TC
2343}
2344
6473c56f
TC
2345sub can_remove {
2346 my ($self, $req, $article, $articles, $rmsg) = @_;
2347
abf5bbc6
TC
2348 unless ($req->user_can('edit_delete_article', $article, $rmsg)) {
2349 $$rmsg ||= "Access denied";
2350 return;
2351 }
2352
6473c56f
TC
2353 if ($articles->children($article->{id})) {
2354 $$rmsg = "This article has children. You must delete the children first (or change their parents)";
2355 return;
2356 }
2357 if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
2358 $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
2359 return;
2360 }
2361 if ($article->{id} == $Constants::SHOPID) {
2362 $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the the store instead.";
2363 return;
2364 }
2365
2366 return 1;
2367}
2368
2369sub remove {
2370 my ($self, $req, $article, $articles) = @_;
2371
2372 my $why_not;
2373 unless ($self->can_remove($req, $article, $articles, \$why_not)) {
2374 return $self->edit_form($req, $article, $articles, $why_not);
2375 }
2376
2377 require Images;
2378 my @images = Images->getBy(articleId=>$article->{id});
2379 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
2380 for my $image (@images) {
2381 unlink("$imagedir/$image->{image}");
2382 $image->remove();
2383 }
2384
2385 # remove any step(child|parent) links
2386 require OtherParents;
2387 my @steprels = OtherParents->anylinks($article->{id});
2388 for my $link (@steprels) {
2389 $link->remove();
2390 }
2391
2392 my $parentid = $article->{parentid};
2393 $article->remove;
8b0b2f34
TC
2394 my $url = $req->cgi->param('r');
2395 unless ($url) {
2396 my $urlbase = $self->{cfg}->entryVar('site', 'url');
2397 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$parentid";
2398 $url .= "&message=Article+deleted";
2399 }
6473c56f
TC
2400 return BSE::Template->get_refresh($url, $self->{cfg});
2401}
2402
4010d92e
TC
2403sub unhide {
2404 my ($self, $req, $article, $articles) = @_;
2405
2406 if ($req->user_can(edit_field_edit_listed => $article)
2407 && $req->user_can(edit_save => $article)) {
2408 $article->{listed} = 1;
2409 $article->save;
2410
2411 use Util 'generate_article';
2412 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2413 }
8b0b2f34 2414 return $self->refresh($article, $req->cgi, undef, 'Article unhidden');
4010d92e
TC
2415}
2416
2417sub hide {
2418 my ($self, $req, $article, $articles) = @_;
2419
2420 if ($req->user_can(edit_field_edit_listed => $article)
2421 && $req->user_can(edit_save => $article)) {
2422 $article->{listed} = 0;
2423 $article->save;
2424
2425 use Util 'generate_article';
2426 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2427 }
2428 my $r = $req->cgi->param('r');
2429 unless ($r) {
2430 $r = $req->cfg->entryVar('site', 'url') . "/cgi-bin/admin/add.pl?id=" . $article->{parentid};
2431 }
8b0b2f34 2432 return $self->refresh($article, $req->cgi, undef, 'Article hidden');
4010d92e
TC
2433}
2434
9168c88c
TC
2435sub default_value {
2436 my ($self, $req, $article, $col) = @_;
2437
2438 if ($article->{parentid}) {
2439 my $section = "children of $article->{parentid}";
2440 my $value = $req->cfg->entry($section, $col);
2441 if (defined $value) {
2442 }
2443 }
2444 my $section = "level $article->{level}";
2445 my $value = $req->cfg->entry($section, $col);
2446 defined($value) and return encode_entities($value);
2447
2448 return '';
2449}
2450
918735d1
TC
2451sub flag_sections {
2452 return ( 'article flags' );
2453}
2454
2455sub flags {
2456 my ($self) = @_;
2457
2458 my $cfg = $self->{cfg};
2459
2460 my @sections = $self->flag_sections;
2461
2462 my %flags = map $cfg->entriesCS($_), reverse @sections;
2463 my @valid = grep /^\w$/, keys %flags;
2464
2465 return map +{ id => $_, desc => $flags{$_} },
2466 sort { lc($flags{$a}) cmp lc($flags{$b}) }@valid;
2467}
2468
ca9aa2bf
TC
24691;
2470
2471=head1 NAME
2472
2473 BSE::Edit::Article - editing functionality for BSE articles
2474
2475=head1 AUTHOR
2476
2477Tony Cook <tony@develop-help.com>
2478
2479=head1 REVISION
2480
2481$Revision$
2482
2483=cut