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