improve compatibility between template method I/F and data_only
[bse.git] / site / cgi-bin / modules / BSE / TB / Product.pm
CommitLineData
10dd37f9 1package BSE::TB::Product;
15fb10f2 2use strict;
41b9d8ec 3# represents a product from the database
e0ed81d7 4use BSE::TB::Articles;
41b9d8ec 5use vars qw/@ISA/;
e0ed81d7 6@ISA = qw/BSE::TB::Article/;
41b9d8ec 7
2bd7f190 8our $VERSION = "1.007";
cb7fd78d 9
af74f0b4
TC
10# subscription_usage values
11use constant SUBUSAGE_START_ONLY => 1;
12use constant SUBUSAGE_RENEW_ONLY => 2;
13use constant SUBUSAGE_EITHER => 3;
14
41b9d8ec
TC
15sub columns {
16 return ($_[0]->SUPER::columns(),
74b21f6d 17 qw/articleId description leadTime retailPrice wholesalePrice gst options
0ec4ac8a 18 subscription_id subscription_period subscription_usage
306eb97a 19 subscription_required product_code weight length height width/ );
41b9d8ec
TC
20}
21
22sub bases {
e0ed81d7 23 return { articleId=>{ class=>'BSE::TB::Article'} };
41b9d8ec
TC
24}
25
0ec4ac8a
TC
26sub 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
4175638b
TC
36sub 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
af74f0b4
TC
46sub is_renew_sub_only {
47 my ($self) = @_;
48
49 $self->{subscription_usage} == SUBUSAGE_RENEW_ONLY;
50}
51
52sub is_start_sub_only {
53 my ($self) = @_;
54
55 $self->{subscription_usage} == SUBUSAGE_START_ONLY;
56}
57
58baa27b
TC
58sub _get_cfg_options {
59 my ($cfg) = @_;
0eb78304
TC
60
61 require BSE::CfgInfo;
62 my $avail_options = BSE::CfgInfo::product_options($cfg);
58baa27b
TC
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
89sub _get_prod_options {
90 my ($product, $cfg, @values) = @_;
91
92 my %all_cfg_opts = map { $_->id => $_ } _get_cfg_options($cfg);
0eb78304 93 my @opt_names = split /,/, $product->{options};
58baa27b
TC
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;
84e29d01 106 my %opt_valueobjs = map { $_->id => $_ } @opt_values;
58baa27b
TC
107 my $result_opt =
108 {
109 id => $opt->key,
110 name => $opt->key,
111 desc => $opt->name,
112 value => $values[$index],
84e29d01 113 valueobj => $opt_valueobjs{$values[$index]},
58baa27b
TC
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;
0eb78304
TC
125 }
126
127 return @sem_options;
128}
129
130sub option_descs {
131 my ($self, $cfg, $rvalues) = @_;
132
133 $rvalues or $rvalues = [ ];
134
135 return $self->_get_prod_options($cfg, @$rvalues);
136}
137
58baa27b
TC
138sub db_options {
139 my ($self) = @_;
140
141 require BSE::TB::ProductOptions;
66371e15
TC
142 return BSE::TB::ProductOptions->getBy2
143 (
144 [ product_id => $self->{id} ],
145 { order => "display_order" }
146 );
58baa27b
TC
147}
148
726ffaed
TC
149sub 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
dfd483db
TC
163 # remove any tiered prices
164 BSE::DB->run(bseRemoveProductPrices => $self->id);
165
726ffaed
TC
166 return $self->SUPER::remove($cfg);
167}
168
1d383001
TC
169sub 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
dfd483db
TC
177sub 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
186Set tiered pricing for the product.
187
188I<$prices> is a hashref mapping tier ids to prices in cents.
189
190If a tier doesn't have a price in I<$prices> it's removed from the
191product.
192
193=cut
194
195sub 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
225Return the retail price depending on the user and date
226and optionally the tier object (in list context).
227
228If no tier matches then the undef is returned at the tier object.
229
230=cut
231
232sub price {
233 my ($self, %opts) = @_;
234
235 my $user = delete $opts{user};
236 my $date = delete $opts{date} || BSE::Util::SQL::now_sqldate();
10dd37f9 237 my @tiers = BSE::TB::Products->pricing_tiers;
dfd483db
TC
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
256sub update_dynamic {
257 my ($self, $cfg) = @_;
258
10dd37f9 259 my @tiers = BSE::TB::Products->pricing_tiers;
dfd483db
TC
260 if (@tiers) {
261 $self->set_cached_dynamic(1);
262 return;
263 }
264
265 return $self->SUPER::update_dynamic($cfg);
266}
267
b6a28bd1 268sub tableClass {
10dd37f9 269 return "BSE::TB::Products";
b6a28bd1
TC
270}
271
58baa27b
TC
272package BSE::CfgProductOption;
273use strict;
274
275sub id { $_[0]{id} }
276
277sub key {$_[0]{id} } # same as id for config options
278
279sub type { "select" }
280
281sub name { $_[0]{name} }
282
283sub values {
284 @{$_[0]{values}}
285}
286
287sub default_value { $_[0]{default} }
288
289package BSE::CfgProductOptionValue;
290use strict;
291
292sub id { $_[0]{id} }
293
294sub value { $_[0]{value} }
295
33d04a1b
TC
296sub get_custom { undef }
297
2bd7f190
TC
298sub get_custom_all { +{} }
299
41b9d8ec 3001;