Commit | Line | Data |
---|---|---|
ca9aa2bf TC |
1 | package BSE::Edit::Product; |
2 | use strict; | |
3 | use base 'BSE::Edit::Article'; | |
10dd37f9 | 4 | use BSE::TB::Products; |
ca9aa2bf | 5 | use HTML::Entities; |
aefcabcb | 6 | use BSE::Template; |
0ec4ac8a | 7 | use BSE::Util::Iterate; |
3f9c8a96 | 8 | use BSE::Util::HTML; |
2076966c | 9 | use BSE::CfgInfo 'product_options'; |
ea71fc0d | 10 | use BSE::Util::Tags qw(tag_hash tag_article); |
59fca225 | 11 | use constant PRODUCT_CUSTOM_FIELDS_CFG => "product custom fields"; |
58baa27b | 12 | |
0bdcab3b | 13 | our $VERSION = "1.016"; |
cb7fd78d | 14 | |
58baa27b TC |
15 | =head1 NAME |
16 | ||
17 | BSE::Edit::Product - tags and actions for editing BSE products | |
18 | ||
19 | =head1 SYNOPSIS | |
20 | ||
21 | http://www.example.com/cgi-bin/admin/add.pl ... | |
22 | ||
23 | =head1 DESCRIPTION | |
24 | ||
25 | Article editor subclass for editing Products. | |
26 | ||
27 | =cut | |
ca9aa2bf TC |
28 | |
29 | my %money_fields = | |
30 | ( | |
31 | retailPrice => "Retail price", | |
32 | wholesalePrice => "Wholesale price", | |
33 | gst => "GST", | |
34 | ); | |
35 | ||
f09e8b4f | 36 | sub generator { 'BSE::Generate::Product' } |
ca9aa2bf | 37 | |
0bdcab3b TC |
38 | sub _make_dummy_article { |
39 | my ($self, $article) = @_; | |
40 | ||
41 | require BSE::DummyProduct; | |
42 | return bless $article, "BSE::DummyProduct"; | |
43 | } | |
44 | ||
ca9aa2bf TC |
45 | sub base_template_dirs { |
46 | return ( "products" ); | |
47 | } | |
48 | ||
49 | sub extra_templates { | |
50 | my ($self, $article) = @_; | |
51 | ||
52 | my @extras = $self->SUPER::extra_templates($article); | |
aefcabcb TC |
53 | push @extras, 'shopitem.tmpl' |
54 | if grep -f "$_/shopitem.tmpl", | |
55 | BSE::Template->template_dirs($self->{cfg}); | |
ca9aa2bf | 56 | |
d64413ee TC |
57 | my $extras = $self->{cfg}->entry('products', 'extra_templates'); |
58 | push @extras, grep /\.(tmpl|html)$/i, split /,/, $extras | |
59 | if $extras; | |
60 | ||
ca9aa2bf TC |
61 | return @extras; |
62 | } | |
63 | ||
64 | sub hash_tag { | |
65 | my ($article, $arg) = @_; | |
66 | ||
67 | my $value = $article->{$arg}; | |
68 | defined $value or $value = ''; | |
7b81711b TC |
69 | if ($value =~ /\cJ/ && $value =~ /\cM/) { |
70 | $value =~ tr/\cM//d; | |
71 | } | |
ca9aa2bf TC |
72 | |
73 | return encode_entities($value); | |
74 | } | |
75 | ||
d7538448 TC |
76 | sub iter_subs { |
77 | require BSE::TB::Subscriptions; | |
78 | BSE::TB::Subscriptions->all; | |
79 | } | |
0ec4ac8a | 80 | |
58baa27b TC |
81 | sub iter_option_values { |
82 | my ($self, $rcurrent_option, $args) = @_; | |
83 | ||
84 | $$rcurrent_option | |
85 | or return; | |
86 | ||
87 | return $$rcurrent_option->values; | |
88 | } | |
89 | ||
ab3c22ff TC |
90 | sub tag_hash_mbcs { |
91 | my ($object, $args) = @_; | |
92 | ||
93 | my $value = $object->{$args}; | |
94 | defined $value or $value = ''; | |
95 | if ($value =~ /\cJ/ && $value =~ /\cM/) { | |
96 | $value =~ tr/\cM//d; | |
97 | } | |
98 | escape_html($value, '<>&"'); | |
99 | } | |
100 | ||
58baa27b TC |
101 | sub tag_dboptionvalue_move { |
102 | my ($self, $req, $article, $rvalues, $rindex, $args) = @_; | |
103 | ||
104 | $$rindex >= 0 && $$rindex < @$rvalues | |
105 | or return "** dboptionvalue_move only in dboption_values iterator **"; | |
106 | ||
107 | my $my_id = $rvalues->[$$rindex]{id}; | |
108 | my $base_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&value_id=$my_id&_csrfp=".$req->get_csrf_token("admin_move_option_value") . "&"; | |
109 | ||
110 | my $t = $req->cgi->param('_t'); | |
111 | $t && $t =~ /^\w+$/ | |
112 | and $base_url .= "_t=$t&"; | |
113 | ||
114 | my $up_url = ''; | |
115 | if ($$rindex > 0) { | |
116 | $up_url = $base_url . "a_option_value_moveup=1"; | |
117 | } | |
118 | my $down_url = ''; | |
119 | if ($$rindex < $#$rvalues) { | |
120 | $down_url = $base_url . "a_option_value_movedown=1"; | |
121 | } | |
122 | ||
123 | my $refresh = $self->refresh_url($article, $req->cgi); | |
124 | ||
125 | require BSE::Arrows; | |
126 | return BSE::Arrows::make_arrows($req->cfg, $down_url, $up_url, $refresh, $args, id => $my_id, id_prefix => "prodoptvaluemove"); | |
127 | } | |
128 | ||
129 | sub tag_dboption_move { | |
130 | my ($self, $req, $article, $roptions, $rindex, $args) = @_; | |
131 | ||
132 | $$rindex >= 0 && $$rindex < @$roptions | |
133 | or return "** dboption_move only in dboptions iterator **"; | |
134 | ||
135 | my $my_id = $roptions->[$$rindex]{id}; | |
136 | my $base_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&option_id=$my_id&_csrfp=".$req->get_csrf_token("admin_move_option") . "&"; | |
137 | ||
138 | my $t = $req->cgi->param('_t'); | |
139 | $t && $t =~ /^\w+$/ | |
140 | and $base_url .= "_t=$t&"; | |
141 | ||
142 | my $up_url = ''; | |
143 | if ($$rindex > 0) { | |
144 | $up_url = $base_url . "a_option_moveup=1"; | |
145 | } | |
146 | my $down_url = ''; | |
147 | if ($$rindex < $#$roptions) { | |
148 | $down_url = $base_url . "a_option_movedown=1"; | |
149 | } | |
150 | ||
151 | my $refresh = $self->refresh_url($article, $req->cgi); | |
152 | ||
153 | require BSE::Arrows; | |
154 | return BSE::Arrows::make_arrows($req->cfg, $down_url, $up_url, $refresh, $args, id => $my_id, id_prefix => "prodoptmove"); | |
155 | } | |
156 | ||
dfd483db TC |
157 | sub tag_tier_price { |
158 | my ($self, $rtier, $rprices, $product) = @_; | |
159 | ||
160 | unless ($rprices->{loaded}) { | |
161 | %$rprices = map { $_->tier_id => $_ } $product->prices | |
162 | if $product->{id}; | |
163 | $rprices->{loaded} = 1; | |
164 | } | |
165 | ||
166 | $$rtier or return '** no current tier **'; | |
167 | ||
168 | exists $rprices->{$$rtier->id} | |
169 | or return ''; | |
170 | ||
171 | return $rprices->{$$rtier->id}->retailPrice; | |
172 | } | |
173 | ||
174 | sub save_more { | |
175 | my ($self, $req, $article, $data) = @_; | |
176 | ||
177 | $self->_save_price_tiers($req, $article, $data); | |
178 | $self->SUPER::save_more($req, $article, $data); | |
179 | } | |
180 | ||
181 | sub save_new_more { | |
182 | my ($self, $req, $article, $data) = @_; | |
183 | ||
184 | $self->_save_price_tiers($req, $article, $data); | |
185 | $self->SUPER::save_new_more($req, $article, $data); | |
186 | } | |
187 | ||
188 | sub _save_price_tiers { | |
189 | my ($self, $req, $article, $data) = @_; | |
190 | ||
191 | $data->{save_pricing_tiers} | |
192 | or return; | |
193 | ||
2146c9b5 | 194 | $req->user_can('edit_field_edit_retailPrice', $article) |
dfd483db TC |
195 | or return; |
196 | ||
10dd37f9 | 197 | my @tiers = BSE::TB::Products->pricing_tiers; |
dfd483db TC |
198 | my %prices; |
199 | for my $tier (@tiers) { | |
200 | my $key = "tier_price_" . $tier->id; | |
201 | if (exists $data->{$key} && $data->{$key} =~ /\S/) { | |
202 | $prices{$tier->id} = $data->{$key} * 100; | |
203 | } | |
204 | } | |
205 | $article->set_prices(\%prices); | |
206 | } | |
207 | ||
208 | sub save_columns { | |
209 | my ($self, $table_object) = @_; | |
210 | ||
211 | my @cols = $self->SUPER::save_columns($table_object); | |
10dd37f9 | 212 | my @tiers = BSE::TB::Products->pricing_tiers; |
dfd483db TC |
213 | if (@tiers) { |
214 | push @cols, "save_pricing_tiers"; | |
215 | push @cols, map { "tier_price_" . $_->id } @tiers; | |
216 | } | |
217 | ||
218 | return @cols; | |
219 | } | |
220 | ||
b876ce1c TC |
221 | sub iter_dboptions { |
222 | my ($self, $article) = @_; | |
223 | ||
224 | $article->{id} | |
225 | or return; | |
226 | ||
227 | return $article->db_options; | |
228 | } | |
229 | ||
58baa27b TC |
230 | =head1 Edit tags |
231 | ||
232 | These a tags available on admin/edit_* pages specific to products. | |
233 | ||
234 | =over | |
235 | ||
236 | =item * | |
237 | ||
238 | product I<field> - display the given field from the product being edited. | |
239 | ||
240 | =item * | |
241 | ||
242 | iterator begin dboptions ... dboption I<field> ... iterator end dboptions | |
243 | ||
244 | - iterate over the existing database stored options for the product | |
245 | ||
246 | =item * | |
247 | ||
248 | dboption_move - display arrows to move the current dboption. The span | |
249 | for the arrows is given an id of "prodoptmoveI<option-id>" by default. | |
250 | ||
251 | =item * | |
252 | ||
253 | iterator begin dboptionvalues ... dboptionvalue I<field> ... iterator end dboptionvalues | |
254 | ||
255 | - iterate over the values for the current dboption | |
256 | ||
257 | =item * | |
258 | ||
259 | dboptionvalue_move - display arrows to move the current dboption. The | |
260 | span for the arrows is given an id of "prodoptvaluemoveI<value-id>" | |
261 | by default. | |
262 | ||
263 | =item * | |
264 | ||
265 | dboptionsjson - returns the product options as JSON. | |
266 | ||
dfd483db TC |
267 | =item * |
268 | ||
269 | iterator begin price_tiers ... price_tier I<field> ... iterator end price_tiers | |
270 | ||
271 | Iterate over the configured price tiers. | |
272 | ||
273 | =item * | |
274 | ||
275 | tier_price | |
276 | ||
277 | Return the price at the current price_tier. Returns an empty string | |
278 | if there's no price at this tier. | |
279 | ||
58baa27b TC |
280 | =back |
281 | ||
282 | =cut | |
283 | ||
ca9aa2bf TC |
284 | sub low_edit_tags { |
285 | my ($self, $acts, $req, $article, $articles, $msg, $errors) = @_; | |
ab3c22ff | 286 | |
2076966c TC |
287 | my $product_opts = product_options($req->cfg); |
288 | ||
ab3c22ff TC |
289 | my $cfg = $req->cfg; |
290 | my $mbcs = $cfg->entry('html', 'mbcs', 0); | |
291 | my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&hash_tag; | |
58baa27b TC |
292 | my $current_option; |
293 | my @dboptions; | |
294 | my $dboption_index; | |
295 | my @dboption_values; | |
296 | my $dboption_value_index; | |
297 | my $current_option_value; | |
0ec4ac8a | 298 | my $it = BSE::Util::Iterate->new; |
dfd483db TC |
299 | my @tiers; |
300 | my $price_tier; | |
301 | my %prices; | |
0bdcab3b | 302 | $req->set_variable(product => $article); |
ca9aa2bf TC |
303 | return |
304 | ( | |
ea71fc0d | 305 | product => [ \&tag_article, $article, $cfg ], |
ca9aa2bf TC |
306 | $self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg, |
307 | $errors), | |
2076966c | 308 | alloptions => join(",", sort keys %$product_opts), |
d7538448 TC |
309 | $it->make_iterator |
310 | ([ \&iter_subs, $req ], 'subscription', 'subscriptions'), | |
58baa27b TC |
311 | $it->make |
312 | ( | |
313 | single => "dboption", | |
314 | plural => "dboptions", | |
315 | store => \$current_option, | |
316 | data => \@dboptions, | |
317 | index => \$dboption_index, | |
b876ce1c | 318 | code => [ iter_dboptions => $self, $article ], |
58baa27b TC |
319 | ), |
320 | dboption_move => | |
321 | [ | |
322 | tag_dboption_move => | |
323 | $self, $req, $article, \@dboptions, \$dboption_index | |
324 | ], | |
325 | $it->make | |
326 | ( | |
327 | single => "dboptionvalue", | |
328 | plural => "dboptionvalues", | |
329 | data => \@dboption_values, | |
330 | index => \$dboption_value_index, | |
331 | store => \$current_option_value, | |
332 | code => [ iter_option_values => $self, \$current_option ], | |
333 | nocache => 1, | |
334 | ), | |
335 | dboptionsjson => [ tag_dboptionsjson => $self, $article ], | |
336 | dboptionvalue_move => | |
337 | [ | |
338 | tag_dboptionvalue_move => | |
339 | $self, $req, $article, \@dboption_values, \$dboption_value_index | |
340 | ], | |
dfd483db TC |
341 | $it->make |
342 | ( | |
343 | single => "price_tier", | |
344 | plural => "price_tiers", | |
10dd37f9 | 345 | code => [ pricing_tiers => "BSE::TB::Products" ], |
dfd483db TC |
346 | data => \@tiers, |
347 | store => \$price_tier, | |
348 | ), | |
349 | tier_price => [ tag_tier_price => $self, \$price_tier, \%prices, $article ], | |
ca9aa2bf TC |
350 | ); |
351 | } | |
352 | ||
353 | sub edit_template { | |
354 | my ($self, $article, $cgi) = @_; | |
355 | ||
356 | my $base = 'product'; | |
357 | my $t = $cgi->param('_t'); | |
358 | if ($t && $t =~ /^\w+$/) { | |
359 | $base = $t; | |
360 | } | |
361 | return $self->{cfg}->entry('admin templates', $base, | |
362 | "admin/edit_$base"); | |
363 | } | |
364 | ||
365 | sub add_template { | |
366 | my ($self, $article, $cgi) = @_; | |
367 | ||
368 | return $self->{cfg}->entry('admin templates', 'add_product', | |
918735d1 | 369 | 'admin/edit_product'); |
ca9aa2bf TC |
370 | } |
371 | ||
372 | sub validate_parent { | |
373 | my ($self, $data, $articles, $parent, $rmsg) = @_; | |
374 | ||
375 | my $shopid = $self->{cfg}->entryErr('articles', 'shop'); | |
376 | unless ($parent && | |
46541e94 | 377 | $parent->{generator} eq 'BSE::Generate::Catalog') { |
ca9aa2bf TC |
378 | $$rmsg = "Products must be in a catalog (not $parent->{generator})"; |
379 | return; | |
380 | } | |
381 | ||
382 | return $self->SUPER::validate_parent($data, $articles, $parent, $rmsg); | |
383 | } | |
384 | ||
385 | sub _validate_common { | |
386 | my ($self, $data, $articles, $errors) = @_; | |
387 | ||
bcf58062 TC |
388 | $self->SUPER::_validate_common($data, $articles, $errors); |
389 | ||
ca9aa2bf TC |
390 | for my $col (keys %money_fields) { |
391 | my $value = $data->{$col}; | |
0ec4ac8a | 392 | defined $value or next; |
ca9aa2bf TC |
393 | unless ($value =~ /^\d+(\.\d{1,2})?\s*/) { |
394 | $errors->{$col} = "$money_fields{$col} invalid"; | |
395 | } | |
396 | } | |
2076966c | 397 | |
0ec4ac8a | 398 | if (defined $data->{options}) { |
2076966c TC |
399 | my $avail_options = product_options($self->{cfg}); |
400 | ||
401 | my @bad_opts = grep !$avail_options->{$_}, | |
0ec4ac8a TC |
402 | split /,/, $data->{options}; |
403 | if (@bad_opts) { | |
404 | $errors->{options} = "Bad product options '". join(",", @bad_opts)."' entered"; | |
405 | } | |
406 | } | |
ca9aa2bf | 407 | |
0ec4ac8a TC |
408 | my @subs; |
409 | for my $sub_field (qw(subscription_id subscription_required)) { | |
410 | my $value = $data->{$sub_field}; | |
411 | defined $value or next; | |
412 | if ($value ne '-1') { | |
d7538448 TC |
413 | require BSE::TB::Subscriptions; |
414 | @subs = BSE::TB::Subscriptions->all unless @subs; | |
415 | unless (grep $_->{subscription_id} == $value, @subs) { | |
0ec4ac8a | 416 | $errors->{$sub_field} = "Invalid $sub_field value"; |
d7538448 | 417 | } |
0ec4ac8a TC |
418 | } |
419 | } | |
420 | if (defined $data->{subscription_period}) { | |
ab2cd916 TC |
421 | my $sub = $data->{subscription_id}; |
422 | if ($data->{subscription_period} !~ /^\d+$/) { | |
0ec4ac8a TC |
423 | $errors->{subscription_period} = "Invalid subscription period, it must be the number of months to subscribe"; |
424 | } | |
ab2cd916 TC |
425 | elsif ($sub != -1 && $data->{subscription_period} < 1) { |
426 | $errors->{subscription_period} = "Subscription period must be 1 or more when a subscription is selected"; | |
427 | } | |
0ec4ac8a TC |
428 | } |
429 | if (defined $data->{subscription_usage}) { | |
430 | unless ($data->{subscription_usage} =~ /^[123]$/) { | |
431 | $errors->{subscription_usage} = "Invalid subscription usage"; | |
432 | } | |
ca9aa2bf TC |
433 | } |
434 | ||
dfd483db | 435 | if ($data->{save_pricing_tiers}) { |
10dd37f9 | 436 | my @tiers = BSE::TB::Products->pricing_tiers; |
dfd483db TC |
437 | for my $tier (@tiers) { |
438 | my $key = "tier_price_" . $tier->id; | |
439 | my $value = $data->{$key}; | |
440 | defined $value or next; | |
441 | if ($value =~ /\S/ && $value !~ /^\d+(\.\d{1,2})?\s*/) { | |
442 | $errors->{$key} = 'Pricing tier "' . $tier->description . '" price invalid'; | |
443 | } | |
444 | } | |
445 | } | |
446 | ||
ca9aa2bf TC |
447 | return !keys %$errors; |
448 | } | |
449 | ||
450 | sub validate { | |
918735d1 | 451 | my ($self, $data, $articles, $errors) = @_; |
ca9aa2bf | 452 | |
918735d1 | 453 | my $ok = $self->SUPER::validate($data, $articles, $errors); |
ca9aa2bf TC |
454 | $self->_validate_common($data, $articles, $errors); |
455 | ||
0e4b5b38 | 456 | for my $field (qw(title)) { |
ca9aa2bf TC |
457 | unless ($data->{$field} =~ /\S/) { |
458 | $errors->{$field} = "No $field entered"; | |
459 | } | |
460 | } | |
461 | ||
462 | return $ok && !keys %$errors; | |
463 | } | |
464 | ||
465 | sub validate_old { | |
918735d1 | 466 | my ($self, $article, $data, $articles, $errors) = @_; |
ca9aa2bf | 467 | |
0d7dc36d | 468 | $self->SUPER::validate_old($article, $data, $articles, $errors) |
ca9aa2bf TC |
469 | or return; |
470 | ||
471 | return !keys %$errors; | |
472 | } | |
473 | ||
474 | sub possible_parents { | |
475 | my ($self, $article, $articles) = @_; | |
476 | ||
477 | my %labels; | |
478 | my @values; | |
479 | ||
480 | my $shopid = $self->{cfg}->entryErr('articles', 'shop'); | |
481 | # the parents of a catalog can be other catalogs or the shop | |
482 | my $shop = $articles->getByPkey($shopid); | |
483 | my @work = [ $shopid, $shop->{title} ]; | |
484 | while (@work) { | |
485 | my ($id, $title) = @{pop @work}; | |
486 | push(@values, $id); | |
487 | $labels{$id} = $title; | |
488 | push @work, map [ $_->{id}, $title.' / '.$_->{title} ], | |
489 | sort { $b->{displayOrder} <=> $a->{displayOrder} } | |
46541e94 | 490 | grep $_->{generator} eq 'BSE::Generate::Catalog', |
ca9aa2bf TC |
491 | $articles->getBy(parentid=>$id); |
492 | } | |
46541e94 | 493 | unless ($shop->{generator} eq 'BSE::Generate::Catalog') { |
a5e3fc4b TC |
494 | shift @values; |
495 | delete $labels{$shopid}; | |
496 | } | |
ca9aa2bf TC |
497 | return (\@values, \%labels); |
498 | } | |
499 | ||
500 | sub table_object { | |
501 | my ($self, $articles) = @_; | |
502 | ||
10dd37f9 | 503 | 'BSE::TB::Products'; |
ca9aa2bf TC |
504 | } |
505 | ||
506 | sub get_article { | |
507 | my ($self, $articles, $article) = @_; | |
508 | ||
10dd37f9 | 509 | return BSE::TB::Products->getByPkey($article->{id}); |
ca9aa2bf TC |
510 | } |
511 | ||
95989433 TC |
512 | sub default_link_path { |
513 | my ($self, $article) = @_; | |
514 | ||
515 | $self->{cfg}->entry('uri', 'shop', '/shop'); | |
516 | } | |
517 | ||
ca9aa2bf TC |
518 | sub make_link { |
519 | my ($self, $article) = @_; | |
520 | ||
75e51df4 TC |
521 | $article->is_linked |
522 | or return ""; | |
523 | ||
57d988af TC |
524 | # Modified by adrian |
525 | my $urlbase = ''; | |
526 | if ($self->{cfg}->entry('shop', 'secureurl_articles', 1)) { | |
527 | $urlbase = $self->{cfg}->entryVar('site', 'secureurl'); | |
528 | } | |
529 | # end adrian | |
efcc5a30 TC |
530 | |
531 | if ($article->is_dynamic) { | |
d4336bdc TC |
532 | (my $extra = $article->title) =~ tr/A-Za-z0-9/-/sc; |
533 | return "$urlbase/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($extra); | |
efcc5a30 TC |
534 | } |
535 | ||
536 | my $shop_uri = $self->link_path($article); | |
ca9aa2bf TC |
537 | return $urlbase.$shop_uri."/shop$article->{id}.html"; |
538 | } | |
539 | ||
540 | sub _fill_product_data { | |
541 | my ($self, $req, $data, $src) = @_; | |
542 | ||
543 | for my $money_col (qw(retailPrice wholesalePrice gst)) { | |
544 | if (exists $src->{$money_col}) { | |
545 | if ($src->{$money_col} =~ /^\d+(\.\d\d)?\s*/) { | |
546 | $data->{$money_col} = 100 * $src->{$money_col}; | |
547 | } | |
548 | else { | |
549 | $data->{$money_col} = 0; | |
550 | } | |
551 | } | |
552 | } | |
553 | if (exists $src->{leadTime}) { | |
554 | $src->{leadTime} =~ /^\d+\s*$/ | |
555 | or $src->{leadTime} = 0; | |
556 | $data->{leadTime} = $src->{leadTime}; | |
557 | } | |
74b21f6d | 558 | if (exists $src->{description} && length $src->{description}) { |
4010d92e | 559 | if ($data->{id}) { |
74b21f6d TC |
560 | if ($req->user_can('edit_field_edit_description', $data)) { |
561 | $data->{description} = $src->{description}; | |
562 | } | |
563 | } | |
564 | } | |
565 | if (exists $src->{product_code} && length $src->{product_code}) { | |
566 | if ($data->{id}) { | |
567 | if ($req->user_can('edit_field_edit_product_code', $data)) { | |
568 | $data->{product_code} = $src->{product_code}; | |
4010d92e TC |
569 | } |
570 | } | |
571 | } | |
0ec4ac8a | 572 | for my $field (qw(options subscription_id subscription_period |
306eb97a AMS |
573 | subscription_usage subscription_required |
574 | weight length width height)) { | |
0ec4ac8a TC |
575 | if (exists $src->{$field}) { |
576 | $data->{$field} = $src->{$field}; | |
577 | } | |
578 | elsif ($data == $src) { | |
579 | # use the default | |
580 | $data->{$field} = $self->default_value($req, $data, $field); | |
581 | } | |
918735d1 | 582 | } |
ca9aa2bf TC |
583 | } |
584 | ||
585 | sub fill_new_data { | |
586 | my ($self, $req, $data, $articles) = @_; | |
587 | ||
588 | $self->_fill_product_data($req, $data, $data); | |
589 | ||
590 | return $self->SUPER::fill_new_data($req, $data, $articles); | |
591 | } | |
592 | ||
593 | sub fill_old_data { | |
594 | my ($self, $req, $article, $src) = @_; | |
595 | ||
596 | $self->_fill_product_data($req, $article, $src); | |
597 | ||
598 | return $self->SUPER::fill_old_data($req, $article, $src); | |
599 | } | |
600 | ||
caa7299c TC |
601 | sub default_template { |
602 | my ($self, $article, $cfg, $templates) = @_; | |
603 | ||
d64413ee | 604 | my $template = $cfg->entry('products', 'template'); |
caa7299c TC |
605 | return $template |
606 | if $template && grep $_ eq $template, @$templates; | |
607 | ||
608 | return $self->SUPER::default_template($article, $cfg, $templates); | |
609 | } | |
610 | ||
918735d1 TC |
611 | sub flag_sections { |
612 | my ($self) = @_; | |
613 | ||
614 | return ( 'product flags', $self->SUPER::flag_sections ); | |
615 | } | |
616 | ||
6d91d9dc TC |
617 | sub shop_article { 1 } |
618 | ||
0ec4ac8a TC |
619 | my %defaults = |
620 | ( | |
621 | options => '', | |
0e4b5b38 | 622 | description => '', |
0ec4ac8a TC |
623 | subscription_id => -1, |
624 | subscription_required => -1, | |
625 | subscription_period => 1, | |
626 | subscription_usage => 3, | |
0e4b5b38 | 627 | leadTime => 0, |
0ec4ac8a | 628 | retailPrice => 0, |
0e4b5b38 TC |
629 | wholesalePrice => 0, |
630 | gst => 0, | |
4ad55bda TC |
631 | product_code => '', |
632 | weight => 0, | |
633 | length => 0, | |
634 | height => 0, | |
635 | width => 0, | |
0ec4ac8a TC |
636 | ); |
637 | ||
638 | sub default_value { | |
639 | my ($self, $req, $article, $col) = @_; | |
640 | ||
641 | my $value = $self->SUPER::default_value($req, $article, $col); | |
642 | defined $value and return $value; | |
643 | ||
644 | exists $defaults{$col} and return $defaults{$col}; | |
645 | ||
646 | return; | |
647 | } | |
648 | ||
deae2a52 TC |
649 | sub type_default_value { |
650 | my ($self, $req, $col) = @_; | |
651 | ||
652 | my $value = $req->cfg->entry('product defaults', $col); | |
653 | defined $value and return $value; | |
654 | ||
655 | return $self->SUPER::type_default_value($req, $col); | |
656 | } | |
657 | ||
58baa27b TC |
658 | my %option_fields = |
659 | ( | |
660 | name => | |
661 | { | |
662 | description => "Option name", | |
663 | required => 1, | |
664 | rules => "dh_one_line", | |
085b34a0 | 665 | maxlength => 255, |
58baa27b TC |
666 | }, |
667 | value1 => | |
668 | { | |
669 | description => "Value 1", | |
670 | rules => "dh_one_line", | |
085b34a0 | 671 | maxlength => 255, |
58baa27b TC |
672 | }, |
673 | value2 => | |
674 | { | |
675 | description => "Value 2", | |
676 | rules => "dh_one_line", | |
085b34a0 | 677 | maxlength => 255, |
58baa27b TC |
678 | }, |
679 | value3 => | |
680 | { | |
681 | description => "Value 3", | |
682 | rules => "dh_one_line", | |
085b34a0 | 683 | maxlength => 255, |
58baa27b TC |
684 | }, |
685 | value4 => | |
686 | { | |
687 | description => "Value 4", | |
688 | rules => "dh_one_line", | |
085b34a0 | 689 | maxlength => 255, |
58baa27b TC |
690 | }, |
691 | value5 => | |
692 | { | |
693 | description => "Value 5", | |
694 | rules => "dh_one_line", | |
085b34a0 | 695 | maxlength => 255, |
58baa27b TC |
696 | }, |
697 | ); | |
698 | ||
699 | =head1 Targets | |
700 | ||
701 | Actions you can request from add.pl for products. | |
702 | ||
703 | =over | |
704 | ||
705 | =item a_add_option | |
706 | ||
707 | Add a new product option. | |
708 | ||
709 | On failure perform a service error. | |
710 | ||
711 | Requires _csrfp for admin_add_option | |
712 | ||
713 | For Ajax requests (or with a _ parameter) returns JSON like: | |
714 | ||
715 | { | |
716 | success: 1, | |
717 | option: { <option data> }, | |
718 | values: [ { value data }, { value data }, ... ] | |
719 | } | |
720 | ||
721 | Parameters: | |
722 | ||
723 | =over | |
724 | ||
725 | =item * | |
726 | ||
727 | id - Article id | |
728 | ||
729 | =item * | |
730 | ||
731 | name - Name of the option (required) | |
732 | ||
733 | =item * | |
734 | ||
735 | value1 .. value5 - if any of these are non-blank they are added to the | |
736 | option as values. | |
737 | ||
738 | =back | |
739 | ||
9b3a5df0 TC |
740 | Permission required: bse_edit_prodopt_add |
741 | ||
58baa27b TC |
742 | =cut |
743 | ||
744 | sub req_add_option { | |
745 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
746 | ||
747 | $req->check_csrf('admin_add_option') | |
748 | or return $self->csrf_error($req, $article, "admin_add_option", "Add Product Option"); | |
749 | ||
9b3a5df0 TC |
750 | $req->user_can(bse_edit_prodopt_add => $article) |
751 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to add options"); | |
752 | ||
58baa27b TC |
753 | my %errors; |
754 | $req->validate(fields => \%option_fields, | |
755 | errors => \%errors); | |
756 | keys %errors | |
757 | and return $self->_service_error($req, $article, $articles, undef, | |
758 | \%errors); | |
759 | ||
760 | my $cgi = $req->cgi; | |
761 | require BSE::TB::ProductOptions; | |
762 | require BSE::TB::ProductOptionValues; | |
763 | my $option = BSE::TB::ProductOptions->make | |
764 | ( | |
765 | product_id => $article->{id}, | |
766 | name => scalar($cgi->param('name')), | |
767 | display_order => time, | |
768 | ); | |
769 | ||
770 | my $order = time; | |
771 | my @values; | |
772 | for my $value_key (sort grep /^value/, keys %option_fields) { | |
58baa27b TC |
773 | my ($value) = $cgi->param($value_key); |
774 | if (defined $value && $value =~ /\S/) { | |
775 | my $entry = BSE::TB::ProductOptionValues->make | |
776 | ( | |
777 | product_option_id => $option->{id}, | |
778 | value => $value, | |
779 | display_order => $order, | |
780 | ); | |
781 | push @values, $entry; | |
782 | ++$order; | |
783 | } | |
784 | } | |
785 | ||
786 | $req->is_ajax | |
787 | and return $req->json_content | |
788 | ( | |
789 | success => 1, | |
790 | option => $option->data_only, | |
791 | values => [ map $_->data_only, @values ] | |
792 | ); | |
793 | ||
794 | return $self->refresh($article, $cgi, undef, "Option added"); | |
795 | } | |
796 | ||
797 | my %option_id = | |
798 | ( | |
799 | option_id => | |
800 | { | |
801 | rules => "required;positiveint", | |
802 | }, | |
803 | ); | |
804 | ||
805 | sub _get_option { | |
806 | my ($self, $req, $article, $errors) = @_; | |
807 | ||
808 | my $option; | |
809 | my $cgi = $req->cgi; | |
810 | $req->validate(fields => \%option_id, | |
811 | errors => $errors); | |
4de47893 TC |
812 | my @option_ids = $cgi->param("option_id"); |
813 | unless ($errors->{option_id}) { | |
814 | @option_ids == 1 | |
815 | or $errors->{option_id} = "This request accepts only one option_id"; | |
816 | } | |
58baa27b TC |
817 | unless ($errors->{option_id}) { |
818 | require BSE::TB::ProductOptions; | |
819 | $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id")); | |
820 | $option | |
821 | or $errors->{option_id} = "Unknown option id"; | |
822 | } | |
823 | unless ($errors->{option_id}) { | |
824 | $option->{product_id} = $article->{id} | |
825 | or $errors->{option_id} = "Option doesn't belong to this product"; | |
826 | } | |
827 | $errors->{option_id} | |
828 | and return; | |
829 | ||
830 | return $option; | |
831 | } | |
832 | ||
833 | sub _common_option { | |
834 | my ($self, $template, $req, $article, $articles, $msg, $errors) = @_; | |
835 | ||
836 | my %errors; | |
837 | my $option = $self->_get_option($req, $article, \%errors); | |
838 | keys %errors | |
839 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
840 | ||
5b816615 TC |
841 | $req->set_variable(option => $option); |
842 | $req->messages($errors); | |
58baa27b TC |
843 | my $it = BSE::Util::Iterate->new; |
844 | my %acts; | |
845 | %acts = | |
846 | ( | |
847 | $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors), | |
848 | option => [ \&tag_hash, $option ], | |
849 | $it->make | |
850 | ( | |
851 | single => "dboptionvalue", | |
852 | plural => "dboptionvalues", | |
853 | code => [ iter_option_values => $self, \$option ], | |
854 | ), | |
855 | ); | |
856 | ||
857 | return $req->dyn_response($template, \%acts); | |
858 | } | |
859 | ||
860 | =item a_edit_option | |
861 | ||
862 | Produce a form to edit the given option. | |
863 | ||
864 | Parameters: | |
865 | ||
866 | =over | |
867 | ||
868 | =item * | |
869 | ||
870 | id - article id | |
871 | ||
872 | =item * | |
873 | ||
874 | option_id - option id. This must belong to the product identified by | |
875 | id. | |
876 | ||
877 | =back | |
878 | ||
879 | Template: admin/prodopt_edit | |
880 | ||
9b3a5df0 TC |
881 | Permission required: bse_edit_prodopt_edit |
882 | ||
58baa27b TC |
883 | =cut |
884 | ||
885 | sub req_edit_option { | |
886 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
887 | ||
9b3a5df0 TC |
888 | $req->user_can(bse_edit_prodopt_edit => $article) |
889 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
890 | ||
58baa27b TC |
891 | return $self->_common_option('admin/prodopt_edit', $req, $article, |
892 | $articles, $msg, $errors); | |
893 | } | |
894 | ||
895 | my %option_name = | |
896 | ( | |
897 | name => | |
898 | { | |
899 | description => "Option name", | |
9eebac67 | 900 | rules => "required;dh_one_line", |
085b34a0 | 901 | maxlength => 255, |
58baa27b TC |
902 | }, |
903 | default_value => | |
904 | { | |
905 | description => "Default Value", | |
9b3a5df0 | 906 | rules => "positiveint" |
58baa27b TC |
907 | } |
908 | ); | |
909 | ||
910 | my %option_value = | |
911 | ( | |
912 | description => "Value", | |
9eebac67 | 913 | rules => "required;dh_one_line", |
085b34a0 | 914 | maxlength => 255, |
58baa27b TC |
915 | ); |
916 | ||
917 | =item a_save_option | |
918 | ||
919 | Saves changes to an option. | |
920 | ||
921 | On failure perform a service error. | |
922 | ||
923 | Requires _csrfp for admin_save_option | |
924 | ||
925 | For Ajax requests (or with a _ parameter), returns JSON like: | |
926 | ||
927 | { | |
928 | success: 1, | |
929 | option: { <option data> }, | |
930 | values: [ { value data, value data, ... } ] | |
931 | } | |
932 | ||
933 | Parameters: | |
934 | ||
935 | =over | |
936 | ||
937 | =item * | |
938 | ||
939 | id - article id | |
940 | ||
941 | =item * | |
942 | ||
943 | option_id - id of the option to save, must belong to the product | |
944 | identified by id. | |
945 | ||
946 | =item * | |
947 | ||
948 | name - new value for the name field | |
949 | ||
950 | =item * | |
951 | ||
952 | default_value - id of the default value | |
953 | ||
954 | =item * | |
955 | ||
956 | save_enabled - if supplied and true, set enabled from the enabled | |
957 | parameter. | |
958 | ||
959 | =item * | |
960 | ||
961 | enabled - If supplied and true, enable the option, otherwise disable | |
962 | it. Ignored unless save_enabled is true. | |
963 | ||
964 | =item * | |
965 | ||
966 | valueI<value-id> - set the displayed value for the value record | |
5708b3ac TC |
967 | identified by I<value-id>. If these aren't supplied the values aren't |
968 | changed. | |
58baa27b TC |
969 | |
970 | =back | |
971 | ||
9b3a5df0 TC |
972 | Permission required: bse_edit_prodopt_save |
973 | ||
58baa27b TC |
974 | =cut |
975 | ||
976 | sub req_save_option { | |
977 | my ($self, $req, $article, $articles) = @_; | |
978 | ||
979 | my $cgi = $req->cgi; | |
980 | ||
981 | $req->check_csrf("admin_save_option") | |
982 | or return $self->csrf_error($req, $article, "admin_save_option", "Save Product Option"); | |
983 | ||
9b3a5df0 TC |
984 | $req->user_can(bse_edit_prodopt_edit => $article) |
985 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
986 | ||
58baa27b TC |
987 | my %errors; |
988 | my $option = $self->_get_option($req, $article, \%errors); | |
989 | keys %errors | |
d445674b | 990 | and return $self->_service_error($req, $article, $articles, undef, \%errors, 'FIELD', "req_edit_option"); |
9b3a5df0 | 991 | $req->validate(fields => \%option_name, |
58baa27b TC |
992 | errors => \%errors); |
993 | my @values = $option->values; | |
994 | my %fields = map {; "value$_->{id}" => \%option_value } @values; | |
9b3a5df0 TC |
995 | $req->validate(fields => \%fields, |
996 | errors => \%errors, | |
997 | optional => 1); | |
58baa27b TC |
998 | my $default_value = $cgi->param('default_value'); |
999 | if (!$errors{default_value} && $default_value) { | |
1000 | grep $_->{id} == $default_value, @values | |
1001 | or $errors{default_value} = "Unknown value selected as default"; | |
1002 | } | |
d445674b TC |
1003 | |
1004 | $DB::single = 1; | |
1005 | my @new_values; | |
1006 | my $index = 1; | |
1007 | while ($index < 10 && defined $cgi->param("newvalue$index")) { | |
1008 | my $field = "newvalue$index"; | |
1009 | my $value = $cgi->param($field); | |
1010 | $req->validate(fields => { $field => \%option_value }, | |
1011 | errors => \%errors); | |
1012 | push @new_values, $value; | |
1013 | ||
1014 | ++$index; | |
1015 | } | |
1016 | ||
58baa27b | 1017 | keys %errors |
d445674b | 1018 | and return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD", "req_edit_option"); |
58baa27b TC |
1019 | |
1020 | my $name = $cgi->param("name"); | |
1021 | defined $name | |
1022 | and $option->set_name($name); | |
1023 | defined $default_value | |
1024 | and $option->set_default_value($default_value); | |
1025 | if ($cgi->param("save_enabled")) { | |
1026 | my $enabled = $cgi->param("enabled") ? 1 : 0; | |
1027 | $option->set_enabled($enabled); | |
1028 | } | |
1029 | $option->save; | |
1030 | for my $value (@values) { | |
1031 | my $new_value = $cgi->param("value$value->{id}"); | |
5708b3ac | 1032 | if (defined $new_value && $new_value ne $value->value) { |
58baa27b TC |
1033 | $value->set_value($new_value); |
1034 | $value->save; | |
1035 | } | |
1036 | } | |
d445674b TC |
1037 | my $order = @values ? $values[-1]->display_order : time; |
1038 | for my $value (@new_values) { | |
1039 | BSE::TB::ProductOptionValues->make | |
1040 | ( | |
1041 | product_option_id => $option->id, | |
1042 | value => $value, | |
1043 | display_order => ++$order, | |
1044 | ); | |
1045 | } | |
58baa27b TC |
1046 | |
1047 | $req->is_ajax | |
1048 | and return $req->json_content | |
1049 | ( | |
1050 | success => 1, | |
1051 | option => $option->data_only, | |
1052 | values => [ map $_->data_only, @values ], | |
1053 | ); | |
1054 | ||
d445674b TC |
1055 | return $self->refresh($article, $req->cgi, undef, |
1056 | "Option '" . $option->name . "' saved"); | |
58baa27b TC |
1057 | } |
1058 | ||
1059 | =item a_delconf_option | |
1060 | ||
1061 | Produce a form to confirm deletion of the given option. | |
1062 | ||
1063 | Parameters: | |
1064 | ||
1065 | =over | |
1066 | ||
1067 | =item * | |
1068 | ||
1069 | id - article id | |
1070 | ||
1071 | =item * | |
1072 | ||
1073 | option_id - option id. This must belong to the product identified by | |
1074 | id. | |
1075 | ||
1076 | =back | |
1077 | ||
1078 | Template: admin/prodopt_delete | |
1079 | ||
1080 | =cut | |
1081 | ||
1082 | sub req_delconf_option { | |
1083 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
1084 | ||
9b3a5df0 TC |
1085 | $req->user_can(bse_edit_prodopt_delete => $article) |
1086 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options"); | |
1087 | ||
58baa27b TC |
1088 | return $self->_common_option('admin/prodopt_delete', $req, $article, |
1089 | $articles, $msg, $errors); | |
1090 | } | |
1091 | ||
1092 | =item a_delete_option | |
1093 | ||
1094 | Delete the given option. | |
1095 | ||
1096 | On failure perform a service error. | |
1097 | ||
1098 | Requires _csrfp for admin_delete_option | |
1099 | ||
1100 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1101 | ||
1102 | { | |
1103 | success: 1, | |
1104 | } | |
1105 | ||
9b3a5df0 TC |
1106 | Permission required: bse_edit_prodopt_delete |
1107 | ||
58baa27b TC |
1108 | =cut |
1109 | ||
1110 | sub req_delete_option { | |
1111 | my ($self, $req, $article, $articles) = @_; | |
1112 | ||
1113 | $req->check_csrf("admin_delete_option") | |
1114 | or return $self->csrf_error($req, $article, "admin_delete_option", "Delete Product Option"); | |
1115 | ||
9b3a5df0 TC |
1116 | $req->user_can(bse_edit_prodopt_delete => $article) |
1117 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options"); | |
1118 | ||
58baa27b TC |
1119 | my %errors; |
1120 | my $option = $self->_get_option($req, $article, \%errors); | |
1121 | keys %errors | |
1122 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1123 | my @values = $option->values; | |
1124 | ||
1125 | for my $value (@values) { | |
1126 | $value->remove; | |
1127 | } | |
1128 | $option->remove; | |
1129 | ||
1130 | $req->is_ajax | |
1131 | and return $req->json_content | |
1132 | ( | |
1133 | success => 1 | |
1134 | ); | |
1135 | ||
1136 | return $self->refresh($article, $req->cgi, undef, "Option deleted"); | |
1137 | } | |
1138 | ||
1139 | ||
1140 | my %add_option_value_fields = | |
1141 | ( | |
1142 | option_id => | |
1143 | { | |
1144 | description => "Option id", | |
1145 | rules => "required;positiveint", | |
1146 | }, | |
1147 | value => | |
1148 | { | |
1149 | description => "Value", | |
085b34a0 TC |
1150 | rules => "required;dh_one_line", |
1151 | maxlength => 255, | |
58baa27b TC |
1152 | }, |
1153 | ); | |
1154 | ||
1155 | =item a_add_option_value | |
1156 | ||
1157 | Add a value to a product option. | |
1158 | ||
1159 | On failure perform a service error, see BSE::Edit::Article::_service_error. | |
1160 | ||
1161 | Requires _csrfp for admin_add_option_value | |
1162 | ||
1163 | For Ajax requests returns JSON like | |
d8b4c773 | 1164 | |
58baa27b TC |
1165 | { success: 1, value: (valueobject) } |
1166 | ||
1167 | Standard redirect on success otherwise. | |
1168 | ||
1169 | Parameters: | |
1170 | ||
1171 | =over | |
1172 | ||
1173 | =item * | |
1174 | ||
1175 | id - article id | |
1176 | ||
1177 | =item * | |
1178 | ||
1179 | option_id - id of the option to add the value to | |
1180 | ||
1181 | =item * | |
1182 | ||
1183 | value - text of the value to add. | |
1184 | ||
1185 | =back | |
1186 | ||
9b3a5df0 TC |
1187 | Permission required: bse_edit_prodopt_edit |
1188 | ||
58baa27b TC |
1189 | =cut |
1190 | ||
1191 | sub req_add_option_value { | |
1192 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
1193 | ||
1194 | $req->check_csrf("admin_add_option_value") | |
1195 | or return $self->csrf_error($req, $article, "admin_add_option_value", "Add Product Option Value"); | |
1196 | ||
9b3a5df0 TC |
1197 | $req->user_can(bse_edit_prodopt_edit => $article) |
1198 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1199 | ||
58baa27b TC |
1200 | my %errors; |
1201 | $req->validate(fields => \%add_option_value_fields, | |
1202 | errors => \%errors); | |
1203 | my $option; | |
1204 | my $cgi = $req->cgi; | |
1205 | unless ($errors{option_id}) { | |
1206 | require BSE::TB::ProductOptions; | |
1207 | $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id")); | |
1208 | defined $option && $option->{product_id} | |
1209 | or $errors{option_id} = "Bad option id - either unknown or for a different product"; | |
1210 | } | |
1211 | keys %errors | |
1212 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1213 | ||
1214 | my $value = $cgi->param("value"); | |
1215 | require BSE::TB::ProductOptionValues; | |
1216 | my $entry = BSE::TB::ProductOptionValues->make | |
1217 | ( | |
1218 | product_option_id => $option->{id}, | |
1219 | value => $value, | |
1220 | display_order => time, | |
1221 | ); | |
1222 | ||
1223 | $req->is_ajax | |
1660ce30 | 1224 | and return $req->json_content |
58baa27b TC |
1225 | ( |
1226 | success => 1, | |
1227 | value => $entry->data_only | |
1228 | ); | |
1229 | ||
1230 | return $self->refresh($article, $cgi, undef, "Value added"); | |
1231 | } | |
1232 | ||
1233 | ||
1234 | my %option_value_id = | |
1235 | ( | |
1236 | value_id => | |
1237 | { | |
1238 | rules => "required;positiveint", | |
1239 | }, | |
1240 | ); | |
1241 | ||
1242 | sub _get_option_value { | |
1243 | my ($self, $req, $article, $errors) = @_; | |
1244 | ||
1245 | my $option_value; | |
1246 | my $cgi = $req->cgi; | |
1247 | $req->validate(fields => \%option_value_id, | |
1248 | errors => $errors); | |
1249 | unless ($errors->{value_id}) { | |
1250 | require BSE::TB::ProductOptionValues; | |
1251 | $option_value = BSE::TB::ProductOptionValues->getByPkey($cgi->param("value_id")); | |
1252 | $option_value | |
1253 | or $errors->{value_id} = "Unknown option value id"; | |
1254 | } | |
1255 | my $option; | |
1256 | unless ($errors->{value_id}) { | |
1257 | $option = $option_value->option; | |
1258 | defined $option && $option->{product_id} == $article->{id} | |
1259 | or $errors->{value_id} = "Value has no option or doesn't belong to the product"; | |
1260 | } | |
1261 | ||
1262 | $errors->{value_id} | |
1263 | and return; | |
1264 | ||
1265 | return wantarray ? ( $option_value, $option ) : $option_value ; | |
1266 | } | |
1267 | ||
1268 | sub _common_option_value { | |
1269 | my ($self, $template, $req, $article, $articles, $msg, $errors) = @_; | |
1270 | ||
1271 | my %errors; | |
1272 | my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors); | |
1273 | keys %errors | |
1274 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1275 | ||
5b816615 TC |
1276 | $req->set_variable(option => $option); |
1277 | $req->set_variable(option_value => $option_value); | |
58baa27b TC |
1278 | my %acts; |
1279 | %acts = | |
1280 | ( | |
1281 | $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors), | |
1282 | option_value => [ \&tag_hash, $option_value ], | |
1283 | option => [ \&tag_hash, $option ], | |
1284 | ); | |
1285 | ||
1286 | return $req->dyn_response($template, \%acts); | |
1287 | } | |
1288 | ||
1289 | =item a_edit_option_value | |
1290 | ||
1291 | Displays a form to edit the value for a given option. | |
1292 | ||
1293 | Parameters: | |
1294 | ||
1295 | =over | |
1296 | ||
1297 | =item * | |
1298 | ||
1299 | id - id of the product | |
1300 | ||
1301 | =item * | |
1302 | ||
1303 | value_id - id of he product option value to edit, must belong to the | |
1304 | given product. | |
1305 | ||
1306 | =back | |
1307 | ||
1308 | Template: admin/prodopt_value_edit | |
1309 | ||
9b3a5df0 TC |
1310 | Permission required: bse_edit_prodopt_edit |
1311 | ||
58baa27b TC |
1312 | =cut |
1313 | ||
1314 | sub req_edit_option_value { | |
1315 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
1316 | ||
9b3a5df0 TC |
1317 | $req->user_can(bse_edit_prodopt_edit => $article) |
1318 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1319 | ||
58baa27b TC |
1320 | return $self->_common_option_value('admin/prodopt_value_edit', $req, |
1321 | $article, $articles, $msg, $errors); | |
1322 | } | |
1323 | ||
1324 | my %save_option_value_fields = | |
1325 | ( | |
1326 | value => | |
1327 | { | |
1328 | rules => "required;dh_one_line", | |
085b34a0 | 1329 | maxlength => 255, |
58baa27b TC |
1330 | }, |
1331 | ); | |
1332 | ||
1333 | =item a_save_option_value | |
1334 | ||
1335 | Saves changes to an option. | |
1336 | ||
1337 | On failure perform a service error. | |
1338 | ||
1339 | Requires _csrfp for admin_save_option_value | |
1340 | ||
1341 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1342 | ||
1343 | { | |
1344 | success: 1, | |
1345 | value: { value data } | |
1346 | } | |
1347 | ||
1348 | Parameters: | |
1349 | ||
1350 | =over | |
1351 | ||
1352 | =item * | |
1353 | ||
1354 | id - article id | |
1355 | ||
1356 | =item * | |
1357 | ||
1358 | value_id - id of the value to save, must belong to the product | |
1359 | identified by id. | |
1360 | ||
1361 | =item * | |
1362 | ||
1363 | value - new displayed value for the option value. | |
1364 | ||
1365 | =back | |
1366 | ||
9b3a5df0 TC |
1367 | Permission required: bse_edit_prodopt_edit |
1368 | ||
58baa27b TC |
1369 | =cut |
1370 | ||
1371 | sub req_save_option_value { | |
1372 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
1373 | ||
1374 | $req->check_csrf("admin_save_option_value") | |
1375 | or return $self->csrf_error($req, $article, "admin_save_option_value", "Save Product Option Value"); | |
1376 | ||
9b3a5df0 TC |
1377 | $req->user_can(bse_edit_prodopt_edit => $article) |
1378 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1379 | ||
58baa27b TC |
1380 | my %errors; |
1381 | $req->validate(fields => \%save_option_value_fields, | |
1382 | errors => \%errors); | |
1383 | my $option_value = $self->_get_option_value($req, $article, \%errors); | |
1384 | keys %errors | |
1385 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1386 | ||
1387 | my $cgi = $req->cgi; | |
1388 | $option_value->{value} = $cgi->param("value"); | |
1389 | $option_value->save; | |
1390 | ||
1391 | $req->is_ajax | |
1660ce30 | 1392 | and return $req->json_content |
58baa27b TC |
1393 | ( |
1394 | success => 1, | |
1395 | value => $option_value->data_only | |
1396 | ); | |
1397 | ||
1398 | return $self->refresh($article, $cgi, undef, "Value saved"); | |
1399 | } | |
1400 | ||
1401 | =item a_confdel_option_value | |
1402 | ||
1403 | Displays a page confirming deletion of a product option value. | |
1404 | ||
1405 | Parameters: | |
1406 | ||
1407 | =over | |
1408 | ||
1409 | =item * | |
1410 | ||
1411 | id - article id | |
1412 | ||
1413 | =item * | |
1414 | ||
1415 | value_id - option value id | |
1416 | ||
1417 | =back | |
1418 | ||
1419 | Template: admin/prodopt_value_delete | |
1420 | ||
9b3a5df0 TC |
1421 | Permission required: bse_edit_prodopt_edit |
1422 | ||
58baa27b TC |
1423 | =cut |
1424 | ||
1425 | sub req_confdel_option_value { | |
1426 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
1427 | ||
9b3a5df0 TC |
1428 | $req->user_can(bse_edit_prodopt_edit => $article) |
1429 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1430 | ||
58baa27b TC |
1431 | return $self->_common_option_value('admin/prodopt_value_delete', $req, |
1432 | $article, $articles, $msg, $errors); | |
1433 | } | |
1434 | ||
1435 | =item a_delete_option_value | |
1436 | ||
1437 | Deletes a product option. | |
1438 | ||
1439 | On failure perform a service error. | |
1440 | ||
1441 | Requires _csrfp for admin_delete_option_value | |
1442 | ||
1443 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1444 | ||
1445 | { | |
1446 | success: 1, | |
1447 | } | |
1448 | ||
1449 | Parameters: | |
1450 | ||
1451 | =over | |
1452 | ||
1453 | =item * | |
1454 | ||
1455 | id - article id | |
1456 | ||
1457 | =item * | |
1458 | ||
1459 | value_id - id of the value to delete, must belong to the product | |
1460 | identified by id. | |
1461 | ||
1462 | =back | |
1463 | ||
9b3a5df0 TC |
1464 | Permission required: bse_edit_prodopt_edit |
1465 | ||
58baa27b TC |
1466 | =cut |
1467 | ||
1468 | sub req_delete_option_value { | |
1469 | my ($self, $req, $article, $articles, $msg, $errors) = @_; | |
1470 | ||
1471 | $req->check_csrf("admin_delete_option_value") | |
1472 | or return $self->csrf_error($req, $article, "admin_delete_option_value", "Delete Product Option Value"); | |
1473 | ||
9b3a5df0 TC |
1474 | $req->user_can(bse_edit_prodopt_edit => $article) |
1475 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1476 | ||
58baa27b TC |
1477 | my %errors; |
1478 | my $option_value = $self->_get_option_value($req, $article, \%errors); | |
1479 | keys %errors | |
1480 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1481 | ||
1482 | $option_value->remove; | |
1483 | ||
1484 | $req->is_ajax | |
1660ce30 | 1485 | and return $req->json_content |
58baa27b TC |
1486 | ( |
1487 | success => 1 | |
1488 | ); | |
1489 | ||
1490 | return $self->refresh($article, $req->cgi, undef, "Value removed"); | |
1491 | } | |
1492 | ||
1493 | sub tag_dboptionsjson { | |
1494 | my ($self, $article) = @_; | |
1495 | ||
1496 | my @result; | |
1497 | my @options = $article->db_options; | |
1498 | my @opt_cols = BSE::TB::ProductOption->columns; | |
1499 | for my $option (@options) { | |
1500 | my $entry = $option->data_only; | |
1501 | $entry->{values} = [ map $_->data_only, $option->values ]; | |
1502 | push @result, $entry; | |
1503 | } | |
1504 | ||
1505 | require JSON; | |
1506 | my $json = JSON->new; | |
1507 | return $json->encode(\@result); | |
1508 | } | |
1509 | ||
1510 | sub _option_move { | |
1511 | my ($self, $req, $article, $articles, $direction) = @_; | |
1512 | ||
1513 | $req->check_csrf("admin_move_option") | |
1514 | or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option"); | |
1515 | ||
9b3a5df0 TC |
1516 | $req->user_can(bse_edit_prodopt_move => $article) |
1517 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options"); | |
1518 | ||
58baa27b TC |
1519 | my %errors; |
1520 | my $option = $self->_get_option($req, $article, \%errors); | |
1521 | keys %errors | |
1522 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1523 | my @options = $article->db_options; | |
1524 | my ($index) = grep $options[$_]{id} == $option->{id}, 0 .. $#options | |
1525 | or return $self->_service_error($req, $article, $articles, "Unknown option id"); | |
1526 | ||
1527 | $options[$index] = $option; | |
1528 | ||
1529 | my $other_index = $index + $direction; | |
1530 | $other_index >= 0 && $other_index < @options | |
1531 | or return $self->_service_error($req, $article, $articles, "Can't move option beyond end"); | |
1532 | ||
1533 | my $other = $options[$other_index]; | |
1534 | ||
1535 | ($option->{display_order}, $other->{display_order}) = | |
1536 | ($other->{display_order}, $option->{display_order}); | |
1537 | $option->save; | |
1538 | $other->save; | |
1539 | ||
4de47893 TC |
1540 | if ($req->is_ajax) { |
1541 | @options = sort { $a->{display_order} <=> $b->{display_order} } @options; | |
9b3a5df0 | 1542 | return return $req->json_content |
58baa27b TC |
1543 | ( |
1544 | success => 1, | |
1545 | order => [ map $_->{id}, @options ] | |
1546 | ); | |
4de47893 | 1547 | } |
58baa27b TC |
1548 | |
1549 | return $self->refresh($article, $req->cgi, undef, "Option moved"); | |
1550 | } | |
1551 | ||
4de47893 | 1552 | =item a_option_moveup |
58baa27b | 1553 | |
4de47893 | 1554 | =item a_option_movedown |
58baa27b TC |
1555 | |
1556 | Move a product option up/down through the options for a product. | |
1557 | ||
1558 | On failure perform a service error. | |
1559 | ||
1560 | Requires _csrfp for admin_move_option | |
1561 | ||
1562 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1563 | ||
1564 | { | |
1565 | success: 1, | |
1566 | order: [ list of option ids ] | |
1567 | } | |
1568 | ||
1569 | Parameters: | |
1570 | ||
1571 | =over | |
1572 | ||
1573 | =item * | |
1574 | ||
1575 | id - article id | |
1576 | ||
1577 | =item * | |
1578 | ||
1579 | option_id - option id. This must belong to the product identified by | |
1580 | id. | |
1581 | ||
1582 | =back | |
1583 | ||
9b3a5df0 TC |
1584 | Permission required: bse_edit_prodopt_move |
1585 | ||
58baa27b TC |
1586 | =cut |
1587 | ||
1588 | sub req_option_moveup { | |
1589 | my ($self, $req, $article, $articles) = @_; | |
1590 | ||
1591 | return $self->_option_move($req, $article, $articles, -1); | |
1592 | } | |
1593 | ||
1594 | sub req_option_movedown { | |
1595 | my ($self, $req, $article, $articles) = @_; | |
1596 | ||
1597 | return $self->_option_move($req, $article, $articles, 1); | |
1598 | } | |
1599 | ||
1600 | =item a_option_reorder | |
1601 | ||
1602 | Move a product option up/down through the options for a product. | |
1603 | ||
1604 | On failure perform a service error. | |
1605 | ||
1606 | Requires _csrfp for admin_move_option | |
1607 | ||
1608 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1609 | ||
1610 | { | |
1611 | success: 1, | |
1612 | order: [ list of option ids ] | |
1613 | } | |
1614 | ||
1615 | Parameters: | |
1616 | ||
1617 | =over | |
1618 | ||
1619 | =item * | |
1620 | ||
1621 | id - article id | |
1622 | ||
1623 | =item * | |
1624 | ||
1625 | option_ids - option ids separated by commas. These must belong to the | |
1626 | product identified by id. | |
1627 | ||
1628 | =back | |
1629 | ||
9b3a5df0 TC |
1630 | Permission required: bse_edit_prodopt_move |
1631 | ||
58baa27b TC |
1632 | =cut |
1633 | ||
1634 | sub req_option_reorder { | |
1635 | my ($self, $req, $article, $articles) = @_; | |
1636 | ||
1637 | $req->check_csrf("admin_move_option") | |
1638 | or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option"); | |
1639 | ||
9b3a5df0 TC |
1640 | $req->user_can(bse_edit_prodopt_move => $article) |
1641 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options"); | |
1642 | ||
58baa27b TC |
1643 | my @options = $article->db_options; |
1644 | my @order = map { split ',' } $req->cgi->param('option_ids'); | |
1645 | my %options = map { $_->{id} => $_ } @options; | |
1646 | my @new_options; | |
1647 | for my $id (@order) { | |
1648 | my $option = delete $options{$id} | |
1649 | or next; | |
1650 | push @new_options, $option; | |
1651 | } | |
1652 | push @new_options, sort { $a->{display_order} <=> $b->{display_order} } values %options; | |
1653 | my @display_order = map $_->{display_order}, @options; | |
1654 | for my $index (0 .. $#new_options) { | |
1655 | $new_options[$index]{display_order} = $display_order[$index]; | |
1656 | $new_options[$index]->save; | |
1657 | } | |
1658 | ||
1659 | $req->is_ajax | |
1660 | and return $req->json_content | |
1661 | ( | |
1662 | success => 1, | |
1663 | order => [ map $_->{id}, @new_options ] | |
1664 | ); | |
1665 | ||
1666 | return $self->refresh($article, $req->cgi, undef, "Options reordered"); | |
1667 | } | |
1668 | ||
1669 | sub _option_value_move { | |
1670 | my ($self, $req, $article, $articles, $direction) = @_; | |
1671 | ||
1672 | $req->check_csrf("admin_move_option_value") | |
1673 | or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value"); | |
1674 | ||
9b3a5df0 TC |
1675 | $req->user_can(bse_edit_prodopt_edit => $article) |
1676 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1677 | ||
58baa27b TC |
1678 | my %errors; |
1679 | my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors); | |
1680 | keys %errors | |
1681 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1682 | my @values = $option->values; | |
1683 | my ($index) = grep $values[$_]{id} == $option_value->{id}, 0 .. $#values | |
1684 | or return $self->_service_error($req, $article, $articles, "Unknown option value id"); | |
1685 | ||
1686 | $values[$index] = $option_value; | |
1687 | ||
1688 | my $other_index = $index + $direction; | |
1689 | $other_index >= 0 && $other_index < @values | |
1690 | or return $self->_service_error($req, $article, $articles, "Can't move option value beyond end"); | |
1691 | ||
1692 | my $other = $values[$other_index]; | |
1693 | ||
1694 | ($option_value->{display_order}, $other->{display_order}) = | |
1695 | ($other->{display_order}, $option_value->{display_order}); | |
1696 | $option_value->save; | |
1697 | $other->save; | |
1698 | ||
9b3a5df0 TC |
1699 | # make sure the json gets the new order |
1700 | @values[$index, $other_index] = @values[$other_index, $index]; | |
1701 | ||
58baa27b | 1702 | $req->is_ajax |
9b3a5df0 | 1703 | and return $req->json_content |
58baa27b TC |
1704 | ( |
1705 | success => 1, | |
1706 | order => [ map $_->{id}, @values ] | |
1707 | ); | |
1708 | ||
1709 | return $self->refresh($article, $req->cgi, undef, "Value moved"); | |
1710 | } | |
1711 | ||
1712 | =item a_option_value_moveup | |
1713 | ||
1714 | =item a_option_value_movedown | |
1715 | ||
1716 | Move a product option value up/down through the values for a product | |
1717 | option. | |
1718 | ||
1719 | On failure perform a service error. | |
1720 | ||
1721 | Requires _csrfp for admin_move_option_value | |
1722 | ||
1723 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1724 | ||
1725 | { | |
1726 | success: 1, | |
1727 | order: [ list of value ids ] | |
1728 | } | |
1729 | ||
1730 | Parameters: | |
1731 | ||
1732 | =over | |
1733 | ||
1734 | =item * | |
1735 | ||
1736 | id - article id | |
1737 | ||
1738 | =item * | |
1739 | ||
1740 | value_id - option id. This must belong to the product identified by | |
1741 | id. | |
1742 | ||
1743 | =back | |
1744 | ||
9b3a5df0 TC |
1745 | Permission required: bse_edit_prodopt_edit |
1746 | ||
58baa27b TC |
1747 | =cut |
1748 | ||
1749 | sub req_option_value_moveup { | |
1750 | my ($self, $req, $article, $articles) = @_; | |
1751 | ||
1752 | return $self->_option_value_move($req, $article, $articles, -1); | |
1753 | } | |
1754 | ||
1755 | sub req_option_value_movedown { | |
1756 | my ($self, $req, $article, $articles) = @_; | |
1757 | ||
1758 | return $self->_option_value_move($req, $article, $articles, 1); | |
1759 | } | |
1760 | ||
1761 | =item a_option_value_reorder | |
1762 | ||
1763 | Specify a new order for the values belonging to a product option. | |
1764 | ||
1765 | On failure perform a service error. | |
1766 | ||
1767 | Requires _csrfp for admin_move_option_value | |
1768 | ||
1769 | For Ajax requests (or with a _ parameter), returns JSON like: | |
1770 | ||
1771 | { | |
1772 | success: 1, | |
1773 | order: [ list of value ids ] | |
1774 | } | |
1775 | ||
1776 | Parameters: | |
1777 | ||
1778 | =over | |
1779 | ||
1780 | =item * | |
1781 | ||
1782 | id - article id | |
1783 | ||
1784 | =item * | |
1785 | ||
4de47893 TC |
1786 | option_id - the option to reorder values for |
1787 | ||
1788 | =item * | |
1789 | ||
58baa27b TC |
1790 | value_ids - new order for values specified as value ids separated by |
1791 | commas. | |
1792 | ||
1793 | =back | |
1794 | ||
9b3a5df0 TC |
1795 | Permission required: bse_edit_prodopt_edit |
1796 | ||
58baa27b TC |
1797 | =cut |
1798 | ||
1799 | sub req_option_value_reorder { | |
1800 | my ($self, $req, $article, $articles) = @_; | |
1801 | ||
1802 | $req->check_csrf("admin_move_option_value") | |
1803 | or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value"); | |
1804 | ||
9b3a5df0 TC |
1805 | $req->user_can(bse_edit_prodopt_edit => $article) |
1806 | or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options"); | |
1807 | ||
58baa27b TC |
1808 | my %errors; |
1809 | my $option = $self->_get_option($req, $article, \%errors); | |
1810 | keys %errors | |
1811 | and return $self->_service_error($req, $article, $articles, undef, \%errors); | |
1812 | my @order = map { split ',' } $req->cgi->param('value_ids'); | |
1813 | my @values = $option->values; | |
1814 | my %values = map { $_->{id} => $_ } @values; | |
1815 | my @new_values; | |
1816 | for my $id (@order) { | |
1817 | my $value = delete $values{$id} | |
1818 | or next; | |
1819 | push @new_values, $value; | |
1820 | } | |
1821 | push @new_values, sort { $a->{display_order} <=> $b->{display_order} } values %values; | |
1822 | my @display_order = map $_->{display_order}, @values; | |
1823 | for my $index (0 .. $#new_values) { | |
1824 | $new_values[$index]{display_order} = $display_order[$index]; | |
1825 | $new_values[$index]->save; | |
1826 | } | |
1827 | ||
1828 | $req->is_ajax | |
1829 | and return $req->json_content | |
1830 | ( | |
1831 | success => 1, | |
1832 | option => $option->data_only, | |
1833 | order => [ map $_->{id}, @new_values ] | |
1834 | ); | |
1835 | ||
1836 | return $self->refresh($article, $req->cgi, undef, "Values reordered"); | |
1837 | } | |
1838 | ||
59fca225 TC |
1839 | sub custom_fields { |
1840 | my ($self) = @_; | |
1841 | ||
1842 | my $custom = $self->SUPER::custom_fields(); | |
1843 | ||
1844 | require DevHelp::Validate; | |
1845 | DevHelp::Validate->import; | |
1846 | return DevHelp::Validate::dh_configure_fields | |
1847 | ( | |
1848 | $custom, | |
1849 | $self->cfg, | |
1850 | PRODUCT_CUSTOM_FIELDS_CFG, | |
1851 | BSE::DB->single->dbh, | |
1852 | ); | |
1853 | } | |
1854 | ||
58baa27b TC |
1855 | sub article_actions { |
1856 | my $self = shift; | |
1857 | ||
1858 | return | |
1859 | ( | |
1860 | $self->SUPER::article_actions, | |
1861 | a_add_option => 'req_add_option', | |
1862 | a_confdel_option => 'req_confdel_option', | |
1863 | a_del_option => 'req_del_option', | |
1864 | a_edit_option => 'req_edit_option', | |
1865 | a_save_option => 'req_save_option', | |
1866 | a_delconf_option => 'req_delconf_option', | |
1867 | a_delete_option => 'req_delete_option', | |
1868 | a_get_option => 'req_get_option', | |
1869 | a_edit_option_value => 'req_edit_option_value', | |
1870 | a_save_option_value => 'req_save_option_value', | |
1871 | a_confdel_option_value => 'req_confdel_option_value', | |
1872 | a_delete_option_value => 'req_delete_option_value', | |
1873 | a_add_option_value => 'req_add_option_value', | |
1874 | a_option_value_moveup => 'req_option_value_moveup', | |
1875 | a_option_value_movedown => 'req_option_value_movedown', | |
1876 | a_option_value_reorder => 'req_option_value_reorder', | |
1877 | a_option_moveup => 'req_option_moveup', | |
1878 | a_option_movedown => 'req_option_movedown', | |
1879 | a_option_reorder => 'req_option_reorder', | |
1880 | ); | |
1881 | } | |
1882 | ||
ca9aa2bf | 1883 | 1; |
d8b4c773 TC |
1884 | |
1885 | =back | |
1886 | ||
1887 | =head1 AUTHOR | |
1888 | ||
1889 | Tony Cook <tony@develop-help.com> | |
1890 | ||
1891 | =cut |