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.049";
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 my ($price, $tier) = $product->price(user => scalar $req->siteuser);
1805 $work{price} = $price;
1806 $work{tier_id} = $tier ? $tier->id : undef;
1807 $work{extended_retailPrice} = $work{units} * $work{price};
1808 $work{extended_gst} = $work{units} * $work{gst};
1809 $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1811 push @newcart, \%work;
1815 # we don't use these for anything for now
1823 sub _fillout_order {
1824 my ($class, $req, $values, $rmsg, $how) = @_;
1826 my $session = $req->session;
1827 my $cfg = $req->cfg;
1828 my $cgi = $req->cgi;
1830 my $cart = $req->cart($how);
1832 if ($cart->is_empty) {
1833 $$rmsg = "Your cart is empty";
1837 # FIXME? this doesn't take discounting into effect
1838 $values->{gst} = $cart->gst;
1839 $values->{wholesaleTotal} = $cart->wholesaleTotal;
1841 my $items = $cart->items;
1842 my $products = $cart->products;
1843 my $prompt_ship = $cart->cfg_shipping;
1845 if (_any_physical_products($products)) {
1846 my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1847 my $country_code = bse_country_code($values->{delivCountry});
1849 unless ($courier->can_deliver(country => $country_code,
1850 suburb => $values->{delivSuburb},
1851 postcode => $values->{delivPostCode})) {
1852 $cgi->param("courier", undef);
1854 "Can't use the selected courier ".
1855 "(". $courier->description(). ") for this order.";
1858 my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1859 my $cost = $courier->calculate_shipping
1861 parcels => \@parcels,
1862 country => $country_code,
1863 suburb => $values->{delivSuburb},
1864 postcode => $values->{delivPostCode},
1865 products => $products,
1868 if (!defined $cost and $courier->name() ne 'contact') {
1869 my $err = $courier->error_message();
1870 $$rmsg = "Error calculating shipping cost";
1871 $$rmsg .= ": $err" if $err;
1874 $values->{shipping_method} = $courier->description();
1875 $values->{shipping_name} = $courier->name;
1876 $values->{shipping_cost} = $cost;
1877 $values->{shipping_trace} = $courier->trace;
1878 $values->{delivery_in} = $courier->delivery_in();
1882 $$rmsg = "Error: no usable courier found.";
1887 $values->{shipping_method} = "Nothing to ship!";
1888 $values->{shipping_name} = "none";
1889 $values->{shipping_cost} = 0;
1890 $values->{shipping_trace} = "All products have zero weight.";
1893 if ($cart->coupon_active) {
1894 $values->{coupon_id} = $cart->coupon->id;
1897 $values->{coupon_id} = undef;
1899 $cart->set_shipping_cost($values->{shipping_cost});
1900 $cart->set_shipping_method($values->{shipping_method});
1901 $cart->set_shipping_name($values->{shipping_name});
1902 $cart->set_delivery_in($values->{delivery_in});
1904 $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1905 $values->{total} = $cart->total;
1907 my $cust_class = custom_class($cfg);
1910 local $SIG{__DIE__};
1911 $session->{custom} = $cart->custom_state || {};
1912 my %custom = %{$session->{custom}};
1913 $cust_class->order_save($cgi, $values, $items, $items,
1915 $session->{custom} = \%custom;
1923 $cust_class->total_extras($items, $items,
1924 $session->{custom}, $cfg, $how);
1926 my $affiliate_code = $session->{affiliate_code};
1927 defined $affiliate_code && length $affiliate_code
1928 or $affiliate_code = $cgi->param('affiliate_code');
1929 defined $affiliate_code or $affiliate_code = '';
1930 $values->{affiliate_code} = $affiliate_code;
1932 my $user = $req->siteuser;
1934 $values->{userId} = $user->{userId};
1935 $values->{siteuser_id} = $user->{id};
1938 $values->{userId} = '';
1939 $values->{siteuser_id} = -1;
1942 $values->{orderDate} = now_sqldatetime;
1944 # this should be hard to guess
1945 $values->{randomId} = md5_hex(time().rand().{}.$$);
1950 sub action_prefix { '' }
1953 my ($class, $req) = @_;
1955 require BSE::TB::Locations;
1956 my $cgi = $req->cgi;
1957 my $location_id = $cgi->param('location_id');
1959 if (defined $location_id && $location_id =~ /^\d+$/) {
1960 $location = BSE::TB::Locations->getByPkey($location_id);
1964 BSE::Util::Tags->static(\%acts, $req->cfg),
1965 location => [ \&tag_hash, $location ],
1968 return $req->response('location', \%acts);
1973 type=>BSE::Template->get_type($req->cfg, 'error'),
1974 content=>"Missing or invalid location_id",
1979 sub _validate_add_by_id {
1980 my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1984 $product = BSE::TB::Seminars->getByPkey($addid);
1985 $product ||= BSE::TB::Products->getByPkey($addid);
1988 $$error = "Cannot find product $addid";
1992 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1995 sub _validate_add_by_code {
1996 my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
1999 if (defined $code) {
2000 $product = BSE::TB::Seminars->getBy(product_code => $code);
2001 $product ||= BSE::TB::Products->getBy(product_code => $code);
2004 $$error = "Cannot find product code $code";
2008 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2012 my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2014 # collect the product options
2016 my @option_descs = $product->option_descs($req->cfg);
2017 my @option_names = map $_->{name}, @option_descs;
2019 my $cgi = $req->cgi;
2020 for my $name (@option_names) {
2021 my $value = $cgi->param($name);
2022 push @options, $value;
2023 unless (defined $value) {
2024 push @not_def, $name;
2028 $$error = "Some product options (@not_def) not supplied";
2032 # the product must be non-expired and listed
2033 (my $comp_release = $product->{release}) =~ s/ .*//;
2034 (my $comp_expire = $product->{expire}) =~ s/ .*//;
2035 my $today = now_sqldate();
2036 unless ($comp_release le $today) {
2037 $$error = "Product $product->{title} has not been released yet";
2040 unless ($today le $comp_expire) {
2041 $$error = "Product $product->{title} has expired";
2044 unless ($product->{listed}) {
2045 $$error = "Product $product->{title} not available";
2049 # used to refresh if a logon is needed
2050 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2051 my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2052 for my $opt_index (0..$#option_names) {
2053 $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2056 my $user = $req->siteuser;
2057 # need to be logged on if it has any subs
2058 if ($product->{subscription_id} != -1) {
2060 my $sub = $product->subscription;
2061 if ($product->is_renew_sub_only) {
2062 unless ($user->subscribed_to_grace($sub)) {
2063 $$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";
2067 elsif ($product->is_start_sub_only) {
2068 if ($user->subscribed_to_grace($sub)) {
2069 $$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";
2076 [ "You must be logged on to add this product to your cart",
2081 if ($product->{subscription_required} != -1) {
2082 my $sub = $product->subscription_required;
2084 unless ($user->subscribed_to($sub)) {
2085 $$error = "You must be subscribed to $sub->{title} to purchase this product";
2090 # we want to refresh back to adding the item to the cart if possible
2092 [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2093 'prodlogonsub', $r ];
2098 # we need a natural integer quantity
2099 unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2100 $$error = "Invalid quantity";
2105 if ($product->isa('BSE::TB::Seminar')) {
2106 # you must be logged on to add a seminar
2109 [ "You must be logged on to add seminars to your cart",
2110 'seminarlogon', $r ];
2114 # get and validate the session
2115 my $session_id = $cgi->param('session_id');
2116 unless (defined $session_id) {
2117 $$error = "Please select a session when adding a seminar";
2121 unless ($session_id =~ /^\d+$/) {
2122 $$error = "Invalid session_id supplied";
2126 require BSE::TB::SeminarSessions;
2127 my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2129 $$error = "Unknown session id supplied";
2132 unless ($session->{seminar_id} == $product->{id}) {
2133 $$error = "Session not for this seminar";
2137 # check if the user is already booked for this session
2138 if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2139 $$error = "You are already booked for this session";
2143 $extras{session_id} = $session_id;
2146 return ( $product, \@options, \%extras );
2150 my ($refresh, $req, $started_empty) = @_;
2152 my $cfg = $req->cfg;
2153 my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2154 if ($started_empty && !$cookie_domain) {
2155 my $base_url = $cfg->entryVar('site', 'url');
2156 my $secure_url = $cfg->entryVar('site', 'secureurl');
2157 if ($base_url ne $secure_url) {
2158 my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2160 # magical refresh time
2161 # which host are we on?
2162 # first get info about the 2 possible hosts
2163 my ($baseprot, $basehost, $baseport) =
2164 $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2165 $baseport ||= $baseprot eq 'http' ? 80 : 443;
2166 print STDERR "Base: prot: $baseprot Host: $basehost Port: $baseport\n"
2169 #my ($secprot, $sechost, $secport) =
2170 # $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2173 # get info about the current host
2174 my $port = $ENV{SERVER_PORT} || 80;
2175 my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2176 print STDERR "\$ishttps: $ishttps\n" if $debug;
2177 my $protocol = $ishttps ? 'https' : 'http';
2179 if (lc $ENV{SERVER_NAME} ne lc $basehost
2180 || lc $protocol ne $baseprot
2181 || $baseport != $port) {
2182 print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot' $baseport cmp $port\n" if $debug;
2185 my $base = $onbase ? $secure_url : $base_url;
2186 my $finalbase = $onbase ? $base_url : $secure_url;
2187 $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2188 my $sessionid = $req->session->{_session_id};
2189 require BSE::SessionSign;
2190 my $sig = BSE::SessionSign->make($sessionid);
2191 my $url = $cfg->user_url("user", undef,
2193 setcookie => $sessionid,
2196 print STDERR "Heading to $url to setcookie\n" if $debug;
2197 return $req->get_refresh($url);
2201 return $req->get_refresh($refresh);
2205 my ($left, $right) = @_;
2207 for my $index (0 .. $#$left) {
2208 my $left_value = $left->[$index];
2209 my $right_value = $right->[$index];
2210 defined $right_value
2212 $left_value eq $right_value
2220 my ($self, $req, $rmsg) = @_;
2222 my $id = $req->cgi->param("order");
2224 $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2227 my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2229 $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2238 Handles PayPal returning control.
2246 order - the randomId of the order
2250 token - paypal token we originally supplied to paypal. Supplied by
2255 PayerID - the paypal user who paid the order. Supplied by PayPal.
2262 my ($self, $req) = @_;
2264 require BSE::PayPal;
2265 BSE::PayPal->configured
2266 or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2269 my $order = $self->_paypal_order($req, \$msg)
2270 or return $self->req_show_payment($req, { _ => $msg });
2273 and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2275 unless (BSE::PayPal->pay_order(req => $req,
2278 return $self->req_show_payment($req, { _ => $msg });
2281 $self->_finish_order($req, $order);
2283 return $req->get_refresh($req->user_url(shop => "orderdone"));
2287 my ($self, $req) = @_;
2289 require BSE::PayPal;
2290 BSE::PayPal->configured
2291 or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2294 my $order = $self->_paypal_order($req, \$msg)
2295 or return $self->req_show_payment($req, { _ => $msg });
2297 $req->flash_notice("msg:bse/shop/paypal/cancelled");
2299 my $url = $req->user_url(shop => "show_payment");
2300 return $req->get_refresh($url);
2304 my ($self, $req) = @_;
2306 my $user = $req->siteuser
2309 my $cart = $req->session->{cart}
2312 for my $item (@$cart) {
2313 if (!$item->{user} || $item->{user} != $user->id) {
2314 my $product = BSE::TB::Products->getByPkey($item->{productId})
2316 my ($price, $tier) = $product->price(user => $user);
2317 $item->{price} = $price;
2318 $item->{tier} = $tier ? $tier->id : "";
2322 $req->session->{cart} = $cart;
2335 =item iterator ... items
2337 Iterates over the items in the shopping cart, setting the C<item> tag
2342 Retreives the given field from the item. This can include product
2343 fields for this item.
2347 The numeric index of the current item.
2349 =item extended [<field>]
2351 The "extended price", the product of the unit cost and the number of
2352 units for the current item in the cart. I<field> defaults to the
2353 price of the product.
2355 =item money I<which> <field>
2357 Formats the given field as a money value (without a currency symbol.)
2361 The number of items in the cart.
2365 Conditional tag, true if a registered user is logged in.
2369 Retrieved the given field from the currently logged in user, if any.
2373 =head2 Checkout tags
2375 This has the same tags as the L<Cart page>, and some extras:
2381 The total cost of all items in the cart.
2383 This will need to be formatted as a money value with the C<money> tag.
2387 An error message, if a validation error occurred.
2391 The previously entered value for I<field>. This should be used as the
2392 value for the various checkout fields, so that if a validation error
2393 occurs the user won't need to re-enter values.
2397 =head2 Completed order
2399 These tags are used in the F<checkoutfinal_base.tmpl>.
2405 =item product I<field>
2407 This is split out for these forms.
2409 =item order I<field>
2413 =item ifSubscribingTo I<subid>
2415 Can be used to check if this order is intended to be subscribing to a
2420 =head2 Mailed order tags
2422 These tags are used in the emails sent to the user to confirm an order
2423 and in the encrypted copy sent to the site administrator:
2429 C<iterate> ... C<items>
2431 Iterates over the items in the order.
2437 Access to the given field in the order item.
2443 Access to the product field for the current order item.
2449 Access to fields of the order.
2453 C<extended> I<field>
2455 The product of the I<field> in the current item and it's quantity.
2459 C<money> I<tag> I<parameters>
2461 Formats the given field as a money value.
2465 The mail generation template can use extra formatting specified with
2474 Format the value as a I<number> wide money value.
2480 Performs sprintf formatting on the value.
2486 Left justifies the value in a I<number> wide field.
2490 The order email sent to the site administrator has a couple of extra
2499 The credit card number of the user's credit card.
2505 The entered expiry date for the user's credit card.
2511 These names can be used with the <: order ... :> tag.
2513 Monetary values should typically be used with <:money order ...:>
2521 The order id or order number.
2525 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2526 delivPostCode, delivCountry - Delivery information for the order.
2530 billFirstName, billLastName, billStreet, billSuburb, billState,
2531 billPostCode, billCountry - Billing information for the order.
2535 telephone, facsimile, emailAddress - Contact information for the
2540 total - Total price of the order.
2544 wholesaleTotal - Wholesale cost of the total. Your costs, if you
2545 entered wholesale prices for the products.
2549 gst - GST (in Australia) payable on the order, if you entered GST for
2554 orderDate - When the order was made.
2558 filled - Whether or not the order has been filled. This can be used
2559 with the order_filled target in shopadmin.pl for tracking filled
2564 whenFilled - The time and date when the order was filled.
2568 whoFilled - The user who marked the order as filled.
2572 paidFor - Whether or not the order has been paid for. This can be
2573 used with a custom purchasing handler to mark the product as paid for.
2574 You can then filter the order list to only display paid for orders.
2578 paymentReceipt - A custom payment handler can fill this with receipt
2583 randomId - Generated by the prePurchase target, this can be used as a
2584 difficult to guess identifier for orders, when working with custom
2589 cancelled - This can be used by a custom payment handler to mark an
2590 order as cancelled if the user starts processing an order without
2595 =head2 Order item fields
2601 productId - The product id of this item.
2605 orderId - The order Id.
2609 units - The number of units for this item.
2613 price - The price paid for the product.
2617 wholesalePrice - The wholesale price for the product.
2621 gst - The gst for the product.
2625 options - A comma separated list of options specified for this item.
2626 These correspond to the option names in the product.
2632 New with 0.10_04 is the facility to set options for each product.
2634 The cart, checkout and checkoutfinal pages now include the following
2641 C<iterator> ... <options>
2643 within an item, iterates over the options for this item in the cart.
2650 Retrieves the given field from the option, possible field names are:
2656 id - The type/identifier for this option. eg. msize for a male
2657 clothing size field.
2661 value - The underlying value of the option, eg. XL.
2665 desc - The description of the field from the product options hash. If
2666 the description isn't defined this is the same as the id. eg. Size.
2670 label - The description of the value from the product options hash.
2677 ifOptions - A conditional tag, true if the current cart item has any
2682 options - A simple rendering of the options as a parenthesized
2683 comma-separated list.