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