support for new templating for product options
[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
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
701Actions you can request from add.pl for products.
702
703=over
704
705=item a_add_option
706
707Add a new product option.
708
709On failure perform a service error.
710
711Requires _csrfp for admin_add_option
712
713For 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
721Parameters:
722
723=over
724
725=item *
726
727id - Article id
728
729=item *
730
731name - Name of the option (required)
732
733=item *
734
735value1 .. value5 - if any of these are non-blank they are added to the
736option as values.
737
738=back
739
9b3a5df0
TC
740Permission required: bse_edit_prodopt_add
741
58baa27b
TC
742=cut
743
744sub 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
797my %option_id =
798 (
799 option_id =>
800 {
801 rules => "required;positiveint",
802 },
803 );
804
805sub _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
833sub _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
862Produce a form to edit the given option.
863
864Parameters:
865
866=over
867
868=item *
869
870id - article id
871
872=item *
873
874option_id - option id. This must belong to the product identified by
875id.
876
877=back
878
879Template: admin/prodopt_edit
880
9b3a5df0
TC
881Permission required: bse_edit_prodopt_edit
882
58baa27b
TC
883=cut
884
885sub 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
895my %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
910my %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
919Saves changes to an option.
920
921On failure perform a service error.
922
923Requires _csrfp for admin_save_option
924
925For 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
933Parameters:
934
935=over
936
937=item *
938
939id - article id
940
941=item *
942
943option_id - id of the option to save, must belong to the product
944identified by id.
945
946=item *
947
948name - new value for the name field
949
950=item *
951
952default_value - id of the default value
953
954=item *
955
956save_enabled - if supplied and true, set enabled from the enabled
957parameter.
958
959=item *
960
961enabled - If supplied and true, enable the option, otherwise disable
962it. Ignored unless save_enabled is true.
963
964=item *
965
966valueI<value-id> - set the displayed value for the value record
5708b3ac
TC
967identified by I<value-id>. If these aren't supplied the values aren't
968changed.
58baa27b
TC
969
970=back
971
9b3a5df0
TC
972Permission required: bse_edit_prodopt_save
973
58baa27b
TC
974=cut
975
976sub 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
1061Produce a form to confirm deletion of the given option.
1062
1063Parameters:
1064
1065=over
1066
1067=item *
1068
1069id - article id
1070
1071=item *
1072
1073option_id - option id. This must belong to the product identified by
1074id.
1075
1076=back
1077
1078Template: admin/prodopt_delete
1079
1080=cut
1081
1082sub 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
1094Delete the given option.
1095
1096On failure perform a service error.
1097
1098Requires _csrfp for admin_delete_option
1099
1100For Ajax requests (or with a _ parameter), returns JSON like:
1101
1102 {
1103 success: 1,
1104 }
1105
9b3a5df0
TC
1106Permission required: bse_edit_prodopt_delete
1107
58baa27b
TC
1108=cut
1109
1110sub 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
1140my %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
1157Add a value to a product option.
1158
1159On failure perform a service error, see BSE::Edit::Article::_service_error.
1160
1161Requires _csrfp for admin_add_option_value
1162
1163For Ajax requests returns JSON like
d8b4c773 1164
58baa27b
TC
1165 { success: 1, value: (valueobject) }
1166
1167Standard redirect on success otherwise.
1168
1169Parameters:
1170
1171=over
1172
1173=item *
1174
1175id - article id
1176
1177=item *
1178
1179option_id - id of the option to add the value to
1180
1181=item *
1182
1183value - text of the value to add.
1184
1185=back
1186
9b3a5df0
TC
1187Permission required: bse_edit_prodopt_edit
1188
58baa27b
TC
1189=cut
1190
1191sub 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
1234my %option_value_id =
1235 (
1236 value_id =>
1237 {
1238 rules => "required;positiveint",
1239 },
1240 );
1241
1242sub _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
1268sub _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
1291Displays a form to edit the value for a given option.
1292
1293Parameters:
1294
1295=over
1296
1297=item *
1298
1299id - id of the product
1300
1301=item *
1302
1303value_id - id of he product option value to edit, must belong to the
1304given product.
1305
1306=back
1307
1308Template: admin/prodopt_value_edit
1309
9b3a5df0
TC
1310Permission required: bse_edit_prodopt_edit
1311
58baa27b
TC
1312=cut
1313
1314sub 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
1324my %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
1335Saves changes to an option.
1336
1337On failure perform a service error.
1338
1339Requires _csrfp for admin_save_option_value
1340
1341For Ajax requests (or with a _ parameter), returns JSON like:
1342
1343 {
1344 success: 1,
1345 value: { value data }
1346 }
1347
1348Parameters:
1349
1350=over
1351
1352=item *
1353
1354id - article id
1355
1356=item *
1357
1358value_id - id of the value to save, must belong to the product
1359identified by id.
1360
1361=item *
1362
1363value - new displayed value for the option value.
1364
1365=back
1366
9b3a5df0
TC
1367Permission required: bse_edit_prodopt_edit
1368
58baa27b
TC
1369=cut
1370
1371sub 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
1403Displays a page confirming deletion of a product option value.
1404
1405Parameters:
1406
1407=over
1408
1409=item *
1410
1411id - article id
1412
1413=item *
1414
1415value_id - option value id
1416
1417=back
1418
1419Template: admin/prodopt_value_delete
1420
9b3a5df0
TC
1421Permission required: bse_edit_prodopt_edit
1422
58baa27b
TC
1423=cut
1424
1425sub 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
1437Deletes a product option.
1438
1439On failure perform a service error.
1440
1441Requires _csrfp for admin_delete_option_value
1442
1443For Ajax requests (or with a _ parameter), returns JSON like:
1444
1445 {
1446 success: 1,
1447 }
1448
1449Parameters:
1450
1451=over
1452
1453=item *
1454
1455id - article id
1456
1457=item *
1458
1459value_id - id of the value to delete, must belong to the product
1460identified by id.
1461
1462=back
1463
9b3a5df0
TC
1464Permission required: bse_edit_prodopt_edit
1465
58baa27b
TC
1466=cut
1467
1468sub 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
1493sub 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
1510sub _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
1556Move a product option up/down through the options for a product.
1557
1558On failure perform a service error.
1559
1560Requires _csrfp for admin_move_option
1561
1562For Ajax requests (or with a _ parameter), returns JSON like:
1563
1564 {
1565 success: 1,
1566 order: [ list of option ids ]
1567 }
1568
1569Parameters:
1570
1571=over
1572
1573=item *
1574
1575id - article id
1576
1577=item *
1578
1579option_id - option id. This must belong to the product identified by
1580id.
1581
1582=back
1583
9b3a5df0
TC
1584Permission required: bse_edit_prodopt_move
1585
58baa27b
TC
1586=cut
1587
1588sub req_option_moveup {
1589 my ($self, $req, $article, $articles) = @_;
1590
1591 return $self->_option_move($req, $article, $articles, -1);
1592}
1593
1594sub 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
1602Move a product option up/down through the options for a product.
1603
1604On failure perform a service error.
1605
1606Requires _csrfp for admin_move_option
1607
1608For Ajax requests (or with a _ parameter), returns JSON like:
1609
1610 {
1611 success: 1,
1612 order: [ list of option ids ]
1613 }
1614
1615Parameters:
1616
1617=over
1618
1619=item *
1620
1621id - article id
1622
1623=item *
1624
1625option_ids - option ids separated by commas. These must belong to the
1626product identified by id.
1627
1628=back
1629
9b3a5df0
TC
1630Permission required: bse_edit_prodopt_move
1631
58baa27b
TC
1632=cut
1633
1634sub 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
1669sub _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
1716Move a product option value up/down through the values for a product
1717option.
1718
1719On failure perform a service error.
1720
1721Requires _csrfp for admin_move_option_value
1722
1723For Ajax requests (or with a _ parameter), returns JSON like:
1724
1725 {
1726 success: 1,
1727 order: [ list of value ids ]
1728 }
1729
1730Parameters:
1731
1732=over
1733
1734=item *
1735
1736id - article id
1737
1738=item *
1739
1740value_id - option id. This must belong to the product identified by
1741id.
1742
1743=back
1744
9b3a5df0
TC
1745Permission required: bse_edit_prodopt_edit
1746
58baa27b
TC
1747=cut
1748
1749sub req_option_value_moveup {
1750 my ($self, $req, $article, $articles) = @_;
1751
1752 return $self->_option_value_move($req, $article, $articles, -1);
1753}
1754
1755sub 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
1763Specify a new order for the values belonging to a product option.
1764
1765On failure perform a service error.
1766
1767Requires _csrfp for admin_move_option_value
1768
1769For Ajax requests (or with a _ parameter), returns JSON like:
1770
1771 {
1772 success: 1,
1773 order: [ list of value ids ]
1774 }
1775
1776Parameters:
1777
1778=over
1779
1780=item *
1781
1782id - article id
1783
1784=item *
1785
4de47893
TC
1786option_id - the option to reorder values for
1787
1788=item *
1789
58baa27b
TC
1790value_ids - new order for values specified as value ids separated by
1791commas.
1792
1793=back
1794
9b3a5df0
TC
1795Permission required: bse_edit_prodopt_edit
1796
58baa27b
TC
1797=cut
1798
1799sub 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
1839sub 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
1855sub 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 18831;
d8b4c773
TC
1884
1885=back
1886
1887=head1 AUTHOR
1888
1889Tony Cook <tony@develop-help.com>
1890
1891=cut