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.051";
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_message;
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};
1810 if ($cart->coupon_active) {
1811 $work{product_discount} = $item->product_discount;
1812 $work{product_discount_units} = $item->product_discount_units;
1815 $work{product_discount} = 0;
1816 $work{product_discount_units} = 0;
1819 push @newcart, \%work;
1823 # we don't use these for anything for now
1831 sub _fillout_order {
1832 my ($class, $req, $values, $rmsg, $how) = @_;
1834 my $session = $req->session;
1835 my $cfg = $req->cfg;
1836 my $cgi = $req->cgi;
1838 my $cart = $req->cart($how);
1840 if ($cart->is_empty) {
1841 $$rmsg = "Your cart is empty";
1845 # FIXME? this doesn't take discounting into effect
1846 $values->{gst} = $cart->gst;
1847 $values->{wholesaleTotal} = $cart->wholesaleTotal;
1849 my $items = $cart->items;
1850 my $products = $cart->products;
1851 my $prompt_ship = $cart->cfg_shipping;
1853 if (_any_physical_products($products)) {
1854 my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1855 my $country_code = bse_country_code($values->{delivCountry});
1857 unless ($courier->can_deliver(country => $country_code,
1858 suburb => $values->{delivSuburb},
1859 postcode => $values->{delivPostCode})) {
1860 $cgi->param("courier", undef);
1862 "Can't use the selected courier ".
1863 "(". $courier->description(). ") for this order.";
1866 my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1867 my $cost = $courier->calculate_shipping
1869 parcels => \@parcels,
1870 country => $country_code,
1871 suburb => $values->{delivSuburb},
1872 postcode => $values->{delivPostCode},
1873 products => $products,
1876 if (!defined $cost and $courier->name() ne 'contact') {
1877 my $err = $courier->error_message();
1878 $$rmsg = "Error calculating shipping cost";
1879 $$rmsg .= ": $err" if $err;
1882 $values->{shipping_method} = $courier->description();
1883 $values->{shipping_name} = $courier->name;
1884 $values->{shipping_cost} = $cost;
1885 $values->{shipping_trace} = $courier->trace;
1886 $values->{delivery_in} = $courier->delivery_in();
1890 $$rmsg = "Error: no usable courier found.";
1895 $values->{shipping_method} = "Nothing to ship!";
1896 $values->{shipping_name} = "none";
1897 $values->{shipping_cost} = 0;
1898 $values->{shipping_trace} = "All products have zero weight.";
1901 if ($cart->coupon_active) {
1902 $values->{coupon_id} = $cart->coupon->id;
1903 $values->{coupon_description} = $cart->coupon_description;
1904 $values->{coupon_cart_wide} = $cart->coupon_cart_wide;
1907 $values->{coupon_id} = undef;
1908 $values->{coupon_description} = "";
1909 $values->{coupon_cart_wide} = 0;
1911 $cart->set_shipping_cost($values->{shipping_cost});
1912 $cart->set_shipping_method($values->{shipping_method});
1913 $cart->set_shipping_name($values->{shipping_name});
1914 $cart->set_delivery_in($values->{delivery_in});
1916 $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1917 $values->{product_cost_discount} = $cart->product_cost_discount;
1918 $values->{total} = $cart->total;
1920 my $cust_class = custom_class($cfg);
1923 local $SIG{__DIE__};
1924 $session->{custom} = $cart->custom_state || {};
1925 my %custom = %{$session->{custom}};
1926 $cust_class->order_save($cgi, $values, $items, $items,
1928 $session->{custom} = \%custom;
1936 $cust_class->total_extras($items, $items,
1937 $session->{custom}, $cfg, $how);
1939 my $affiliate_code = $session->{affiliate_code};
1940 defined $affiliate_code && length $affiliate_code
1941 or $affiliate_code = $cgi->param('affiliate_code');
1942 defined $affiliate_code or $affiliate_code = '';
1943 $values->{affiliate_code} = $affiliate_code;
1945 my $user = $req->siteuser;
1947 $values->{userId} = $user->{userId};
1948 $values->{siteuser_id} = $user->{id};
1951 $values->{userId} = '';
1952 $values->{siteuser_id} = -1;
1955 $values->{orderDate} = now_sqldatetime;
1957 # this should be hard to guess
1958 $values->{randomId} = md5_hex(time().rand().{}.$$);
1963 sub action_prefix { '' }
1966 my ($class, $req) = @_;
1968 require BSE::TB::Locations;
1969 my $cgi = $req->cgi;
1970 my $location_id = $cgi->param('location_id');
1972 if (defined $location_id && $location_id =~ /^\d+$/) {
1973 $location = BSE::TB::Locations->getByPkey($location_id);
1977 BSE::Util::Tags->static(\%acts, $req->cfg),
1978 location => [ \&tag_hash, $location ],
1981 return $req->response('location', \%acts);
1986 type=>BSE::Template->get_type($req->cfg, 'error'),
1987 content=>"Missing or invalid location_id",
1992 sub _validate_add_by_id {
1993 my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1997 $product = BSE::TB::Seminars->getByPkey($addid);
1998 $product ||= BSE::TB::Products->getByPkey($addid);
2001 $$error = "Cannot find product $addid";
2005 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2008 sub _validate_add_by_code {
2009 my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
2012 if (defined $code) {
2013 $product = BSE::TB::Seminars->getBy(product_code => $code);
2014 $product ||= BSE::TB::Products->getBy(product_code => $code);
2017 $$error = "Cannot find product code $code";
2021 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2025 my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2027 # collect the product options
2029 my @option_descs = $product->option_descs($req->cfg);
2030 my @option_names = map $_->{name}, @option_descs;
2032 my $cgi = $req->cgi;
2033 for my $name (@option_names) {
2034 my $value = $cgi->param($name);
2035 push @options, $value;
2036 unless (defined $value) {
2037 push @not_def, $name;
2041 $$error = "Some product options (@not_def) not supplied";
2045 # the product must be non-expired and listed
2046 (my $comp_release = $product->{release}) =~ s/ .*//;
2047 (my $comp_expire = $product->{expire}) =~ s/ .*//;
2048 my $today = now_sqldate();
2049 unless ($comp_release le $today) {
2050 $$error = "Product $product->{title} has not been released yet";
2053 unless ($today le $comp_expire) {
2054 $$error = "Product $product->{title} has expired";
2057 unless ($product->{listed}) {
2058 $$error = "Product $product->{title} not available";
2062 # used to refresh if a logon is needed
2063 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2064 my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2065 for my $opt_index (0..$#option_names) {
2066 $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2069 my $user = $req->siteuser;
2070 # need to be logged on if it has any subs
2071 if ($product->{subscription_id} != -1) {
2073 my $sub = $product->subscription;
2074 if ($product->is_renew_sub_only) {
2075 unless ($user->subscribed_to_grace($sub)) {
2076 $$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";
2080 elsif ($product->is_start_sub_only) {
2081 if ($user->subscribed_to_grace($sub)) {
2082 $$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";
2089 [ "You must be logged on to add this product to your cart",
2094 if ($product->{subscription_required} != -1) {
2095 my $sub = $product->subscription_required;
2097 unless ($user->subscribed_to($sub)) {
2098 $$error = "You must be subscribed to $sub->{title} to purchase this product";
2103 # we want to refresh back to adding the item to the cart if possible
2105 [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2106 'prodlogonsub', $r ];
2111 # we need a natural integer quantity
2112 unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2113 $$error = "Invalid quantity";
2118 if ($product->isa('BSE::TB::Seminar')) {
2119 # you must be logged on to add a seminar
2122 [ "You must be logged on to add seminars to your cart",
2123 'seminarlogon', $r ];
2127 # get and validate the session
2128 my $session_id = $cgi->param('session_id');
2129 unless (defined $session_id) {
2130 $$error = "Please select a session when adding a seminar";
2134 unless ($session_id =~ /^\d+$/) {
2135 $$error = "Invalid session_id supplied";
2139 require BSE::TB::SeminarSessions;
2140 my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2142 $$error = "Unknown session id supplied";
2145 unless ($session->{seminar_id} == $product->{id}) {
2146 $$error = "Session not for this seminar";
2150 # check if the user is already booked for this session
2151 if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2152 $$error = "You are already booked for this session";
2156 $extras{session_id} = $session_id;
2159 return ( $product, \@options, \%extras );
2163 my ($refresh, $req, $started_empty) = @_;
2165 my $cfg = $req->cfg;
2166 my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2167 if ($started_empty && !$cookie_domain) {
2168 my $base_url = $cfg->entryVar('site', 'url');
2169 my $secure_url = $cfg->entryVar('site', 'secureurl');
2170 if ($base_url ne $secure_url) {
2171 my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2173 # magical refresh time
2174 # which host are we on?
2175 # first get info about the 2 possible hosts
2176 my ($baseprot, $basehost, $baseport) =
2177 $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2178 $baseport ||= $baseprot eq 'http' ? 80 : 443;
2179 print STDERR "Base: prot: $baseprot Host: $basehost Port: $baseport\n"
2182 #my ($secprot, $sechost, $secport) =
2183 # $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2186 # get info about the current host
2187 my $port = $ENV{SERVER_PORT} || 80;
2188 my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2189 print STDERR "\$ishttps: $ishttps\n" if $debug;
2190 my $protocol = $ishttps ? 'https' : 'http';
2192 if (lc $ENV{SERVER_NAME} ne lc $basehost
2193 || lc $protocol ne $baseprot
2194 || $baseport != $port) {
2195 print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot' $baseport cmp $port\n" if $debug;
2198 my $base = $onbase ? $secure_url : $base_url;
2199 my $finalbase = $onbase ? $base_url : $secure_url;
2200 $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2201 my $sessionid = $req->session->{_session_id};
2202 require BSE::SessionSign;
2203 my $sig = BSE::SessionSign->make($sessionid);
2204 my $url = $cfg->user_url("user", undef,
2206 setcookie => $sessionid,
2209 print STDERR "Heading to $url to setcookie\n" if $debug;
2210 return $req->get_refresh($url);
2214 return $req->get_refresh($refresh);
2218 my ($left, $right) = @_;
2220 for my $index (0 .. $#$left) {
2221 my $left_value = $left->[$index];
2222 my $right_value = $right->[$index];
2223 defined $right_value
2225 $left_value eq $right_value
2233 my ($self, $req, $rmsg) = @_;
2235 my $id = $req->cgi->param("order");
2237 $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2240 my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2242 $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2251 Handles PayPal returning control.
2259 order - the randomId of the order
2263 token - paypal token we originally supplied to paypal. Supplied by
2268 PayerID - the paypal user who paid the order. Supplied by PayPal.
2275 my ($self, $req) = @_;
2277 require BSE::PayPal;
2278 BSE::PayPal->configured
2279 or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2282 my $order = $self->_paypal_order($req, \$msg)
2283 or return $self->req_show_payment($req, { _ => $msg });
2286 and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2288 unless (BSE::PayPal->pay_order(req => $req,
2291 return $self->req_show_payment($req, { _ => $msg });
2294 $self->_finish_order($req, $order);
2296 return $req->get_refresh($req->user_url(shop => "orderdone"));
2300 my ($self, $req) = @_;
2302 require BSE::PayPal;
2303 BSE::PayPal->configured
2304 or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2307 my $order = $self->_paypal_order($req, \$msg)
2308 or return $self->req_show_payment($req, { _ => $msg });
2310 $req->flash_notice("msg:bse/shop/paypal/cancelled");
2312 my $url = $req->user_url(shop => "show_payment");
2313 return $req->get_refresh($url);
2317 my ($self, $req) = @_;
2319 my $user = $req->siteuser
2322 my $cart = $req->session->{cart}
2325 for my $item (@$cart) {
2326 if (!$item->{user} || $item->{user} != $user->id) {
2327 my $product = BSE::TB::Products->getByPkey($item->{productId})
2329 my ($price, $tier) = $product->price(user => $user);
2330 $item->{price} = $price;
2331 $item->{tier} = $tier ? $tier->id : "";
2335 $req->session->{cart} = $cart;
2348 =item iterator ... items
2350 Iterates over the items in the shopping cart, setting the C<item> tag
2355 Retreives the given field from the item. This can include product
2356 fields for this item.
2360 The numeric index of the current item.
2362 =item extended [<field>]
2364 The "extended price", the product of the unit cost and the number of
2365 units for the current item in the cart. I<field> defaults to the
2366 price of the product.
2368 =item money I<which> <field>
2370 Formats the given field as a money value (without a currency symbol.)
2374 The number of items in the cart.
2378 Conditional tag, true if a registered user is logged in.
2382 Retrieved the given field from the currently logged in user, if any.
2386 =head2 Checkout tags
2388 This has the same tags as the L<Cart page>, and some extras:
2394 The total cost of all items in the cart.
2396 This will need to be formatted as a money value with the C<money> tag.
2400 An error message, if a validation error occurred.
2404 The previously entered value for I<field>. This should be used as the
2405 value for the various checkout fields, so that if a validation error
2406 occurs the user won't need to re-enter values.
2410 =head2 Completed order
2412 These tags are used in the F<checkoutfinal_base.tmpl>.
2418 =item product I<field>
2420 This is split out for these forms.
2422 =item order I<field>
2426 =item ifSubscribingTo I<subid>
2428 Can be used to check if this order is intended to be subscribing to a
2433 =head2 Mailed order tags
2435 These tags are used in the emails sent to the user to confirm an order
2436 and in the encrypted copy sent to the site administrator:
2442 C<iterate> ... C<items>
2444 Iterates over the items in the order.
2450 Access to the given field in the order item.
2456 Access to the product field for the current order item.
2462 Access to fields of the order.
2466 C<extended> I<field>
2468 The product of the I<field> in the current item and it's quantity.
2472 C<money> I<tag> I<parameters>
2474 Formats the given field as a money value.
2478 The mail generation template can use extra formatting specified with
2487 Format the value as a I<number> wide money value.
2493 Performs sprintf formatting on the value.
2499 Left justifies the value in a I<number> wide field.
2503 The order email sent to the site administrator has a couple of extra
2512 The credit card number of the user's credit card.
2518 The entered expiry date for the user's credit card.
2524 These names can be used with the <: order ... :> tag.
2526 Monetary values should typically be used with <:money order ...:>
2534 The order id or order number.
2538 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2539 delivPostCode, delivCountry - Delivery information for the order.
2543 billFirstName, billLastName, billStreet, billSuburb, billState,
2544 billPostCode, billCountry - Billing information for the order.
2548 telephone, facsimile, emailAddress - Contact information for the
2553 total - Total price of the order.
2557 wholesaleTotal - Wholesale cost of the total. Your costs, if you
2558 entered wholesale prices for the products.
2562 gst - GST (in Australia) payable on the order, if you entered GST for
2567 orderDate - When the order was made.
2571 filled - Whether or not the order has been filled. This can be used
2572 with the order_filled target in shopadmin.pl for tracking filled
2577 whenFilled - The time and date when the order was filled.
2581 whoFilled - The user who marked the order as filled.
2585 paidFor - Whether or not the order has been paid for. This can be
2586 used with a custom purchasing handler to mark the product as paid for.
2587 You can then filter the order list to only display paid for orders.
2591 paymentReceipt - A custom payment handler can fill this with receipt
2596 randomId - Generated by the prePurchase target, this can be used as a
2597 difficult to guess identifier for orders, when working with custom
2602 cancelled - This can be used by a custom payment handler to mark an
2603 order as cancelled if the user starts processing an order without
2608 =head2 Order item fields
2614 productId - The product id of this item.
2618 orderId - The order Id.
2622 units - The number of units for this item.
2626 price - The price paid for the product.
2630 wholesalePrice - The wholesale price for the product.
2634 gst - The gst for the product.
2638 options - A comma separated list of options specified for this item.
2639 These correspond to the option names in the product.
2645 New with 0.10_04 is the facility to set options for each product.
2647 The cart, checkout and checkoutfinal pages now include the following
2654 C<iterator> ... <options>
2656 within an item, iterates over the options for this item in the cart.
2663 Retrieves the given field from the option, possible field names are:
2669 id - The type/identifier for this option. eg. msize for a male
2670 clothing size field.
2674 value - The underlying value of the option, eg. XL.
2678 desc - The description of the field from the product options hash. If
2679 the description isn't defined this is the same as the id. eg. Size.
2683 label - The description of the value from the product options hash.
2690 ifOptions - A conditional tag, true if the current cart item has any
2695 options - A simple rendering of the options as a parenthesized
2696 comma-separated list.