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