allow metadata to be defined for new products
[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
841 my $it = BSE::Util::Iterate->new;
842 my %acts;
843 %acts =
844 (
845 $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
846 option => [ \&tag_hash, $option ],
847 $it->make
848 (
849 single => "dboptionvalue",
850 plural => "dboptionvalues",
851 code => [ iter_option_values => $self, \$option ],
852 ),
853 );
854
855 return $req->dyn_response($template, \%acts);
856}
857
858=item a_edit_option
859
860Produce a form to edit the given option.
861
862Parameters:
863
864=over
865
866=item *
867
868id - article id
869
870=item *
871
872option_id - option id. This must belong to the product identified by
873id.
874
875=back
876
877Template: admin/prodopt_edit
878
9b3a5df0
TC
879Permission required: bse_edit_prodopt_edit
880
58baa27b
TC
881=cut
882
883sub req_edit_option {
884 my ($self, $req, $article, $articles, $msg, $errors) = @_;
885
9b3a5df0
TC
886 $req->user_can(bse_edit_prodopt_edit => $article)
887 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
888
58baa27b
TC
889 return $self->_common_option('admin/prodopt_edit', $req, $article,
890 $articles, $msg, $errors);
891}
892
893my %option_name =
894 (
895 name =>
896 {
897 description => "Option name",
9eebac67 898 rules => "required;dh_one_line",
085b34a0 899 maxlength => 255,
58baa27b
TC
900 },
901 default_value =>
902 {
903 description => "Default Value",
9b3a5df0 904 rules => "positiveint"
58baa27b
TC
905 }
906 );
907
908my %option_value =
909 (
910 description => "Value",
9eebac67 911 rules => "required;dh_one_line",
085b34a0 912 maxlength => 255,
58baa27b
TC
913 );
914
915=item a_save_option
916
917Saves changes to an option.
918
919On failure perform a service error.
920
921Requires _csrfp for admin_save_option
922
923For Ajax requests (or with a _ parameter), returns JSON like:
924
925 {
926 success: 1,
927 option: { <option data> },
928 values: [ { value data, value data, ... } ]
929 }
930
931Parameters:
932
933=over
934
935=item *
936
937id - article id
938
939=item *
940
941option_id - id of the option to save, must belong to the product
942identified by id.
943
944=item *
945
946name - new value for the name field
947
948=item *
949
950default_value - id of the default value
951
952=item *
953
954save_enabled - if supplied and true, set enabled from the enabled
955parameter.
956
957=item *
958
959enabled - If supplied and true, enable the option, otherwise disable
960it. Ignored unless save_enabled is true.
961
962=item *
963
964valueI<value-id> - set the displayed value for the value record
5708b3ac
TC
965identified by I<value-id>. If these aren't supplied the values aren't
966changed.
58baa27b
TC
967
968=back
969
9b3a5df0
TC
970Permission required: bse_edit_prodopt_save
971
58baa27b
TC
972=cut
973
974sub req_save_option {
975 my ($self, $req, $article, $articles) = @_;
976
977 my $cgi = $req->cgi;
978
979 $req->check_csrf("admin_save_option")
980 or return $self->csrf_error($req, $article, "admin_save_option", "Save Product Option");
981
9b3a5df0
TC
982 $req->user_can(bse_edit_prodopt_edit => $article)
983 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
984
58baa27b
TC
985 my %errors;
986 my $option = $self->_get_option($req, $article, \%errors);
987 keys %errors
d445674b 988 and return $self->_service_error($req, $article, $articles, undef, \%errors, 'FIELD', "req_edit_option");
9b3a5df0 989 $req->validate(fields => \%option_name,
58baa27b
TC
990 errors => \%errors);
991 my @values = $option->values;
992 my %fields = map {; "value$_->{id}" => \%option_value } @values;
9b3a5df0
TC
993 $req->validate(fields => \%fields,
994 errors => \%errors,
995 optional => 1);
58baa27b
TC
996 my $default_value = $cgi->param('default_value');
997 if (!$errors{default_value} && $default_value) {
998 grep $_->{id} == $default_value, @values
999 or $errors{default_value} = "Unknown value selected as default";
1000 }
d445674b
TC
1001
1002 $DB::single = 1;
1003 my @new_values;
1004 my $index = 1;
1005 while ($index < 10 && defined $cgi->param("newvalue$index")) {
1006 my $field = "newvalue$index";
1007 my $value = $cgi->param($field);
1008 $req->validate(fields => { $field => \%option_value },
1009 errors => \%errors);
1010 push @new_values, $value;
1011
1012 ++$index;
1013 }
1014
58baa27b 1015 keys %errors
d445674b 1016 and return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD", "req_edit_option");
58baa27b
TC
1017
1018 my $name = $cgi->param("name");
1019 defined $name
1020 and $option->set_name($name);
1021 defined $default_value
1022 and $option->set_default_value($default_value);
1023 if ($cgi->param("save_enabled")) {
1024 my $enabled = $cgi->param("enabled") ? 1 : 0;
1025 $option->set_enabled($enabled);
1026 }
1027 $option->save;
1028 for my $value (@values) {
1029 my $new_value = $cgi->param("value$value->{id}");
5708b3ac 1030 if (defined $new_value && $new_value ne $value->value) {
58baa27b
TC
1031 $value->set_value($new_value);
1032 $value->save;
1033 }
1034 }
d445674b
TC
1035 my $order = @values ? $values[-1]->display_order : time;
1036 for my $value (@new_values) {
1037 BSE::TB::ProductOptionValues->make
1038 (
1039 product_option_id => $option->id,
1040 value => $value,
1041 display_order => ++$order,
1042 );
1043 }
58baa27b
TC
1044
1045 $req->is_ajax
1046 and return $req->json_content
1047 (
1048 success => 1,
1049 option => $option->data_only,
1050 values => [ map $_->data_only, @values ],
1051 );
1052
d445674b
TC
1053 return $self->refresh($article, $req->cgi, undef,
1054 "Option '" . $option->name . "' saved");
58baa27b
TC
1055}
1056
1057=item a_delconf_option
1058
1059Produce a form to confirm deletion of the given option.
1060
1061Parameters:
1062
1063=over
1064
1065=item *
1066
1067id - article id
1068
1069=item *
1070
1071option_id - option id. This must belong to the product identified by
1072id.
1073
1074=back
1075
1076Template: admin/prodopt_delete
1077
1078=cut
1079
1080sub req_delconf_option {
1081 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1082
9b3a5df0
TC
1083 $req->user_can(bse_edit_prodopt_delete => $article)
1084 or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options");
1085
58baa27b
TC
1086 return $self->_common_option('admin/prodopt_delete', $req, $article,
1087 $articles, $msg, $errors);
1088}
1089
1090=item a_delete_option
1091
1092Delete the given option.
1093
1094On failure perform a service error.
1095
1096Requires _csrfp for admin_delete_option
1097
1098For Ajax requests (or with a _ parameter), returns JSON like:
1099
1100 {
1101 success: 1,
1102 }
1103
9b3a5df0
TC
1104Permission required: bse_edit_prodopt_delete
1105
58baa27b
TC
1106=cut
1107
1108sub req_delete_option {
1109 my ($self, $req, $article, $articles) = @_;
1110
1111 $req->check_csrf("admin_delete_option")
1112 or return $self->csrf_error($req, $article, "admin_delete_option", "Delete Product Option");
1113
9b3a5df0
TC
1114 $req->user_can(bse_edit_prodopt_delete => $article)
1115 or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options");
1116
58baa27b
TC
1117 my %errors;
1118 my $option = $self->_get_option($req, $article, \%errors);
1119 keys %errors
1120 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1121 my @values = $option->values;
1122
1123 for my $value (@values) {
1124 $value->remove;
1125 }
1126 $option->remove;
1127
1128 $req->is_ajax
1129 and return $req->json_content
1130 (
1131 success => 1
1132 );
1133
1134 return $self->refresh($article, $req->cgi, undef, "Option deleted");
1135}
1136
1137
1138my %add_option_value_fields =
1139 (
1140 option_id =>
1141 {
1142 description => "Option id",
1143 rules => "required;positiveint",
1144 },
1145 value =>
1146 {
1147 description => "Value",
085b34a0
TC
1148 rules => "required;dh_one_line",
1149 maxlength => 255,
58baa27b
TC
1150 },
1151 );
1152
1153=item a_add_option_value
1154
1155Add a value to a product option.
1156
1157On failure perform a service error, see BSE::Edit::Article::_service_error.
1158
1159Requires _csrfp for admin_add_option_value
1160
1161For Ajax requests returns JSON like
d8b4c773 1162
58baa27b
TC
1163 { success: 1, value: (valueobject) }
1164
1165Standard redirect on success otherwise.
1166
1167Parameters:
1168
1169=over
1170
1171=item *
1172
1173id - article id
1174
1175=item *
1176
1177option_id - id of the option to add the value to
1178
1179=item *
1180
1181value - text of the value to add.
1182
1183=back
1184
9b3a5df0
TC
1185Permission required: bse_edit_prodopt_edit
1186
58baa27b
TC
1187=cut
1188
1189sub req_add_option_value {
1190 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1191
1192 $req->check_csrf("admin_add_option_value")
1193 or return $self->csrf_error($req, $article, "admin_add_option_value", "Add Product Option Value");
1194
9b3a5df0
TC
1195 $req->user_can(bse_edit_prodopt_edit => $article)
1196 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1197
58baa27b
TC
1198 my %errors;
1199 $req->validate(fields => \%add_option_value_fields,
1200 errors => \%errors);
1201 my $option;
1202 my $cgi = $req->cgi;
1203 unless ($errors{option_id}) {
1204 require BSE::TB::ProductOptions;
1205 $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id"));
1206 defined $option && $option->{product_id}
1207 or $errors{option_id} = "Bad option id - either unknown or for a different product";
1208 }
1209 keys %errors
1210 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1211
1212 my $value = $cgi->param("value");
1213 require BSE::TB::ProductOptionValues;
1214 my $entry = BSE::TB::ProductOptionValues->make
1215 (
1216 product_option_id => $option->{id},
1217 value => $value,
1218 display_order => time,
1219 );
1220
1221 $req->is_ajax
1660ce30 1222 and return $req->json_content
58baa27b
TC
1223 (
1224 success => 1,
1225 value => $entry->data_only
1226 );
1227
1228 return $self->refresh($article, $cgi, undef, "Value added");
1229}
1230
1231
1232my %option_value_id =
1233 (
1234 value_id =>
1235 {
1236 rules => "required;positiveint",
1237 },
1238 );
1239
1240sub _get_option_value {
1241 my ($self, $req, $article, $errors) = @_;
1242
1243 my $option_value;
1244 my $cgi = $req->cgi;
1245 $req->validate(fields => \%option_value_id,
1246 errors => $errors);
1247 unless ($errors->{value_id}) {
1248 require BSE::TB::ProductOptionValues;
1249 $option_value = BSE::TB::ProductOptionValues->getByPkey($cgi->param("value_id"));
1250 $option_value
1251 or $errors->{value_id} = "Unknown option value id";
1252 }
1253 my $option;
1254 unless ($errors->{value_id}) {
1255 $option = $option_value->option;
1256 defined $option && $option->{product_id} == $article->{id}
1257 or $errors->{value_id} = "Value has no option or doesn't belong to the product";
1258 }
1259
1260 $errors->{value_id}
1261 and return;
1262
1263 return wantarray ? ( $option_value, $option ) : $option_value ;
1264}
1265
1266sub _common_option_value {
1267 my ($self, $template, $req, $article, $articles, $msg, $errors) = @_;
1268
1269 my %errors;
1270 my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors);
1271 keys %errors
1272 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1273
1274 my %acts;
1275 %acts =
1276 (
1277 $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
1278 option_value => [ \&tag_hash, $option_value ],
1279 option => [ \&tag_hash, $option ],
1280 );
1281
1282 return $req->dyn_response($template, \%acts);
1283}
1284
1285=item a_edit_option_value
1286
1287Displays a form to edit the value for a given option.
1288
1289Parameters:
1290
1291=over
1292
1293=item *
1294
1295id - id of the product
1296
1297=item *
1298
1299value_id - id of he product option value to edit, must belong to the
1300given product.
1301
1302=back
1303
1304Template: admin/prodopt_value_edit
1305
9b3a5df0
TC
1306Permission required: bse_edit_prodopt_edit
1307
58baa27b
TC
1308=cut
1309
1310sub req_edit_option_value {
1311 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1312
9b3a5df0
TC
1313 $req->user_can(bse_edit_prodopt_edit => $article)
1314 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1315
58baa27b
TC
1316 return $self->_common_option_value('admin/prodopt_value_edit', $req,
1317 $article, $articles, $msg, $errors);
1318}
1319
1320my %save_option_value_fields =
1321 (
1322 value =>
1323 {
1324 rules => "required;dh_one_line",
085b34a0 1325 maxlength => 255,
58baa27b
TC
1326 },
1327 );
1328
1329=item a_save_option_value
1330
1331Saves changes to an option.
1332
1333On failure perform a service error.
1334
1335Requires _csrfp for admin_save_option_value
1336
1337For Ajax requests (or with a _ parameter), returns JSON like:
1338
1339 {
1340 success: 1,
1341 value: { value data }
1342 }
1343
1344Parameters:
1345
1346=over
1347
1348=item *
1349
1350id - article id
1351
1352=item *
1353
1354value_id - id of the value to save, must belong to the product
1355identified by id.
1356
1357=item *
1358
1359value - new displayed value for the option value.
1360
1361=back
1362
9b3a5df0
TC
1363Permission required: bse_edit_prodopt_edit
1364
58baa27b
TC
1365=cut
1366
1367sub req_save_option_value {
1368 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1369
1370 $req->check_csrf("admin_save_option_value")
1371 or return $self->csrf_error($req, $article, "admin_save_option_value", "Save Product Option Value");
1372
9b3a5df0
TC
1373 $req->user_can(bse_edit_prodopt_edit => $article)
1374 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1375
58baa27b
TC
1376 my %errors;
1377 $req->validate(fields => \%save_option_value_fields,
1378 errors => \%errors);
1379 my $option_value = $self->_get_option_value($req, $article, \%errors);
1380 keys %errors
1381 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1382
1383 my $cgi = $req->cgi;
1384 $option_value->{value} = $cgi->param("value");
1385 $option_value->save;
1386
1387 $req->is_ajax
1660ce30 1388 and return $req->json_content
58baa27b
TC
1389 (
1390 success => 1,
1391 value => $option_value->data_only
1392 );
1393
1394 return $self->refresh($article, $cgi, undef, "Value saved");
1395}
1396
1397=item a_confdel_option_value
1398
1399Displays a page confirming deletion of a product option value.
1400
1401Parameters:
1402
1403=over
1404
1405=item *
1406
1407id - article id
1408
1409=item *
1410
1411value_id - option value id
1412
1413=back
1414
1415Template: admin/prodopt_value_delete
1416
9b3a5df0
TC
1417Permission required: bse_edit_prodopt_edit
1418
58baa27b
TC
1419=cut
1420
1421sub req_confdel_option_value {
1422 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1423
9b3a5df0
TC
1424 $req->user_can(bse_edit_prodopt_edit => $article)
1425 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1426
58baa27b
TC
1427 return $self->_common_option_value('admin/prodopt_value_delete', $req,
1428 $article, $articles, $msg, $errors);
1429}
1430
1431=item a_delete_option_value
1432
1433Deletes a product option.
1434
1435On failure perform a service error.
1436
1437Requires _csrfp for admin_delete_option_value
1438
1439For Ajax requests (or with a _ parameter), returns JSON like:
1440
1441 {
1442 success: 1,
1443 }
1444
1445Parameters:
1446
1447=over
1448
1449=item *
1450
1451id - article id
1452
1453=item *
1454
1455value_id - id of the value to delete, must belong to the product
1456identified by id.
1457
1458=back
1459
9b3a5df0
TC
1460Permission required: bse_edit_prodopt_edit
1461
58baa27b
TC
1462=cut
1463
1464sub req_delete_option_value {
1465 my ($self, $req, $article, $articles, $msg, $errors) = @_;
1466
1467 $req->check_csrf("admin_delete_option_value")
1468 or return $self->csrf_error($req, $article, "admin_delete_option_value", "Delete Product Option Value");
1469
9b3a5df0
TC
1470 $req->user_can(bse_edit_prodopt_edit => $article)
1471 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1472
58baa27b
TC
1473 my %errors;
1474 my $option_value = $self->_get_option_value($req, $article, \%errors);
1475 keys %errors
1476 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1477
1478 $option_value->remove;
1479
1480 $req->is_ajax
1660ce30 1481 and return $req->json_content
58baa27b
TC
1482 (
1483 success => 1
1484 );
1485
1486 return $self->refresh($article, $req->cgi, undef, "Value removed");
1487}
1488
1489sub tag_dboptionsjson {
1490 my ($self, $article) = @_;
1491
1492 my @result;
1493 my @options = $article->db_options;
1494 my @opt_cols = BSE::TB::ProductOption->columns;
1495 for my $option (@options) {
1496 my $entry = $option->data_only;
1497 $entry->{values} = [ map $_->data_only, $option->values ];
1498 push @result, $entry;
1499 }
1500
1501 require JSON;
1502 my $json = JSON->new;
1503 return $json->encode(\@result);
1504}
1505
1506sub _option_move {
1507 my ($self, $req, $article, $articles, $direction) = @_;
1508
1509 $req->check_csrf("admin_move_option")
1510 or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option");
1511
9b3a5df0
TC
1512 $req->user_can(bse_edit_prodopt_move => $article)
1513 or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options");
1514
58baa27b
TC
1515 my %errors;
1516 my $option = $self->_get_option($req, $article, \%errors);
1517 keys %errors
1518 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1519 my @options = $article->db_options;
1520 my ($index) = grep $options[$_]{id} == $option->{id}, 0 .. $#options
1521 or return $self->_service_error($req, $article, $articles, "Unknown option id");
1522
1523 $options[$index] = $option;
1524
1525 my $other_index = $index + $direction;
1526 $other_index >= 0 && $other_index < @options
1527 or return $self->_service_error($req, $article, $articles, "Can't move option beyond end");
1528
1529 my $other = $options[$other_index];
1530
1531 ($option->{display_order}, $other->{display_order}) =
1532 ($other->{display_order}, $option->{display_order});
1533 $option->save;
1534 $other->save;
1535
4de47893
TC
1536 if ($req->is_ajax) {
1537 @options = sort { $a->{display_order} <=> $b->{display_order} } @options;
9b3a5df0 1538 return return $req->json_content
58baa27b
TC
1539 (
1540 success => 1,
1541 order => [ map $_->{id}, @options ]
1542 );
4de47893 1543 }
58baa27b
TC
1544
1545 return $self->refresh($article, $req->cgi, undef, "Option moved");
1546}
1547
4de47893 1548=item a_option_moveup
58baa27b 1549
4de47893 1550=item a_option_movedown
58baa27b
TC
1551
1552Move a product option up/down through the options for a product.
1553
1554On failure perform a service error.
1555
1556Requires _csrfp for admin_move_option
1557
1558For Ajax requests (or with a _ parameter), returns JSON like:
1559
1560 {
1561 success: 1,
1562 order: [ list of option ids ]
1563 }
1564
1565Parameters:
1566
1567=over
1568
1569=item *
1570
1571id - article id
1572
1573=item *
1574
1575option_id - option id. This must belong to the product identified by
1576id.
1577
1578=back
1579
9b3a5df0
TC
1580Permission required: bse_edit_prodopt_move
1581
58baa27b
TC
1582=cut
1583
1584sub req_option_moveup {
1585 my ($self, $req, $article, $articles) = @_;
1586
1587 return $self->_option_move($req, $article, $articles, -1);
1588}
1589
1590sub req_option_movedown {
1591 my ($self, $req, $article, $articles) = @_;
1592
1593 return $self->_option_move($req, $article, $articles, 1);
1594}
1595
1596=item a_option_reorder
1597
1598Move a product option up/down through the options for a product.
1599
1600On failure perform a service error.
1601
1602Requires _csrfp for admin_move_option
1603
1604For Ajax requests (or with a _ parameter), returns JSON like:
1605
1606 {
1607 success: 1,
1608 order: [ list of option ids ]
1609 }
1610
1611Parameters:
1612
1613=over
1614
1615=item *
1616
1617id - article id
1618
1619=item *
1620
1621option_ids - option ids separated by commas. These must belong to the
1622product identified by id.
1623
1624=back
1625
9b3a5df0
TC
1626Permission required: bse_edit_prodopt_move
1627
58baa27b
TC
1628=cut
1629
1630sub req_option_reorder {
1631 my ($self, $req, $article, $articles) = @_;
1632
1633 $req->check_csrf("admin_move_option")
1634 or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option");
1635
9b3a5df0
TC
1636 $req->user_can(bse_edit_prodopt_move => $article)
1637 or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options");
1638
58baa27b
TC
1639 my @options = $article->db_options;
1640 my @order = map { split ',' } $req->cgi->param('option_ids');
1641 my %options = map { $_->{id} => $_ } @options;
1642 my @new_options;
1643 for my $id (@order) {
1644 my $option = delete $options{$id}
1645 or next;
1646 push @new_options, $option;
1647 }
1648 push @new_options, sort { $a->{display_order} <=> $b->{display_order} } values %options;
1649 my @display_order = map $_->{display_order}, @options;
1650 for my $index (0 .. $#new_options) {
1651 $new_options[$index]{display_order} = $display_order[$index];
1652 $new_options[$index]->save;
1653 }
1654
1655 $req->is_ajax
1656 and return $req->json_content
1657 (
1658 success => 1,
1659 order => [ map $_->{id}, @new_options ]
1660 );
1661
1662 return $self->refresh($article, $req->cgi, undef, "Options reordered");
1663}
1664
1665sub _option_value_move {
1666 my ($self, $req, $article, $articles, $direction) = @_;
1667
1668 $req->check_csrf("admin_move_option_value")
1669 or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value");
1670
9b3a5df0
TC
1671 $req->user_can(bse_edit_prodopt_edit => $article)
1672 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1673
58baa27b
TC
1674 my %errors;
1675 my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors);
1676 keys %errors
1677 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1678 my @values = $option->values;
1679 my ($index) = grep $values[$_]{id} == $option_value->{id}, 0 .. $#values
1680 or return $self->_service_error($req, $article, $articles, "Unknown option value id");
1681
1682 $values[$index] = $option_value;
1683
1684 my $other_index = $index + $direction;
1685 $other_index >= 0 && $other_index < @values
1686 or return $self->_service_error($req, $article, $articles, "Can't move option value beyond end");
1687
1688 my $other = $values[$other_index];
1689
1690 ($option_value->{display_order}, $other->{display_order}) =
1691 ($other->{display_order}, $option_value->{display_order});
1692 $option_value->save;
1693 $other->save;
1694
9b3a5df0
TC
1695 # make sure the json gets the new order
1696 @values[$index, $other_index] = @values[$other_index, $index];
1697
58baa27b 1698 $req->is_ajax
9b3a5df0 1699 and return $req->json_content
58baa27b
TC
1700 (
1701 success => 1,
1702 order => [ map $_->{id}, @values ]
1703 );
1704
1705 return $self->refresh($article, $req->cgi, undef, "Value moved");
1706}
1707
1708=item a_option_value_moveup
1709
1710=item a_option_value_movedown
1711
1712Move a product option value up/down through the values for a product
1713option.
1714
1715On failure perform a service error.
1716
1717Requires _csrfp for admin_move_option_value
1718
1719For Ajax requests (or with a _ parameter), returns JSON like:
1720
1721 {
1722 success: 1,
1723 order: [ list of value ids ]
1724 }
1725
1726Parameters:
1727
1728=over
1729
1730=item *
1731
1732id - article id
1733
1734=item *
1735
1736value_id - option id. This must belong to the product identified by
1737id.
1738
1739=back
1740
9b3a5df0
TC
1741Permission required: bse_edit_prodopt_edit
1742
58baa27b
TC
1743=cut
1744
1745sub req_option_value_moveup {
1746 my ($self, $req, $article, $articles) = @_;
1747
1748 return $self->_option_value_move($req, $article, $articles, -1);
1749}
1750
1751sub req_option_value_movedown {
1752 my ($self, $req, $article, $articles) = @_;
1753
1754 return $self->_option_value_move($req, $article, $articles, 1);
1755}
1756
1757=item a_option_value_reorder
1758
1759Specify a new order for the values belonging to a product option.
1760
1761On failure perform a service error.
1762
1763Requires _csrfp for admin_move_option_value
1764
1765For Ajax requests (or with a _ parameter), returns JSON like:
1766
1767 {
1768 success: 1,
1769 order: [ list of value ids ]
1770 }
1771
1772Parameters:
1773
1774=over
1775
1776=item *
1777
1778id - article id
1779
1780=item *
1781
4de47893
TC
1782option_id - the option to reorder values for
1783
1784=item *
1785
58baa27b
TC
1786value_ids - new order for values specified as value ids separated by
1787commas.
1788
1789=back
1790
9b3a5df0
TC
1791Permission required: bse_edit_prodopt_edit
1792
58baa27b
TC
1793=cut
1794
1795sub req_option_value_reorder {
1796 my ($self, $req, $article, $articles) = @_;
1797
1798 $req->check_csrf("admin_move_option_value")
1799 or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value");
1800
9b3a5df0
TC
1801 $req->user_can(bse_edit_prodopt_edit => $article)
1802 or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
1803
58baa27b
TC
1804 my %errors;
1805 my $option = $self->_get_option($req, $article, \%errors);
1806 keys %errors
1807 and return $self->_service_error($req, $article, $articles, undef, \%errors);
1808 my @order = map { split ',' } $req->cgi->param('value_ids');
1809 my @values = $option->values;
1810 my %values = map { $_->{id} => $_ } @values;
1811 my @new_values;
1812 for my $id (@order) {
1813 my $value = delete $values{$id}
1814 or next;
1815 push @new_values, $value;
1816 }
1817 push @new_values, sort { $a->{display_order} <=> $b->{display_order} } values %values;
1818 my @display_order = map $_->{display_order}, @values;
1819 for my $index (0 .. $#new_values) {
1820 $new_values[$index]{display_order} = $display_order[$index];
1821 $new_values[$index]->save;
1822 }
1823
1824 $req->is_ajax
1825 and return $req->json_content
1826 (
1827 success => 1,
1828 option => $option->data_only,
1829 order => [ map $_->{id}, @new_values ]
1830 );
1831
1832 return $self->refresh($article, $req->cgi, undef, "Values reordered");
1833}
1834
59fca225
TC
1835sub custom_fields {
1836 my ($self) = @_;
1837
1838 my $custom = $self->SUPER::custom_fields();
1839
1840 require DevHelp::Validate;
1841 DevHelp::Validate->import;
1842 return DevHelp::Validate::dh_configure_fields
1843 (
1844 $custom,
1845 $self->cfg,
1846 PRODUCT_CUSTOM_FIELDS_CFG,
1847 BSE::DB->single->dbh,
1848 );
1849}
1850
58baa27b
TC
1851sub article_actions {
1852 my $self = shift;
1853
1854 return
1855 (
1856 $self->SUPER::article_actions,
1857 a_add_option => 'req_add_option',
1858 a_confdel_option => 'req_confdel_option',
1859 a_del_option => 'req_del_option',
1860 a_edit_option => 'req_edit_option',
1861 a_save_option => 'req_save_option',
1862 a_delconf_option => 'req_delconf_option',
1863 a_delete_option => 'req_delete_option',
1864 a_get_option => 'req_get_option',
1865 a_edit_option_value => 'req_edit_option_value',
1866 a_save_option_value => 'req_save_option_value',
1867 a_confdel_option_value => 'req_confdel_option_value',
1868 a_delete_option_value => 'req_delete_option_value',
1869 a_add_option_value => 'req_add_option_value',
1870 a_option_value_moveup => 'req_option_value_moveup',
1871 a_option_value_movedown => 'req_option_value_movedown',
1872 a_option_value_reorder => 'req_option_value_reorder',
1873 a_option_moveup => 'req_option_moveup',
1874 a_option_movedown => 'req_option_movedown',
1875 a_option_reorder => 'req_option_reorder',
1876 );
1877}
1878
ca9aa2bf 18791;
d8b4c773
TC
1880
1881=back
1882
1883=head1 AUTHOR
1884
1885Tony Cook <tony@develop-help.com>
1886
1887=cut