site/cgi-bin/modules/BSE/Generate/Subscription.pm
site/cgi-bin/modules/OtherParent.pm
site/cgi-bin/modules/OtherParents.pm
-site/cgi-bin/modules/Product.pm
-site/cgi-bin/modules/Products.pm
+site/cgi-bin/modules/BSE/TB/Product.pm
+site/cgi-bin/modules/BSE/TB/Products.pm
site/cgi-bin/modules/SiteUser.pm
site/cgi-bin/modules/SiteUsers.pm
site/cgi-bin/modules/Squirrel/GPG.pm
use Fcntl qw(:seek);
use Cwd;
-our $VERSION = "1.009";
+our $VERSION = "1.010";
=head1 NAME
my $cfg = delete $opts{cfg}
or confess "cfg option missing";
- require Products;
+ require BSE::TB::Products;
defined $opts{title} && length $opts{title}
or confess "Missing title option\n";
_set_dynamic($cfg, \%opts);
- my @cols = Product->columns;
+ my @cols = BSE::TB::Product->columns;
shift @cols;
- my $product = Products->add(@opts{@cols});
+ my $product = BSE::TB::Products->add(@opts{@cols});
require BSE::Edit::Product;
_finalize_article($cfg, $product, 'BSE::Edit::Product');
use strict;
use Scalar::Util;
-our $VERSION = "1.009";
+our $VERSION = "1.010";
=head1 NAME
my $product = $self->{products}{$id};
unless ($product) {
- require Products;
- $product = Products->getByPkey($id)
+ require BSE::TB::Products;
+ $product = BSE::TB::Products->getByPkey($id)
or die "No product $id\n";
# FIXME
if ($product->generator ne "BSE::Generate::Product") {
our $AUTOLOAD;
(my $name = $AUTOLOAD) =~ s/^.*:://;
unless (%product_keys) {
- require Products;
- %product_keys = map { $_ => 1 } Product->columns;
+ require BSE::TB::Products;
+ %product_keys = map { $_ => 1 } BSE::TB::Product->columns;
}
if ($product_keys{$name}) {
package BSE::Dynamic::Product;
use strict;
use base 'BSE::Dynamic::Article';
-use Products;
+use BSE::TB::Products;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub get_real_article {
my ($self, $article) = @_;
- Products->getByPkey($article->{id});
+ BSE::TB::Products->getByPkey($article->{id});
}
sub tags {
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 BSE::Util::Tags qw(tag_hash tag_article);
use constant PRODUCT_CUSTOM_FIELDS_CFG => "product custom fields";
-our $VERSION = "1.014";
+our $VERSION = "1.015";
=head1 NAME
$req->user_can('edit_field_edit_retailPrice', $article)
or return;
- my @tiers = Products->pricing_tiers;
+ my @tiers = BSE::TB::Products->pricing_tiers;
my %prices;
for my $tier (@tiers) {
my $key = "tier_price_" . $tier->id;
my ($self, $table_object) = @_;
my @cols = $self->SUPER::save_columns($table_object);
- my @tiers = Products->pricing_tiers;
+ my @tiers = BSE::TB::Products->pricing_tiers;
if (@tiers) {
push @cols, "save_pricing_tiers";
push @cols, map { "tier_price_" . $_->id } @tiers;
(
single => "price_tier",
plural => "price_tiers",
- code => [ pricing_tiers => "Products" ],
+ code => [ pricing_tiers => "BSE::TB::Products" ],
data => \@tiers,
store => \$price_tier,
),
}
if ($data->{save_pricing_tiers}) {
- my @tiers = Products->pricing_tiers;
+ my @tiers = BSE::TB::Products->pricing_tiers;
for my $tier (@tiers) {
my $key = "tier_price_" . $tier->id;
my $value = $data->{$key};
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 {
package BSE::Generate::Catalog;
-our $VERSION = "1.005";
+our $VERSION = "1.006";
use strict;
use BSE::Generate;
-use Products;
+use BSE::TB::Products;
use base 'BSE::Generate::Article';
use BSE::Template;
use Constants qw($CGI_URI $ADMIN_URI);
sub baseActs {
my ($self, $articles, $acts, $article, $embedded) = @_;
- my $products = Products->new;
+ my $products = BSE::TB::Products->new;
my @products = sort { $b->{displayOrder} <=> $a->{displayOrder} }
grep $_->{listed} && $_->{parentid} == $article->{id}, $products->all;
my $product_index = -1;
my @allprods = grep UNIVERSAL::isa($_->{generator}, 'BSE::Generate::Product'),
@allkids;
for (@allprods) {
- unless ($_->isa('Product')) {
- $_ = Products->getByPkey($_->{id});
+ unless ($_->isa('BSE::TB::Product')) {
+ $_ = BSE::TB::Products->getByPkey($_->{id});
}
}
my @allcats = grep UNIVERSAL::isa($_->{generator}, 'BSE::Generate::Catalog'),
package BSE::Generate::Product;
use strict;
use BSE::Generate::Article;
-use Products;
+use BSE::TB::Products;
use BSE::TB::Images;
use base qw(BSE::Generate::Article);
use Constants qw(:shop $CGI_URI $ADMIN_URI);
use BSE::Util::HTML;
use BSE::Util::Tags qw(tag_article);
-our $VERSION = "1.002";
+our $VERSION = "1.003";
sub edit_link {
my ($self, $id) = @_;
sub generate {
my ($self, $article, $articles) = @_;
- my $product = Products->getByPkey($article->{id});
+ my $product = BSE::TB::Products->getByPkey($article->{id});
return $self->SUPER::generate($product, $articles);
}
sub baseActs {
my ($self, $articles, $acts, $product, $embedded) = @_;
- unless ($product->isa('Product')) {
- $product = Products->getByPkey($product->{id});
+ unless ($product->isa('BSE::TB::Product')) {
+ $product = BSE::TB::Products->getByPkey($product->{id});
}
my @stepcats = $product->step_parents();
sub get_real_article {
my ($self, $article) = @_;
- return Products->getByPkey($article->{id});
+ return BSE::TB::Products->getByPkey($article->{id});
}
1;
use base 'BSE::Importer::Target::Base';
use BSE::API qw(bse_make_article bse_add_image bse_add_step_parent);
use BSE::TB::Articles;
-use Products;
+use BSE::TB::Products;
use OtherParents;
-our $VERSION = "1.009";
+our $VERSION = "1.010";
=head1 NAME
use base 'BSE::Importer::Target::Article';
use BSE::API qw(bse_make_product bse_make_catalog bse_add_image);
use BSE::TB::Articles;
-use Products;
+use BSE::TB::Products;
use BSE::TB::ProductOptions;
use BSE::TB::ProductOptionValues;
use BSE::TB::PriceTiers;
-our $VERSION = "1.007";
+our $VERSION = "1.008";
=head1 NAME
reset_prodopts=1
# done by the importer
- my $target = BSE::Importer::Target::Product->new
+ my $target = BSE::Importer::Target::BSE::TB::Product->new
(importer => $importer, opts => \%opts)
...
$target->start($imp);
my $leaf;
if ($self->{code_field} eq "id") {
- $leaf = Products->getByPkey($leaf_id);
+ $leaf = BSE::TB::Products->getByPkey($leaf_id);
}
else {
- ($leaf) = Products->getBy($self->{code_field}, $leaf_id)
+ ($leaf) = BSE::TB::Products->getBy($self->{code_field}, $leaf_id)
or return;
}
my ($self, $importer, $entry) = @_;
if (defined $entry->{product_code} && $entry->{product_code} ne '') {
- my $other = Products->getBy(product_code => $entry->{product_code});
+ my $other = BSE::TB::Products->getBy(product_code => $entry->{product_code});
$other
and die "Duplicate product_code with product ", $other->id, "\n";
}
use Spreadsheet::ParseExcel;
use BSE::API qw(bse_make_product bse_make_catalog bse_add_image);
use BSE::TB::Articles;
-use Products;
+use BSE::TB::Products;
use Config;
-our $VERSION = "1.002";
+our $VERSION = "1.003";
sub new {
my ($class, $cfg, $profile, %opts) = @_;
$entry{parentid} = $self->_find_cat(\%cat_cache, $callback, $self->{parent}, @cats);
my $product;
if ($self->{codes}) {
- $product = Products->getBy(product_code => $entry{product_code});
+ $product = BSE::TB::Products->getBy(product_code => $entry{product_code});
}
if ($product) {
@{$product}{keys %entry} = values %entry;
use Carp qw(confess);
use BSE::CfgInfo qw(load_class);
-our $VERSION = "1.002";
+our $VERSION = "1.003";
sub get_couriers {
my ($class, $cfg, $wanted) = @_;
sub package_order {
my ($class, $cfg, $order, $items) = @_;
- require Products;
+ require BSE::TB::Products;
my $total_weight = 0;
my $total_length = 0;
my $total_width = 0;
my $total_height = 0;
foreach my $item (@$items) {
- my $product = Products->getByPkey($item->{productId});
+ my $product = BSE::TB::Products->getByPkey($item->{productId});
my $number = $item->{units};
my $weight = $product->{weight};
payment_types order_item_opts
PAYMENT_CC PAYMENT_CHEQUE PAYMENT_CALLME PAYMENT_MANUAL PAYMENT_PAYPAL/;
-our $VERSION = "1.010";
+our $VERSION = "1.011";
our %EXPORT_TAGS =
(
my @products;
my $today = now_sqldate();
for my $item (@cart) {
- my $product = Products->getByPkey($item->{productId});
+ my $product = BSE::TB::Products->getByPkey($item->{productId});
# double check that it's still a valid product
if (!$product) {
$$error = "Product $item->{productId} not found";
@ISA = qw/Squirrel::Row BSE::TB::SiteCommon BSE::TB::TagOwner/;
use Carp 'confess';
-our $VERSION = "1.024";
+our $VERSION = "1.025";
=head1 NAME
my $dynamic = $cfg->entry('basic', 'all_dynamic', 0) ? 1 : 0;
if (!$dynamic && $self->generator =~ /\bCatalog\b/) {
- require Products;
- my @tiers = Products->pricing_tiers;
+ require BSE::TB::Products;
+ my @tiers = BSE::TB::Products->pricing_tiers;
@tiers and $dynamic = 1;
}
use Carp 'confess';
use BSE::Shop::PaymentTypes;
-our $VERSION = "1.024";
+our $VERSION = "1.025";
sub columns {
return qw/id
sub products {
my ($self) = @_;
- require Products;
- Products->getSpecial(orderProducts=>$self->{id});
+ require BSE::TB::Products;
+ BSE::TB::Products->getSpecial(orderProducts=>$self->{id});
}
sub valid_fields {
$current_item
or return '* only usable in items *';
- require Products;
+ require BSE::TB::Products;
my $id = $current_item->productId;
- $products{$id} ||= Products->getByPkey($id);
+ $products{$id} ||= BSE::TB::Products->getByPkey($id);
my $product = $products{$id}
or return '';
$current_item
or return '* only usable in items *';
- require Products;
+ require BSE::TB::Products;
my $id = $current_item->productId;
- $products{$id} ||= Products->getByPkey($id);
+ $products{$id} ||= BSE::TB::Products->getByPkey($id);
my $product = $products{$id}
or return '';
use vars qw/@ISA/;
@ISA = qw/Squirrel::Row/;
-our $VERSION = "1.003";
+our $VERSION = "1.004";
sub columns {
return qw/id productId orderId units price wholesalePrice gst options
$self->productId == -1
and return;
- require Products;
- return Products->getByPkey($self->productId);
+ require BSE::TB::Products;
+ return BSE::TB::Products->getByPkey($self->productId);
}
sub option_hashes {
--- /dev/null
+package BSE::TB::Product;
+use strict;
+# represents a product from the database
+use BSE::TB::Articles;
+use vars qw/@ISA/;
+@ISA = qw/BSE::TB::Article/;
+
+our $VERSION = "1.005";
+
+# subscription_usage values
+use constant SUBUSAGE_START_ONLY => 1;
+use constant SUBUSAGE_RENEW_ONLY => 2;
+use constant SUBUSAGE_EITHER => 3;
+
+sub columns {
+ return ($_[0]->SUPER::columns(),
+ qw/articleId description leadTime retailPrice wholesalePrice gst options
+ subscription_id subscription_period subscription_usage
+ subscription_required product_code weight length height width/ );
+}
+
+sub bases {
+ return { articleId=>{ class=>'BSE::TB::Article'} };
+}
+
+sub subscription_required {
+ my ($self) = @_;
+
+ my $id = $self->{subscription_required};
+ return if $id == -1;
+
+ require BSE::TB::Subscriptions;
+ return BSE::TB::Subscriptions->getByPkey($id);
+}
+
+sub subscription {
+ my ($self) = @_;
+
+ my $id = $self->{subscription_id};
+ return if $id == -1;
+
+ require BSE::TB::Subscriptions;
+ return BSE::TB::Subscriptions->getByPkey($id);
+}
+
+sub is_renew_sub_only {
+ my ($self) = @_;
+
+ $self->{subscription_usage} == SUBUSAGE_RENEW_ONLY;
+}
+
+sub is_start_sub_only {
+ my ($self) = @_;
+
+ $self->{subscription_usage} == SUBUSAGE_START_ONLY;
+}
+
+sub _get_cfg_options {
+ my ($cfg) = @_;
+
+ require BSE::CfgInfo;
+ my $avail_options = BSE::CfgInfo::product_options($cfg);
+ my @options;
+ for my $name (keys %$avail_options) {
+ my $rawopt = $avail_options->{$name};
+ my %opt =
+ (
+ id => $name,
+ name => $rawopt->{desc},
+ default => $rawopt->{default} || '',
+ );
+ my @values;
+ for my $value (@{$rawopt->{values}}) {
+ my $label = $rawopt->{labels}{$value} || $value;
+ push @values,
+ bless
+ {
+ id => $value,
+ value => $label,
+ }, "BSE::CfgProductOptionValue";
+ }
+ $opt{values} = \@values;
+ push @options, bless \%opt, "BSE::CfgProductOption";
+ }
+
+ return @options;
+}
+
+sub _get_prod_options {
+ my ($product, $cfg, @values) = @_;
+
+ my %all_cfg_opts = map { $_->id => $_ } _get_cfg_options($cfg);
+ my @opt_names = split /,/, $product->{options};
+
+ my @cfg_opts = map $all_cfg_opts{$_}, @opt_names;
+ my @db_opts = grep $_->enabled, $product->db_options;
+ my @all_options = ( @cfg_opts, @db_opts );
+
+ push @values, '' while @values < @all_options;
+
+ my $index = 0;
+ my @sem_options;
+ for my $opt (@all_options) {
+ my @opt_values = $opt->values;
+ my %opt_values = map { $_->id => $_->value } @opt_values;
+ my $result_opt =
+ {
+ id => $opt->key,
+ name => $opt->key,
+ desc => $opt->name,
+ value => $values[$index],
+ type => $opt->type,
+ labels => \%opt_values,
+ default => $opt->default_value,
+ };
+ my $value = $values[$index];
+ if (defined $value) {
+ $result_opt->{values} = [ map $_->id, @opt_values ],
+ $result_opt->{display} = $opt_values{$values[$index]};
+ }
+ push @sem_options, $result_opt;
+ ++$index;
+ }
+
+ return @sem_options;
+}
+
+sub option_descs {
+ my ($self, $cfg, $rvalues) = @_;
+
+ $rvalues or $rvalues = [ ];
+
+ return $self->_get_prod_options($cfg, @$rvalues);
+}
+
+sub db_options {
+ my ($self) = @_;
+
+ require BSE::TB::ProductOptions;
+ return BSE::TB::ProductOptions->getBy2
+ (
+ [ product_id => $self->{id} ],
+ { order => "display_order" }
+ );
+}
+
+sub remove {
+ my ($self, $cfg) = @_;
+
+ # remove any product options
+ for my $opt ($self->db_options) {
+ $opt->remove;
+ }
+
+ # mark any order line items to "anonymize" them
+ BSE::DB->run(bseMarkProductOrderItemsAnon => $self->id);
+
+ # remove any wishlist items
+ BSE::DB->run(bseRemoveProductFromWishlists => $self->id);
+
+ # remove any tiered prices
+ BSE::DB->run(bseRemoveProductPrices => $self->id);
+
+ return $self->SUPER::remove($cfg);
+}
+
+sub has_sale_files {
+ my ($self) = @_;
+
+ my ($row) = BSE::DB->query(bseProductHasSaleFiles => $self->{id});
+
+ return $row->{have_sale_files};
+}
+
+sub prices {
+ my ($self) = @_;
+
+ require BSE::TB::PriceTierPrices;
+ my @prices = BSE::TB::PriceTierPrices->getBy(product_id => $self->id);
+}
+
+=item set_prices($prices)
+
+Set tiered pricing for the product.
+
+I<$prices> is a hashref mapping tier ids to prices in cents.
+
+If a tier doesn't have a price in I<$prices> it's removed from the
+product.
+
+=cut
+
+sub set_prices {
+ my ($self, $prices) = @_;
+
+ my %current = map { $_->tier_id => $_ } $self->prices;
+ for my $tier_id (keys %$prices) {
+ my $current = delete $current{$tier_id};
+ if ($current) {
+ $current->set_retailPrice($prices->{$tier_id});
+ $current->save;
+ }
+ else {
+ BSE::TB::PriceTierPrices->make
+ (
+ tier_id => $tier_id,
+ product_id => $self->id,
+ retailPrice => $prices->{$tier_id},
+ );
+ }
+ }
+
+ # remove any spares
+ for my $price (values %current) {
+ $price->remove;
+ }
+}
+
+=item price(user => $user, date => $sql_date)
+
+=item price(user => $user)
+
+Return the retail price depending on the user and date
+and optionally the tier object (in list context).
+
+If no tier matches then the undef is returned at the tier object.
+
+=cut
+
+sub price {
+ my ($self, %opts) = @_;
+
+ my $user = delete $opts{user};
+ my $date = delete $opts{date} || BSE::Util::SQL::now_sqldate();
+ my @tiers = BSE::TB::Products->pricing_tiers;
+ my %prices = map { $_->tier_id => $_ } $self->prices;
+
+ my $price;
+ my $found_tier;
+ for my $tier (@tiers) {
+ if ($prices{$tier->id}
+ && $tier->match($user, $date)) {
+ $price = $prices{$tier->id}->retailPrice;
+ $found_tier = $tier;
+ last;
+ }
+ }
+
+ defined $price or $price = $self->retailPrice;
+
+ return wantarray ? ( $price, $found_tier ) : $price;
+}
+
+sub update_dynamic {
+ my ($self, $cfg) = @_;
+
+ my @tiers = BSE::TB::Products->pricing_tiers;
+ if (@tiers) {
+ $self->set_cached_dynamic(1);
+ return;
+ }
+
+ return $self->SUPER::update_dynamic($cfg);
+}
+
+sub tableClass {
+ return "BSE::TB::Products";
+}
+
+package BSE::CfgProductOption;
+use strict;
+
+sub id { $_[0]{id} }
+
+sub key {$_[0]{id} } # same as id for config options
+
+sub type { "select" }
+
+sub name { $_[0]{name} }
+
+sub values {
+ @{$_[0]{values}}
+}
+
+sub default_value { $_[0]{default} }
+
+package BSE::CfgProductOptionValue;
+use strict;
+
+sub id { $_[0]{id} }
+
+sub value { $_[0]{value} }
+
+1;
--- /dev/null
+package BSE::TB::Products;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table BSE::TB::TagOwners);
+use BSE::TB::Product;
+
+our $VERSION = "1.004";
+
+sub rowClass {
+ return 'BSE::TB::Product';
+}
+
+sub all_visible_children {
+ my ($self, $id) = @_;
+
+ require OtherParents;
+ my @normal_prods = BSE::TB::Products->visible_children($id);
+ my @step_prods = BSE::TB::Products->visible_step_children($id);
+
+ my %order =
+ (
+ ( map { $_->{id} => $_->{displayOrder} } @normal_prods ),
+ ( map
+ {
+ $_->{childId} => $_->{parentDisplayOrder}
+ } OtherParents->getBy(parentId => $id)
+ )
+ );
+
+ my %kids = map { $_->{id} => $_ } @step_prods, @normal_prods;
+
+ return @kids{ sort { $order{$b} <=> $order{$a} } keys %kids };
+}
+
+sub all_visible_product_tags {
+ my ($self, $id) = @_;
+
+ require BSE::TB::Tags;
+ require BSE::TB::TagMembers;
+ return
+ {
+ tags => [ BSE::TB::Tags->getSpecial(allprods => $id, $id) ],
+ members => [ BSE::TB::TagMembers->getSpecial(allprods => $id, $id) ],
+ };
+}
+
+*all_visible_products = \&all_visible_children;
+
+sub visible_children {
+ my ($class, $id) = @_;
+
+ use BSE::Util::SQL qw/now_sqldate/;
+ my $today = now_sqldate();
+
+ return BSE::TB::Products->getSpecial(visible_children_of => $id, $today);
+}
+
+sub visible_step_children {
+ my ($class, $id) = @_;
+
+ use BSE::Util::SQL qw/now_sqldate/;
+ my $today = now_sqldate();
+
+ return BSE::TB::Products->getSpecial(visibleStep => $id, $today);
+}
+
+{
+ my $tiers;
+ sub pricing_tiers {
+ unless ($tiers) {
+ require BSE::TB::PriceTiers;
+ $tiers = [ sort { $a->display_order <=> $b->display_order }
+ BSE::TB::PriceTiers->all ];
+ }
+
+ return @$tiers;
+ }
+}
+
+1;
package BSE::TB::Seminar;
use strict;
# represents a seminar from the database
-use Product;
+use BSE::TB::Product;
use vars qw/@ISA/;
-@ISA = qw/Product/;
+@ISA = qw/BSE::TB::Product/;
use BSE::Util::SQL qw(now_sqldatetime);
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub columns {
return ($_[0]->SUPER::columns(),
}
sub bases {
- return { seminar_id=>{ class=>'Product'} };
+ return { seminar_id=>{ class=>'BSE::TB::Product'} };
}
sub sessions {
use strict;
use Carp qw(confess);
-our $VERSION = "1.020";
+our $VERSION = "1.021";
=head1 NAME
my $today = now_sqldate();
if ($self->{generator} eq 'BSE::Generate::Catalog') {
- require 'Products.pm';
+ require BSE::TB::Products;
- return Products->getSpecial('visibleStep', $self->{id}, $today);
+ return BSE::TB::Products->getSpecial('visibleStep', $self->{id}, $today);
}
else {
return BSE::TB::Articles->getSpecial('visibleStepKids', $self->{id}, $today);
sub all_visible_products {
my ($self) = @_;
- require Products;
- Products->all_visible_children($self->{id});
+ require BSE::TB::Products;
+ BSE::TB::Products->all_visible_children($self->{id});
}
sub all_visible_product_tags {
my ($self) = @_;
- require Products;
- Products->all_visible_product_tags($self->{id});
+ require BSE::TB::Products;
+ BSE::TB::Products->all_visible_product_tags($self->{id});
}
sub all_visible_catalogs {
use vars qw/@ISA/;
@ISA = qw/Squirrel::Row/;
-our $VERSION = "1.000";
+our $VERSION = "1.001";
sub columns {
return qw/subscription_id text_id title description max_lapsed/;
sub dependent_products {
my ($self) = @_;
- require Products;
- Products->getSpecial(subscriptionDependent => $self->{subscription_id},
+ require BSE::TB::Products;
+ BSE::TB::Products->getSpecial(subscriptionDependent => $self->{subscription_id},
$self->{subscription_id});
}
package BSE::UI::AdminShop;
use strict;
use base 'BSE::UI::AdminDispatch';
-use Products;
-use Product;
+use BSE::TB::Products;
+use BSE::TB::Product;
use BSE::TB::Orders;
use BSE::TB::OrderItems;
use BSE::Template;
use BSE::Util::SQL qw/now_sqldate sql_to_date date_to_sql sql_date sql_datetime/;
use BSE::Util::Valid qw/valid_date/;
-our $VERSION = "1.026";
+our $VERSION = "1.027";
my %actions =
(
my $session = $req->session;
use POSIX 'strftime';
- my $products = Products->new;
+ my $products = BSE::TB::Products->new;
my @list;
if ($session->{showstepkids}) {
my @allkids = $catalog->allkids;
$session->{showstepkids} = $cgi->param('showstepkids');
}
exists $session->{showstepkids} or $session->{showstepkids} = 1;
- my $products = Products->new;
+ my $products = BSE::TB::Products->new;
my @products = sort { $b->{displayOrder} <=> $a->{displayOrder} }
$products->getBy(parentid => $shopid);
my $product_index;
my $cgi = $req->cgi;
my $id = $cgi->param('id');
if ($id and
- my $product = Products->getByPkey($id)) {
+ my $product = BSE::TB::Products->getByPkey($id)) {
return product_form($req, $product, '', '', 'admin/product_detail');
}
else {
use OtherParents;
# ugh
my $realproduct;
- $realproduct = UNIVERSAL::isa($product, 'Product') ? $product : Products->getByPkey($product->{id});
+ $realproduct = UNIVERSAL::isa($product, 'BSE::TB::Product') ? $product : BSE::TB::Products->getByPkey($product->{id});
my @stepcats;
@stepcats = OtherParents->getBy(childId=>$product->{id})
if $product->{id};
my $order = BSE::TB::Orders->getByPkey($id)) {
my $message = $req->message($errors);
my @lines = $order->items;
- my @products = map { Products->getByPkey($_->{productId}) } @lines;
+ my @products = map { BSE::TB::Products->getByPkey($_->{productId}) } @lines;
my $line_index = -1;
my $product;
my @options;
use BSE::TB::Orders;
use BSE::TB::OrderItems;
use BSE::Util::Tags qw(tag_error_img tag_hash tag_article);
-use Products;
+use BSE::TB::Products;
use BSE::TB::Seminars;
use DevHelp::Validate qw(dh_validate dh_validate_hash);
use Digest::MD5 'md5_hex';
use BSE::Util::Secure qw(make_secret);
use BSE::Template;
-our $VERSION = "1.045";
+our $VERSION = "1.046";
=head1 NAME
my @cart = @{$req->session->{cart}};
if ($index >= 0 && $index < @cart) {
my ($item) = splice(@cart, $index, 1);
- my $product = Products->getByPkey($item->{productId});
+ my $product = BSE::TB::Products->getByPkey($item->{productId});
$req->flash_notice("msg:bse/shop/cart/remove", [ $product ]);
}
$req->session->{cart} = \@cart;
my $order = BSE::TB::Orders->getByPkey($id)
or return $class->req_cart($req);
my @items = $order->items;
- my @products = map { Products->getByPkey($_->{productId}) } @items;
+ my @products = map { BSE::TB::Products->getByPkey($_->{productId}) } @items;
my @item_cols = BSE::TB::OrderItem->columns;
- my %copy_cols = map { $_ => 1 } Product->columns;
+ my %copy_cols = map { $_ => 1 } BSE::TB::Product->columns;
delete @copy_cols{@item_cols};
my @copy_cols = keys %copy_cols;
my @showitems;
my @cart = @{$req->session->{cart}}
or return;
my @items;
- my @prodcols = Product->columns;
+ my @prodcols = BSE::TB::Product->columns;
my @newcart;
my $today = now_sqldate();
for my $item ($cart->items) {
my $product;
if ($addid) {
$product = BSE::TB::Seminars->getByPkey($addid);
- $product ||= Products->getByPkey($addid);
+ $product ||= BSE::TB::Products->getByPkey($addid);
}
unless ($product) {
$$error = "Cannot find product $addid";
my $product;
if (defined $code) {
$product = BSE::TB::Seminars->getBy(product_code => $code);
- $product ||= Products->getBy(product_code => $code);
+ $product ||= BSE::TB::Products->getBy(product_code => $code);
}
unless ($product) {
$$error = "Cannot find product code $code";
for my $item (@$cart) {
if (!$item->{user} || $item->{user} != $user->id) {
- my $product = Products->getByPkey($item->{productId})
+ my $product = BSE::TB::Products->getByPkey($item->{productId})
or next;
my ($price, $tier) = $product->price(user => $user);
$item->{price} = $price;
use DevHelp::Date qw(dh_strftime_sql_datetime);
use base 'BSE::UI::UserCommon';
-our $VERSION = "1.000";
+our $VERSION = "1.001";
my %actions =
(
'orderfile', 'orderfiles', \$file_index),
product =>
sub {
- require Products;
- $product = Products->getByPkey($items[$item_index]{productId})
+ require BSE::TB::Products;
+ $product = BSE::TB::Products->getByPkey($items[$item_index]{productId})
unless $product && $product->{id} == $items[$item_index]{productId};
return tag_article($product, $cfg, $_[0]);
},
$$rresult = $self->req_userpage($req, "Missing or invalid product id");
return;
}
- require Products;
- my $product = Products->getByPkey($product_id);
+ require BSE::TB::Products;
+ my $product = BSE::TB::Products->getByPkey($product_id);
unless ($product) {
$$rresult = $self->req_userpage($req, "Unknown product id");
return;
use base 'BSE::UI::UserCommon';
use Carp qw(confess);
-our $VERSION = "1.032";
+our $VERSION = "1.033";
use constant MAX_UNACKED_CONF_MSGS => 3;
use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
my @options;
if ($item->{options}) {
# old order
- require Products;
- my $product = Products->getByPkey($item->{productId});
+ require BSE::TB::Products;
+ my $product = BSE::TB::Products->getByPkey($item->{productId});
@options = order_item_opts($req, $item, $product);
}
use BSE::CfgInfo qw(custom_class);
use BSE::Cart;
-our $VERSION = "1.027";
+our $VERSION = "1.028";
=head1 NAME
my $work;
if ($id =~ /^[0-9]+$/) {
- require Products;
- $work = Products->getByPkey($id)
+ require BSE::TB::Products;
+ $work = BSE::TB::Products->getByPkey($id)
or return "** unknown product $id **";
}
else {
=cut
sub tag_ifTieredPricing {
- require Products;
- my @tiers = Products->pricing_tiers;
+ require BSE::TB::Products;
+ my @tiers = BSE::TB::Products->pricing_tiers;
return scalar @tiers;
}
my $total_cost = 0;
my $total_units = 0;
for my $item (@$cart) {
- require Products;
- my $product = Products->getByPkey($item->{productId});
+ require BSE::TB::Products;
+ my $product = BSE::TB::Products->getByPkey($item->{productId});
my $extended = $product->price(user => scalar $self->{req}->siteuser)
* $item->{units};
my $link = $product->link;
use BSE::TB::Site;
use BSE::Util::HTML;
-our $VERSION = "1.020";
+our $VERSION = "1.021";
sub _base_variables {
my ($self, %opts) = @_;
my $products;
sub _products {
unless ($products) {
- require Products;
- $products = _variable_class("Products");
+ require BSE::TB::Products;
+ $products = _variable_class("BSE::TB::Products");
}
return $products;
+++ /dev/null
-package Product;
-use strict;
-# represents a product from the database
-use BSE::TB::Articles;
-use vars qw/@ISA/;
-@ISA = qw/BSE::TB::Article/;
-
-our $VERSION = "1.004";
-
-# subscription_usage values
-use constant SUBUSAGE_START_ONLY => 1;
-use constant SUBUSAGE_RENEW_ONLY => 2;
-use constant SUBUSAGE_EITHER => 3;
-
-sub columns {
- return ($_[0]->SUPER::columns(),
- qw/articleId description leadTime retailPrice wholesalePrice gst options
- subscription_id subscription_period subscription_usage
- subscription_required product_code weight length height width/ );
-}
-
-sub bases {
- return { articleId=>{ class=>'BSE::TB::Article'} };
-}
-
-sub subscription_required {
- my ($self) = @_;
-
- my $id = $self->{subscription_required};
- return if $id == -1;
-
- require BSE::TB::Subscriptions;
- return BSE::TB::Subscriptions->getByPkey($id);
-}
-
-sub subscription {
- my ($self) = @_;
-
- my $id = $self->{subscription_id};
- return if $id == -1;
-
- require BSE::TB::Subscriptions;
- return BSE::TB::Subscriptions->getByPkey($id);
-}
-
-sub is_renew_sub_only {
- my ($self) = @_;
-
- $self->{subscription_usage} == SUBUSAGE_RENEW_ONLY;
-}
-
-sub is_start_sub_only {
- my ($self) = @_;
-
- $self->{subscription_usage} == SUBUSAGE_START_ONLY;
-}
-
-sub _get_cfg_options {
- my ($cfg) = @_;
-
- require BSE::CfgInfo;
- my $avail_options = BSE::CfgInfo::product_options($cfg);
- my @options;
- for my $name (keys %$avail_options) {
- my $rawopt = $avail_options->{$name};
- my %opt =
- (
- id => $name,
- name => $rawopt->{desc},
- default => $rawopt->{default} || '',
- );
- my @values;
- for my $value (@{$rawopt->{values}}) {
- my $label = $rawopt->{labels}{$value} || $value;
- push @values,
- bless
- {
- id => $value,
- value => $label,
- }, "BSE::CfgProductOptionValue";
- }
- $opt{values} = \@values;
- push @options, bless \%opt, "BSE::CfgProductOption";
- }
-
- return @options;
-}
-
-sub _get_prod_options {
- my ($product, $cfg, @values) = @_;
-
- my %all_cfg_opts = map { $_->id => $_ } _get_cfg_options($cfg);
- my @opt_names = split /,/, $product->{options};
-
- my @cfg_opts = map $all_cfg_opts{$_}, @opt_names;
- my @db_opts = grep $_->enabled, $product->db_options;
- my @all_options = ( @cfg_opts, @db_opts );
-
- push @values, '' while @values < @all_options;
-
- my $index = 0;
- my @sem_options;
- for my $opt (@all_options) {
- my @opt_values = $opt->values;
- my %opt_values = map { $_->id => $_->value } @opt_values;
- my $result_opt =
- {
- id => $opt->key,
- name => $opt->key,
- desc => $opt->name,
- value => $values[$index],
- type => $opt->type,
- labels => \%opt_values,
- default => $opt->default_value,
- };
- my $value = $values[$index];
- if (defined $value) {
- $result_opt->{values} = [ map $_->id, @opt_values ],
- $result_opt->{display} = $opt_values{$values[$index]};
- }
- push @sem_options, $result_opt;
- ++$index;
- }
-
- return @sem_options;
-}
-
-sub option_descs {
- my ($self, $cfg, $rvalues) = @_;
-
- $rvalues or $rvalues = [ ];
-
- return $self->_get_prod_options($cfg, @$rvalues);
-}
-
-sub db_options {
- my ($self) = @_;
-
- require BSE::TB::ProductOptions;
- return BSE::TB::ProductOptions->getBy2
- (
- [ product_id => $self->{id} ],
- { order => "display_order" }
- );
-}
-
-sub remove {
- my ($self, $cfg) = @_;
-
- # remove any product options
- for my $opt ($self->db_options) {
- $opt->remove;
- }
-
- # mark any order line items to "anonymize" them
- BSE::DB->run(bseMarkProductOrderItemsAnon => $self->id);
-
- # remove any wishlist items
- BSE::DB->run(bseRemoveProductFromWishlists => $self->id);
-
- # remove any tiered prices
- BSE::DB->run(bseRemoveProductPrices => $self->id);
-
- return $self->SUPER::remove($cfg);
-}
-
-sub has_sale_files {
- my ($self) = @_;
-
- my ($row) = BSE::DB->query(bseProductHasSaleFiles => $self->{id});
-
- return $row->{have_sale_files};
-}
-
-sub prices {
- my ($self) = @_;
-
- require BSE::TB::PriceTierPrices;
- my @prices = BSE::TB::PriceTierPrices->getBy(product_id => $self->id);
-}
-
-=item set_prices($prices)
-
-Set tiered pricing for the product.
-
-I<$prices> is a hashref mapping tier ids to prices in cents.
-
-If a tier doesn't have a price in I<$prices> it's removed from the
-product.
-
-=cut
-
-sub set_prices {
- my ($self, $prices) = @_;
-
- my %current = map { $_->tier_id => $_ } $self->prices;
- for my $tier_id (keys %$prices) {
- my $current = delete $current{$tier_id};
- if ($current) {
- $current->set_retailPrice($prices->{$tier_id});
- $current->save;
- }
- else {
- BSE::TB::PriceTierPrices->make
- (
- tier_id => $tier_id,
- product_id => $self->id,
- retailPrice => $prices->{$tier_id},
- );
- }
- }
-
- # remove any spares
- for my $price (values %current) {
- $price->remove;
- }
-}
-
-=item price(user => $user, date => $sql_date)
-
-=item price(user => $user)
-
-Return the retail price depending on the user and date
-and optionally the tier object (in list context).
-
-If no tier matches then the undef is returned at the tier object.
-
-=cut
-
-sub price {
- my ($self, %opts) = @_;
-
- my $user = delete $opts{user};
- my $date = delete $opts{date} || BSE::Util::SQL::now_sqldate();
- my @tiers = Products->pricing_tiers;
- my %prices = map { $_->tier_id => $_ } $self->prices;
-
- my $price;
- my $found_tier;
- for my $tier (@tiers) {
- if ($prices{$tier->id}
- && $tier->match($user, $date)) {
- $price = $prices{$tier->id}->retailPrice;
- $found_tier = $tier;
- last;
- }
- }
-
- defined $price or $price = $self->retailPrice;
-
- return wantarray ? ( $price, $found_tier ) : $price;
-}
-
-sub update_dynamic {
- my ($self, $cfg) = @_;
-
- my @tiers = Products->pricing_tiers;
- if (@tiers) {
- $self->set_cached_dynamic(1);
- return;
- }
-
- return $self->SUPER::update_dynamic($cfg);
-}
-
-sub tableClass {
- return "Products";
-}
-
-package BSE::CfgProductOption;
-use strict;
-
-sub id { $_[0]{id} }
-
-sub key {$_[0]{id} } # same as id for config options
-
-sub type { "select" }
-
-sub name { $_[0]{name} }
-
-sub values {
- @{$_[0]{values}}
-}
-
-sub default_value { $_[0]{default} }
-
-package BSE::CfgProductOptionValue;
-use strict;
-
-sub id { $_[0]{id} }
-
-sub value { $_[0]{value} }
-
-1;
+++ /dev/null
-package Products;
-use strict;
-use Squirrel::Table;
-use vars qw(@ISA $VERSION);
-@ISA = qw(Squirrel::Table BSE::TB::TagOwners);
-use Product;
-
-our $VERSION = "1.003";
-
-sub rowClass {
- return 'Product';
-}
-
-sub all_visible_children {
- my ($self, $id) = @_;
-
- require OtherParents;
- my @normal_prods = Products->visible_children($id);
- my @step_prods = Products->visible_step_children($id);
-
- my %order =
- (
- ( map { $_->{id} => $_->{displayOrder} } @normal_prods ),
- ( map
- {
- $_->{childId} => $_->{parentDisplayOrder}
- } OtherParents->getBy(parentId => $id)
- )
- );
-
- my %kids = map { $_->{id} => $_ } @step_prods, @normal_prods;
-
- return @kids{ sort { $order{$b} <=> $order{$a} } keys %kids };
-}
-
-sub all_visible_product_tags {
- my ($self, $id) = @_;
-
- require BSE::TB::Tags;
- require BSE::TB::TagMembers;
- return
- {
- tags => [ BSE::TB::Tags->getSpecial(allprods => $id, $id) ],
- members => [ BSE::TB::TagMembers->getSpecial(allprods => $id, $id) ],
- };
-}
-
-*all_visible_products = \&all_visible_children;
-
-sub visible_children {
- my ($class, $id) = @_;
-
- use BSE::Util::SQL qw/now_sqldate/;
- my $today = now_sqldate();
-
- return Products->getSpecial(visible_children_of => $id, $today);
-}
-
-sub visible_step_children {
- my ($class, $id) = @_;
-
- use BSE::Util::SQL qw/now_sqldate/;
- my $today = now_sqldate();
-
- return Products->getSpecial(visibleStep => $id, $today);
-}
-
-{
- my $tiers;
- sub pricing_tiers {
- unless ($tiers) {
- require BSE::TB::PriceTiers;
- $tiers = [ sort { $a->display_order <=> $b->display_order }
- BSE::TB::PriceTiers->all ];
- }
-
- return @$tiers;
- }
-}
-
-1;
=cut
-our $VERSION = "1.014";
+our $VERSION = "1.015";
use constant MAX_UNACKED_CONF_MSGS => 3;
use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
sub wishlist {
my $self = shift;
- require Products;
- return Products->getSpecial(userWishlist => $self->{id});
+ require BSE::TB::Products;
+ return BSE::TB::Products->getSpecial(userWishlist => $self->{id});
}
sub wishlist_order {
<h2>Product options</h2>
<:if UserCan bse_edit_prodopt_move:article:>
<div id="prodoptmenu">All options:
-<a id="sortoptions" href="<:script:>?a_option_reorder=1&_t=prodopts&id=<:article id:>&_csrfp=<:csrfp admin_move_option:>&option_ids=<:arithmetic join ",", map $_->{id}, sort { lc $a->{name} cmp lc $b->{name} } Products->getByPkey([article id])->db_options:>">Sort</a>
-<a id="reverseoptions" href="<:script:>?a_option_reorder=1&_t=prodopts&id=<:article id:>&_csrfp=<:csrfp admin_move_option:>&option_ids=<:arithmetic join ",", map $_->{id}, reverse Products->getByPkey([article id])->db_options:>">Reverse</a>
+<a id="sortoptions" href="<:script:>?a_option_reorder=1&_t=prodopts&id=<:article id:>&_csrfp=<:csrfp admin_move_option:>&option_ids=<:arithmetic join ",", map $_->{id}, sort { lc $a->{name} cmp lc $b->{name} } BSE::TB::Products->getByPkey([article id])->db_options:>">Sort</a>
+<a id="reverseoptions" href="<:script:>?a_option_reorder=1&_t=prodopts&id=<:article id:>&_csrfp=<:csrfp admin_move_option:>&option_ids=<:arithmetic join ",", map $_->{id}, reverse BSE::TB::Products->getByPkey([article id])->db_options:>">Reverse</a>
<img src="/images/admin/busy.gif" id="busy_img" style="visibility: hidden" alt="busy" />
</div>
<:or UserCan:><:eif UserCan:>
use FindBin;
use lib "$FindBin::Bin/../cgi-bin/modules";
use BSE::Cfg;
-use Products;
+use BSE::TB::Products;
chdir "$FindBin::Bin/../cgi-bin"
or warn "Could not change to cgi-bin directory: $!\n";
-my @products = Products->all;
+my @products = BSE::TB::Products->all;
for my $product (@products) {
if ($product->{body} =~ s/\bpcode:\s*(\S+)//) {
$product->{product_code} = $1;
use lib "$FindBin::Bin/../cgi-bin/modules";
use BSE::API qw(bse_init bse_cfg);
use BSE::TB::Orders;
-use Products;
+use BSE::TB::Products;
bse_init("../cgi-bin");
for my $order (@orders) {
my @items = $order->items;
for my $item (@items) {
- $products{$item->{productId}} = Products->getByPkey($item->{productId});
+ $products{$item->{productId}} = BSE::TB::Products->getByPkey($item->{productId});
my $product = $products{$item->{productId}};
unless ($product) {
print STDERR "Product $item->{productId} not found for order $order->{id}\n";
#ok(chdir $cgidir, "switch to CGI directory");
# create some articles to test with
use BSE::TB::Articles;
-use Products;
+use BSE::TB::Products;
use BSE::API qw/bse_cfg bse_init bse_make_catalog bse_make_product bse_add_step_child/;
bse_init($cgidir);
my $cfg = BSE::Cfg->new;
# create some articles to test with
require BSE::TB::Articles;
-require Products;
+require BSE::TB::Products;
require BSE::TB::ProductOptions;
require BSE::TB::ProductOptionValues;
require BSE::API;
site/cgi-bin/modules/BSE/TB/Order.pm =item without previous =over 1
site/cgi-bin/modules/BSE/TB/Orders.pm =item without previous =over 1
site/cgi-bin/modules/BSE/TB/PriceTier.pm =item without previous =over 1
+site/cgi-bin/modules/BSE/TB/Product.pm =item without previous =over 1
site/cgi-bin/modules/BSE/TB/Tags.pm =item without previous =over 1
site/cgi-bin/modules/BSE/UI/AdminImageClean.pm No argument for =item 2
site/cgi-bin/modules/BSE/UI/AdminModules.pm =item without previous =over 1
site/cgi-bin/modules/DevHelp/Validate.pm multiple occurrence of link target 'required' 1
site/cgi-bin/modules/DevHelp/Validate.pm multiple occurrence of link target 'rules' 1
site/cgi-bin/modules/DevHelp/Validate.pm multiple occurrence of link target 'time' 1
-site/cgi-bin/modules/Product.pm =item without previous =over 1
site/cgi-bin/modules/Squirrel/GPG.pm Verbatim paragraph in NAME section 1
site/cgi-bin/modules/Squirrel/PGP5.pm Verbatim paragraph in NAME section 1
site/cgi-bin/modules/Squirrel/PGP6.pm Verbatim paragraph in NAME section 1
projects / bse.git / commitdiff