site/cgi-bin/modules/BSE/Edit/Product.pm

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