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