no longer used
[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
195977cd 1010 my $geometry = $cfg->entry('thumb geometries', $args, '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 }
1297
1298}
1299
1300sub validate {
918735d1 1301 my ($self, $data, $articles, $errors) = @_;
ca9aa2bf
TC
1302
1303 $self->_validate_common($data, $articles, $errors);
331fd099
TC
1304 custom_class($self->{cfg})
1305 ->article_validate($data, undef, $self->typename, $errors);
ca9aa2bf
TC
1306
1307 return !keys %$errors;
1308}
1309
1310sub validate_old {
918735d1 1311 my ($self, $article, $data, $articles, $errors) = @_;
ca9aa2bf 1312
b553afa2 1313 $self->_validate_common($data, $articles, $errors, $article);
331fd099
TC
1314 custom_class($self->{cfg})
1315 ->article_validate($data, $article, $self->typename, $errors);
ca9aa2bf 1316
b553afa2
TC
1317 if (exists $data->{release} && !valid_date($data->{release})) {
1318 $errors->{release} = "Invalid release date";
1319 }
1320
ca9aa2bf
TC
1321 return !keys %$errors;
1322}
1323
1324sub validate_parent {
1325 1;
1326}
1327
1328sub fill_new_data {
1329 my ($self, $req, $data, $articles) = @_;
1330
331fd099
TC
1331 custom_class($self->{cfg})
1332 ->article_fill_new($data, $self->typename);
1333
ca9aa2bf
TC
1334 1;
1335}
1336
95989433
TC
1337sub link_path {
1338 my ($self, $article) = @_;
1339
1340 # check the config for the article and any of its ancestors
1341 my $work_article = $article;
1342 my $path = $self->{cfg}->entry('article uris', $work_article->{id});
1343 while (!$path) {
1344 last if $work_article->{parentid} == -1;
1345 $work_article = $work_article->parent;
1346 $path = $self->{cfg}->entry('article uris', $work_article->{id});
1347 }
1348 return $path if $path;
1349
1350 $self->default_link_path($article);
1351}
1352
1353sub default_link_path {
1354 my ($self, $article) = @_;
1355
1356 $self->{cfg}->entry('uri', 'articles', '/a');
1357}
1358
ca9aa2bf
TC
1359sub make_link {
1360 my ($self, $article) = @_;
1361
efcc5a30 1362 if ($article->is_dynamic) {
b873a8fa 1363 return "/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($article->{title});
efcc5a30
TC
1364 }
1365
95989433 1366 my $article_uri = $self->link_path($article);
ca9aa2bf
TC
1367 my $link = "$article_uri/$article->{id}.html";
1368 my $link_titles = $self->{cfg}->entryBool('basic', 'link_titles', 0);
1369 if ($link_titles) {
1370 (my $extra = lc $article->{title}) =~ tr/a-z0-9/_/sc;
d7538448 1371 $link .= "/" . $extra . "_html";
ca9aa2bf
TC
1372 }
1373
1374 $link;
1375}
1376
1377sub save_new {
1378 my ($self, $req, $articles) = @_;
1379
1380 my $cgi = $req->cgi;
1381 my %data;
1382 my $table_object = $self->table_object($articles);
1383 my @columns = $table_object->rowClass->columns;
1384 $self->save_thumbnail($cgi, undef, \%data);
1385 for my $name (@columns) {
9168c88c
TC
1386 $data{$name} = $cgi->param($name)
1387 if defined $cgi->param($name);
ca9aa2bf 1388 }
918735d1 1389 $data{flags} = join '', sort $cgi->param('flags');
ca9aa2bf
TC
1390
1391 my $msg;
1392 my %errors;
718a070d
TC
1393 if (!defined $data{parentid} || $data{parentid} eq '') {
1394 $errors{parentid} = "Please select a parent";
1395 }
1396 elsif ($data{parentid} !~ /^(?:-1|\d+)$/) {
1397 $errors{parentid} = "Invalid parent selection (template bug)";
1398 }
918735d1 1399 $self->validate(\%data, $articles, \%errors)
ca9aa2bf
TC
1400 or return $self->add_form($req, $articles, $msg, \%errors);
1401
1402 my $parent;
1403 if ($data{parentid} > 0) {
1404 $parent = $articles->getByPkey($data{parentid}) or die;
9168c88c
TC
1405 $req->user_can('edit_add_child', $parent)
1406 or return $self->add_form($req, $articles,
1407 "You cannot add a child to that article");
1408 for my $name (@columns) {
1409 if (exists $data{$name} &&
1410 !$req->user_can("edit_add_field_$name", $parent)) {
1411 delete $data{$name};
1412 }
1413 }
ca9aa2bf 1414 }
9168c88c
TC
1415 else {
1416 $req->user_can('edit_add_child')
1417 or return $self->add_form($req, $articles,
1418 "You cannot create a top-level article");
1419 for my $name (@columns) {
1420 if (exists $data{$name} &&
1421 !$req->user_can("edit_add_field_$name")) {
1422 delete $data{$name};
1423 }
1424 }
1425 }
1426
ca9aa2bf
TC
1427 $self->validate_parent(\%data, $articles, $parent, \$msg)
1428 or return $self->add_form($req, $articles, $msg);
1429
ca9aa2bf 1430 my $level = $parent ? $parent->{level}+1 : 1;
0ec4ac8a 1431 $data{level} = $level;
9168c88c 1432 $data{displayOrder} = time;
ca9aa2bf
TC
1433 $data{link} ||= '';
1434 $data{admin} ||= '';
ca9aa2bf 1435 $data{generator} = $self->generator;
41f10371 1436 $data{lastModified} = now_sqldatetime();
ca9aa2bf
TC
1437 $data{listed} = 1 unless defined $data{listed};
1438
9604a90c
TC
1439# Added by adrian
1440 $data{pageTitle} = '' unless defined $data{pageTitle};
1441 my $user = $req->getuser;
1442 $data{createdBy} = $user ? $user->{logon} : '';
1443 $data{lastModifiedBy} = $user ? $user->{logon} : '';
1444 $data{created} = now_sqldatetime();
12bcb7ac
TC
1445# end adrian
1446
efcc5a30
TC
1447 $data{force_dynamic} = 0;
1448 $data{cached_dynamic} = 0;
1449 $data{inherit_siteuser_rights} = 1;
9604a90c 1450
12bcb7ac
TC
1451# Added by adrian
1452 $data{metaDescription} = '' unless defined $data{metaDescription};
1453 $data{metaKeywords} = '' unless defined $data{metaKeywords};
1454# end adrian
1455
0ec4ac8a 1456 $self->fill_new_data($req, \%data, $articles);
5d2dd1b4 1457 for my $col (qw(titleImage imagePos template keyword menu titleAlias)) {
0ec4ac8a
TC
1458 defined $data{$col}
1459 or $data{$col} = $self->default_value($req, \%data, $col);
1460 }
1461
c2096d67
TC
1462 for my $col (qw/force_dynamic inherit_siteuser_rights/) {
1463 if ($req->user_can("edit_add_field_$col", $parent)
1464 && $cgi->param("save_$col")) {
1465 $data{$col} = $cgi->param($col) ? 1 : 0;
1466 }
1467 else {
1468 $data{$col} = $self->default_value($req, \%data, $col);
1469 }
1470 }
1471
718a070d
TC
1472 for my $col (qw(release expire)) {
1473 $data{$col} = sql_date($data{$col});
1474 }
1475
0ec4ac8a 1476 # these columns are handled a little differently
d7538448 1477 for my $col (qw(release expire threshold summaryLength )) {
0ec4ac8a
TC
1478 $data{$col}
1479 or $data{$col} = $self->default_value($req, \%data, $col);
1480 }
1481
ca9aa2bf
TC
1482 shift @columns;
1483 my $article = $table_object->add(@data{@columns});
1484
1485 # we now have an id - generate the links
1486
a319d280 1487 $article->update_dynamic($self->{cfg});
ca9aa2bf
TC
1488 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
1489 $article->setAdmin("$cgi_uri/admin/admin.pl?id=$article->{id}");
1490 $article->setLink($self->make_link($article));
1491 $article->save();
1492
caa7299c
TC
1493 use Util 'generate_article';
1494 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1495
8b0b2f34
TC
1496 my $r = $cgi->param('r');
1497 if ($r) {
1498 $r .= ($r =~ /\?/) ? '&' : '?';
1499 $r .= "id=$article->{id}";
1500 }
1501 else {
41f10371
TC
1502
1503 $r = admin_base_url($req->cfg) . $article->{admin};
8b0b2f34
TC
1504 }
1505 return BSE::Template->get_refresh($r, $self->{cfg});
1506
ca9aa2bf
TC
1507}
1508
1509sub fill_old_data {
0d5ccc7f 1510 my ($self, $req, $article, $data) = @_;
ca9aa2bf 1511
4010d92e
TC
1512 if (exists $data->{body}) {
1513 $data->{body} =~ s/\x0D\x0A/\n/g;
1514 $data->{body} =~ tr/\r/\n/;
1515 }
ca9aa2bf 1516 for my $col (Article->columns) {
331fd099 1517 next if $col =~ /^custom/;
ca9aa2bf
TC
1518 $article->{$col} = $data->{$col}
1519 if exists $data->{$col} && $col ne 'id' && $col ne 'parentid';
1520 }
331fd099
TC
1521 custom_class($self->{cfg})
1522 ->article_fill_old($article, $data, $self->typename);
ca9aa2bf
TC
1523
1524 return 1;
1525}
1526
1527sub save {
1528 my ($self, $req, $article, $articles) = @_;
4010d92e
TC
1529
1530 $req->user_can(edit_save => $article)
1531 or return $self->edit_form($req, $article, $articles,
1532 "You don't have access to save this article");
efcc5a30
TC
1533
1534 my $old_dynamic = $article->is_dynamic;
ca9aa2bf
TC
1535 my $cgi = $req->cgi;
1536 my %data;
1537 for my $name ($article->columns) {
1538 $data{$name} = $cgi->param($name)
abf5bbc6
TC
1539 if defined($cgi->param($name)) and $name ne 'id' && $name ne 'parentid'
1540 && $req->user_can("edit_field_edit_$name", $article);
ca9aa2bf 1541 }
12b42a0b
TC
1542
1543# Added by adrian
1544# checks editor lastModified against record lastModified
1545 if ($self->{cfg}->entry('editor', 'check_modified')) {
1546 if ($article->{lastModified} ne $cgi->param('lastModified')) {
1547 my $whoModified = '';
1548 my $timeModified = ampm_time($article->{lastModified});
1549 if ($article->{lastModifiedBy}) {
1550 $whoModified = "by '$article->{lastModifiedBy}'";
1551 }
1552 print STDERR "non-matching lastModified, article not saved\n";
1553 my $msg = "Article changes not saved, this article was modified $whoModified at $timeModified since this editor was loaded";
1554 return $self->edit_form($req, $article, $articles, $msg);
1555 }
1556 }
1557# end adrian
1558
918735d1
TC
1559 # possibly this needs tighter error checking
1560 $data{flags} = join '', sort $cgi->param('flags')
1561 if $req->user_can("edit_field_edit_flags", $article);
ca9aa2bf
TC
1562 my %errors;
1563 $self->validate_old($article, \%data, $articles, \%errors)
1564 or return $self->edit_form($req, $article, $articles, undef, \%errors);
abf5bbc6
TC
1565 $self->save_thumbnail($cgi, $article, \%data)
1566 if $req->user_can('edit_field_edit_thumbImage', $article);
ca9aa2bf
TC
1567 $self->fill_old_data($req, $article, \%data);
1568 if (exists $article->{template} &&
1569 $article->{template} =~ m|\.\.|) {
1570 my $msg = "Please only select templates from the list provided";
1571 return $self->edit_form($req, $article, $articles, $msg);
1572 }
12b42a0b 1573
ca9aa2bf
TC
1574 # reparenting
1575 my $newparentid = $cgi->param('parentid');
abf5bbc6
TC
1576 if ($newparentid && $req->user_can('edit_field_edit_parentid', $article)) {
1577 if ($newparentid == $article->{parentid}) {
1578 # nothing to do
1579 }
1580 elsif ($newparentid != -1) {
1581 print STDERR "Reparenting...\n";
1582 my $newparent = $articles->getByPkey($newparentid);
1583 if ($newparent) {
1584 if ($newparent->{level} != $article->{level}-1) {
1585 # the article cannot become a child of itself or one of it's
1586 # children
1587 if ($article->{id} == $newparentid
1588 || $self->is_descendant($article->{id}, $newparentid, $articles)) {
1589 my $msg = "Cannot become a child of itself or of a descendant";
1590 return $self->edit_form($req, $article, $articles, $msg);
1591 }
1592 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1593 if ($self->is_descendant($article->{id}, $shopid, $articles)) {
1594 my $msg = "Cannot become a descendant of the shop";
1595 return $self->edit_form($req, $article, $articles, $msg);
1596 }
1597 my $msg;
1598 $self->reparent($article, $newparentid, $articles, \$msg)
1599 or return $self->edit_form($req, $article, $articles, $msg);
ca9aa2bf 1600 }
abf5bbc6
TC
1601 else {
1602 # stays at the same level, nothing special
1603 $article->{parentid} = $newparentid;
ca9aa2bf 1604 }
ca9aa2bf 1605 }
abf5bbc6
TC
1606 # else ignore it
1607 }
1608 else {
1609 # becoming a section
1610 my $msg;
1611 $self->reparent($article, -1, $articles, \$msg)
1612 or return $self->edit_form($req, $article, $articles, $msg);
ca9aa2bf 1613 }
ca9aa2bf
TC
1614 }
1615
abf5bbc6 1616 $article->{listed} = $cgi->param('listed')
63e99d77 1617 if defined $cgi->param('listed') &&
abf5bbc6
TC
1618 $req->user_can('edit_field_edit_listed', $article);
1619 $article->{release} = sql_date($cgi->param('release'))
1620 if defined $cgi->param('release') &&
1621 $req->user_can('edit_field_edit_release', $article);
1622
1623 $article->{expire} = sql_date($cgi->param('expire')) || $Constants::D_99
1624 if defined $cgi->param('expire') &&
1625 $req->user_can('edit_field_edit_expire', $article);
41f10371 1626 $article->{lastModified} = now_sqldatetime();
c2096d67
TC
1627 for my $col (qw/force_dynamic inherit_siteuser_rights/) {
1628 if ($req->user_can("edit_field_edit_$col", $article)
1629 && $cgi->param("save_$col")) {
1630 $article->{$col} = $cgi->param($col) ? 1 : 0;
1631 }
1632 }
1633
1634# Added by adrian
1635 my $user = $req->getuser;
1636 $article->{lastModifiedBy} = $user ? $user->{logon} : '';
1637# end adrian
1638
1639 my @save_group_ids = $cgi->param('save_group_id');
1640 if ($req->user_can('edit_field_edit_group_id')
1641 && @save_group_ids) {
1642 require BSE::TB::SiteUserGroups;
1643 my %groups = map { $_->{id} => $_ }
1644 BSE::TB::SiteUserGroups->admin_and_query_groups($self->{cfg});
1645 my %set = map { $_ => 1 } $cgi->param('group_id');
1646 my %current = map { $_ => 1 } $article->group_ids;
1647
1648 for my $group_id (@save_group_ids) {
1649 $groups{$group_id} or next;
1650 if ($current{$group_id} && !$set{$group_id}) {
1651 $article->remove_group_id($group_id);
1652 }
1653 elsif (!$current{$group_id} && $set{$group_id}) {
1654 $article->add_group_id($group_id);
1655 }
1656 }
efcc5a30
TC
1657 }
1658
63e99d77 1659 my $old_link = $article->{link};
efcc5a30
TC
1660 # this need to go last
1661 $article->update_dynamic($self->{cfg});
95989433
TC
1662 if ($article->{link} &&
1663 !$self->{cfg}->entry('protect link', $article->{id})) {
1664 my $article_uri = $self->make_link($article);
95989433 1665 $article->setLink($article_uri);
ca9aa2bf
TC
1666 }
1667
1668 $article->save();
caa7299c 1669
63e99d77 1670 # fix the kids too
efcc5a30 1671 my @extra_regen;
63e99d77
TC
1672 @extra_regen = $self->update_child_dynamic($article, $articles, $req);
1673
1674 if ($article->is_dynamic || $old_dynamic) {
1675 if (!$old_dynamic and $old_link) {
1676 unlink $article->link_to_filename($self->{cfg}, $old_link);
1677 }
16901a2a
TC
1678 elsif (!$article->is_dynamic) {
1679 unlink $article->cached_filename($self->{cfg});
1680 }
efcc5a30
TC
1681 }
1682
caa7299c 1683 use Util 'generate_article';
efcc5a30
TC
1684 if ($Constants::AUTO_GENERATE) {
1685 generate_article($articles, $article);
1686 for my $regen_id (@extra_regen) {
1687 my $regen = $articles->getByPkey($regen_id);
63e99d77 1688 Util::generate_low($articles, $regen, $self->{cfg});
efcc5a30
TC
1689 }
1690 }
caa7299c 1691
8b0b2f34 1692 return $self->refresh($article, $cgi, undef, 'Article saved');
ca9aa2bf
TC
1693}
1694
efcc5a30
TC
1695sub update_child_dynamic {
1696 my ($self, $article, $articles, $req) = @_;
1697
1698 my $cfg = $req->cfg;
1699 my @stack = $article->children;
1700 my @regen;
1701 while (@stack) {
1702 my $workart = pop @stack;
1703 my $old_dynamic = $workart->is_dynamic; # before update
63e99d77 1704 my $old_link = $workart->{link};
3e37b5ba
TC
1705 my $editor;
1706 ($editor, $workart) = $self->article_class($workart, $articles, $cfg);
1707
efcc5a30
TC
1708 $workart->update_dynamic($cfg);
1709 if ($old_dynamic != $workart->is_dynamic) {
1710 # update the link
1711 if ($article->{link} && !$cfg->entry('protect link', $workart->{id})) {
efcc5a30
TC
1712 my $uri = $editor->make_link($workart);
1713 $workart->setLink($uri);
63e99d77 1714
8f84f3f1
TC
1715 !$old_dynamic && $old_link
1716 and unlink $workart->link_to_filename($cfg, $old_link);
1717 $workart->is_dynamic
16901a2a 1718 or unlink $workart->cached_filename($cfg);
efcc5a30
TC
1719 }
1720
1721 # save dynamic cache change and link if that changed
1722 $workart->save;
1723 }
1724 push @stack, $workart->children;
1725 push @regen, $workart->{id};
1726 }
1727
1728 @regen;
1729}
1730
ca9aa2bf
TC
1731sub sql_date {
1732 my $str = shift;
1733 my ($year, $month, $day);
1734
1735 # look for a date
1736 if (($day, $month, $year) = ($str =~ m!(\d+)/(\d+)/(\d+)!)) {
1737 $year += 2000 if $year < 100;
1738
1739 return sprintf("%04d-%02d-%02d", $year, $month, $day);
1740 }
1741 return undef;
1742}
1743
12b42a0b
TC
1744# Added by adrian
1745# Converts 24hr time to 12hr AM/PM time
1746sub ampm_time {
1747 my $str = shift;
1748 my ($hour, $minute, $second, $ampm);
1749
1750 # look for a time
1751 if (($hour, $minute, $second) = ($str =~ m!(\d+):(\d+):(\d+)!)) {
1752 if ($hour > 12) {
1753 $hour -= 12;
1754 $ampm = 'PM';
1755 }
1756 else {
c2096d67 1757 $hour = 12 if $hour == 0;
12b42a0b
TC
1758 $ampm = 'AM';
1759 }
1760 return sprintf("%02d:%02d:%02d $ampm", $hour, $minute, $second);
1761 }
1762 return undef;
1763}
1764# end adrian
1765
ca9aa2bf
TC
1766sub reparent {
1767 my ($self, $article, $newparentid, $articles, $rmsg) = @_;
1768
1769 my $newlevel;
1770 if ($newparentid == -1) {
1771 $newlevel = 1;
1772 }
1773 else {
1774 my $parent = $articles->getByPkey($newparentid);
1775 unless ($parent) {
1776 $$rmsg = "Cannot get new parent article";
1777 return;
1778 }
1779 $newlevel = $parent->{level} + 1;
1780 }
1781 # the caller will save this one
1782 $article->{parentid} = $newparentid;
1783 $article->{level} = $newlevel;
1784 $article->{displayOrder} = time;
1785
1786 my @change = ( [ $article->{id}, $newlevel ] );
1787 while (@change) {
1788 my $this = shift @change;
1789 my ($art, $level) = @$this;
1790
1791 my @kids = $articles->getBy(parentid=>$art);
1792 push @change, map { [ $_->{id}, $level+1 ] } @kids;
1793
1794 for my $kid (@kids) {
1795 $kid->{level} = $level+1;
1796 $kid->save;
1797 }
1798 }
1799
1800 return 1;
1801}
1802
1803# tests if $desc is a descendant of $art
1804# where both are article ids
1805sub is_descendant {
1806 my ($self, $art, $desc, $articles) = @_;
1807
1808 my @check = ($art);
1809 while (@check) {
1810 my $parent = shift @check;
1811 $parent == $desc and return 1;
1812 my @kids = $articles->getBy(parentid=>$parent);
1813 push @check, map $_->{id}, @kids;
1814 }
1815
1816 return 0;
1817}
1818
1819sub save_thumbnail {
1820 my ($self, $cgi, $original, $newdata) = @_;
1821
1822 unless ($original) {
1823 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1824 }
ab2cd916 1825 my $imagedir = cfg_image_dir($self->{cfg});
ca9aa2bf
TC
1826 if ($cgi->param('remove_thumb') && $original && $original->{thumbImage}) {
1827 unlink("$imagedir/$original->{thumbImage}");
1828 @$newdata{qw/thumbImage thumbWidth thumbHeight/} = ('', 0, 0);
1829 }
1830 my $image = $cgi->param('thumbnail');
1831 if ($image && -s $image) {
1832 # where to put it...
1833 my $name = '';
1834 $image =~ /([\w.-]+)$/ and $name = $1;
1835 my $filename = time . "_" . $name;
1836
1837 use Fcntl;
1838 my $counter = "";
1839 $filename = time . '_' . $counter . '_' . $name
1840 until sysopen( OUTPUT, "$imagedir/$filename",
1841 O_WRONLY| O_CREAT| O_EXCL)
1842 || ++$counter > 100;
1843
1844 fileno(OUTPUT) or die "Could not open image file: $!";
1845 binmode OUTPUT;
1846 my $buffer;
1847
1848 #no strict 'refs';
1849
1850 # read the image in from the browser and output it to our
1851 # output filehandle
1852 print STDERR "\$image ",ref $image,"\n";
1853 seek $image, 0, 0;
1854 print OUTPUT $buffer while sysread $image, $buffer, 1024;
1855
1856 close OUTPUT
1857 or die "Could not close image output file: $!";
1858
1859 use Image::Size;
1860
1861 if ($original && $original->{thumbImage}) {
1862 #unlink("$imagedir/$original->{thumbImage}");
1863 }
1864 @$newdata{qw/thumbWidth thumbHeight/} = imgsize("$imagedir/$filename");
1865 $newdata->{thumbImage} = $filename;
1866 }
1867}
1868
1869sub child_types {
1870 my ($self, $article) = @_;
1871
1872 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
1873 if ($article && $article->{id} && $article->{id} == $shopid) {
1874 return ( 'BSE::Edit::Catalog' );
1875 }
1876 return ( 'BSE::Edit::Article' );
1877}
1878
1879sub add_stepkid {
1880 my ($self, $req, $article, $articles) = @_;
1881
31a26b52
TC
1882 $req->user_can(edit_stepkid_add => $article)
1883 or return $self->edit_form($req, $article, $articles,
1884 "You don't have access to add step children to this article");
1885
ca9aa2bf
TC
1886 my $cgi = $req->cgi;
1887 require 'BSE/Admin/StepParents.pm';
1888 eval {
1889 my $childId = $cgi->param('stepkid');
1890 defined $childId
1891 or die "No stepkid supplied to add_stepkid";
1892 $childId =~ /^\d+$/
1893 or die "Invalid stepkid supplied to add_stepkid";
1894 my $child = $articles->getByPkey($childId)
1895 or die "Article $childId not found";
31a26b52
TC
1896
1897 $req->user_can(edit_stepparent_add => $child)
1898 or die "You don't have access to add a stepparent to that article\n";
ca9aa2bf
TC
1899
1900 use BSE::Util::Valid qw/valid_date/;
1901 my $release = $cgi->param('release');
1902 valid_date($release) or $release = undef;
1903 my $expire = $cgi->param('expire');
1904 valid_date($expire) or $expire = undef;
1905
1906 my $newentry =
1907 BSE::Admin::StepParents->add($article, $child, $release, $expire);
1908 };
1909 if ($@) {
1910 return $self->edit_form($req, $article, $articles, $@);
1911 }
a0a8147b
TC
1912
1913 use Util 'generate_article';
1914 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1915
8b0b2f34 1916 return $self->refresh($article, $cgi, 'step', 'Stepchild added');
ca9aa2bf
TC
1917}
1918
1919sub del_stepkid {
1920 my ($self, $req, $article, $articles) = @_;
1921
31a26b52
TC
1922 $req->user_can(edit_stepkid_delete => $article)
1923 or return $self->edit_form($req, $article, $articles,
1924 "You don't have access to delete stepchildren from this article");
1925
ca9aa2bf
TC
1926 my $cgi = $req->cgi;
1927 require 'BSE/Admin/StepParents.pm';
1928 eval {
1929 my $childId = $cgi->param('stepkid');
1930 defined $childId
1931 or die "No stepkid supplied to add_stepkid";
1932 $childId =~ /^\d+$/
1933 or die "Invalid stepkid supplied to add_stepkid";
1934 my $child = $articles->getByPkey($childId)
1935 or die "Article $childId not found";
31a26b52
TC
1936
1937 $req->user_can(edit_stepparent_delete => $child)
1938 or die "You cannot remove stepparents from that article\n";
ca9aa2bf
TC
1939
1940 BSE::Admin::StepParents->del($article, $child);
1941 };
1942
1943 if ($@) {
1944 return $self->edit_form($req, $article, $articles, $@);
1945 }
a0a8147b
TC
1946 use Util 'generate_article';
1947 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1948
8b0b2f34 1949 return $self->refresh($article, $cgi, 'step', 'Stepchild deleted');
ca9aa2bf
TC
1950}
1951
1952sub save_stepkids {
1953 my ($self, $req, $article, $articles) = @_;
1954
31a26b52
TC
1955 $req->user_can(edit_stepkid_save => $article)
1956 or return $self->edit_form($req, $article, $articles,
1957 "No access to save stepkid data for this article");
1958
ca9aa2bf
TC
1959 my $cgi = $req->cgi;
1960 require 'BSE/Admin/StepParents.pm';
1961 my @stepcats = OtherParents->getBy(parentId=>$article->{id});
1962 my %stepcats = map { $_->{parentId}, $_ } @stepcats;
1963 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
1964 for my $stepcat (@stepcats) {
31a26b52
TC
1965 $req->user_can(edit_stepparent_save => $stepcat->{childId})
1966 or next;
ca9aa2bf
TC
1967 for my $name (qw/release expire/) {
1968 my $date = $cgi->param($name.'_'.$stepcat->{childId});
1969 if (defined $date) {
1970 if ($date eq '') {
1971 $date = $datedefs{$name};
1972 }
1973 elsif (valid_date($date)) {
1974 use BSE::Util::SQL qw/date_to_sql/;
1975 $date = date_to_sql($date);
1976 }
1977 else {
1978 return $self->refresh($article, $cgi, '', "Invalid date '$date'");
1979 }
1980 $stepcat->{$name} = $date;
1981 }
1982 }
1983 eval {
1984 $stepcat->save();
1985 };
1986 $@ and return $self->refresh($article, $cgi, '', $@);
1987 }
a0a8147b
TC
1988 use Util 'generate_article';
1989 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
1990
8b0b2f34 1991 return $self->refresh($article, $cgi, 'step', 'Stepchild information saved');
ca9aa2bf
TC
1992}
1993
1994sub add_stepparent {
1995 my ($self, $req, $article, $articles) = @_;
1996
31a26b52
TC
1997 $req->user_can(edit_stepparent_add => $article)
1998 or return $self->edit_form($req, $article, $articles,
1999 "You don't have access to add stepparents to this article");
2000
ca9aa2bf
TC
2001 my $cgi = $req->cgi;
2002 require 'BSE/Admin/StepParents.pm';
2003 eval {
2004 my $step_parent_id = $cgi->param('stepparent');
2005 defined($step_parent_id)
2006 or die "No stepparent supplied to add_stepparent";
2007 int($step_parent_id) eq $step_parent_id
2008 or die "Invalid stepcat supplied to add_stepcat";
2009 my $step_parent = $articles->getByPkey($step_parent_id)
31a26b52
TC
2010 or die "Parent $step_parent_id not found\n";
2011
2012 $req->user_can(edit_stepkid_add => $step_parent)
2013 or die "You don't have access to add a stepkid to that article\n";
ca9aa2bf
TC
2014
2015 my $release = $cgi->param('release');
2016 defined $release
2017 or $release = "01/01/2000";
2018 use BSE::Util::Valid qw/valid_date/;
2019 $release eq '' or valid_date($release)
2020 or die "Invalid release date";
2021 my $expire = $cgi->param('expire');
2022 defined $expire
2023 or $expire = '31/12/2999';
2024 $expire eq '' or valid_date($expire)
2025 or die "Invalid expire data";
2026
2027 my $newentry =
2028 BSE::Admin::StepParents->add($step_parent, $article, $release, $expire);
2029 };
2030 $@ and return $self->refresh($article, $cgi, 'step', $@);
2031
a0a8147b
TC
2032 use Util 'generate_article';
2033 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2034
8b0b2f34 2035 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent added');
ca9aa2bf
TC
2036}
2037
2038sub del_stepparent {
2039 my ($self, $req, $article, $articles) = @_;
2040
31a26b52
TC
2041 $req->user_can(edit_stepparent_delete => $article)
2042 or return $self->edit_form($req, $article, $articles,
2043 "You cannot remove stepparents from that article");
2044
ca9aa2bf
TC
2045 my $cgi = $req->cgi;
2046 require 'BSE/Admin/StepParents.pm';
2047 my $step_parent_id = $cgi->param('stepparent');
2048 defined($step_parent_id)
2049 or return $self->refresh($article, $cgi, 'stepparents',
2050 "No stepparent supplied to add_stepcat");
2051 int($step_parent_id) eq $step_parent_id
2052 or return $self->refresh($article, $cgi, 'stepparents',
2053 "Invalid stepparent supplied to add_stepparent");
2054 my $step_parent = $articles->getByPkey($step_parent_id)
2055 or return $self->refresh($article, $cgi, 'stepparent',
2056 "Stepparent $step_parent_id not found");
2057
31a26b52
TC
2058 $req->user_can(edit_stepkid_delete => $step_parent)
2059 or die "You don't have access to remove the stepkid from that article\n";
2060
ca9aa2bf
TC
2061 eval {
2062 BSE::Admin::StepParents->del($step_parent, $article);
2063 };
2064 $@ and return $self->refresh($article, $cgi, 'stepparents', $@);
2065
a0a8147b
TC
2066 use Util 'generate_article';
2067 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2068
8b0b2f34 2069 return $self->refresh($article, $cgi, 'stepparents', 'Stepparent deleted');
ca9aa2bf
TC
2070}
2071
2072sub save_stepparents {
2073 my ($self, $req, $article, $articles) = @_;
2074
31a26b52
TC
2075 $req->user_can(edit_stepparent_save => $article)
2076 or return $self->edit_form($req, $article, $articles,
2077 "No access to save stepparent data for this artice");
2078
ca9aa2bf
TC
2079 my $cgi = $req->cgi;
2080
2081 require 'BSE/Admin/StepParents.pm';
2082 my @stepparents = OtherParents->getBy(childId=>$article->{id});
2083 my %stepparents = map { $_->{parentId}, $_ } @stepparents;
2084 my %datedefs = ( release => '2000-01-01', expire=>'2999-12-31' );
2085 for my $stepparent (@stepparents) {
31a26b52
TC
2086 $req->user_can(edit_stepkid_save => $stepparent->{parentId})
2087 or next;
ca9aa2bf
TC
2088 for my $name (qw/release expire/) {
2089 my $date = $cgi->param($name.'_'.$stepparent->{parentId});
2090 if (defined $date) {
2091 if ($date eq '') {
2092 $date = $datedefs{$name};
2093 }
2094 elsif (valid_date($date)) {
2095 use BSE::Util::SQL qw/date_to_sql/;
2096 $date = date_to_sql($date);
2097 }
2098 else {
2099 return $self->refresh($article, $cgi, "Invalid date '$date'");
2100 }
2101 $stepparent->{$name} = $date;
2102 }
2103 }
2104 eval {
2105 $stepparent->save();
2106 };
2107 $@ and return $self->refresh($article, $cgi, '', $@);
2108 }
2109
a0a8147b
TC
2110 use Util 'generate_article';
2111 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2112
8b0b2f34
TC
2113 return $self->refresh($article, $cgi, 'stepparents',
2114 'Stepparent information saved');
ca9aa2bf
TC
2115}
2116
2117sub refresh {
2118 my ($self, $article, $cgi, $name, $message, $extras) = @_;
2119
8b0b2f34 2120 my $url = $cgi->param('r');
16ac5598
TC
2121 if ($url) {
2122 if ($url !~ /[?&](m|message)=/ && $message) {
2123 # add in messages if none in the provided refresh
2124 my @msgs = ref $message ? @$message : $message;
2125 for my $msg (@msgs) {
2126 $url .= "&m=" . CGI::escape($msg);
2127 }
2128 }
2129 }
2130 else {
41f10371 2131 my $urlbase = admin_base_url($self->{cfg});
8b0b2f34 2132 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
16ac5598
TC
2133 if ($message) {
2134 my @msgs = ref $message ? @$message : $message;
2135 for my $msg (@msgs) {
2136 $url .= "&m=" . CGI::escape($msg);
2137 }
2138 }
8b0b2f34
TC
2139 if ($cgi->param('_t')) {
2140 $url .= "&_t=".CGI::escape($cgi->param('_t'));
2141 }
2142 $url .= $extras if defined $extras;
2143 my $cgiextras = $cgi->param('e');
2144 $url .= "#$name" if $name;
ca9aa2bf 2145 }
ca9aa2bf
TC
2146
2147 return BSE::Template->get_refresh($url, $self->{cfg});
2148}
2149
2150sub show_images {
918735d1 2151 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
2152
2153 my %acts;
918735d1 2154 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
2155 my $template = 'admin/article_img';
2156
4d764c34 2157 return $req->dyn_response($template, \%acts);
ca9aa2bf
TC
2158}
2159
2160sub save_image_changes {
2161 my ($self, $req, $article, $articles) = @_;
2162
abf5bbc6 2163 $req->user_can(edit_images_save => $article)
cc9019d1 2164 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2165 "You don't have access to save image information for this article");
2166
b95fc3a0
TC
2167 my $image_dir = cfg_image_dir($req->cfg);
2168
ca9aa2bf
TC
2169 my $cgi = $req->cgi;
2170 my $image_pos = $cgi->param('imagePos');
2171 if ($image_pos
2172 && $image_pos =~ /^(?:tl|tr|bl|br)$/
2173 && $image_pos ne $article->{imagePos}) {
2174 $article->{imagePos} = $image_pos;
2175 $article->save;
2176 }
daee3409 2177 my @images = $self->get_images($article);
4772671f
TC
2178
2179 @images or
2180 return $self->refresh($article, $cgi, undef, 'No images to save information for');
ca9aa2bf 2181
b95fc3a0
TC
2182 my %changes;
2183 my %errors;
2184 my %names;
8326f275
TC
2185 my @old_images;
2186 my @new_images;
b95fc3a0
TC
2187 for my $image (@images) {
2188 my $id = $image->{id};
2189
2190 my $alt = $cgi->param("alt$id");
2191 if ($alt ne $image->{alt}) {
2192 $changes{$id}{alt} = $alt;
ca9aa2bf 2193 }
b95fc3a0
TC
2194
2195 my $url = $cgi->param("url$id");
2196 if (defined $url && $url ne $image->{url}) {
2197 $changes{$id}{url} = $url;
ca9aa2bf 2198 }
b95fc3a0
TC
2199
2200 my $name = $cgi->param("name$id");
2201 if (defined $name && $name ne $image->{name}) {
547a26ad
TC
2202 if ($name eq '') {
2203 if ($article->{id} > 0) {
2204 $changes{$id}{name} = '';
2205 }
2206 else {
2207 $errors{"name$id"} = "Identifiers are required for global images";
2208 }
2d83755d
TC
2209 }
2210 elsif ($name =~ /^[a-z_]\w*$/i) {
b95fc3a0
TC
2211 my $msg;
2212 if ($self->validate_image_name($name, \$msg)) {
2213 # check for duplicates after the loop
2214 push @{$names{lc $name}}, $image->{id}
2215 if length $name;
2216 $changes{$id}{name} = $name;
4772671f
TC
2217 }
2218 else {
b95fc3a0 2219 $errors{"name$id"} = $msg;
4772671f
TC
2220 }
2221 }
b95fc3a0
TC
2222 else {
2223 $errors{"name$id"} = 'Image name must be empty or alphanumeric and unique to the article';
2224 }
2225 }
2226 else {
2227 push @{$names{lc $image->{name}}}, $image->{id}
2228 if length $image->{name};
2229 }
2230
2231 my $filename = $cgi->param("image$id");
2232 if (defined $filename && length $filename) {
2233 my $in_fh = $cgi->upload("image$id");
2234 if ($in_fh) {
2235 # work out where to put it
2236 require DevHelp::FileUpload;
daee3409 2237 my $msg;
b95fc3a0
TC
2238 my ($image_name, $out_fh) = DevHelp::FileUpload->make_img_filename
2239 ($image_dir, $filename . '', \$msg);
2240 if ($image_name) {
2241 local $/ = \8192;
2242 my $data;
2243 while ($data = <$in_fh>) {
2244 print $out_fh $data;
2245 }
2246 close $out_fh;
2247
2248 my $full_filename = "$image_dir/$image_name";
2249 require Image::Size;
2250 my ($width, $height, $type) = Image::Size::imgsize($full_filename);
2251 if ($width) {
8326f275
TC
2252 push @old_images, $image->{image};
2253 push @new_images, $image_name;
2254
b95fc3a0
TC
2255 $changes{$id}{image} = $image_name;
2256 $changes{$id}{width} = $width;
2257 $changes{$id}{height} = $height;
b95fc3a0
TC
2258 }
2259 else {
2260 $errors{"image$id"} = $type;
2261 }
2262 }
2263 else {
2264 $errors{"image$id"} = $msg;
2265 }
2266 }
2267 else {
2268 # problem uploading
2269 $errors{"image$id"} = "No image file received";
2270 }
2271 }
2272 }
2273 # look for duplicate names
2274 for my $name (keys %names) {
2275 if (@{$names{$name}} > 1) {
2276 for my $id (@{$names{$name}}) {
2277 $errors{"name$id"} = 'Image name must be unique to the article';
daee3409 2278 }
4772671f
TC
2279 }
2280 }
8326f275
TC
2281 if (keys %errors) {
2282 # remove files that won't be stored because validation failed
2283 unlink map "$image_dir/$_", @new_images;
2284
2285 return $self->edit_form($req, $article, $articles, undef,
2286 \%errors);
2287 }
b95fc3a0 2288 if (keys %changes) {
ca9aa2bf 2289 for my $image (@images) {
b95fc3a0
TC
2290 my $id = $image->{id};
2291 $changes{$id}
2292 or next;
2293
2294 for my $field (keys %{$changes{$id}}) {
2295 $image->{$field} = $changes{$id}{$field};
2296 }
ca9aa2bf
TC
2297 $image->save;
2298 }
a0a8147b 2299
b95fc3a0 2300 # delete any image files that were replaced
8326f275 2301 unlink map "$image_dir/$_", @old_images;
b95fc3a0
TC
2302
2303 use Util 'generate_article';
2304 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2305 }
a0a8147b 2306
cc9019d1 2307 return $self->refresh($article, $cgi, undef, 'Image information saved');
ca9aa2bf
TC
2308}
2309
dbcd12e5
TC
2310sub _service_error {
2311 my ($self, $req, $article, $articles, $error) = @_;
2312
2313 if ($req->cgi->param('_service')) {
2314 my $body = '';
2315 $body .= "Result: failure\n";
2316 if (ref $error) {
2317 for my $field (keys %$error) {
2318 my $text = $error->{$field};
2319 $text =~ tr/\n/ /;
2320 $body .= "Field-Error: $field - $text\n";
2321 }
2322 my $text = join ('/', values %$error);
2323 $text =~ tr/\n/ /;
2324 $body .= "Error: $text\n";
2325 }
2326 else {
2327 $body .= "Error: $error\n";
2328 }
2329 return
2330 {
2331 type => 'text/plain',
2332 content => $body,
2333 };
2334 }
2335 else {
2336 return $self->edit_form($req, $article, $articles, $error);
2337 }
2338}
2339
2340sub _service_success {
2341 my ($self, $results) = @_;
2342
2343 my $body = "Result: success\n";
2344 for my $field (keys %$results) {
2345 $body .= "$field: $results->{$field}\n";
2346 }
2347 return
2348 {
2349 type => 'text/plain',
2350 content => $body,
2351 };
2352}
2353
ca9aa2bf
TC
2354sub add_image {
2355 my ($self, $req, $article, $articles) = @_;
2356
abf5bbc6 2357 $req->user_can(edit_images_add => $article)
dbcd12e5
TC
2358 or return $self->_service_error($req, $article, $articles,
2359 "You don't have access to add new images to this article");
abf5bbc6 2360
ca9aa2bf
TC
2361 my $cgi = $req->cgi;
2362
4772671f
TC
2363 my %errors;
2364 my $msg;
2365 my $imageref = $cgi->param('name');
d794b180 2366 if (defined $imageref && $imageref ne '') {
4772671f
TC
2367 if ($imageref =~ /^[a-z_]\w+$/i) {
2368 # make sure it's unique
daee3409 2369 my @images = $self->get_images($article);
4772671f
TC
2370 for my $img (@images) {
2371 if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
9604a90c 2372 $errors{name} = 'Image name must be unique to the article';
4772671f
TC
2373 last;
2374 }
2375 }
2376 }
2377 else {
9604a90c 2378 $errors{name} = 'Image name must be empty or alphanumeric beginning with an alpha character';
4772671f
TC
2379 }
2380 }
2381 else {
2382 $imageref = '';
2383 }
daee3409 2384 unless ($errors{name}) {
d09682dd
TC
2385 my $workmsg;
2386 $self->validate_image_name($imageref, \$workmsg)
2387 or $errors{name} = $workmsg;
daee3409 2388 }
4772671f 2389
ca9aa2bf 2390 my $image = $cgi->param('image');
4772671f
TC
2391 if ($image) {
2392 if (-z $image) {
2393 $errors{image} = 'Image file is empty';
2394 }
ca9aa2bf 2395 }
4772671f 2396 else {
d09682dd 2397 #$msg = 'Enter or select the name of an image file on your machine';
4772671f
TC
2398 $errors{image} = 'Please enter an image filename';
2399 }
2400 if ($msg || keys %errors) {
dbcd12e5 2401 return $self->_service_error($req, $article, $articles, $msg, \%errors);
ca9aa2bf 2402 }
4772671f 2403
ca9aa2bf
TC
2404 my $imagename = $image;
2405 $imagename .= ''; # force it into a string
2406 my $basename = '';
2407 $imagename =~ /([\w.-]+)$/ and $basename = $1;
2408
2409 # create a filename that we hope is unique
2410 my $filename = time. '_'. $basename;
2411
2412 # for the sysopen() constants
2413 use Fcntl;
2414
ab2cd916 2415 my $imagedir = cfg_image_dir($req->cfg);
ca9aa2bf
TC
2416 # loop until we have a unique filename
2417 my $counter="";
2418 $filename = time. '_' . $counter . '_' . $basename
2419 until sysopen( OUTPUT, "$imagedir/$filename", O_WRONLY| O_CREAT| O_EXCL)
2420 || ++$counter > 100;
2421
2422 fileno(OUTPUT) or die "Could not open image file: $!";
2423
2424 # for OSs with special text line endings
2425 binmode OUTPUT;
2426
2427 my $buffer;
2428
2429 no strict 'refs';
2430
2431 # read the image in from the browser and output it to our output filehandle
2432 print OUTPUT $buffer while read $image, $buffer, 1024;
2433
2434 # close and flush
2435 close OUTPUT
2436 or die "Could not close image file $filename: $!";
2437
2438 use Image::Size;
2439
2440
2441 my($width,$height) = imgsize("$imagedir/$filename");
2442
2443 my $alt = $cgi->param('altIn');
2444 defined $alt or $alt = '';
2445 my $url = $cgi->param('url');
2446 defined $url or $url = '';
2447 my %image =
2448 (
2449 articleId => $article->{id},
2450 image => $filename,
2451 alt=>$alt,
2452 width=>$width,
2453 height => $height,
2454 url => $url,
2455 displayOrder=>time,
4772671f 2456 name => $imageref,
ca9aa2bf
TC
2457 );
2458 require Images;
2459 my @cols = Image->columns;
2460 shift @cols;
2461 my $imageobj = Images->add(@image{@cols});
a0a8147b
TC
2462
2463 use Util 'generate_article';
2464 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2465
dbcd12e5
TC
2466 if ($cgi->param('_service')) {
2467 return $self->_service_success
2468 (
2469 {
2470 image => $imageobj->{id},
2471 },
2472 );
2473 }
2474 else {
2475 return $self->refresh($article, $cgi, undef, 'New image added');
2476 }
ca9aa2bf
TC
2477}
2478
2479# remove an image
2480sub remove_img {
2481 my ($self, $req, $article, $articles, $imageid) = @_;
2482
abf5bbc6 2483 $req->user_can(edit_images_delete => $article)
cc9019d1 2484 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2485 "You don't have access to delete images from this article");
2486
ca9aa2bf
TC
2487 $imageid or die;
2488
daee3409 2489 my @images = $self->get_images($article);
ca9aa2bf
TC
2490 my ($image) = grep $_->{id} == $imageid, @images
2491 or return $self->show_images($req, $article, $articles, "No such image");
ab2cd916 2492 my $imagedir = cfg_image_dir($req->cfg);
6473c56f 2493 unlink "$imagedir$image->{image}";
ca9aa2bf
TC
2494 $image->remove;
2495
a0a8147b
TC
2496 use Util 'generate_article';
2497 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2498
cc9019d1 2499 return $self->refresh($article, $req->cgi, undef, 'Image removed');
ca9aa2bf
TC
2500}
2501
2502sub move_img_up {
2503 my ($self, $req, $article, $articles) = @_;
2504
abf5bbc6 2505 $req->user_can(edit_images_reorder => $article)
cc9019d1 2506 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2507 "You don't have access to reorder images in this article");
2508
ca9aa2bf 2509 my $imageid = $req->cgi->param('imageid');
daee3409 2510 my @images = $self->get_images($article);
ca9aa2bf 2511 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 2512 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 2513 $imgindex > 0
cc9019d1 2514 or return $self->edit_form($req, $article, $articles, "Image is already at the top");
ca9aa2bf
TC
2515 my ($to, $from) = @images[$imgindex-1, $imgindex];
2516 ($to->{displayOrder}, $from->{displayOrder}) =
2517 ($from->{displayOrder}, $to->{displayOrder});
2518 $to->save;
2519 $from->save;
2520
a0a8147b
TC
2521 use Util 'generate_article';
2522 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2523
cc9019d1 2524 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
2525}
2526
2527sub move_img_down {
2528 my ($self, $req, $article, $articles) = @_;
2529
abf5bbc6 2530 $req->user_can(edit_images_reorder => $article)
cc9019d1 2531 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2532 "You don't have access to reorder images in this article");
2533
ca9aa2bf 2534 my $imageid = $req->cgi->param('imageid');
daee3409 2535 my @images = $self->get_images($article);
ca9aa2bf 2536 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 2537 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 2538 $imgindex < $#images
cc9019d1 2539 or return $self->edit_form($req, $article, $articles, "Image is already at the end");
ca9aa2bf
TC
2540 my ($to, $from) = @images[$imgindex+1, $imgindex];
2541 ($to->{displayOrder}, $from->{displayOrder}) =
2542 ($from->{displayOrder}, $to->{displayOrder});
2543 $to->save;
2544 $from->save;
2545
a0a8147b
TC
2546 use Util 'generate_article';
2547 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2548
cc9019d1 2549 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
2550}
2551
ab2cd916
TC
2552sub req_thumb {
2553 my ($self, $req, $article) = @_;
2554
2555 my $cgi = $req->cgi;
2556 my $cfg = $req->cfg;
2557 my $im_id = $cgi->param('im');
2558 my $image;
2559 if (defined $im_id && $im_id =~ /^\d+$/) {
6a8a6ac5 2560 ($image) = grep $_->{id} == $im_id, $self->get_images($article);
ab2cd916
TC
2561 }
2562 my $thumb_obj = $self->_get_thumbs_class();
2563 my ($data, $type);
2564 if ($image && $thumb_obj) {
195977cd
TC
2565 my $geometry_id = $cgi->param('g');
2566 defined $geometry_id or $geometry_id = 'editor';
dbcd12e5 2567 my $geometry = $cfg->entry('thumb geometries', $geometry_id, 'scale(200x200)');
ab2cd916
TC
2568 my $imagedir = $cfg->entry('paths', 'images', $Constants::IMAGEDIR);
2569
195977cd
TC
2570 my $error;
2571 ($data, $type) = $thumb_obj->
2572 thumb_data("$imagedir/$image->{image}", $geometry, \$error)
2573 or return [
2574 type => 'text/plain',
2575 content => 'Error: '.$error
2576 ];
ab2cd916
TC
2577 }
2578
2579 if ($type && $data) {
2580
2581 return
2582 {
2583 type => $type,
2584 content => $data,
2585 headers => [
2586 "Content-Length: ".length($data),
2587 "Cache-Control: max-age=3600",
2588 ],
2589 };
2590 }
2591 else {
2592 # grab the nothumb image
2593 my $uri = $cfg->entry('editor', 'default_thumbnail', '/images/admin/nothumb.png');
2594 my $filebase = $Constants::CONTENTBASE;
2595 if (open IMG, "<$filebase/$uri") {
2596 binmode IMG;
2597 my $data = do { local $/; <IMG> };
2598 close IMG;
2599 my $type = $uri =~ /\.(\w+)$/ ? $1 : 'png';
2600 return
2601 {
2602 type => "image/$type",
2603 content => $data,
2604 headers => [ "Content-Length: ".length($data) ],
2605 };
2606 }
2607 else {
2608 return
2609 {
2610 type=>"text/html",
2611 content => "<html><body>Cannot make thumb or default image</body></html>",
2612 };
2613 }
2614 }
2615}
2616
b95fc3a0
TC
2617sub req_edit_image {
2618 my ($self, $req, $article, $articles, $errors) = @_;
2619
2620 my $cgi = $req->cgi;
2621
2622 my $id = $cgi->param('image_id');
2623
7303cf10 2624 my ($image) = grep $_->{id} == $id, $self->get_images($article)
b95fc3a0
TC
2625 or return $self->edit_form($req, $article, $articles,
2626 "No such image");
2627 $req->user_can(edit_images_save => $article)
2628 or return $self->edit_form($req, $article, $articles,
2629 "You don't have access to save image information for this article");
2630
2631 my %acts;
2632 %acts =
2633 (
2634 $self->low_edit_tags(\%acts, $req, $article, $articles, undef,
2635 $errors),
2636 eimage => [ \&tag_hash, $image ],
7303cf10 2637 error_img => [ \&tag_error_img, $req->cfg, $errors ],
b95fc3a0
TC
2638 );
2639
2640 return $req->response('admin/image_edit', \%acts);
2641}
2642
2643sub req_save_image {
2644 my ($self, $req, $article, $articles) = @_;
2645
2646 my $cgi = $req->cgi;
2647
2648 my $id = $cgi->param('image_id');
2649
7303cf10 2650 my @images = $self->get_images($article);
b95fc3a0
TC
2651 my ($image) = grep $_->{id} == $id, @images
2652 or return $self->edit_form($req, $article, $articles,
2653 "No such image");
2654 $req->user_can(edit_images_save => $article)
2655 or return $self->edit_form($req, $article, $articles,
2656 "You don't have access to save image information for this article");
2657
2658 my $image_dir = cfg_image_dir($req->cfg);
2659
2660 my %errors;
2661 my $delete_file;
2662 my $alt = $cgi->param('alt');
2663 defined $alt and $image->{alt} = $alt;
2664 my $url = $cgi->param('url');
2665 defined $url and $image->{url} = $url;
2666 my @other_images = grep $_->{id} != $id, @images;
2667 my $name = $cgi->param('name');
2668 if (defined $name) {
2669 if (length $name) {
2670 if ($name !~ /^[a-z_]\w*$/i) {
2671 $errors{name} = 'Image name must be empty or alphanumeric and unique to the article';
2672 }
2673 elsif (grep $name eq $_->{name}, @other_images) {
2674 $errors{name} = 'Image name must be unique to the article';
2675 }
2676 else {
2677 $image->{name} = $name;
2678 }
2679 }
2d83755d 2680 else {
547a26ad
TC
2681 if ($article->{id} == -1) {
2682 $errors{name} = "Identifiers are required for global images";
2683 }
2684 else {
2685 $image->{name} = '';
2686 }
2d83755d 2687 }
b95fc3a0
TC
2688 }
2689 my $filename = $cgi->param('image');
2690 if (defined $filename && length $filename) {
2691 my $in_fh = $cgi->upload('image');
2692 if ($in_fh) {
2693 require DevHelp::FileUpload;
2694 my $msg;
2695 my ($image_name, $out_fh) = DevHelp::FileUpload->make_img_filename
2696 ($image_dir, $filename . '', \$msg);
2697 if ($image_name) {
2698 {
2699 local $/ = \8192;
2700 my $data;
2701 while ($data = <$in_fh>) {
2702 print $out_fh $data;
2703 }
2704 close $out_fh;
2705 }
2706
2707 my $full_filename = "$image_dir/$image_name";
2708 require Image::Size;
2709 my ($width, $height, $type) = Image::Size::imgsize($full_filename);
2710 if ($width) {
2711 $delete_file = $image->{image};
2712 $image->{image} = $image_name;
2713 $image->{width} = $width;
2714 $image->{height} = $height;
2715 }
2716 else {
2717 $errors{image} = $type;
2718 }
2719 }
2720 else {
2721 $errors{image} = $msg;
2722 }
2723 }
2724 else {
2725 $errors{image} = "No image file received";
2726 }
2727 }
2728 keys %errors
2729 and return $self->req_edit_image($req, $article, $articles, \%errors);
2730
2731 $image->save;
2732 unlink "$image_dir/$delete_file"
2733 if $delete_file;
2734
2735 return $self->refresh($article, $cgi, undef, 'Image saved');
2736}
2737
ca9aa2bf
TC
2738sub get_article {
2739 my ($self, $articles, $article) = @_;
2740
2741 return $article;
2742}
2743
2744sub table_object {
2745 my ($self, $articles) = @_;
2746
2747 $articles;
2748}
2749
2750my %types =
2751 (
2752 qw(
6a8a6ac5
TC
2753 bash text/plain
2754 css text/css
2755 csv text/plain
2756 diff text/plain
ca9aa2bf
TC
2757 htm text/html
2758 html text/html
6a8a6ac5
TC
2759 ics text/calendar
2760 patch text/plain
2761 pl text/plain
2762 pm text/plain
2763 pod text/plain
2764 py text/plain
ad48b8d4
TC
2765 sgm text/sgml
2766 sgml text/sgml
6a8a6ac5
TC
2767 sh text/plain
2768 tcsh text/plain
2769 text text/plain
ad48b8d4 2770 tsv text/tab-separated-values
6a8a6ac5
TC
2771 txt text/plain
2772 vcf text/x-vcard
2773 vcs text/x-vcalendar
2774 xml text/xml
4a8db683 2775 zsh text/plain
6a8a6ac5 2776 bmp image/bmp
ca9aa2bf 2777 gif image/gif
ad48b8d4 2778 jp2 image/jpeg2000
6a8a6ac5
TC
2779 jpeg image/jpeg
2780 jpg image/jpeg
2781 pct image/pict
2782 pict image/pict
ca9aa2bf 2783 png image/png
ca9aa2bf
TC
2784 tif image/tiff
2785 tiff image/tiff
6a8a6ac5
TC
2786 dcr application/x-director
2787 dir application/x-director
2788 doc application/msword
2789 dxr application/x-director
ad48b8d4 2790 eps application/postscript
6a8a6ac5 2791 fla application/x-shockwave-flash
4a8db683 2792 flv application/x-shockwave-flash
6a8a6ac5
TC
2793 gz application/gzip
2794 hqx application/mac-binhex40
2795 js application/x-javascript
2796 lzh application/x-lzh
2797 pdf application/pdf
2798 pps application/ms-powerpoint
2799 ppt application/ms-powerpoint
ad48b8d4 2800 ps application/postscript
ad48b8d4 2801 rtf application/rtf
6a8a6ac5
TC
2802 sit application/x-stuffit
2803 swf application/x-shockwave-flash
ad48b8d4
TC
2804 tar application/x-tar
2805 tgz application/gzip
ad48b8d4 2806 xls application/ms-excel
4a8db683 2807 Z application/x-compress
6a8a6ac5
TC
2808 zip application/zip
2809 asf video/x-ms-asf
2810 avi video/avi
2811 flc video/flc
ad48b8d4 2812 moov video/quicktime
6a8a6ac5 2813 mov video/quicktime
41f10371 2814 mp4 video/mp4
ad48b8d4 2815 mpeg video/mpeg
6a8a6ac5 2816 mpg video/mpeg
ad48b8d4 2817 wmv video/x-ms-wmv
4a8db683 2818 3gp video/3gpp
6a8a6ac5 2819 aa audio/audible
ad48b8d4
TC
2820 aif audio/aiff
2821 aiff audio/aiff
6a8a6ac5
TC
2822 m4a audio/m4a
2823 mid audio/midi
2824 mp2 audio/x-mpeg
2825 mp3 audio/x-mpeg
ad48b8d4
TC
2826 ra audio/x-realaudio
2827 ram audio/x-pn-realaudio
2828 rm audio/vnd.rm-realmedia
6a8a6ac5 2829 swa audio/mp3
ad48b8d4
TC
2830 wav audio/wav
2831 wma audio/x-ms-wma
ca9aa2bf
TC
2832 )
2833 );
2834
2835sub _refresh_filelist {
8b0b2f34 2836 my ($self, $req, $article, $msg) = @_;
ca9aa2bf 2837
cc9019d1 2838 return $self->refresh($article, $req->cgi, undef, $msg);
ca9aa2bf
TC
2839}
2840
2841sub filelist {
918735d1 2842 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
2843
2844 my %acts;
918735d1 2845 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
2846 my $template = 'admin/filelist';
2847
2848 return BSE::Template->get_response($template, $req->cfg, \%acts);
2849}
2850
4b69925d
TC
2851my %file_fields =
2852 (
2853 file =>
2854 {
2855 maxlength => MAX_FILE_DISPLAYNAME_LENGTH,
2856 description => 'Filename'
2857 },
2858 description =>
2859 {
2860 rules => 'dh_one_line',
2861 maxlength => 255,
2862 description => 'Description',
2863 },
2864 name =>
2865 {
2866 description => 'Identifier',
2867 maxlength => 80,
2868 },
2869 );
2870
ca9aa2bf
TC
2871sub fileadd {
2872 my ($self, $req, $article, $articles) = @_;
2873
abf5bbc6 2874 $req->user_can(edit_files_add => $article)
cc9019d1 2875 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2876 "You don't have access to add files to this article");
2877
ca9aa2bf
TC
2878 my %file;
2879 my $cgi = $req->cgi;
2880 require ArticleFile;
2881 my @cols = ArticleFile->columns;
2882 shift @cols;
2883 for my $col (@cols) {
2884 if (defined $cgi->param($col)) {
2885 $file{$col} = $cgi->param($col);
2886 }
2887 }
c5286ebe
TC
2888
2889 my %errors;
ca9aa2bf 2890
4b69925d
TC
2891 $req->validate(errors => \%errors,
2892 fields => \%file_fields,
2893 section => $article->{id} == -1 ? 'Global File Validation' : 'Article File Validation');
2894
b8e8b584
TC
2895 $file{forSale} = 0 + exists $file{forSale};
2896 $file{articleId} = $article->{id};
2897 $file{download} = 0 + exists $file{download};
2898 $file{requireUser} = 0 + exists $file{requireUser};
2899 $file{hide_from_list} = 0 + exists $file{hide_from_list};
ca9aa2bf
TC
2900
2901 my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
2902
2903 # build a filename
2904 my $file = $cgi->param('file');
2905 unless ($file) {
c5286ebe 2906 $errors{file} = 'Please enter a filename';
ca9aa2bf 2907 }
c5286ebe
TC
2908 if ($file && -z $file) {
2909 $errors{file} = 'File is empty';
ca9aa2bf
TC
2910 }
2911
2912 unless ($file{contentType}) {
2913 unless ($file =~ /\.([^.]+)$/) {
2914 $file{contentType} = "application/octet-stream";
2915 }
2916 unless ($file{contentType}) {
2917 my $ext = lc $1;
2918 my $type = $types{$ext};
2919 unless ($type) {
2920 $type = $self->{cfg}->entry('extensions', $ext)
2921 || $self->{cfg}->entry('extensions', ".$ext")
2922 || "application/octet-stream";
2923 }
2924 $file{contentType} = $type;
2925 }
2926 }
c5286ebe
TC
2927
2928 defined $file{name} or $file{name} = '';
9366cd70
TC
2929 if ($article->{id} == -1 && $file{name} eq '') {
2930 $errors{name} = 'Identifier is required for global files';
2931 }
2932 if (!$errors{name} && length $file{name} && $file{name} !~/^\w+$/) {
c5286ebe
TC
2933 $errors{name} = "Identifier must be a single word";
2934 }
2935 if (!$errors{name} && length $file{name}) {
9366cd70 2936 my @files = $self->get_files($article);
c5286ebe
TC
2937 if (grep lc $_->{name} eq lc $file{name}, @files) {
2938 $errors{name} = "Duplicate file identifier $file{name}";
2939 }
2940 }
2941
2942 keys %errors
2943 and return $self->edit_form($req, $article, $articles, undef, \%errors);
ca9aa2bf
TC
2944
2945 my $basename = '';
6a8a205a
TC
2946 my $workfile = $file;
2947 $workfile =~ s![^\w.:/\\-]+!_!g;
2948 $workfile =~ tr/_/_/s;
2949 $workfile =~ /([ \w.-]+)$/ and $basename = $1;
f0543260 2950 $basename =~ tr/ /_/;
ca9aa2bf 2951
4b69925d
TC
2952 # if the user supplies a really long filename, it can overflow the
2953 # filename field
2954
2955 my $work_filename = $basename;
2956 if (length $work_filename > 60) {
2957 $work_filename = substr($work_filename, -60);
2958 }
2959
2960 my $filename = time. '_'. $work_filename;
ca9aa2bf
TC
2961
2962 # for the sysopen() constants
2963 use Fcntl;
2964
2965 # loop until we have a unique filename
2966 my $counter="";
4b69925d 2967 $filename = time. '_' . $counter . '_' . $work_filename
ca9aa2bf
TC
2968 until sysopen( OUTPUT, "$downloadPath/$filename",
2969 O_WRONLY| O_CREAT| O_EXCL)
2970 || ++$counter > 100;
2971
2972 fileno(OUTPUT) or die "Could not open file: $!";
2973
2974 # for OSs with special text line endings
2975 binmode OUTPUT;
2976
2977 my $buffer;
2978
2979 no strict 'refs';
2980
2981 # read the image in from the browser and output it to our output filehandle
2982 print OUTPUT $buffer while read $file, $buffer, 8192;
2983
2984 # close and flush
2985 close OUTPUT
2986 or die "Could not close file $filename: $!";
2987
2988 use BSE::Util::SQL qw/now_datetime/;
2989 $file{filename} = $filename;
2990 $file{displayName} = $basename;
2991 $file{sizeInBytes} = -s $file;
2992 $file{displayOrder} = time;
2993 $file{whenUploaded} = now_datetime();
2994
2995 require ArticleFiles;
2996 my $fileobj = ArticleFiles->add(@file{@cols});
2997
a0a8147b
TC
2998 use Util 'generate_article';
2999 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3000
8b0b2f34 3001 $self->_refresh_filelist($req, $article, 'New file added');
ca9aa2bf
TC
3002}
3003
3004sub fileswap {
3005 my ($self, $req, $article, $articles) = @_;
3006
abf5bbc6 3007 $req->user_can('edit_files_reorder', $article)
cc9019d1 3008 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
3009 "You don't have access to reorder files in this article");
3010
ca9aa2bf
TC
3011 my $cgi = $req->cgi;
3012 my $id1 = $cgi->param('file1');
3013 my $id2 = $cgi->param('file2');
3014
3015 if ($id1 && $id2) {
9366cd70 3016 my @files = $self->get_files($article);
ca9aa2bf
TC
3017
3018 my ($file1) = grep $_->{id} == $id1, @files;
3019 my ($file2) = grep $_->{id} == $id2, @files;
3020
3021 if ($file1 && $file2) {
3022 ($file1->{displayOrder}, $file2->{displayOrder})
3023 = ($file2->{displayOrder}, $file1->{displayOrder});
3024 $file1->save;
3025 $file2->save;
3026 }
3027 }
3028
a0a8147b
TC
3029 use Util 'generate_article';
3030 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3031
9063386f 3032 $self->refresh($article, $req->cgi, undef, 'File moved');
ca9aa2bf
TC
3033}
3034
3035sub filedel {
3036 my ($self, $req, $article, $articles) = @_;
3037
abf5bbc6 3038 $req->user_can('edit_files_delete', $article)
cc9019d1
TC
3039 or return $self->edit_form($req, $article, $articles,
3040 "You don't have access to delete files from this article");
abf5bbc6 3041
ca9aa2bf
TC
3042 my $cgi = $req->cgi;
3043 my $fileid = $cgi->param('file');
3044 if ($fileid) {
9366cd70 3045 my @files = $self->get_files($article);
ca9aa2bf
TC
3046
3047 my ($file) = grep $_->{id} == $fileid, @files;
3048
3049 if ($file) {
16901a2a 3050 $file->remove($req->cfg);
ca9aa2bf
TC
3051 }
3052 }
3053
a0a8147b
TC
3054 use Util 'generate_article';
3055 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3056
8b0b2f34 3057 $self->_refresh_filelist($req, $article, 'File deleted');
ca9aa2bf
TC
3058}
3059
3060sub filesave {
abf5bbc6 3061 my ($self, $req, $article, $articles) = @_;
ca9aa2bf 3062
abf5bbc6 3063 $req->user_can('edit_files_save', $article)
cc9019d1 3064 or return $self->edit_form($req, $article, $articles,
abf5bbc6 3065 "You don't have access to save file information for this article");
9366cd70 3066 my @files = $self->get_files($article);
ca9aa2bf 3067
8326f275
TC
3068 my $download_path = $self->{cfg}->entryVar('paths', 'downloads');
3069
ca9aa2bf 3070 my $cgi = $req->cgi;
b95fc3a0
TC
3071 my %names;
3072 my %errors;
8326f275
TC
3073 my @old_files;
3074 my @new_files;
ca9aa2bf 3075 for my $file (@files) {
b8e8b584 3076 my $id = $file->{id};
b95fc3a0
TC
3077 my $desc = $cgi->param("description_$id");
3078 defined $desc and $file->{description} = $desc;
3079 my $type = $cgi->param("contentType_$id");
3080 defined $type and $file->{contentType} = $type;
3081 my $notes = $cgi->param("notes_$id");
3082 defined $notes and $file->{notes} = $notes;
3083 my $name = $cgi->param("name_$id");
3084 if (defined $name) {
3085 $file->{name} = $name;
3086 if (length $name) {
3087 if ($name =~ /^\w+$/) {
b2a9e505 3088 push @{$names{$name}}, $id;
b95fc3a0
TC
3089 }
3090 else {
3091 $errors{"name_$id"} = "Invalid file identifier $name";
3092 }
c5286ebe 3093 }
9366cd70
TC
3094 elsif ($article->{id} == -1) {
3095 $errors{"name_$id"} = "Identifier is required for global files";
3096 }
b95fc3a0
TC
3097 }
3098 else {
3099 push @{$names{$file->{name}}}, $id
3100 if length $file->{name};
3101 }
3102 if ($cgi->param('save_file_flags')) {
b8e8b584
TC
3103 $file->{download} = 0 + defined $cgi->param("download_$id");
3104 $file->{forSale} = 0 + defined $cgi->param("forSale_$id");
3105 $file->{requireUser} = 0 + defined $cgi->param("requireUser_$id");
3106 $file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list_$id");
ca9aa2bf 3107 }
8326f275
TC
3108
3109 my $filex = $cgi->param("file_$id");
3110 my $in_fh = $cgi->upload("file_$id");
3111 if (defined $filex && length $filex) {
4b69925d
TC
3112 if (length $filex <= MAX_FILE_DISPLAYNAME_LENGTH) {
3113 if ($in_fh) {
3114 if (-s $in_fh) {
3115 require DevHelp::FileUpload;
3116 my $msg;
3117 my ($file_name, $out_fh) = DevHelp::FileUpload->make_img_filename
3118 ($download_path, $filex . '', \$msg);
3119 if ($file_name) {
3120 {
3121 local $/ = \8192;
3122 my $data;
3123 while ($data = <$in_fh>) {
3124 print $out_fh $data;
3125 }
3126 close $out_fh;
8326f275 3127 }
4b69925d
TC
3128 my $display_name = $filex;
3129 $display_name =~ s!.*[\\:/]!!;
3130 $display_name =~ s/[^\w._-]+/_/g;
3131 my $full_name = "$download_path/$file_name";
3132 push @old_files, $file->{filename};
3133 push @new_files, $file_name;
3134
3135 $file->{filename} = $file_name;
3136 $file->{sizeInBytes} = -s $full_name;
3137 $file->{whenUploaded} = now_datetime();
3138 $file->{displayName} = $display_name;
3139 }
3140 else {
3141 $errors{"file_$id"} = $msg;
8326f275 3142 }
8326f275
TC
3143 }
3144 else {
4b69925d 3145 $errors{"file_$id"} = "File is empty";
8326f275
TC
3146 }
3147 }
3148 else {
4b69925d 3149 $errors{"file_$id"} = "No file data received";
8326f275
TC
3150 }
3151 }
3152 else {
4b69925d 3153 $errors{"file_$id"} = "Filename too long";
8326f275
TC
3154 }
3155 }
ca9aa2bf 3156 }
b95fc3a0
TC
3157 for my $name (keys %names) {
3158 if (@{$names{$name}} > 1) {
3159 for my $id (@{$names{$name}}) {
3160 $errors{"name_$id"} = 'File identifier must be unique to the article';
3161 }
3162 }
3163 }
8326f275
TC
3164 if (keys %errors) {
3165 # remove the uploaded replacements
3166 unlink map "$download_path/$_", @new_files;
3167
3168 return $self->edit_form($req, $article, $articles, undef, \%errors);
3169 }
c5286ebe
TC
3170 for my $file (@files) {
3171 $file->save;
3172 }
8326f275
TC
3173
3174 # remove the replaced files
3175 unlink map "$download_path/$_", @old_files;
3176
a0a8147b
TC
3177 use Util 'generate_article';
3178 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3179
8b0b2f34 3180 $self->_refresh_filelist($req, $article, 'File information saved');
ca9aa2bf
TC
3181}
3182
b2a9e505
TC
3183sub tag_old_checked {
3184 my ($errors, $cgi, $file, $key) = @_;
3185
3186 return $errors ? $cgi->param($key) : $file->{$key};
3187}
3188
3189sub req_edit_file {
3190 my ($self, $req, $article, $articles, $errors) = @_;
3191
3192 my $cgi = $req->cgi;
3193
3194 my $id = $cgi->param('file_id');
3195
9366cd70 3196 my ($file) = grep $_->{id} == $id, $self->get_files($article)
b2a9e505
TC
3197 or return $self->edit_form($req, $article, $articles,
3198 "No such file");
3199 $req->user_can(edit_files_save => $article)
3200 or return $self->edit_form($req, $article, $articles,
3201 "You don't have access to save file information for this article");
3202
3203 my %acts;
3204 %acts =
3205 (
3206 $self->low_edit_tags(\%acts, $req, $article, $articles, undef,
3207 $errors),
3208 efile => [ \&tag_hash, $file ],
3209 error_img => [ \&tag_error_img, $req->cfg, $errors ],
3210 ifOldChecked =>
3211 [ \&tag_old_checked, $errors, $cgi, $file ],
3212 );
3213
3214 return $req->response('admin/file_edit', \%acts);
3215}
3216
3217sub req_save_file {
3218 my ($self, $req, $article, $articles) = @_;
3219
3220 my $cgi = $req->cgi;
3221
9366cd70 3222 my @files = $self->get_files($article);
b2a9e505
TC
3223
3224 my $id = $cgi->param('file_id');
3225
3226 my ($file) = grep $_->{id} == $id, @files
3227 or return $self->edit_form($req, $article, $articles,
3228 "No such file");
3229 $req->user_can(edit_files_save => $article)
3230 or return $self->edit_form($req, $article, $articles,
3231 "You don't have access to save file information for this article");
3232 my @other_files = grep $_->{id} != $id, @files;
3233
3234 my $download_path = $self->{cfg}->entryVar('paths', 'downloads');
3235
3236 my %errors;
4b69925d
TC
3237
3238 $req->validate(errors => \%errors,
3239 fields => \%file_fields,
3240 section => $article->{id} == -1 ? 'Global File Validation' : 'Article File Validation');
3241
b2a9e505
TC
3242 my $desc = $cgi->param("description");
3243 defined $desc and $file->{description} = $desc;
3244 my $type = $cgi->param("contentType");
3245 defined $type and $file->{contentType} = $type;
3246 my $notes = $cgi->param("notes");
3247 defined $notes and $file->{notes} = $notes;
3248 my $name = $cgi->param("name");
3249 if (defined $name) {
3250 $file->{name} = $name;
3251 if (length $name) {
3252 if ($name =~ /^\w+$/) {
3253 if (grep lc $name eq lc $_->{name}, @other_files) {
3254 $errors{name} = 'File identifier must be unique to the article';
3255 }
3256 }
3257 else {
3258 $errors{name} = "Invalid file identifier $name";
3259 }
3260 }
9366cd70
TC
3261 if (!$errors{name} && $article->{id} == -1) {
3262 length $name
3263 or $errors{name} = "Identifier is required for global files";
3264 }
b2a9e505
TC
3265 }
3266
3267 if ($cgi->param('save_file_flags')) {
3268 $file->{download} = 0 + defined $cgi->param("download");
3269 $file->{forSale} = 0 + defined $cgi->param("forSale");
3270 $file->{requireUser} = 0 + defined $cgi->param("requireUser");
3271 $file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list");
3272 }
3273
3274 my @old_files;
3275 my @new_files;
3276 my $filex = $cgi->param("file");
3277 my $in_fh = $cgi->upload("file");
3278 if (defined $filex && length $filex) {
3279 if ($in_fh) {
3280 if (-s $in_fh) {
3281 require DevHelp::FileUpload;
3282 my $msg;
3283 my ($file_name, $out_fh) = DevHelp::FileUpload->make_img_filename
3284 ($download_path, $filex . '', \$msg);
3285 if ($file_name) {
3286 {
3287 local $/ = \8192;
3288 my $data;
3289 while ($data = <$in_fh>) {
3290 print $out_fh $data;
3291 }
3292 close $out_fh;
3293 }
3294 my $display_name = $filex;
3295 $display_name =~ s!.*[\\:/]!!;
3296 $display_name =~ s/[^\w._-]+/_/g;
3297 my $full_name = "$download_path/$file_name";
3298 push @old_files, $file->{filename};
3299 push @new_files, $file_name;
3300
3301 $file->{filename} = $file_name;
3302 $file->{sizeInBytes} = -s $full_name;
3303 $file->{whenUploaded} = now_datetime();
3304 $file->{displayName} = $display_name;
3305 }
3306 else {
3307 $errors{"file"} = $msg;
3308 }
3309 }
3310 else {
3311 $errors{"file"} = "File is empty";
3312 }
3313 }
3314 else {
3315 $errors{"file"} = "No file data received";
3316 }
3317 }
3318
3319 if (keys %errors) {
3320 # remove the uploaded replacements
3321 unlink map "$download_path/$_", @new_files;
3322
3323 return $self->req_edit_file($req, $article, $articles, \%errors);
3324 }
3325 $file->save;
3326
3327 # remove the replaced files
3328 unlink map "$download_path/$_", @old_files;
3329
3330 use Util 'generate_article';
3331 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3332
3333 $self->_refresh_filelist($req, $article, 'File information saved');
3334}
3335
6473c56f
TC
3336sub can_remove {
3337 my ($self, $req, $article, $articles, $rmsg) = @_;
3338
abf5bbc6
TC
3339 unless ($req->user_can('edit_delete_article', $article, $rmsg)) {
3340 $$rmsg ||= "Access denied";
3341 return;
3342 }
3343
6473c56f
TC
3344 if ($articles->children($article->{id})) {
3345 $$rmsg = "This article has children. You must delete the children first (or change their parents)";
3346 return;
3347 }
3348 if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
3349 $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
3350 return;
3351 }
3352 if ($article->{id} == $Constants::SHOPID) {
b8e8b584 3353 $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the store instead.";
6473c56f
TC
3354 return;
3355 }
3356
3357 return 1;
3358}
3359
3360sub remove {
3361 my ($self, $req, $article, $articles) = @_;
3362
3363 my $why_not;
3364 unless ($self->can_remove($req, $article, $articles, \$why_not)) {
3365 return $self->edit_form($req, $article, $articles, $why_not);
3366 }
3367
6473c56f 3368 my $parentid = $article->{parentid};
16901a2a
TC
3369 $article->remove($req->cfg);
3370
8b0b2f34
TC
3371 my $url = $req->cgi->param('r');
3372 unless ($url) {
41f10371 3373 my $urlbase = admin_base_url($req->cfg);
8b0b2f34
TC
3374 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$parentid";
3375 $url .= "&message=Article+deleted";
3376 }
6473c56f
TC
3377 return BSE::Template->get_refresh($url, $self->{cfg});
3378}
3379
4010d92e
TC
3380sub unhide {
3381 my ($self, $req, $article, $articles) = @_;
3382
3383 if ($req->user_can(edit_field_edit_listed => $article)
3384 && $req->user_can(edit_save => $article)) {
3385 $article->{listed} = 1;
3386 $article->save;
3387
3388 use Util 'generate_article';
3389 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3390 }
8b0b2f34 3391 return $self->refresh($article, $req->cgi, undef, 'Article unhidden');
4010d92e
TC
3392}
3393
3394sub hide {
3395 my ($self, $req, $article, $articles) = @_;
3396
3397 if ($req->user_can(edit_field_edit_listed => $article)
3398 && $req->user_can(edit_save => $article)) {
3399 $article->{listed} = 0;
3400 $article->save;
3401
3402 use Util 'generate_article';
3403 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
3404 }
3405 my $r = $req->cgi->param('r');
3406 unless ($r) {
41f10371
TC
3407 $r = admin_base_url($req->cfg)
3408 . "/cgi-bin/admin/add.pl?id=" . $article->{parentid};
4010d92e 3409 }
8b0b2f34 3410 return $self->refresh($article, $req->cgi, undef, 'Article hidden');
4010d92e
TC
3411}
3412
0ec4ac8a
TC
3413my %defaults =
3414 (
3415 titleImage => '',
3416 imagePos => 'tr',
3417 expire => $Constants::D_99,
3418 listed => 1,
3419 keyword => '',
5d88571c 3420 body => '<maximum of 64Kb>',
c2096d67
TC
3421 force_dynamic => 0,
3422 inherit_siteuser_rights => 1,
5d2dd1b4
AO
3423 menu => 0,
3424 titleAlias => '',
0ec4ac8a
TC
3425 );
3426
9168c88c
TC
3427sub default_value {
3428 my ($self, $req, $article, $col) = @_;
3429
3430 if ($article->{parentid}) {
3431 my $section = "children of $article->{parentid}";
3432 my $value = $req->cfg->entry($section, $col);
3433 if (defined $value) {
77804754 3434 return $value;
9168c88c
TC
3435 }
3436 }
3437 my $section = "level $article->{level}";
3438 my $value = $req->cfg->entry($section, $col);
77804754 3439 defined($value) and return $value;
0ec4ac8a 3440
deae2a52
TC
3441 $value = $self->type_default_value($req, $col);
3442 defined $value and return $value;
3443
0ec4ac8a
TC
3444 exists $defaults{$col} and return $defaults{$col};
3445
3446 $col eq 'release' and return now_sqldate();
3447
3448 if ($col eq 'threshold') {
d44b5da9 3449 my $parent = defined $article->{parentid} && $article->{parentid} != -1
0ec4ac8a
TC
3450 && Articles->getByPkey($article->{parentid});
3451
3452 $parent and return $parent->{threshold};
3453
3454 return 5;
3455 }
9168c88c 3456
0ec4ac8a 3457 if ($col eq 'summaryLength') {
5d88571c 3458 my $parent = defined $article->{parentid} && $article->{parentid} != -1
0ec4ac8a
TC
3459 && Articles->getByPkey($article->{parentid});