avoid having to scroll down to manage images/files, that has always sucked.
[bse.git] / site / cgi-bin / modules / BSE / Edit / Article.pm
CommitLineData
ca9aa2bf
TC
1package BSE::Edit::Article;
2use strict;
ca9aa2bf 3use base qw(BSE::Edit::Base);
b553afa2 4use BSE::Util::Tags qw(tag_error_img);
41f10371 5use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
b553afa2 6use BSE::Util::Valid qw/valid_date/;
9168c88c 7use BSE::Permissions;
d09682dd
TC
8use DevHelp::HTML qw(:default popup_menu);
9use BSE::Arrows;
ab2cd916
TC
10use BSE::CfgInfo qw(custom_class admin_base_url cfg_image_dir);
11use BSE::Util::Iterate;
f2bf0d11 12use BSE::Template;
ca9aa2bf 13
74b21f6d
TC
14sub not_logged_on {
15 my ($self, $req) = @_;
16
45121fea
TC
17 if (() = $req->cgi->param('_') ||
18 (defined $ENV{HTTP_X_REQUESTED_WITH}
19 && $ENV{HTTP_X_REQUESTED_WITH} =~ /XMLHttpRequest/)) {
74b21f6d
TC
20 # AJAX/Prototype request
21 return
22 {
23 content => 'Access Forbidden: login timed out',
24 headers => [
25 "Status: 403", # forbidden
26 ],
27 };
28 }
29 else {
30 BSE::Template->get_refresh($req->url('logon'), $req->cfg);
31 }
32}
33
ca9aa2bf 34sub article_dispatch {
9168c88c
TC
35 my ($self, $req, $article, $articles) = @_;
36
37 BSE::Permissions->check_logon($req)
fc186852 38 or return $self->not_logged_on($req);
9168c88c
TC
39
40 my $cgi = $req->cgi;
ca9aa2bf
TC
41 my $action;
42 my %actions = $self->article_actions;
43 for my $check (keys %actions) {
44 if ($cgi->param($check) || $cgi->param("$check.x")) {
45 $action = $check;
46 last;
47 }
48 }
49 my @extraargs;
50 unless ($action) {
51 ($action, @extraargs) = $self->other_article_actions($cgi);
52 }
53 $action ||= 'edit';
54 my $method = $actions{$action};
9168c88c 55 return $self->$method($req, $article, $articles, @extraargs);
ca9aa2bf
TC
56}
57
58sub noarticle_dispatch {
9168c88c 59 my ($self, $req, $articles) = @_;
ca9aa2bf 60
9168c88c
TC
61 BSE::Permissions->check_logon($req)
62 or return BSE::Template->get_refresh($req->url('logon'), $req->cfg);
63
64 my $cgi = $req->cgi;
ca9aa2bf
TC
65 my $action = 'add';
66 my %actions = $self->noarticle_actions;
67 for my $check (keys %actions) {
68 if ($cgi->param($check) || $cgi->param("$check.x")) {
69 $action = $check;
70 last;
71 }
72 }
73 my $method = $actions{$action};
9168c88c 74 return $self->$method($req, $articles);
ca9aa2bf
TC
75}
76
ca9aa2bf
TC
77sub article_actions {
78 my ($self) = @_;
79
80 return
81 (
82 edit => 'edit_form',
83 save => 'save',
84 add_stepkid => 'add_stepkid',
85 del_stepkid => 'del_stepkid',
86 save_stepkids => 'save_stepkids',
87 add_stepparent => 'add_stepparent',
88 del_stepparent => 'del_stepparent',
89 save_stepparents => 'save_stepparents',
90 artimg => 'save_image_changes',
91 addimg => 'add_image',
6473c56f 92 remove => 'remove',
ca9aa2bf
TC
93 showimages => 'show_images',
94 process => 'save_image_changes',
95 removeimg => 'remove_img',
96 moveimgup => 'move_img_up',
97 moveimgdown => 'move_img_down',
98 filelist => 'filelist',
99 fileadd => 'fileadd',
100 fileswap => 'fileswap',
101 filedel => 'filedel',
102 filesave => 'filesave',
4010d92e
TC
103 hide => 'hide',
104 unhide => 'unhide',
ab2cd916 105 a_thumb => 'req_thumb',
74b21f6d
TC
106 a_ajax_get => 'req_ajax_get',
107 a_ajax_save_body => 'req_ajax_save_body',
108 a_ajax_set => 'req_ajax_set',
ca9aa2bf
TC
109 );
110}
111
112sub other_article_actions {
113 my ($self, $cgi) = @_;
114
115 for my $param ($cgi->param) {
116 if ($param =~ /^removeimg_(\d+)(\.x)?$/) {
117 return ('removeimg', $1 );
118 }
119 }
120
121 return;
122}
123
124sub noarticle_actions {
125 return
126 (
127 add => 'add_form',
128 save => 'save_new',
129 );
130}
131
132sub get_parent {
133 my ($self, $parentid, $articles) = @_;
134
135 if ($parentid == -1) {
136 return
137 {
138 id => -1,
139 title=>'All Sections',
140 level => 0,
141 listed => 0,
142 parentid => undef,
143 };
144 }
145 else {
146 return $articles->getByPkey($parentid);
147 }
148}
149
150sub tag_hash {
151 my ($object, $args) = @_;
152
153 my $value = $object->{$args};
154 defined $value or $value = '';
7b81711b
TC
155 if ($value =~ /\cJ/ && $value =~ /\cM/) {
156 $value =~ tr/\cM//d;
157 }
77804754 158 escape_html($value);
ca9aa2bf
TC
159}
160
62533efa
TC
161sub tag_hash_mbcs {
162 my ($object, $args) = @_;
163
164 my $value = $object->{$args};
165 defined $value or $value = '';
166 if ($value =~ /\cJ/ && $value =~ /\cM/) {
167 $value =~ tr/\cM//d;
168 }
169 escape_html($value, '<>&"');
170}
171
ca9aa2bf
TC
172sub tag_art_type {
173 my ($level, $cfg) = @_;
174
77804754 175 escape_html($cfg->entry('level names', $level, 'Article'));
ca9aa2bf
TC
176}
177
178sub tag_if_new {
179 my ($article) = @_;
180
181 !$article->{id};
182}
183
184sub reparent_updown {
185 return 1;
186}
187
188sub should_be_catalog {
189 my ($self, $article, $parent, $articles) = @_;
190
191 if ($article->{parentid} && (!$parent || $parent->{id} != $article->{parentid})) {
192 $parent = $articles->getByPkey($article->{id});
193 }
194
195 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
196
197 return $article->{parentid} && $parent &&
198 ($article->{parentid} == $shopid ||
199 $parent->{generator} eq 'Generate::Catalog');
200}
201
202sub possible_parents {
9168c88c 203 my ($self, $article, $articles, $req) = @_;
ca9aa2bf
TC
204
205 my %labels;
206 my @values;
207
208 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
209 my @parents = $articles->getBy('level', $article->{level}-1);
210 @parents = grep { $_->{generator} eq 'Generate::Article'
211 && $_->{id} != $shopid } @parents;
9168c88c
TC
212
213 # user can only select parent they can add to
214 @parents = grep $req->user_can('edit_add_child', $_), @parents;
ca9aa2bf
TC
215
216 @values = ( map {$_->{id}} @parents );
217 %labels = ( map { $_->{id} => "$_->{title} ($_->{id})" } @parents );
218
9168c88c 219 if ($article->{level} == 1 && $req->user_can('edit_add_child')) {
ca9aa2bf
TC
220 push @values, -1;
221 $labels{-1} = "No parent - this is a section";
222 }
223
224 if ($article->{id} && $self->reparent_updown($article)) {
225 # we also list the siblings and grandparent (if any)
226 my @siblings = grep $_->{id} != $article->{id} && $_->{id} != $shopid,
227 $articles->getBy(parentid => $article->{parentid});
9168c88c 228 @siblings = grep $req->user_can('edit_add_child', $_), @siblings;
ca9aa2bf
TC
229 push @values, map $_->{id}, @siblings;
230 @labels{map $_->{id}, @siblings} =
231 map { "-- move down a level -- $_->{title} ($_->{id})" } @siblings;
232
233 if ($article->{parentid} != -1) {
234 my $parent = $articles->getByPkey($article->{parentid});
235 if ($parent->{parentid} != -1) {
236 my $gparent = $articles->getByPkey($parent->{parentid});
9168c88c
TC
237 if ($req->user_can('edit_add_child', $gparent)) {
238 push @values, $gparent->{id};
239 $labels{$gparent->{id}} =
240 "-- move up a level -- $gparent->{title} ($gparent->{id})";
241 }
ca9aa2bf
TC
242 }
243 else {
9168c88c
TC
244 if ($req->user_can('edit_add_child')) {
245 push @values, -1;
246 $labels{-1} = "-- move up a level -- become a section";
247 }
ca9aa2bf
TC
248 }
249 }
250 }
251
252 return (\@values, \%labels);
253}
254
255sub tag_list {
9168c88c 256 my ($self, $article, $articles, $cgi, $req, $what) = @_;
ca9aa2bf
TC
257
258 if ($what eq 'listed') {
259 my @values = qw(0 1);
260 my %labels = ( 0=>"No", 1=>"Yes");
261 if ($article->{level} <= 2) {
262 $labels{2} = "In Sections, but not menu";
263 push(@values, 2);
264 }
265 else {
266 $labels{2} = "In content, but not menus";
267 push(@values, 2);
268 }
d09682dd
TC
269 return popup_menu(-name=>'listed',
270 -values=>\@values,
271 -labels=>\%labels,
272 -default=>$article->{listed});
ca9aa2bf
TC
273 }
274 else {
9168c88c 275 my ($values, $labels) = $self->possible_parents($article, $articles, $req);
ca9aa2bf
TC
276 my $html;
277 if (defined $article->{parentid}) {
d09682dd
TC
278 $html = popup_menu(-name=>'parentid',
279 -values=> $values,
280 -labels => $labels,
281 -default => $article->{parentid},
282 -override=>1);
ca9aa2bf
TC
283 }
284 else {
d09682dd
TC
285 $html = popup_menu(-name=>'parentid',
286 -values=> $values,
287 -labels => $labels,
288 -override=>1);
ca9aa2bf
TC
289 }
290
291 # munge the html - we display a default value, so we need to wrap the
292 # default <select /> around this one
293 $html =~ s!^<select[^>]+>|</select>!!gi;
294 return $html;
295 }
296}
297
298sub tag_checked {
299 my ($arg, $acts, $funcname, $templater) = @_;
300 my ($func, $args) = split ' ', $arg, 2;
301 return $templater->perform($acts, $func, $args) ? 'checked' : '';
302}
303
304sub iter_get_images {
daee3409 305 my ($self, $article) = @_;
ca9aa2bf
TC
306
307 $article->{id} or return;
daee3409 308 $self->get_images($article);
ca9aa2bf
TC
309}
310
311sub iter_get_kids {
312 my ($article, $articles) = @_;
313
15fb10f2 314 my @children;
ca9aa2bf
TC
315 $article->{id} or return;
316 if (UNIVERSAL::isa($article, 'Article')) {
15fb10f2 317 @children = $article->children;
ca9aa2bf
TC
318 }
319 elsif ($article->{id}) {
15fb10f2 320 @children = $articles->children($article->{id});
ca9aa2bf 321 }
15fb10f2
TC
322
323 return sort { $b->{displayOrder} <=> $a->{displayOrder} } @children;
ca9aa2bf
TC
324}
325
326sub tag_if_have_child_type {
327 my ($level, $cfg) = @_;
328
329 defined $cfg->entry("level names", $level+1);
330}
331
332sub tag_is {
333 my ($args, $acts, $isname, $templater) = @_;
334
335 my ($func, $funcargs) = split ' ', $args, 2;
336 return $templater->perform($acts, $func, $funcargs) ? 'Yes' : 'No';
337}
338
caa7299c
TC
339sub default_template {
340 my ($self, $article, $cfg, $templates) = @_;
341
342 if ($article->{parentid}) {
343 my $template = $cfg->entry("children of $article->{parentid}", "template");
344 return $template
345 if $template && grep $_ eq $template, @$templates;
346 }
347 if ($article->{level}) {
348 my $template = $cfg->entry("level $article->{level}", "template");
349 return $template
350 if $template && grep $_ eq $template, @$templates;
351 }
352 return $templates->[0];
353}
354
ca9aa2bf
TC
355sub tag_templates {
356 my ($self, $article, $cfg, $cgi) = @_;
357
358 my @templates = sort $self->templates($article);
359 my $default;
360 if ($article->{template} && grep $_ eq $article->{template}, @templates) {
361 $default = $article->{template};
362 }
363 else {
caa7299c
TC
364 my @options;
365 $default = $self->default_template($article, $cfg, \@templates);
ca9aa2bf 366 }
d09682dd
TC
367 return popup_menu(-name=>'template',
368 -values=>\@templates,
369 -default=>$default,
370 -override=>1);
ca9aa2bf
TC
371}
372
373sub title_images {
374 my ($self, $article) = @_;
375
376 my @title_images;
ab2cd916 377 my $imagedir = cfg_image_dir($self->{cfg});
ca9aa2bf
TC
378 if (opendir TITLE_IMAGES, "$imagedir/titles") {
379 @title_images = sort
380 grep -f "$imagedir/titles/$_" && /\.(gif|jpeg|jpg|png)$/i,
381 readdir TITLE_IMAGES;
382 closedir TITLE_IMAGES;
383 }
384
385 @title_images;
386}
387
388sub tag_title_images {
389 my ($self, $article, $cfg, $cgi) = @_;
390
391 my @images = $self->title_images($article);
392 my @values = ( '', @images );
393 my %labels = ( '' => 'None', map { $_ => $_ } @images );
394 return $cgi->
395 popup_menu(-name=>'titleImage',
396 -values=>\@values,
397 -labels=>\%labels,
398 -default=>$article->{id} ? $article->{titleImage} : '',
399 -override=>1);
400}
401
402sub base_template_dirs {
403 return ( "common" );
404}
405
406sub template_dirs {
407 my ($self, $article) = @_;
408
409 my @dirs = $self->base_template_dirs;
410 if (my $parentid = $article->{parentid}) {
411 my $section = "children of $parentid";
412 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
413 push @dirs, split /,/, $dirs;
414 }
415 }
416 if (my $id = $article->{id}) {
417 my $section = "article $id";
418 if (my $dirs = $self->{cfg}->entry($section, 'template_dirs')) {
419 push @dirs, split /,/, $dirs;
420 }
421 }
caa7299c
TC
422 if ($article->{level}) {
423 push @dirs, $article->{level};
424 my $dirs = $self->{cfg}->entry("level $article->{level}", 'template_dirs');
425 push @dirs, split /,/, $dirs if $dirs;
426 }
ca9aa2bf
TC
427
428 @dirs;
429}
430
431sub templates {
432 my ($self, $article) = @_;
433
434 my @dirs = $self->template_dirs($article);
435 my @templates;
918735d1
TC
436 my @basedirs = BSE::Template->template_dirs($self->{cfg});
437 for my $basedir (@basedirs) {
438 for my $dir (@dirs) {
439 my $path = File::Spec->catdir($basedir, $dir);
440 if (-d $path) {
441 if (opendir TEMPLATE_DIR, $path) {
442 push(@templates, sort map "$dir/$_",
443 grep -f "$path/$_" && /\.(tmpl|html)$/i, readdir TEMPLATE_DIR);
444 closedir TEMPLATE_DIR;
445 }
ca9aa2bf
TC
446 }
447 }
448 }
918735d1
TC
449
450 # eliminate any dups, and order it nicely
451 my %seen;
452 @templates = sort { lc($a) cmp lc($b) }
453 grep !$seen{$_}++, @templates;
454
ca9aa2bf
TC
455 return (@templates, $self->extra_templates($article));
456}
457
458sub extra_templates {
459 my ($self, $article) = @_;
460
aefcabcb 461 my $basedir = $self->{cfg}->entryVar('paths', 'templates');
ca9aa2bf
TC
462 my @templates;
463 if (my $id = $article->{id}) {
464 push @templates, 'index.tmpl'
465 if $id == 1 && -f "$basedir/index.html";
466 push @templates, 'index2.tmpl'
467 if $id == 2 && -f "$basedir/index2.html";
468 my $shopid = $self->{cfg}->entryErr('articles', 'shop');
469 push @templates, "shop_sect.tmpl"
470 if $id == $shopid && -f "$basedir/shop_sect.tmpl";
471 my $section = "article $id";
472 my $extras = $self->{cfg}->entry($section, 'extra_templates');
473 push @templates, grep /\.(tmpl|html)$/i, split /,/, $extras
474 if $extras;
475 }
476
477 @templates;
478}
479
480sub edit_parent {
481 my ($article) = @_;
482
483 return '' unless $article->{id} && $article->{id} != -1;
484 return <<HTML;
485<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
486HTML
487}
488
489sub iter_allkids {
490 my ($article) = @_;
491
492 return unless $article->{id} && $article->{id} > 0;
493 $article->allkids;
494}
495
496sub _load_step_kids {
497 my ($article, $step_kids) = @_;
498
499 my @stepkids = OtherParents->getBy(parentId=>$article->{id}) if $article->{id};
500 %$step_kids = map { $_->{childId} => $_ } @stepkids;
ca9aa2bf
TC
501 $step_kids->{loaded} = 1;
502}
503
504sub tag_if_step_kid {
505 my ($article, $allkids, $rallkid_index, $step_kids) = @_;
506
507 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
508
509 my $kid = $allkids->[$$rallkid_index]
510 or return;
511 exists $step_kids->{$kid->{id}};
512}
513
514sub tag_step_kid {
515 my ($article, $allkids, $rallkid_index, $step_kids, $arg) = @_;
516
517 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
518
519 my $kid = $allkids->[$$rallkid_index]
520 or return '';
f0543260
TC
521 my $step_kid = $step_kids->{$kid->{id}}
522 or return '';
523 #use Data::Dumper;
524 #print STDERR "found kid (want $arg): ", Dumper($kid), Dumper($step_kid);
525 escape_html($step_kid->{$arg});
ca9aa2bf
TC
526}
527
528sub tag_move_stepkid {
8b0b2f34
TC
529 my ($self, $cgi, $req, $article, $allkids, $rallkids_index, $arg,
530 $acts, $funcname, $templater) = @_;
31a26b52
TC
531
532 $req->user_can(edit_reorder_children => $article)
533 or return '';
ca9aa2bf 534
aefcabcb
TC
535 @$allkids > 1 or return '';
536
8b0b2f34
TC
537 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
538 $img_prefix = '' unless defined $img_prefix;
539 $urladd = '' unless defined $urladd;
540
ca9aa2bf 541 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
ca9aa2bf
TC
542 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
543 if ($cgi->param('_t')) {
544 $url .= "&_t=".$cgi->param('_t');
545 }
8b0b2f34 546 $url .= $urladd;
ca9aa2bf 547 $url .= "#step";
d09682dd 548 my $down_url = '';
ca9aa2bf 549 if ($$rallkids_index < $#$allkids) {
d09682dd 550 $down_url = "$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index+1]{id}";
aefcabcb 551 }
d09682dd 552 my $up_url = '';
ca9aa2bf 553 if ($$rallkids_index > 0) {
d09682dd 554 $up_url = "$cgi_uri/admin/move.pl?stepparent=$article->{id}&d=swap&id=$allkids->[$$rallkids_index]{id}&other=$allkids->[$$rallkids_index-1]{id}";
ca9aa2bf 555 }
d09682dd
TC
556
557 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
558}
559
560sub possible_stepkids {
31a26b52
TC
561 my ($req, $article, $articles, $stepkids) = @_;
562
563 $req->user_can(edit_stepkid_add => $article)
564 or return;
ca9aa2bf 565
31a26b52 566 my @possible = sort { lc $a->{title} cmp lc $b->{title} }
de30d08a 567 grep !$stepkids->{$_->{id}} && $_->{id} != $article->{id}, $articles->all;
31a26b52
TC
568 if ($req->access_control) {
569 @possible = grep $req->user_can(edit_stepparent_add => $_), @possible;
570 }
571 return @possible;
ca9aa2bf
TC
572}
573
ca9aa2bf 574sub tag_possible_stepkids {
31a26b52 575 my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
ca9aa2bf
TC
576
577 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
31a26b52 578 @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
ca9aa2bf
TC
579 unless @$possstepkids;
580 my %labels = map { $_->{id} => "$_->{title} ($_->{id})" } @$possstepkids;
581 return
d09682dd
TC
582 popup_menu(-name=>'stepkid',
583 -values=> [ map $_->{id}, @$possstepkids ],
584 -labels => \%labels);
ca9aa2bf
TC
585}
586
587sub tag_if_possible_stepkids {
31a26b52 588 my ($step_kids, $req, $article, $possstepkids, $articles, $cgi) = @_;
ca9aa2bf
TC
589
590 _load_step_kids($article, $step_kids) unless $step_kids->{loaded};
31a26b52 591 @$possstepkids = possible_stepkids($req, $article, $articles, $step_kids)
ca9aa2bf
TC
592 unless @$possstepkids;
593
594 @$possstepkids;
595}
596
597sub iter_get_stepparents {
598 my ($article) = @_;
599
600 return unless $article->{id} && $article->{id} > 0;
601
602 OtherParents->getBy(childId=>$article->{id});
603}
604
605sub tag_ifStepParents {
606 my ($args, $acts, $funcname, $templater) = @_;
607
608 return $templater->perform($acts, 'ifStepparents', '');
609}
610
611sub tag_stepparent_targ {
612 my ($article, $targs, $rindex, $arg) = @_;
613
614 if ($article->{id} && $article->{id} > 0 && !@$targs) {
615 @$targs = $article->step_parents;
616 }
77804754 617 escape_html($targs->[$$rindex]{$arg});
ca9aa2bf
TC
618}
619
620sub tag_move_stepparent {
8b0b2f34
TC
621 my ($self, $cgi, $req, $article, $stepparents, $rindex, $arg,
622 $acts, $funcname, $templater) = @_;
31a26b52
TC
623
624 $req->user_can(edit_reorder_stepparents => $article)
625 or return '';
ca9aa2bf 626
aefcabcb
TC
627 @$stepparents > 1 or return '';
628
8b0b2f34
TC
629 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
630 $img_prefix = '' unless defined $img_prefix;
631 $urladd = '' unless defined $urladd;
632
ca9aa2bf
TC
633 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
634 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
635 my $html = '';
636 my $url = $ENV{SCRIPT_NAME} . "?id=$article->{id}";
637 if ($cgi->param('_t')) {
638 $url .= "&_t=".$cgi->param('_t');
639 }
8b0b2f34 640 $url .= $urladd;
ca9aa2bf 641 $url .= "#stepparents";
d794b180 642 my $blank = qq!<img src="$images_uri/trans_pixel.gif" width="17" height="13" border="0" align="absbottom" alt="" />!;
d09682dd 643 my $down_url = '';
ca9aa2bf 644 if ($$rindex < $#$stepparents) {
d09682dd 645 $down_url = "$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex+1]{parentId}";
aefcabcb 646 }
d09682dd 647 my $up_url = '';
ca9aa2bf 648 if ($$rindex > 0) {
d09682dd 649 $up_url = "$cgi_uri/admin/move.pl?stepchild=$article->{id}&id=$stepparents->[$$rindex]{parentId}&d=swap&other=$stepparents->[$$rindex-1]{parentId}";
aefcabcb 650 }
d09682dd
TC
651
652 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
653}
654
de193691
TC
655sub _stepparent_possibles {
656 my ($req, $article, $articles, $targs) = @_;
657
658 $req->user_can(edit_stepparent_add => $article)
659 or return;
660
661 @$targs = $article->step_parents unless @$targs;
662 my %targs = map { $_->{id}, 1 } @$targs;
de30d08a
TC
663 my @possibles = grep !$targs{$_->{id}} && $_->{id} != $article->{id},
664 $articles->all;
de193691
TC
665 if ($req->access_control) {
666 @possibles = grep $req->user_can(edit_stepkid_add => $_), @possibles;
667 }
668 @possibles = sort { lc $a->{title} cmp lc $b->{title} } @possibles;
669
670 return @possibles;
671}
672
ca9aa2bf 673sub tag_if_stepparent_possibles {
31a26b52 674 my ($req, $article, $articles, $targs, $possibles) = @_;
ca9aa2bf 675
de193691
TC
676 if ($article->{id} && $article->{id} > 0 && !@$possibles) {
677 @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
ca9aa2bf
TC
678 }
679 scalar @$possibles;
680}
681
682sub tag_stepparent_possibles {
31a26b52 683 my ($cgi, $req, $article, $articles, $targs, $possibles) = @_;
ca9aa2bf 684
de193691
TC
685 if ($article->{id} && $article->{id} > 0 && !@$possibles) {
686 @$possibles = _stepparent_possibles($req, $article, $articles, $targs);
ca9aa2bf 687 }
d09682dd
TC
688 popup_menu(-name=>'stepparent',
689 -values => [ map $_->{id}, @$possibles ],
690 -labels => { map { $_->{id}, "$_->{title} ($_->{id})" }
691 @$possibles });
ca9aa2bf
TC
692}
693
694sub iter_files {
695 my ($article) = @_;
696
697 return unless $article->{id} && $article->{id} > 0;
698
699 return $article->files;
700}
701
702sub tag_edit_parent {
703 my ($article) = @_;
704
705 return '' unless $article->{id} && $article->{id} != -1;
706
707 return <<HTML;
708<a href="$ENV{SCRIPT_NAME}?id=$article->{parentid}">Edit parent</a> |
709HTML
710}
711
712sub tag_if_children {
713 my ($args, $acts, $funcname, $templater) = @_;
714
715 return $templater->perform($acts, 'ifChildren', '');
716}
717
718sub tag_movechild {
8b0b2f34
TC
719 my ($self, $req, $article, $kids, $rindex, $arg,
720 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
721
722 $req->user_can('edit_reorder_children', $article)
723 or return '';
ca9aa2bf 724
aefcabcb
TC
725 @$kids > 1 or return '';
726
ca9aa2bf
TC
727 $$rindex >=0 && $$rindex < @$kids
728 or return '** movechild can only be used in the children iterator **';
729
8b0b2f34
TC
730 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
731 $img_prefix = '' unless defined $img_prefix;
732 $urladd = '' unless defined $urladd;
733
ca9aa2bf
TC
734 my $cgi_uri = $self->{cfg}->entry('uri', 'cgi', '/cgi-bin');
735 my $images_uri = $self->{cfg}->entry('uri', 'images', '/images');
41f10371 736 my $urlbase = admin_base_url($req->cfg);
d09682dd 737 my $refresh_url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
cc9019d1
TC
738 my $t = $req->cgi->param('_t');
739 if ($t && $t =~ /^\w+$/) {
d09682dd 740 $refresh_url .= "&_t=$t";
cc9019d1 741 }
d09682dd
TC
742
743 $refresh_url .= $urladd;
744
ca9aa2bf 745 my $id = $kids->[$$rindex]{id};
d09682dd 746 my $down_url = '';
ca9aa2bf 747 if ($$rindex < $#$kids) {
d09682dd 748 $down_url = "$cgi_uri/admin/move.pl?id=$id&d=down&edit=1&all=1";
ca9aa2bf 749 }
d09682dd 750 my $up_url = '';
ca9aa2bf 751 if ($$rindex > 0) {
d09682dd 752 $up_url = "$cgi_uri/admin/move.pl?id=$id&d=up&edit=1&all=1"
ca9aa2bf 753 }
ca9aa2bf 754
d09682dd 755 return make_arrows($req->cfg, $down_url, $up_url, $refresh_url, $img_prefix);
ca9aa2bf
TC
756}
757
758sub tag_edit_link {
f2bf0d11 759 my ($cfg, $article, $args, $acts, $funcname, $templater) = @_;
ca9aa2bf
TC
760 my ($which, $name) = split / /, $args, 2;
761 $name ||= 'Edit';
762 my $gen_class;
763 if ($acts->{$which}
764 && ($gen_class = $templater->perform($acts, $which, 'generator'))) {
765 eval "use $gen_class";
766 unless ($@) {
f2bf0d11 767 my $gen = $gen_class->new(top => $article, cfg => $cfg);
ca9aa2bf
TC
768 my $link = $gen->edit_link($templater->perform($acts, $which, 'id'));
769 return qq!<a href="$link">$name</a>!;
770 }
771 }
772 return '';
773}
774
775sub tag_imgmove {
8b0b2f34
TC
776 my ($req, $article, $rindex, $images, $arg,
777 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
778
779 $req->user_can(edit_images_reorder => $article)
780 or return '';
ca9aa2bf 781
aefcabcb
TC
782 @$images > 1 or return '';
783
ca9aa2bf
TC
784 $$rindex >= 0 && $$rindex < @$images
785 or return '** imgmove can only be used in image iterator **';
786
8b0b2f34
TC
787 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
788 $img_prefix = '' unless defined $img_prefix;
789 $urladd = '' unless defined $urladd;
790
41f10371 791 my $urlbase = admin_base_url($req->cfg);
cc9019d1
TC
792 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}";
793 my $t = $req->cgi->param('_t');
794 if ($t && $t =~ /^\w+$/) {
795 $url .= "&_t=$t";
796 }
797 $url .= $urladd;
8b0b2f34 798
ca9aa2bf 799 my $image = $images->[$$rindex];
d09682dd 800 my $down_url;
ca9aa2bf 801 if ($$rindex < $#$images) {
d09682dd 802 $down_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgdown=1&imageid=$image->{id}";
ca9aa2bf 803 }
d09682dd
TC
804 my $up_url = '';
805 if ($$rindex > 0) {
806 $up_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&moveimgup=1&imageid=$image->{id}";
ca9aa2bf 807 }
d09682dd 808 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
809}
810
811sub tag_movefiles {
8b0b2f34
TC
812 my ($self, $req, $article, $files, $rindex, $arg,
813 $acts, $funcname, $templater) = @_;
abf5bbc6
TC
814
815 $req->user_can('edit_files_reorder', $article)
816 or return '';
ca9aa2bf 817
aefcabcb
TC
818 @$files > 1 or return '';
819
8b0b2f34
TC
820 my ($img_prefix, $urladd) = DevHelp::Tags->get_parms($arg, $acts, $templater);
821 $img_prefix = '' unless defined $img_prefix;
822 $urladd = '' unless defined $urladd;
823
ca9aa2bf
TC
824 $$rindex >= 0 && $$rindex < @$files
825 or return '** movefiles can only be used in the files iterator **';
826
41f10371 827 my $urlbase = admin_base_url($req->cfg);
9063386f
TC
828 my $url = "$urlbase$ENV{SCRIPT_NAME}?id=$article->{id}$urladd";
829 my $t = $req->cgi->param('_t');
830 if ($t && $t =~ /^\w+$/) {
831 $url .= "&_t=$t";
832 }
d09682dd
TC
833
834 my $down_url = "";
ca9aa2bf 835 if ($$rindex < $#$files) {
d09682dd 836 $down_url = "$ENV{SCRIPT_NAME}?fileswap=1&amp;id=$article->{id}&amp;file1=$files->[$$rindex]{id}&amp;file2=$files->[$$rindex+1]{id}";
ca9aa2bf 837 }
d09682dd 838 my $up_url = "";
ca9aa2bf 839 if ($$rindex > 0) {
d09682dd 840 $up_url = "$ENV{SCRIPT_NAME}?fileswap=1&amp;id=$article->{id}&amp;file1=$files->[$$rindex]{id}&amp;file2=$files->[$$rindex-1]{id}";
ca9aa2bf 841 }
d09682dd
TC
842
843 return make_arrows($req->cfg, $down_url, $up_url, $url, $img_prefix);
ca9aa2bf
TC
844}
845
846sub tag_old {
847 my ($article, $cgi, $args, $acts, $funcname, $templater) = @_;
848
849 my ($col, $func, $funcargs) = split ' ', $args, 3;
850 my $value = $cgi->param($col);
851 if (defined $value) {
77804754 852 return escape_html($value);
ca9aa2bf
TC
853 }
854 else {
855 if ($func) {
856 return $templater->perform($acts, $func, $funcargs);
857 }
858 else {
859 $value = $article->{$args};
860 defined $value or $value = '';
77804754 861 return escape_html($value);
ca9aa2bf
TC
862 }
863 }
864}
865
08123550
TC
866sub iter_admin_users {
867 require BSE::TB::AdminUsers;
868
869 BSE::TB::AdminUsers->all;
870}
871
872sub iter_admin_groups {
873 require BSE::TB::AdminGroups;
874
875 BSE::TB::AdminGroups->all;
876}
877
9168c88c
TC
878sub tag_if_field_perm {
879 my ($req, $article, $field) = @_;
880
abf5bbc6
TC
881 unless ($field =~ /^\w+$/) {
882 print STDERR "Bad fieldname '$field'\n";
883 return;
884 }
9168c88c 885 if ($article->{id}) {
abf5bbc6 886 return $req->user_can("edit_field_edit_$field", $article);
9168c88c
TC
887 }
888 else {
4010d92e 889 #print STDERR "adding, always successful\n";
abf5bbc6 890 return 1;
9168c88c
TC
891 }
892}
893
894sub tag_default {
895 my ($self, $req, $article, $args, $acts, $funcname, $templater) = @_;
896
897 my ($col, $func, $funcargs) = split ' ', $args, 3;
898 if ($article->{id}) {
899 if ($func) {
900 return $templater->perform($acts, $func, $funcargs);
901 }
902 else {
903 my $value = $article->{$args};
904 defined $value or $value = '';
77804754 905 return escape_html($value);
9168c88c
TC
906 }
907 }
908 else {
909 my $value = $self->default_value($req, $article, $col);
0ec4ac8a 910 defined $value or $value = '';
77804754 911 return escape_html($value);
9168c88c
TC
912 }
913}
914
918735d1
TC
915sub iter_flags {
916 my ($self) = @_;
917
918 $self->flags;
919}
920
921sub tag_if_flag_set {
922 my ($article, $arg, $acts, $funcname, $templater) = @_;
923
924 my @args = DevHelp::Tags->get_parms($arg, $acts, $templater);
925 @args or return;
926
927 return index($article->{flags}, $args[0]) >= 0;
928}
929
8b0b2f34
TC
930sub iter_crumbs {
931 my ($article, $articles) = @_;
932
933 my @crumbs;
934 my $temp = $article;
935 defined($temp->{parentid}) or return;
936 while ($temp->{parentid} > 0
937 and my $crumb = $articles->getByPkey($temp->{parentid})) {
938 unshift @crumbs, $crumb;
939 $temp = $crumb;
940 }
941
942 @crumbs;
943}
944
945sub tag_typename {
946 my ($args, $acts, $funcname, $templater) = @_;
947
948 exists $acts->{$args} or return "** need an article name **";
949 my $generator = $templater->perform($acts, $args, 'generator');
950
951 $generator =~ /^(?:BSE::)?Generate::(\w+)$/
952 or return "** invalid generator $generator **";
953
954 return $1;
955}
956
ab2cd916
TC
957sub _get_thumbs_class {
958 my ($self) = @_;
959
960 $self->{cfg}->entry('editor', 'allow_thumb', 0)
961 or return;
962
963 my $class = $self->{cfg}->entry('editor', 'thumbs_class')
964 or return;
965
966 (my $filename = "$class.pm") =~ s!::!/!g;
967 eval { require $filename; };
968 if ($@) {
969 print STDERR "** Error loading thumbs_class $class ($filename): $@\n";
970 return;
971 }
972 my $obj;
973 eval { $obj = $class->new($self->{cfg}) };
974 if ($@) {
975 print STDERR "** Error creating thumbs objects $class: $@\n";
976 return;
977 }
978
979 return $obj;
980}
981
982sub tag_thumbimage {
983 my ($cfg, $thumbs_obj, $current_image, $args) = @_;
984
6a8a6ac5
TC
985 $thumbs_obj or return '';
986
ab2cd916
TC
987 $$current_image or return '** no current image **';
988
989 my $imagedir = cfg_image_dir($cfg);
990
991 my $filename = "$imagedir/$$current_image->{image}";
992 -e $filename or return "** image file missing **";
993
994 my ($max_width, $max_height, $max_pixels) = split ' ', $args;
995 defined $max_width && $max_width eq '-' and undef $max_width;
996 defined $max_height && $max_height eq '-' and undef $max_height;
997 defined $max_pixels && $max_pixels eq '-' and undef $max_pixels;
998
999 my ($use_orig, $width, $height) = $thumbs_obj->thumb_dimensions
1000 ($filename, $$current_image, $max_width, $max_height, $max_pixels);
1001
1002
1003 my ($uri, $alt);
1004 if ($use_orig) {
1005 $alt = $$current_image->{alt};
1006 $uri = "/images/$$current_image->{image}";
1007 }
1008 elsif ($width) {
1009 $alt = "thumbnail of ".$$current_image->{alt};
1010 $uri = "$ENV{SCRIPT_NAME}?a_thumb=1&id=$$current_image->{articleId}&im=$$current_image->{id}&w=$width&h=$height";
1011 }
1012 else {
1013 # link to the default thumbnail
1014 $uri = $cfg->entry('editor', 'default_thumbnail', '/images/admin/nothumb.png');
1015 $width = $cfg->entry('editor', 'default_thumbnail_width', 100);
1016 $height = $cfg->entry('editor', 'default_thumbnail_height', 100);
1017 $alt = $cfg->entry('editor', 'default_thumbnail_alt',
1018 "no thumbnail available");
1019 }
1020
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
1144 ([ \&iter_files, $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
TC
1456 $self->fill_new_data($req, \%data, $articles);
1457 for my $col (qw(titleImage imagePos template keyword)) {
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
ca9aa2bf
TC
2167 my $cgi = $req->cgi;
2168 my $image_pos = $cgi->param('imagePos');
2169 if ($image_pos
2170 && $image_pos =~ /^(?:tl|tr|bl|br)$/
2171 && $image_pos ne $article->{imagePos}) {
2172 $article->{imagePos} = $image_pos;
2173 $article->save;
2174 }
daee3409 2175 my @images = $self->get_images($article);
4772671f
TC
2176
2177 @images or
2178 return $self->refresh($article, $cgi, undef, 'No images to save information for');
ca9aa2bf
TC
2179
2180 my $changed;
2181 my @alt = $cgi->param('alt');
2182 if (@alt) {
2183 ++$changed;
2184 for my $index (0..$#images) {
2185 $index < @alt or last;
2186 $images[$index]{alt} = $alt[$index];
2187 }
2188 }
2189 my @urls = $cgi->param('url');
2190 if (@urls) {
2191 ++$changed;
2192 for my $index (0..$#images) {
2193 $index < @urls or next;
2194 $images[$index]{url} = $urls[$index];
2195 }
2196 }
4772671f
TC
2197 my %errors;
2198 my @names = map scalar($cgi->param('name'.$_)), 0..$#images;
2199 if (@names) {
2200 # make sure there aren't any dups
2201 my %used;
2202 my $index = 0;
2203 for my $name (@names) {
2204 defined $name or $name = '';
2205 if ($name ne '') {
2206 if ($name =~ /^[a-z_]\w*$/i) {
2207 if ($used{lc $name}++) {
29993428 2208 $errors{"name$index"} = 'Image name must be unique to the article';
4772671f
TC
2209 }
2210 }
2211 else {
29993428 2212 $errors{"name$index"} = 'Image name must be empty or alphanumeric and unique to the article';
4772671f
TC
2213 }
2214 }
daee3409
TC
2215 unless ($errors{"name$index"}) {
2216 my $msg;
2217 $self->validate_image_name($name, \$msg)
2218 or $errors{"name$index"} = $msg;
2219 }
2220
4772671f
TC
2221 ++$index;
2222 }
2223 }
2224 keys %errors
2225 and return $self->edit_form($req, $article, $articles, undef,
2226 \%errors);
2227 for my $index (0..$#images) {
2228 $images[$index]{name} = $names[$index];
2229 }
ca9aa2bf
TC
2230 if ($changed) {
2231 for my $image (@images) {
2232 $image->save;
2233 }
2234 }
a0a8147b
TC
2235
2236 use Util 'generate_article';
2237 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2238
cc9019d1 2239 return $self->refresh($article, $cgi, undef, 'Image information saved');
ca9aa2bf
TC
2240}
2241
2242sub add_image {
2243 my ($self, $req, $article, $articles) = @_;
2244
abf5bbc6 2245 $req->user_can(edit_images_add => $article)
cc9019d1 2246 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2247 "You don't have access to add new images to this article");
2248
ca9aa2bf
TC
2249 my $cgi = $req->cgi;
2250
4772671f
TC
2251 my %errors;
2252 my $msg;
2253 my $imageref = $cgi->param('name');
d794b180 2254 if (defined $imageref && $imageref ne '') {
4772671f
TC
2255 if ($imageref =~ /^[a-z_]\w+$/i) {
2256 # make sure it's unique
daee3409 2257 my @images = $self->get_images($article);
4772671f
TC
2258 for my $img (@images) {
2259 if (defined $img->{name} && lc $img->{name} eq lc $imageref) {
9604a90c 2260 $errors{name} = 'Image name must be unique to the article';
4772671f
TC
2261 last;
2262 }
2263 }
2264 }
2265 else {
9604a90c 2266 $errors{name} = 'Image name must be empty or alphanumeric beginning with an alpha character';
4772671f
TC
2267 }
2268 }
2269 else {
2270 $imageref = '';
2271 }
daee3409 2272 unless ($errors{name}) {
d09682dd
TC
2273 my $workmsg;
2274 $self->validate_image_name($imageref, \$workmsg)
2275 or $errors{name} = $workmsg;
daee3409 2276 }
4772671f 2277
ca9aa2bf 2278 my $image = $cgi->param('image');
4772671f
TC
2279 if ($image) {
2280 if (-z $image) {
2281 $errors{image} = 'Image file is empty';
2282 }
ca9aa2bf 2283 }
4772671f 2284 else {
d09682dd 2285 #$msg = 'Enter or select the name of an image file on your machine';
4772671f
TC
2286 $errors{image} = 'Please enter an image filename';
2287 }
2288 if ($msg || keys %errors) {
2289 return $self->edit_form($req, $article, $articles, $msg, \%errors);
ca9aa2bf 2290 }
4772671f 2291
ca9aa2bf
TC
2292 my $imagename = $image;
2293 $imagename .= ''; # force it into a string
2294 my $basename = '';
2295 $imagename =~ /([\w.-]+)$/ and $basename = $1;
2296
2297 # create a filename that we hope is unique
2298 my $filename = time. '_'. $basename;
2299
2300 # for the sysopen() constants
2301 use Fcntl;
2302
ab2cd916 2303 my $imagedir = cfg_image_dir($req->cfg);
ca9aa2bf
TC
2304 # loop until we have a unique filename
2305 my $counter="";
2306 $filename = time. '_' . $counter . '_' . $basename
2307 until sysopen( OUTPUT, "$imagedir/$filename", O_WRONLY| O_CREAT| O_EXCL)
2308 || ++$counter > 100;
2309
2310 fileno(OUTPUT) or die "Could not open image file: $!";
2311
2312 # for OSs with special text line endings
2313 binmode OUTPUT;
2314
2315 my $buffer;
2316
2317 no strict 'refs';
2318
2319 # read the image in from the browser and output it to our output filehandle
2320 print OUTPUT $buffer while read $image, $buffer, 1024;
2321
2322 # close and flush
2323 close OUTPUT
2324 or die "Could not close image file $filename: $!";
2325
2326 use Image::Size;
2327
2328
2329 my($width,$height) = imgsize("$imagedir/$filename");
2330
2331 my $alt = $cgi->param('altIn');
2332 defined $alt or $alt = '';
2333 my $url = $cgi->param('url');
2334 defined $url or $url = '';
2335 my %image =
2336 (
2337 articleId => $article->{id},
2338 image => $filename,
2339 alt=>$alt,
2340 width=>$width,
2341 height => $height,
2342 url => $url,
2343 displayOrder=>time,
4772671f 2344 name => $imageref,
ca9aa2bf
TC
2345 );
2346 require Images;
2347 my @cols = Image->columns;
2348 shift @cols;
2349 my $imageobj = Images->add(@image{@cols});
a0a8147b
TC
2350
2351 use Util 'generate_article';
2352 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2353
cc9019d1 2354 return $self->refresh($article, $cgi, undef, 'New image added');
ca9aa2bf
TC
2355}
2356
2357# remove an image
2358sub remove_img {
2359 my ($self, $req, $article, $articles, $imageid) = @_;
2360
abf5bbc6 2361 $req->user_can(edit_images_delete => $article)
cc9019d1 2362 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2363 "You don't have access to delete images from this article");
2364
ca9aa2bf
TC
2365 $imageid or die;
2366
daee3409 2367 my @images = $self->get_images($article);
ca9aa2bf
TC
2368 my ($image) = grep $_->{id} == $imageid, @images
2369 or return $self->show_images($req, $article, $articles, "No such image");
ab2cd916 2370 my $imagedir = cfg_image_dir($req->cfg);
6473c56f 2371 unlink "$imagedir$image->{image}";
ca9aa2bf
TC
2372 $image->remove;
2373
a0a8147b
TC
2374 use Util 'generate_article';
2375 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2376
cc9019d1 2377 return $self->refresh($article, $req->cgi, undef, 'Image removed');
ca9aa2bf
TC
2378}
2379
2380sub move_img_up {
2381 my ($self, $req, $article, $articles) = @_;
2382
abf5bbc6 2383 $req->user_can(edit_images_reorder => $article)
cc9019d1 2384 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2385 "You don't have access to reorder images in this article");
2386
ca9aa2bf 2387 my $imageid = $req->cgi->param('imageid');
daee3409 2388 my @images = $self->get_images($article);
ca9aa2bf 2389 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 2390 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 2391 $imgindex > 0
cc9019d1 2392 or return $self->edit_form($req, $article, $articles, "Image is already at the top");
ca9aa2bf
TC
2393 my ($to, $from) = @images[$imgindex-1, $imgindex];
2394 ($to->{displayOrder}, $from->{displayOrder}) =
2395 ($from->{displayOrder}, $to->{displayOrder});
2396 $to->save;
2397 $from->save;
2398
a0a8147b
TC
2399 use Util 'generate_article';
2400 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2401
cc9019d1 2402 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
2403}
2404
2405sub move_img_down {
2406 my ($self, $req, $article, $articles) = @_;
2407
abf5bbc6 2408 $req->user_can(edit_images_reorder => $article)
cc9019d1 2409 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2410 "You don't have access to reorder images in this article");
2411
ca9aa2bf 2412 my $imageid = $req->cgi->param('imageid');
daee3409 2413 my @images = $self->get_images($article);
ca9aa2bf 2414 my ($imgindex) = grep $images[$_]{id} == $imageid, 0..$#images
cc9019d1 2415 or return $self->edit_form($req, $article, $articles, "No such image");
ca9aa2bf 2416 $imgindex < $#images
cc9019d1 2417 or return $self->edit_form($req, $article, $articles, "Image is already at the end");
ca9aa2bf
TC
2418 my ($to, $from) = @images[$imgindex+1, $imgindex];
2419 ($to->{displayOrder}, $from->{displayOrder}) =
2420 ($from->{displayOrder}, $to->{displayOrder});
2421 $to->save;
2422 $from->save;
2423
a0a8147b
TC
2424 use Util 'generate_article';
2425 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2426
cc9019d1 2427 return $self->refresh($article, $req->cgi, undef, 'Image moved');
ca9aa2bf
TC
2428}
2429
ab2cd916
TC
2430sub req_thumb {
2431 my ($self, $req, $article) = @_;
2432
2433 my $cgi = $req->cgi;
2434 my $cfg = $req->cfg;
2435 my $im_id = $cgi->param('im');
2436 my $image;
2437 if (defined $im_id && $im_id =~ /^\d+$/) {
6a8a6ac5 2438 ($image) = grep $_->{id} == $im_id, $self->get_images($article);
ab2cd916
TC
2439 }
2440 my $thumb_obj = $self->_get_thumbs_class();
2441 my ($data, $type);
2442 if ($image && $thumb_obj) {
2443 my $width = $cgi->param('w');
2444 my $height = $cgi->param('h');
2445 my $pixels = $cgi->param('p');
2446 my $imagedir = $cfg->entry('paths', 'images', $Constants::IMAGEDIR);
2447
2448 ($type, $data) = $thumb_obj->
2449 thumb_data("$imagedir/$image->{image}", $image, $width, $height,
2450 $pixels);
2451 }
2452
2453 if ($type && $data) {
2454
2455 return
2456 {
2457 type => $type,
2458 content => $data,
2459 headers => [
2460 "Content-Length: ".length($data),
2461 "Cache-Control: max-age=3600",
2462 ],
2463 };
2464 }
2465 else {
2466 # grab the nothumb image
2467 my $uri = $cfg->entry('editor', 'default_thumbnail', '/images/admin/nothumb.png');
2468 my $filebase = $Constants::CONTENTBASE;
2469 if (open IMG, "<$filebase/$uri") {
2470 binmode IMG;
2471 my $data = do { local $/; <IMG> };
2472 close IMG;
2473 my $type = $uri =~ /\.(\w+)$/ ? $1 : 'png';
2474 return
2475 {
2476 type => "image/$type",
2477 content => $data,
2478 headers => [ "Content-Length: ".length($data) ],
2479 };
2480 }
2481 else {
2482 return
2483 {
2484 type=>"text/html",
2485 content => "<html><body>Cannot make thumb or default image</body></html>",
2486 };
2487 }
2488 }
2489}
2490
ca9aa2bf
TC
2491sub get_article {
2492 my ($self, $articles, $article) = @_;
2493
2494 return $article;
2495}
2496
2497sub table_object {
2498 my ($self, $articles) = @_;
2499
2500 $articles;
2501}
2502
2503my %types =
2504 (
2505 qw(
6a8a6ac5
TC
2506 bash text/plain
2507 css text/css
2508 csv text/plain
2509 diff text/plain
ca9aa2bf
TC
2510 htm text/html
2511 html text/html
6a8a6ac5
TC
2512 ics text/calendar
2513 patch text/plain
2514 pl text/plain
2515 pm text/plain
2516 pod text/plain
2517 py text/plain
ad48b8d4
TC
2518 sgm text/sgml
2519 sgml text/sgml
6a8a6ac5
TC
2520 sh text/plain
2521 tcsh text/plain
2522 text text/plain
ad48b8d4 2523 tsv text/tab-separated-values
6a8a6ac5
TC
2524 txt text/plain
2525 vcf text/x-vcard
2526 vcs text/x-vcalendar
2527 xml text/xml
4a8db683 2528 zsh text/plain
6a8a6ac5 2529 bmp image/bmp
ca9aa2bf 2530 gif image/gif
ad48b8d4 2531 jp2 image/jpeg2000
6a8a6ac5
TC
2532 jpeg image/jpeg
2533 jpg image/jpeg
2534 pct image/pict
2535 pict image/pict
ca9aa2bf 2536 png image/png
ca9aa2bf
TC
2537 tif image/tiff
2538 tiff image/tiff
6a8a6ac5
TC
2539 dcr application/x-director
2540 dir application/x-director
2541 doc application/msword
2542 dxr application/x-director
ad48b8d4 2543 eps application/postscript
6a8a6ac5 2544 fla application/x-shockwave-flash
4a8db683 2545 flv application/x-shockwave-flash
6a8a6ac5
TC
2546 gz application/gzip
2547 hqx application/mac-binhex40
2548 js application/x-javascript
2549 lzh application/x-lzh
2550 pdf application/pdf
2551 pps application/ms-powerpoint
2552 ppt application/ms-powerpoint
ad48b8d4 2553 ps application/postscript
ad48b8d4 2554 rtf application/rtf
6a8a6ac5
TC
2555 sit application/x-stuffit
2556 swf application/x-shockwave-flash
ad48b8d4
TC
2557 tar application/x-tar
2558 tgz application/gzip
ad48b8d4 2559 xls application/ms-excel
4a8db683 2560 Z application/x-compress
6a8a6ac5
TC
2561 zip application/zip
2562 asf video/x-ms-asf
2563 avi video/avi
2564 flc video/flc
ad48b8d4 2565 moov video/quicktime
6a8a6ac5 2566 mov video/quicktime
41f10371 2567 mp4 video/mp4
ad48b8d4 2568 mpeg video/mpeg
6a8a6ac5 2569 mpg video/mpeg
ad48b8d4 2570 wmv video/x-ms-wmv
4a8db683 2571 3gp video/3gpp
6a8a6ac5 2572 aa audio/audible
ad48b8d4
TC
2573 aif audio/aiff
2574 aiff audio/aiff
6a8a6ac5
TC
2575 m4a audio/m4a
2576 mid audio/midi
2577 mp2 audio/x-mpeg
2578 mp3 audio/x-mpeg
ad48b8d4
TC
2579 ra audio/x-realaudio
2580 ram audio/x-pn-realaudio
2581 rm audio/vnd.rm-realmedia
6a8a6ac5 2582 swa audio/mp3
ad48b8d4
TC
2583 wav audio/wav
2584 wma audio/x-ms-wma
ca9aa2bf
TC
2585 )
2586 );
2587
2588sub _refresh_filelist {
8b0b2f34 2589 my ($self, $req, $article, $msg) = @_;
ca9aa2bf 2590
cc9019d1 2591 return $self->refresh($article, $req->cgi, undef, $msg);
ca9aa2bf
TC
2592}
2593
2594sub filelist {
918735d1 2595 my ($self, $req, $article, $articles, $msg, $errors) = @_;
ca9aa2bf
TC
2596
2597 my %acts;
918735d1 2598 %acts = $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors);
ca9aa2bf
TC
2599 my $template = 'admin/filelist';
2600
2601 return BSE::Template->get_response($template, $req->cfg, \%acts);
2602}
2603
2604sub fileadd {
2605 my ($self, $req, $article, $articles) = @_;
2606
abf5bbc6 2607 $req->user_can(edit_files_add => $article)
cc9019d1 2608 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2609 "You don't have access to add files to this article");
2610
ca9aa2bf
TC
2611 my %file;
2612 my $cgi = $req->cgi;
2613 require ArticleFile;
2614 my @cols = ArticleFile->columns;
2615 shift @cols;
2616 for my $col (@cols) {
2617 if (defined $cgi->param($col)) {
2618 $file{$col} = $cgi->param($col);
2619 }
2620 }
c5286ebe
TC
2621
2622 my %errors;
ca9aa2bf 2623
b8e8b584
TC
2624 $file{forSale} = 0 + exists $file{forSale};
2625 $file{articleId} = $article->{id};
2626 $file{download} = 0 + exists $file{download};
2627 $file{requireUser} = 0 + exists $file{requireUser};
2628 $file{hide_from_list} = 0 + exists $file{hide_from_list};
ca9aa2bf
TC
2629
2630 my $downloadPath = $self->{cfg}->entryVar('paths', 'downloads');
2631
2632 # build a filename
2633 my $file = $cgi->param('file');
2634 unless ($file) {
c5286ebe 2635 $errors{file} = 'Please enter a filename';
ca9aa2bf 2636 }
c5286ebe
TC
2637 if ($file && -z $file) {
2638 $errors{file} = 'File is empty';
ca9aa2bf
TC
2639 }
2640
2641 unless ($file{contentType}) {
2642 unless ($file =~ /\.([^.]+)$/) {
2643 $file{contentType} = "application/octet-stream";
2644 }
2645 unless ($file{contentType}) {
2646 my $ext = lc $1;
2647 my $type = $types{$ext};
2648 unless ($type) {
2649 $type = $self->{cfg}->entry('extensions', $ext)
2650 || $self->{cfg}->entry('extensions', ".$ext")
2651 || "application/octet-stream";
2652 }
2653 $file{contentType} = $type;
2654 }
2655 }
c5286ebe
TC
2656
2657 defined $file{name} or $file{name} = '';
2658 if (length $file{name} && $file{name} !~/^\w+$/) {
2659 $errors{name} = "Identifier must be a single word";
2660 }
2661 if (!$errors{name} && length $file{name}) {
2662 my @files = $article->files;
2663 if (grep lc $_->{name} eq lc $file{name}, @files) {
2664 $errors{name} = "Duplicate file identifier $file{name}";
2665 }
2666 }
2667
2668 keys %errors
2669 and return $self->edit_form($req, $article, $articles, undef, \%errors);
ca9aa2bf
TC
2670
2671 my $basename = '';
6a8a205a
TC
2672 my $workfile = $file;
2673 $workfile =~ s![^\w.:/\\-]+!_!g;
2674 $workfile =~ tr/_/_/s;
2675 $workfile =~ /([ \w.-]+)$/ and $basename = $1;
f0543260 2676 $basename =~ tr/ /_/;
ca9aa2bf
TC
2677
2678 my $filename = time. '_'. $basename;
2679
2680 # for the sysopen() constants
2681 use Fcntl;
2682
2683 # loop until we have a unique filename
2684 my $counter="";
2685 $filename = time. '_' . $counter . '_' . $basename
2686 until sysopen( OUTPUT, "$downloadPath/$filename",
2687 O_WRONLY| O_CREAT| O_EXCL)
2688 || ++$counter > 100;
2689
2690 fileno(OUTPUT) or die "Could not open file: $!";
2691
2692 # for OSs with special text line endings
2693 binmode OUTPUT;
2694
2695 my $buffer;
2696
2697 no strict 'refs';
2698
2699 # read the image in from the browser and output it to our output filehandle
2700 print OUTPUT $buffer while read $file, $buffer, 8192;
2701
2702 # close and flush
2703 close OUTPUT
2704 or die "Could not close file $filename: $!";
2705
2706 use BSE::Util::SQL qw/now_datetime/;
2707 $file{filename} = $filename;
2708 $file{displayName} = $basename;
2709 $file{sizeInBytes} = -s $file;
2710 $file{displayOrder} = time;
2711 $file{whenUploaded} = now_datetime();
2712
2713 require ArticleFiles;
2714 my $fileobj = ArticleFiles->add(@file{@cols});
2715
a0a8147b
TC
2716 use Util 'generate_article';
2717 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2718
8b0b2f34 2719 $self->_refresh_filelist($req, $article, 'New file added');
ca9aa2bf
TC
2720}
2721
2722sub fileswap {
2723 my ($self, $req, $article, $articles) = @_;
2724
abf5bbc6 2725 $req->user_can('edit_files_reorder', $article)
cc9019d1 2726 or return $self->edit_form($req, $article, $articles,
abf5bbc6
TC
2727 "You don't have access to reorder files in this article");
2728
ca9aa2bf
TC
2729 my $cgi = $req->cgi;
2730 my $id1 = $cgi->param('file1');
2731 my $id2 = $cgi->param('file2');
2732
2733 if ($id1 && $id2) {
2734 my @files = $article->files;
2735
2736 my ($file1) = grep $_->{id} == $id1, @files;
2737 my ($file2) = grep $_->{id} == $id2, @files;
2738
2739 if ($file1 && $file2) {
2740 ($file1->{displayOrder}, $file2->{displayOrder})
2741 = ($file2->{displayOrder}, $file1->{displayOrder});
2742 $file1->save;
2743 $file2->save;
2744 }
2745 }
2746
a0a8147b
TC
2747 use Util 'generate_article';
2748 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2749
9063386f 2750 $self->refresh($article, $req->cgi, undef, 'File moved');
ca9aa2bf
TC
2751}
2752
2753sub filedel {
2754 my ($self, $req, $article, $articles) = @_;
2755
abf5bbc6 2756 $req->user_can('edit_files_delete', $article)
cc9019d1
TC
2757 or return $self->edit_form($req, $article, $articles,
2758 "You don't have access to delete files from this article");
abf5bbc6 2759
ca9aa2bf
TC
2760 my $cgi = $req->cgi;
2761 my $fileid = $cgi->param('file');
2762 if ($fileid) {
2763 my @files = $article->files;
2764
2765 my ($file) = grep $_->{id} == $fileid, @files;
2766
2767 if ($file) {
16901a2a 2768 $file->remove($req->cfg);
ca9aa2bf
TC
2769 }
2770 }
2771
a0a8147b
TC
2772 use Util 'generate_article';
2773 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2774
8b0b2f34 2775 $self->_refresh_filelist($req, $article, 'File deleted');
ca9aa2bf
TC
2776}
2777
2778sub filesave {
abf5bbc6 2779 my ($self, $req, $article, $articles) = @_;
ca9aa2bf 2780
abf5bbc6 2781 $req->user_can('edit_files_save', $article)
cc9019d1 2782 or return $self->edit_form($req, $article, $articles,
abf5bbc6 2783 "You don't have access to save file information for this article");
ca9aa2bf
TC
2784 my @files = $article->files;
2785
2786 my $cgi = $req->cgi;
c5286ebe 2787 my %seen_name;
ca9aa2bf 2788 for my $file (@files) {
b8e8b584
TC
2789 my $id = $file->{id};
2790 if (defined $cgi->param("description_$id")) {
2791 $file->{description} = $cgi->param("description_$id");
2792 if (defined(my $type = $cgi->param("contentType_$id"))) {
ca9aa2bf
TC
2793 $file->{contentType} = $type;
2794 }
b8e8b584 2795 if (defined(my $notes = $cgi->param("notes_$id"))) {
3f69022d
TC
2796 $file->{notes} = $notes;
2797 }
b8e8b584 2798 my $name = $cgi->param("name_$id");
c5286ebe
TC
2799 defined $name or $name = $file->{name};
2800 if (length $name && $name !~ /^\w+$/) {
2801 return $self->edit_form($req, $article, $articles,
2802 "Invalid file identifier $name");
2803 }
2804 if (length $name && $seen_name{lc $name}++) {
2805 return $self->edit_form($req, $article, $articles,
2806 "Duplicate file identifier $name");
2807 }
b8e8b584
TC
2808 $file->{name} = $name;
2809 $file->{download} = 0 + defined $cgi->param("download_$id");
2810 $file->{forSale} = 0 + defined $cgi->param("forSale_$id");
2811 $file->{requireUser} = 0 + defined $cgi->param("requireUser_$id");
2812 $file->{hide_from_list} = 0 + defined $cgi->param("hide_from_list_$id");
ca9aa2bf
TC
2813 }
2814 }
c5286ebe
TC
2815 for my $file (@files) {
2816 $file->save;
2817 }
a0a8147b
TC
2818 use Util 'generate_article';
2819 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2820
8b0b2f34 2821 $self->_refresh_filelist($req, $article, 'File information saved');
ca9aa2bf
TC
2822}
2823
6473c56f
TC
2824sub can_remove {
2825 my ($self, $req, $article, $articles, $rmsg) = @_;
2826
abf5bbc6
TC
2827 unless ($req->user_can('edit_delete_article', $article, $rmsg)) {
2828 $$rmsg ||= "Access denied";
2829 return;
2830 }
2831
6473c56f
TC
2832 if ($articles->children($article->{id})) {
2833 $$rmsg = "This article has children. You must delete the children first (or change their parents)";
2834 return;
2835 }
2836 if (grep $_ == $article->{id}, @Constants::NO_DELETE) {
2837 $$rmsg = "Sorry, these pages are essential to the site structure - they cannot be deleted";
2838 return;
2839 }
2840 if ($article->{id} == $Constants::SHOPID) {
b8e8b584 2841 $$rmsg = "Sorry, these pages are essential to the store - they cannot be deleted - you may want to hide the store instead.";
6473c56f
TC
2842 return;
2843 }
2844
2845 return 1;
2846}
2847
2848sub remove {
2849 my ($self, $req, $article, $articles) = @_;
2850
2851 my $why_not;
2852 unless ($self->can_remove($req, $article, $articles, \$why_not)) {
2853 return $self->edit_form($req, $article, $articles, $why_not);
2854 }
2855
6473c56f 2856 my $parentid = $article->{parentid};
16901a2a
TC
2857 $article->remove($req->cfg);
2858
8b0b2f34
TC
2859 my $url = $req->cgi->param('r');
2860 unless ($url) {
41f10371 2861 my $urlbase = admin_base_url($req->cfg);
8b0b2f34
TC
2862 $url = "$urlbase$ENV{SCRIPT_NAME}?id=$parentid";
2863 $url .= "&message=Article+deleted";
2864 }
6473c56f
TC
2865 return BSE::Template->get_refresh($url, $self->{cfg});
2866}
2867
4010d92e
TC
2868sub unhide {
2869 my ($self, $req, $article, $articles) = @_;
2870
2871 if ($req->user_can(edit_field_edit_listed => $article)
2872 && $req->user_can(edit_save => $article)) {
2873 $article->{listed} = 1;
2874 $article->save;
2875
2876 use Util 'generate_article';
2877 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2878 }
8b0b2f34 2879 return $self->refresh($article, $req->cgi, undef, 'Article unhidden');
4010d92e
TC
2880}
2881
2882sub hide {
2883 my ($self, $req, $article, $articles) = @_;
2884
2885 if ($req->user_can(edit_field_edit_listed => $article)
2886 && $req->user_can(edit_save => $article)) {
2887 $article->{listed} = 0;
2888 $article->save;
2889
2890 use Util 'generate_article';
2891 generate_article($articles, $article) if $Constants::AUTO_GENERATE;
2892 }
2893 my $r = $req->cgi->param('r');
2894 unless ($r) {
41f10371
TC
2895 $r = admin_base_url($req->cfg)
2896 . "/cgi-bin/admin/add.pl?id=" . $article->{parentid};
4010d92e 2897 }
8b0b2f34 2898 return $self->refresh($article, $req->cgi, undef, 'Article hidden');
4010d92e
TC
2899}
2900
0ec4ac8a
TC
2901my %defaults =
2902 (
2903 titleImage => '',
2904 imagePos => 'tr',
2905 expire => $Constants::D_99,
2906 listed => 1,
2907 keyword => '',
5d88571c 2908 body => '<maximum of 64Kb>',
c2096d67
TC
2909 force_dynamic => 0,
2910 inherit_siteuser_rights => 1,
0ec4ac8a
TC
2911 );
2912
9168c88c
TC
2913sub default_value {
2914 my ($self, $req, $article, $col) = @_;
2915
2916 if ($article->{parentid}) {
2917 my $section = "children of $article->{parentid}";
2918 my $value = $req->cfg->entry($section, $col);
2919 if (defined $value) {
77804754 2920 return $value;
9168c88c
TC
2921 }
2922 }
2923 my $section = "level $article->{level}";
2924 my $value = $req->cfg->entry($section, $col);
77804754 2925 defined($value) and return $value;
0ec4ac8a 2926
deae2a52
TC
2927 $value = $self->type_default_value($req, $col);
2928 defined $value and return $value;
2929
0ec4ac8a
TC
2930 exists $defaults{$col} and return $defaults{$col};
2931
2932 $col eq 'release' and return now_sqldate();
2933
2934 if ($col eq 'threshold') {
d44b5da9 2935 my $parent = defined $article->{parentid} && $article->{parentid} != -1
0ec4ac8a
TC
2936 && Articles->getByPkey($article->{parentid});
2937
2938 $parent and return $parent->{threshold};
2939
2940 return 5;
2941 }
9168c88c 2942
0ec4ac8a 2943 if ($col eq 'summaryLength') {
5d88571c 2944 my $parent = defined $article->{parentid} && $article->{parentid} != -1
0ec4ac8a
TC
2945 && Articles->getByPkey($article->{parentid});
2946
2947 $parent and return $parent->{summaryLength};
2948
2949 return 200;
2950 }
2951
2952 return;
9168c88c
TC
2953}
2954
deae2a52
TC
2955sub type_default_value {
2956 my ($self, $req, $col) = @_;
2957
2958 return $req->cfg->entry('article defaults', $col);
2959}
2960
918735d1
TC
2961sub flag_sections {
2962 return ( 'article flags' );
2963}
2964
2965sub flags {
2966 my ($self) = @_;
2967
2968 my $cfg = $self->{cfg};
2969
2970 my @sections = $self->flag_sections;
2971
2972 my %flags = map $cfg->entriesCS($_), reverse @sections;
2973 my @valid = grep /^\w$/, keys %flags;
2974
2975 return map +{ id => $_, desc => $flags{$_} },
2976 sort { lc($flags{$a}) cmp lc($flags{$b}) }@valid;
2977}
2978
daee3409
TC
2979sub get_images {
2980 my ($self, $article) = @_;
2981
2982 $article->images;
2983}
2984
2985sub validate_image_name {
2986 my ($self, $name, $rmsg) = @_;
2987
2988 1; # no extra validation
2989}
2990
74b21f6d
TC
2991sub req_ajax_get {
2992 my ($self, $req, $article, $articles, @extras) = @_;
2993
2994 my $field_name = $req->cgi->param('field');
2995 unless ($field_name && exists $article->{$field_name}) {
2996 print STDERR "req_ajax_get: missing or invalid field parameter\n";
2997 return {
24f4cfc0 2998 content => 'Invalid or missing field name',
74b21f6d
TC
2999 headers => [
3000 "Status: 187" # bad request
3001 ],
3002 };
3003 }
3004
3005 my $value = $article->{$field_name};
3006 defined $value or $value = '';
3007
3008 my $charset = $req->cfg->entry('html', 'charset', 'iso-8859-1');
3009
3010 # re-encode to utf8
3011 require Encode;
3012 Encode::from_to($value, $charset, 'utf8');
3013
3014 # make some content
3015 return
3016 {
3017 content => $value,
3018 type => 'text/plain; charset=utf-8',
3019 };
3020}
3021
3022sub req_ajax_save_body {
3023 my ($self, $req, $article, $articles, @extras) = @_;
3024
3025 my $cfg = $req->cfg;
3026 my $cgi = $req->cgi;
3027
3028 $cgi->charset('utf-8');
3029
3030 # newer versions of CGI.pm will decode the content as UTF8 if we
3031 # do the above
3032 my $body = $cgi->param('body');
3033
3034 my $charset = $req->cfg->entry('html', 'charset', 'iso-8859-1');
3035
3036 # convert it to our working charset
3037 # any characters that don't convert are replaced by some
3038 # substitution character, not defined by the documentation
3039 require Encode;
3040 $body = Encode::encode($charset, $body);
3041
3042 $article->{body} = $body;
3043 $article->{lastModified} = now_sqldatetime();
3044 my $user = $req->getuser;
3045 $article->{lastModifiedBy} = $user ? $user->{logon} : '';
3046 $article->save;
3047
3048 my @extra_regen;
3049 @extra_regen = $self->update_child_dynamic($article, $articles, $req);
3050
3051 if ($Constants::AUTO_GENERATE) {
3052 require Util;
3053 Util::generate_article($articles, $article);
3054 for my $regen_id (@extra_regen) {
3055 my $regen = $articles->getByPkey($regen_id);
3056 Util::generate_low($articles, $regen, $self->{cfg});
3057 }
3058 }
3059
3060 # we need the formatted body as the result
3061 my $genname = $article->{generator};
3062 eval "use $genname";
3063 $@ and die "Error on use $genname: $@";
3064 my $gen = $genname->new(article => $articles, cfg => $cfg, top => $article);
3065 my %acts;
3066 %acts = $gen->baseActs($articles, \%acts, $article, 0);
3067 my $template = "<:body:>";
3068 my $formatted = BSE::Template->replace($template, $req->cfg, \%acts);
3069
3070 return
3071 {
3072 content => $formatted,
3073 type => BSE::Template->html_type($cfg),
3074 };
3075}
3076
3077my %settable_fields = qw(title keyword author pageTitle);
3078
3079
3080sub req_ajax_set {
3081 my ($self, $req, $article, $articles, @extras) = @_;
3082
3083 my $cfg = $req->cfg;
3084 my $cgi = $req->cgi;
3085
3086 my $field = $cgi->param('field');
3087
3088 unless ($field && $settable_fields{$field}) {
3089 return {
24f4cfc0 3090 content => 'Invalid or missing field name',
74b21f6d
TC
3091 headers => [
3092 "Status: 187" # bad request
3093 ],
3094 };
3095 }
3096
3097 $cgi->charset('utf-8');
3098
3099 # newer versions of CGI.pm will decode the content as UTF8 if we
3100 # do the above
3101 my $value = $cgi->param('value');
3102
3103 # hack - validate it if it's the title
3104 if ($field eq 'title') {
3105 if ($value !~ /\S/) {
3106 return {
24f4cfc0 3107 content => 'Invelid or missing field name',
74b21f6d
TC
3108 headers => [
3109 "Status: 187" # bad request
3110 ],
3111 };
3112 }
3113 }
3114
3115 my $charset = $req->cfg->entry('html', 'charset', 'iso-8859-1');
3116
3117 # convert it to our working charset
3118 # any characters that don't convert are replaced by some
3119 # substitution character, not defined by the documentation
3120 require Encode;
3121 $value = Encode::encode($charset, $value);
3122
3123 $article->{$field} = $value;
3124 $article->{lastModified} = now_sqldatetime();
3125 my $user = $req->getuser;
3126 $article->{lastModifiedBy} = $user ? $user->{logon} : '';
3127 $article->save;
3128
3129 my @extra_regen;
3130 @extra_regen = $self->update_child_dynamic($article, $articles, $req);
3131
3132 if ($Constants::AUTO_GENERATE) {
3133 require Util;
3134 Util::generate_article($articles, $article);
3135 for my $regen_id (@extra_regen) {
3136 my $regen = $articles->getByPkey($regen_id);
3137 Util::generate_low($articles, $regen, $self->{cfg});
3138 }
3139 }
3140
3141 return
3142 {
3143 content => $value,
3144 type => BSE::Template->html_type($cfg),
3145 };
3146}
3147
ca9aa2bf
TC
31481;
3149
3150=head1 NAME
3151
3152 BSE::Edit::Article - editing functionality for BSE articles
3153
3154=head1 AUTHOR
3155
3156Tony Cook <tony@develop-help.com>
3157
3158=head1 REVISION
3159
3160$Revision$
3161
3162=cut