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