move a lot of cart logic to the cart object
[bse.git] / site / cgi-bin / modules / BSE / Cart.pm
CommitLineData
11af7272
TC
1package BSE::Cart;
2use strict;
3use Scalar::Util;
4
676f5398 5our $VERSION = "1.003";
11af7272
TC
6
7=head1 NAME
8
9BSE::Cart - abstraction for the BSE cart.
10
11=head1 SYNOPSIS
12
13 use BSE::Cart;
8757d2fb 14 my $cart = BSE::Cart->new($req, $stage);
11af7272
TC
15
16 my $items = $cart->items;
17 my $products = $cart->products;
18
19=head1 DESCRIPTION
20
21This class provides a simple abstraction for access to the BSE
22shopping cart.
23
24This is intended for use in templates, but may be expanded further.
25
26=head1 METHODS
27
28=over
29
30=item new()
31
32Create a new cart object based on the session.
33
34=cut
35
36sub new {
8757d2fb 37 my ($class, $req, $stage) = @_;
11af7272
TC
38
39 my $self = bless
40 {
41 products => {},
42 req => $req,
8757d2fb 43 stage => $stage,
676f5398 44 shipping => 0,
11af7272
TC
45 }, $class;
46 Scalar::Util::weaken($self->{req});
47 my $items = $req->session->{cart} || [];
48 my $myself = $self;
49 Scalar::Util::weaken($myself);
50 my $index = 0;
8757d2fb 51 $self->{items} = [ map BSE::Cart::Item->new($_, $index++, $self), @$items ];
11af7272 52
676f5398
TC
53 if ($stage eq 'cart' || $stage eq 'checkout') {
54 $self->_enter_cart;
55 }
56
11af7272
TC
57 return $self;
58}
59
676f5398
TC
60sub _enter_cart {
61 my ($self) = @_;
62
63 my $req = $self->{req};
64 require BSE::CfgInfo;
65
66 $req->session->{custom} ||= {};
67 my %custom_state = %{$req->session->{custom}};
68
69 $self->{custom_state} = \%custom_state;
70
71 my $cust_class = BSE::CfgInfo::custom_class($self->{req}->cfg);
72 $cust_class->enter_cart($self->items, $self->products,
73 \%custom_state, $req->cfg);
74}
75
11af7272
TC
76=item items()
77
78Return an array reference of cart items.
79
80=cut
81
82sub items {
676f5398 83 return wantarray ? @{$_[0]{items}} : $_[0]{items};
11af7272
TC
84}
85
86=item products().
87
88Return an array reference of products in the cart, corresponding to
89the array reference returned by items().
90
91=cut
92
93sub products {
94 my $self = shift;
676f5398
TC
95
96 my @products = map $self->_product($_->{productId}), @{$self->items};
97
98 return wantarray ? @products : \@products;
11af7272
TC
99}
100
101=item total_cost
102
103Return the total cost of the items in the cart.
104
105=cut
106
107sub total_cost {
108 my ($self) = @_;
109
110 my $total_cost = 0;
111 for my $item (@{$self->items}) {
676f5398 112 $total_cost += $item->extended_retailPrice;
11af7272
TC
113 }
114
115 return $total_cost;
116}
117
676f5398
TC
118=item set_shipping_cost()
119
120Set the cost of shipping.
121
122Called by the shop.
123
124=cut
125
126sub set_shipping_cost {
127 my ($self, $cost) = @_;
128
129 $self->{shipping} = $cost;
130}
131
132=item shipping_cost()
133
134Fetch the cost of shipping.
135
136=cut
137
138sub shipping_cost {
139 my ($self) = @_;
140
141 return $self->{shipping};
142}
143
11af7272
TC
144=item total_units
145
146Return the total number of units in the cart.
147
148=cut
149
150sub total_units {
151 my ($self) = @_;
152
153 my $total_units = 0;
154 for my $item (@{$self->items}) {
155 $total_units += $item->{units};
156 }
157
158 return $total_units;
159}
160
161=item total
162
676f5398
TC
163Total of items in the cart and shipping costs.
164
165This doesn't handle custom costs yet.
11af7272
TC
166
167=cut
168
8757d2fb
TC
169sub total {
170 my ($self) = @_;
11af7272 171
676f5398
TC
172 return $self->total_cost() + $self->shipping_cost();
173}
174
175=item have_sales_files
176
177Return true if the cart contains products with files that are for
178sale.
179
180=cut
181
182sub have_sales_files {
183 my ($self) = @_;
184
185 unless (defined $self->{have_sales_files}) {
186 $self->{have_sales_files} = 0;
187 PRODUCTS:
188 for my $prod (@{$self->products}) {
189 if ($prod->has_sales_files) {
190 $self->{have_sales_files} = 1;
191 last PRODUCTS;
192 }
193 }
194 }
195
196 return $self->{have_sales_files};
197}
198
199=item need_logon
200
201Return true if the cart contains items that the user needs to be
202logged on to purchase, or if the current user isn't qualified to
203purchase the item.
204
205Call need_logon_message() to get the reason for this method returning
206false.
207
208=cut
209
210sub need_logon {
211 my ($self) = @_;
212
213 unless (exists $self->{need_logon}) {
214 $self->{need_logon} = $self->_need_logon;
215 }
216
217 $self->{need_logon} or return;
218
219 return 1;
220}
221
222=head1 need_logon_message
223
224Returns a list with the error message and message id of the reason the
225user needs to logon for this cart.
226
227=cut
228
229sub need_logon_message {
230 my ($self) = @_;
231
232 unless (exists $self->{need_logon}) {
233 $self->{need_logon} = $self->_need_logon;
234 }
235
236 return @{$self->{logon_reason}};
237}
238
239=item custom_state
240
241State managed by a custom class.
242
243=cut
244
245sub custom_state {
246 my ($self) = @_;
247
248 $self->{custom_state};
249}
250
251=item affiliate_code
252
253Return the stored affiliate code.
254
255=cut
256
257sub affiliate_code {
258 my ($self) = @_;
259
260 my $code = $self->{req}->session->{affiliate_code};
261 defined $code or $code = '';
262
263 return $code;
264}
265
266=item any_physcial_products
267
268Returns true if the cart contains any physical products, ie. needs
269shipping.
270
271=cut
272
273sub any_physical_products {
274 my ($self) = @_;
275
276 for my $prod (@{$self->products}) {
277 if ($prod->weight) {
278 return 1;
279 last;
280 }
281 }
282
283 return 0;
284}
285
286
287=item _need_logon
288
289Internal implementation of need_logon.
290
291=cut
292
293sub _need_logon {
294 my ($self) = @_;
295
296 my $cfg = $self->{req}->cfg;
297
298 $self->{logon_reason} = [];
299
300 my $reg_if_files = $cfg->entryBool('shop', 'register_if_files', 1);
301
302 my $user = $self->{req}->siteuser;
303
304 if (!$user && $reg_if_files) {
305 require BSE::TB::ArticleFiles;
306 # scan to see if any of the products have files
307 # requires a subscription or subscribes
308 for my $prod (@{$self->products}) {
309 my @files = $prod->files;
310 if (grep $_->forSale, @files) {
311 $self->{logon_reason} =
312 [ "register before checkout", "shop/fileitems" ];
313 return;
314 }
315 if ($prod->{subscription_id} != -1) {
316 $self->{logon_reason} =
317 [ "you must be logged in to purchase a subscription", "shop/buysub" ];
318 return;
319 }
320 if ($prod->{subscription_required} != -1) {
321 $self->{logon_reason} =
322 [ "must be logged in to purchase a product requiring a subscription", "shop/subrequired" ];
323 return;
324 }
325 }
326 }
327
328 my $require_logon = $cfg->entryBool('shop', 'require_logon', 0);
329 if (!$user && $require_logon) {
330 $self->{logon_reason} =
331 [ "register before checkout", "shop/logonrequired" ];
332 return;
333 }
334
335 # check the user has the right required subs
336 # and that they qualify to subscribe for limited subscription products
337 if ($user) {
338 for my $prod (@{$self->products}) {
339 my $sub = $prod->subscription_required;
340 if ($sub && !$user->subscribed_to($sub)) {
341 $self->{logon_reason} =
342 [ "you must be subscribed to $sub->{title} to purchase one of these products", "shop/subrequired" ];
343 return;
344 }
345
346 $sub = $prod->subscription;
347 if ($sub && $prod->is_renew_sub_only) {
348 unless ($user->subscribed_to_grace($sub)) {
349 $self->{logon_reason} =
350 [ "you must be subscribed to $sub->{title} to use this renew only product", "sub/renewsubonly" ];
351 return;
352 }
353 }
354 if ($sub && $prod->is_start_sub_only) {
355 if ($user->subscribed_to_grace($sub)) {
356 $self->{logon_reason} =
357 [ "you must not be subscribed to $sub->{title} already to use this new subscription only product", "sub/newsubonly" ];
358 return;
359 }
360 }
361 }
362 }
363
364 return;
8757d2fb 365}
11af7272
TC
366
367sub _product {
368 my ($self, $id) = @_;
369
370 my $product = $self->{products}{$id};
371 unless ($product) {
372 require Products;
373 $product = Products->getByPkey($id)
374 or die "No product $id\n";
375 # FIXME
376 if ($product->generator ne "Generate::Product") {
377 require BSE::TB::Seminars;
378 $product = BSE::TB::Seminars->getByPkey($id)
379 or die "Not a product, not a seminar $id\n";
380 }
381
382 $self->{products}{$id} = $product;
383 }
384 return $product;
8757d2fb
TC
385}
386
387sub _session {
388 my ($self, $id) = @_;
389 my $session = $self->{sessions}{$id};
390 unless ($session) {
391 require BSE::TB::SeminarSessions;
392 $session = BSE::TB::SeminarSessions->getByPkey($id);
393 $self->{sessions}{$id} = $session;
394 }
11af7272 395
8757d2fb
TC
396 return $session;
397}
398
399=item cleanup()
400
401Clean up the cart, removing any items that are unreleased, expired or
402unlisted.
403
404For BSE use.
405
406=cut
407
408sub cleanup {
409 my ($self) = @_;
410
411 my @newitems;
412 for my $item ($self->items) {
413 my $product = $item->product;
414
415 if ($product->is_released && !$product->is_expired && $product->listed) {
416 push @newitems, $item;
417 }
418 }
419
420 $self->{items} = \@newitems;
421}
422
423=back
424
425=cut
426
427package BSE::Cart::Item;
428
429sub new {
430 my ($class, $raw_item, $index, $cart) = @_;
431
432 my $item = bless
433 {
434 %$raw_item,
435 index => $index,
436 cart => $cart,
437 }, $class;
438
439 Scalar::Util::weaken($item->{cart});
440
441 return $item;
442}
443
444=head2 Item Members
445
446=over
447
448=item product
449
450Returns the product for that line item.
451
452=cut
453
454sub product {
455 my $self = shift;
456
457 return $self->{cart}->_product($self->{productId});
458}
459
460=item price
461
462=cut
463
464sub price {
465 my ($self) = @_;
466
467 unless (defined $self->{calc_price}) {
88a03daa 468 $self->{calc_price} = $self->product->price(user => $self->{cart}{req}->siteuser);
8757d2fb
TC
469 }
470
471 return $self->{calc_price};
11af7272
TC
472}
473
474=item extended
475
476The extended price for the item.
477
8757d2fb
TC
478=cut
479
480sub extended {
481 my ($self, $base) = @_;
482
483 $base =~ /^(price|retailPrice|gst|wholesalePrice)$/
484 or return 0;
485
676f5398 486 return $self->$base() * $self->{units};
8757d2fb
TC
487}
488
489sub extended_retailPrice {
490 $_[0]->extended("price");
491}
492
493sub extended_wholesalePrice {
494 $_[0]->extended("wholesalePrice");
495}
496
497sub extended_gst {
498 $_[0]->extended("gst");
499}
500
501=item units
502
503The number of units.
504
505=cut
506
507sub units {
508 $_[0]{units};
509}
510
511=item session_id
512
513The seminar session id, if any.
514
515=cut
516
517sub session_id {
518 $_[0]{session_id};
519}
520
521=item tier_id
522
523The pricing tier id.
524
525=cut
526
527sub tier_id {
528 $_[0]{tier};
529}
530
11af7272
TC
531=item link
532
533A link to the product.
534
535=cut
536
8757d2fb 537sub link {
11af7272
TC
538 my ($self, $id) = @_;
539
8757d2fb 540 my $product = $self->product;
11af7272
TC
541 my $link = $product->link;
542 unless ($link =~ /^\w+:/) {
543 $link = BSE::Cfg->single->entryErr("site", "url") . $link;
544 }
545
546 return $link;
547}
548
549=item option_list
550
551Return a list of options for the item, each with:
552
553=over
554
555=item *
556
557id, name - the identifier for the option
558
559=item *
560
561value - the value of the option.
562
563=item *
564
565desc - the description of the option
566
567=item *
568
569display - display of the option value
570
571=back
572
573=cut
574
8757d2fb 575sub option_list {
11af7272
TC
576 my ($self, $index) = @_;
577
8757d2fb 578 return [ $self->product->option_descs(BSE::Cfg->single, $self->{options}) ];
11af7272
TC
579}
580
581=item option_text
582
583Display text for options for the item.
584
585=cut
586
8757d2fb 587sub option_text {
11af7272
TC
588 my ($self, $index) = @_;
589
8757d2fb 590 my $options = $self->option_list;
11af7272
TC
591 return join(", ", map "$_->{desc}: $_->{display}", @$options);
592}
593
594=item session
595
596The session object of the seminar session
597
598=cut
599
8757d2fb
TC
600sub session {
601 my ($self) = @_;
11af7272 602
8757d2fb
TC
603 $self->{session_id} or return;
604 return $self->{cart}->_session($self->{session_id});
605}
606
607
608my %product_keys;
609
610sub AUTOLOAD {
611 our $AUTOLOAD;
612 (my $name = $AUTOLOAD) =~ s/^.*:://;
613 unless (%product_keys) {
614 require Products;
615 %product_keys = map { $_ => 1 } Product->columns;
11af7272
TC
616 }
617
8757d2fb
TC
618 if ($product_keys{$name}) {
619 return $_[0]->product->$name();
620 }
621 else {
622 return "* unknown method $name *";
623 }
11af7272
TC
624}
625
676f5398
TC
626=item description
627
628=item title
629
630=cut
631
632sub description {
633 my ($self) = @_;
634
635 $self->product->description;
636}
637
638sub title {
639 my ($self) = @_;
640
641 $self->product->title;
642}
643
11af7272
TC
6441;
645
646=back
647
648=head1 AUTHOR
649
650Tony Cook <tony@develop-help.com>
651
652=cut