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