link to coupon management from the shop admin page
[bse.git] / site / cgi-bin / modules / BSE / Cart.pm
CommitLineData
11af7272
TC
1package BSE::Cart;
2use strict;
3use Scalar::Util;
4
023761bd 5our $VERSION = "1.004";
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
023761bd
TC
57 $self->{coupon_code} = $self->{req}->session->{cart_coupon_code};
58 defined $self->{coupon_code} or $self->{coupon_code} = "";
59
11af7272
TC
60 return $self;
61}
62
676f5398
TC
63sub _enter_cart {
64 my ($self) = @_;
65
66 my $req = $self->{req};
67 require BSE::CfgInfo;
68
69 $req->session->{custom} ||= {};
70 my %custom_state = %{$req->session->{custom}};
71
72 $self->{custom_state} = \%custom_state;
73
74 my $cust_class = BSE::CfgInfo::custom_class($self->{req}->cfg);
75 $cust_class->enter_cart($self->items, $self->products,
76 \%custom_state, $req->cfg);
77}
78
11af7272
TC
79=item items()
80
81Return an array reference of cart items.
82
83=cut
84
85sub items {
676f5398 86 return wantarray ? @{$_[0]{items}} : $_[0]{items};
11af7272
TC
87}
88
89=item products().
90
91Return an array reference of products in the cart, corresponding to
92the array reference returned by items().
93
94=cut
95
96sub products {
97 my $self = shift;
676f5398
TC
98
99 my @products = map $self->_product($_->{productId}), @{$self->items};
100
101 return wantarray ? @products : \@products;
11af7272
TC
102}
103
104=item total_cost
105
106Return the total cost of the items in the cart.
107
023761bd
TC
108This does not include shipping costs and is not discounted.
109
11af7272
TC
110=cut
111
112sub total_cost {
113 my ($self) = @_;
114
115 my $total_cost = 0;
116 for my $item (@{$self->items}) {
676f5398 117 $total_cost += $item->extended_retailPrice;
11af7272
TC
118 }
119
120 return $total_cost;
121}
122
023761bd
TC
123=item discounted_product_cost
124
125Cost of products with an product discount taken into account.
126
127Note: this rounds thr total B<down>.
128
129=cut
130
131sub discounted_product_cost {
132 my ($self) = @_;
133
134 my $cost = $self->total_cost;
135
136 if ($self->coupon_active) {
137 $cost -= $cost * $self->coupon_code_discount_pc / 100;
138 }
139
140 return int($cost);
141}
142
143=item product_cost_discount
144
145Return any amount taken off the product cost.
146
147=cut
148
149sub product_cost_discount {
150 my ($self) = @_;
151
152 return $self->total_cost - $self->discounted_product_cost;
153}
154
676f5398
TC
155=item set_shipping_cost()
156
157Set the cost of shipping.
158
159Called by the shop.
160
161=cut
162
163sub set_shipping_cost {
164 my ($self, $cost) = @_;
165
166 $self->{shipping} = $cost;
167}
168
169=item shipping_cost()
170
171Fetch the cost of shipping.
172
173=cut
174
175sub shipping_cost {
176 my ($self) = @_;
177
178 return $self->{shipping};
179}
180
11af7272
TC
181=item total_units
182
183Return the total number of units in the cart.
184
185=cut
186
187sub total_units {
188 my ($self) = @_;
189
190 my $total_units = 0;
191 for my $item (@{$self->items}) {
192 $total_units += $item->{units};
193 }
194
195 return $total_units;
196}
197
198=item total
199
676f5398
TC
200Total of items in the cart and shipping costs.
201
202This doesn't handle custom costs yet.
11af7272
TC
203
204=cut
205
8757d2fb
TC
206sub total {
207 my ($self) = @_;
11af7272 208
023761bd
TC
209 my $cost = 0;
210
211 $cost += $self->discounted_product_cost;
212
213 $cost += $self->shipping_cost;
214
215 $cost += $self->custom_cost;
216
217 return $cost;
218}
219
220=item coupon_code
221
222The current coupon code.
223
224=cut
225
226sub coupon_code {
227 my ($self) = @_;
228
229 return $self->{coupon_code};
230}
231
232=item set_coupon_code()
233
234Used by the shop to set the coupon code.
235
236=cut
237
238sub set_coupon_code {
239 my ($self, $code) = @_;
240
241 $code =~ s/\A\s+//;
242 $code =~ s/\s+\z//;
243 $self->{coupon_code} = $code;
244 delete $self->{coupon_valid};
245 $self->{req}->session->{cart_coupon_code} = $code;
246}
247
248=item coupon_code_discount_pc
249
250The percentage discount for the current coupon code, if that code is
251valid and the contents of the cart are valid for that coupon code.
252
253=cut
254
255sub coupon_code_discount_pc {
256 my ($self) = @_;
257
258 $self->coupon_valid
259 or return 0;
260
261 return $self->{coupon_check}{coupon}->discount_percent;
262}
263
264=item coupon_valid
265
266Return true if the current coupon code is valid
267
268=cut
269
270sub coupon_valid {
271 my ($self) = @_;
272
273 unless ($self->{coupon_check}) {
274 if (length $self->{coupon_code}) {
275 require BSE::TB::Coupons;
276 my ($coupon) = BSE::TB::Coupons->getBy(code => $self->{coupon_code});
277 print STDERR "Searching for coupon '$self->{coupon_code}'\n";
278 my %check =
279 (
280 coupon => $coupon,
281 valid => 0,
282 );
283 #print STDERR " coupon $coupon\n";
284 #print STDERR "released ", 0+ $coupon->is_released, " expired ",
285 # 0+$coupon->is_expired, " valid ", 0+$coupon->is_valid, "\n" if $coupon;
286 if ($coupon && $coupon->is_valid) {
287 $check{valid} = 1;
288 $check{active} = 1;
289 my %tiers = map { $_ => 1 } $coupon->tiers;
290 ITEM:
291 for my $item ($self->items) {
292 my $applies = 1;
293 if ($item->tier_id) {
294 #print STDERR "tier ", $item->tier_id, " tiers ", join(",", keys %tiers), "\n";
295 if (!$tiers{$item->tier_id}) {
296 $applies = 0;
297 }
298 }
299 else {
300 if (!$coupon->untiered) {
301 $applies = 0;
302 }
303 }
304 $item->{coupon_applies} = $applies;
305 $applies or $check{active} = 0;
306 }
307 }
308 $self->{coupon_check} = \%check;
309 }
310 else {
311 $self->{coupon_check} =
312 {
313 valid => 0,
314 active => 0,
315 };
316 }
317 }
318
319 return $self->{coupon_check}{valid};
320}
321
322=item coupon_active
323
324Return true if the current coupon is active, ie. both valid and the
325cart has products of all the right tiers.
326
327=cut
328
329sub coupon_active {
330 my ($self) = @_;
331
332 $self->coupon_valid
333 or return 0;
334
335 return $self->{coupon_check}{active};
336}
337
338=item coupon
339
340The current coupon object, if and only if the coupon code is valid.
341
342=cut
343
344sub coupon {
345 my ($self) = @_;
346
347 $self->coupon_valid
348 or return;
349
350 $self->{coupon_check}{coupon};
351}
352
353=item custom_cost
354
355Return any custom cost specified by a custom class.
356
357=cut
358
359sub custom_cost {
360 my ($self) = @_;
361
362 unless (exists $self->{custom_cost}) {
363 my $obj = BSE::CfgInfo::custom_class($self->{req}->cfg);
364 $self->{custom_cost} =
365 $obj->total_extras(scalar $self->items, scalar $self->products,
366 $self->{custom_state}, $self->{req}->cfg, $self->{stage});
367 }
368
369 return $self->{custom_cost};
676f5398
TC
370}
371
372=item have_sales_files
373
374Return true if the cart contains products with files that are for
375sale.
376
377=cut
378
379sub have_sales_files {
380 my ($self) = @_;
381
382 unless (defined $self->{have_sales_files}) {
383 $self->{have_sales_files} = 0;
384 PRODUCTS:
385 for my $prod (@{$self->products}) {
386 if ($prod->has_sales_files) {
387 $self->{have_sales_files} = 1;
388 last PRODUCTS;
389 }
390 }
391 }
392
393 return $self->{have_sales_files};
394}
395
396=item need_logon
397
398Return true if the cart contains items that the user needs to be
399logged on to purchase, or if the current user isn't qualified to
400purchase the item.
401
402Call need_logon_message() to get the reason for this method returning
403false.
404
405=cut
406
407sub need_logon {
408 my ($self) = @_;
409
410 unless (exists $self->{need_logon}) {
411 $self->{need_logon} = $self->_need_logon;
412 }
413
414 $self->{need_logon} or return;
415
416 return 1;
417}
418
023761bd 419=item need_logon_message
676f5398
TC
420
421Returns a list with the error message and message id of the reason the
422user needs to logon for this cart.
423
424=cut
425
426sub need_logon_message {
427 my ($self) = @_;
428
429 unless (exists $self->{need_logon}) {
430 $self->{need_logon} = $self->_need_logon;
431 }
432
433 return @{$self->{logon_reason}};
434}
435
436=item custom_state
437
438State managed by a custom class.
439
440=cut
441
442sub custom_state {
443 my ($self) = @_;
444
445 $self->{custom_state};
446}
447
448=item affiliate_code
449
450Return the stored affiliate code.
451
452=cut
453
454sub affiliate_code {
455 my ($self) = @_;
456
457 my $code = $self->{req}->session->{affiliate_code};
458 defined $code or $code = '';
459
460 return $code;
461}
462
463=item any_physcial_products
464
465Returns true if the cart contains any physical products, ie. needs
466shipping.
467
468=cut
469
470sub any_physical_products {
471 my ($self) = @_;
472
473 for my $prod (@{$self->products}) {
474 if ($prod->weight) {
475 return 1;
476 last;
477 }
478 }
479
480 return 0;
481}
482
483
484=item _need_logon
485
486Internal implementation of need_logon.
487
488=cut
489
490sub _need_logon {
491 my ($self) = @_;
492
493 my $cfg = $self->{req}->cfg;
494
495 $self->{logon_reason} = [];
496
497 my $reg_if_files = $cfg->entryBool('shop', 'register_if_files', 1);
498
499 my $user = $self->{req}->siteuser;
500
501 if (!$user && $reg_if_files) {
502 require BSE::TB::ArticleFiles;
503 # scan to see if any of the products have files
504 # requires a subscription or subscribes
505 for my $prod (@{$self->products}) {
506 my @files = $prod->files;
507 if (grep $_->forSale, @files) {
508 $self->{logon_reason} =
509 [ "register before checkout", "shop/fileitems" ];
510 return;
511 }
512 if ($prod->{subscription_id} != -1) {
513 $self->{logon_reason} =
514 [ "you must be logged in to purchase a subscription", "shop/buysub" ];
515 return;
516 }
517 if ($prod->{subscription_required} != -1) {
518 $self->{logon_reason} =
519 [ "must be logged in to purchase a product requiring a subscription", "shop/subrequired" ];
520 return;
521 }
522 }
523 }
524
525 my $require_logon = $cfg->entryBool('shop', 'require_logon', 0);
526 if (!$user && $require_logon) {
527 $self->{logon_reason} =
528 [ "register before checkout", "shop/logonrequired" ];
529 return;
530 }
531
532 # check the user has the right required subs
533 # and that they qualify to subscribe for limited subscription products
534 if ($user) {
535 for my $prod (@{$self->products}) {
536 my $sub = $prod->subscription_required;
537 if ($sub && !$user->subscribed_to($sub)) {
538 $self->{logon_reason} =
539 [ "you must be subscribed to $sub->{title} to purchase one of these products", "shop/subrequired" ];
540 return;
541 }
542
543 $sub = $prod->subscription;
544 if ($sub && $prod->is_renew_sub_only) {
545 unless ($user->subscribed_to_grace($sub)) {
546 $self->{logon_reason} =
547 [ "you must be subscribed to $sub->{title} to use this renew only product", "sub/renewsubonly" ];
548 return;
549 }
550 }
551 if ($sub && $prod->is_start_sub_only) {
552 if ($user->subscribed_to_grace($sub)) {
553 $self->{logon_reason} =
554 [ "you must not be subscribed to $sub->{title} already to use this new subscription only product", "sub/newsubonly" ];
555 return;
556 }
557 }
558 }
559 }
560
561 return;
8757d2fb 562}
11af7272
TC
563
564sub _product {
565 my ($self, $id) = @_;
566
567 my $product = $self->{products}{$id};
568 unless ($product) {
569 require Products;
570 $product = Products->getByPkey($id)
571 or die "No product $id\n";
572 # FIXME
573 if ($product->generator ne "Generate::Product") {
574 require BSE::TB::Seminars;
575 $product = BSE::TB::Seminars->getByPkey($id)
576 or die "Not a product, not a seminar $id\n";
577 }
578
579 $self->{products}{$id} = $product;
580 }
581 return $product;
8757d2fb
TC
582}
583
584sub _session {
585 my ($self, $id) = @_;
586 my $session = $self->{sessions}{$id};
587 unless ($session) {
588 require BSE::TB::SeminarSessions;
589 $session = BSE::TB::SeminarSessions->getByPkey($id);
590 $self->{sessions}{$id} = $session;
591 }
11af7272 592
8757d2fb
TC
593 return $session;
594}
595
596=item cleanup()
597
598Clean up the cart, removing any items that are unreleased, expired or
599unlisted.
600
601For BSE use.
602
603=cut
604
605sub cleanup {
606 my ($self) = @_;
607
608 my @newitems;
609 for my $item ($self->items) {
610 my $product = $item->product;
611
612 if ($product->is_released && !$product->is_expired && $product->listed) {
613 push @newitems, $item;
614 }
615 }
616
617 $self->{items} = \@newitems;
618}
619
620=back
621
622=cut
623
624package BSE::Cart::Item;
625
626sub new {
627 my ($class, $raw_item, $index, $cart) = @_;
628
629 my $item = bless
630 {
631 %$raw_item,
632 index => $index,
633 cart => $cart,
634 }, $class;
635
636 Scalar::Util::weaken($item->{cart});
637
638 return $item;
639}
640
641=head2 Item Members
642
643=over
644
645=item product
646
647Returns the product for that line item.
648
649=cut
650
651sub product {
652 my $self = shift;
653
654 return $self->{cart}->_product($self->{productId});
655}
656
657=item price
658
659=cut
660
661sub price {
662 my ($self) = @_;
663
664 unless (defined $self->{calc_price}) {
88a03daa 665 $self->{calc_price} = $self->product->price(user => $self->{cart}{req}->siteuser);
8757d2fb
TC
666 }
667
668 return $self->{calc_price};
11af7272
TC
669}
670
671=item extended
672
673The extended price for the item.
674
8757d2fb
TC
675=cut
676
677sub extended {
678 my ($self, $base) = @_;
679
680 $base =~ /^(price|retailPrice|gst|wholesalePrice)$/
681 or return 0;
682
676f5398 683 return $self->$base() * $self->{units};
8757d2fb
TC
684}
685
686sub extended_retailPrice {
687 $_[0]->extended("price");
688}
689
690sub extended_wholesalePrice {
691 $_[0]->extended("wholesalePrice");
692}
693
694sub extended_gst {
695 $_[0]->extended("gst");
696}
697
698=item units
699
700The number of units.
701
702=cut
703
704sub units {
705 $_[0]{units};
706}
707
708=item session_id
709
710The seminar session id, if any.
711
712=cut
713
714sub session_id {
715 $_[0]{session_id};
716}
717
718=item tier_id
719
720The pricing tier id.
721
722=cut
723
724sub tier_id {
725 $_[0]{tier};
726}
727
11af7272
TC
728=item link
729
730A link to the product.
731
732=cut
733
8757d2fb 734sub link {
11af7272
TC
735 my ($self, $id) = @_;
736
8757d2fb 737 my $product = $self->product;
11af7272
TC
738 my $link = $product->link;
739 unless ($link =~ /^\w+:/) {
740 $link = BSE::Cfg->single->entryErr("site", "url") . $link;
741 }
742
743 return $link;
744}
745
746=item option_list
747
748Return a list of options for the item, each with:
749
750=over
751
752=item *
753
754id, name - the identifier for the option
755
756=item *
757
758value - the value of the option.
759
760=item *
761
762desc - the description of the option
763
764=item *
765
766display - display of the option value
767
768=back
769
770=cut
771
8757d2fb 772sub option_list {
11af7272
TC
773 my ($self, $index) = @_;
774
8757d2fb 775 return [ $self->product->option_descs(BSE::Cfg->single, $self->{options}) ];
11af7272
TC
776}
777
778=item option_text
779
780Display text for options for the item.
781
782=cut
783
8757d2fb 784sub option_text {
11af7272
TC
785 my ($self, $index) = @_;
786
8757d2fb 787 my $options = $self->option_list;
11af7272
TC
788 return join(", ", map "$_->{desc}: $_->{display}", @$options);
789}
790
023761bd
TC
791=item coupon_applies
792
793Returns true if the current coupon code applies to the item.
794
795=cut
796
797sub coupon_applies {
798 my ($self) = @_;
799
800 $self->{cart}->coupon_valid
801 or return 0;
802
803 return $self->{coupon_applies};
804}
805
11af7272
TC
806=item session
807
808The session object of the seminar session
809
810=cut
811
8757d2fb
TC
812sub session {
813 my ($self) = @_;
11af7272 814
8757d2fb
TC
815 $self->{session_id} or return;
816 return $self->{cart}->_session($self->{session_id});
817}
818
819
820my %product_keys;
821
822sub AUTOLOAD {
823 our $AUTOLOAD;
824 (my $name = $AUTOLOAD) =~ s/^.*:://;
825 unless (%product_keys) {
826 require Products;
827 %product_keys = map { $_ => 1 } Product->columns;
11af7272
TC
828 }
829
8757d2fb
TC
830 if ($product_keys{$name}) {
831 return $_[0]->product->$name();
832 }
833 else {
834 return "* unknown method $name *";
835 }
11af7272
TC
836}
837
676f5398
TC
838=item description
839
840=item title
841
842=cut
843
844sub description {
845 my ($self) = @_;
846
847 $self->product->description;
848}
849
850sub title {
851 my ($self) = @_;
852
853 $self->product->title;
854}
855
11af7272
TC
8561;
857
858=back
859
860=head1 AUTHOR
861
862Tony Cook <tony@develop-help.com>
863
864=cut