package BSE::Edit::Product;
use strict;
use base 'BSE::Edit::Article';
-use Products;
+use BSE::TB::Products;
use HTML::Entities;
use BSE::Template;
use BSE::Util::Iterate;
-use DevHelp::HTML;
+use BSE::Util::HTML;
use BSE::CfgInfo 'product_options';
+use BSE::Util::Tags qw(tag_hash tag_article);
+use BSE::PubSub;
+use constant PRODUCT_CUSTOM_FIELDS_CFG => "product custom fields";
+
+our $VERSION = "1.017";
+
+=head1 NAME
+
+BSE::Edit::Product - tags and actions for editing BSE products
+
+=head1 SYNOPSIS
+
+ http://www.example.com/cgi-bin/admin/add.pl ...
+
+=head1 DESCRIPTION
+
+Article editor subclass for editing Products.
+
+=cut
my %money_fields =
(
gst => "GST",
);
-sub generator { 'Generate::Product' }
+sub generator { 'BSE::Generate::Product' }
+
+sub _make_dummy_article {
+ my ($self, $article) = @_;
+
+ require BSE::DummyProduct;
+ return bless $article, "BSE::DummyProduct";
+}
sub base_template_dirs {
return ( "products" );
BSE::TB::Subscriptions->all;
}
+sub iter_option_values {
+ my ($self, $rcurrent_option, $args) = @_;
+
+ $$rcurrent_option
+ or return;
+
+ return $$rcurrent_option->values;
+}
+
sub tag_hash_mbcs {
my ($object, $args) = @_;
escape_html($value, '<>&"');
}
+sub tag_dboptionvalue_move {
+ my ($self, $req, $article, $rvalues, $rindex, $args) = @_;
+
+ $$rindex >= 0 && $$rindex < @$rvalues
+ or return "** dboptionvalue_move only in dboption_values iterator **";
+
+ my $my_id = $rvalues->[$$rindex]{id};
+ my $base_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&value_id=$my_id&_csrfp=".$req->get_csrf_token("admin_move_option_value") . "&";
+
+ my $t = $req->cgi->param('_t');
+ $t && $t =~ /^\w+$/
+ and $base_url .= "_t=$t&";
+
+ my $up_url = '';
+ if ($$rindex > 0) {
+ $up_url = $base_url . "a_option_value_moveup=1";
+ }
+ my $down_url = '';
+ if ($$rindex < $#$rvalues) {
+ $down_url = $base_url . "a_option_value_movedown=1";
+ }
+
+ my $refresh = $self->refresh_url($article, $req->cgi);
+
+ require BSE::Arrows;
+ return BSE::Arrows::make_arrows($req->cfg, $down_url, $up_url, $refresh, $args, id => $my_id, id_prefix => "prodoptvaluemove");
+}
+
+sub tag_dboption_move {
+ my ($self, $req, $article, $roptions, $rindex, $args) = @_;
+
+ $$rindex >= 0 && $$rindex < @$roptions
+ or return "** dboption_move only in dboptions iterator **";
+
+ my $my_id = $roptions->[$$rindex]{id};
+ my $base_url = "$ENV{SCRIPT_NAME}?id=$article->{id}&option_id=$my_id&_csrfp=".$req->get_csrf_token("admin_move_option") . "&";
+
+ my $t = $req->cgi->param('_t');
+ $t && $t =~ /^\w+$/
+ and $base_url .= "_t=$t&";
+
+ my $up_url = '';
+ if ($$rindex > 0) {
+ $up_url = $base_url . "a_option_moveup=1";
+ }
+ my $down_url = '';
+ if ($$rindex < $#$roptions) {
+ $down_url = $base_url . "a_option_movedown=1";
+ }
+
+ my $refresh = $self->refresh_url($article, $req->cgi);
+
+ require BSE::Arrows;
+ return BSE::Arrows::make_arrows($req->cfg, $down_url, $up_url, $refresh, $args, id => $my_id, id_prefix => "prodoptmove");
+}
+
+sub tag_tier_price {
+ my ($self, $rtier, $rprices, $product) = @_;
+
+ unless ($rprices->{loaded}) {
+ %$rprices = map { $_->tier_id => $_ } $product->prices
+ if $product->{id};
+ $rprices->{loaded} = 1;
+ }
+
+ $$rtier or return '** no current tier **';
+
+ exists $rprices->{$$rtier->id}
+ or return '';
+
+ return $rprices->{$$rtier->id}->retailPrice;
+}
+
+sub save_more {
+ my ($self, $req, $article, $data) = @_;
+
+ $self->_save_price_tiers($req, $article, $data);
+ $self->SUPER::save_more($req, $article, $data);
+}
+
+sub save_new_more {
+ my ($self, $req, $article, $data) = @_;
+
+ $self->_save_price_tiers($req, $article, $data);
+ $self->SUPER::save_new_more($req, $article, $data);
+}
+
+sub _save_price_tiers {
+ my ($self, $req, $article, $data) = @_;
+
+ $data->{save_pricing_tiers}
+ or return;
+
+ $req->user_can('edit_field_edit_retailPrice', $article)
+ or return;
+
+ my @tiers = BSE::TB::Products->pricing_tiers;
+ my %prices;
+ for my $tier (@tiers) {
+ my $key = "tier_price_" . $tier->id;
+ if (exists $data->{$key} && $data->{$key} =~ /\S/) {
+ $prices{$tier->id} = $data->{$key} * 100;
+ }
+ }
+ $article->set_prices(\%prices);
+}
+
+sub save_columns {
+ my ($self, $table_object) = @_;
+
+ my @cols = $self->SUPER::save_columns($table_object);
+ my @tiers = BSE::TB::Products->pricing_tiers;
+ if (@tiers) {
+ push @cols, "save_pricing_tiers";
+ push @cols, map { "tier_price_" . $_->id } @tiers;
+ }
+
+ return @cols;
+}
+
+sub iter_dboptions {
+ my ($self, $article) = @_;
+
+ $article->{id}
+ or return;
+
+ return $article->db_options;
+}
+
+=head1 Edit tags
+
+These a tags available on admin/edit_* pages specific to products.
+
+=over
+
+=item *
+
+product I<field> - display the given field from the product being edited.
+
+=item *
+
+iterator begin dboptions ... dboption I<field> ... iterator end dboptions
+
+- iterate over the existing database stored options for the product
+
+=item *
+
+dboption_move - display arrows to move the current dboption. The span
+for the arrows is given an id of "prodoptmoveI<option-id>" by default.
+
+=item *
+
+iterator begin dboptionvalues ... dboptionvalue I<field> ... iterator end dboptionvalues
+
+- iterate over the values for the current dboption
+
+=item *
+
+dboptionvalue_move - display arrows to move the current dboption. The
+span for the arrows is given an id of "prodoptvaluemoveI<value-id>"
+by default.
+
+=item *
+
+dboptionsjson - returns the product options as JSON.
+
+=item *
+
+iterator begin price_tiers ... price_tier I<field> ... iterator end price_tiers
+
+Iterate over the configured price tiers.
+
+=item *
+
+tier_price
+
+Return the price at the current price_tier. Returns an empty string
+if there's no price at this tier.
+
+=back
+
+=cut
+
sub low_edit_tags {
my ($self, $acts, $req, $article, $articles, $msg, $errors) = @_;
my $cfg = $req->cfg;
my $mbcs = $cfg->entry('html', 'mbcs', 0);
my $tag_hash = $mbcs ? \&tag_hash_mbcs : \&hash_tag;
+ my $current_option;
+ my @dboptions;
+ my $dboption_index;
+ my @dboption_values;
+ my $dboption_value_index;
+ my $current_option_value;
my $it = BSE::Util::Iterate->new;
+ my @tiers;
+ my $price_tier;
+ my %prices;
+ $req->set_variable(product => $article);
+ BSE::PubSub->customize(product_edit_variables => { req => $req, product => $article, errors => \$errors });
return
(
- product => [ $tag_hash, $article ],
+ product => [ \&tag_article, $article, $cfg ],
$self->SUPER::low_edit_tags($acts, $req, $article, $articles, $msg,
$errors),
alloptions => join(",", sort keys %$product_opts),
$it->make_iterator
([ \&iter_subs, $req ], 'subscription', 'subscriptions'),
+ $it->make
+ (
+ single => "dboption",
+ plural => "dboptions",
+ store => \$current_option,
+ data => \@dboptions,
+ index => \$dboption_index,
+ code => [ iter_dboptions => $self, $article ],
+ ),
+ dboption_move =>
+ [
+ tag_dboption_move =>
+ $self, $req, $article, \@dboptions, \$dboption_index
+ ],
+ $it->make
+ (
+ single => "dboptionvalue",
+ plural => "dboptionvalues",
+ data => \@dboption_values,
+ index => \$dboption_value_index,
+ store => \$current_option_value,
+ code => [ iter_option_values => $self, \$current_option ],
+ nocache => 1,
+ ),
+ dboptionsjson => [ tag_dboptionsjson => $self, $article ],
+ dboptionvalue_move =>
+ [
+ tag_dboptionvalue_move =>
+ $self, $req, $article, \@dboption_values, \$dboption_value_index
+ ],
+ $it->make
+ (
+ single => "price_tier",
+ plural => "price_tiers",
+ code => [ pricing_tiers => "BSE::TB::Products" ],
+ data => \@tiers,
+ store => \$price_tier,
+ ),
+ tier_price => [ tag_tier_price => $self, \$price_tier, \%prices, $article ],
);
}
my $shopid = $self->{cfg}->entryErr('articles', 'shop');
unless ($parent &&
- $parent->{generator} eq 'Generate::Catalog') {
+ $parent->{generator} eq 'BSE::Generate::Catalog') {
$$rmsg = "Products must be in a catalog (not $parent->{generator})";
return;
}
sub _validate_common {
my ($self, $data, $articles, $errors) = @_;
+ $self->SUPER::_validate_common($data, $articles, $errors);
+
for my $col (keys %money_fields) {
my $value = $data->{$col};
defined $value or next;
}
}
+ if ($data->{save_pricing_tiers}) {
+ my @tiers = BSE::TB::Products->pricing_tiers;
+ for my $tier (@tiers) {
+ my $key = "tier_price_" . $tier->id;
+ my $value = $data->{$key};
+ defined $value or next;
+ if ($value =~ /\S/ && $value !~ /^\d+(\.\d{1,2})?\s*/) {
+ $errors->{$key} = 'Pricing tier "' . $tier->description . '" price invalid';
+ }
+ }
+ }
+
return !keys %$errors;
}
my $ok = $self->SUPER::validate($data, $articles, $errors);
$self->_validate_common($data, $articles, $errors);
- for my $field (qw(title summary body)) {
+ for my $field (qw(title)) {
unless ($data->{$field} =~ /\S/) {
$errors->{$field} = "No $field entered";
}
sub validate_old {
my ($self, $article, $data, $articles, $errors) = @_;
- $self->SUPER::validate($data, $articles, $errors)
+ $self->SUPER::validate_old($article, $data, $articles, $errors)
or return;
return !keys %$errors;
$labels{$id} = $title;
push @work, map [ $_->{id}, $title.' / '.$_->{title} ],
sort { $b->{displayOrder} <=> $a->{displayOrder} }
- grep $_->{generator} eq 'Generate::Catalog',
+ grep $_->{generator} eq 'BSE::Generate::Catalog',
$articles->getBy(parentid=>$id);
}
- unless ($shop->{generator} eq 'Generate::Catalog') {
+ unless ($shop->{generator} eq 'BSE::Generate::Catalog') {
shift @values;
delete $labels{$shopid};
}
sub table_object {
my ($self, $articles) = @_;
- 'Products';
+ 'BSE::TB::Products';
}
sub get_article {
my ($self, $articles, $article) = @_;
- return Products->getByPkey($article->{id});
+ return BSE::TB::Products->getByPkey($article->{id});
}
sub default_link_path {
sub make_link {
my ($self, $article) = @_;
+ $article->is_linked
+ or return "";
+
# Modified by adrian
my $urlbase = '';
if ($self->{cfg}->entry('shop', 'secureurl_articles', 1)) {
# end adrian
if ($article->is_dynamic) {
- return "$urlbase/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($article->{title});
+ (my $extra = $article->title) =~ tr/A-Za-z0-9/-/sc;
+ return "$urlbase/cgi-bin/page.pl?page=$article->{id}&title=".escape_uri($extra);
}
my $shop_uri = $self->link_path($article);
or $src->{leadTime} = 0;
$data->{leadTime} = $src->{leadTime};
}
- if (exists $src->{summary} && length $src->{summary}) {
+ if (exists $src->{description} && length $src->{description}) {
+ if ($data->{id}) {
+ if ($req->user_can('edit_field_edit_description', $data)) {
+ $data->{description} = $src->{description};
+ }
+ }
+ }
+ if (exists $src->{product_code} && length $src->{product_code}) {
if ($data->{id}) {
- if ($req->user_can('edit_field_edit_summary', $data)) {
- $data->{summary} = $src->{summary};
+ if ($req->user_can('edit_field_edit_product_code', $data)) {
+ $data->{product_code} = $src->{product_code};
}
}
}
for my $field (qw(options subscription_id subscription_period
- subscription_usage subscription_required)) {
+ subscription_usage subscription_required
+ weight length width height)) {
if (exists $src->{$field}) {
$data->{$field} = $src->{$field};
}
return $self->SUPER::default_template($article, $cfg, $templates);
}
-sub can_remove {
- my ($self, $req, $article, $articles, $rmsg) = @_;
-
- require BSE::TB::OrderItems;
- my @items = BSE::TB::OrderItems->getBy(productId=>$article->{id});
- if (@items) {
- $$rmsg = "There are orders for this product. It cannot be deleted.";
- return;
- }
-
- return $self->SUPER::can_remove($req, $article, $articles, $rmsg);
-}
-
sub flag_sections {
my ($self) = @_;
return ( 'product flags', $self->SUPER::flag_sections );
}
+sub shop_article { 1 }
+
my %defaults =
(
options => '',
+ description => '',
subscription_id => -1,
subscription_required => -1,
subscription_period => 1,
subscription_usage => 3,
+ leadTime => 0,
retailPrice => 0,
+ wholesalePrice => 0,
+ gst => 0,
+ product_code => '',
+ weight => 0,
+ length => 0,
+ height => 0,
+ width => 0,
);
sub default_value {
return $self->SUPER::type_default_value($req, $col);
}
-1;
+my %option_fields =
+ (
+ name =>
+ {
+ description => "Option name",
+ required => 1,
+ rules => "dh_one_line",
+ maxlength => 255,
+ },
+ value1 =>
+ {
+ description => "Value 1",
+ rules => "dh_one_line",
+ maxlength => 255,
+ },
+ );
+
+=head1 Targets
+
+Actions you can request from add.pl for products.
+
+=over
+
+=item a_add_option
+
+Add a new product option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_add_option
+
+For Ajax requests (or with a _ parameter) returns JSON like:
+
+ {
+ success: 1,
+ option: { <option data> },
+ values: [ { value data }, { value data }, ... ]
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - Article id
+
+=item *
+
+name - Name of the option (required)
+
+=item *
+
+value1 .. value5 - if any of these are non-blank they are added to the
+option as values.
+
+=back
+
+Permission required: bse_edit_prodopt_add
+
+=cut
+
+sub req_add_option {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->check_csrf('admin_add_option')
+ or return $self->csrf_error($req, $article, "admin_add_option", "Add Product Option");
+
+ $req->user_can(bse_edit_prodopt_add => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to add options");
+
+ my %errors;
+ my %work_option_fields = \%option_fields;
+ for my $field (grep /^value[1-9][0-9]*$/, $req->cgi->param) {
+ my ($index) = ( $field =~ /([1-9][0-9]*)$/);
+ $work_option_fields{$field} =
+ {
+ description => "Value $index",
+ rules => "dh_one_line",
+ maxlength => 255,
+ };
+ }
+ $req->validate(fields => \%work_option_fields,
+ errors => \%errors);
+ BSE::PubSub->customize(
+ product_option_add_validate =>
+ {
+ req => $req,
+ errors => \%errors,
+ product => $article,
+ fields => \%work_option_fields,
+ });
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef,
+ \%errors);
+
+ my $cgi = $req->cgi;
+ require BSE::TB::ProductOptions;
+ require BSE::TB::ProductOptionValues;
+ my $option = BSE::TB::ProductOptions->make
+ (
+ product_id => $article->{id},
+ name => scalar($cgi->param('name')),
+ display_order => time,
+ );
+
+ my $order = time;
+ my @values;
+ my %value_keys;
+ for my $value_key (sort grep /^value/, keys %work_option_fields) {
+ my ($value) = $cgi->param($value_key);
+ if (defined $value && $value =~ /\S/) {
+ my $entry = BSE::TB::ProductOptionValues->make
+ (
+ product_option_id => $option->{id},
+ value => $value,
+ display_order => $order,
+ );
+ push @values, $entry;
+ $value_keys{$value_key} = $entry;
+ ++$order;
+ }
+ }
+ my $def = $cgi->param("default");
+ if ($def && $value_keys{$def}) {
+ $option->set_default_value($value_keys{$def}->id);
+ $option->save;
+ }
+
+ BSE::PubSub->customize(
+ product_option_add =>
+ {
+ req => $req,
+ product => $article,
+ option => $option,
+ values => \%value_keys
+ });
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ option => $option->data_only,
+ values => [ map $_->data_only, @values ]
+ );
+
+ return $self->refresh($article, $cgi, undef, "Option added");
+}
+
+my %option_id =
+ (
+ option_id =>
+ {
+ rules => "required;positiveint",
+ },
+ );
+
+sub _get_option {
+ my ($self, $req, $article, $errors) = @_;
+
+ my $option;
+ my $cgi = $req->cgi;
+ $req->validate(fields => \%option_id,
+ errors => $errors);
+ my @option_ids = $cgi->param("option_id");
+ unless ($errors->{option_id}) {
+ @option_ids == 1
+ or $errors->{option_id} = "This request accepts only one option_id";
+ }
+ unless ($errors->{option_id}) {
+ require BSE::TB::ProductOptions;
+ $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id"));
+ $option
+ or $errors->{option_id} = "Unknown option id";
+ }
+ unless ($errors->{option_id}) {
+ $option->{product_id} = $article->{id}
+ or $errors->{option_id} = "Option doesn't belong to this product";
+ }
+ $errors->{option_id}
+ and return;
+
+ return $option;
+}
+
+sub _common_option {
+ my ($self, $template, $req, $article, $articles, $msg, $errors) = @_;
+
+ my %errors;
+ my $option = $self->_get_option($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+
+ if ($template =~ /edit/) {
+ BSE::PubSub->customize(
+ product_edit_option_edit => {
+ req => $req,
+ product => $article,
+ option => $option
+ });
+ }
+ $req->set_variable(option => $option);
+ $req->messages($errors);
+
+ my $it = BSE::Util::Iterate->new;
+ my %acts;
+ %acts =
+ (
+ $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
+ option => [ \&tag_hash, $option ],
+ $it->make
+ (
+ single => "dboptionvalue",
+ plural => "dboptionvalues",
+ code => [ iter_option_values => $self, \$option ],
+ ),
+ );
+
+ return $req->dyn_response($template, \%acts);
+}
+
+=item a_edit_option
+
+Produce a form to edit the given option.
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_id - option id. This must belong to the product identified by
+id.
+
+=back
+
+Template: admin/prodopt_edit
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_edit_option {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+
+ return $self->_common_option('admin/prodopt_edit', $req, $article,
+ $articles, $msg, $errors);
+}
+
+my %option_name =
+ (
+ name =>
+ {
+ description => "Option name",
+ rules => "required;dh_one_line",
+ maxlength => 255,
+ },
+ default_value =>
+ {
+ description => "Default Value",
+ rules => "positiveint"
+ }
+ );
+
+my %option_value =
+ (
+ description => "Value",
+ rules => "required;dh_one_line",
+ maxlength => 255,
+ );
+
+=item a_save_option
+
+Saves changes to an option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_save_option
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ option: { <option data> },
+ values: [ { value data, value data, ... } ]
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_id - id of the option to save, must belong to the product
+identified by id.
+
+=item *
+
+name - new value for the name field
+
+=item *
+
+default_value - id of the default value
+
+=item *
+
+save_enabled - if supplied and true, set enabled from the enabled
+parameter.
+
+=item *
+
+enabled - If supplied and true, enable the option, otherwise disable
+it. Ignored unless save_enabled is true.
+
+=item *
+
+valueI<value-id> - set the displayed value for the value record
+identified by I<value-id>. If these aren't supplied the values aren't
+changed.
+
+=back
+
+Permission required: bse_edit_prodopt_save
+
+=cut
+
+sub req_save_option {
+ my ($self, $req, $article, $articles) = @_;
+
+ my $cgi = $req->cgi;
+
+ $req->check_csrf("admin_save_option")
+ or return $self->csrf_error($req, $article, "admin_save_option", "Save Product Option");
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ my %errors;
+ my $option = $self->_get_option($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors, 'FIELD', "req_edit_option");
+ $req->validate(fields => \%option_name,
+ errors => \%errors);
+ BSE::PubSub->customize(
+ product_option_edit_validate =>
+ {
+ req => $req,
+ errors => \%errors,
+ product => $article,
+ option => $option,
+ });
+ my @values = $option->values;
+ my %fields = map {; "value$_->{id}" => \%option_value } @values;
+ $req->validate(fields => \%fields,
+ errors => \%errors,
+ optional => 1);
+ my $default_value = $cgi->param('default_value');
+ if (!$errors{default_value} && $default_value) {
+ grep $_->{id} == $default_value, @values
+ or $errors{default_value} = "Unknown value selected as default";
+ }
+
+ my @new_values;
+ my $index = 1;
+ while ($index < 10 && defined $cgi->param("newvalue$index")) {
+ my $field = "newvalue$index";
+ my $value = $cgi->param($field);
+ $req->validate(fields => { $field => \%option_value },
+ errors => \%errors);
+ push @new_values, [ $field, $value ];
+
+ ++$index;
+ }
+
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors, "FIELD", "req_edit_option");
+
+ my $name = $cgi->param("name");
+ defined $name
+ and $option->set_name($name);
+ defined $default_value
+ and $option->set_default_value($default_value);
+ if ($cgi->param("save_enabled")) {
+ my $enabled = $cgi->param("enabled") ? 1 : 0;
+ $option->set_enabled($enabled);
+ }
+ $option->save;
+ for my $value (@values) {
+ my $new_value = $cgi->param("value$value->{id}");
+ if (defined $new_value && $new_value ne $value->value) {
+ $value->set_value($new_value);
+ $value->save;
+ }
+ }
+ my $order = @values ? $values[-1]->display_order : time;
+ my %newvalues;
+ for my $new (@new_values) {
+ my ($name, $value) = @$new;
+ $newvalues{$name} = BSE::TB::ProductOptionValues->make
+ (
+ product_option_id => $option->id,
+ value => $value,
+ display_order => ++$order,
+ );
+ }
+ BSE::PubSub->customize(
+ product_option_edit_save =>
+ {
+ req => $req,
+ product => $article,
+ option => $option,
+ newvalues => \%newvalues,
+ });
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ option => $option->data_only,
+ values => [ map $_->data_only, @values ],
+ );
+
+ return $self->refresh($article, $req->cgi, undef,
+ "Option '" . $option->name . "' saved");
+}
+
+=item a_delconf_option
+
+Produce a form to confirm deletion of the given option.
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_id - option id. This must belong to the product identified by
+id.
+
+=back
+
+Template: admin/prodopt_delete
+
+=cut
+
+sub req_delconf_option {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->user_can(bse_edit_prodopt_delete => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options");
+
+ return $self->_common_option('admin/prodopt_delete', $req, $article,
+ $articles, $msg, $errors);
+}
+
+=item a_delete_option
+
+Delete the given option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_delete_option
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ }
+
+Permission required: bse_edit_prodopt_delete
+
+=cut
+
+sub req_delete_option {
+ my ($self, $req, $article, $articles) = @_;
+
+ $req->check_csrf("admin_delete_option")
+ or return $self->csrf_error($req, $article, "admin_delete_option", "Delete Product Option");
+
+ $req->user_can(bse_edit_prodopt_delete => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to delete options");
+
+ my %errors;
+ my $option = $self->_get_option($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+ my @values = $option->values;
+
+ for my $value (@values) {
+ $value->remove;
+ }
+ $option->remove;
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1
+ );
+
+ return $self->refresh($article, $req->cgi, undef, "Option deleted");
+}
+
+
+my %add_option_value_fields =
+ (
+ option_id =>
+ {
+ description => "Option id",
+ rules => "required;positiveint",
+ },
+ value =>
+ {
+ description => "Value",
+ rules => "required;dh_one_line",
+ maxlength => 255,
+ },
+ );
+
+=item a_add_option_value
+
+Add a value to a product option.
+
+On failure perform a service error, see BSE::Edit::Article::_service_error.
+
+Requires _csrfp for admin_add_option_value
+
+For Ajax requests returns JSON like
+
+ { success: 1, value: (valueobject) }
+
+Standard redirect on success otherwise.
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_id - id of the option to add the value to
+
+=item *
+
+value - text of the value to add.
+
+=back
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_add_option_value {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->check_csrf("admin_add_option_value")
+ or return $self->csrf_error($req, $article, "admin_add_option_value", "Add Product Option Value");
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ my %errors;
+ $req->validate(fields => \%add_option_value_fields,
+ errors => \%errors);
+ my $option;
+ my $cgi = $req->cgi;
+ unless ($errors{option_id}) {
+ require BSE::TB::ProductOptions;
+ $option = BSE::TB::ProductOptions->getByPkey($cgi->param("option_id"));
+ defined $option && $option->{product_id}
+ or $errors{option_id} = "Bad option id - either unknown or for a different product";
+ }
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+
+ my $value = $cgi->param("value");
+ require BSE::TB::ProductOptionValues;
+ my $entry = BSE::TB::ProductOptionValues->make
+ (
+ product_option_id => $option->{id},
+ value => $value,
+ display_order => time,
+ );
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ value => $entry->data_only
+ );
+
+ return $self->refresh($article, $cgi, undef, "Value added");
+}
+
+
+my %option_value_id =
+ (
+ value_id =>
+ {
+ rules => "required;positiveint",
+ },
+ );
+
+sub _get_option_value {
+ my ($self, $req, $article, $errors) = @_;
+
+ my $option_value;
+ my $cgi = $req->cgi;
+ $req->validate(fields => \%option_value_id,
+ errors => $errors);
+ unless ($errors->{value_id}) {
+ require BSE::TB::ProductOptionValues;
+ $option_value = BSE::TB::ProductOptionValues->getByPkey($cgi->param("value_id"));
+ $option_value
+ or $errors->{value_id} = "Unknown option value id";
+ }
+ my $option;
+ unless ($errors->{value_id}) {
+ $option = $option_value->option;
+ defined $option && $option->{product_id} == $article->{id}
+ or $errors->{value_id} = "Value has no option or doesn't belong to the product";
+ }
+
+ $errors->{value_id}
+ and return;
+
+ return wantarray ? ( $option_value, $option ) : $option_value ;
+}
+
+sub _common_option_value {
+ my ($self, $template, $req, $article, $articles, $msg, $errors) = @_;
+
+ my %errors;
+ my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+
+ $req->set_variable(option => $option);
+ $req->set_variable(option_value => $option_value);
+ my %acts;
+ %acts =
+ (
+ $self->low_edit_tags(\%acts, $req, $article, $articles, $msg, $errors),
+ option_value => [ \&tag_hash, $option_value ],
+ option => [ \&tag_hash, $option ],
+ );
+
+ return $req->dyn_response($template, \%acts);
+}
+
+=item a_edit_option_value
+
+Displays a form to edit the value for a given option.
+
+Parameters:
+
+=over
+
+=item *
+
+id - id of the product
+
+=item *
+
+value_id - id of he product option value to edit, must belong to the
+given product.
+
+=back
+
+Template: admin/prodopt_value_edit
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_edit_option_value {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ return $self->_common_option_value('admin/prodopt_value_edit', $req,
+ $article, $articles, $msg, $errors);
+}
+
+my %save_option_value_fields =
+ (
+ value =>
+ {
+ rules => "required;dh_one_line",
+ maxlength => 255,
+ },
+ );
+
+=item a_save_option_value
+
+Saves changes to an option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_save_option_value
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ value: { value data }
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+value_id - id of the value to save, must belong to the product
+identified by id.
+
+=item *
+
+value - new displayed value for the option value.
+
+=back
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_save_option_value {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->check_csrf("admin_save_option_value")
+ or return $self->csrf_error($req, $article, "admin_save_option_value", "Save Product Option Value");
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ my %errors;
+ $req->validate(fields => \%save_option_value_fields,
+ errors => \%errors);
+ my $option_value = $self->_get_option_value($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+
+ my $cgi = $req->cgi;
+ $option_value->{value} = $cgi->param("value");
+ $option_value->save;
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ value => $option_value->data_only
+ );
+
+ return $self->refresh($article, $cgi, undef, "Value saved");
+}
+
+=item a_confdel_option_value
+
+Displays a page confirming deletion of a product option value.
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+value_id - option value id
+
+=back
+
+Template: admin/prodopt_value_delete
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_confdel_option_value {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ return $self->_common_option_value('admin/prodopt_value_delete', $req,
+ $article, $articles, $msg, $errors);
+}
+
+=item a_delete_option_value
+
+Deletes a product option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_delete_option_value
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+value_id - id of the value to delete, must belong to the product
+identified by id.
+
+=back
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_delete_option_value {
+ my ($self, $req, $article, $articles, $msg, $errors) = @_;
+
+ $req->check_csrf("admin_delete_option_value")
+ or return $self->csrf_error($req, $article, "admin_delete_option_value", "Delete Product Option Value");
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ my %errors;
+ my $option_value = $self->_get_option_value($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+
+ $option_value->remove;
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1
+ );
+
+ return $self->refresh($article, $req->cgi, undef, "Value removed");
+}
+
+sub tag_dboptionsjson {
+ my ($self, $article) = @_;
+
+ my @result;
+ my @options = $article->db_options;
+ my @opt_cols = BSE::TB::ProductOption->columns;
+ for my $option (@options) {
+ my $entry = $option->data_only;
+ $entry->{values} = [ map $_->data_only, $option->values ];
+ push @result, $entry;
+ }
+
+ require JSON;
+ my $json = JSON->new;
+ return $json->encode(\@result);
+}
+
+sub _option_move {
+ my ($self, $req, $article, $articles, $direction) = @_;
+
+ $req->check_csrf("admin_move_option")
+ or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option");
+
+ $req->user_can(bse_edit_prodopt_move => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options");
+
+ my %errors;
+ my $option = $self->_get_option($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+ my @options = $article->db_options;
+ my ($index) = grep $options[$_]{id} == $option->{id}, 0 .. $#options
+ or return $self->_service_error($req, $article, $articles, "Unknown option id");
+
+ $options[$index] = $option;
+
+ my $other_index = $index + $direction;
+ $other_index >= 0 && $other_index < @options
+ or return $self->_service_error($req, $article, $articles, "Can't move option beyond end");
+
+ my $other = $options[$other_index];
+
+ ($option->{display_order}, $other->{display_order}) =
+ ($other->{display_order}, $option->{display_order});
+ $option->save;
+ $other->save;
+
+ if ($req->is_ajax) {
+ @options = sort { $a->{display_order} <=> $b->{display_order} } @options;
+ return return $req->json_content
+ (
+ success => 1,
+ order => [ map $_->{id}, @options ]
+ );
+ }
+
+ return $self->refresh($article, $req->cgi, undef, "Option moved");
+}
+
+=item a_option_moveup
+
+=item a_option_movedown
+
+Move a product option up/down through the options for a product.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_move_option
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ order: [ list of option ids ]
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_id - option id. This must belong to the product identified by
+id.
+
+=back
+
+Permission required: bse_edit_prodopt_move
+
+=cut
+
+sub req_option_moveup {
+ my ($self, $req, $article, $articles) = @_;
+
+ return $self->_option_move($req, $article, $articles, -1);
+}
+
+sub req_option_movedown {
+ my ($self, $req, $article, $articles) = @_;
+
+ return $self->_option_move($req, $article, $articles, 1);
+}
+
+=item a_option_reorder
+
+Move a product option up/down through the options for a product.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_move_option
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ order: [ list of option ids ]
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_ids - option ids separated by commas. These must belong to the
+product identified by id.
+
+=back
+
+Permission required: bse_edit_prodopt_move
+
+=cut
+
+sub req_option_reorder {
+ my ($self, $req, $article, $articles) = @_;
+
+ $req->check_csrf("admin_move_option")
+ or return $self->csrf_error($req, $article, "admin_move_option", "Move Product Option");
+
+ $req->user_can(bse_edit_prodopt_move => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to move options");
+
+ my @options = $article->db_options;
+ my @order = map { split ',' } $req->cgi->param('option_ids');
+ my %options = map { $_->{id} => $_ } @options;
+ my @new_options;
+ for my $id (@order) {
+ my $option = delete $options{$id}
+ or next;
+ push @new_options, $option;
+ }
+ push @new_options, sort { $a->{display_order} <=> $b->{display_order} } values %options;
+ my @display_order = map $_->{display_order}, @options;
+ for my $index (0 .. $#new_options) {
+ $new_options[$index]{display_order} = $display_order[$index];
+ $new_options[$index]->save;
+ }
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ order => [ map $_->{id}, @new_options ]
+ );
+
+ return $self->refresh($article, $req->cgi, undef, "Options reordered");
+}
+
+sub _option_value_move {
+ my ($self, $req, $article, $articles, $direction) = @_;
+
+ $req->check_csrf("admin_move_option_value")
+ or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value");
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ my %errors;
+ my ($option_value, $option) = $self->_get_option_value($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+ my @values = $option->values;
+ my ($index) = grep $values[$_]{id} == $option_value->{id}, 0 .. $#values
+ or return $self->_service_error($req, $article, $articles, "Unknown option value id");
+
+ $values[$index] = $option_value;
+
+ my $other_index = $index + $direction;
+ $other_index >= 0 && $other_index < @values
+ or return $self->_service_error($req, $article, $articles, "Can't move option value beyond end");
+
+ my $other = $values[$other_index];
+
+ ($option_value->{display_order}, $other->{display_order}) =
+ ($other->{display_order}, $option_value->{display_order});
+ $option_value->save;
+ $other->save;
+
+ # make sure the json gets the new order
+ @values[$index, $other_index] = @values[$other_index, $index];
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ order => [ map $_->{id}, @values ]
+ );
+
+ return $self->refresh($article, $req->cgi, undef, "Value moved");
+}
+
+=item a_option_value_moveup
+
+=item a_option_value_movedown
+
+Move a product option value up/down through the values for a product
+option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_move_option_value
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ order: [ list of value ids ]
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+value_id - option id. This must belong to the product identified by
+id.
+
+=back
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_option_value_moveup {
+ my ($self, $req, $article, $articles) = @_;
+
+ return $self->_option_value_move($req, $article, $articles, -1);
+}
+
+sub req_option_value_movedown {
+ my ($self, $req, $article, $articles) = @_;
+
+ return $self->_option_value_move($req, $article, $articles, 1);
+}
+
+=item a_option_value_reorder
+
+Specify a new order for the values belonging to a product option.
+
+On failure perform a service error.
+
+Requires _csrfp for admin_move_option_value
+
+For Ajax requests (or with a _ parameter), returns JSON like:
+
+ {
+ success: 1,
+ order: [ list of value ids ]
+ }
+
+Parameters:
+
+=over
+
+=item *
+
+id - article id
+
+=item *
+
+option_id - the option to reorder values for
+
+=item *
+
+value_ids - new order for values specified as value ids separated by
+commas.
+
+=back
+
+Permission required: bse_edit_prodopt_edit
+
+=cut
+
+sub req_option_value_reorder {
+ my ($self, $req, $article, $articles) = @_;
+
+ $req->check_csrf("admin_move_option_value")
+ or return $self->csrf_error($req, $article, "admin_move_option_value", "Move Product Option Value");
+
+ $req->user_can(bse_edit_prodopt_edit => $article)
+ or return $self->_service_error($req, $article, $articles, "Insufficient product access to edit options");
+
+ my %errors;
+ my $option = $self->_get_option($req, $article, \%errors);
+ keys %errors
+ and return $self->_service_error($req, $article, $articles, undef, \%errors);
+ my @order = map { split ',' } $req->cgi->param('value_ids');
+ my @values = $option->values;
+ my %values = map { $_->{id} => $_ } @values;
+ my @new_values;
+ for my $id (@order) {
+ my $value = delete $values{$id}
+ or next;
+ push @new_values, $value;
+ }
+ push @new_values, sort { $a->{display_order} <=> $b->{display_order} } values %values;
+ my @display_order = map $_->{display_order}, @values;
+ for my $index (0 .. $#new_values) {
+ $new_values[$index]{display_order} = $display_order[$index];
+ $new_values[$index]->save;
+ }
+
+ $req->is_ajax
+ and return $req->json_content
+ (
+ success => 1,
+ option => $option->data_only,
+ order => [ map $_->{id}, @new_values ]
+ );
+
+ return $self->refresh($article, $req->cgi, undef, "Values reordered");
+}
+
+sub custom_fields {
+ my ($self) = @_;
+
+ my $custom = $self->SUPER::custom_fields();
+
+ require DevHelp::Validate;
+ DevHelp::Validate->import;
+ return DevHelp::Validate::dh_configure_fields
+ (
+ $custom,
+ $self->cfg,
+ PRODUCT_CUSTOM_FIELDS_CFG,
+ BSE::DB->single->dbh,
+ );
+}
+
+sub article_actions {
+ my $self = shift;
+
+ return
+ (
+ $self->SUPER::article_actions,
+ a_add_option => 'req_add_option',
+ a_confdel_option => 'req_confdel_option',
+ a_del_option => 'req_del_option',
+ a_edit_option => 'req_edit_option',
+ a_save_option => 'req_save_option',
+ a_delconf_option => 'req_delconf_option',
+ a_delete_option => 'req_delete_option',
+ a_get_option => 'req_get_option',
+ a_edit_option_value => 'req_edit_option_value',
+ a_save_option_value => 'req_save_option_value',
+ a_confdel_option_value => 'req_confdel_option_value',
+ a_delete_option_value => 'req_delete_option_value',
+ a_add_option_value => 'req_add_option_value',
+ a_option_value_moveup => 'req_option_value_moveup',
+ a_option_value_movedown => 'req_option_value_movedown',
+ a_option_value_reorder => 'req_option_value_reorder',
+ a_option_moveup => 'req_option_moveup',
+ a_option_movedown => 'req_option_movedown',
+ a_option_reorder => 'req_option_reorder',
+ );
+}
+
+1;
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut
projects / bse.git / blobdiff