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