allow purchase of products with missing 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.053";
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 (grep $_->{value} ne '', @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 $allow_missing_options = $req->cfg->entry("shop", "allow_missing_options", 0);
2048   my @not_def;
2049   my $cgi = $req->cgi;
2050   for my $name (@option_names) {
2051     my $value = $cgi->param($name);
2052     unless (defined $value) {
2053       if ($allow_missing_options) {
2054         $value = "";
2055       }
2056       else {
2057         push @not_def, $name;
2058       }
2059     }
2060     push @options, $value;
2061   }
2062   if (@not_def) {
2063     $$error = "Some product options (@not_def) not supplied";
2064     return;
2065   }
2066   
2067   # the product must be non-expired and listed
2068   (my $comp_release = $product->{release}) =~ s/ .*//;
2069   (my $comp_expire = $product->{expire}) =~ s/ .*//;
2070   my $today = now_sqldate();
2071   unless ($comp_release le $today) {
2072     $$error = "Product $product->{title} has not been released yet";
2073     return;
2074   }
2075   unless ($today le $comp_expire) {
2076     $$error = "Product $product->{title} has expired";
2077     return;
2078   }
2079   unless ($product->{listed}) {
2080     $$error = "Product $product->{title} not available";
2081     return;
2082   }
2083   
2084   # used to refresh if a logon is needed
2085   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2086   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2087   for my $opt_index (0..$#option_names) {
2088     $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2089   }
2090   
2091   my $user = $req->siteuser;
2092   # need to be logged on if it has any subs
2093   if ($product->{subscription_id} != -1) {
2094     if ($user) {
2095       my $sub = $product->subscription;
2096       if ($product->is_renew_sub_only) {
2097         unless ($user->subscribed_to_grace($sub)) {
2098           $$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";
2099           return;
2100         }
2101       }
2102       elsif ($product->is_start_sub_only) {
2103         if ($user->subscribed_to_grace($sub)) {
2104           $$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";
2105           return;
2106         }
2107       }
2108     }
2109     else {
2110       $$refresh_logon = 
2111         [  "You must be logged on to add this product to your cart", 
2112            'prodlogon', $r ];
2113       return;
2114     }
2115   }
2116   if ($product->{subscription_required} != -1) {
2117     my $sub = $product->subscription_required;
2118     if ($user) {
2119       unless ($user->subscribed_to($sub)) {
2120         $$error = "You must be subscribed to $sub->{title} to purchase this product";
2121         return;
2122       }
2123     }
2124     else {
2125       # we want to refresh back to adding the item to the cart if possible
2126       $$refresh_logon = 
2127         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2128          'prodlogonsub', $r ];
2129       return;
2130     }
2131   }
2132
2133   # we need a natural integer quantity
2134   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2135     $$error = "Invalid quantity";
2136     return;
2137   }
2138
2139   my %extras;
2140   if ($product->isa('BSE::TB::Seminar')) {
2141     # you must be logged on to add a seminar
2142     unless ($user) {
2143       $$refresh_logon = 
2144         [ "You must be logged on to add seminars to your cart", 
2145           'seminarlogon', $r ];
2146       return;
2147     }
2148
2149     # get and validate the session
2150     my $session_id = $cgi->param('session_id');
2151     unless (defined $session_id) {
2152       $$error = "Please select a session when adding a seminar";
2153       return;
2154     }
2155     
2156     unless ($session_id =~ /^\d+$/) {
2157       $$error = "Invalid session_id supplied";
2158       return;
2159     }
2160       
2161     require BSE::TB::SeminarSessions;
2162     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2163     unless ($session) {
2164       $$error = "Unknown session id supplied";
2165       return;
2166     }
2167     unless ($session->{seminar_id} == $product->{id}) {
2168       $$error = "Session not for this seminar";
2169       return;
2170     }
2171
2172     # check if the user is already booked for this session
2173     if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2174       $$error = "You are already booked for this session";
2175       return;
2176     }
2177
2178     $extras{session_id} = $session_id;
2179   }
2180
2181   return ( $product, \@options, \%extras );
2182 }
2183
2184 sub _add_refresh {
2185   my ($refresh, $req, $started_empty) = @_;
2186
2187   my $cfg = $req->cfg;
2188   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2189   if ($started_empty && !$cookie_domain) {
2190     my $base_url = $cfg->entryVar('site', 'url');
2191     my $secure_url = $cfg->entryVar('site', 'secureurl');
2192     if ($base_url ne $secure_url) {
2193       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2194
2195       # magical refresh time
2196       # which host are we on?
2197       # first get info about the 2 possible hosts
2198       my ($baseprot, $basehost, $baseport) = 
2199         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2200       $baseport ||= $baseprot eq 'http' ? 80 : 443;
2201       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
2202         if $debug;
2203       
2204       #my ($secprot, $sechost, $secport) = 
2205       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2206
2207       my $onbase = 1;
2208       # get info about the current host
2209       my $port = $ENV{SERVER_PORT} || 80;
2210       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2211       print STDERR "\$ishttps: $ishttps\n" if $debug;
2212       my $protocol = $ishttps ? 'https' : 'http';
2213
2214       if (lc $ENV{SERVER_NAME} ne lc $basehost
2215           || lc $protocol ne $baseprot
2216           || $baseport != $port) {
2217         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
2218         $onbase = 0;
2219       }
2220       my $base = $onbase ? $secure_url : $base_url;
2221       my $finalbase = $onbase ? $base_url : $secure_url;
2222       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2223       my $sessionid = $req->session->{_session_id};
2224       require BSE::SessionSign;
2225       my $sig = BSE::SessionSign->make($sessionid);
2226       my $url = $cfg->user_url("user", undef,
2227                                -base => $base,
2228                                setcookie => $sessionid,
2229                                s => $sig,
2230                                r => $refresh);
2231       print STDERR "Heading to $url to setcookie\n" if $debug;
2232       return $req->get_refresh($url);
2233     }
2234   }
2235
2236   return $req->get_refresh($refresh);
2237 }
2238
2239 sub _same_options {
2240   my ($left, $right) = @_;
2241
2242   for my $index (0 .. $#$left) {
2243     my $left_value = $left->[$index];
2244     my $right_value = $right->[$index];
2245     defined $right_value
2246       or return;
2247     $left_value eq $right_value
2248       or return;
2249   }
2250
2251   return 1;
2252 }
2253
2254 sub _paypal_order {
2255   my ($self, $req, $rmsg) = @_;
2256
2257   my $id = $req->cgi->param("order");
2258   unless ($id) {
2259     $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2260     return;
2261   }
2262   my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2263   unless ($order) {
2264     $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2265     return;
2266   }
2267
2268   return $order;
2269 }
2270
2271 =item paypalret
2272
2273 Handles PayPal returning control.
2274
2275 Expects:
2276
2277 =over
2278
2279 =item *
2280
2281 order - the randomId of the order
2282
2283 =item *
2284
2285 token - paypal token we originally supplied to paypal.  Supplied by
2286 PayPal.
2287
2288 =item *
2289
2290 PayerID - the paypal user who paid the order.  Supplied by PayPal.
2291
2292 =back
2293
2294 =cut
2295
2296 sub req_paypalret {
2297   my ($self, $req) = @_;
2298
2299   require BSE::PayPal;
2300   BSE::PayPal->configured
2301       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2302
2303   my $msg;
2304   my $order = $self->_paypal_order($req, \$msg)
2305     or return $self->req_show_payment($req, { _ => $msg });
2306
2307   $order->complete
2308     and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2309
2310   unless (BSE::PayPal->pay_order(req => $req,
2311                                  order => $order,
2312                                  msg => \$msg)) {
2313     return $self->req_show_payment($req, { _ => $msg });
2314   }
2315
2316   $self->_finish_order($req, $order);
2317
2318   return $req->get_refresh($req->user_url(shop => "orderdone"));
2319 }
2320
2321 sub req_paypalcan {
2322   my ($self, $req) = @_;
2323
2324   require BSE::PayPal;
2325   BSE::PayPal->configured
2326       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2327
2328   my $msg;
2329   my $order = $self->_paypal_order($req, \$msg)
2330     or return $self->req_show_payment($req, { _ => $msg });
2331
2332   $req->flash_notice("msg:bse/shop/paypal/cancelled");
2333
2334   my $url = $req->user_url(shop => "show_payment");
2335   return $req->get_refresh($url);
2336 }
2337
2338 sub _refresh_cart {
2339   my ($self, $req) = @_;
2340
2341   my $user = $req->siteuser
2342     or return;
2343
2344   my $cart = $req->session->{cart}
2345     or return;
2346
2347   for my $item (@$cart) {
2348     if (!$item->{user} || $item->{user} != $user->id) {
2349       my $product = BSE::TB::Products->getByPkey($item->{productId})
2350         or next;
2351       my ($price, $tier) = $product->price(user => $user);
2352       $item->{price} = $price;
2353       $item->{tier} = $tier ? $tier->id : "";
2354     }
2355   }
2356
2357   $req->session->{cart} = $cart;
2358 }
2359
2360 1;
2361
2362 =back
2363
2364 =head1 TAGS
2365
2366 =head2 Cart page
2367
2368 =over 4
2369
2370 =item iterator ... items
2371
2372 Iterates over the items in the shopping cart, setting the C<item> tag
2373 for each one.
2374
2375 =item item I<field>
2376
2377 Retreives the given field from the item.  This can include product
2378 fields for this item.
2379
2380 =item index
2381
2382 The numeric index of the current item.
2383
2384 =item extended [<field>]
2385
2386 The "extended price", the product of the unit cost and the number of
2387 units for the current item in the cart.  I<field> defaults to the
2388 price of the product.
2389
2390 =item money I<which> <field>
2391
2392 Formats the given field as a money value (without a currency symbol.)
2393
2394 =item count
2395
2396 The number of items in the cart.
2397
2398 =item ifUser
2399
2400 Conditional tag, true if a registered user is logged in.
2401
2402 =item user I<field>
2403
2404 Retrieved the given field from the currently logged in user, if any.
2405
2406 =back
2407
2408 =head2 Checkout tags
2409
2410 This has the same tags as the L<Cart page>, and some extras:
2411
2412 =over 4
2413
2414 =item total
2415
2416 The total cost of all items in the cart.
2417
2418 This will need to be formatted as a money value with the C<money> tag.
2419
2420 =item message
2421
2422 An error message, if a validation error occurred.
2423
2424 =item old I<field>
2425
2426 The previously entered value for I<field>.  This should be used as the
2427 value for the various checkout fields, so that if a validation error
2428 occurs the user won't need to re-enter values.
2429
2430 =back
2431
2432 =head2 Completed order
2433
2434 These tags are used in the F<checkoutfinal_base.tmpl>.
2435
2436 =over 4
2437
2438 =item item I<field>
2439
2440 =item product I<field>
2441
2442 This is split out for these forms.
2443
2444 =item order I<field>
2445
2446 Order fields.
2447
2448 =item ifSubscribingTo I<subid>
2449
2450 Can be used to check if this order is intended to be subscribing to a
2451 subscription.
2452
2453 =back
2454
2455 =head2 Mailed order tags
2456
2457 These tags are used in the emails sent to the user to confirm an order
2458 and in the encrypted copy sent to the site administrator:
2459
2460 =over 4
2461
2462 =item *
2463
2464 C<iterate> ... C<items>
2465
2466 Iterates over the items in the order.
2467
2468 =item *
2469
2470 C<item> I<field>
2471
2472 Access to the given field in the order item.
2473
2474 =item *
2475
2476 C<product> I<field>
2477
2478 Access to the product field for the current order item.
2479
2480 =item *
2481
2482 C<order> I<field>
2483
2484 Access to fields of the order.
2485
2486 =item *
2487
2488 C<extended> I<field>
2489
2490 The product of the I<field> in the current item and it's quantity.
2491
2492 =item *
2493
2494 C<money> I<tag> I<parameters>
2495
2496 Formats the given field as a money value.
2497
2498 =back
2499
2500 The mail generation template can use extra formatting specified with
2501 '|format':
2502
2503 =over 4
2504
2505 =item *
2506
2507 m<number>
2508
2509 Format the value as a I<number> wide money value.
2510
2511 =item *
2512
2513 %<format>
2514
2515 Performs sprintf formatting on the value.
2516
2517 =item *
2518
2519 <number>
2520
2521 Left justifies the value in a I<number> wide field.
2522
2523 =back
2524
2525 The order email sent to the site administrator has a couple of extra
2526 fields:
2527
2528 =over
2529
2530 =item *
2531
2532 cardNumber
2533
2534 The credit card number of the user's credit card.
2535
2536 =item *
2537
2538 cardExpiry
2539
2540 The entered expiry date for the user's credit card.
2541
2542 =back
2543
2544 =head2 Order fields
2545
2546 These names can be used with the <: order ... :> tag.
2547
2548 Monetary values should typically be used with <:money order ...:>
2549
2550 =over
2551
2552 =item *
2553
2554 id
2555
2556 The order id or order number.
2557
2558 =item *
2559
2560 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2561 delivPostCode, delivCountry - Delivery information for the order.
2562
2563 =item *
2564
2565 billFirstName, billLastName, billStreet, billSuburb, billState,
2566 billPostCode, billCountry - Billing information for the order.
2567
2568 =item *
2569
2570 telephone, facsimile, emailAddress - Contact information for the
2571 order.
2572
2573 =item *
2574
2575 total - Total price of the order.
2576
2577 =item *
2578
2579 wholesaleTotal - Wholesale cost of the total.  Your costs, if you
2580 entered wholesale prices for the products.
2581
2582 =item *
2583
2584 gst - GST (in Australia) payable on the order, if you entered GST for
2585 the products.
2586
2587 =item *
2588
2589 orderDate - When the order was made.
2590
2591 =item *
2592
2593 filled - Whether or not the order has been filled.  This can be used
2594 with the order_filled target in shopadmin.pl for tracking filled
2595 orders.
2596
2597 =item *
2598
2599 whenFilled - The time and date when the order was filled.
2600
2601 =item *
2602
2603 whoFilled - The user who marked the order as filled.
2604
2605 =item *
2606
2607 paidFor - Whether or not the order has been paid for.  This can be
2608 used with a custom purchasing handler to mark the product as paid for.
2609 You can then filter the order list to only display paid for orders.
2610
2611 =item *
2612
2613 paymentReceipt - A custom payment handler can fill this with receipt
2614 information.
2615
2616 =item *
2617
2618 randomId - Generated by the prePurchase target, this can be used as a
2619 difficult to guess identifier for orders, when working with custom
2620 payment handlers.
2621
2622 =item *
2623
2624 cancelled - This can be used by a custom payment handler to mark an
2625 order as cancelled if the user starts processing an order without
2626 completing payment.
2627
2628 =back
2629
2630 =head2 Order item fields
2631
2632 =over
2633
2634 =item *
2635
2636 productId - The product id of this item.
2637
2638 =item *
2639
2640 orderId - The order Id.
2641
2642 =item *
2643
2644 units - The number of units for this item.
2645
2646 =item *
2647
2648 price - The price paid for the product.
2649
2650 =item *
2651
2652 wholesalePrice - The wholesale price for the product.
2653
2654 =item *
2655
2656 gst - The gst for the product.
2657
2658 =item *
2659
2660 options - A comma separated list of options specified for this item.
2661 These correspond to the option names in the product.
2662
2663 =back
2664
2665 =head2 Options
2666
2667 New with 0.10_04 is the facility to set options for each product.
2668
2669 The cart, checkout and checkoutfinal pages now include the following
2670 tags:
2671
2672 =over
2673
2674 =item *
2675
2676 C<iterator> ... <options>
2677
2678 within an item, iterates over the options for this item in the cart.
2679 Sets the item tag.
2680
2681 =item *
2682
2683 C<option> I<field>
2684
2685 Retrieves the given field from the option, possible field names are:
2686
2687 =over
2688
2689 =item *
2690
2691 id - The type/identifier for this option.  eg. msize for a male
2692 clothing size field.
2693
2694 =item *
2695
2696 value - The underlying value of the option, eg. XL.
2697
2698 =item *
2699
2700 desc - The description of the field from the product options hash.  If
2701 the description isn't defined this is the same as the id. eg. Size.
2702
2703 =item *
2704
2705 label - The description of the value from the product options hash.
2706 eg. "Extra large".
2707
2708 =back
2709
2710 =item *
2711
2712 ifOptions - A conditional tag, true if the current cart item has any
2713 options.
2714
2715 =item *
2716
2717 options - A simple rendering of the options as a parenthesized
2718 comma-separated list.
2719
2720 =back
2721
2722 =cut