3 use base 'BSE::UI::Dispatch';
4 use BSE::Util::HTML qw(:default popup_menu);
5 use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
6 use BSE::Shop::Util qw(:payment shop_cart_tags payment_types nice_options
7 cart_item_opts basic_tags order_item_opts);
8 use BSE::CfgInfo qw(custom_class credit_card_class bse_default_country);
10 use BSE::TB::OrderItems;
11 use BSE::Util::Tags qw(tag_error_img tag_hash tag_article);
12 use BSE::TB::Products;
13 use BSE::TB::Seminars;
14 use DevHelp::Validate qw(dh_validate dh_validate_hash);
15 use Digest::MD5 'md5_hex';
17 use BSE::Countries qw(bse_country_code);
18 use BSE::Util::Secure qw(make_secret);
21 our $VERSION = "1.048";
25 BSE::UI::Shop - implements the shop for BSE
29 BSE::UI::Shop implements the shop for BSE.
37 use constant MSG_SHOP_CART_FULL => 'Your shopping cart is full, please remove an item and try adding an item again';
60 # map of SiteUser field names to order field names - mostly
63 name1 => 'billFirstName',
64 name2 => 'billLastName',
65 street => 'billStreet',
66 street2 => 'billStreet2',
67 suburb => 'billSuburb',
68 postcode => 'billPostCode',
70 country => 'billCountry',
71 telephone => 'billTelephone',
72 facsimile => 'billFacsimile',
73 mobile => 'billMobile',
74 organization => 'billOrganization',
76 delivFacsimile => 'facsimile',
77 delivTelephone => 'telephone',
78 delivEmail => 'emailAddress',
81 my %rev_field_map = reverse %field_map;
83 sub actions { \%actions }
85 sub default_action { 'cart' }
88 my ($class, $cgi) = @_;
90 for my $key ($cgi->param()) {
91 if ($key =~ /^delete_(\d+)(?:\.x)?$/) {
92 return ( remove_item => $1 );
94 elsif ($key =~ /^(?:a_)?addsingle(\d+)(?:\.x)?$/) {
95 return ( addsingle => $1 );
103 my ($class, $req, $msg) = @_;
105 $class->_refresh_cart($req);
107 my $cart = $req->cart("cart");
109 my $cust_class = custom_class($req->cfg);
110 # $req->session->{custom} ||= {};
111 # my %custom_state = %{$req->session->{custom}};
113 # $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $req->cfg);
114 $msg = $req->message($msg);
119 $cust_class->cart_actions(\%acts, scalar $cart->items, scalar $cart->products,
120 $cart->custom_state, $req->cfg),
121 shop_cart_tags(\%acts, $cart, $req, 'cart'),
126 $req->session->{custom} = { %{$cart->custom_state} };
127 $req->session->{order_info_confirmed} = 0;
129 # intended to ajax enable the shop cart with partial templates
130 my $template = 'cart';
131 my $embed = $req->cgi->param('embed');
132 if (defined $embed and $embed =~ /^\w+$/) {
133 $template = "include/cart_$embed";
135 return $req->response($template, \%acts);
140 Empty the shopping cart.
142 Refreshes to the URL in C<r> or the cart otherwise.
144 Flashes msg:bse/shop/cart/empty unless C<r> is supplied.
149 my ($self, $req) = @_;
151 my $cart = $req->cart;
152 my $item_count = @{$cart->items};
155 my $refresh = $req->cgi->param('r');
157 $refresh = $req->user_url(shop => 'cart');
158 $req->flash_notice("msg:bse/shop/cart/empty");
161 return _add_refresh($refresh, $req, !$item_count);
165 my ($class, $req) = @_;
169 my $quantity = $cgi->param('quantity');
174 my ($product, $options, $extras);
175 my $addid = $cgi->param('id');
176 if (defined $addid) {
177 ($product, $options, $extras)
178 = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
181 my $code = $cgi->param('code');
183 ($product, $options, $extras)
184 = $class->_validate_add_by_code($req, $code, $quantity, \$error, \$refresh_logon);
187 return $class->req_cart($req, "No product id or code supplied");
190 if ($refresh_logon) {
191 return $class->_refresh_logon($req, @$refresh_logon);
194 return $class->req_cart($req, $error);
197 if ($cgi->param('empty')) {
198 $req->session->{cart} = [];
201 $req->session->{cart} ||= [];
202 my @cart = @{$req->session->{cart}};
203 my $started_empty = @cart == 0;
206 for my $item (@cart) {
207 $item->{productId} eq $product->{id} && _same_options($item->{options}, $options)
211 $item->{units} += $quantity;
212 $req->flash_notice("msg:bse/shop/cart/addquant", [ $product, $quantity ]);
216 my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
217 if (defined $cart_limit && @cart >= $cart_limit) {
218 return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
220 my $user = $req->siteuser;
221 my ($price, $tier) = $product->price(user => $user);
224 productId => $product->{id},
228 tier => $tier ? $tier->id : "",
229 user => $user ? $user->id : 0,
232 $req->flash_notice("msg:bse/shop/cart/add", [ $product, $quantity ]);
235 $req->session->{cart} = \@cart;
236 $req->session->{order_info_confirmed} = 0;
238 my $refresh = $cgi->param('r');
240 $refresh = $req->user_url(shop => 'cart');
244 if ($refresh eq 'ajaxcart') {
245 return $class->req_cart($req);
248 return _add_refresh($refresh, $req, $started_empty);
252 my ($class, $req, $addid) = @_;
257 my $quantity = $cgi->param("qty$addid");
258 defined $quantity && $quantity =~ /\S/
263 my ($product, $options, $extras)
264 = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
265 if ($refresh_logon) {
266 return $class->_refresh_logon($req, @$refresh_logon);
269 return $class->req_cart($req, $error);
272 if ($cgi->param('empty')) {
273 $req->session->{cart} = [];
276 $req->session->{cart} ||= [];
277 my @cart = @{$req->session->{cart}};
278 my $started_empty = @cart == 0;
281 for my $item (@cart) {
282 $item->{productId} eq $addid && _same_options($item->{options}, $options)
286 $item->{units} += $quantity;
287 $req->flash_notice("msg:bse/shop/cart/addquant", [ $product, $quantity ]);
291 my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
292 if (defined $cart_limit && @cart >= $cart_limit) {
293 return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
295 my $user = $req->siteuser;
296 my ($price, $tier) = $product->price(user => $user);
303 tier => $tier ? $tier->id : "",
304 user => $user ? $user->id : 0,
307 $req->flash_notice("msg:bse/shop/cart/add", [ $product, $quantity ]);
310 $req->session->{cart} = \@cart;
311 $req->session->{order_info_confirmed} = 0;
313 my $refresh = $cgi->param('r');
315 $refresh = $req->user_url(shop => 'cart');
319 if ($refresh eq 'ajaxcart') {
320 return $class->req_cart($req);
323 return _add_refresh($refresh, $req, $started_empty);
326 sub req_addmultiple {
327 my ($class, $req) = @_;
330 my @qty_keys = map /^qty(\d+)/, $cgi->param;
334 for my $addid (@qty_keys) {
335 my $quantity = $cgi->param("qty$addid");
336 defined $quantity && $quantity =~ /^\s*\d+\s*$/
341 my ($product, $options, $extras) =
342 $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
343 if ($refresh_logon) {
344 return $class->_refresh_logon($req, @$refresh_logon);
347 return $class->req_cart($req, $error);
349 if ($product->{options}) {
350 push @messages, "$product->{title} has options, you need to use the product page to add this product";
355 id => $product->{id},
358 quantity => $quantity,
362 my @qtys = $cgi->param("qty");
363 my @ids = $cgi->param("id");
364 for my $addid (@ids) {
365 my $quantity = shift @qtys;
370 defined $quantity or $quantity = 1;
375 my ($error, $refresh_logon);
377 my ($product, $options, $extras) =
378 $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
379 if ($refresh_logon) {
380 return $class->_refresh_logon($req, @$refresh_logon);
383 return $class->req_cart($req, $error);
385 if ($product->{options}) {
386 push @messages, "$product->{title} has options, you need to use the product page to add this product";
391 id => $product->{id},
394 quantity => $quantity,
398 my $started_empty = 0;
399 if (keys %additions) {
400 if ($cgi->param('empty')) {
401 $req->session->{cart} = [];
403 $req->session->{cart} ||= [];
404 my @cart = @{$req->session->{cart}};
405 $started_empty = @cart == 0;
406 for my $item (@cart) {
407 @{$item->{options}} == 0 or next;
409 my $addition = delete $additions{$item->{productId}}
412 $item->{units} += $addition->{quantity};
413 $req->flash_notice("msg:bse/shop/cart/addquant",
414 [ $addition->{product}, $addition->{quantity} ]);
417 my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
419 my @additions = grep $_->{quantity} > 0, values %additions;
421 my $user = $req->siteuser;
423 for my $addition (@additions) {
424 my $product = $addition->{product};
426 if (defined $cart_limit && @cart >= $cart_limit) {
427 $error = $req->text('shop/cartfull', MSG_SHOP_CART_FULL);
431 my ($price, $tier) = $product->price(user => $user);
434 productId => $product->{id},
435 units => $addition->{quantity},
437 tier => $tier ? $tier->id : "",
438 user => $user ? $user->id : 0,
440 %{$addition->{extras}},
442 $req->flash_notice("msg:bse/shop/cart/add",
443 [ $addition->{product}, $addition->{quantity} ]);
446 $req->session->{cart} = \@cart;
447 $req->session->{order_info_confirmed} = 0;
449 and return $class->req_cart($req, $error);
452 my $refresh = $cgi->param('r');
454 $refresh = $req->user_url(shop => 'cart');
457 $req->flash_error($_) for @messages;
461 if ($refresh eq 'ajaxcart') {
462 return $class->req_cart($req);
465 return _add_refresh($refresh, $req, $started_empty);
469 my ($user, $args) = @_;
473 return defined $user->{$args} && $user->{$args};
480 return defined $user;
484 sub _any_physical_products {
487 for my $prod (@$prods) {
499 Display the checkout form.
507 old - a function returning the old value for most fields.
511 errors - any errors from attempting to progress to payment
515 need_delivery - true if the user indicates they want separate delivery
520 Template C<checkoutnew>
525 my ($class, $req, $message, $olddata) = @_;
527 $class->_refresh_cart($req);
530 if (defined $message) {
533 $message = $req->message($errors);
542 my $need_delivery = ( $olddata ? $cgi->param("need_delivery") : $req->session->{order_need_delivery} ) || 0;
544 $class->update_quantities($req);
545 my $cart = $req->cart("checkout");
546 my @cart = @{$cart->items};
548 @cart or return $class->req_cart($req);
550 my @cart_prods = @{$cart->products};
551 my @items = @{$cart->items};
553 if ($cart->need_logon) {
554 my ($msg, $id) = $cart->need_logon_reason;
555 return $class->_refresh_logon($req, $msg, $id);
558 my $user = $req->siteuser;
560 my $order_info = $req->session->{order_info};
562 my $billing_map = BSE::TB::Order->billing_to_delivery_map;
563 my %delivery_map = reverse %$billing_map;
565 if ($order_info && !$need_delivery) {
566 # if need delivery is off, remove any delivery fields
567 my $map = BSE::TB::Order->billing_to_delivery_map;
568 delete @{$order_info}{keys %delivery_map};
575 if ($olddata && defined($cgi->param($field))) {
576 $value = $cgi->param($field);
578 elsif ($order_info && defined $order_info->{$field}) {
579 $value = $order_info->{$field};
582 $rev_field_map{$field} and $field = $rev_field_map{$field};
583 $value = $user && defined $user->{$field} ? $user->{$field} : '';
586 defined $value or $value = '';
590 # shipping handling, if enabled
591 my $shipping_select = ''; # select of shipping types
592 my ($delivery_in, $shipping_cost, $shipping_method);
593 my $shipping_error = '';
594 my $shipping_name = '';
595 my $prompt_ship = $cart->cfg_shipping;
597 my $physical = $cart->any_physical_products;
600 my $sel_cn = $old->("shipping_name") || "";
603 $work_order = $order_info unless $olddata;
604 unless ($work_order) {
606 my %fields = $class->_order_fields($req);
607 $class->_order_hash($req, \%fake_order, \%fields, user => 1);
608 $work_order = \%fake_order;
611 # Get a list of couriers
612 my $country_field = $need_delivery ? "delivCountry" : "billCountry";
613 my $country = $old->($country_field)
614 || bse_default_country($cfg);
615 my $country_code = bse_country_code($country);
616 my $suburb = $old->($need_delivery ? "delivSuburb" : "billSuburb");
617 my $postcode = $old->($need_delivery ? "delivPostCode" : "billPostCode");
620 or $errors->{$country_field} = "Unknown country name $country";
622 my @couriers = BSE::Shipping->get_couriers($cfg);
624 if ($country_code and $postcode) {
625 @couriers = grep $_->can_deliver(country => $country_code,
627 postcode => $postcode), @couriers;
630 my ($sel_cour) = grep $_->name eq $sel_cn, @couriers;
631 # if we don't match against the list (perhaps because of a country
632 # change) the first item in the list will be selected by the
633 # browser anyway, so select it ourselves and display an
634 # appropriate shipping cost for the item
636 $sel_cour = $couriers[0];
637 $sel_cn = $sel_cour->name;
639 if ($sel_cour and $postcode and $suburb and $country_code) {
640 my @parcels = BSE::Shipping->package_order($cfg, $order_info, \@items);
641 $shipping_cost = $sel_cour->calculate_shipping
643 parcels => \@parcels,
645 postcode => $postcode,
646 country => $country_code,
647 products => \@cart_prods,
650 $delivery_in = $sel_cour->delivery_in();
651 $shipping_method = $sel_cour->description();
652 $shipping_name = $sel_cour->name;
653 unless (defined $shipping_cost) {
654 $shipping_error = "$shipping_method: " . $sel_cour->error_message;
655 $errors->{shipping_name} = $shipping_error;
657 # use the last one, which should be the Null shipper
658 $sel_cour = $couriers[-1];
659 $sel_cn = $sel_cour->name;
660 $shipping_method = $sel_cour->description;
664 $shipping_select = popup_menu
666 -name => "shipping_name",
667 -id => "shipping_name",
668 -values => [ map $_->name, @couriers ],
669 -labels => { map { $_->name => $_->description } @couriers },
674 $sel_cn = $shipping_name = "none";
675 $shipping_method = "Nothing to ship!";
676 $shipping_select = popup_menu
678 -name => "shipping_name",
679 -id => "shipping_name",
680 -values => [ "none" ],
681 -labels => { none => $shipping_method },
687 my $cust_class = custom_class($cfg);
689 if (!$message && keys %$errors) {
690 $message = $req->message($errors);
692 $cart->set_shipping_cost($shipping_cost);
693 $cart->set_shipping_method($shipping_method);
694 $cart->set_shipping_name($shipping_name);
695 $cart->set_delivery_in($delivery_in);
696 $req->set_variable(old => $old);
697 $req->set_variable(errors => $errors);
698 $req->set_variable(need_delivery => $need_delivery);
706 shop_cart_tags(\%acts, $cart, $req, 'checkout'),
710 old => sub { escape_html($old->($_[0])); },
711 $cust_class->checkout_actions(\%acts, \@cart, \@cart_prods,
712 $cart->custom_state, $req->cgi, $cfg),
713 ifUser => [ \&tag_ifUser, $user ],
714 user => $user ? [ \&tag_hash, $user ] : '',
715 affiliate_code => escape_html($cart->affiliate_code),
716 error_img => [ \&tag_error_img, $cfg, $errors ],
717 ifShipping => $prompt_ship,
718 shipping_select => $shipping_select,
719 delivery_in => escape_html(defined $delivery_in ? $delivery_in : ""),
720 shipping_cost => $shipping_cost,
721 shipping_method => escape_html($shipping_method),
722 shipping_error => escape_html($shipping_error),
723 shipping_name => $shipping_name,
724 ifPhysical => $physical,
725 ifNeedDelivery => $need_delivery,
727 $req->session->{custom} = $cart->custom_state;
729 return $req->response('checkoutnew', \%acts);
732 sub req_checkupdate {
733 my ($self, $req) = @_;
735 my $cart = $req->cart("checkupdate");
737 $self->update_quantities($req);
739 $req->session->{custom} = $cart->custom_state;
740 $req->session->{order_info_confirmed} = 0;
742 my %fields = $self->_order_fields($req);
744 $self->_order_hash($req, \%values, \%fields);
745 $req->session->{order_info} = \%values;
746 $req->session->{order_need_delivery} = $req->cgi->param("need_delivery");
748 return $req->get_refresh($req->user_url(shop => "checkout"));
751 sub req_remove_item {
752 my ($class, $req, $index) = @_;
754 $req->session->{cart} ||= [];
755 my @cart = @{$req->session->{cart}};
756 if ($index >= 0 && $index < @cart) {
757 my ($item) = splice(@cart, $index, 1);
758 my $product = BSE::TB::Products->getByPkey($item->{productId});
759 $req->flash_notice("msg:bse/shop/cart/remove", [ $product ]);
761 $req->session->{cart} = \@cart;
762 $req->session->{order_info_confirmed} = 0;
764 return BSE::Template->get_refresh($req->user_url(shop => 'cart'), $req->cfg);
768 my ($self, $req) = @_;
770 my %fields = BSE::TB::Order->valid_fields($req->cfg);
771 my $cust_class = custom_class($req->cfg);
773 $cust_class->required_fields($req->cgi, $req->session->{custom}, $req->cfg);
775 for my $name (@required) {
776 $fields{$name}{required} = 1;
783 my ($self, $req, $values, $fields, %opts) = @_;
786 my $user = $req->siteuser;
787 for my $name (keys %$fields) {
788 my ($value) = $cgi->param($name);
789 if (!defined $value && $opts{user} && $user) {
790 my $field = $rev_field_map{$name} || $name;
791 if ($user->can($field)) {
792 $value = $user->$field();
795 defined $value or $value = "";
796 $values->{$name} = $value;
799 unless ($cgi->param("need_delivery")) {
800 my $map = BSE::TB::Order->billing_to_delivery_map;
801 keys %$map; # reset iterator
802 while (my ($billing, $delivery) = each %$map) {
803 $values->{$delivery} = $values->{$billing};
806 my $cart = $req->cart;
807 if ($cart->cfg_shipping && $cart->any_physical_products) {
808 my $shipping_name = $cgi->param("shipping_name");
809 defined $shipping_name and $values->{shipping_name} = $shipping_name;
813 # saves order and refresh to payment page
815 my ($class, $req) = @_;
820 $req->session->{cart} && @{$req->session->{cart}}
821 or return $class->req_cart($req, "Your cart is empty");
824 $class->_validate_cfg($req, \$msg)
825 or return $class->req_cart($req, $msg);
827 my $cart = $req->cart("order");
829 my @products = @{$cart->products};
830 my @items = @{$cart->items};
833 if ($cart->need_logon) {
834 my ($msg, $id) = $cart->need_logon_message;
835 return $class->_refresh_logon($req, $msg, $id);
838 my %fields = $class->_order_fields($req);
839 my %rules = BSE::TB::Order->valid_rules($cfg);
843 $class->_order_hash($req, \%values, \%fields);
845 dh_validate_hash(\%values, \%errors, { rules=>\%rules, fields=>\%fields },
846 $cfg, 'Shop Order Validation');
847 my $prompt_ship = $cart->cfg_shipping;
849 my $country = $values{delivCountry} || bse_default_country($cfg);
850 my $country_code = bse_country_code($country);
852 or $errors{delivCountry} = "Unknown country name $country";
855 and return $class->req_checkout($req, \%errors, 1);
857 $class->_fillout_order($req, \%values, \$msg, 'payment')
858 or return $class->req_checkout($req, $msg, 1);
860 $req->session->{order_info} = \%values;
861 $req->session->{order_need_delivery} = $cgi->param("need_delivery");
862 $req->session->{order_info_confirmed} = 1;
864 # skip payment page if nothing to pay
865 if ($values{total} == 0) {
866 return $class->req_payment($req);
869 return BSE::Template->get_refresh($req->user_url(shop => 'show_payment'), $req->cfg);
875 Allows the customer to pay for an existing order.
883 orderid - the order id to be paid (Optional, otherwise displays the
888 Template: checkoutpay
893 sub req_show_payment {
894 my ($class, $req, $errors) = @_;
903 # ideally supply order_id to be consistent with a_payment.
904 my $order_id = $cgi->param('orderid') || $cgi->param("order_id");
908 or return $class->req_cart($req, "No or invalid order id supplied");
910 my $user = $req->siteuser
911 or return $class->_refresh_logon
912 ($req, "Please logon before paying your existing order", "logonpayorder",
913 undef, { a_show_payment => 1, orderid => $order_id });
915 require BSE::TB::Orders;
916 $order = BSE::TB::Orders->getByPkey($order_id)
917 or return $class->req_cart($req, "Unknown order id");
919 $order->siteuser_id == $user->id
920 or return $class->req_cart($req, "You can only pay for your own orders");
923 and return $class->req_cart($req, "Order $order->{id} has been paid");
928 $req->session->{order_info_confirmed}
929 or return $class->req_checkout($req, 'Please proceed via the checkout page');
931 $req->session->{cart} && @{$req->session->{cart}}
932 or return $class->req_cart($req, "Your cart is empty");
934 $order = $req->session->{order_info}
935 or return $class->req_checkout($req, "You need to enter order information first");
937 $cart = $req->cart("payment");
941 my $msg = $req->message($errors);
943 my @pay_types = payment_types($cfg);
944 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
945 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
946 @payment_types or @payment_types = ( PAYMENT_CALLME );
947 @payment_types = sort { $a <=> $b } @payment_types;
948 my %payment_types = map { $_=> 1 } @payment_types;
950 $errors and $payment = $cgi->param('paymentType');
951 defined $payment or $payment = $payment_types[0];
953 $cart->set_shipping_cost($order->{shipping_cost});
954 $cart->set_shipping_method($order->{shipping_method});
955 $cart->set_shipping_name($order->{shipping_name});
956 $req->set_variable(errors => $errors);
964 order => [ \&tag_hash, $order ],
965 shop_cart_tags(\%acts, $cart, $req, 'payment'),
966 ifMultPaymentTypes => @payment_types > 1,
967 checkedPayment => [ \&tag_checkedPayment, $payment, \%types_by_name ],
968 ifPayments => [ \&tag_ifPayments, \@payment_types, \%types_by_name ],
969 paymentTypeId => [ \&tag_paymentTypeId, \%types_by_name ],
970 error_img => [ \&tag_error_img, $cfg, $errors ],
971 total => $cart->total,
972 delivery_in => $order->{delivery_in},
973 shipping_cost => $order->{shipping_cost},
974 shipping_method => $order->{shipping_method},
976 for my $type (@pay_types) {
977 my $id = $type->{id};
978 my $name = $type->{name};
979 $acts{"if${name}Payments"} = exists $payment_types{$id};
980 $acts{"if${name}FirstPayment"} = $payment_types[0] == $id;
981 $acts{"checkedIfFirst$name"} = $payment_types[0] == $id ? "checked " : "";
982 $acts{"checkedPayment$name"} = $payment == $id ? 'checked="checked" ' : "";
984 $req->set_variable(ordercart => $cart);
985 $req->set_variable(order => $order);
986 $req->set_variable(is_order => !!$order_id);
988 return $req->response('checkoutpay', \%acts);
1002 # hash of CC payment parameter names to arrays of billing address fields
1003 firstname => "billFirstName",
1004 lastname => "billLastName",
1005 address1 => "billStreet",
1006 address2 => "billStreet2",
1007 postcode => "billPostCode",
1008 state => "billState",
1009 suburb => "billSuburb",
1010 email => "billEmail",
1014 my ($class, $req, $errors) = @_;
1016 require BSE::TB::Orders;
1017 my $cgi = $req->cgi;
1018 my $order_id = $cgi->param("order_id");
1019 my $user = $req->siteuser;
1022 my $old_order; # true if we're paying an old order
1025 return $class->_refresh_logon
1028 "Please logon before paying your existing order",
1031 { a_show_payment => 1, orderid => $order_id }
1034 $order_id =~ /^\d+$/
1035 or return $class->req_cart($req, "Invalid order id");
1036 $order = BSE::TB::Orders->getByPkey($order_id)
1037 or return $class->req_cart($req, "Unknown order id");
1038 $order->siteuser_id == $user->id
1039 or return $class->req_cart($req, "You can only pay for your own orders");
1042 and return $class->req_cart($req, "Order $order->{id} has been paid");
1044 $order_values = $order;
1048 $req->session->{order_info_confirmed}
1049 or return $class->req_checkout($req, 'Please proceed via the checkout page');
1051 $order_values = $req->session->{order_info}
1052 or return $class->req_checkout($req, "You need to enter order information first");
1056 my $cfg = $req->cfg;
1057 my $session = $req->session;
1060 if ($order_values->{total} != 0) {
1061 my @pay_types = payment_types($cfg);
1062 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1063 my %pay_types = map { $_->{id} => $_ } @pay_types;
1064 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1065 @payment_types or @payment_types = ( PAYMENT_CALLME );
1066 @payment_types = sort { $a <=> $b } @payment_types;
1067 my %payment_types = map { $_=> 1 } @payment_types;
1069 $paymentType = $cgi->param('paymentType');
1070 defined $paymentType or $paymentType = $payment_types[0];
1071 $payment_types{$paymentType}
1072 or return $class->req_show_payment($req, { paymentType => "Invalid payment type" } , 1);
1075 push @required, @{$pay_types{$paymentType}{require}};
1077 my %fields = BSE::TB::Order->valid_payment_fields($cfg);
1078 my %rules = BSE::TB::Order->valid_payment_rules($cfg);
1079 for my $field (@required) {
1080 if (exists $fields{$field}) {
1081 $fields{$field}{required} = 1;
1084 $fields{$field} = { description => $field, required=> 1 };
1089 dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
1090 $cfg, 'Shop Order Validation');
1092 and return $class->req_show_payment($req, \%errors);
1094 for my $field (keys %fields) {
1095 unless ($nostore{$field}) {
1096 if (my ($value) = $cgi->param($field)) {
1097 $order_values->{$field} = $value;
1107 $order_values->{paymentType} = $paymentType;
1112 @dbitems = $order->items;
1113 @products = $order->products;
1114 for my $product (@products) {
1115 my $sub = $product->subscription;
1117 $subscribing_to{$sub->{text_id}} = $sub;
1122 my $cart = $req->cart("payment");
1124 $order_values->{filled} = 0;
1125 $order_values->{paidFor} = 0;
1127 my @items = $class->_build_items($req);
1128 @products = $cart->products;
1130 if ($session->{order_work}) {
1131 $order = BSE::TB::Orders->getByPkey($session->{order_work});
1133 if ($order && !$order->{complete}) {
1134 my @columns = BSE::TB::Order->columns;
1135 shift @columns; # don't set id
1137 @columns{@columns} = @columns;
1139 for my $col (@columns) {
1140 defined $order_values->{$col} or $order_values->{$col} = '';
1143 my @data = @{$order_values}{@columns};
1146 print STDERR "Recycling order $order->{id}\n";
1148 my @allbutid = @columns;
1150 @{$order}{@allbutid} = @data;
1152 $order->clear_items;
1153 delete $session->{order_work};
1155 tied(%$session)->save;
1159 $order = BSE::TB::Orders->make(%$order_values)
1160 or die "Cannot add order";
1163 my @item_cols = BSE::TB::OrderItem->columns;
1164 for my $row_num (0..$#items) {
1165 my $item = $items[$row_num];
1166 my $product = $products[$row_num];
1168 $item{orderId} = $order->{id};
1169 $item{max_lapsed} = 0;
1170 if ($product->{subscription_id} != -1) {
1171 my $sub = $product->subscription;
1172 $item{max_lapsed} = $sub->{max_lapsed} if $sub;
1174 defined $item{session_id} or $item{session_id} = 0;
1175 $item{options} = ""; # not used for new orders
1176 my @data = @item{@item_cols};
1178 my $dbitem = BSE::TB::OrderItems->add(@data);
1179 push @dbitems, $dbitem;
1181 if ($item->{options} and @{$item->{options}}) {
1182 require BSE::TB::OrderItemOptions;
1183 my @option_descs = $product->option_descs($cfg, $item->{options});
1184 my $display_order = 1;
1185 for my $option (@option_descs) {
1186 BSE::TB::OrderItemOptions->make
1188 order_item_id => $dbitem->{id},
1189 original_id => $option->{id},
1190 name => $option->{desc},
1191 value => $option->{value},
1192 display => $option->{display},
1193 display_order => $display_order++,
1198 my $sub = $product->subscription;
1200 $subscribing_to{$sub->{text_id}} = $sub;
1203 if ($item->{session_id}) {
1204 require BSE::TB::SeminarSessions;
1205 my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
1206 my $options = join(",", @{$item->{options}});
1207 $session->add_attendee($user,
1208 customer_instructions => $order->{instructions},
1209 options => $options);
1214 $order->set_randomId(make_secret($cfg));
1215 $order->{ccOnline} = 0;
1217 my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
1218 if ($paymentType == PAYMENT_CC) {
1219 my $ccNumber = $cgi->param('cardNumber');
1220 my $ccExpiry = $cgi->param('cardExpiry');
1221 my $ccName = $cgi->param('ccName');
1224 my $cc_class = credit_card_class($cfg);
1226 $order->{ccOnline} = 1;
1228 $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
1229 my ($month, $year) = ($1, $2);
1230 $year > 2000 or $year += 2000;
1231 my $expiry = sprintf("%04d%02d", $year, $month);
1232 my $verify = $cgi->param('cardVerify');
1233 defined $verify or $verify = '';
1235 while (my ($cc_field, $order_field) = each %bill_ccmap) {
1236 if ($order->$order_field()) {
1237 $more{$cc_field} = $order->$order_field();
1240 my $result = $cc_class->payment
1242 orderno => $order->{id},
1243 amount => $order->{total},
1244 cardnumber => $ccNumber,
1245 nameoncard => $ccName,
1246 expirydate => $expiry,
1248 ipaddress => $ENV{REMOTE_ADDR},
1251 unless ($result->{success}) {
1253 print STDERR Dumper($result);
1254 # failed, back to payments
1255 $order->{ccSuccess} = 0;
1256 $order->{ccStatus} = $result->{statuscode};
1257 $order->{ccStatus2} = 0;
1258 $order->{ccStatusText} = $result->{error};
1259 $order->{ccTranId} = '';
1262 $errors{cardNumber} = $result->{error};
1263 $session->{order_work} = $order->{id};
1264 return $class->req_show_payment($req, \%errors);
1267 $order->{ccSuccess} = 1;
1268 $order->{ccReceipt} = $result->{receipt};
1269 $order->{ccStatus} = 0;
1270 $order->{ccStatus2} = 0;
1271 $order->{ccStatusText} = '';
1272 $order->{ccTranId} = $result->{transactionid};
1273 $order->set_ccPANTruncate($ccNumber);
1274 defined $order->{ccTranId} or $order->{ccTranId} = '';
1275 $order->{paidFor} = 1;
1278 $ccNumber =~ tr/0-9//cd;
1279 $order->{ccExpiryHash} = md5_hex($ccExpiry);
1280 $order->set_ccPANTruncate($ccNumber);
1282 $order->set_ccName($ccName);
1284 elsif ($paymentType == PAYMENT_PAYPAL) {
1285 require BSE::PayPal;
1287 my $url = BSE::PayPal->payment_url(order => $order,
1291 $session->{order_work} = $order->{id};
1293 $errors{_} = "PayPal error: $msg" if $msg;
1294 return $class->req_show_payment($req, \%errors);
1297 # have to mark it complete so it doesn't get used by something else
1298 return BSE::Template->get_refresh($url, $req->cfg);
1302 $order->set_complete(1);
1303 $order->set_stage("unprocessed");
1306 $class->_finish_order($req, $order);
1308 return BSE::Template->get_refresh($req->user_url(shop => 'orderdone'), $req->cfg);
1311 # do final processing of an order after payment
1313 my ($self, $req, $order) = @_;
1316 my $custom = custom_class($req->cfg);
1317 $custom->can("order_complete")
1318 and $custom->order_complete($req->cfg, $order);
1320 # set the order displayed by orderdone
1321 $req->session->{order_completed} = $order->{id};
1322 $req->session->{order_completed_at} = time;
1324 $self->_send_order($req, $order);
1326 my $cart = $req->cart;
1332 Display the order after the order is complete.
1340 C<order> - the new L<BSE::TB::Order> object.
1347 my ($class, $req) = @_;
1349 my $session = $req->session;
1350 my $cfg = $req->cfg;
1352 my $id = $session->{order_completed};
1353 my $when = $session->{order_completed_at};
1354 $id && defined $when && time < $when + 500
1355 or return $class->req_cart($req);
1357 my $order = BSE::TB::Orders->getByPkey($id)
1358 or return $class->req_cart($req);
1359 my @items = $order->items;
1360 my @products = map { BSE::TB::Products->getByPkey($_->{productId}) } @items;
1362 my @item_cols = BSE::TB::OrderItem->columns;
1363 my %copy_cols = map { $_ => 1 } BSE::TB::Product->columns;
1364 delete @copy_cols{@item_cols};
1365 my @copy_cols = keys %copy_cols;
1367 for my $item_index (0..$#items) {
1368 my $item = $items[$item_index];
1369 my $product = $products[$item_index];
1371 @entry{@item_cols} = @{$item}{@item_cols};
1372 @entry{@copy_cols} = @{$product}{@copy_cols};
1374 push @showitems, \%entry;
1377 my $cust_class = custom_class($req->cfg);
1379 my @pay_types = payment_types($cfg);
1380 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1381 my %pay_types = map { $_->{id} => $_ } @pay_types;
1382 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1384 my $item_index = -1;
1391 require BSE::Util::Iterate;
1392 my $it = BSE::Util::Iterate::Objects->new(cfg => $req->cfg);
1393 my $message = $req->message();
1397 $req->dyn_user_tags(),
1398 $cust_class->purchase_actions(\%acts, \@items, \@products,
1399 $session->{custom}, $cfg),
1400 BSE::Util::Tags->static(\%acts, $cfg),
1401 iterate_items_reset => sub { $item_index = -1; },
1404 if (++$item_index < @items) {
1406 @options = order_item_opts($req, $items[$item_index]);
1409 $item = $items[$item_index];
1410 $product = $products[$item_index];
1419 item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
1422 return tag_article($product, $cfg, $_[0]);
1426 my $what = $_[0] || 'retailPrice';
1427 $items[$item_index]{units} * $items[$item_index]{$what};
1429 order => sub { escape_html($order->{$_[0]}) },
1430 iterate_options_reset => sub { $option_index = -1 },
1431 iterate_options => sub { ++$option_index < @options },
1432 option => sub { escape_html($options[$option_index]{$_[0]}) },
1433 ifOptions => sub { @options },
1434 options => sub { nice_options(@options) },
1435 ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
1436 #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1437 session => [ \&tag_session, \$item, \$sem_session ],
1438 location => [ \&tag_location, \$item, \$location ],
1440 delivery_in => $order->{delivery_in},
1441 shipping_cost => $order->{shipping_cost},
1442 shipping_method => $order->{shipping_method},
1445 single => "orderpaidfile",
1446 plural => "orderpaidfiles",
1447 code => [ paid_files => $order ],
1450 for my $type (@pay_types) {
1451 my $id = $type->{id};
1452 my $name = $type->{name};
1453 $acts{"if${name}Payment"} = $order->{paymentType} == $id;
1456 $req->set_variable(order => $order);
1457 $req->set_variable(payment_types => \@pay_types);
1459 return $req->response('checkoutfinal', \%acts);
1463 my ($ritem, $rsession, $arg) = @_;
1465 $$ritem or return '';
1467 $$ritem->{session_id} or return '';
1469 unless ($$rsession) {
1470 require BSE::TB::SeminarSessions;
1471 $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
1475 my $value = $$rsession->{$arg};
1476 defined $value or return '';
1478 escape_html($value);
1482 my ($ritem, $rlocation, $arg) = @_;
1484 $$ritem or return '';
1486 $$ritem->{session_id} or return '';
1488 unless ($$rlocation) {
1489 require BSE::TB::Locations;
1490 ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
1494 my $value = $$rlocation->{$arg};
1495 defined $value or return '';
1497 escape_html($value);
1501 my ($payment, $types_by_name, $args) = @_;
1504 if ($type !~ /^\d+$/) {
1505 return '' unless exists $types_by_name->{$type};
1506 $type = $types_by_name->{$type};
1509 return $payment == $type;
1512 sub tag_paymentTypeId {
1513 my ($types_by_name, $args) = @_;
1515 if (exists $types_by_name->{$args}) {
1516 return $types_by_name->{$args};
1524 my ($class, $req, $rmsg) = @_;
1526 my $cfg = $req->cfg;
1527 my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1528 unless ($from && $from =~ /.\@./) {
1529 $$rmsg = "Configuration error: shop from address not set";
1532 my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1533 unless ($toEmail && $toEmail =~ /.\@./) {
1534 $$rmsg = "Configuration error: shop to_email address not set";
1542 my ($class, $req) = @_;
1544 $class->update_quantities($req);
1545 $req->session->{order_info_confirmed} = 0;
1547 my $refresh = $req->cgi->param('r');
1549 $refresh = $req->user_url(shop => 'cart');
1552 return $req->get_refresh($refresh);
1555 sub req_recalculate {
1556 my ($class, $req) = @_;
1558 return $class->req_recalc($req);
1562 my ($class, $req, $order) = @_;
1564 my $cfg = $req->cfg;
1565 my $cgi = $req->cgi;
1567 my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
1568 my $crypto_class = $cfg->entry('shop', 'crypt_module',
1569 $Constants::SHOP_CRYPTO);
1570 my $signing_id = $cfg->entry('shop', 'crypt_signing_id',
1571 $Constants::SHOP_SIGNING_ID);
1572 my $pgp = $cfg->entry('shop', 'crypt_pgp', $Constants::SHOP_PGP);
1573 my $pgpe = $cfg->entry('shop', 'crypt_pgpe', $Constants::SHOP_PGPE);
1574 my $gpg = $cfg->entry('shop', 'crypt_gpg', $Constants::SHOP_GPG);
1575 my $passphrase = $cfg->entry('shop', 'crypt_passphrase',
1576 $Constants::SHOP_PASSPHRASE);
1577 my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1578 my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
1579 my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1580 my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
1582 my $session = $req->session;
1583 my %extras = $cfg->entriesCS('extra tags');
1584 for my $key (keys %extras) {
1586 my $data = $cfg->entryVar('extra tags', $key);
1587 $extras{$key} = sub { $data };
1590 my @items = $order->items;
1591 my @products = map $_->product, @items;
1593 for my $product (@products) {
1594 my $sub = $product->subscription;
1596 $subscribing_to{$sub->{text_id}} = $sub;
1600 my $item_index = -1;
1608 ->order_mail_actions(\%acts, $order, \@items, \@products,
1609 $session->{custom}, $cfg),
1610 BSE::Util::Tags->mail_tags(),
1611 $order->mail_tags(),
1612 ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1620 my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
1621 require BSE::ComposeMail;
1623 unless ($noencrypt) {
1624 $acts{cardNumber} = $cgi->param('cardNumber');
1625 $acts{cardExpiry} = $cgi->param('cardExpiry');
1626 $acts{cardVerify} = $cgi->param('cardVerify');
1627 @vars{qw(cardNumber cardExpiry cardVerify)} =
1628 @acts{qw(cardNumber cardExpiry cardVerify)};
1631 my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1636 subject=>'New Order '.$order->{id},
1638 template => "mailorder",
1639 log_component => "shop:sendorder:mailowner",
1640 log_object => $order,
1641 log_msg => "Send Order No. $order->{id} to admin",
1645 unless ($noencrypt) {
1647 my $sign = $cfg->entryBool('basic', 'sign', 1);
1648 $sign or $crypt_opts{signing_id} = "";
1649 $crypt_opts{recipient} =
1650 $cfg->entry("shop", "crypt_recipient", "$toName $toEmail");
1651 $mailer->encrypt_body(%crypt_opts);
1654 unless ($mailer->done) {
1655 $req->flash_error("Could not mail order to admin: " . $mailer->errstr);
1658 delete @acts{qw/cardNumber cardExpiry cardVerify/};
1659 delete @vars{qw/cardNumber cardExpiry cardVerify/};
1661 my $to_email = $order->billEmail;
1662 my $user = $req->siteuser;
1664 if ($user && $user->email eq $to_email) {
1667 my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1672 subject => $subject . " " . localtime,
1673 template => "mailconfirm",
1675 log_component => "shop:sendorder:mailbuyer",
1676 log_object => $order,
1677 log_msg => "Send Order No. $order->{id} to customer ($to_email)",
1680 my $bcc_order = $cfg->entry("shop", "bcc_email");
1682 $opts{bcc} = $bcc_order;
1684 $mailer->send(%opts)
1685 or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1688 sub _refresh_logon {
1689 my ($class, $req, $msg, $msgid, $r, $parms) = @_;
1691 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1692 my $url = $securlbase."/cgi-bin/user.pl";
1693 $parms ||= { checkout => 1 };
1696 $r = $securlbase."/cgi-bin/shop.pl?"
1697 . join("&", map "$_=" . escape_uri($parms->{$_}), keys %$parms);
1701 if ($req->cfg->entry('shop registration', 'all')
1702 || $req->cfg->entry('shop registration', $msgid)) {
1703 $parms{show_register} = 1;
1707 $msg = $req->cfg->entry('messages', $msgid, $msg);
1709 $parms{m} = $msg if $msg;
1710 $parms{mid} = $msgid if $msgid;
1711 $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1713 return BSE::Template->get_refresh($url, $req->cfg);
1716 sub tag_checkedPayment {
1717 my ($payment, $types_by_name, $args) = @_;
1720 if ($type !~ /^\d+$/) {
1721 return '' unless exists $types_by_name->{$type};
1722 $type = $types_by_name->{$type};
1725 return $payment == $type ? 'checked="checked"' : '';
1728 sub tag_ifPayments {
1729 my ($enabled, $types_by_name, $args) = @_;
1732 if ($type !~ /^\d+$/) {
1733 return '' unless exists $types_by_name->{$type};
1734 $type = $types_by_name->{$type};
1737 my @found = grep $_ == $type, @$enabled;
1739 return scalar @found;
1742 sub update_quantities {
1743 my ($class, $req) = @_;
1745 # FIXME: should use the cart class to update quantities
1746 my $session = $req->session;
1747 my $cgi = $req->cgi;
1748 my $cfg = $req->cfg;
1749 my @cart = @{$session->{cart} || []};
1750 for my $index (0..$#cart) {
1751 my $new_quantity = $cgi->param("quantity_$index");
1752 if (defined $new_quantity) {
1753 if ($new_quantity =~ /^\s*(\d+)/) {
1754 $cart[$index]{units} = $1;
1756 elsif ($new_quantity =~ /^\s*$/) {
1757 $cart[$index]{units} = 0;
1761 @cart = grep { $_->{units} != 0 } @cart;
1762 $session->{cart} = \@cart;
1763 $session->{custom} ||= {};
1764 my %custom_state = %{$session->{custom}};
1765 custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1766 $session->{custom} = \%custom_state;
1768 my ($coupon) = $cgi->param("coupon");
1769 if (defined $coupon) {
1770 my $cart = $req->cart;
1771 $cart->set_coupon_code($coupon);
1776 my ($class, $req) = @_;
1778 my $session = $req->session;
1779 my $cart = $req->cart;
1783 my @cart = @{$req->session->{cart}}
1786 my @prodcols = BSE::TB::Product->columns;
1788 my $today = now_sqldate();
1789 for my $item ($cart->items) {
1791 my $product = $item->product;
1793 $product->is_released
1794 or do { push @msgs, "'$product->{title}' has not been released yet";
1796 $product->is_expired
1797 and do { push @msgs, "'$product->{title}' has expired"; next; };
1799 or do { push @msgs, "'$product->{title}' not available"; next; };
1801 for my $col (@prodcols) {
1802 $work{$col} = $product->$col() unless exists $work{$col};
1804 $work{price} = $product->price(user => scalar $req->siteuser);
1805 $work{extended_retailPrice} = $work{units} * $work{price};
1806 $work{extended_gst} = $work{units} * $work{gst};
1807 $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1809 push @newcart, \%work;
1813 # we don't use these for anything for now
1821 sub _fillout_order {
1822 my ($class, $req, $values, $rmsg, $how) = @_;
1824 my $session = $req->session;
1825 my $cfg = $req->cfg;
1826 my $cgi = $req->cgi;
1828 my $cart = $req->cart($how);
1830 if ($cart->is_empty) {
1831 $$rmsg = "Your cart is empty";
1835 # FIXME? this doesn't take discounting into effect
1836 $values->{gst} = $cart->gst;
1837 $values->{wholesaleTotal} = $cart->wholesaleTotal;
1839 my $items = $cart->items;
1840 my $products = $cart->products;
1841 my $prompt_ship = $cart->cfg_shipping;
1843 if (_any_physical_products($products)) {
1844 my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1845 my $country_code = bse_country_code($values->{delivCountry});
1847 unless ($courier->can_deliver(country => $country_code,
1848 suburb => $values->{delivSuburb},
1849 postcode => $values->{delivPostCode})) {
1850 $cgi->param("courier", undef);
1852 "Can't use the selected courier ".
1853 "(". $courier->description(). ") for this order.";
1856 my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1857 my $cost = $courier->calculate_shipping
1859 parcels => \@parcels,
1860 country => $country_code,
1861 suburb => $values->{delivSuburb},
1862 postcode => $values->{delivPostCode},
1863 products => $products,
1866 if (!defined $cost and $courier->name() ne 'contact') {
1867 my $err = $courier->error_message();
1868 $$rmsg = "Error calculating shipping cost";
1869 $$rmsg .= ": $err" if $err;
1872 $values->{shipping_method} = $courier->description();
1873 $values->{shipping_name} = $courier->name;
1874 $values->{shipping_cost} = $cost;
1875 $values->{shipping_trace} = $courier->trace;
1876 $values->{delivery_in} = $courier->delivery_in();
1880 $$rmsg = "Error: no usable courier found.";
1885 $values->{shipping_method} = "Nothing to ship!";
1886 $values->{shipping_name} = "none";
1887 $values->{shipping_cost} = 0;
1888 $values->{shipping_trace} = "All products have zero weight.";
1891 if ($cart->coupon_active) {
1892 $values->{coupon_id} = $cart->coupon->id;
1895 $values->{coupon_id} = undef;
1897 $cart->set_shipping_cost($values->{shipping_cost});
1898 $cart->set_shipping_method($values->{shipping_method});
1899 $cart->set_shipping_name($values->{shipping_name});
1900 $cart->set_delivery_in($values->{delivery_in});
1902 $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1903 $values->{total} = $cart->total;
1905 my $cust_class = custom_class($cfg);
1908 local $SIG{__DIE__};
1909 $session->{custom} = $cart->custom_state || {};
1910 my %custom = %{$session->{custom}};
1911 $cust_class->order_save($cgi, $values, $items, $items,
1913 $session->{custom} = \%custom;
1921 $cust_class->total_extras($items, $items,
1922 $session->{custom}, $cfg, $how);
1924 my $affiliate_code = $session->{affiliate_code};
1925 defined $affiliate_code && length $affiliate_code
1926 or $affiliate_code = $cgi->param('affiliate_code');
1927 defined $affiliate_code or $affiliate_code = '';
1928 $values->{affiliate_code} = $affiliate_code;
1930 my $user = $req->siteuser;
1932 $values->{userId} = $user->{userId};
1933 $values->{siteuser_id} = $user->{id};
1936 $values->{userId} = '';
1937 $values->{siteuser_id} = -1;
1940 $values->{orderDate} = now_sqldatetime;
1942 # this should be hard to guess
1943 $values->{randomId} = md5_hex(time().rand().{}.$$);
1948 sub action_prefix { '' }
1951 my ($class, $req) = @_;
1953 require BSE::TB::Locations;
1954 my $cgi = $req->cgi;
1955 my $location_id = $cgi->param('location_id');
1957 if (defined $location_id && $location_id =~ /^\d+$/) {
1958 $location = BSE::TB::Locations->getByPkey($location_id);
1962 BSE::Util::Tags->static(\%acts, $req->cfg),
1963 location => [ \&tag_hash, $location ],
1966 return $req->response('location', \%acts);
1971 type=>BSE::Template->get_type($req->cfg, 'error'),
1972 content=>"Missing or invalid location_id",
1977 sub _validate_add_by_id {
1978 my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1982 $product = BSE::TB::Seminars->getByPkey($addid);
1983 $product ||= BSE::TB::Products->getByPkey($addid);
1986 $$error = "Cannot find product $addid";
1990 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1993 sub _validate_add_by_code {
1994 my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
1997 if (defined $code) {
1998 $product = BSE::TB::Seminars->getBy(product_code => $code);
1999 $product ||= BSE::TB::Products->getBy(product_code => $code);
2002 $$error = "Cannot find product code $code";
2006 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2010 my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2012 # collect the product options
2014 my @option_descs = $product->option_descs($req->cfg);
2015 my @option_names = map $_->{name}, @option_descs;
2017 my $cgi = $req->cgi;
2018 for my $name (@option_names) {
2019 my $value = $cgi->param($name);
2020 push @options, $value;
2021 unless (defined $value) {
2022 push @not_def, $name;
2026 $$error = "Some product options (@not_def) not supplied";
2030 # the product must be non-expired and listed
2031 (my $comp_release = $product->{release}) =~ s/ .*//;
2032 (my $comp_expire = $product->{expire}) =~ s/ .*//;
2033 my $today = now_sqldate();
2034 unless ($comp_release le $today) {
2035 $$error = "Product $product->{title} has not been released yet";
2038 unless ($today le $comp_expire) {
2039 $$error = "Product $product->{title} has expired";
2042 unless ($product->{listed}) {
2043 $$error = "Product $product->{title} not available";
2047 # used to refresh if a logon is needed
2048 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2049 my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2050 for my $opt_index (0..$#option_names) {
2051 $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2054 my $user = $req->siteuser;
2055 # need to be logged on if it has any subs
2056 if ($product->{subscription_id} != -1) {
2058 my $sub = $product->subscription;
2059 if ($product->is_renew_sub_only) {
2060 unless ($user->subscribed_to_grace($sub)) {
2061 $$error = "The product $product->{title} can only be used to renew your subscription to $sub->{title} and you are not subscribed nor within the renewal grace period";
2065 elsif ($product->is_start_sub_only) {
2066 if ($user->subscribed_to_grace($sub)) {
2067 $$error = "The product $product->{title} can only be used to start your subscription to $sub->{title} and you are already subscribed or within the grace period";
2074 [ "You must be logged on to add this product to your cart",
2079 if ($product->{subscription_required} != -1) {
2080 my $sub = $product->subscription_required;
2082 unless ($user->subscribed_to($sub)) {
2083 $$error = "You must be subscribed to $sub->{title} to purchase this product";
2088 # we want to refresh back to adding the item to the cart if possible
2090 [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2091 'prodlogonsub', $r ];
2096 # we need a natural integer quantity
2097 unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2098 $$error = "Invalid quantity";
2103 if ($product->isa('BSE::TB::Seminar')) {
2104 # you must be logged on to add a seminar
2107 [ "You must be logged on to add seminars to your cart",
2108 'seminarlogon', $r ];
2112 # get and validate the session
2113 my $session_id = $cgi->param('session_id');
2114 unless (defined $session_id) {
2115 $$error = "Please select a session when adding a seminar";
2119 unless ($session_id =~ /^\d+$/) {
2120 $$error = "Invalid session_id supplied";
2124 require BSE::TB::SeminarSessions;
2125 my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2127 $$error = "Unknown session id supplied";
2130 unless ($session->{seminar_id} == $product->{id}) {
2131 $$error = "Session not for this seminar";
2135 # check if the user is already booked for this session
2136 if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2137 $$error = "You are already booked for this session";
2141 $extras{session_id} = $session_id;
2144 return ( $product, \@options, \%extras );
2148 my ($refresh, $req, $started_empty) = @_;
2150 my $cfg = $req->cfg;
2151 my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2152 if ($started_empty && !$cookie_domain) {
2153 my $base_url = $cfg->entryVar('site', 'url');
2154 my $secure_url = $cfg->entryVar('site', 'secureurl');
2155 if ($base_url ne $secure_url) {
2156 my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2158 # magical refresh time
2159 # which host are we on?
2160 # first get info about the 2 possible hosts
2161 my ($baseprot, $basehost, $baseport) =
2162 $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2163 $baseport ||= $baseprot eq 'http' ? 80 : 443;
2164 print STDERR "Base: prot: $baseprot Host: $basehost Port: $baseport\n"
2167 #my ($secprot, $sechost, $secport) =
2168 # $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2171 # get info about the current host
2172 my $port = $ENV{SERVER_PORT} || 80;
2173 my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2174 print STDERR "\$ishttps: $ishttps\n" if $debug;
2175 my $protocol = $ishttps ? 'https' : 'http';
2177 if (lc $ENV{SERVER_NAME} ne lc $basehost
2178 || lc $protocol ne $baseprot
2179 || $baseport != $port) {
2180 print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot' $baseport cmp $port\n" if $debug;
2183 my $base = $onbase ? $secure_url : $base_url;
2184 my $finalbase = $onbase ? $base_url : $secure_url;
2185 $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2186 my $sessionid = $req->session->{_session_id};
2187 require BSE::SessionSign;
2188 my $sig = BSE::SessionSign->make($sessionid);
2189 my $url = $cfg->user_url("user", undef,
2191 setcookie => $sessionid,
2194 print STDERR "Heading to $url to setcookie\n" if $debug;
2195 return $req->get_refresh($url);
2199 return $req->get_refresh($refresh);
2203 my ($left, $right) = @_;
2205 for my $index (0 .. $#$left) {
2206 my $left_value = $left->[$index];
2207 my $right_value = $right->[$index];
2208 defined $right_value
2210 $left_value eq $right_value
2218 my ($self, $req, $rmsg) = @_;
2220 my $id = $req->cgi->param("order");
2222 $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2225 my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2227 $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2236 Handles PayPal returning control.
2244 order - the randomId of the order
2248 token - paypal token we originally supplied to paypal. Supplied by
2253 PayerID - the paypal user who paid the order. Supplied by PayPal.
2260 my ($self, $req) = @_;
2262 require BSE::PayPal;
2263 BSE::PayPal->configured
2264 or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2267 my $order = $self->_paypal_order($req, \$msg)
2268 or return $self->req_show_payment($req, { _ => $msg });
2271 and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2273 unless (BSE::PayPal->pay_order(req => $req,
2276 return $self->req_show_payment($req, { _ => $msg });
2279 $self->_finish_order($req, $order);
2281 return $req->get_refresh($req->user_url(shop => "orderdone"));
2285 my ($self, $req) = @_;
2287 require BSE::PayPal;
2288 BSE::PayPal->configured
2289 or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2292 my $order = $self->_paypal_order($req, \$msg)
2293 or return $self->req_show_payment($req, { _ => $msg });
2295 $req->flash_notice("msg:bse/shop/paypal/cancelled");
2297 my $url = $req->user_url(shop => "show_payment");
2298 return $req->get_refresh($url);
2302 my ($self, $req) = @_;
2304 my $user = $req->siteuser
2307 my $cart = $req->session->{cart}
2310 for my $item (@$cart) {
2311 if (!$item->{user} || $item->{user} != $user->id) {
2312 my $product = BSE::TB::Products->getByPkey($item->{productId})
2314 my ($price, $tier) = $product->price(user => $user);
2315 $item->{price} = $price;
2316 $item->{tier} = $tier ? $tier->id : "";
2320 $req->session->{cart} = $cart;
2333 =item iterator ... items
2335 Iterates over the items in the shopping cart, setting the C<item> tag
2340 Retreives the given field from the item. This can include product
2341 fields for this item.
2345 The numeric index of the current item.
2347 =item extended [<field>]
2349 The "extended price", the product of the unit cost and the number of
2350 units for the current item in the cart. I<field> defaults to the
2351 price of the product.
2353 =item money I<which> <field>
2355 Formats the given field as a money value (without a currency symbol.)
2359 The number of items in the cart.
2363 Conditional tag, true if a registered user is logged in.
2367 Retrieved the given field from the currently logged in user, if any.
2371 =head2 Checkout tags
2373 This has the same tags as the L<Cart page>, and some extras:
2379 The total cost of all items in the cart.
2381 This will need to be formatted as a money value with the C<money> tag.
2385 An error message, if a validation error occurred.
2389 The previously entered value for I<field>. This should be used as the
2390 value for the various checkout fields, so that if a validation error
2391 occurs the user won't need to re-enter values.
2395 =head2 Completed order
2397 These tags are used in the F<checkoutfinal_base.tmpl>.
2403 =item product I<field>
2405 This is split out for these forms.
2407 =item order I<field>
2411 =item ifSubscribingTo I<subid>
2413 Can be used to check if this order is intended to be subscribing to a
2418 =head2 Mailed order tags
2420 These tags are used in the emails sent to the user to confirm an order
2421 and in the encrypted copy sent to the site administrator:
2427 C<iterate> ... C<items>
2429 Iterates over the items in the order.
2435 Access to the given field in the order item.
2441 Access to the product field for the current order item.
2447 Access to fields of the order.
2451 C<extended> I<field>
2453 The product of the I<field> in the current item and it's quantity.
2457 C<money> I<tag> I<parameters>
2459 Formats the given field as a money value.
2463 The mail generation template can use extra formatting specified with
2472 Format the value as a I<number> wide money value.
2478 Performs sprintf formatting on the value.
2484 Left justifies the value in a I<number> wide field.
2488 The order email sent to the site administrator has a couple of extra
2497 The credit card number of the user's credit card.
2503 The entered expiry date for the user's credit card.
2509 These names can be used with the <: order ... :> tag.
2511 Monetary values should typically be used with <:money order ...:>
2519 The order id or order number.
2523 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2524 delivPostCode, delivCountry - Delivery information for the order.
2528 billFirstName, billLastName, billStreet, billSuburb, billState,
2529 billPostCode, billCountry - Billing information for the order.
2533 telephone, facsimile, emailAddress - Contact information for the
2538 total - Total price of the order.
2542 wholesaleTotal - Wholesale cost of the total. Your costs, if you
2543 entered wholesale prices for the products.
2547 gst - GST (in Australia) payable on the order, if you entered GST for
2552 orderDate - When the order was made.
2556 filled - Whether or not the order has been filled. This can be used
2557 with the order_filled target in shopadmin.pl for tracking filled
2562 whenFilled - The time and date when the order was filled.
2566 whoFilled - The user who marked the order as filled.
2570 paidFor - Whether or not the order has been paid for. This can be
2571 used with a custom purchasing handler to mark the product as paid for.
2572 You can then filter the order list to only display paid for orders.
2576 paymentReceipt - A custom payment handler can fill this with receipt
2581 randomId - Generated by the prePurchase target, this can be used as a
2582 difficult to guess identifier for orders, when working with custom
2587 cancelled - This can be used by a custom payment handler to mark an
2588 order as cancelled if the user starts processing an order without
2593 =head2 Order item fields
2599 productId - The product id of this item.
2603 orderId - The order Id.
2607 units - The number of units for this item.
2611 price - The price paid for the product.
2615 wholesalePrice - The wholesale price for the product.
2619 gst - The gst for the product.
2623 options - A comma separated list of options specified for this item.
2624 These correspond to the option names in the product.
2630 New with 0.10_04 is the facility to set options for each product.
2632 The cart, checkout and checkoutfinal pages now include the following
2639 C<iterator> ... <options>
2641 within an item, iterates over the options for this item in the cart.
2648 Retrieves the given field from the option, possible field names are:
2654 id - The type/identifier for this option. eg. msize for a male
2655 clothing size field.
2659 value - The underlying value of the option, eg. XL.
2663 desc - The description of the field from the product options hash. If
2664 the description isn't defined this is the same as the id. eg. Size.
2668 label - The description of the value from the product options hash.
2675 ifOptions - A conditional tag, true if the current cart item has any
2680 options - A simple rendering of the options as a parenthesized
2681 comma-separated list.