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