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