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