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