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