0.12_09 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);
5use BSE::Util::Tags;
6use BSE::Util::SQL qw(now_sqldate);
7
8sub article_dispatch {
9 my ($self, $request, $article, $articles) = @_;
10
11 my $cgi = $request->cgi;
12 my $action;
13 my %actions = $self->article_actions;
14 for my $check (keys %actions) {
15 if ($cgi->param($check) || $cgi->param("$check.x")) {
16 $action = $check;
17 last;
18 }
19 }
20 my @extraargs;
21 unless ($action) {
22 ($action, @extraargs) = $self->other_article_actions($cgi);
23 }
24 $action ||= 'edit';
25 my $method = $actions{$action};
26 return $self->$method($request, $article, $articles, @extraargs);
27}
28
29sub noarticle_dispatch {
30 my ($self, $request, $articles) = @_;
31
32 my $cgi = $request->cgi;
33 my $action = 'add';
34 my %actions = $self->noarticle_actions;
35 for my $check (keys %actions) {
36 if ($cgi->param($check) || $cgi->param("$check.x")) {
37 $action = $check;
38 last;
39 }
40 }
41 my $method = $actions{$action};
42 return $self->$method($request, $articles);
43}
44
45sub edit_sections {
46 my ($self, $req, $articles) = @_;
47
48 my %article;
49 my @cols = Article->columns;
50 @article{@cols} = ('') x @cols;
51 $article{id} = '-1';
52 $article{parentid} = -1;
53 $article{level} = 0;
54 $article{body} = '';
55 $article{listed} = 0;
56 $article{generator} = $self->generator;
57
58 return $self->low_edit_form($req, \%article, $articles);
59}
60
61sub article_actions {
62 my ($self) = @_;
63
64 return
65 (
66 edit => 'edit_form',
67 save => 'save',
68 add_stepkid => 'add_stepkid',
69 del_stepkid => 'del_stepkid',
70 save_stepkids => 'save_stepkids',
71 add_stepparent => 'add_stepparent',
72 del_stepparent => 'del_stepparent',
73 save_stepparents => 'save_stepparents',
74 artimg => 'save_image_changes',
75 addimg => 'add_image',
6473c56f 76 remove => 'remove',
ca9aa2bf
TC
77 showimages => 'show_images',
78 process => 'save_image_changes',
79 removeimg => 'remove_img',
80 moveimgup => 'move_img_up',
81 moveimgdown => 'move_img_down',
82 filelist => 'filelist',
83 fileadd => 'fileadd',
84 fileswap => 'fileswap',
85 filedel => 'filedel',
86 filesave => 'filesave',
87 );
88}
89
90sub other_article_actions {
91 my ($self, $cgi) = @_;
92
93 for my $param ($cgi->param) {
94 if ($param =~ /^removeimg_(\d+)(\.x)?$/) {
95 return ('removeimg', $1 );
96 }
97 }
98
99 return;
100}
101
102sub noarticle_actions {
103 return
104 (
105 add => 'add_form',
106 save => 'save_new',
107 );
108}
109
110sub get_parent {
111 my ($self, $parentid, $articles) = @_;
112
113 if ($parentid == -1) {
114 return
115 {
116 id => -1,
117 title=>'All Sections',
118 level => 0,
119 listed => 0,
120 parentid => undef,
121 };
122 }
123 else {
124 return $articles->getByPkey($parentid);
125 }
126}
127
128sub tag_hash {
129 my ($object, $args) = @_;
130
131 my $value = $object->{$args};
132 defined $value or $value = '';
133 encode_entities($value);
134}
135
136sub tag_art_type {
137 my ($level, $cfg) = @_;
138
139 encode_entities($cfg->entry('level names', $level, 'Article'));
140}
141
142sub tag_if_new {
143 my ($article) = @_;
144
145 !$article->{id};
146}
147
148sub reparent_updown {
149 return 1;
150}
151
152sub should_be_catalog {
153 my ($self, $article, $parent, $articles) = @_;
154
155 if ($article->{parentid} && (!$parent || $parent->{id} != $article->{parentid})) {
156 $parent = $articles->getByPkey($article->{id});
157 }
158
159 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
160
161 return $article->{parentid} && $parent &&
162 ($article->{parentid} == $shopid ||
163 $parent->{generator} eq 'Generate::Catalog');
164}
165
166sub possible_parents {
167 my ($self, $article, $articles) = @_;
168
169 my %labels;
170 my @values;
171
172 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
173 my @parents = $articles->getBy('level', $article->{level}-1);
174 @parents = grep { $_->{generator} eq 'Generate::Article'
175 && $_->{id} != $shopid } @parents;
176
177 @values = ( map {$_->{id}} @parents );
178 %labels = ( map { $_->{id} => "$_->{title} ($_->{id})" } @parents );
179
180 if ($article->{level} == 1) {
181 push @values, -1;
182 $labels{-1} = "No parent - this is a section";
183 }
184
185 if ($article->{id} && $self->reparent_updown($article)) {
186 # we also list the siblings and grandparent (if any)
187 my @siblings = grep $_->{id} != $article->{id} && $_->{id} != $shopid,
188 $articles->getBy(parentid => $article->{parentid});
189 push @values, map $_->{id}, @siblings;
190 @labels{map $_->{id}, @siblings} =
191 map { "-- move down a level -- $_->{title} ($_->{id})" } @siblings;
192
193 if ($article->{parentid} != -1) {
194 my $parent = $articles->getByPkey($article->{parentid});
195 if ($parent->{parentid} != -1) {
196 my $gparent = $articles->getByPkey($parent->{parentid});
197 push @values, $gparent->{id};
198 $labels{$gparent->{id}} =
199 "-- move up a level -- $gparent->{title} ($gparent->{id})";
200 }
201 else {
202 push @values, -1;
203 $labels{-1} = "-- move up a level -- become a section";
204 }
205 }
206 }
207
208 return (\@values, \%labels);
209}
210
211sub tag_list {
212 my ($self, $article, $articles, $cgi, $what) = @_;
213
214 if ($what eq 'listed') {
215 my @values = qw(0 1);
216 my %labels = ( 0=>"No", 1=>"Yes");
217 if ($article->{level} <= 2) {
218 $labels{2} = "In Sections, but not menu";
219 push(@values, 2);
220 }
221 else {
222 $labels{2} = "In content, but not menus";
223 push(@values, 2);
224 }
225 return $cgi->popup_menu(-name=>'listed',
226 -values=>\@values,
227 -labels=>\%labels,
228 -default=>$article->{listed});
229 }
230 else {
231 my ($values, $labels) = $self->possible_parents($article, $articles);
232 my $html;
233 if (defined $article->{parentid}) {
234 $html = $cgi->popup_menu(-name=>'parentid',
235 -values=> $values,
236 -labels => $labels,
237 -default => $article->{parentid},
238 -override=>1);
239 }
240 else {
241 $html = $cgi->popup_menu(-name=>'parentid',
242 -values=> $values,
243 -labels => $labels,
244 -override=>1);
245 }
246
247 # munge the html - we display a default value, so we need to wrap the
248 # default <select /> around this one
249 $html =~ s!^<select[^>]+>|</select>!!gi;
250 return $html;
251 }
252}
253
254sub tag_checked {
255 my ($arg, $acts, $funcname, $templater) = @_;
256 my ($func, $args) = split ' ', $arg, 2;
257 return $templater->perform($acts, $func, $args) ? 'checked' : '';
258}
259
260sub iter_get_images {
261 my ($article) = @_;
262
263 $article->{id} or return;
264 $article->images;
265}
266
267sub iter_get_kids {
268 my ($article, $articles) = @_;
269
15fb10f2 270 my @children;
ca9aa2bf
TC
271 $article->{id} or return;
272 if (UNIVERSAL::isa($article, 'Article')) {
15fb10f2 273 @children = $article->children;
ca9aa2bf
TC
274 }
275 elsif ($article->{id}) {
15fb10f2 276 @children = $articles->children($article->{id});
ca9aa2bf 277 }
15fb10f2
TC
278
279 return sort { $b->{displayOrder} <=> $a->{displayOrder} } @children;
ca9aa2bf
TC
280}
281
282sub tag_if_have_child_type {
283 my ($level, $cfg) = @_;
284
285 defined $cfg->entry("level names", $level+1);
286}
287
288sub tag_is {
289 my ($args, $acts, $isname, $templater) = @_;
290
291 my ($func, $funcargs) = split ' ', $args, 2;
292 return $templater->perform($acts, $func, $funcargs) ? 'Yes' : 'No';
293}
294
caa7299c
TC
295sub default_template {
296 my ($self, $article, $cfg, $templates) = @_;
297
298 if ($article->{parentid}) {
299 my $template = $cfg->entry("children of $article->{parentid}", "template");
300 return $template
301 if $template && grep $_ eq $template, @$templates;
302 }
303 if ($article->{level}) {
304 my $template = $cfg->entry("level $article->{level}", "template");
305 return $template
306 if $template && grep $_ eq $template, @$templates;
307 }
308 return $templates->[0];
309}
310
ca9aa2bf
TC
311sub tag_templates {
312 my ($self, $article, $cfg, $cgi) = @_;
313
314 my @templates = sort $self->templates($article);
315 my $default;
316 if ($article->{template} && grep $_ eq $article->{template}, @templates) {
317 $default = $article->{template};
318 }
319 else {
caa7299c
TC
320 my @options;
321 $default = $self->default_template($article, $cfg, \@templates);
ca9aa2bf
TC
322 }
323 return $cgi->popup_menu(-name=>'template',
324 -values=>\@templates,
325 -default=>$default,
326 -override=>1);
327}
328
329sub title_images {
330 my ($self, $article) = @_;
331
332 my @title_images;
333 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
334 if (opendir TITLE_IMAGES, "$imagedir/titles") {
335 @title_images = sort
336 grep -f "$imagedir/titles/$_" && /\.(gif|jpeg|jpg|png)$/i,
337 readdir TITLE_IMAGES;
338 closedir TITLE_IMAGES;
339 }
340
341 @title_images;
342}
343
344sub tag_title_images {
345 my ($self, $article, $cfg, $cgi) = @_;
346
347 my @images = $self->title_images($article);
348 my @values = ( '', @images );
349 my %labels = ( '' => 'None', map { $_ => $_ } @images );
350 return $cgi->
351 popup_menu(-name=>'titleImage',
352 -values=>\@values,
353 -labels=>\%labels,
354 -default=>$article->{id} ? $article->{titleImage} : '',
355 -override=>1);
356}
357
358sub base_template_dirs {
359 return ( "common" );
360}
361
362sub template_dirs {
363 my ($self, $article) = @_;
364
365 my @dirs = $self->base_template_dirs;
366 if (my $parentid = $article->{parentid}) {
367 my $section = "children of $parentid";
368 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
369 push @dirs, split /,/, $dirs;
370 }
371 }
372 if (my $id = $article->{id}) {
373 my $section = "article $id";
374 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
375 push @dirs, split /,/, $dirs;
376 }
377 }
caa7299c
TC
378 if ($article->{level}) {
379 push @dirs, $article->{level};
380 my $dirs = $self->{cfg}->entry("level $article->{level}", 'template_dirs');
381 push @dirs, split /,/, $dirs if $dirs;
382 }
ca9aa2bf
TC
383
384 @dirs;
385}
386
387sub templates {
388 my ($self, $article) = @_;
389
390 my @dirs = $self->template_dirs($article);
391 my @templates;
392 my $basedir = $self->{cfg}->entry('paths', 'templates', $Constants::TMPLDIR);
393 for my $dir (@dirs) {
394 my $path = File::Spec->catdir($basedir, $dir);
395 if (-d $path) {
396 if (opendir TEMPLATE_DIR, $path) {
397 push(@templates, sort map "$dir/$_",
398 grep -f "$path/$_" && /\.(tmpl|html)$/i, readdir TEMPLATE_DIR);
399 closedir TEMPLATE_DIR;
400 }
401 }
402 }
403 return (@templates, $self->extra_templates($article));
404}
405
406sub extra_templates {
407 my ($self, $article) = @_;
408
409 my $basedir = $self->{cfg}->entry('paths', 'templates', $Constants::TMPLDIR);
410 my @templates;
411 if (my $id = $article->{id}) {
412 push @templates, 'index.tmpl'
413 if $id == 1 && -f "$basedir/index.html";
414 push @templates, 'index2.tmpl'
415 if $id == 2 && -f "$basedir/index2.html";
416 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
417 push @templates, "shop_sect.tmpl"
418 if $id == $shopid && -f "$basedir/shop_sect.tmpl";
419 my $section = "article $id";
420 my $extras = $self->{cfg}->entry($section, 'extra_templates');
421 push @templates, grep /\.(tmpl|html)$/i, split /,/, $extras
422 if $extras;
423 }
424
425 @templates;
426}
427
428sub edit_parent {
429 my ($article) = @_;
430
431 return '' unless $article->{id} && $article->{id} != -1;
432 return <<HTML;
433<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
434HTML
435}
436
437sub iter_allkids {
438 my ($article) = @_;
439
440 return unless $article->{id} && $article->{id} > 0;
441 $article->allkids;
442}
443
444sub _load_step_kids {
445 my ($article, $step_kids) = @_;
446
447 my @stepkids = OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
448 %$step_kids = map { $_->{childId} => $_ } @stepkids;
449 use Data::Dumper;
450 print STDERR "stepkids:\n", Dumper($step_kids);
451 $step_kids->{loaded} = 1;
452}
453
454sub tag_if_step_kid {
455 my ($article, $allkids, $rallkid_index, $step_kids) = @_;
456
457 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
458
459 my $kid = $allkids->[$$rallkid_index]
460 or return;
461 exists $step_kids->{$kid->{id}};
462}
463
464sub tag_step_kid {
465 my ($article, $allkids, $rallkid_index, $step_kids, $arg) = @_;
466
467 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
468
469 my $kid = $allkids->[$$rallkid_index]
470 or return '';
471 print STDERR "found kid (want $arg): ", Dumper $kid;
472 encode_entities($step_kids->{$kid->{id}}{$arg});
473}
474
475sub tag_move_stepkid {
476 my ($self, $cgi, $article, $allkids, $rallkids_index) = @_;
477
478 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
479 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
480 my $html = '';
481 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
482 if ($cgi->param('_t')) {
483 $url .= "&_t=".$cgi->param('_t');
484 }
485 $url .= "#step";
486 my $refreshto = CGI::escape($url);
487 if ($$rallkids_index < $#$allkids) {
488 $html .= <<HTML;
489<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/move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom"></a>
490HTML
491 }
492 if ($$rallkids_index > 0) {
493 $html .= <<HTML;
494<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/move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom"></a>
495HTML
496 }
497 return $html;
498}
499
500sub possible_stepkids {
501 my ($articles, $stepkids) = @_;
502
503 return sort { lc $a->{title} cmp lc $b->{title} }
504 grep !$stepkids->{$_->{id}}, $articles->all;
505}
506
507
508
509sub tag_possible_stepkids {
510 my ($step_kids, $article, $possstepkids, $articles, $cgi) = @_;
511
512 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
513 @$possstepkids = possible_stepkids($articles, $step_kids)
514 unless @$possstepkids;
515 my %labels = map { $_->{id} => "$_->{title} ($_->{id})" } @$possstepkids;
516 return
517 $cgi->popup_menu(-name=>'stepkid',
518 -values=> [ map $_->{id}, @$possstepkids ],
519 -labels => \%labels);
520}
521
522sub tag_if_possible_stepkids {
523 my ($step_kids, $article, $possstepkids, $articles, $cgi) = @_;
524
525 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
526 @$possstepkids = possible_stepkids($articles, $step_kids)
527 unless @$possstepkids;
528
529 @$possstepkids;
530}
531
532sub iter_get_stepparents {
533 my ($article) = @_;
534
535 return unless $article->{id} && $article->{id} > 0;
536
537 OtherParents->getBy(childId=>$article->{id});
538}
539
540sub tag_ifStepParents {
541 my ($args, $acts, $funcname, $templater) = @_;
542
543 return $templater->perform($acts, 'ifStepparents', '');
544}
545
546sub tag_stepparent_targ {
547 my ($article, $targs, $rindex, $arg) = @_;
548
549 if ($article->{id} && $article->{id} > 0 && !@$targs) {
550 @$targs = $article->step_parents;
551 }
552 encode_entities($targs->[$$rindex]{$arg});
553}
554
555sub tag_move_stepparent {
556 my ($self, $cgi, $article, $stepparents, $rindex) = @_;
557
558 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
559 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
560 my $html = '';
561 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
562 if ($cgi->param('_t')) {
563 $url .= "&_t=".$cgi->param('_t');
564 }
565 $url .= "#stepparents";
566 my $refreshto = CGI::escape($url);
567 if ($$rindex < $#$stepparents) {
568 $html .= <<HTML;
569<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/move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom"></a>
570HTML
571 }
572 if ($$rindex > 0) {
573 $html .= <<HTML;
574<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/move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom"></a>
575HTML
576 }
577 return $html;
578}
579
580sub tag_if_stepparent_possibles {
581 my ($article, $articles, $targs, $possibles) = @_;
582
583 if ($article->{id} && $article->{id} > 0) {
584 @$targs = $article->step_parents unless @$targs;
585 my %targs = map { $_->{id}, 1 } @$targs;
586 @$possibles = grep !$targs{$_->{id}}, $articles->all;
587 }
588 scalar @$possibles;
589}
590
591sub tag_stepparent_possibles {
592 my ($cgi, $article, $articles, $targs, $possibles) = @_;
593
594 if ($article->{id} && $article->{id} > 0) {
595 @$targs = $article->step_parents unless @$targs;
596 my %targs = map { $_->{id}, 1 } @$targs;
597 @$possibles = sort { lc $a->{title} cmp lc $b->{title} }
598 grep !$targs{$_->{id}}, $articles->all;
599 }
600 $cgi->popup_menu(-name=>'stepparent',
601 -values => [ map $_->{id}, @$possibles ],
602 -labels => { map { $_->{id}, "$_->{title} ($_->{id})" }
603 @$possibles });
604}
605
606sub iter_files {
607 my ($article) = @_;
608
609 return unless $article->{id} && $article->{id} > 0;
610
611 return $article->files;
612}
613
614sub tag_edit_parent {
615 my ($article) = @_;
616
617 return '' unless $article->{id} && $article->{id} != -1;
618
619 return <<HTML;
620<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
621HTML
622}
623
624sub tag_if_children {
625 my ($args, $acts, $funcname, $templater) = @_;
626
627 return $templater->perform($acts, 'ifChildren', '');
628}
629
630sub tag_movechild {
631 my ($self, $kids, $rindex) = @_;
632
633 $$rindex >=0 && $$rindex < @$kids
634 or return '** movechild can only be used in the children iterator **';
635
636 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
637 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
638 my $html = '';
639 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" alt="" align="absbottom">';
640 my $id = $kids->[$$rindex]{id};
641 if ($$rindex < $#$kids) {
642 $html .= <<HTML;
643<a href="$cgi_uri/admin/move.pl?id=$id&d=down&edit=1&all=1"><img src="$images_uri/admin/move_down.gif" width="17" height="13" alt="Move Down" border="0" align="absbottom"></a>
644HTML
645 }
646 else {
647 $html .= $nomove;
648 }
649 if ($$rindex > 0) {
650 $html .= <<HTML;
651<a href="$cgi_uri/admin/move.pl?id=$id&d=up&edit=1&all=1"><img src="$images_uri/admin/move_up.gif" width="17" height="13" alt="Move Up" border="0" align="absbottom"></a>
652HTML
653 }
654 else {
655 $html .= $nomove;
656 }
657 $html =~ tr/\n//d;
658
659 $html;
660}
661
662sub tag_edit_link {
663 my ($args, $acts, $funcname, $templater) = @_;
664 my ($which, $name) = split / /, $args, 2;
665 $name ||= 'Edit';
666 my $gen_class;
667 if ($acts->{$which}
668 && ($gen_class = $templater->perform($acts, $which, 'generator'))) {
669 eval "use $gen_class";
670 unless ($@) {
671 my $gen = $gen_class->new;
672 my $link = $gen->edit_link($templater->perform($acts, $which, 'id'));
673 return qq!<a href="$link">$name</a>!;
674 }
675 }
676 return '';
677}
678
679sub tag_imgmove {
680 my ($article, $rindex, $images) = @_;
681
682 $$rindex >= 0 && $$rindex < @$images
683 or return '** imgmove can only be used in image iterator **';
684
685 my $html = '';
686 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" alt="" align="absbottom">';
687 my $image = $images->[$$rindex];
688 if ($$rindex > 0) {
689 $html .= <<HTML
690<a href="$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgup=1&imageid=$image->{id}"><img src="/images/admin/move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom"></a>
691HTML
692 }
693 else {
694 $html .= $nomove;
695 }
696 if ($$rindex < $#$images) {
697 $html .= <<HTML
698<a href="$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgdown=1&imageid=$image->{id}"><img src="/images/admin/move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom"></a>
699HTML
700 }
701 else {
702 $html .= $nomove;
703 }
704 return $html;
705}
706
707sub tag_movefiles {
708 my ($self, $article, $files, $rindex) = @_;
709
710 my $html = '';
711
712 $$rindex >= 0 && $$rindex < @$files
713 or return '** movefiles can only be used in the files iterator **';
714
715 my $nomove = '<img src="/images/trans_pixel.gif" width="17" height="13" border="0" alt="" align="absbottom">';
716 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
717
718 if ($$rindex < $#$files) {
719 $html .= <<HTML;
720<a href="$ENV{SCRIPT_NAME}?fileswap=1&id=$article->{id}&file1=$files->[$$rindex]{id}&file2=$files->[$$rindex+1]{id}"><img src="$images_uri/admin/move_down.gif" width="17" height="13" border="0" alt="Move Down" align="absbottom"></a>
721HTML
722 }
723 else {
724 $html .= $nomove;
725 }
726 if ($$rindex > 0) {
727 $html .= <<HTML;
728<a href="$ENV{SCRIPT_NAME}?fileswap=1&id=$article->{id}&file1=$files->[$$rindex]{id}&file2=$files->[$$rindex-1]{id}"><img src="$images_uri/admin/move_up.gif" width="17" height="13" border="0" alt="Move Up" align="absbottom"></a>
729HTML
730 }
731 else {
732 $html .= $nomove;
733 }
734 $html =~ tr/\n//d;
735 $html;
736}
737
738sub tag_old {
739 my ($article, $cgi, $args, $acts, $funcname, $templater) = @_;
740
741 my ($col, $func, $funcargs) = split ' ', $args, 3;
742 my $value = $cgi->param($col);
743 if (defined $value) {
744 return encode_entities($value);
745 }
746 else {
747 if ($func) {
748 return $templater->perform($acts, $func, $funcargs);
749 }
750 else {
751 $value = $article->{$args};
752 defined $value or $value = '';
753 return encode_entities($value);
754 }
755 }
756}
757
758sub tag_error_img {
759 my ($self, $errors, $args) = @_;
760
761 return '' unless $errors->{$args};
762 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
763 my $encoded = encode_entities($errors->{$args});
764 return qq!<img src="$images_uri/admin/error.gif" alt="$encoded" title="$encoded" border="0" align="top">!;
765}
766
08123550
TC
767sub iter_admin_users {
768 require BSE::TB::AdminUsers;
769
770 BSE::TB::AdminUsers->all;
771}
772
773sub iter_admin_groups {
774 require BSE::TB::AdminGroups;
775
776 BSE::TB::AdminGroups->all;
777}
778
ca9aa2bf
TC
779sub low_edit_tags {
780 my ($self, $acts, $request, $article, $articles, $msg, $errors) = @_;
781
782 my $cgi = $request->cgi;
6473c56f 783 $msg ||= $cgi->param('message');
ca9aa2bf
TC
784 $msg ||= '';
785 $errors ||= {};
786 if (keys %$errors && !$msg) {
787 # try to get the errors in the same order as the table
788 my @cols = $self->table_object($articles)->rowClass->columns;
789 my %work = %$errors;
790 my @out = grep defined, delete @work{@cols};
791
792 $msg = join "<br>", @out, values %work;
793 }
794 my @images;
795 my $image_index;
796 my @children;
797 my $child_index;
798 my %stepkids;
799 my $cfg = $self->{cfg};
800 my @allkids;
801 my $allkid_index;
802 my @possstepkids;
803 my @stepparents;
804 my $stepparent_index;
805 my @stepparent_targs;
806 my @stepparentpossibles;
807 my @files;
808 my $file_index;
809 return
810 (
811 BSE::Util::Tags->basic($acts, $cgi, $cfg),
812 BSE::Util::Tags->admin($acts, $cfg),
813 article => [ \&tag_hash, $article ],
814 old => [ \&tag_old, $article, $cgi ],
815 articleType => [ \&tag_art_type, $article->{level}, $cfg ],
816 parentType => [ \&tag_art_type, $article->{level}-1, $cfg ],
817 ifnew => [ \&tag_if_new, $article ],
818 list => [ \&tag_list, $self, $article, $articles, $cgi ],
819 script => $ENV{SCRIPT_NAME},
820 level => $article->{level},
821 checked => \&tag_checked,
822 DevHelp::Tags->make_iterator2
823 ([ \&iter_get_images, $article ], 'image', 'images', \@images,
824 \$image_index),
825 imgmove => [ \&tag_imgmove, $article, \$image_index, \@images ],
826 message => $msg,
827 DevHelp::Tags->make_iterator2
828 ([ \&iter_get_kids, $article, $articles ],
829 'child', 'children', \@children, \$child_index),
830 ifchildren => \&tag_if_children,
831 childtype => [ \&tag_art_type, $article->{level}+1, $cfg ],
832 ifHaveChildType => [ \&tag_if_have_child_type, $article->{level}, $cfg ],
833 movechild => [ \&tag_movechild, $self, \@children, \$child_index],
834 is => \&tag_is,
835 templates => [ \&tag_templates, $self, $article, $cfg, $cgi ],
836 titleImages => [ \&tag_title_images, $self, $article, $cfg, $cgi ],
837 editParent => [ \&tag_edit_parent, $article ],
838 DevHelp::Tags->make_iterator2
839 ([ \&iter_allkids, $article ], 'kid', 'kids', \@allkids, \$allkid_index),
840 ifStepKid =>
841 [ \&tag_if_step_kid, $article, \@allkids, \$allkid_index, \%stepkids ],
842 stepkid => [ \&tag_step_kid, $article, \@allkids, \$allkid_index,
843 \%stepkids ],
844 movestepkid =>
845 [ \&tag_move_stepkid, $self, $cgi, $article, \@allkids, \$allkid_index ],
846 possible_stepkids =>
847 [ \&tag_possible_stepkids, \%stepkids, $article, \@possstepkids,
848 $articles, $cgi ],
849 ifPossibles =>
850 [ \&tag_if_possible_stepkids, \%stepkids, $article, \@possstepkids,
851 $articles, $cgi ],
852 DevHelp::Tags->make_iterator2
853 ( [ \&iter_get_stepparents, $article ], 'stepparent', 'stepparents',
854 \@stepparents, \$stepparent_index),
855 ifStepParents => \&tag_ifStepParents,
856 stepparent_targ =>
857 [ \&tag_stepparent_targ, $article, \@stepparent_targs,
858 \$stepparent_index ],
859 movestepparent =>
860 [ \&tag_move_stepparent, $self, $cgi, $article, \@stepparents,
861 \$stepparent_index ],
862 ifStepparentPossibles =>
863 [ \&tag_if_stepparent_possibles, $article, $articles, \@stepparent_targs,
864 \@stepparentpossibles, ],
865 stepparent_possibles =>
866 [ \&tag_stepparent_possibles, $cgi, $article, $articles,
867 \@stepparent_targs, \@stepparentpossibles, ],
868 DevHelp::Tags->make_iterator2
869 ([ \&iter_files, $article ], 'file', 'files', \@files, \$file_index ),
870 movefiles => [ \&tag_movefiles, $self, $article, \@files, \$file_index ],
08123550
TC
871 DevHelp::Tags->make_iterator2
872 (\&iter_admin_users, 'iadminuser', 'adminusers'),
873 DevHelp::Tags->make_iterator2
874 (\&iter_admin_groups, 'iadmingroup', 'admingroups'),
ca9aa2bf
TC
875 edit => \&tag_edit_link,
876 error => [ \&tag_hash, $errors ],
877 error_img => [ \&tag_error_img, $self, $errors ],
878 );
879}
880
881sub edit_template {
882 my ($self, $article, $cgi) = @_;
883
884 my $base = $article->{level};
885 my $t = $cgi->param('_t');
886 if ($t && $t =~ /^\w+$/) {
887 $base = $t;
888 }
889 return $self->{cfg}->entry('admin templates', $base,
890 "admin/edit_$base");
891}
892
893sub add_template {
894 my ($self, $article, $cgi) = @_;
895
896 $self->edit_template($article, $cgi);
897}
898
899sub low_edit_form {
900 my ($self, $request, $article, $articles, $msg, $errors) = @_;
901
902 my $cgi = $request->cgi;
903 my %acts;
904 %acts = $self->low_edit_tags(\%acts, $request, $article, $articles, $msg,
905 $errors);
906 my $template = $article->{id} ?
907 $self->edit_template($article, $cgi) : $self->add_template($article, $cgi);
908
909 return BSE::Template->get_response($template, $request->cfg, \%acts);
910}
911
912sub edit_form {
913 my ($self, $request, $article, $articles, $msg, $errors) = @_;
914
915 return $self->low_edit_form($request, $article, $articles, $msg, $errors);
916}
917
918sub add_form {
919 my ($self, $request, $articles, $msg, $errors) = @_;
920
921 my $level;
922 my $cgi = $request->cgi;
923 my $parentid = $cgi->param('parentid');
924 if ($parentid) {
925 if ($parentid =~ /^\d+$/) {
926 if (my $parent = $self->get_parent($parentid, $articles)) {
927 $level = $parent->{level}+1;
928 }
929 else {
930 $parentid = undef;
931 }
932 }
933 elsif ($parentid eq "-1") {
934 $level = 1;
935 }
936 }
937 unless (defined $level) {
938 $level = $cgi->param('level');
939 undef $level unless defined $level && $level =~ /^\d+$/
940 && $level > 0 && $level < 100;
941 defined $level or $level = 3;
942 }
943
944 my %article;
945 my @cols = Article->columns;
946 @article{@cols} = ('') x @cols;
947 $article{id} = '';
948 $article{parentid} = $parentid;
949 $article{level} = $level;
950 $article{body} = '<maximum of 64Kb>';
951 $article{listed} = 1;
952 $article{generator} = $self->generator;
953
954 return $self->low_edit_form($request, \%article, $articles, $msg, $errors);
955}
956
957sub generator { 'Generate::Article' }
958
959sub _validate_common {
960 my ($self, $data, $articles, $errors) = @_;
961
962 if (defined $data->{parentid} && $data->{parentid} =~ /^(?:-1|\d+)$/) {
963 unless ($data->{parentid} == -1 or
964 $articles->getByPkey($data->{parentid})) {
965 $errors->{parentid} = "Selected parent article doesn't exist";
966 }
967 }
968 else {
969 $errors->{parentid} = "You need to select a valid parent";
970 }
971
972 if (exists $data->{template} && $data->{template} =~ /\.\./) {
973 $errors->{template} = "Please only select templates from the list provided";
974 }
975
976}
977
978sub validate {
979 my ($self, $data, $articles, $rmsg, $errors) = @_;
980
981 $self->_validate_common($data, $articles, $errors);
982
983 return !keys %$errors;
984}
985
986sub validate_old {
15fb10f2 987 my ($self, $article, $data, $articles, $rmsg, $errors) = @_;
ca9aa2bf
TC
988
989 $self->_validate_common($data, $articles, $errors);
990
991 return !keys %$errors;
992}
993
994sub validate_parent {
995 1;
996}
997
998sub fill_new_data {
999 my ($self, $req, $data, $articles) = @_;
1000
1001 1;
1002}
1003
1004sub make_link {
1005 my ($self, $article) = @_;
1006
1007 my $article_uri = $self->{cfg}->entry('uri', 'articles', '/a');
1008 my $link = "$article_uri/$article->{id}.html";
1009 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1010 if ($link_titles) {
1011 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1012 $link .= "/".$extra;
1013 }
1014
1015 $link;
1016}
1017
1018sub save_new {
1019 my ($self, $req, $articles) = @_;
1020
1021 my $cgi = $req->cgi;
1022 my %data;
1023 my $table_object = $self->table_object($articles);
1024 my @columns = $table_object->rowClass->columns;
1025 $self->save_thumbnail($cgi, undef, \%data);
1026 for my $name (@columns) {
1027 $data{$name} = $cgi->param($name) if defined $cgi->param($name);
1028 }
1029
1030 my $msg;
1031 my %errors;
1032 $self->validate(\%data, $articles, \$msg, \%errors)
1033 or return $self->add_form($req, $articles, $msg, \%errors);
1034
1035 my $parent;
1036 if ($data{parentid} > 0) {
1037 $parent = $articles->getByPkey($data{parentid}) or die;
1038 }
1039
1040 $self->validate_parent(\%data, $articles, $parent, \$msg)
1041 or return $self->add_form($req, $articles, $msg);
1042
1043 $self->fill_new_data($req, \%data, $articles);
1044 my $level = $parent ? $parent->{level}+1 : 1;
1045 $data{displayOrder} ||= time;
1046 $data{titleImage} ||= '';
1047 $data{imagePos} = 'tr';
1048 $data{release} = sql_date($data{release}) || now_sqldate();
1049 $data{expire} = sql_date($data{expire}) || $Constants::D_99;
1050 unless ($data{template}) {
1051 $data{template} ||=
1052 $self->{cfg}->entry("children of $data{parentid}", 'template');
1053 $data{template} ||=
1054 $self->{cfg}->entry("level $level", 'template');
1055 }
1056 $data{link} ||= '';
1057 $data{admin} ||= '';
1058 if ($parent) {
1059 $data{threshold} = $parent->{threshold}
1060 if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1061 $data{summaryLength} = $parent->{summaryLength}
1062 if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1063 }
1064 else {
1065 $data{threshold} = $self->{cfg}->entry("level $level", 'threshold', 5)
1066 if !defined $data{threshold} || $data{threshold} =~ /^\s*$/;
1067 $data{summaryLength} = 200
1068 if !defined $data{summaryLength} || $data{summaryLength} =~ /^\s*$/;
1069 }
1070 $data{generator} = $self->generator;
1071 $data{lastModified} = now_sqldate();
1072 $data{level} = $level;
1073 $data{listed} = 1 unless defined $data{listed};
1074
1075 shift @columns;
1076 my $article = $table_object->add(@data{@columns});
1077
1078 # we now have an id - generate the links
1079
1080 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1081 $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1082 $article->setLink($self->make_link($article));
1083 $article->save();
1084
caa7299c
TC
1085 use Util 'generate_article';
1086 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1087
ca9aa2bf
TC
1088 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1089 return BSE::Template->get_refresh($urlbase . $article->{admin},
1090 $self->{cfg});
1091}
1092
1093sub fill_old_data {
0d5ccc7f 1094 my ($self, $req, $article, $data) = @_;
ca9aa2bf
TC
1095
1096 for my $col (Article->columns) {
1097 $article->{$col} = $data->{$col}
1098 if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1099 }
1100
1101 return 1;
1102}
1103
1104sub save {
1105 my ($self, $req, $article, $articles) = @_;
1106
1107 my $cgi = $req->cgi;
1108 my %data;
1109 for my $name ($article->columns) {
1110 $data{$name} = $cgi->param($name)
1111 if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid';
1112 }
1113 my %errors;
1114 $self->validate_old($article, \%data, $articles, \%errors)
1115 or return $self->edit_form($req, $article, $articles, undef, \%errors);
1116 $self->fill_old_data($req, $article, \%data);
1117 if (exists $article->{template} &&
1118 $article->{template} =~ m|\.\.|) {
1119 my $msg = "Please only select templates from the list provided";
1120 return $self->edit_form($req, $article, $articles, $msg);
1121 }
1122
1123 # reparenting
1124 my $newparentid = $cgi->param('parentid');
1125 if ($newparentid == $article->{parentid}) {
1126 # nothing to do
1127 }
1128 elsif ($newparentid != -1) {
1129 print STDERR "Reparenting...\n";
1130 my $newparent = $articles->getByPkey($newparentid);
1131 if ($newparent) {
1132 if ($newparent->{level} != $article->{level}-1) {
1133 # the article cannot become a child of itself or one of it's
1134 # children
1135 if ($article->{id} == $newparentid
1136 || $self->is_descendant($article->{id}, $newparentid, $articles)) {
1137 my $msg = "Cannot become a child of itself or of a descendant";
1138 return $self->edit_form($req, $article, $articles, $msg);
1139 }
1140 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1141 if ($self->is_descendant($article->{id}, $shopid, $articles)) {
1142 my $msg = "Cannot become a descendant of the shop";
1143 return $self->edit_form($req, $article, $articles, $msg);
1144 }
1145 my $msg;
1146 $self->reparent($article, $newparentid, $articles, \$msg)
1147 or return $self->edit_form($req, $article, $articles, $msg);
1148 }
1149 else {
1150 # stays at the same level, nothing special
1151 $article->{parentid} = $newparentid;
1152 }
1153 }
1154 # else ignore it
1155 }
1156 else {
1157 # becoming a section
1158 my $msg;
1159 $self->reparent($article, -1, $articles, \$msg)
1160 or return $self->edit_form($req, $article, $articles, $msg);
1161 }
1162
1163 $article->{listed} = $cgi->param('listed') if defined $cgi->param('listed');
1164 $article->{release} = sql_date($cgi->param('release'));
1165 $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99;
1166 $article->{lastModified} = now_sqldate();
1167 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1168 if ($article->{id} != 1 && $article->{link} && $link_titles) {
1169 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
1170 my $article_uri = $self->{cfg}->entry('uri', 'articles', '/a');
1171 $article->{link} = "$article_uri/$article->{id}.html/$extra";
1172 }
1173
1174 $article->save();
caa7299c
TC
1175
1176 use Util 'generate_article';
1177 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1178
ca9aa2bf
TC
1179 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1180 return BSE::Template->get_refresh($urlbase . $article->{admin},
1181 $self->{cfg});
1182}
1183
1184sub sql_date {
1185 my $str = shift;
1186 my ($year, $month, $day);
1187
1188 # look for a date
1189 if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
1190 $year += 2000 if $year < 100;
1191
1192 return sprintf("%04d-%02d-%02d", $year, $month, $day);
1193 }
1194 return undef;
1195}
1196
1197sub reparent {
1198 my ($self, $article, $newparentid, $articles, $rmsg) = @_;
1199
1200 my $newlevel;
1201 if ($newparentid == -1) {
1202 $newlevel = 1;
1203 }
1204 else {
1205 my $parent = $articles->getByPkey($newparentid);
1206 unless ($parent) {
1207 $$rmsg = "Cannot get new parent article";
1208 return;
1209 }
1210 $newlevel = $parent->{level} + 1;
1211 }
1212 # the caller will save this one
1213 $article->{parentid} = $newparentid;
1214 $article->{level} = $newlevel;
1215 $article->{displayOrder} = time;
1216
1217 my @change = ( [ $article->{id}, $newlevel ] );
1218 while (@change) {
1219 my $this = shift @change;
1220 my ($art, $level) = @$this;
1221
1222 my @kids = $articles->getBy(parentid=>$art);
1223 push @change, map { [ $_->{id}, $level+1 ] } @kids;
1224
1225 for my $kid (@kids) {
1226 $kid->{level} = $level+1;
1227 $kid->save;
1228 }
1229 }
1230
1231 return 1;
1232}
1233
1234# tests if $desc is a descendant of $art
1235# where both are article ids
1236sub is_descendant {
1237 my ($self, $art, $desc, $articles) = @_;
1238
1239 my @check = ($art);
1240 while (@check) {
1241 my $parent = shift @check;
1242 $parent == $desc and return 1;
1243 my @kids = $articles->getBy(parentid=>$parent);
1244 push @check, map $_->{id}, @kids;
1245 }
1246
1247 return 0;
1248}
1249
1250sub save_thumbnail {
1251 my ($self, $cgi, $original, $newdata) = @_;
1252
1253 unless ($original) {
1254 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1255 }
1256 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
1257 if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
1258 unlink("$imagedir/$original->{thumbImage}");
1259 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1260 }
1261 my $image = $cgi->param('thumbnail');
1262 if ($image && -s $image) {
1263 # where to put it...
1264 my $name = '';
1265 $image =~ /([\w.-]+)$/ and $name = $1;
1266 my $filename = time . "_" . $name;
1267
1268 use Fcntl;
1269 my $counter = "";
1270 $filename = time . '_' . $counter . '_' . $name
1271 until sysopen( OUTPUT, "$imagedir/$filename",
1272 O_WRONLY| O_CREAT| O_EXCL)
1273 || ++$counter > 100;
1274
1275 fileno(OUTPUT) or die "Could not open image file: $!";
1276 binmode OUTPUT;
1277 my $buffer;
1278
1279 #no strict 'refs';
1280
1281 # read the image in from the browser and output it to our
1282 # output filehandle
1283 print STDERR "\$image ",ref $image,"\n";
1284 seek $image, 0, 0;
1285 print OUTPUT $buffer while sysread $image, $buffer, 1024;
1286
1287 close OUTPUT
1288 or die "Could not close image output file: $!";
1289
1290 use Image::Size;
1291
1292 if ($original && $original->{thumbImage}) {
1293 #unlink("$imagedir/$original->{thumbImage}");
1294 }
1295 @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
1296 $newdata->{thumbImage} = $filename;
1297 }
1298}
1299
1300sub child_types {
1301 my ($self, $article) = @_;
1302
1303 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1304 if ($article && $article->{id} && $article->{id} == $shopid) {
1305 return ( 'BSE::Edit::Catalog' );
1306 }
1307 return ( 'BSE::Edit::Article' );
1308}
1309
1310sub add_stepkid {
1311 my ($self, $req, $article, $articles) = @_;
1312
1313 my $cgi = $req->cgi;
1314 require 'BSE/Admin/StepParents.pm';
1315 eval {
1316 my $childId = $cgi->param('stepkid');
1317 defined $childId
1318 or die "No stepkid supplied to add_stepkid";
1319 $childId =~ /^\d+$/
1320 or die "Invalid stepkid supplied to add_stepkid";
1321 my $child = $articles->getByPkey($childId)
1322 or die "Article $childId not found";
1323
1324 use BSE::Util::Valid qw/valid_date/;
1325 my $release = $cgi->param('release');
1326 valid_date($release) or $release = undef;
1327 my $expire = $cgi->param('expire');
1328 valid_date($expire) or $expire = undef;
1329
1330 my $newentry =
1331 BSE::Admin::StepParents->add($article, $child, $release, $expire);
1332 };
1333 if ($@) {
1334 return $self->edit_form($req, $article, $articles, $@);
1335 }
1336 return $self->refresh($article, $cgi, 'step');
1337}
1338
1339sub del_stepkid {
1340 my ($self, $req, $article, $articles) = @_;
1341
1342 my $cgi = $req->cgi;
1343 require 'BSE/Admin/StepParents.pm';
1344 eval {
1345 my $childId = $cgi->param('stepkid');
1346 defined $childId
1347 or die "No stepkid supplied to add_stepkid";
1348 $childId =~ /^\d+$/
1349 or die "Invalid stepkid supplied to add_stepkid";
1350 my $child = $articles->getByPkey($childId)
1351 or die "Article $childId not found";
1352
1353 BSE::Admin::StepParents->del($article, $child);
1354 };
1355
1356 if ($@) {
1357 return $self->edit_form($req, $article, $articles, $@);
1358 }
1359 return $self->refresh($article, $cgi, 'step');
1360}
1361
1362sub save_stepkids {
1363 my ($self, $req, $article, $articles) = @_;
1364
1365 my $cgi = $req->cgi;
1366 require 'BSE/Admin/StepParents.pm';
1367 my @stepcats = OtherParents->getBy(parentId=>$article->{id});
1368 my %stepcats = map { $_->{parentId}, $_ } @stepcats;
1369 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1370 for my $stepcat (@stepcats) {
1371 for my $name (qw/release expire/) {
1372 my $date = $cgi->param($name.'_'.$stepcat->{childId});
1373 if (defined $date) {
1374 if ($date eq '') {
1375 $date = $datedefs{$name};
1376 }
1377 elsif (valid_date($date)) {
1378 use BSE::Util::SQL qw/date_to_sql/;
1379 $date = date_to_sql($date);
1380 }
1381 else {
1382 return $self->refresh($article, $cgi, '', "Invalid date '$date'");
1383 }
1384 $stepcat->{$name} = $date;
1385 }
1386 }
1387 eval {
1388 $stepcat->save();
1389 };
1390 $@ and return $self->refresh($article, $cgi, '', $@);
1391 }
1392 return $self->refresh($article, $cgi, 'step');
1393}
1394
1395sub add_stepparent {
1396 my ($self, $req, $article, $articles) = @_;
1397
1398 my $cgi = $req->cgi;
1399 require 'BSE/Admin/StepParents.pm';
1400 eval {
1401 my $step_parent_id = $cgi->param('stepparent');
1402 defined($step_parent_id)
1403 or die "No stepparent supplied to add_stepparent";
1404 int($step_parent_id) eq $step_parent_id
1405 or die "Invalid stepcat supplied to add_stepcat";
1406 my $step_parent = $articles->getByPkey($step_parent_id)
1407 or die "Parnet $step_parent_id not found\n";
1408
1409 my $release = $cgi->param('release');
1410 defined $release
1411 or $release = "01/01/2000";
1412 use BSE::Util::Valid qw/valid_date/;
1413 $release eq '' or valid_date($release)
1414 or die "Invalid release date";
1415 my $expire = $cgi->param('expire');
1416 defined $expire
1417 or $expire = '31/12/2999';
1418 $expire eq '' or valid_date($expire)
1419 or die "Invalid expire data";
1420
1421 my $newentry =
1422 BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
1423 };
1424 $@ and return $self->refresh($article, $cgi, 'step', $@);
1425
1426 return $self->refresh($article, $cgi, 'stepparents');
1427}
1428
1429sub del_stepparent {
1430 my ($self, $req, $article, $articles) = @_;
1431
1432 my $cgi = $req->cgi;
1433 require 'BSE/Admin/StepParents.pm';
1434 my $step_parent_id = $cgi->param('stepparent');
1435 defined($step_parent_id)
1436 or return $self->refresh($article, $cgi, 'stepparents',
1437 "No stepparent supplied to add_stepcat");
1438 int($step_parent_id) eq $step_parent_id
1439 or return $self->refresh($article, $cgi, 'stepparents',
1440 "Invalid stepparent supplied to add_stepparent");
1441 my $step_parent = $articles->getByPkey($step_parent_id)
1442 or return $self->refresh($article, $cgi, 'stepparent',
1443 "Stepparent $step_parent_id not found");
1444
1445 eval {
1446 BSE::Admin::StepParents->del($step_parent, $article);
1447 };
1448 $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
1449
1450 return $self->refresh($article, $cgi, 'stepparents');
1451}
1452
1453sub save_stepparents {
1454 my ($self, $req, $article, $articles) = @_;
1455
1456 my $cgi = $req->cgi;
1457
1458 require 'BSE/Admin/StepParents.pm';
1459 my @stepparents = OtherParents->getBy(childId=>$article->{id});
1460 my %stepparents = map { $_->{parentId}, $_ } @stepparents;
1461 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1462 for my $stepparent (@stepparents) {
1463 for my $name (qw/release expire/) {
1464 my $date = $cgi->param($name.'_'.$stepparent->{parentId});
1465 if (defined $date) {
1466 if ($date eq '') {
1467 $date = $datedefs{$name};
1468 }
1469 elsif (valid_date($date)) {
1470 use BSE::Util::SQL qw/date_to_sql/;
1471 $date = date_to_sql($date);
1472 }
1473 else {
1474 return $self->refresh($article, $cgi, "Invalid date '$date'");
1475 }
1476 $stepparent->{$name} = $date;
1477 }
1478 }
1479 eval {
1480 $stepparent->save();
1481 };
1482 $@ and return $self->refresh($article, $cgi, '', $@);
1483 }
1484
1485 return $self->refresh($article, $cgi, 'stepparents');
1486}
1487
1488sub refresh {
1489 my ($self, $article, $cgi, $name, $message, $extras) = @_;
1490
1491 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1492 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
1493 $url .= "&message=" . CGI::escape($message) if $message;
1494 if ($cgi->param('_t')) {
1495 $url .= "&_t=".CGI::escape($cgi->param('_t'));
1496 }
1497 $url .= $extras if defined $extras;
1498 $url .= "#$name" if $name;
1499
1500 return BSE::Template->get_refresh($url, $self->{cfg});
1501}
1502
1503sub show_images {
1504 my ($self, $req, $article, $articles, $msg) = @_;
1505
1506 my %acts;
1507 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg);
1508 my $template = 'admin/article_img';
1509
1510 return BSE::Template->get_response($template, $req->cfg, \%acts);
1511}
1512
1513sub save_image_changes {
1514 my ($self, $req, $article, $articles) = @_;
1515
1516 my $cgi = $req->cgi;
1517 my $image_pos = $cgi->param('imagePos');
1518 if ($image_pos
1519 && $image_pos =~ /^(?:tl|tr|bl|br)$/
1520 && $image_pos ne $article->{imagePos}) {
1521 $article->{imagePos} = $image_pos;
1522 $article->save;
1523 }
1524 my @images = $article->images;
1525
1526 my $changed;
1527 my @alt = $cgi->param('alt');
1528 if (@alt) {
1529 ++$changed;
1530 for my $index (0..$#images) {
1531 $index < @alt or last;
1532 $images[$index]{alt} = $alt[$index];
1533 }
1534 }
1535 my @urls = $cgi->param('url');
1536 if (@urls) {
1537 ++$changed;
1538 for my $index (0..$#images) {
1539 $index < @urls or next;
1540 $images[$index]{url} = $urls[$index];
1541 }
1542 }
1543 if ($changed) {
1544 for my $image (@images) {
1545 $image->save;
1546 }
1547 }
55753022 1548 return $self->refresh($article, $cgi, undef, undef, '&showimages=1');
ca9aa2bf
TC
1549}
1550
1551sub add_image {
1552 my ($self, $req, $article, $articles) = @_;
1553
1554 my $cgi = $req->cgi;
1555
1556 my $image = $cgi->param('image');
1557 unless ($image) {
1558 return $self->show_images($req, $article, $articles,
1559 'Enter or select the name of an image file on your machine');
1560 }
1561 if (-z $image) {
1562 return $self->show_images($req, $article, $articles,
1563 'Image file is empty');
1564 }
1565 my $imagename = $image;
1566 $imagename .= ''; # force it into a string
1567 my $basename = '';
1568 $imagename =~ /([\w.-]+)$/ and $basename = $1;
1569
1570 # create a filename that we hope is unique
1571 my $filename = time. '_'. $basename;
1572
1573 # for the sysopen() constants
1574 use Fcntl;
1575
1576 my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
1577 # loop until we have a unique filename
1578 my $counter="";
1579 $filename = time. '_' . $counter . '_' . $basename
1580 until sysopen( OUTPUT, "$imagedir/$filename", O_WRONLY| O_CREAT| O_EXCL)
1581 || ++$counter > 100;
1582
1583 fileno(OUTPUT) or die "Could not open image file: $!";
1584
1585 # for OSs with special text line endings
1586 binmode OUTPUT;
1587
1588 my $buffer;
1589
1590 no strict 'refs';
1591
1592 # read the image in from the browser and output it to our output filehandle
1593 print OUTPUT $buffer while read $image, $buffer, 1024;
1594
1595 # close and flush
1596 close OUTPUT
1597 or die "Could not close image file $filename: $!";
1598
1599 use Image::Size;
1600
1601
1602 my($width,$height) = imgsize("$imagedir/$filename");
1603
1604 my $alt = $cgi->param('altIn');
1605 defined $alt or $alt = '';
1606 my $url = $cgi->param('url');
1607 defined $url or $url = '';
1608 my %image =
1609 (
1610 articleId => $article->{id},
1611 image => $filename,
1612 alt=>$alt,
1613 width=>$width,
1614 height => $height,
1615 url => $url,
1616 displayOrder=>time,
1617 );
1618 require Images;
1619 my @cols = Image->columns;
1620 shift @cols;
1621 my $imageobj = Images->add(@image{@cols});
1622
55753022 1623 return $self->refresh($article, $cgi, undef, undef, '&showimages=1');
ca9aa2bf
TC
1624}
1625
1626# remove an image
1627sub remove_img {
1628 my ($self, $req, $article, $articles, $imageid) = @_;
1629
1630 $imageid or die;
1631
1632 my @images = $article->images();
1633 my ($image) = grep $_->{id} == $imageid, @images
1634 or return $self->show_images($req, $article, $articles, "No such image");
1635 my $imagedir = $req->cfg->entry('paths', 'images', $Constants::IMAGEDIR);
6473c56f 1636 unlink "$imagedir$image->{image}";
ca9aa2bf
TC
1637 $image->remove;
1638
6473c56f 1639 return $self->refresh($article, $req->cgi, undef, undef, '&showimages=1');
ca9aa2bf
TC
1640}
1641
1642sub move_img_up {
1643 my ($self, $req, $article, $articles) = @_;
1644
1645 my $imageid = $req->cgi->param('imageid');
1646 my @images = $article->images;
1647 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
1648 or return $self->show_images($req, $article, $articles, "No such image");
1649 $imgindex > 0
1650 or return $self->show_images($req, $article, $articles, "Image is already at the top");
1651 my ($to, $from) = @images[$imgindex-1, $imgindex];
1652 ($to->{displayOrder}, $from->{displayOrder}) =
1653 ($from->{displayOrder}, $to->{displayOrder});
1654 $to->save;
1655 $from->save;
1656
1657 return $self->refresh($article, $req->cgi, undef, undef, '&showimage=1');
1658}
1659
1660sub move_img_down {
1661 my ($self, $req, $article, $articles) = @_;
1662
1663 my $imageid = $req->cgi->param('imageid');
1664 my @images = $article->images;
1665 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
1666 or return $self->show_images($req, $article, $articles, "No such image");
1667 $imgindex < $#images
1668 or return $self->show_images($req, $article, $articles, "Image is already at the end");
1669 my ($to, $from) = @images[$imgindex+1, $imgindex];
1670 ($to->{displayOrder}, $from->{displayOrder}) =
1671 ($from->{displayOrder}, $to->{displayOrder});
1672 $to->save;
1673 $from->save;
1674
1675 return $self->refresh($article, $req->cgi, undef, undef, '&showimage=1');
1676}
1677
1678sub get_article {
1679 my ($self, $articles, $article) = @_;
1680
1681 return $article;
1682}
1683
1684sub table_object {
1685 my ($self, $articles) = @_;
1686
1687 $articles;
1688}
1689
1690my %types =
1691 (
1692 qw(
1693 pdf application/pdf
1694 txt text/plain
1695 htm text/html
1696 html text/html
1697 gif image/gif
1698 jpg image/jpeg
1699 jpeg image/jpeg
1700 doc application/msword
1701 rtf application/rtf
1702 zip application/zip
1703 png image/png
1704 bmp image/bmp
1705 tif image/tiff
1706 tiff image/tiff
1707 sgm text/sgml
1708 sgml text/sgml
1709 xml text/xml
1710 mov video/quicktime
1711 )
1712 );
1713
1714sub _refresh_filelist {
1715 my ($self, $req, $article) = @_;
1716
1717 return $self->refresh($article, $req->cgi, undef, undef, '&filelist=1');
1718}
1719
1720sub filelist {
1721 my ($self, $req, $article, $articles, $msg) = @_;
1722
1723 my %acts;
1724 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg);
1725 my $template = 'admin/filelist';
1726
1727 return BSE::Template->get_response($template, $req->cfg, \%acts);
1728}
1729
1730sub fileadd {
1731 my ($self, $req, $article, $articles) = @_;
1732
1733 my %file;
1734 my $cgi = $req->cgi;
1735 require ArticleFile;
1736 my @cols = ArticleFile->columns;
1737 shift @cols;
1738 for my $col (@cols) {
1739 if (defined $cgi->param($col)) {
1740 $file{$col} = $cgi->param($col);
1741 }
1742 }
1743
1744 $file{forSale} = 0 + exists $file{forSale};
1745 $file{articleId} = $article->{id};
1746 $file{download} = 0 + exists $file{download};
1747 $file{requireUser} = 0 + exists $file{requireUser};
1748
1749 my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
1750
1751 # build a filename
1752 my $file = $cgi->param('file');
1753 unless ($file) {
1754 return $self->filelist($req, $article, $articles,
1755 "Enter or select the name of a file on your machine");
1756 }
1757 if (-z $file) {
1758 return $self->filelist($req, $article, $articles,
1759 message=>"File is empty");
1760 }
1761
1762 unless ($file{contentType}) {
1763 unless ($file =~ /\.([^.]+)$/) {
1764 $file{contentType} = "application/octet-stream";
1765 }
1766 unless ($file{contentType}) {
1767 my $ext = lc $1;
1768 my $type = $types{$ext};
1769 unless ($type) {
1770 $type = $self->{cfg}->entry('extensions', $ext)
1771 || $self->{cfg}->entry('extensions', ".$ext")
1772 || "application/octet-stream";
1773 }
1774 $file{contentType} = $type;
1775 }
1776 }
1777
1778 my $basename = '';
1779 $file =~ /([\w.-]+)$/ and $basename = $1;
1780
1781 my $filename = time. '_'. $basename;
1782
1783 # for the sysopen() constants
1784 use Fcntl;
1785
1786 # loop until we have a unique filename
1787 my $counter="";
1788 $filename = time. '_' . $counter . '_' . $basename
1789 until sysopen( OUTPUT, "$downloadPath/$filename",
1790 O_WRONLY| O_CREAT| O_EXCL)
1791 || ++$counter > 100;
1792
1793 fileno(OUTPUT) or die "Could not open file: $!";
1794
1795 # for OSs with special text line endings
1796 binmode OUTPUT;
1797
1798 my $buffer;
1799
1800 no strict 'refs';
1801
1802 # read the image in from the browser and output it to our output filehandle
1803 print OUTPUT $buffer while read $file, $buffer, 8192;
1804
1805 # close and flush
1806 close OUTPUT
1807 or die "Could not close file $filename: $!";
1808
1809 use BSE::Util::SQL qw/now_datetime/;
1810 $file{filename} = $filename;
1811 $file{displayName} = $basename;
1812 $file{sizeInBytes} = -s $file;
1813 $file{displayOrder} = time;
1814 $file{whenUploaded} = now_datetime();
1815
1816 require ArticleFiles;
1817 my $fileobj = ArticleFiles->add(@file{@cols});
1818
1819 $self->_refresh_filelist($req, $article);
1820}
1821
1822sub fileswap {
1823 my ($self, $req, $article, $articles) = @_;
1824
1825 my $cgi = $req->cgi;
1826 my $id1 = $cgi->param('file1');
1827 my $id2 = $cgi->param('file2');
1828
1829 if ($id1 && $id2) {
1830 my @files = $article->files;
1831
1832 my ($file1) = grep $_->{id} == $id1, @files;
1833 my ($file2) = grep $_->{id} == $id2, @files;
1834
1835 if ($file1 && $file2) {
1836 ($file1->{displayOrder}, $file2->{displayOrder})
1837 = ($file2->{displayOrder}, $file1->{displayOrder});
1838 $file1->save;
1839 $file2->save;
1840 }
1841 }
1842
1843 $self->_refresh_filelist($req, $article);
1844}
1845
1846sub filedel {
1847 my ($self, $req, $article, $articles) = @_;
1848
1849 my $cgi = $req->cgi;
1850 my $fileid = $cgi->param('file');
1851 if ($fileid) {
1852 my @files = $article->files;
1853
1854 my ($file) = grep $_->{id} == $fileid, @files;
1855
1856 if ($file) {
1857 my $downloadPath = $req->cfg->entryErr('paths', 'downloads');
1858 my $filename = $downloadPath . "/" . $file->{filename};
1859 my $debug_del = $req->cfg->entryBool('debug', 'file_unlink', 0);
1860 if ($debug_del) {
1861 unlink $filename
1862 or print STDERR "Error deleting $filename: $!\n";
1863 }
1864 else {
1865 unlink $filename;
1866 }
1867 $file->remove();
1868 }
1869 }
1870
1871 $self->_refresh_filelist($req, $article);
1872}
1873
1874sub filesave {
1875 my ($self, $req, $article) = @_;
1876
1877 my @files = $article->files;
1878
1879 my $cgi = $req->cgi;
1880 for my $file (@files) {
1881 if (defined $cgi->param("description_$file->{id}")) {
1882 $file->{description} = $cgi->param("description_$file->{id}");
1883 if (my $type = $cgi->param("contentType_$file->{id}")) {
1884 $file->{contentType} = $type;
1885 }
1886 $file->{download} = 0 + defined $cgi->param("download_$file->{id}");
1887 $file->{forSale} = 0 + defined $cgi->param("forSale_$file->{id}");
1888 $file->{requireUser} = 0 + defined $cgi->param("requireUser_$file->{id}");
1889 $file->save;
1890 }
1891 }
1892
1893 $self->_refresh_filelist($req, $article);
1894}
1895
6473c56f
TC
1896sub can_remove {
1897 my ($self, $req, $article, $articles, $rmsg) = @_;
1898
1899 if ($articles->children($article->{id})) {
1900 $$rmsg = "This article has children. You must delete the children first (or change their parents)";
1901 return;
1902 }
1903 if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
1904 $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
1905 return;
1906 }
1907 if ($article->{id} == $Constants::SHOPID) {
1908 $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the the store instead.";
1909 return;
1910 }
1911
1912 return 1;
1913}
1914
1915sub remove {
1916 my ($self, $req, $article, $articles) = @_;
1917
1918 my $why_not;
1919 unless ($self->can_remove($req, $article, $articles, \$why_not)) {
1920 return $self->edit_form($req, $article, $articles, $why_not);
1921 }
1922
1923 require Images;
1924 my @images = Images->getBy(articleId=>$article->{id});
1925 my $imagedir = $self->{cfg}->entry('paths', 'images', $Constants::IMAGEDIR);
1926 for my $image (@images) {
1927 unlink("$imagedir/$image->{image}");
1928 $image->remove();
1929 }
1930
1931 # remove any step(child|parent) links
1932 require OtherParents;
1933 my @steprels = OtherParents->anylinks($article->{id});
1934 for my $link (@steprels) {
1935 $link->remove();
1936 }
1937
1938 my $parentid = $article->{parentid};
1939 $article->remove;
1940 my $urlbase = $self->{cfg}->entryVar('site', 'url');
1941 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$parentid";
1942 $url .= "&message=Article+deleted";
1943 return BSE::Template->get_refresh($url, $self->{cfg});
1944}
1945
ca9aa2bf
TC
19461;
1947
1948=head1 NAME
1949
1950 BSE::Edit::Article - editing functionality for BSE articles
1951
1952=head1 AUTHOR
1953
1954Tony Cook <tony@develop-help.com>
1955
1956=head1 REVISION
1957
1958$Revision$
1959
1960=cut