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