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