improve compatibility between template method I/F and data_only
[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.007";
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 %opt_valueobjs = map { $_->id => $_ } @opt_values;
107     my $result_opt = 
108       {
109        id => $opt->key,
110        name => $opt->key,
111        desc => $opt->name,
112        value => $values[$index],
113        valueobj => $opt_valueobjs{$values[$index]},
114        type => $opt->type,
115        labels => \%opt_values,
116        default => $opt->default_value,
117       };
118     my $value = $values[$index];
119     if (defined $value) {
120       $result_opt->{values} = [ map $_->id, @opt_values ],
121       $result_opt->{display} = $opt_values{$values[$index]};
122     }
123     push @sem_options, $result_opt;
124     ++$index;
125   }
126
127   return @sem_options;
128 }
129
130 sub option_descs {
131   my ($self, $cfg, $rvalues) = @_;
132
133   $rvalues or $rvalues = [ ];
134
135   return $self->_get_prod_options($cfg, @$rvalues);
136 }
137
138 sub db_options {
139   my ($self) = @_;
140
141   require BSE::TB::ProductOptions;
142   return BSE::TB::ProductOptions->getBy2
143     (
144      [ product_id => $self->{id} ],
145      { order => "display_order" }
146     );
147 }
148
149 sub remove {
150   my ($self, $cfg) = @_;
151
152   # remove any product options
153   for my $opt ($self->db_options) {
154     $opt->remove;
155   }
156
157   # mark any order line items to "anonymize" them
158   BSE::DB->run(bseMarkProductOrderItemsAnon => $self->id);
159
160   # remove any wishlist items
161   BSE::DB->run(bseRemoveProductFromWishlists => $self->id);
162
163   # remove any tiered prices
164   BSE::DB->run(bseRemoveProductPrices => $self->id);
165
166   return $self->SUPER::remove($cfg);
167 }
168
169 sub has_sale_files {
170   my ($self) = @_;
171
172   my ($row) = BSE::DB->query(bseProductHasSaleFiles => $self->{id});
173
174   return $row->{have_sale_files};
175 }
176
177 sub prices {
178   my ($self) = @_;
179
180   require BSE::TB::PriceTierPrices;
181   my @prices = BSE::TB::PriceTierPrices->getBy(product_id => $self->id);
182 }
183
184 =item set_prices($prices)
185
186 Set tiered pricing for the product.
187
188 I<$prices> is a hashref mapping tier ids to prices in cents.
189
190 If a tier doesn't have a price in I<$prices> it's removed from the
191 product.
192
193 =cut
194
195 sub set_prices {
196   my ($self, $prices) = @_;
197
198   my %current = map { $_->tier_id => $_ } $self->prices;
199   for my $tier_id (keys %$prices) {
200     my $current = delete $current{$tier_id};
201     if ($current) {
202       $current->set_retailPrice($prices->{$tier_id});
203       $current->save;
204     }
205     else {
206       BSE::TB::PriceTierPrices->make
207           (
208            tier_id => $tier_id,
209            product_id => $self->id,
210            retailPrice => $prices->{$tier_id},
211           );
212     }
213   }
214
215   # remove any spares
216   for my $price (values %current) {
217     $price->remove;
218   }
219 }
220
221 =item price(user => $user, date => $sql_date)
222
223 =item price(user => $user)
224
225 Return the retail price depending on the user and date
226 and optionally the tier object (in list context).
227
228 If no tier matches then the undef is returned at the tier object.
229
230 =cut
231
232 sub price {
233   my ($self, %opts) = @_;
234
235   my $user = delete $opts{user};
236   my $date = delete $opts{date} || BSE::Util::SQL::now_sqldate();
237   my @tiers = BSE::TB::Products->pricing_tiers;
238   my %prices = map { $_->tier_id => $_ } $self->prices;
239
240   my $price;
241   my $found_tier;
242   for my $tier (@tiers) {
243     if ($prices{$tier->id}
244         && $tier->match($user, $date)) {
245       $price = $prices{$tier->id}->retailPrice;
246       $found_tier = $tier;
247       last;
248     }
249   }
250
251   defined $price or $price = $self->retailPrice;
252
253   return wantarray ? ( $price, $found_tier ) : $price;
254 }
255
256 sub update_dynamic {
257   my ($self, $cfg) = @_;
258
259   my @tiers = BSE::TB::Products->pricing_tiers;
260   if (@tiers) {
261     $self->set_cached_dynamic(1);
262     return;
263   }
264
265   return $self->SUPER::update_dynamic($cfg);
266 }
267
268 sub tableClass {
269   return "BSE::TB::Products";
270 }
271
272 package BSE::CfgProductOption;
273 use strict;
274
275 sub id { $_[0]{id} }
276
277 sub key {$_[0]{id} } # same as id for config options
278
279 sub type { "select" }
280
281 sub name { $_[0]{name} }
282
283 sub values {
284   @{$_[0]{values}}
285 }
286
287 sub default_value { $_[0]{default} }
288
289 package BSE::CfgProductOptionValue;
290 use strict;
291
292 sub id { $_[0]{id} }
293
294 sub value { $_[0]{value} }
295
296 sub get_custom { undef }
297
298 sub get_custom_all { +{} }
299
300 1;