allow more values when creating a product option
[bse.git] / site / cgi-bin / modules / BSE / Edit / Product.pm
CommitLineData
ca9aa2bf
TC
1package BSE::Edit::Product;
2use strict;
3use base 'BSE::Edit::Article';
10dd37f9 4use BSE::TB::Products;
ca9aa2bf 5use HTML::Entities;
aefcabcb 6use BSE::Template;
0ec4ac8a 7use BSE::Util::Iterate;
3f9c8a96 8use BSE::Util::HTML;
2076966c 9use BSE::CfgInfo 'product_options';
ea71fc0d 10use BSE::Util::Tags qw(tag_hash tag_article);
59fca225 11use constant PRODUCT_CUSTOM_FIELDS_CFG => "product custom fields";
58baa27b 12
0bdcab3b 13our $VERSION = "1.016";
cb7fd78d 14
58baa27b
TC
15=head1 NAME
16
17BSE::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
25Article editor subclass for editing Products.
26
27=cut
ca9aa2bf
TC
28
29my %money_fields =
30 (
31 retailPrice => "Retail price",
32 wholesalePrice => "Wholesale price",
33 gst => "GST",
34 );
35
f09e8b4f 36sub generator { 'BSE::Generate::Product' }
ca9aa2bf 37
0bdcab3b
TC
38sub _make_dummy_article {
39 my ($self, $article) = @_;
40
41 require BSE::DummyProduct;
42 return bless $article, "BSE::DummyProduct";
43}
44
ca9aa2bf
TC
45sub base_template_dirs {
46 return ( "products" );
47}
48
49sub 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
64sub 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
76sub iter_subs {
77 require BSE::TB::Subscriptions;
78 BSE::TB::Subscriptions->all;
79}
0ec4ac8a 80
58baa27b
TC
81sub 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
90sub 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
101sub 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
129sub 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
157sub 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
174sub 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
181sub 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
188sub _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
208sub 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
221sub 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
232These a tags available on admin/edit_* pages specific to products.
233
234=over
235
236=item *
237
238product I<field> - display the given field from the product being edited.
239
240=item *
241
242iterator begin dboptions ... dboption I<field> ... iterator end dboptions
243
244- iterate over the existing database stored options for the product
245
246=item *
247
248dboption_move - display arrows to move the current dboption. The span
249for the arrows is given an id of "prodoptmoveI<option-id>" by default.
250
251=item *
252
253iterator begin dboptionvalues ... dboptionvalue I<field> ... iterator end dboptionvalues
254
255- iterate over the values for the current dboption
256
257=item *
258
259dboptionvalue_move - display arrows to move the current dboption. The
260span for the arrows is given an id of "prodoptvaluemoveI<value-id>"
261by default.
262
263=item *
264
265dboptionsjson - returns the product options as JSON.
266
dfd483db
TC
267=item *
268
269iterator begin price_tiers ... price_tier I<field> ... iterator end price_tiers
270
271Iterate over the configured price tiers.
272
273=item *
274
275tier_price
276
277Return the price at the current price_tier. Returns an empty string
278if there's no price at this tier.
279
58baa27b
TC
280=back
281
282=cut
283
ca9aa2bf
TC
284sub 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
353sub 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
365sub 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
372sub 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
385sub _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
450sub 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
465sub 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
474sub 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
500sub table_object {
501 my ($self, $articles) = @_;
502
10dd37f9 503 'BSE::TB::Products';
ca9aa2bf
TC
504}
505
506sub get_article {
507 my ($self, $articles, $article) = @_;
508
10dd37f9 509 return BSE::TB::Products->getByPkey($article->{id});
ca9aa2bf
TC
510}
511
95989433
TC
512sub default_link_path {
513 my ($self, $article) = @_;
514
515 $self->{cfg}->entry('uri', 'shop', '/shop');
516}
517
ca9aa2bf
TC
518sub 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
540sub _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
585sub 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
593sub 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
601sub 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
611sub flag_sections {
612 my ($self) = @_;
613
614 return ( 'product flags', $self->SUPER::flag_sections );
615}
616
6d91d9dc
TC
617sub shop_article { 1 }
618
0ec4ac8a
TC
619my %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
638sub 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
649sub 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
658my %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 672 },
58baa27b
TC
673 );
674
675=head1 Targets
676
677Actions you can request from add.pl for products.
678
679=over
680
681=item a_add_option
682
683Add a new product option.
684
685On failure perform a service error.
686
687Requires _csrfp for admin_add_option
688
689For Ajax requests (or with a _ parameter) returns JSON like:
690
691 {
692 success: 1,
693 option: { <option data> },
694 values: [ { value data }, { value data }, ... ]
695 }
696
697Parameters:
698
699=over
700
701=item *
702
703id - Article id
704
705=item *
706
707name - Name of the option (required)
708
709=item *
710
711value1 .. value5 - if any of these are non-blank they are added to the
712option as values.
713
714=back
715
9b3a5df0
TC
716Permission required: bse_edit_prodopt_add
717
58baa27b
TC
718=cut
719
720sub req_add_option {
721 my ($self, $req, $article, $articles, $msg, $errors) = @_;
722
723 $req->check_csrf('admin_add_option')
724 or return $self->csrf_error($req, $article, "admin_add_option", "Add Product Option");
725
9b3a5df0
TC
726 $req->user_can(bse_edit_prodopt_add => $article)
727 or return $self->_service_error($req, $article, $articles, "Insufficient product access to add options");
728
58baa27b 729 my %errors;
e00cfb72
TC
730 my %work_option_fields = \%option_fields;
731 for my $field (grep /^value[1-9][0-9]*$/, $req->cgi->param) {
732 my ($index) = ( $field =~ /([1-9][0-9]*)$/);
733 $work_option_fields{$field} =
734 {
735 description => "Value $index",
736 rules => "dh_one_line",
737 maxlength => 255,
738 };
739 }
740 $req->validate(fields => \%work_option_fields,
58baa27b
TC
741 errors => \%errors);
742 keys %errors
743 and return $self->_service_error($req, $article, $articles, undef,
744 \%errors);
745
746 my $cgi = $req->cgi;
747 require BSE::TB::ProductOptions;
748 require BSE::TB::ProductOptionValues;
749 my $option = BSE::TB::ProductOptions->make
750 (
751 product_id => $article->{id},
752 name => scalar($cgi->param('name')),
753 display_order => time,
754 );
755
756 my $order = time;
757 my @values;
abcd71ea 758 my %value_keys;
e00cfb72 759 for my $value_key (sort grep /^value/, keys %work_option_fields) {
58baa27b
TC
760 my ($value) = $cgi->param($value_key);
761 if (defined $value && $value =~ /\S/) {
762 my $entry = BSE::TB::ProductOptionValues->make
763 (
764 product_option_id => $option->{id},
765 value => $value,
766 display_order => $order,
767 );
768 push @values, $entry;
abcd71ea 769 $value_keys{$value_key} = $entry;
58baa27b
TC
770 ++$order;
771 }
772 }
abcd71ea
TC
773 my $def = $cgi->param("default");
774 if ($def && $value_keys{$def}) {
775 $option->set_default_value($value_keys{$def}->id);
776 $option->save;
777 }
58baa27b
TC
778
779 $req->is_ajax
780 and return $req->json_content
781 (
782 success => 1,
783 option => $option->data_only,
784 values => [ map $_->data_only, @values ]
785 );
786
787 return $self->refresh($article, $cgi, undef, "Option added");
788}
789
790my %option_id =
791 (
792 option_id =>
793 {
794 rules => "required;positiveint",
795 },
796 );
797
798sub _get_option {
799 my ($self, $req, $article, $errors) = @_;
800
801 my $option;
802 my $cgi = $req->cgi;
803 $req->validate(fields => \%option_id,
804 errors => $errors);
4de47893
TC
805 my @option_ids = $cgi->param("option_id");
806 unless ($errors->{option_id}) {
807 @option_ids == 1
808 or $errors->{option_id} = "This request accepts only one option_id";
809 }
58baa27b
TC
810 unless ($errors->{option_id}) {
811 require BSE::TB::ProductOptions;
812 $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id"));
813 $option
814 or $errors->{option_id} = "Unknown option id";
815 }
816 unless ($errors->{option_id}) {
817 $option->{product_id} = $article->{id}
818 or $errors->{option_id} = "Option doesn't belong to this product";
819 }
820 $errors->{option_id}
821 and return;
822
823 return $option;
824}
825
826sub _common_option {
827 my ($self, $template, $req, $article, $articles, $msg, $errors) = @_;
828
829 my %errors;
830 my $option = $self->_get_option($req, $article, \%errors);
831 keys %errors
832 and return $self->_service_error($req, $article, $articles, undef, \%errors);
833
5b816615
TC
834 $req->set_variable(option => $option);
835 $req->messages($errors);
58baa27b
TC
836 my $it = BSE::Util::Iterate->new;
837 my %acts;
838 %acts =
839 (
840 $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
841 option => [ \&tag_hash, $option ],
842 $it->make
843 (
844 single => "dboptionvalue",
845 plural => "dboptionvalues",
846 code => [ iter_option_values => $self, \$option ],
847 ),
848 );
849
850 return $req->dyn_response($template, \%acts);
851}
852
853=item a_edit_option
854
855Produce a form to edit the given option.
856
857Parameters:
858
859=over
860
861=item *
862
863id - article id
864
865=item *
866
867option_id - option id. This must belong to the product identified by
868id.
869
870=back
871
872Template: admin/prodopt_edit
873
9b3a5df0
TC
874Permission required: bse_edit_prodopt_edit
875
58baa27b
TC
876=cut
877
878sub req_edit_option {
879 my ($self, $req, $article, $articles, $msg, $errors) = @_;
880
9b3a5df0
TC
881 $req->user_can(bse_edit_prodopt_edit => $article)
882 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
883
58baa27b
TC
884 return $self->_common_option('admin/prodopt_edit', $req, $article,
885 $articles, $msg, $errors);
886}
887
888my %option_name =
889 (
890 name =>
891 {
892 description => "Option name",
9eebac67 893 rules => "required;dh_one_line",
085b34a0 894 maxlength => 255,
58baa27b
TC
895 },
896 default_value =>
897 {
898 description => "Default Value",
9b3a5df0 899 rules => "positiveint"
58baa27b
TC
900 }
901 );
902
903my %option_value =
904 (
905 description => "Value",
9eebac67 906 rules => "required;dh_one_line",
085b34a0 907 maxlength => 255,
58baa27b
TC
908 );
909
910=item a_save_option
911
912Saves changes to an option.
913
914On failure perform a service error.
915
916Requires _csrfp for admin_save_option
917
918For Ajax requests (or with a _ parameter), returns JSON like:
919
920 {
921 success: 1,
922 option: { <option data> },
923 values: [ { value data, value data, ... } ]
924 }
925
926Parameters:
927
928=over
929
930=item *
931
932id - article id
933
934=item *
935
936option_id - id of the option to save, must belong to the product
937identified by id.
938
939=item *
940
941name - new value for the name field
942
943=item *
944
945default_value - id of the default value
946
947=item *
948
949save_enabled - if supplied and true, set enabled from the enabled
950parameter.
951
952=item *
953
954enabled - If supplied and true, enable the option, otherwise disable
955it. Ignored unless save_enabled is true.
956
957=item *
958
959valueI<value-id> - set the displayed value for the value record
5708b3ac
TC
960identified by I<value-id>. If these aren't supplied the values aren't
961changed.
58baa27b
TC
962
963=back
964
9b3a5df0
TC
965Permission required: bse_edit_prodopt_save
966
58baa27b
TC
967=cut
968
969sub req_save_option {
970 my ($self, $req, $article, $articles) = @_;
971
972 my $cgi = $req->cgi;
973
974 $req->check_csrf("admin_save_option")
975 or return $self->csrf_error($req, $article, "admin_save_option", "Save Product Option");
976
9b3a5df0
TC
977 $req->user_can(bse_edit_prodopt_edit => $article)
978 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
979
58baa27b
TC
980 my %errors;
981 my $option = $self->_get_option($req, $article, \%errors);
982 keys %errors
d445674b 983 and return $self->_service_error($req, $article, $articles, undef, \%errors, 'FIELD', "req_edit_option");
9b3a5df0 984 $req->validate(fields => \%option_name,
58baa27b
TC
985 errors => \%errors);
986 my @values = $option->values;
987 my %fields = map {; "value$_->{id}" => \%option_value } @values;
9b3a5df0
TC
988 $req->validate(fields => \%fields,
989 errors => \%errors,
990 optional => 1);
58baa27b
TC
991 my $default_value = $cgi->param('default_value');
992 if (!$errors{default_value} && $default_value) {
993 grep $_->{id} == $default_value, @values
994 or $errors{default_value} = "Unknown value selected as default";
995 }
d445674b
TC
996
997 $DB::single = 1;
998 my @new_values;
999 my $index = 1;
1000 while ($index < 10 && defined $cgi->param("newvalue$index")) {
1001 my $field = "newvalue$index";
1002 my $value = $cgi->param($field);
1003 $req->validate(fields => { $field => \%option_value },
1004 errors => \%errors);
1005 push @new_values, $value;
1006
1007 ++$index;
1008 }
1009
58baa27b 1010 keys %errors
d445674b 1011 and return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD", "req_edit_option");
58baa27b
TC
1012
1013 my $name = $cgi->param("name");
1014 defined $name
1015 and $option->set_name($name);
1016 defined $default_value
1017 and $option->set_default_value($default_value);
1018 if ($cgi->param("save_enabled")) {
1019 my $enabled = $cgi->param("enabled") ? 1 : 0;
1020 $option->set_enabled($enabled);
1021 }
1022 $option->save;
1023 for my $value (@values) {
1024 my $new_value = $cgi->param("value$value->{id}");
5708b3ac 1025 if (defined $new_value && $new_value ne $value->value) {
58baa27b
TC
1026 $value->set_value($new_value);
1027 $value->save;
1028 }
1029 }
d445674b
TC
1030 my $order = @values ? $values[-1]->display_order : time;
1031 for my $value (@new_values) {
1032 BSE::TB::ProductOptionValues->make
1033 (
1034 product_option_id => $option->id,
1035 value => $value,
1036 display_order => ++$order,
1037 );
1038 }
58baa27b
TC
1039
1040 $req->is_ajax
1041 and return $req->json_content
1042 (
1043 success => 1,
1044 option => $option->data_only,
1045 values => [ map $_->data_only, @values ],
1046 );
1047
d445674b
TC
1048 return $self->refresh($article, $req->cgi, undef,
1049 "Option '" . $option->name . "' saved");
58baa27b
TC
1050}
1051
1052=item a_delconf_option
1053
1054Produce a form to confirm deletion of the given option.
1055
1056Parameters:
1057
1058=over
1059
1060=item *
1061
1062id - article id
1063
1064=item *
1065
1066option_id - option id. This must belong to the product identified by
1067id.
1068
1069=back
1070
1071Template: admin/prodopt_delete
1072
1073=cut
1074
1075sub req_delconf_option {
1076 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1077
9b3a5df0
TC
1078 $req->user_can(bse_edit_prodopt_delete => $article)
1079 or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options");
1080
58baa27b
TC
1081 return $self->_common_option('admin/prodopt_delete', $req, $article,
1082 $articles, $msg, $errors);
1083}
1084
1085=item a_delete_option
1086
1087Delete the given option.
1088
1089On failure perform a service error.
1090
1091Requires _csrfp for admin_delete_option
1092
1093For Ajax requests (or with a _ parameter), returns JSON like:
1094
1095 {
1096 success: 1,
1097 }
1098
9b3a5df0
TC
1099Permission required: bse_edit_prodopt_delete
1100
58baa27b
TC
1101=cut
1102
1103sub req_delete_option {
1104 my ($self, $req, $article, $articles) = @_;
1105
1106 $req->check_csrf("admin_delete_option")
1107 or return $self->csrf_error($req, $article, "admin_delete_option", "Delete Product Option");
1108
9b3a5df0
TC
1109 $req->user_can(bse_edit_prodopt_delete => $article)
1110 or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options");
1111
58baa27b
TC
1112 my %errors;
1113 my $option = $self->_get_option($req, $article, \%errors);
1114 keys %errors
1115 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1116 my @values = $option->values;
1117
1118 for my $value (@values) {
1119 $value->remove;
1120 }
1121 $option->remove;
1122
1123 $req->is_ajax
1124 and return $req->json_content
1125 (
1126 success => 1
1127 );
1128
1129 return $self->refresh($article, $req->cgi, undef, "Option deleted");
1130}
1131
1132
1133my %add_option_value_fields =
1134 (
1135 option_id =>
1136 {
1137 description => "Option id",
1138 rules => "required;positiveint",
1139 },
1140 value =>
1141 {
1142 description => "Value",
085b34a0
TC
1143 rules => "required;dh_one_line",
1144 maxlength => 255,
58baa27b
TC
1145 },
1146 );
1147
1148=item a_add_option_value
1149
1150Add a value to a product option.
1151
1152On failure perform a service error, see BSE::Edit::Article::_service_error.
1153
1154Requires _csrfp for admin_add_option_value
1155
1156For Ajax requests returns JSON like
d8b4c773 1157
58baa27b
TC
1158 { success: 1, value: (valueobject) }
1159
1160Standard redirect on success otherwise.
1161
1162Parameters:
1163
1164=over
1165
1166=item *
1167
1168id - article id
1169
1170=item *
1171
1172option_id - id of the option to add the value to
1173
1174=item *
1175
1176value - text of the value to add.
1177
1178=back
1179
9b3a5df0
TC
1180Permission required: bse_edit_prodopt_edit
1181
58baa27b
TC
1182=cut
1183
1184sub req_add_option_value {
1185 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1186
1187 $req->check_csrf("admin_add_option_value")
1188 or return $self->csrf_error($req, $article, "admin_add_option_value", "Add Product Option Value");
1189
9b3a5df0
TC
1190 $req->user_can(bse_edit_prodopt_edit => $article)
1191 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1192
58baa27b
TC
1193 my %errors;
1194 $req->validate(fields => \%add_option_value_fields,
1195 errors => \%errors);
1196 my $option;
1197 my $cgi = $req->cgi;
1198 unless ($errors{option_id}) {
1199 require BSE::TB::ProductOptions;
1200 $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id"));
1201 defined $option && $option->{product_id}
1202 or $errors{option_id} = "Bad option id - either unknown or for a different product";
1203 }
1204 keys %errors
1205 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1206
1207 my $value = $cgi->param("value");
1208 require BSE::TB::ProductOptionValues;
1209 my $entry = BSE::TB::ProductOptionValues->make
1210 (
1211 product_option_id => $option->{id},
1212 value => $value,
1213 display_order => time,
1214 );
1215
1216 $req->is_ajax
1660ce30 1217 and return $req->json_content
58baa27b
TC
1218 (
1219 success => 1,
1220 value => $entry->data_only
1221 );
1222
1223 return $self->refresh($article, $cgi, undef, "Value added");
1224}
1225
1226
1227my %option_value_id =
1228 (
1229 value_id =>
1230 {
1231 rules => "required;positiveint",
1232 },
1233 );
1234
1235sub _get_option_value {
1236 my ($self, $req, $article, $errors) = @_;
1237
1238 my $option_value;
1239 my $cgi = $req->cgi;
1240 $req->validate(fields => \%option_value_id,
1241 errors => $errors);
1242 unless ($errors->{value_id}) {
1243 require BSE::TB::ProductOptionValues;
1244 $option_value = BSE::TB::ProductOptionValues->getByPkey($cgi->param("value_id"));
1245 $option_value
1246 or $errors->{value_id} = "Unknown option value id";
1247 }
1248 my $option;
1249 unless ($errors->{value_id}) {
1250 $option = $option_value->option;
1251 defined $option && $option->{product_id} == $article->{id}
1252 or $errors->{value_id} = "Value has no option or doesn't belong to the product";
1253 }
1254
1255 $errors->{value_id}
1256 and return;
1257
1258 return wantarray ? ( $option_value, $option ) : $option_value ;
1259}
1260
1261sub _common_option_value {
1262 my ($self, $template, $req, $article, $articles, $msg, $errors) = @_;
1263
1264 my %errors;
1265 my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors);
1266 keys %errors
1267 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1268
5b816615
TC
1269 $req->set_variable(option => $option);
1270 $req->set_variable(option_value => $option_value);
58baa27b
TC
1271 my %acts;
1272 %acts =
1273 (
1274 $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
1275 option_value => [ \&tag_hash, $option_value ],
1276 option => [ \&tag_hash, $option ],
1277 );
1278
1279 return $req->dyn_response($template, \%acts);
1280}
1281
1282=item a_edit_option_value
1283
1284Displays a form to edit the value for a given option.
1285
1286Parameters:
1287
1288=over
1289
1290=item *
1291
1292id - id of the product
1293
1294=item *
1295
1296value_id - id of he product option value to edit, must belong to the
1297given product.
1298
1299=back
1300
1301Template: admin/prodopt_value_edit
1302
9b3a5df0
TC
1303Permission required: bse_edit_prodopt_edit
1304
58baa27b
TC
1305=cut
1306
1307sub req_edit_option_value {
1308 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1309
9b3a5df0
TC
1310 $req->user_can(bse_edit_prodopt_edit => $article)
1311 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1312
58baa27b
TC
1313 return $self->_common_option_value('admin/prodopt_value_edit', $req,
1314 $article, $articles, $msg, $errors);
1315}
1316
1317my %save_option_value_fields =
1318 (
1319 value =>
1320 {
1321 rules => "required;dh_one_line",
085b34a0 1322 maxlength => 255,
58baa27b
TC
1323 },
1324 );
1325
1326=item a_save_option_value
1327
1328Saves changes to an option.
1329
1330On failure perform a service error.
1331
1332Requires _csrfp for admin_save_option_value
1333
1334For Ajax requests (or with a _ parameter), returns JSON like:
1335
1336 {
1337 success: 1,
1338 value: { value data }
1339 }
1340
1341Parameters:
1342
1343=over
1344
1345=item *
1346
1347id - article id
1348
1349=item *
1350
1351value_id - id of the value to save, must belong to the product
1352identified by id.
1353
1354=item *
1355
1356value - new displayed value for the option value.
1357
1358=back
1359
9b3a5df0
TC
1360Permission required: bse_edit_prodopt_edit
1361
58baa27b
TC
1362=cut
1363
1364sub req_save_option_value {
1365 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1366
1367 $req->check_csrf("admin_save_option_value")
1368 or return $self->csrf_error($req, $article, "admin_save_option_value", "Save Product Option Value");
1369
9b3a5df0
TC
1370 $req->user_can(bse_edit_prodopt_edit => $article)
1371 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1372
58baa27b
TC
1373 my %errors;
1374 $req->validate(fields => \%save_option_value_fields,
1375 errors => \%errors);
1376 my $option_value = $self->_get_option_value($req, $article, \%errors);
1377 keys %errors
1378 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1379
1380 my $cgi = $req->cgi;
1381 $option_value->{value} = $cgi->param("value");
1382 $option_value->save;
1383
1384 $req->is_ajax
1660ce30 1385 and return $req->json_content
58baa27b
TC
1386 (
1387 success => 1,
1388 value => $option_value->data_only
1389 );
1390
1391 return $self->refresh($article, $cgi, undef, "Value saved");
1392}
1393
1394=item a_confdel_option_value
1395
1396Displays a page confirming deletion of a product option value.
1397
1398Parameters:
1399
1400=over
1401
1402=item *
1403
1404id - article id
1405
1406=item *
1407
1408value_id - option value id
1409
1410=back
1411
1412Template: admin/prodopt_value_delete
1413
9b3a5df0
TC
1414Permission required: bse_edit_prodopt_edit
1415
58baa27b
TC
1416=cut
1417
1418sub req_confdel_option_value {
1419 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1420
9b3a5df0
TC
1421 $req->user_can(bse_edit_prodopt_edit => $article)
1422 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1423
58baa27b
TC
1424 return $self->_common_option_value('admin/prodopt_value_delete', $req,
1425 $article, $articles, $msg, $errors);
1426}
1427
1428=item a_delete_option_value
1429
1430Deletes a product option.
1431
1432On failure perform a service error.
1433
1434Requires _csrfp for admin_delete_option_value
1435
1436For Ajax requests (or with a _ parameter), returns JSON like:
1437
1438 {
1439 success: 1,
1440 }
1441
1442Parameters:
1443
1444=over
1445
1446=item *
1447
1448id - article id
1449
1450=item *
1451
1452value_id - id of the value to delete, must belong to the product
1453identified by id.
1454
1455=back
1456
9b3a5df0
TC
1457Permission required: bse_edit_prodopt_edit
1458
58baa27b
TC
1459=cut
1460
1461sub req_delete_option_value {
1462 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1463
1464 $req->check_csrf("admin_delete_option_value")
1465 or return $self->csrf_error($req, $article, "admin_delete_option_value", "Delete Product Option Value");
1466
9b3a5df0
TC
1467 $req->user_can(bse_edit_prodopt_edit => $article)
1468 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1469
58baa27b
TC
1470 my %errors;
1471 my $option_value = $self->_get_option_value($req, $article, \%errors);
1472 keys %errors
1473 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1474
1475 $option_value->remove;
1476
1477 $req->is_ajax
1660ce30 1478 and return $req->json_content
58baa27b
TC
1479 (
1480 success => 1
1481 );
1482
1483 return $self->refresh($article, $req->cgi, undef, "Value removed");
1484}
1485
1486sub tag_dboptionsjson {
1487 my ($self, $article) = @_;
1488
1489 my @result;
1490 my @options = $article->db_options;
1491 my @opt_cols = BSE::TB::ProductOption->columns;
1492 for my $option (@options) {
1493 my $entry = $option->data_only;
1494 $entry->{values} = [ map $_->data_only, $option->values ];
1495 push @result, $entry;
1496 }
1497
1498 require JSON;
1499 my $json = JSON->new;
1500 return $json->encode(\@result);
1501}
1502
1503sub _option_move {
1504 my ($self, $req, $article, $articles, $direction) = @_;
1505
1506 $req->check_csrf("admin_move_option")
1507 or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option");
1508
9b3a5df0
TC
1509 $req->user_can(bse_edit_prodopt_move => $article)
1510 or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options");
1511
58baa27b
TC
1512 my %errors;
1513 my $option = $self->_get_option($req, $article, \%errors);
1514 keys %errors
1515 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1516 my @options = $article->db_options;
1517 my ($index) = grep $options[$_]{id} == $option->{id}, 0 .. $#options
1518 or return $self->_service_error($req, $article, $articles, "Unknown option id");
1519
1520 $options[$index] = $option;
1521
1522 my $other_index = $index + $direction;
1523 $other_index >= 0 && $other_index < @options
1524 or return $self->_service_error($req, $article, $articles, "Can't move option beyond end");
1525
1526 my $other = $options[$other_index];
1527
1528 ($option->{display_order}, $other->{display_order}) =
1529 ($other->{display_order}, $option->{display_order});
1530 $option->save;
1531 $other->save;
1532
4de47893
TC
1533 if ($req->is_ajax) {
1534 @options = sort { $a->{display_order} <=> $b->{display_order} } @options;
9b3a5df0 1535 return return $req->json_content
58baa27b
TC
1536 (
1537 success => 1,
1538 order => [ map $_->{id}, @options ]
1539 );
4de47893 1540 }
58baa27b
TC
1541
1542 return $self->refresh($article, $req->cgi, undef, "Option moved");
1543}
1544
4de47893 1545=item a_option_moveup
58baa27b 1546
4de47893 1547=item a_option_movedown
58baa27b
TC
1548
1549Move a product option up/down through the options for a product.
1550
1551On failure perform a service error.
1552
1553Requires _csrfp for admin_move_option
1554
1555For Ajax requests (or with a _ parameter), returns JSON like:
1556
1557 {
1558 success: 1,
1559 order: [ list of option ids ]
1560 }
1561
1562Parameters:
1563
1564=over
1565
1566=item *
1567
1568id - article id
1569
1570=item *
1571
1572option_id - option id. This must belong to the product identified by
1573id.
1574
1575=back
1576
9b3a5df0
TC
1577Permission required: bse_edit_prodopt_move
1578
58baa27b
TC
1579=cut
1580
1581sub req_option_moveup {
1582 my ($self, $req, $article, $articles) = @_;
1583
1584 return $self->_option_move($req, $article, $articles, -1);
1585}
1586
1587sub req_option_movedown {
1588 my ($self, $req, $article, $articles) = @_;
1589
1590 return $self->_option_move($req, $article, $articles, 1);
1591}
1592
1593=item a_option_reorder
1594
1595Move a product option up/down through the options for a product.
1596
1597On failure perform a service error.
1598
1599Requires _csrfp for admin_move_option
1600
1601For Ajax requests (or with a _ parameter), returns JSON like:
1602
1603 {
1604 success: 1,
1605 order: [ list of option ids ]
1606 }
1607
1608Parameters:
1609
1610=over
1611
1612=item *
1613
1614id - article id
1615
1616=item *
1617
1618option_ids - option ids separated by commas. These must belong to the
1619product identified by id.
1620
1621=back
1622
9b3a5df0
TC
1623Permission required: bse_edit_prodopt_move
1624
58baa27b
TC
1625=cut
1626
1627sub req_option_reorder {
1628 my ($self, $req, $article, $articles) = @_;
1629
1630 $req->check_csrf("admin_move_option")
1631 or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option");
1632
9b3a5df0
TC
1633 $req->user_can(bse_edit_prodopt_move => $article)
1634 or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options");
1635
58baa27b
TC
1636 my @options = $article->db_options;
1637 my @order = map { split ',' } $req->cgi->param('option_ids');
1638 my %options = map { $_->{id} => $_ } @options;
1639 my @new_options;
1640 for my $id (@order) {
1641 my $option = delete $options{$id}
1642 or next;
1643 push @new_options, $option;
1644 }
1645 push @new_options, sort { $a->{display_order} <=> $b->{display_order} } values %options;
1646 my @display_order = map $_->{display_order}, @options;
1647 for my $index (0 .. $#new_options) {
1648 $new_options[$index]{display_order} = $display_order[$index];
1649 $new_options[$index]->save;
1650 }
1651
1652 $req->is_ajax
1653 and return $req->json_content
1654 (
1655 success => 1,
1656 order => [ map $_->{id}, @new_options ]
1657 );
1658
1659 return $self->refresh($article, $req->cgi, undef, "Options reordered");
1660}
1661
1662sub _option_value_move {
1663 my ($self, $req, $article, $articles, $direction) = @_;
1664
1665 $req->check_csrf("admin_move_option_value")
1666 or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value");
1667
9b3a5df0
TC
1668 $req->user_can(bse_edit_prodopt_edit => $article)
1669 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1670
58baa27b
TC
1671 my %errors;
1672 my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors);
1673 keys %errors
1674 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1675 my @values = $option->values;
1676 my ($index) = grep $values[$_]{id} == $option_value->{id}, 0 .. $#values
1677 or return $self->_service_error($req, $article, $articles, "Unknown option value id");
1678
1679 $values[$index] = $option_value;
1680
1681 my $other_index = $index + $direction;
1682 $other_index >= 0 && $other_index < @values
1683 or return $self->_service_error($req, $article, $articles, "Can't move option value beyond end");
1684
1685 my $other = $values[$other_index];
1686
1687 ($option_value->{display_order}, $other->{display_order}) =
1688 ($other->{display_order}, $option_value->{display_order});
1689 $option_value->save;
1690 $other->save;
1691
9b3a5df0
TC
1692 # make sure the json gets the new order
1693 @values[$index, $other_index] = @values[$other_index, $index];
1694
58baa27b 1695 $req->is_ajax
9b3a5df0 1696 and return $req->json_content
58baa27b
TC
1697 (
1698 success => 1,
1699 order => [ map $_->{id}, @values ]
1700 );
1701
1702 return $self->refresh($article, $req->cgi, undef, "Value moved");
1703}
1704
1705=item a_option_value_moveup
1706
1707=item a_option_value_movedown
1708
1709Move a product option value up/down through the values for a product
1710option.
1711
1712On failure perform a service error.
1713
1714Requires _csrfp for admin_move_option_value
1715
1716For Ajax requests (or with a _ parameter), returns JSON like:
1717
1718 {
1719 success: 1,
1720 order: [ list of value ids ]
1721 }
1722
1723Parameters:
1724
1725=over
1726
1727=item *
1728
1729id - article id
1730
1731=item *
1732
1733value_id - option id. This must belong to the product identified by
1734id.
1735
1736=back
1737
9b3a5df0
TC
1738Permission required: bse_edit_prodopt_edit
1739
58baa27b
TC
1740=cut
1741
1742sub req_option_value_moveup {
1743 my ($self, $req, $article, $articles) = @_;
1744
1745 return $self->_option_value_move($req, $article, $articles, -1);
1746}
1747
1748sub req_option_value_movedown {
1749 my ($self, $req, $article, $articles) = @_;
1750
1751 return $self->_option_value_move($req, $article, $articles, 1);
1752}
1753
1754=item a_option_value_reorder
1755
1756Specify a new order for the values belonging to a product option.
1757
1758On failure perform a service error.
1759
1760Requires _csrfp for admin_move_option_value
1761
1762For Ajax requests (or with a _ parameter), returns JSON like:
1763
1764 {
1765 success: 1,
1766 order: [ list of value ids ]
1767 }
1768
1769Parameters:
1770
1771=over
1772
1773=item *
1774
1775id - article id
1776
1777=item *
1778
4de47893
TC
1779option_id - the option to reorder values for
1780
1781=item *
1782
58baa27b
TC
1783value_ids - new order for values specified as value ids separated by
1784commas.
1785
1786=back
1787
9b3a5df0
TC
1788Permission required: bse_edit_prodopt_edit
1789
58baa27b
TC
1790=cut
1791
1792sub req_option_value_reorder {
1793 my ($self, $req, $article, $articles) = @_;
1794
1795 $req->check_csrf("admin_move_option_value")
1796 or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value");
1797
9b3a5df0
TC
1798 $req->user_can(bse_edit_prodopt_edit => $article)
1799 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1800
58baa27b
TC
1801 my %errors;
1802 my $option = $self->_get_option($req, $article, \%errors);
1803 keys %errors
1804 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1805 my @order = map { split ',' } $req->cgi->param('value_ids');
1806 my @values = $option->values;
1807 my %values = map { $_->{id} => $_ } @values;
1808 my @new_values;
1809 for my $id (@order) {
1810 my $value = delete $values{$id}
1811 or next;
1812 push @new_values, $value;
1813 }
1814 push @new_values, sort { $a->{display_order} <=> $b->{display_order} } values %values;
1815 my @display_order = map $_->{display_order}, @values;
1816 for my $index (0 .. $#new_values) {
1817 $new_values[$index]{display_order} = $display_order[$index];
1818 $new_values[$index]->save;
1819 }
1820
1821 $req->is_ajax
1822 and return $req->json_content
1823 (
1824 success => 1,
1825 option => $option->data_only,
1826 order => [ map $_->{id}, @new_values ]
1827 );
1828
1829 return $self->refresh($article, $req->cgi, undef, "Values reordered");
1830}
1831
59fca225
TC
1832sub custom_fields {
1833 my ($self) = @_;
1834
1835 my $custom = $self->SUPER::custom_fields();
1836
1837 require DevHelp::Validate;
1838 DevHelp::Validate->import;
1839 return DevHelp::Validate::dh_configure_fields
1840 (
1841 $custom,
1842 $self->cfg,
1843 PRODUCT_CUSTOM_FIELDS_CFG,
1844 BSE::DB->single->dbh,
1845 );
1846}
1847
58baa27b
TC
1848sub article_actions {
1849 my $self = shift;
1850
1851 return
1852 (
1853 $self->SUPER::article_actions,
1854 a_add_option => 'req_add_option',
1855 a_confdel_option => 'req_confdel_option',
1856 a_del_option => 'req_del_option',
1857 a_edit_option => 'req_edit_option',
1858 a_save_option => 'req_save_option',
1859 a_delconf_option => 'req_delconf_option',
1860 a_delete_option => 'req_delete_option',
1861 a_get_option => 'req_get_option',
1862 a_edit_option_value => 'req_edit_option_value',
1863 a_save_option_value => 'req_save_option_value',
1864 a_confdel_option_value => 'req_confdel_option_value',
1865 a_delete_option_value => 'req_delete_option_value',
1866 a_add_option_value => 'req_add_option_value',
1867 a_option_value_moveup => 'req_option_value_moveup',
1868 a_option_value_movedown => 'req_option_value_movedown',
1869 a_option_value_reorder => 'req_option_value_reorder',
1870 a_option_moveup => 'req_option_moveup',
1871 a_option_movedown => 'req_option_movedown',
1872 a_option_reorder => 'req_option_reorder',
1873 );
1874}
1875
ca9aa2bf 18761;
d8b4c773
TC
1877
1878=back
1879
1880=head1 AUTHOR
1881
1882Tony Cook <tony@develop-help.com>
1883
1884=cut