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