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