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