988f03a4dbe23ce0ff90a00a3a39eba5ddbd9234
[bse.git] / site / cgi-bin / modules / BSE / TB / Product.pm
1 package BSE::TB::Product;
2 use strict;
3 # represents a product from the database
4 use BSE::TB::Articles;
5 use vars qw/@ISA/;
6 @ISA = qw/BSE::TB::Article/;
7
8 our $VERSION = "1.005";
9
10 # subscription_usage values
11 use constant SUBUSAGE_START_ONLY => 1;
12 use constant SUBUSAGE_RENEW_ONLY => 2;
13 use constant SUBUSAGE_EITHER => 3;
14
15 sub columns {
16   return ($_[0]->SUPER::columns(), 
17           qw/articleId description leadTime retailPrice wholesalePrice gst options
18              subscription_id subscription_period subscription_usage
19              subscription_required product_code weight length height width/ );
20 }
21
22 sub bases {
23   return { articleId=>{ class=>'BSE::TB::Article'} };
24 }
25
26 sub subscription_required {
27   my ($self) = @_;
28
29   my $id = $self->{subscription_required};
30   return if $id == -1;
31
32   require BSE::TB::Subscriptions;
33   return BSE::TB::Subscriptions->getByPkey($id);
34 }
35
36 sub subscription {
37   my ($self) = @_;
38
39   my $id = $self->{subscription_id};
40   return if $id == -1;
41
42   require BSE::TB::Subscriptions;
43   return BSE::TB::Subscriptions->getByPkey($id);
44 }
45
46 sub is_renew_sub_only {
47   my ($self) = @_;
48
49   $self->{subscription_usage} == SUBUSAGE_RENEW_ONLY;
50 }
51
52 sub is_start_sub_only {
53   my ($self) = @_;
54
55   $self->{subscription_usage} == SUBUSAGE_START_ONLY;
56 }
57
58 sub _get_cfg_options {
59   my ($cfg) = @_;
60
61   require BSE::CfgInfo;
62   my $avail_options = BSE::CfgInfo::product_options($cfg);
63   my @options;
64   for my $name (keys %$avail_options) {
65     my $rawopt = $avail_options->{$name};
66     my %opt =
67       (
68        id => $name,
69        name => $rawopt->{desc},
70        default => $rawopt->{default} || '',
71       );
72     my @values;
73     for my $value (@{$rawopt->{values}}) {
74       my $label = $rawopt->{labels}{$value} || $value;
75       push @values,
76         bless
77           {
78            id => $value,
79            value => $label,
80           }, "BSE::CfgProductOptionValue";
81     }
82     $opt{values} = \@values;
83     push @options, bless \%opt, "BSE::CfgProductOption";
84   }
85
86   return @options;
87 }
88
89 sub _get_prod_options {
90   my ($product, $cfg, @values) = @_;
91
92   my %all_cfg_opts = map { $_->id => $_ } _get_cfg_options($cfg);
93   my @opt_names = split /,/, $product->{options};
94
95   my @cfg_opts = map $all_cfg_opts{$_}, @opt_names;
96   my @db_opts = grep $_->enabled, $product->db_options;
97   my @all_options = ( @cfg_opts, @db_opts );
98
99   push @values, '' while @values < @all_options;
100
101   my $index = 0;
102   my @sem_options;
103   for my $opt (@all_options) {
104     my @opt_values = $opt->values;
105     my %opt_values = map { $_->id => $_->value } @opt_values;
106     my $result_opt = 
107       {
108        id => $opt->key,
109        name => $opt->key,
110        desc => $opt->name,
111        value => $values[$index],
112        type => $opt->type,
113        labels => \%opt_values,
114        default => $opt->default_value,
115       };
116     my $value = $values[$index];
117     if (defined $value) {
118       $result_opt->{values} = [ map $_->id, @opt_values ],
119       $result_opt->{display} = $opt_values{$values[$index]};
120     }
121     push @sem_options, $result_opt;
122     ++$index;
123   }
124
125   return @sem_options;
126 }
127
128 sub option_descs {
129   my ($self, $cfg, $rvalues) = @_;
130
131   $rvalues or $rvalues = [ ];
132
133   return $self->_get_prod_options($cfg, @$rvalues);
134 }
135
136 sub db_options {
137   my ($self) = @_;
138
139   require BSE::TB::ProductOptions;
140   return BSE::TB::ProductOptions->getBy2
141     (
142      [ product_id => $self->{id} ],
143      { order => "display_order" }
144     );
145 }
146
147 sub remove {
148   my ($self, $cfg) = @_;
149
150   # remove any product options
151   for my $opt ($self->db_options) {
152     $opt->remove;
153   }
154
155   # mark any order line items to "anonymize" them
156   BSE::DB->run(bseMarkProductOrderItemsAnon => $self->id);
157
158   # remove any wishlist items
159   BSE::DB->run(bseRemoveProductFromWishlists => $self->id);
160
161   # remove any tiered prices
162   BSE::DB->run(bseRemoveProductPrices => $self->id);
163
164   return $self->SUPER::remove($cfg);
165 }
166
167 sub has_sale_files {
168   my ($self) = @_;
169
170   my ($row) = BSE::DB->query(bseProductHasSaleFiles => $self->{id});
171
172   return $row->{have_sale_files};
173 }
174
175 sub prices {
176   my ($self) = @_;
177
178   require BSE::TB::PriceTierPrices;
179   my @prices = BSE::TB::PriceTierPrices->getBy(product_id => $self->id);
180 }
181
182 =item set_prices($prices)
183
184 Set tiered pricing for the product.
185
186 I<$prices> is a hashref mapping tier ids to prices in cents.
187
188 If a tier doesn't have a price in I<$prices> it's removed from the
189 product.
190
191 =cut
192
193 sub set_prices {
194   my ($self, $prices) = @_;
195
196   my %current = map { $_->tier_id => $_ } $self->prices;
197   for my $tier_id (keys %$prices) {
198     my $current = delete $current{$tier_id};
199     if ($current) {
200       $current->set_retailPrice($prices->{$tier_id});
201       $current->save;
202     }
203     else {
204       BSE::TB::PriceTierPrices->make
205           (
206            tier_id => $tier_id,
207            product_id => $self->id,
208            retailPrice => $prices->{$tier_id},
209           );
210     }
211   }
212
213   # remove any spares
214   for my $price (values %current) {
215     $price->remove;
216   }
217 }
218
219 =item price(user => $user, date => $sql_date)
220
221 =item price(user => $user)
222
223 Return the retail price depending on the user and date
224 and optionally the tier object (in list context).
225
226 If no tier matches then the undef is returned at the tier object.
227
228 =cut
229
230 sub price {
231   my ($self, %opts) = @_;
232
233   my $user = delete $opts{user};
234   my $date = delete $opts{date} || BSE::Util::SQL::now_sqldate();
235   my @tiers = BSE::TB::Products->pricing_tiers;
236   my %prices = map { $_->tier_id => $_ } $self->prices;
237
238   my $price;
239   my $found_tier;
240   for my $tier (@tiers) {
241     if ($prices{$tier->id}
242         && $tier->match($user, $date)) {
243       $price = $prices{$tier->id}->retailPrice;
244       $found_tier = $tier;
245       last;
246     }
247   }
248
249   defined $price or $price = $self->retailPrice;
250
251   return wantarray ? ( $price, $found_tier ) : $price;
252 }
253
254 sub update_dynamic {
255   my ($self, $cfg) = @_;
256
257   my @tiers = BSE::TB::Products->pricing_tiers;
258   if (@tiers) {
259     $self->set_cached_dynamic(1);
260     return;
261   }
262
263   return $self->SUPER::update_dynamic($cfg);
264 }
265
266 sub tableClass {
267   return "BSE::TB::Products";
268 }
269
270 package BSE::CfgProductOption;
271 use strict;
272
273 sub id { $_[0]{id} }
274
275 sub key {$_[0]{id} } # same as id for config options
276
277 sub type { "select" }
278
279 sub name { $_[0]{name} }
280
281 sub values {
282   @{$_[0]{values}}
283 }
284
285 sub default_value { $_[0]{default} }
286
287 package BSE::CfgProductOptionValue;
288 use strict;
289
290 sub id { $_[0]{id} }
291
292 sub value { $_[0]{value} }
293
294 1;