add some support for customizing product options
[bse.git] / site / cgi-bin / modules / BSE / UI / Shop.pm
1 package BSE::UI::Shop;
2 use strict;
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);
9 use BSE::TB::Orders;
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';
16 use BSE::Shipping;
17 use BSE::Countries qw(bse_country_code);
18 use BSE::Util::Secure qw(make_secret);
19 use BSE::Template;
20
21 our $VERSION = "1.052";
22
23 =head1 NAME
24
25 BSE::UI::Shop - implements the shop for BSE
26
27 =head1 DESCRIPTION
28
29 BSE::UI::Shop implements the shop for BSE.
30
31 =head1 TARGETS
32
33 =over
34
35 =cut
36
37 use constant MSG_SHOP_CART_FULL => 'Your shopping cart is full, please remove an item and try adding an item again';
38
39 my %actions =
40   (
41    add => 1,
42    addmultiple => 1,
43    cart => 1,
44    checkout => 1,
45    checkupdate => 1,
46    recheckout => 1,
47    recalc=>1,
48    recalculate => 1,
49    #purchase => 1,
50    order => 1,
51    show_payment => 1,
52    payment => 1,
53    orderdone => 1,
54    location => 1,
55    paypalret => 1,
56    paypalcan => 1,
57    emptycart => 1,
58   );
59
60 # map of SiteUser field names to order field names - mostly
61 my %field_map = 
62   (
63    name1 => 'billFirstName',
64    name2 => 'billLastName',
65    street => 'billStreet',
66    street2 => 'billStreet2',
67    suburb => 'billSuburb',
68    postcode => 'billPostCode',
69    state => 'billState',
70    country => 'billCountry',
71    telephone => 'billTelephone',
72    facsimile => 'billFacsimile',
73    mobile => 'billMobile',
74    organization => 'billOrganization',
75    email => 'billEmail',
76    delivFacsimile => 'facsimile',
77    delivTelephone => 'telephone',
78    delivEmail => 'emailAddress',
79   );
80
81 my %rev_field_map = reverse %field_map;
82
83 sub actions { \%actions }
84
85 sub default_action { 'cart' }
86
87 sub other_action {
88   my ($class, $cgi) = @_;
89
90   for my $key ($cgi->param()) {
91     if ($key =~ /^delete_(\d+)(?:\.x)?$/) {
92       return ( remove_item => $1 );
93     }
94     elsif ($key =~ /^(?:a_)?addsingle(\d+)(?:\.x)?$/) {
95       return ( addsingle => $1 );
96     }
97   }
98
99   return;
100 }
101
102 sub req_cart {
103   my ($class, $req, $msg) = @_;
104
105   $class->_refresh_cart($req);
106
107   my $cart = $req->cart("cart");
108
109   my $cust_class = custom_class($req->cfg);
110   # $req->session->{custom} ||= {};
111   # my %custom_state = %{$req->session->{custom}};
112
113   # $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $req->cfg);
114   $msg = $req->message($msg);
115   
116   my %acts;
117   %acts =
118     (
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'),
122      basic_tags(\%acts),
123      msg => $msg,
124     );
125
126   $req->session->{custom} = { %{$cart->custom_state} };
127   $req->session->{order_info_confirmed} = 0;
128
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";
134   }
135   return $req->response($template, \%acts);
136 }
137
138 =item a_emptycart
139
140 Empty the shopping cart.
141
142 Refreshes to the URL in C<r> or the cart otherwise.
143
144 Flashes msg:bse/shop/cart/empty unless C<r> is supplied.
145
146 =cut
147
148 sub req_emptycart {
149   my ($self, $req) = @_;
150
151   my $cart = $req->cart;
152   my $item_count = @{$cart->items};
153   $cart->empty;
154
155   my $refresh = $req->cgi->param('r');
156   unless ($refresh) {
157     $refresh = $req->user_url(shop => 'cart');
158     $req->flash_notice("msg:bse/shop/cart/empty");
159   }
160
161   return _add_refresh($refresh, $req, !$item_count);
162 }
163
164 sub req_add {
165   my ($class, $req) = @_;
166
167   my $cgi = $req->cgi;
168
169   my $quantity = $cgi->param('quantity');
170   $quantity ||= 1;
171
172   my $error;
173   my $refresh_logon;
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);
179   }
180   else {
181     my $code = $cgi->param('code');
182     if (defined $code) {
183       ($product, $options, $extras)
184         = $class->_validate_add_by_code($req, $code, $quantity, \$error, \$refresh_logon);
185     }
186     else {
187       return $class->req_cart($req, "No product id or code supplied");
188     }
189   }
190   if ($refresh_logon) {
191     return $class->_refresh_logon($req, @$refresh_logon);
192   }
193   elsif ($error) {
194     return $class->req_cart($req, $error);
195   }
196
197   if ($cgi->param('empty')) {
198     $req->session->{cart} = [];
199   }
200
201   $req->session->{cart} ||= [];
202   my @cart = @{$req->session->{cart}};
203   my $started_empty = @cart == 0;
204
205   my $found;
206   for my $item (@cart) {
207     $item->{productId} eq $product->{id} && _same_options($item->{options}, $options)
208       or next;
209
210     ++$found;
211     $item->{units} += $quantity;
212     $req->flash_notice("msg:bse/shop/cart/addquant", [ $product, $quantity ]);
213     last;
214   }
215   unless ($found) {
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));
219     }
220     my $user = $req->siteuser;
221     my ($price, $tier) = $product->price(user => $user);
222     push @cart, 
223       { 
224        productId => $product->{id}, 
225        units => $quantity, 
226        price=> $price,
227        options=>$options,
228        tier => $tier ? $tier->id : "",
229        user => $user ? $user->id : 0,
230        %$extras,
231       };
232     $req->flash_notice("msg:bse/shop/cart/add", [ $product, $quantity ]);
233   }
234
235   $req->session->{cart} = \@cart;
236   $req->session->{order_info_confirmed} = 0;
237
238   my $refresh = $cgi->param('r');
239   unless ($refresh) {
240     $refresh = $req->user_url(shop => 'cart');
241   }
242
243   # speed for ajax
244   if ($refresh eq 'ajaxcart') {
245     return $class->req_cart($req);
246   }
247
248   return _add_refresh($refresh, $req, $started_empty);
249 }
250
251 sub req_addsingle {
252   my ($class, $req, $addid) = @_;
253
254   my $cgi = $req->cgi;
255
256   $addid ||= '';
257   my $quantity = $cgi->param("qty$addid");
258   defined $quantity && $quantity =~ /\S/
259     or $quantity = 1;
260
261   my $error;
262   my $refresh_logon;
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);
267   }
268   elsif ($error) {
269     return $class->req_cart($req, $error);
270   }    
271
272   if ($cgi->param('empty')) {
273     $req->session->{cart} = [];
274   }
275
276   $req->session->{cart} ||= [];
277   my @cart = @{$req->session->{cart}};
278   my $started_empty = @cart == 0;
279  
280   my $found;
281   for my $item (@cart) {
282     $item->{productId} eq $addid && _same_options($item->{options}, $options)
283       or next;
284
285     ++$found;
286     $item->{units} += $quantity;
287     $req->flash_notice("msg:bse/shop/cart/addquant", [ $product, $quantity ]);
288     last;
289   }
290   unless ($found) {
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));
294     }
295     my $user = $req->siteuser;
296     my ($price, $tier) = $product->price(user => $user);
297     push @cart, 
298       { 
299        productId => $addid, 
300        units => $quantity, 
301        price=> $price,
302        options=>$options,
303        tier => $tier ? $tier->id : "",
304        user => $user ? $user->id : 0,
305        %$extras,
306       };
307     $req->flash_notice("msg:bse/shop/cart/add", [ $product, $quantity ]);
308   }
309
310   $req->session->{cart} = \@cart;
311   $req->session->{order_info_confirmed} = 0;
312
313   my $refresh = $cgi->param('r');
314   unless ($refresh) {
315     $refresh = $req->user_url(shop => 'cart');
316   }
317
318   # speed for ajax
319   if ($refresh eq 'ajaxcart') {
320     return $class->req_cart($req);
321   }
322
323   return _add_refresh($refresh, $req, $started_empty);
324 }
325
326 sub req_addmultiple {
327   my ($class, $req) = @_;
328
329   my $cgi = $req->cgi;
330   my @qty_keys = map /^qty(\d+)/, $cgi->param;
331
332   my @messages;
333   my %additions;
334   for my $addid (@qty_keys) {
335     my $quantity = $cgi->param("qty$addid");
336     defined $quantity && $quantity =~ /^\s*\d+\s*$/
337       or next;
338
339     my $error;
340     my $refresh_logon;
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);
345     }
346     elsif ($error) {
347       return $class->req_cart($req, $error);
348     }
349     if ($product->{options}) {
350       push @messages, "$product->{title} has options, you need to use the product page to add this product";
351       next;
352     }
353     $additions{$addid} = 
354       { 
355        id => $product->{id},
356        product => $product, 
357        extras => $extras,
358        quantity => $quantity,
359       };
360   }
361
362   my @qtys = $cgi->param("qty");
363   my @ids = $cgi->param("id");
364   for my $addid (@ids) {
365     my $quantity = shift @qtys;
366     $addid =~ /^\d+$/
367       or next;
368     $additions{$addid}
369       and next;
370     defined $quantity or $quantity = 1;
371     $quantity =~ /^\d+$/
372       or next;
373     $quantity
374       or next;
375     my ($error, $refresh_logon);
376
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);
381     }
382     elsif ($error) {
383       return $class->req_cart($req, $error);
384     }
385     if ($product->{options}) {
386       push @messages, "$product->{title} has options, you need to use the product page to add this product";
387       next;
388     }
389     $additions{$addid} = 
390       { 
391        id => $product->{id},
392        product => $product, 
393        extras => $extras,
394        quantity => $quantity,
395       };
396   }
397   
398   my $started_empty = 0;
399   if (keys %additions) {
400     if ($cgi->param('empty')) {
401       $req->session->{cart} = [];
402     }
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;
408
409       my $addition = delete $additions{$item->{productId}}
410         or next;
411
412       $item->{units} += $addition->{quantity};
413       $req->flash_notice("msg:bse/shop/cart/addquant",
414                          [ $addition->{product}, $addition->{quantity} ]);
415     }
416
417     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
418
419     my @additions = grep $_->{quantity} > 0, values %additions;
420
421     my $user = $req->siteuser;
422     my $error;
423     for my $addition (@additions) {
424       my $product = $addition->{product};
425
426       if (defined $cart_limit && @cart >= $cart_limit) {
427         $error = $req->text('shop/cartfull', MSG_SHOP_CART_FULL);
428         last;
429       }
430
431       my ($price, $tier) = $product->price(user => $user);
432       push @cart, 
433         { 
434          productId => $product->{id},
435          units => $addition->{quantity}, 
436          price=> $price,
437          tier => $tier ? $tier->id : "",
438          user => $user ? $user->id : 0,
439          options=>[],
440          %{$addition->{extras}},
441         };
442       $req->flash_notice("msg:bse/shop/cart/add",
443                          [ $addition->{product}, $addition->{quantity} ]);
444     }
445     
446     $req->session->{cart} = \@cart;
447     $req->session->{order_info_confirmed} = 0;
448     $error
449       and return $class->req_cart($req, $error);
450   }
451
452   my $refresh = $cgi->param('r');
453   unless ($refresh) {
454     $refresh = $req->user_url(shop => 'cart');
455   }
456   if (@messages) {
457     $req->flash_error($_) for @messages;
458   }
459
460   # speed for ajax
461   if ($refresh eq 'ajaxcart') {
462     return $class->req_cart($req);
463   }
464
465   return _add_refresh($refresh, $req, $started_empty);
466 }
467
468 sub tag_ifUser {
469   my ($user, $args) = @_;
470
471   if ($args) {
472     if ($user) {
473       return defined $user->{$args} && $user->{$args};
474     }
475     else {
476       return 0;
477     }
478   }
479   else {
480     return defined $user;
481   }
482 }
483
484 sub _any_physical_products {
485   my $prods = shift;
486
487   for my $prod (@$prods) {
488     if ($prod->weight) {
489       return 1;
490       last;
491     }
492   }
493
494   return 0;
495 }
496
497 =item checkout
498
499 Display the checkout form.
500
501 Variables:
502
503 =over
504
505 =item *
506
507 old - a function returning the old value for most fields.
508
509 =item *
510
511 errors - any errors from attempting to progress to payment
512
513 =item *
514
515 need_delivery - true if the user indicates they want separate delivery
516 and billing details.
517
518 =back
519
520 Template C<checkoutnew>
521
522 =cut
523
524 sub req_checkout {
525   my ($class, $req, $message, $olddata) = @_;
526
527   $class->_refresh_cart($req);
528
529   my $errors = {};
530   if (defined $message) {
531     if (ref $message) {
532       $errors = $message;
533       $message = $req->message($errors);
534     }
535   }
536   else {
537     $message = '';
538   }
539   my $cfg = $req->cfg;
540   my $cgi = $req->cgi;
541
542   my $need_delivery = ( $olddata ? $cgi->param("need_delivery") : $req->session->{order_need_delivery} ) || 0;
543
544   $class->update_quantities($req);
545   my $cart = $req->cart("checkout");
546   my @cart = @{$cart->items};
547
548   @cart or return $class->req_cart($req);
549
550   my @cart_prods = @{$cart->products};
551   my @items = @{$cart->items};
552
553   if ($cart->need_logon) {
554     my ($msg, $id) = $cart->need_logon_message;
555     return $class->_refresh_logon($req, $msg, $id);
556   }
557
558   my $user = $req->siteuser;
559
560   my $order_info = $req->session->{order_info};
561
562   my $billing_map = BSE::TB::Order->billing_to_delivery_map;
563   my %delivery_map = reverse %$billing_map;
564
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};
569   }
570
571   my $old = sub {
572     my $field = $_[0];
573     my $value;
574
575     if ($olddata && defined($cgi->param($field))) {
576       $value = $cgi->param($field);
577     }
578     elsif ($order_info && defined $order_info->{$field}) {
579       $value = $order_info->{$field};
580     }
581     elsif ($user) {
582       $rev_field_map{$field} and $field = $rev_field_map{$field};
583       $value = $user && defined $user->{$field} ? $user->{$field} : '';
584     }
585
586     defined $value or $value = '';
587     return $value;
588   };
589
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;
596
597   my $physical = $cart->any_physical_products;
598
599   if ($prompt_ship) {
600     my $sel_cn = $old->("shipping_name") || "";
601     if ($physical) {
602       my $work_order;
603       $work_order = $order_info unless $olddata;
604       unless ($work_order) {
605         my %fake_order;
606         my %fields = $class->_order_fields($req);
607         $class->_order_hash($req, \%fake_order, \%fields, user => 1);
608         $work_order = \%fake_order;
609       }
610       
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");
618       
619       $country_code
620         or $errors->{$country_field} = "Unknown country name $country";
621       
622       my @couriers = BSE::Shipping->get_couriers($cfg);
623       
624       if ($country_code and $postcode) {
625         @couriers = grep $_->can_deliver(country => $country_code,
626                                          suburb => $suburb,
627                                          postcode => $postcode), @couriers;
628       }
629       
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
635       unless ($sel_cour) {
636         $sel_cour = $couriers[0];
637         $sel_cn = $sel_cour->name;
638       }
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
642           (
643            parcels => \@parcels,
644            suburb => $suburb,
645            postcode => $postcode,
646            country => $country_code,
647            products => \@cart_prods,
648            items => \@items,
649           );
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;
656           
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;
661         }
662       }
663     
664       $shipping_select = popup_menu
665         (
666          -name => "shipping_name",
667          -id => "shipping_name",
668          -values => [ map $_->name, @couriers ],
669          -labels => { map { $_->name => $_->description } @couriers },
670          -default => $sel_cn,
671         );
672     }
673     else {
674       $sel_cn = $shipping_name = "none";
675       $shipping_method = "Nothing to ship!";
676       $shipping_select = popup_menu
677         (
678          -name => "shipping_name",
679          -id => "shipping_name",
680          -values => [ "none" ],
681          -labels => { none => $shipping_method },
682          -default => $sel_cn,
683         );
684     }
685   }
686
687   my $cust_class = custom_class($cfg);
688
689   if (!$message && keys %$errors) {
690     $message = $req->message($errors);
691   }
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);
699
700   my $item_index = -1;
701   my @options;
702   my $option_index;
703   my %acts;
704   %acts =
705     (
706      shop_cart_tags(\%acts, $cart, $req, 'checkout'),
707      basic_tags(\%acts),
708      message => $message,
709      msg => $message,
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,
726     );
727   $req->session->{custom} = $cart->custom_state;
728
729   return $req->response('checkoutnew', \%acts);
730 }
731
732 sub req_checkupdate {
733   my ($self, $req) = @_;
734
735   my $cart = $req->cart("checkupdate");
736
737   $self->update_quantities($req);
738
739   $req->session->{custom} = $cart->custom_state;
740   $req->session->{order_info_confirmed} = 0;
741
742   my %fields = $self->_order_fields($req);
743   my %values;
744   $self->_order_hash($req, \%values, \%fields);
745   $req->session->{order_info} = \%values;
746   $req->session->{order_need_delivery} = $req->cgi->param("need_delivery");
747
748   return $req->get_refresh($req->user_url(shop => "checkout"));
749 }
750
751 sub req_remove_item {
752   my ($class, $req, $index) = @_;
753
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 ]);
760   }
761   $req->session->{cart} = \@cart;
762   $req->session->{order_info_confirmed} = 0;
763
764   return BSE::Template->get_refresh($req->user_url(shop => 'cart'), $req->cfg);
765 }
766
767 sub _order_fields {
768   my ($self, $req) = @_;
769
770   my %fields = BSE::TB::Order->valid_fields($req->cfg);
771   my $cust_class = custom_class($req->cfg);
772   my @required = 
773     $cust_class->required_fields($req->cgi, $req->session->{custom}, $req->cfg);
774
775   for my $name (@required) {
776     $fields{$name}{required} = 1;
777   }
778
779   return %fields;
780 }
781
782 sub _order_hash {
783   my ($self, $req, $values, $fields, %opts) = @_;
784
785   my $cgi = $req->cgi;
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();
793       }
794     }
795     defined $value or $value = "";
796     $values->{$name} = $value;
797   }
798
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};
804     }
805   }
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;
810   }
811 }
812
813 # saves order and refresh to payment page
814 sub req_order {
815   my ($class, $req) = @_;
816
817   my $cfg = $req->cfg;
818   my $cgi = $req->cgi;
819
820   $req->session->{cart} && @{$req->session->{cart}}
821     or return $class->req_cart($req, "Your cart is empty");
822
823   my $msg;
824   $class->_validate_cfg($req, \$msg)
825     or return $class->req_cart($req, $msg);
826
827   my $cart = $req->cart("order");
828
829   my @products = @{$cart->products};
830   my @items = @{$cart->items};
831
832   my $id;
833   if ($cart->need_logon) {
834     my ($msg, $id) = $cart->need_logon_message;
835     return $class->_refresh_logon($req, $msg, $id);
836   }
837
838   my %fields = $class->_order_fields($req);
839   my %rules = BSE::TB::Order->valid_rules($cfg);
840   
841   my %errors;
842   my %values;
843   $class->_order_hash($req, \%values, \%fields);
844
845   dh_validate_hash(\%values, \%errors, { rules=>\%rules, fields=>\%fields },
846                    $cfg, 'Shop Order Validation');
847   my $prompt_ship = $cart->cfg_shipping;
848   if ($prompt_ship) {
849     my $country = $values{delivCountry} || bse_default_country($cfg);
850     my $country_code = bse_country_code($country);
851     $country_code
852       or $errors{delivCountry} = "Unknown country name $country";
853   }
854   keys %errors
855     and return $class->req_checkout($req, \%errors, 1);
856
857   $class->_fillout_order($req, \%values, \$msg, 'payment')
858     or return $class->req_checkout($req, $msg, 1);
859
860   $req->session->{order_info} = \%values;
861   $req->session->{order_need_delivery} = $cgi->param("need_delivery");
862   $req->session->{order_info_confirmed} = 1;
863
864   # skip payment page if nothing to pay
865   if ($values{total} == 0) {
866     return $class->req_payment($req);
867   }
868   else {
869     return BSE::Template->get_refresh($req->user_url(shop => 'show_payment'), $req->cfg);
870   }
871 }
872
873 =item a_show_payment
874
875 Allows the customer to pay for an existing order.
876
877 Parameters:
878
879 =over
880
881 =item *
882
883 orderid - the order id to be paid (Optional, otherwise displays the
884 cart for payment).
885
886 =back
887
888 Template: checkoutpay
889
890 =cut
891
892
893 sub req_show_payment {
894   my ($class, $req, $errors) = @_;
895
896   my $cfg = $req->cfg;
897   my $cgi = $req->cgi;
898
899   my @items;
900   my @products;
901   my $order;
902
903   # ideally supply order_id to be consistent with a_payment.
904   my $order_id = $cgi->param('orderid') || $cgi->param("order_id");
905   my $cart;
906   if ($order_id) {
907     $order_id =~ /^\d+$/
908       or return $class->req_cart($req, "No or invalid order id supplied");
909
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 });
914
915     require BSE::TB::Orders;
916     $order = BSE::TB::Orders->getByPkey($order_id)
917       or return $class->req_cart($req, "Unknown order id");
918
919     $order->siteuser_id == $user->id
920       or return $class->req_cart($req, "You can only pay for your own orders");
921
922     $order->paidFor
923       and return $class->req_cart($req, "Order $order->{id} has been paid");
924
925     $cart = $order;
926   }
927   else {
928     $req->session->{order_info_confirmed}
929       or return $class->req_checkout($req, 'Please proceed via the checkout page');
930
931     $req->session->{cart} && @{$req->session->{cart}}
932       or return $class->req_cart($req, "Your cart is empty");
933
934     $order = $req->session->{order_info}
935       or return $class->req_checkout($req, "You need to enter order information first");
936
937     $cart = $req->cart("payment");
938   }
939
940   $errors ||= {};
941   my $msg = $req->message($errors);
942
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;
949   my $payment;
950   $errors and $payment = $cgi->param('paymentType');
951   defined $payment or $payment = $payment_types[0];
952
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);
957
958   my %acts;
959   %acts =
960     (
961      basic_tags(\%acts),
962      message => $msg,
963      msg => $msg,
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},
975     );
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" ' : "";
983   }
984   $req->set_variable(ordercart => $cart);
985   $req->set_variable(order => $order);
986   $req->set_variable(is_order => !!$order_id);
987
988   return $req->response('checkoutpay', \%acts);
989 }
990
991 my %nostore =
992   (
993    cardNumber => 1,
994    cardExpiry => 1,
995    delivery_in => 1,
996    cardVerify => 1,
997    ccName => 1,
998   );
999
1000 my %bill_ccmap =
1001   (
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",
1011   );
1012
1013 sub req_payment {
1014   my ($class, $req, $errors) = @_;
1015
1016   require BSE::TB::Orders;
1017   my $cgi = $req->cgi;
1018   my $order_id = $cgi->param("order_id");
1019   my $user = $req->siteuser;
1020   my $order;
1021   my $order_values;
1022   my $old_order; # true if we're paying an old order
1023   if ($order_id) {
1024     unless ($user) {
1025       return $class->_refresh_logon
1026         (
1027          $req,
1028          "Please logon before paying your existing order",
1029          "logonpayorder",
1030          undef,
1031          { a_show_payment => 1, orderid => $order_id }
1032         );
1033     }
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");
1040
1041     $order->paidFor
1042       and return $class->req_cart($req, "Order $order->{id} has been paid");
1043
1044     $order_values = $order;
1045     $old_order = 1;
1046   }
1047   else {
1048     $req->session->{order_info_confirmed}
1049       or return $class->req_checkout($req, 'Please proceed via the checkout page');
1050
1051     $order_values = $req->session->{order_info}
1052       or return $class->req_checkout($req, "You need to enter order information first");
1053     $old_order = 0;
1054   }
1055
1056   my $cfg = $req->cfg;
1057   my $session = $req->session;
1058
1059   my $paymentType;
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;
1068     
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);
1073     
1074     my @required;
1075     push @required, @{$pay_types{$paymentType}{require}};
1076     
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;
1082       }
1083       else {
1084         $fields{$field} = { description => $field, required=> 1 };
1085       }
1086     }
1087     
1088     my %errors;
1089     dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
1090                 $cfg, 'Shop Order Validation');
1091     keys %errors
1092       and return $class->req_show_payment($req, \%errors);
1093
1094     for my $field (keys %fields) {
1095       unless ($nostore{$field}) {
1096         if (my ($value) = $cgi->param($field)) {
1097           $order_values->{$field} = $value;
1098         }
1099       }
1100     }
1101
1102   }
1103   else {
1104     $paymentType = -1;
1105   }
1106
1107   $order_values->{paymentType} = $paymentType;
1108   my @dbitems;
1109   my @products;
1110   my %subscribing_to;
1111   if ($order) {
1112     @dbitems = $order->items;
1113     @products = $order->products;
1114     for my $product (@products) {
1115       my $sub = $product->subscription;
1116       if ($sub) {
1117         $subscribing_to{$sub->{text_id}} = $sub;
1118       }
1119     }
1120   }
1121   else {
1122     my $cart = $req->cart("payment");
1123
1124     $order_values->{filled} = 0;
1125     $order_values->{paidFor} = 0;
1126     
1127     my @items = $class->_build_items($req);
1128     my @cartitems = $cart->items;
1129     @products = $cart->products;
1130     
1131     if ($session->{order_work}) {
1132       $order = BSE::TB::Orders->getByPkey($session->{order_work});
1133     }
1134     if ($order && !$order->{complete}) {
1135       my @columns = BSE::TB::Order->columns;
1136       shift @columns; # don't set id
1137       my %columns; 
1138       @columns{@columns} = @columns;
1139       
1140       for my $col (@columns) {
1141         defined $order_values->{$col} or $order_values->{$col} = '';
1142       }
1143       
1144       my @data = @{$order_values}{@columns};
1145       shift @data;
1146     
1147       print STDERR "Recycling order $order->{id}\n";
1148       
1149       my @allbutid = @columns;
1150       shift @allbutid;
1151       @{$order}{@allbutid} = @data;
1152
1153       $order->clear_items;
1154       delete $session->{order_work};
1155       eval {
1156         tied(%$session)->save;
1157       };
1158     }
1159     else {
1160       $order = BSE::TB::Orders->make(%$order_values)
1161         or die "Cannot add order";
1162     }
1163     
1164     my @item_cols = BSE::TB::OrderItem->columns;
1165     for my $row_num (0..$#items) {
1166       my $item = $items[$row_num];
1167       my $product = $products[$row_num];
1168       my %item = %$item;
1169       $item{orderId} = $order->{id};
1170       $item{max_lapsed} = 0;
1171       if ($product->{subscription_id} != -1) {
1172         my $sub = $product->subscription;
1173         $item{max_lapsed} = $sub->{max_lapsed} if $sub;
1174       }
1175       defined $item{session_id} or $item{session_id} = 0;
1176       $item{options} = ""; # not used for new orders
1177       my @data = @item{@item_cols};
1178       shift @data;
1179       my $dbitem = BSE::TB::OrderItems->add(@data);
1180       push @dbitems, $dbitem;
1181       
1182       if ($item->{options} and @{$item->{options}}) {
1183         require BSE::TB::OrderItemOptions;
1184         my @option_descs = $product->option_descs($cfg, $item->{options});
1185         my $display_order = 1;
1186         for my $option (@option_descs) {
1187           my $optionitem = BSE::TB::OrderItemOptions->make
1188               (
1189                order_item_id => $dbitem->{id},
1190                original_id => $option->{id},
1191                name => $option->{desc},
1192                value => $option->{value},
1193                display => $option->{display},
1194                display_order => $display_order++,
1195               );
1196           BSE::PubSub->customize(
1197             order_item_option =>
1198               {
1199                 cartitem => $cartitems[$row_num],
1200                 cartoption => $option->{valueobj},
1201                 cart => $cart,
1202                 orderitem => $dbitem,
1203                 orderitemoption => $optionitem,
1204               });
1205         }
1206       }
1207
1208       my $sub = $product->subscription;
1209       if ($sub) {
1210         $subscribing_to{$sub->{text_id}} = $sub;
1211       }
1212
1213       if ($item->{session_id}) {
1214         require BSE::TB::SeminarSessions;
1215         my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
1216         my $options = join(",", @{$item->{options}});
1217         $session->add_attendee($user, 
1218                                customer_instructions => $order->{instructions},
1219                                options => $options);
1220       }
1221     }
1222   }
1223
1224   $order->set_randomId(make_secret($cfg));
1225   $order->{ccOnline} = 0;
1226   
1227   my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
1228   if ($paymentType == PAYMENT_CC) {
1229     my $ccNumber = $cgi->param('cardNumber');
1230     my $ccExpiry = $cgi->param('cardExpiry');
1231     my $ccName   = $cgi->param('ccName');
1232     
1233     if ($ccprocessor) {
1234       my $cc_class = credit_card_class($cfg);
1235       
1236       $order->{ccOnline} = 1;
1237       
1238       $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
1239       my ($month, $year) = ($1, $2);
1240       $year > 2000 or $year += 2000;
1241       my $expiry = sprintf("%04d%02d", $year, $month);
1242       my $verify = $cgi->param('cardVerify');
1243       defined $verify or $verify = '';
1244       my %more;
1245       while (my ($cc_field, $order_field) = each %bill_ccmap) {
1246         if ($order->$order_field()) {
1247           $more{$cc_field} = $order->$order_field();
1248         }
1249       }
1250       my $result = $cc_class->payment
1251         (
1252          orderno => $order->{id},
1253          amount => $order->{total},
1254          cardnumber => $ccNumber,
1255          nameoncard => $ccName,
1256          expirydate => $expiry,
1257          cvv => $verify,
1258          ipaddress => $ENV{REMOTE_ADDR},
1259          %more,
1260         );
1261       unless ($result->{success}) {
1262         use Data::Dumper;
1263         print STDERR Dumper($result);
1264         # failed, back to payments
1265         $order->{ccSuccess}     = 0;
1266         $order->{ccStatus}      = $result->{statuscode};
1267         $order->{ccStatus2}     = 0;
1268         $order->{ccStatusText}  = $result->{error};
1269         $order->{ccTranId}      = '';
1270         $order->save;
1271         my %errors;
1272         $errors{cardNumber} = $result->{error};
1273         $session->{order_work} = $order->{id};
1274         return $class->req_show_payment($req, \%errors);
1275       }
1276       
1277       $order->{ccSuccess}           = 1;
1278       $order->{ccReceipt}           = $result->{receipt};
1279       $order->{ccStatus}            = 0;
1280       $order->{ccStatus2}           = 0;
1281       $order->{ccStatusText}  = '';
1282       $order->{ccTranId}            = $result->{transactionid};
1283       $order->set_ccPANTruncate($ccNumber);
1284       defined $order->{ccTranId} or $order->{ccTranId} = '';
1285       $order->{paidFor}     = 1;
1286     }
1287     else {
1288       $ccNumber =~ tr/0-9//cd;
1289       $order->{ccExpiryHash} = md5_hex($ccExpiry);
1290       $order->set_ccPANTruncate($ccNumber);
1291     }
1292     $order->set_ccName($ccName);
1293   }
1294   elsif ($paymentType == PAYMENT_PAYPAL) {
1295     require BSE::PayPal;
1296     my $msg;
1297     my $url = BSE::PayPal->payment_url(order => $order,
1298                                        user => $user,
1299                                        msg => \$msg);
1300     unless ($url) {
1301       $session->{order_work} = $order->{id};
1302       my %errors;
1303       $errors{_} = "PayPal error: $msg" if $msg;
1304       return $class->req_show_payment($req, \%errors);
1305     }
1306
1307     # have to mark it complete so it doesn't get used by something else
1308     return BSE::Template->get_refresh($url, $req->cfg);
1309   }
1310
1311   # order complete
1312   $order->set_complete(1);
1313   $order->set_stage("unprocessed");
1314   $order->save;
1315
1316   $class->_finish_order($req, $order);
1317
1318   return BSE::Template->get_refresh($req->user_url(shop => 'orderdone'), $req->cfg);
1319 }
1320
1321 # do final processing of an order after payment
1322 sub _finish_order {
1323   my ($self, $req, $order) = @_;
1324
1325
1326   my $custom = custom_class($req->cfg);
1327   $custom->can("order_complete")
1328     and $custom->order_complete($req->cfg, $order);
1329
1330   # set the order displayed by orderdone
1331   $req->session->{order_completed} = $order->{id};
1332   $req->session->{order_completed_at} = time;
1333
1334   $self->_send_order($req, $order);
1335
1336   my $cart = $req->cart;
1337   $cart->empty;
1338 }
1339
1340 =item orderdone
1341
1342 Display the order after the order is complete.
1343
1344 Sets variables:
1345
1346 =over
1347
1348 =item *
1349
1350 C<order> - the new L<BSE::TB::Order> object.
1351
1352 =back
1353
1354 =cut
1355
1356 sub req_orderdone {
1357   my ($class, $req) = @_;
1358
1359   my $session = $req->session;
1360   my $cfg = $req->cfg;
1361
1362   my $id = $session->{order_completed};
1363   my $when = $session->{order_completed_at};
1364   $id && defined $when && time < $when + 500
1365     or return $class->req_cart($req);
1366     
1367   my $order = BSE::TB::Orders->getByPkey($id)
1368     or return $class->req_cart($req);
1369   my @items = $order->items;
1370   my @products = map { BSE::TB::Products->getByPkey($_->{productId}) } @items;
1371
1372   my @item_cols = BSE::TB::OrderItem->columns;
1373   my %copy_cols = map { $_ => 1 } BSE::TB::Product->columns;
1374   delete @copy_cols{@item_cols};
1375   my @copy_cols = keys %copy_cols;
1376   my @showitems;
1377   for my $item_index (0..$#items) {
1378     my $item = $items[$item_index];
1379     my $product = $products[$item_index];
1380     my %entry;
1381     @entry{@item_cols} = @{$item}{@item_cols};
1382     @entry{@copy_cols} = @{$product}{@copy_cols};
1383
1384     push @showitems, \%entry;
1385   }
1386
1387   my $cust_class = custom_class($req->cfg);
1388
1389   my @pay_types = payment_types($cfg);
1390   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1391   my %pay_types = map { $_->{id} => $_ } @pay_types;
1392   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1393
1394   my $item_index = -1;
1395   my @options;
1396   my $option_index;
1397   my $item;
1398   my $product;
1399   my $sem_session;
1400   my $location;
1401   require BSE::Util::Iterate;
1402   my $it = BSE::Util::Iterate::Objects->new(cfg => $req->cfg);
1403   my $message = $req->message();
1404   my %acts;
1405   %acts =
1406     (
1407      $req->dyn_user_tags(),
1408      $cust_class->purchase_actions(\%acts, \@items, \@products, 
1409                                    $session->{custom}, $cfg),
1410      BSE::Util::Tags->static(\%acts, $cfg),
1411      iterate_items_reset => sub { $item_index = -1; },
1412      iterate_items => 
1413      sub { 
1414        if (++$item_index < @items) {
1415          $option_index = -1;
1416          @options = order_item_opts($req, $items[$item_index]);
1417          undef $sem_session;
1418          undef $location;
1419          $item = $items[$item_index];
1420          $product = $products[$item_index];
1421          return 1;
1422        }
1423        undef $item;
1424        undef $sem_session;
1425        undef $product;
1426        undef $location;
1427        return 0;
1428      },
1429      item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
1430      product =>
1431      sub { 
1432        return tag_article($product, $cfg, $_[0]);
1433      },
1434      extended =>
1435      sub { 
1436        my $what = $_[0] || 'retailPrice';
1437        $items[$item_index]{units} * $items[$item_index]{$what};
1438      },
1439      order => sub { escape_html($order->{$_[0]}) },
1440      iterate_options_reset => sub { $option_index = -1 },
1441      iterate_options => sub { ++$option_index < @options },
1442      option => sub { escape_html($options[$option_index]{$_[0]}) },
1443      ifOptions => sub { @options },
1444      options => sub { nice_options(@options) },
1445      ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
1446      #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1447      session => [ \&tag_session, \$item, \$sem_session ],
1448      location => [ \&tag_location, \$item, \$location ],
1449      msg => $message,
1450      delivery_in => $order->{delivery_in},
1451      shipping_cost => $order->{shipping_cost},
1452      shipping_method => $order->{shipping_method},
1453      $it->make
1454      (
1455       single => "orderpaidfile",
1456       plural => "orderpaidfiles",
1457       code => [ paid_files => $order ],
1458      ),
1459     );
1460   for my $type (@pay_types) {
1461     my $id = $type->{id};
1462     my $name = $type->{name};
1463     $acts{"if${name}Payment"} = $order->{paymentType} == $id;
1464   }
1465
1466   $req->set_variable(order => $order);
1467   $req->set_variable(payment_types => \@pay_types);
1468
1469   return $req->response('checkoutfinal', \%acts);
1470 }
1471
1472 sub tag_session {
1473   my ($ritem, $rsession, $arg) = @_;
1474
1475   $$ritem or return '';
1476
1477   $$ritem->{session_id} or return '';
1478
1479   unless ($$rsession) {
1480     require BSE::TB::SeminarSessions;
1481     $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
1482       or return '';
1483   }
1484
1485   my $value = $$rsession->{$arg};
1486   defined $value or return '';
1487
1488   escape_html($value);
1489 }
1490
1491 sub tag_location {
1492   my ($ritem, $rlocation, $arg) = @_;
1493
1494   $$ritem or return '';
1495
1496   $$ritem->{session_id} or return '';
1497
1498   unless ($$rlocation) {
1499     require BSE::TB::Locations;
1500     ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
1501       or return '';
1502   }
1503
1504   my $value = $$rlocation->{$arg};
1505   defined $value or return '';
1506
1507   escape_html($value);
1508 }
1509
1510 sub tag_ifPayment {
1511   my ($payment, $types_by_name, $args) = @_;
1512
1513   my $type = $args;
1514   if ($type !~ /^\d+$/) {
1515     return '' unless exists $types_by_name->{$type};
1516     $type = $types_by_name->{$type};
1517   }
1518
1519   return $payment == $type;
1520 }
1521
1522 sub tag_paymentTypeId {
1523   my ($types_by_name, $args) = @_;
1524
1525   if (exists $types_by_name->{$args}) {
1526     return $types_by_name->{$args};
1527   }
1528
1529   return '';
1530 }
1531
1532
1533 sub _validate_cfg {
1534   my ($class, $req, $rmsg) = @_;
1535
1536   my $cfg = $req->cfg;
1537   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1538   unless ($from && $from =~ /.\@./) {
1539     $$rmsg = "Configuration error: shop from address not set";
1540     return;
1541   }
1542   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1543   unless ($toEmail && $toEmail =~ /.\@./) {
1544     $$rmsg = "Configuration error: shop to_email address not set";
1545     return;
1546   }
1547
1548   return 1;
1549 }
1550
1551 sub req_recalc {
1552   my ($class, $req) = @_;
1553
1554   $class->update_quantities($req);
1555   $req->session->{order_info_confirmed} = 0;
1556
1557   my $refresh = $req->cgi->param('r');
1558   unless ($refresh) {
1559     $refresh = $req->user_url(shop => 'cart');
1560   }
1561
1562   return $req->get_refresh($refresh);
1563 }
1564
1565 sub req_recalculate {
1566   my ($class, $req) = @_;
1567
1568   return $class->req_recalc($req);
1569 }
1570
1571 sub _send_order {
1572   my ($class, $req, $order) = @_;
1573
1574   my $cfg = $req->cfg;
1575   my $cgi = $req->cgi;
1576
1577   my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
1578   my $crypto_class = $cfg->entry('shop', 'crypt_module',
1579                                  $Constants::SHOP_CRYPTO);
1580   my $signing_id = $cfg->entry('shop', 'crypt_signing_id',
1581                                $Constants::SHOP_SIGNING_ID);
1582   my $pgp = $cfg->entry('shop', 'crypt_pgp', $Constants::SHOP_PGP);
1583   my $pgpe = $cfg->entry('shop', 'crypt_pgpe', $Constants::SHOP_PGPE);
1584   my $gpg = $cfg->entry('shop', 'crypt_gpg', $Constants::SHOP_GPG);
1585   my $passphrase = $cfg->entry('shop', 'crypt_passphrase', 
1586                                $Constants::SHOP_PASSPHRASE);
1587   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1588   my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
1589   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1590   my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
1591
1592   my $session = $req->session;
1593   my %extras = $cfg->entriesCS('extra tags');
1594   for my $key (keys %extras) {
1595     # follow any links
1596     my $data = $cfg->entryVar('extra tags', $key);
1597     $extras{$key} = sub { $data };
1598   }
1599
1600   my @items = $order->items;
1601   my @products = map $_->product, @items;
1602   my %subscribing_to;
1603   for my $product (@products) {
1604     my $sub = $product->subscription;
1605     if ($sub) {
1606       $subscribing_to{$sub->{text_id}} = $sub;
1607     }
1608   }
1609
1610   my $item_index = -1;
1611   my @options;
1612   my $option_index;
1613   my %acts;
1614   %acts =
1615     (
1616      %extras,
1617      custom_class($cfg)
1618      ->order_mail_actions(\%acts, $order, \@items, \@products, 
1619                           $session->{custom}, $cfg),
1620      BSE::Util::Tags->mail_tags(),
1621      $order->mail_tags(),
1622      ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1623     );
1624
1625   my %vars =
1626     (
1627      order => $order,
1628     );
1629
1630   my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
1631   require BSE::ComposeMail;
1632   if ($email_order) {
1633     unless ($noencrypt) {
1634       $acts{cardNumber} = $cgi->param('cardNumber');
1635       $acts{cardExpiry} = $cgi->param('cardExpiry');
1636       $acts{cardVerify} = $cgi->param('cardVerify');
1637       @vars{qw(cardNumber cardExpiry cardVerify)} =
1638         @acts{qw(cardNumber cardExpiry cardVerify)};
1639     }
1640
1641     my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1642     $mailer->start
1643       (
1644        to=>$toEmail,
1645        from=>$from,
1646        subject=>'New Order '.$order->{id},
1647        acts => \%acts,
1648        template => "mailorder",
1649        log_component => "shop:sendorder:mailowner",
1650        log_object => $order,
1651        log_msg => "Send Order No. $order->{id} to admin",
1652        vars => \%vars,
1653       );
1654
1655     unless ($noencrypt) {
1656       my %crypt_opts;
1657       my $sign = $cfg->entryBool('basic', 'sign', 1);
1658       $sign or $crypt_opts{signing_id} = "";
1659       $crypt_opts{recipient} =
1660         $cfg->entry("shop", "crypt_recipient", "$toName $toEmail");
1661       $mailer->encrypt_body(%crypt_opts);
1662     }
1663
1664     unless ($mailer->done) {
1665       $req->flash_error("Could not mail order to admin: " . $mailer->errstr);
1666     }
1667
1668     delete @acts{qw/cardNumber cardExpiry cardVerify/};
1669     delete @vars{qw/cardNumber cardExpiry cardVerify/};
1670   }
1671   my $to_email = $order->billEmail;
1672   my $user = $req->siteuser;
1673   my $to = $to_email;
1674   if ($user && $user->email eq $to_email) {
1675     $to = $user;
1676   }
1677   my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1678   my %opts =
1679     (
1680      to => $to,
1681      from => $from,
1682      subject => $subject . " " . localtime,
1683      template => "mailconfirm",
1684      acts => \%acts,
1685      log_component => "shop:sendorder:mailbuyer",
1686      log_object => $order,
1687      log_msg => "Send Order No. $order->{id} to customer ($to_email)",
1688      vars => \%vars,
1689     );
1690   my $bcc_order = $cfg->entry("shop", "bcc_email");
1691   if ($bcc_order) {
1692     $opts{bcc} = $bcc_order;
1693   }
1694   $mailer->send(%opts)
1695     or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1696 }
1697
1698 sub _refresh_logon {
1699   my ($class, $req, $msg, $msgid, $r, $parms) = @_;
1700
1701   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1702   my $url = $securlbase."/cgi-bin/user.pl";
1703   $parms ||= { checkout => 1 };
1704
1705   unless ($r) {
1706     $r = $securlbase."/cgi-bin/shop.pl?" 
1707       . join("&", map "$_=" . escape_uri($parms->{$_}), keys %$parms);
1708   }
1709
1710   my %parms;
1711   if ($req->cfg->entry('shop registration', 'all')
1712       || $req->cfg->entry('shop registration', $msgid)) {
1713     $parms{show_register} = 1;
1714   }
1715   $parms{r} = $r;
1716   if ($msgid) {
1717     $msg = $req->cfg->entry('messages', $msgid, $msg);
1718   }
1719   $parms{m} = $msg if $msg;
1720   $parms{mid} = $msgid if $msgid;
1721   $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1722   
1723   return BSE::Template->get_refresh($url, $req->cfg);
1724 }
1725
1726 sub tag_checkedPayment {
1727   my ($payment, $types_by_name, $args) = @_;
1728
1729   my $type = $args;
1730   if ($type !~ /^\d+$/) {
1731     return '' unless exists $types_by_name->{$type};
1732     $type = $types_by_name->{$type};
1733   }
1734
1735   return $payment == $type  ? 'checked="checked"' : '';
1736 }
1737
1738 sub tag_ifPayments {
1739   my ($enabled, $types_by_name, $args) = @_;
1740
1741   my $type = $args;
1742   if ($type !~ /^\d+$/) {
1743     return '' unless exists $types_by_name->{$type};
1744     $type = $types_by_name->{$type};
1745   }
1746
1747   my @found = grep $_ == $type, @$enabled;
1748
1749   return scalar @found;
1750 }
1751
1752 sub update_quantities {
1753   my ($class, $req) = @_;
1754
1755   # FIXME: should use the cart class to update quantities
1756   my $session = $req->session;
1757   my $cgi = $req->cgi;
1758   my $cfg = $req->cfg;
1759   my @cart = @{$session->{cart} || []};
1760   for my $index (0..$#cart) {
1761     my $new_quantity = $cgi->param("quantity_$index");
1762     if (defined $new_quantity) {
1763       if ($new_quantity =~ /^\s*(\d+)/) {
1764         $cart[$index]{units} = $1;
1765       }
1766       elsif ($new_quantity =~ /^\s*$/) {
1767         $cart[$index]{units} = 0;
1768       }
1769     }
1770   }
1771   @cart = grep { $_->{units} != 0 } @cart;
1772   $session->{cart} = \@cart;
1773   $session->{custom} ||= {};
1774   my %custom_state = %{$session->{custom}};
1775   custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1776   $session->{custom} = \%custom_state;
1777
1778   my ($coupon) = $cgi->param("coupon");
1779   if (defined $coupon) {
1780     my $cart = $req->cart;
1781     $cart->set_coupon_code($coupon);
1782   }
1783 }
1784
1785 sub _build_items {
1786   my ($class, $req) = @_;
1787
1788   my $session = $req->session;
1789   my $cart = $req->cart;
1790   $session->{cart}
1791     or return;
1792   my @msgs;
1793   my @cart = @{$req->session->{cart}}
1794     or return;
1795   my @items;
1796   my @prodcols = BSE::TB::Product->columns;
1797   my @newcart;
1798   my $today = now_sqldate();
1799   for my $item ($cart->items) {
1800     my %work = %$item;
1801     my $product = $item->product;
1802     if ($product) {
1803       $product->is_released
1804         or do { push @msgs, "'$product->{title}' has not been released yet";
1805                 next; };
1806       $product->is_expired
1807         and do { push @msgs, "'$product->{title}' has expired"; next; };
1808       $product->listed
1809         or do { push @msgs, "'$product->{title}' not available"; next; };
1810
1811       for my $col (@prodcols) {
1812         $work{$col} = $product->$col() unless exists $work{$col};
1813       }
1814       my ($price, $tier) = $product->price(user => scalar $req->siteuser);
1815       $work{price} = $item->price;
1816       $work{tier_id} = $item->tier_id;
1817       $work{extended_retailPrice} = $item->extended_retailPrice;
1818       $work{extended_gst} = $item->extended_gst;
1819       $work{extended_wholesale} = $item->extended_wholesale;
1820       if ($cart->coupon_active) {
1821         $work{product_discount} = $item->product_discount;
1822         $work{product_discount_units} = $item->product_discount_units;
1823       }
1824       else {
1825         $work{product_discount} = 0;
1826         $work{product_discount_units} = 0;
1827       }
1828       BSE::PubSub->customize(
1829         order_build_item => {
1830           cartitem => $item,
1831           cart => $cart,
1832           orderitem => \%work,
1833          });
1834
1835       push @newcart, \%work;
1836     }
1837   }
1838
1839   # we don't use these for anything for now
1840   #if (@msgs) {
1841   #  @$rmsg = @msgs;
1842   #}
1843
1844   return @newcart;
1845 }
1846
1847 sub _fillout_order {
1848   my ($class, $req, $values, $rmsg, $how) = @_;
1849
1850   my $session = $req->session;
1851   my $cfg = $req->cfg;
1852   my $cgi = $req->cgi;
1853
1854   my $cart = $req->cart($how);
1855
1856   if ($cart->is_empty) {
1857     $$rmsg = "Your cart is empty";
1858     return;
1859   }
1860
1861   # FIXME? this doesn't take discounting into effect
1862   $values->{gst} = $cart->gst;
1863   $values->{wholesaleTotal} = $cart->wholesaleTotal;
1864
1865   my $items = $cart->items;
1866   my $products = $cart->products;
1867   my $prompt_ship = $cart->cfg_shipping;
1868   if ($prompt_ship) {
1869     if (_any_physical_products($products)) {
1870       my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1871       my $country_code = bse_country_code($values->{delivCountry});
1872       if ($courier) {
1873         unless ($courier->can_deliver(country => $country_code,
1874                                       suburb => $values->{delivSuburb},
1875                                       postcode => $values->{delivPostCode})) {
1876           $cgi->param("courier", undef);
1877           $$rmsg =
1878             "Can't use the selected courier ".
1879               "(". $courier->description(). ") for this order.";
1880           return;
1881         }
1882         my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1883         my $cost = $courier->calculate_shipping
1884           (
1885            parcels => \@parcels,
1886            country => $country_code,
1887            suburb => $values->{delivSuburb},
1888            postcode => $values->{delivPostCode},
1889            products => $products,
1890            items => $items,
1891           );
1892         if (!defined $cost and $courier->name() ne 'contact') {
1893           my $err = $courier->error_message();
1894           $$rmsg = "Error calculating shipping cost";
1895           $$rmsg .= ": $err" if $err;
1896           return;
1897         }
1898         $values->{shipping_method} = $courier->description();
1899         $values->{shipping_name} = $courier->name;
1900         $values->{shipping_cost} = $cost;
1901         $values->{shipping_trace} = $courier->trace;
1902         $values->{delivery_in} = $courier->delivery_in();
1903       }
1904       else {
1905         # XXX: What to do?
1906         $$rmsg = "Error: no usable courier found.";
1907         return;
1908       }
1909     }
1910     else {
1911       $values->{shipping_method} = "Nothing to ship!";
1912       $values->{shipping_name} = "none";
1913       $values->{shipping_cost} = 0;
1914       $values->{shipping_trace} = "All products have zero weight.";
1915     }
1916   }
1917   if ($cart->coupon_active) {
1918     $values->{coupon_id} = $cart->coupon->id;
1919     $values->{coupon_description} = $cart->coupon_description;
1920     $values->{coupon_cart_wide} = $cart->coupon_cart_wide;
1921   }
1922   else {
1923     $values->{coupon_id} = undef;
1924     $values->{coupon_description} = "";
1925     $values->{coupon_cart_wide} = 0;
1926   }
1927   $cart->set_shipping_cost($values->{shipping_cost});
1928   $cart->set_shipping_method($values->{shipping_method});
1929   $cart->set_shipping_name($values->{shipping_name});
1930   $cart->set_delivery_in($values->{delivery_in});
1931
1932   $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1933   $values->{product_cost_discount} = $cart->product_cost_discount;
1934   $values->{total} = $cart->total;
1935
1936   my $cust_class = custom_class($cfg);
1937
1938   eval {
1939     local $SIG{__DIE__};
1940     $session->{custom} = $cart->custom_state || {};
1941     my %custom = %{$session->{custom}};
1942     $cust_class->order_save($cgi, $values, $items, $items, 
1943                             \%custom, $cfg);
1944     $session->{custom} = \%custom;
1945   };
1946   if ($@) {
1947     $$rmsg = $@;
1948     return;
1949   }
1950
1951   $values->{total} += 
1952     $cust_class->total_extras($items, $items, 
1953                               $session->{custom}, $cfg, $how);
1954
1955   my $affiliate_code = $session->{affiliate_code};
1956   defined $affiliate_code && length $affiliate_code
1957     or $affiliate_code = $cgi->param('affiliate_code');
1958   defined $affiliate_code or $affiliate_code = '';
1959   $values->{affiliate_code} = $affiliate_code;
1960
1961   my $user = $req->siteuser;
1962   if ($user) {
1963     $values->{userId} = $user->{userId};
1964     $values->{siteuser_id} = $user->{id};
1965   }
1966   else {
1967     $values->{userId} = '';
1968     $values->{siteuser_id} = -1;
1969   }
1970
1971   $values->{orderDate} = now_sqldatetime;
1972
1973   # this should be hard to guess
1974   $values->{randomId} = md5_hex(time().rand().{}.$$);
1975
1976   return 1;
1977 }
1978
1979 sub action_prefix { '' }
1980
1981 sub req_location {
1982   my ($class, $req) = @_;
1983
1984   require BSE::TB::Locations;
1985   my $cgi = $req->cgi;
1986   my $location_id = $cgi->param('location_id');
1987   my $location;
1988   if (defined $location_id && $location_id =~ /^\d+$/) {
1989     $location = BSE::TB::Locations->getByPkey($location_id);
1990     my %acts;
1991     %acts =
1992       (
1993        BSE::Util::Tags->static(\%acts, $req->cfg),
1994        location => [ \&tag_hash, $location ],
1995       );
1996
1997     return $req->response('location', \%acts);
1998   }
1999   else {
2000     return
2001       {
2002        type=>BSE::Template->get_type($req->cfg, 'error'),
2003        content=>"Missing or invalid location_id",
2004       };
2005   }
2006 }
2007
2008 sub _validate_add_by_id {
2009   my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
2010
2011   my $product;
2012   if ($addid) {
2013     $product = BSE::TB::Seminars->getByPkey($addid);
2014     $product ||= BSE::TB::Products->getByPkey($addid);
2015   }
2016   unless ($product) {
2017     $$error = "Cannot find product $addid";
2018     return;
2019   }
2020
2021   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2022 }
2023
2024 sub _validate_add_by_code {
2025   my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
2026
2027   my $product;
2028   if (defined $code) {
2029     $product = BSE::TB::Seminars->getBy(product_code => $code);
2030     $product ||= BSE::TB::Products->getBy(product_code => $code);
2031   }
2032   unless ($product) {
2033     $$error = "Cannot find product code $code";
2034     return;
2035   }
2036
2037   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2038 }
2039
2040 sub _validate_add {
2041   my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2042
2043   # collect the product options
2044   my @options;
2045   my @option_descs =  $product->option_descs($req->cfg);
2046   my @option_names = map $_->{name}, @option_descs;
2047   my @not_def;
2048   my $cgi = $req->cgi;
2049   for my $name (@option_names) {
2050     my $value = $cgi->param($name);
2051     push @options, $value;
2052     unless (defined $value) {
2053       push @not_def, $name;
2054     }
2055   }
2056   if (@not_def) {
2057     $$error = "Some product options (@not_def) not supplied";
2058     return;
2059   }
2060   
2061   # the product must be non-expired and listed
2062   (my $comp_release = $product->{release}) =~ s/ .*//;
2063   (my $comp_expire = $product->{expire}) =~ s/ .*//;
2064   my $today = now_sqldate();
2065   unless ($comp_release le $today) {
2066     $$error = "Product $product->{title} has not been released yet";
2067     return;
2068   }
2069   unless ($today le $comp_expire) {
2070     $$error = "Product $product->{title} has expired";
2071     return;
2072   }
2073   unless ($product->{listed}) {
2074     $$error = "Product $product->{title} not available";
2075     return;
2076   }
2077   
2078   # used to refresh if a logon is needed
2079   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2080   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2081   for my $opt_index (0..$#option_names) {
2082     $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2083   }
2084   
2085   my $user = $req->siteuser;
2086   # need to be logged on if it has any subs
2087   if ($product->{subscription_id} != -1) {
2088     if ($user) {
2089       my $sub = $product->subscription;
2090       if ($product->is_renew_sub_only) {
2091         unless ($user->subscribed_to_grace($sub)) {
2092           $$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";
2093           return;
2094         }
2095       }
2096       elsif ($product->is_start_sub_only) {
2097         if ($user->subscribed_to_grace($sub)) {
2098           $$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";
2099           return;
2100         }
2101       }
2102     }
2103     else {
2104       $$refresh_logon = 
2105         [  "You must be logged on to add this product to your cart", 
2106            'prodlogon', $r ];
2107       return;
2108     }
2109   }
2110   if ($product->{subscription_required} != -1) {
2111     my $sub = $product->subscription_required;
2112     if ($user) {
2113       unless ($user->subscribed_to($sub)) {
2114         $$error = "You must be subscribed to $sub->{title} to purchase this product";
2115         return;
2116       }
2117     }
2118     else {
2119       # we want to refresh back to adding the item to the cart if possible
2120       $$refresh_logon = 
2121         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2122          'prodlogonsub', $r ];
2123       return;
2124     }
2125   }
2126
2127   # we need a natural integer quantity
2128   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2129     $$error = "Invalid quantity";
2130     return;
2131   }
2132
2133   my %extras;
2134   if ($product->isa('BSE::TB::Seminar')) {
2135     # you must be logged on to add a seminar
2136     unless ($user) {
2137       $$refresh_logon = 
2138         [ "You must be logged on to add seminars to your cart", 
2139           'seminarlogon', $r ];
2140       return;
2141     }
2142
2143     # get and validate the session
2144     my $session_id = $cgi->param('session_id');
2145     unless (defined $session_id) {
2146       $$error = "Please select a session when adding a seminar";
2147       return;
2148     }
2149     
2150     unless ($session_id =~ /^\d+$/) {
2151       $$error = "Invalid session_id supplied";
2152       return;
2153     }
2154       
2155     require BSE::TB::SeminarSessions;
2156     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2157     unless ($session) {
2158       $$error = "Unknown session id supplied";
2159       return;
2160     }
2161     unless ($session->{seminar_id} == $product->{id}) {
2162       $$error = "Session not for this seminar";
2163       return;
2164     }
2165
2166     # check if the user is already booked for this session
2167     if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2168       $$error = "You are already booked for this session";
2169       return;
2170     }
2171
2172     $extras{session_id} = $session_id;
2173   }
2174
2175   return ( $product, \@options, \%extras );
2176 }
2177
2178 sub _add_refresh {
2179   my ($refresh, $req, $started_empty) = @_;
2180
2181   my $cfg = $req->cfg;
2182   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2183   if ($started_empty && !$cookie_domain) {
2184     my $base_url = $cfg->entryVar('site', 'url');
2185     my $secure_url = $cfg->entryVar('site', 'secureurl');
2186     if ($base_url ne $secure_url) {
2187       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2188
2189       # magical refresh time
2190       # which host are we on?
2191       # first get info about the 2 possible hosts
2192       my ($baseprot, $basehost, $baseport) = 
2193         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2194       $baseport ||= $baseprot eq 'http' ? 80 : 443;
2195       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
2196         if $debug;
2197       
2198       #my ($secprot, $sechost, $secport) = 
2199       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2200
2201       my $onbase = 1;
2202       # get info about the current host
2203       my $port = $ENV{SERVER_PORT} || 80;
2204       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2205       print STDERR "\$ishttps: $ishttps\n" if $debug;
2206       my $protocol = $ishttps ? 'https' : 'http';
2207
2208       if (lc $ENV{SERVER_NAME} ne lc $basehost
2209           || lc $protocol ne $baseprot
2210           || $baseport != $port) {
2211         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
2212         $onbase = 0;
2213       }
2214       my $base = $onbase ? $secure_url : $base_url;
2215       my $finalbase = $onbase ? $base_url : $secure_url;
2216       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2217       my $sessionid = $req->session->{_session_id};
2218       require BSE::SessionSign;
2219       my $sig = BSE::SessionSign->make($sessionid);
2220       my $url = $cfg->user_url("user", undef,
2221                                -base => $base,
2222                                setcookie => $sessionid,
2223                                s => $sig,
2224                                r => $refresh);
2225       print STDERR "Heading to $url to setcookie\n" if $debug;
2226       return $req->get_refresh($url);
2227     }
2228   }
2229
2230   return $req->get_refresh($refresh);
2231 }
2232
2233 sub _same_options {
2234   my ($left, $right) = @_;
2235
2236   for my $index (0 .. $#$left) {
2237     my $left_value = $left->[$index];
2238     my $right_value = $right->[$index];
2239     defined $right_value
2240       or return;
2241     $left_value eq $right_value
2242       or return;
2243   }
2244
2245   return 1;
2246 }
2247
2248 sub _paypal_order {
2249   my ($self, $req, $rmsg) = @_;
2250
2251   my $id = $req->cgi->param("order");
2252   unless ($id) {
2253     $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2254     return;
2255   }
2256   my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2257   unless ($order) {
2258     $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2259     return;
2260   }
2261
2262   return $order;
2263 }
2264
2265 =item paypalret
2266
2267 Handles PayPal returning control.
2268
2269 Expects:
2270
2271 =over
2272
2273 =item *
2274
2275 order - the randomId of the order
2276
2277 =item *
2278
2279 token - paypal token we originally supplied to paypal.  Supplied by
2280 PayPal.
2281
2282 =item *
2283
2284 PayerID - the paypal user who paid the order.  Supplied by PayPal.
2285
2286 =back
2287
2288 =cut
2289
2290 sub req_paypalret {
2291   my ($self, $req) = @_;
2292
2293   require BSE::PayPal;
2294   BSE::PayPal->configured
2295       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2296
2297   my $msg;
2298   my $order = $self->_paypal_order($req, \$msg)
2299     or return $self->req_show_payment($req, { _ => $msg });
2300
2301   $order->complete
2302     and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2303
2304   unless (BSE::PayPal->pay_order(req => $req,
2305                                  order => $order,
2306                                  msg => \$msg)) {
2307     return $self->req_show_payment($req, { _ => $msg });
2308   }
2309
2310   $self->_finish_order($req, $order);
2311
2312   return $req->get_refresh($req->user_url(shop => "orderdone"));
2313 }
2314
2315 sub req_paypalcan {
2316   my ($self, $req) = @_;
2317
2318   require BSE::PayPal;
2319   BSE::PayPal->configured
2320       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2321
2322   my $msg;
2323   my $order = $self->_paypal_order($req, \$msg)
2324     or return $self->req_show_payment($req, { _ => $msg });
2325
2326   $req->flash_notice("msg:bse/shop/paypal/cancelled");
2327
2328   my $url = $req->user_url(shop => "show_payment");
2329   return $req->get_refresh($url);
2330 }
2331
2332 sub _refresh_cart {
2333   my ($self, $req) = @_;
2334
2335   my $user = $req->siteuser
2336     or return;
2337
2338   my $cart = $req->session->{cart}
2339     or return;
2340
2341   for my $item (@$cart) {
2342     if (!$item->{user} || $item->{user} != $user->id) {
2343       my $product = BSE::TB::Products->getByPkey($item->{productId})
2344         or next;
2345       my ($price, $tier) = $product->price(user => $user);
2346       $item->{price} = $price;
2347       $item->{tier} = $tier ? $tier->id : "";
2348     }
2349   }
2350
2351   $req->session->{cart} = $cart;
2352 }
2353
2354 1;
2355
2356 =back
2357
2358 =head1 TAGS
2359
2360 =head2 Cart page
2361
2362 =over 4
2363
2364 =item iterator ... items
2365
2366 Iterates over the items in the shopping cart, setting the C<item> tag
2367 for each one.
2368
2369 =item item I<field>
2370
2371 Retreives the given field from the item.  This can include product
2372 fields for this item.
2373
2374 =item index
2375
2376 The numeric index of the current item.
2377
2378 =item extended [<field>]
2379
2380 The "extended price", the product of the unit cost and the number of
2381 units for the current item in the cart.  I<field> defaults to the
2382 price of the product.
2383
2384 =item money I<which> <field>
2385
2386 Formats the given field as a money value (without a currency symbol.)
2387
2388 =item count
2389
2390 The number of items in the cart.
2391
2392 =item ifUser
2393
2394 Conditional tag, true if a registered user is logged in.
2395
2396 =item user I<field>
2397
2398 Retrieved the given field from the currently logged in user, if any.
2399
2400 =back
2401
2402 =head2 Checkout tags
2403
2404 This has the same tags as the L<Cart page>, and some extras:
2405
2406 =over 4
2407
2408 =item total
2409
2410 The total cost of all items in the cart.
2411
2412 This will need to be formatted as a money value with the C<money> tag.
2413
2414 =item message
2415
2416 An error message, if a validation error occurred.
2417
2418 =item old I<field>
2419
2420 The previously entered value for I<field>.  This should be used as the
2421 value for the various checkout fields, so that if a validation error
2422 occurs the user won't need to re-enter values.
2423
2424 =back
2425
2426 =head2 Completed order
2427
2428 These tags are used in the F<checkoutfinal_base.tmpl>.
2429
2430 =over 4
2431
2432 =item item I<field>
2433
2434 =item product I<field>
2435
2436 This is split out for these forms.
2437
2438 =item order I<field>
2439
2440 Order fields.
2441
2442 =item ifSubscribingTo I<subid>
2443
2444 Can be used to check if this order is intended to be subscribing to a
2445 subscription.
2446
2447 =back
2448
2449 =head2 Mailed order tags
2450
2451 These tags are used in the emails sent to the user to confirm an order
2452 and in the encrypted copy sent to the site administrator:
2453
2454 =over 4
2455
2456 =item *
2457
2458 C<iterate> ... C<items>
2459
2460 Iterates over the items in the order.
2461
2462 =item *
2463
2464 C<item> I<field>
2465
2466 Access to the given field in the order item.
2467
2468 =item *
2469
2470 C<product> I<field>
2471
2472 Access to the product field for the current order item.
2473
2474 =item *
2475
2476 C<order> I<field>
2477
2478 Access to fields of the order.
2479
2480 =item *
2481
2482 C<extended> I<field>
2483
2484 The product of the I<field> in the current item and it's quantity.
2485
2486 =item *
2487
2488 C<money> I<tag> I<parameters>
2489
2490 Formats the given field as a money value.
2491
2492 =back
2493
2494 The mail generation template can use extra formatting specified with
2495 '|format':
2496
2497 =over 4
2498
2499 =item *
2500
2501 m<number>
2502
2503 Format the value as a I<number> wide money value.
2504
2505 =item *
2506
2507 %<format>
2508
2509 Performs sprintf formatting on the value.
2510
2511 =item *
2512
2513 <number>
2514
2515 Left justifies the value in a I<number> wide field.
2516
2517 =back
2518
2519 The order email sent to the site administrator has a couple of extra
2520 fields:
2521
2522 =over
2523
2524 =item *
2525
2526 cardNumber
2527
2528 The credit card number of the user's credit card.
2529
2530 =item *
2531
2532 cardExpiry
2533
2534 The entered expiry date for the user's credit card.
2535
2536 =back
2537
2538 =head2 Order fields
2539
2540 These names can be used with the <: order ... :> tag.
2541
2542 Monetary values should typically be used with <:money order ...:>
2543
2544 =over
2545
2546 =item *
2547
2548 id
2549
2550 The order id or order number.
2551
2552 =item *
2553
2554 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2555 delivPostCode, delivCountry - Delivery information for the order.
2556
2557 =item *
2558
2559 billFirstName, billLastName, billStreet, billSuburb, billState,
2560 billPostCode, billCountry - Billing information for the order.
2561
2562 =item *
2563
2564 telephone, facsimile, emailAddress - Contact information for the
2565 order.
2566
2567 =item *
2568
2569 total - Total price of the order.
2570
2571 =item *
2572
2573 wholesaleTotal - Wholesale cost of the total.  Your costs, if you
2574 entered wholesale prices for the products.
2575
2576 =item *
2577
2578 gst - GST (in Australia) payable on the order, if you entered GST for
2579 the products.
2580
2581 =item *
2582
2583 orderDate - When the order was made.
2584
2585 =item *
2586
2587 filled - Whether or not the order has been filled.  This can be used
2588 with the order_filled target in shopadmin.pl for tracking filled
2589 orders.
2590
2591 =item *
2592
2593 whenFilled - The time and date when the order was filled.
2594
2595 =item *
2596
2597 whoFilled - The user who marked the order as filled.
2598
2599 =item *
2600
2601 paidFor - Whether or not the order has been paid for.  This can be
2602 used with a custom purchasing handler to mark the product as paid for.
2603 You can then filter the order list to only display paid for orders.
2604
2605 =item *
2606
2607 paymentReceipt - A custom payment handler can fill this with receipt
2608 information.
2609
2610 =item *
2611
2612 randomId - Generated by the prePurchase target, this can be used as a
2613 difficult to guess identifier for orders, when working with custom
2614 payment handlers.
2615
2616 =item *
2617
2618 cancelled - This can be used by a custom payment handler to mark an
2619 order as cancelled if the user starts processing an order without
2620 completing payment.
2621
2622 =back
2623
2624 =head2 Order item fields
2625
2626 =over
2627
2628 =item *
2629
2630 productId - The product id of this item.
2631
2632 =item *
2633
2634 orderId - The order Id.
2635
2636 =item *
2637
2638 units - The number of units for this item.
2639
2640 =item *
2641
2642 price - The price paid for the product.
2643
2644 =item *
2645
2646 wholesalePrice - The wholesale price for the product.
2647
2648 =item *
2649
2650 gst - The gst for the product.
2651
2652 =item *
2653
2654 options - A comma separated list of options specified for this item.
2655 These correspond to the option names in the product.
2656
2657 =back
2658
2659 =head2 Options
2660
2661 New with 0.10_04 is the facility to set options for each product.
2662
2663 The cart, checkout and checkoutfinal pages now include the following
2664 tags:
2665
2666 =over
2667
2668 =item *
2669
2670 C<iterator> ... <options>
2671
2672 within an item, iterates over the options for this item in the cart.
2673 Sets the item tag.
2674
2675 =item *
2676
2677 C<option> I<field>
2678
2679 Retrieves the given field from the option, possible field names are:
2680
2681 =over
2682
2683 =item *
2684
2685 id - The type/identifier for this option.  eg. msize for a male
2686 clothing size field.
2687
2688 =item *
2689
2690 value - The underlying value of the option, eg. XL.
2691
2692 =item *
2693
2694 desc - The description of the field from the product options hash.  If
2695 the description isn't defined this is the same as the id. eg. Size.
2696
2697 =item *
2698
2699 label - The description of the value from the product options hash.
2700 eg. "Extra large".
2701
2702 =back
2703
2704 =item *
2705
2706 ifOptions - A conditional tag, true if the current cart item has any
2707 options.
2708
2709 =item *
2710
2711 options - A simple rendering of the options as a parenthesized
2712 comma-separated list.
2713
2714 =back
2715
2716 =cut