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