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