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.049";
  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_reason;
 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     @products = $cart->products;
1129
1130     if ($session->{order_work}) {
1131       $order = BSE::TB::Orders->getByPkey($session->{order_work});
1132     }
1133     if ($order && !$order->{complete}) {
1134       my @columns = BSE::TB::Order->columns;
1135       shift @columns; # don't set id
1136       my %columns;
1137       @columns{@columns} = @columns;
1138
1139       for my $col (@columns) {
1140         defined $order_values->{$col} or $order_values->{$col} = '';
1141       }
1142
1143       my @data = @{$order_values}{@columns};
1144       shift @data;
1145
1146       print STDERR "Recycling order $order->{id}\n";
1147
1148       my @allbutid = @columns;
1149       shift @allbutid;
1150       @{$order}{@allbutid} = @data;
1151
1152       $order->clear_items;
1153       delete $session->{order_work};
1154       eval {
1155         tied(%$session)->save;
1156       };
1157     }
1158     else {
1159       $order = BSE::TB::Orders->make(%$order_values)
1160         or die "Cannot add order";
1161     }
1162
1163     my @item_cols = BSE::TB::OrderItem->columns;
1164     for my $row_num (0..$#items) {
1165       my $item = $items[$row_num];
1166       my $product = $products[$row_num];
1167       my %item = %$item;
1168       $item{orderId} = $order->{id};
1169       $item{max_lapsed} = 0;
1170       if ($product->{subscription_id} != -1) {
1171         my $sub = $product->subscription;
1172         $item{max_lapsed} = $sub->{max_lapsed} if $sub;
1173       }
1174       defined $item{session_id} or $item{session_id} = 0;
1175       $item{options} = ""; # not used for new orders
1176       my @data = @item{@item_cols};
1177       shift @data;
1178       my $dbitem = BSE::TB::OrderItems->add(@data);
1179       push @dbitems, $dbitem;
1180
1181       if ($item->{options} and @{$item->{options}}) {
1182         require BSE::TB::OrderItemOptions;
1183         my @option_descs = $product->option_descs($cfg, $item->{options});
1184         my $display_order = 1;
1185         for my $option (@option_descs) {
1186           BSE::TB::OrderItemOptions->make
1187               (
1188                order_item_id => $dbitem->{id},
1189                original_id => $option->{id},
1190                name => $option->{desc},
1191                value => $option->{value},
1192                display => $option->{display},
1193                display_order => $display_order++,
1194               );
1195         }
1196       }
1197
1198       my $sub = $product->subscription;
1199       if ($sub) {
1200         $subscribing_to{$sub->{text_id}} = $sub;
1201       }
1202
1203       if ($item->{session_id}) {
1204         require BSE::TB::SeminarSessions;
1205         my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
1206         my $options = join(",", @{$item->{options}});
1207         $session->add_attendee($user,
1208                                customer_instructions => $order->{instructions},
1209                                options => $options);
1210       }
1211     }
1212   }
1213
1214   $order->set_randomId(make_secret($cfg));
1215   $order->{ccOnline} = 0;
1216
1217   my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
1218   if ($paymentType == PAYMENT_CC) {
1219     my $ccNumber = $cgi->param('cardNumber');
1220     my $ccExpiry = $cgi->param('cardExpiry');
1221     my $ccName   = $cgi->param('ccName');
1222
1223     if ($ccprocessor) {
1224       my $cc_class = credit_card_class($cfg);
1225
1226       $order->{ccOnline} = 1;
1227
1228       $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
1229       my ($month, $year) = ($1, $2);
1230       $year > 2000 or $year += 2000;
1231       my $expiry = sprintf("%04d%02d", $year, $month);
1232       my $verify = $cgi->param('cardVerify');
1233       defined $verify or $verify = '';
1234       my %more;
1235       while (my ($cc_field, $order_field) = each %bill_ccmap) {
1236         if ($order->$order_field()) {
1237           $more{$cc_field} = $order->$order_field();
1238         }
1239       }
1240       my $result = $cc_class->payment
1241         (
1242          orderno => $order->{id},
1243          amount => $order->{total},
1244          cardnumber => $ccNumber,
1245          nameoncard => $ccName,
1246          expirydate => $expiry,
1247          cvv => $verify,
1248          ipaddress => $ENV{REMOTE_ADDR},
1249          %more,
1250         );
1251       unless ($result->{success}) {
1252         use Data::Dumper;
1253         print STDERR Dumper($result);
1254         # failed, back to payments
1255         $order->{ccSuccess}     = 0;
1256         $order->{ccStatus}      = $result->{statuscode};
1257         $order->{ccStatus2}     = 0;
1258         $order->{ccStatusText}  = $result->{error};
1259         $order->{ccTranId}      = '';
1260         $order->save;
1261         my %errors;
1262         $errors{cardNumber} = $result->{error};
1263         $session->{order_work} = $order->{id};
1264         return $class->req_show_payment($req, \%errors);
1265       }
1266
1267       $order->{ccSuccess}           = 1;
1268       $order->{ccReceipt}           = $result->{receipt};
1269       $order->{ccStatus}            = 0;
1270       $order->{ccStatus2}           = 0;
1271       $order->{ccStatusText}  = '';
1272       $order->{ccTranId}            = $result->{transactionid};
1273       $order->set_ccPANTruncate($ccNumber);
1274       defined $order->{ccTranId} or $order->{ccTranId} = '';
1275       $order->{paidFor}     = 1;
1276     }
1277     else {
1278       $ccNumber =~ tr/0-9//cd;
1279       $order->{ccExpiryHash} = md5_hex($ccExpiry);
1280       $order->set_ccPANTruncate($ccNumber);
1281     }
1282     $order->set_ccName($ccName);
1283   }
1284   elsif ($paymentType == PAYMENT_PAYPAL) {
1285     require BSE::PayPal;
1286     my $msg;
1287     my $url = BSE::PayPal->payment_url(order => $order,
1288                                        user => $user,
1289                                        msg => \$msg);
1290     unless ($url) {
1291       $session->{order_work} = $order->{id};
1292       my %errors;
1293       $errors{_} = "PayPal error: $msg" if $msg;
1294       return $class->req_show_payment($req, \%errors);
1295     }
1296
1297     # have to mark it complete so it doesn't get used by something else
1298     return BSE::Template->get_refresh($url, $req->cfg);
1299   }
1300
1301   # order complete
1302   $order->set_complete(1);
1303   $order->set_stage("unprocessed");
1304   $order->save;
1305
1306   $class->_finish_order($req, $order);
1307
1308   return BSE::Template->get_refresh($req->user_url(shop => 'orderdone'), $req->cfg);
1309 }
1310
1311 # do final processing of an order after payment
1312 sub _finish_order {
1313   my ($self, $req, $order) = @_;
1314
1315
1316   my $custom = custom_class($req->cfg);
1317   $custom->can("order_complete")
1318     and $custom->order_complete($req->cfg, $order);
1319
1320   # set the order displayed by orderdone
1321   $req->session->{order_completed} = $order->{id};
1322   $req->session->{order_completed_at} = time;
1323
1324   $self->_send_order($req, $order);
1325
1326   my $cart = $req->cart;
1327   $cart->empty;
1328 }
1329
1330 =item orderdone
1331
1332 Display the order after the order is complete.
1333
1334 Sets variables:
1335
1336 =over
1337
1338 =item *
1339
1340 C<order> - the new L<BSE::TB::Order> object.
1341
1342 =back
1343
1344 =cut
1345
1346 sub req_orderdone {
1347   my ($class, $req) = @_;
1348
1349   my $session = $req->session;
1350   my $cfg = $req->cfg;
1351
1352   my $id = $session->{order_completed};
1353   my $when = $session->{order_completed_at};
1354   $id && defined $when && time < $when + 500
1355     or return $class->req_cart($req);
1356
1357   my $order = BSE::TB::Orders->getByPkey($id)
1358     or return $class->req_cart($req);
1359   my @items = $order->items;
1360   my @products = map { BSE::TB::Products->getByPkey($_->{productId}) } @items;
1361
1362   my @item_cols = BSE::TB::OrderItem->columns;
1363   my %copy_cols = map { $_ => 1 } BSE::TB::Product->columns;
1364   delete @copy_cols{@item_cols};
1365   my @copy_cols = keys %copy_cols;
1366   my @showitems;
1367   for my $item_index (0..$#items) {
1368     my $item = $items[$item_index];
1369     my $product = $products[$item_index];
1370     my %entry;
1371     @entry{@item_cols} = @{$item}{@item_cols};
1372     @entry{@copy_cols} = @{$product}{@copy_cols};
1373
1374     push @showitems, \%entry;
1375   }
1376
1377   my $cust_class = custom_class($req->cfg);
1378
1379   my @pay_types = payment_types($cfg);
1380   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1381   my %pay_types = map { $_->{id} => $_ } @pay_types;
1382   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1383
1384   my $item_index = -1;
1385   my @options;
1386   my $option_index;
1387   my $item;
1388   my $product;
1389   my $sem_session;
1390   my $location;
1391   require BSE::Util::Iterate;
1392   my $it = BSE::Util::Iterate::Objects->new(cfg => $req->cfg);
1393   my $message = $req->message();
1394   my %acts;
1395   %acts =
1396     (
1397      $req->dyn_user_tags(),
1398      $cust_class->purchase_actions(\%acts, \@items, \@products,
1399                                    $session->{custom}, $cfg),
1400      BSE::Util::Tags->static(\%acts, $cfg),
1401      iterate_items_reset => sub { $item_index = -1; },
1402      iterate_items =>
1403      sub {
1404        if (++$item_index < @items) {
1405          $option_index = -1;
1406          @options = order_item_opts($req, $items[$item_index]);
1407          undef $sem_session;
1408          undef $location;
1409          $item = $items[$item_index];
1410          $product = $products[$item_index];
1411          return 1;
1412        }
1413        undef $item;
1414        undef $sem_session;
1415        undef $product;
1416        undef $location;
1417        return 0;
1418      },
1419      item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
1420      product =>
1421      sub {
1422        return tag_article($product, $cfg, $_[0]);
1423      },
1424      extended =>
1425      sub {
1426        my $what = $_[0] || 'retailPrice';
1427        $items[$item_index]{units} * $items[$item_index]{$what};
1428      },
1429      order => sub { escape_html($order->{$_[0]}) },
1430      iterate_options_reset => sub { $option_index = -1 },
1431      iterate_options => sub { ++$option_index < @options },
1432      option => sub { escape_html($options[$option_index]{$_[0]}) },
1433      ifOptions => sub { @options },
1434      options => sub { nice_options(@options) },
1435      ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
1436      #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1437      session => [ \&tag_session, \$item, \$sem_session ],
1438      location => [ \&tag_location, \$item, \$location ],
1439      msg => $message,
1440      delivery_in => $order->{delivery_in},
1441      shipping_cost => $order->{shipping_cost},
1442      shipping_method => $order->{shipping_method},
1443      $it->make
1444      (
1445       single => "orderpaidfile",
1446       plural => "orderpaidfiles",
1447       code => [ paid_files => $order ],
1448      ),
1449     );
1450   for my $type (@pay_types) {
1451     my $id = $type->{id};
1452     my $name = $type->{name};
1453     $acts{"if${name}Payment"} = $order->{paymentType} == $id;
1454   }
1455
1456   $req->set_variable(order => $order);
1457   $req->set_variable(payment_types => \@pay_types);
1458
1459   return $req->response('checkoutfinal', \%acts);
1460 }
1461
1462 sub tag_session {
1463   my ($ritem, $rsession, $arg) = @_;
1464
1465   $$ritem or return '';
1466
1467   $$ritem->{session_id} or return '';
1468
1469   unless ($$rsession) {
1470     require BSE::TB::SeminarSessions;
1471     $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
1472       or return '';
1473   }
1474
1475   my $value = $$rsession->{$arg};
1476   defined $value or return '';
1477
1478   escape_html($value);
1479 }
1480
1481 sub tag_location {
1482   my ($ritem, $rlocation, $arg) = @_;
1483
1484   $$ritem or return '';
1485
1486   $$ritem->{session_id} or return '';
1487
1488   unless ($$rlocation) {
1489     require BSE::TB::Locations;
1490     ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
1491       or return '';
1492   }
1493
1494   my $value = $$rlocation->{$arg};
1495   defined $value or return '';
1496
1497   escape_html($value);
1498 }
1499
1500 sub tag_ifPayment {
1501   my ($payment, $types_by_name, $args) = @_;
1502
1503   my $type = $args;
1504   if ($type !~ /^\d+$/) {
1505     return '' unless exists $types_by_name->{$type};
1506     $type = $types_by_name->{$type};
1507   }
1508
1509   return $payment == $type;
1510 }
1511
1512 sub tag_paymentTypeId {
1513   my ($types_by_name, $args) = @_;
1514
1515   if (exists $types_by_name->{$args}) {
1516     return $types_by_name->{$args};
1517   }
1518
1519   return '';
1520 }
1521
1522
1523 sub _validate_cfg {
1524   my ($class, $req, $rmsg) = @_;
1525
1526   my $cfg = $req->cfg;
1527   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1528   unless ($from && $from =~ /.\@./) {
1529     $$rmsg = "Configuration error: shop from address not set";
1530     return;
1531   }
1532   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1533   unless ($toEmail && $toEmail =~ /.\@./) {
1534     $$rmsg = "Configuration error: shop to_email address not set";
1535     return;
1536   }
1537
1538   return 1;
1539 }
1540
1541 sub req_recalc {
1542   my ($class, $req) = @_;
1543
1544   $class->update_quantities($req);
1545   $req->session->{order_info_confirmed} = 0;
1546
1547   my $refresh = $req->cgi->param('r');
1548   unless ($refresh) {
1549     $refresh = $req->user_url(shop => 'cart');
1550   }
1551
1552   return $req->get_refresh($refresh);
1553 }
1554
1555 sub req_recalculate {
1556   my ($class, $req) = @_;
1557
1558   return $class->req_recalc($req);
1559 }
1560
1561 sub _send_order {
1562   my ($class, $req, $order) = @_;
1563
1564   my $cfg = $req->cfg;
1565   my $cgi = $req->cgi;
1566
1567   my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
1568   my $crypto_class = $cfg->entry('shop', 'crypt_module',
1569                                  $Constants::SHOP_CRYPTO);
1570   my $signing_id = $cfg->entry('shop', 'crypt_signing_id',
1571                                $Constants::SHOP_SIGNING_ID);
1572   my $pgp = $cfg->entry('shop', 'crypt_pgp', $Constants::SHOP_PGP);
1573   my $pgpe = $cfg->entry('shop', 'crypt_pgpe', $Constants::SHOP_PGPE);
1574   my $gpg = $cfg->entry('shop', 'crypt_gpg', $Constants::SHOP_GPG);
1575   my $passphrase = $cfg->entry('shop', 'crypt_passphrase',
1576                                $Constants::SHOP_PASSPHRASE);
1577   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1578   my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
1579   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1580   my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
1581
1582   my $session = $req->session;
1583   my %extras = $cfg->entriesCS('extra tags');
1584   for my $key (keys %extras) {
1585     # follow any links
1586     my $data = $cfg->entryVar('extra tags', $key);
1587     $extras{$key} = sub { $data };
1588   }
1589
1590   my @items = $order->items;
1591   my @products = map $_->product, @items;
1592   my %subscribing_to;
1593   for my $product (@products) {
1594     my $sub = $product->subscription;
1595     if ($sub) {
1596       $subscribing_to{$sub->{text_id}} = $sub;
1597     }
1598   }
1599
1600   my $item_index = -1;
1601   my @options;
1602   my $option_index;
1603   my %acts;
1604   %acts =
1605     (
1606      %extras,
1607      custom_class($cfg)
1608      ->order_mail_actions(\%acts, $order, \@items, \@products,
1609                           $session->{custom}, $cfg),
1610      BSE::Util::Tags->mail_tags(),
1611      $order->mail_tags(),
1612      ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1613     );
1614
1615   my %vars =
1616     (
1617      order => $order,
1618     );
1619
1620   my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
1621   require BSE::ComposeMail;
1622   if ($email_order) {
1623     unless ($noencrypt) {
1624       $acts{cardNumber} = $cgi->param('cardNumber');
1625       $acts{cardExpiry} = $cgi->param('cardExpiry');
1626       $acts{cardVerify} = $cgi->param('cardVerify');
1627       @vars{qw(cardNumber cardExpiry cardVerify)} =
1628         @acts{qw(cardNumber cardExpiry cardVerify)};
1629     }
1630
1631     my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1632     $mailer->start
1633       (
1634        to=>$toEmail,
1635        from=>$from,
1636        subject=>'New Order '.$order->{id},
1637        acts => \%acts,
1638        template => "mailorder",
1639        log_component => "shop:sendorder:mailowner",
1640        log_object => $order,
1641        log_msg => "Send Order No. $order->{id} to admin",
1642        vars => \%vars,
1643       );
1644
1645     unless ($noencrypt) {
1646       my %crypt_opts;
1647       my $sign = $cfg->entryBool('basic', 'sign', 1);
1648       $sign or $crypt_opts{signing_id} = "";
1649       $crypt_opts{recipient} =
1650         $cfg->entry("shop", "crypt_recipient", "$toName $toEmail");
1651       $mailer->encrypt_body(%crypt_opts);
1652     }
1653
1654     unless ($mailer->done) {
1655       $req->flash_error("Could not mail order to admin: " . $mailer->errstr);
1656     }
1657
1658     delete @acts{qw/cardNumber cardExpiry cardVerify/};
1659     delete @vars{qw/cardNumber cardExpiry cardVerify/};
1660   }
1661   my $to_email = $order->billEmail;
1662   my $user = $req->siteuser;
1663   my $to = $to_email;
1664   if ($user && $user->email eq $to_email) {
1665     $to = $user;
1666   }
1667   my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1668   my %opts =
1669     (
1670      to => $to,
1671      from => $from,
1672      subject => $subject . " " . localtime,
1673      template => "mailconfirm",
1674      acts => \%acts,
1675      log_component => "shop:sendorder:mailbuyer",
1676      log_object => $order,
1677      log_msg => "Send Order No. $order->{id} to customer ($to_email)",
1678      vars => \%vars,
1679     );
1680   my $bcc_order = $cfg->entry("shop", "bcc_email");
1681   if ($bcc_order) {
1682     $opts{bcc} = $bcc_order;
1683   }
1684   $mailer->send(%opts)
1685     or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1686 }
1687
1688 sub _refresh_logon {
1689   my ($class, $req, $msg, $msgid, $r, $parms) = @_;
1690
1691   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1692   my $url = $securlbase."/cgi-bin/user.pl";
1693   $parms ||= { checkout => 1 };
1694
1695   unless ($r) {
1696     $r = $securlbase."/cgi-bin/shop.pl?"
1697       . join("&", map "$_=" . escape_uri($parms->{$_}), keys %$parms);
1698   }
1699
1700   my %parms;
1701   if ($req->cfg->entry('shop registration', 'all')
1702       || $req->cfg->entry('shop registration', $msgid)) {
1703     $parms{show_register} = 1;
1704   }
1705   $parms{r} = $r;
1706   if ($msgid) {
1707     $msg = $req->cfg->entry('messages', $msgid, $msg);
1708   }
1709   $parms{m} = $msg if $msg;
1710   $parms{mid} = $msgid if $msgid;
1711   $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1712
1713   return BSE::Template->get_refresh($url, $req->cfg);
1714 }
1715
1716 sub tag_checkedPayment {
1717   my ($payment, $types_by_name, $args) = @_;
1718
1719   my $type = $args;
1720   if ($type !~ /^\d+$/) {
1721     return '' unless exists $types_by_name->{$type};
1722     $type = $types_by_name->{$type};
1723   }
1724
1725   return $payment == $type  ? 'checked="checked"' : '';
1726 }
1727
1728 sub tag_ifPayments {
1729   my ($enabled, $types_by_name, $args) = @_;
1730
1731   my $type = $args;
1732   if ($type !~ /^\d+$/) {
1733     return '' unless exists $types_by_name->{$type};
1734     $type = $types_by_name->{$type};
1735   }
1736
1737   my @found = grep $_ == $type, @$enabled;
1738
1739   return scalar @found;
1740 }
1741
1742 sub update_quantities {
1743   my ($class, $req) = @_;
1744
1745   # FIXME: should use the cart class to update quantities
1746   my $session = $req->session;
1747   my $cgi = $req->cgi;
1748   my $cfg = $req->cfg;
1749   my @cart = @{$session->{cart} || []};
1750   for my $index (0..$#cart) {
1751     my $new_quantity = $cgi->param("quantity_$index");
1752     if (defined $new_quantity) {
1753       if ($new_quantity =~ /^\s*(\d+)/) {
1754         $cart[$index]{units} = $1;
1755       }
1756       elsif ($new_quantity =~ /^\s*$/) {
1757         $cart[$index]{units} = 0;
1758       }
1759     }
1760   }
1761   @cart = grep { $_->{units} != 0 } @cart;
1762   $session->{cart} = \@cart;
1763   $session->{custom} ||= {};
1764   my %custom_state = %{$session->{custom}};
1765   custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1766   $session->{custom} = \%custom_state;
1767
1768   my ($coupon) = $cgi->param("coupon");
1769   if (defined $coupon) {
1770     my $cart = $req->cart;
1771     $cart->set_coupon_code($coupon);
1772   }
1773 }
1774
1775 sub _build_items {
1776   my ($class, $req) = @_;
1777
1778   my $session = $req->session;
1779   my $cart = $req->cart;
1780   $session->{cart}
1781     or return;
1782   my @msgs;
1783   my @cart = @{$req->session->{cart}}
1784     or return;
1785   my @items;
1786   my @prodcols = BSE::TB::Product->columns;
1787   my @newcart;
1788   my $today = now_sqldate();
1789   for my $item ($cart->items) {
1790     my %work = %$item;
1791     my $product = $item->product;
1792     if ($product) {
1793       $product->is_released
1794         or do { push @msgs, "'$product->{title}' has not been released yet";
1795                 next; };
1796       $product->is_expired
1797         and do { push @msgs, "'$product->{title}' has expired"; next; };
1798       $product->listed
1799         or do { push @msgs, "'$product->{title}' not available"; next; };
1800
1801       for my $col (@prodcols) {
1802         $work{$col} = $product->$col() unless exists $work{$col};
1803       }
1804       my ($price, $tier) = $product->price(user => scalar $req->siteuser);
1805       $work{price} = $price;
1806       $work{tier_id} = $tier ? $tier->id : undef;
1807       $work{extended_retailPrice} = $work{units} * $work{price};
1808       $work{extended_gst} = $work{units} * $work{gst};
1809       $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1810
1811       push @newcart, \%work;
1812     }
1813   }
1814
1815   # we don't use these for anything for now
1816   #if (@msgs) {
1817   #  @$rmsg = @msgs;
1818   #}
1819
1820   return @newcart;
1821 }
1822
1823 sub _fillout_order {
1824   my ($class, $req, $values, $rmsg, $how) = @_;
1825
1826   my $session = $req->session;
1827   my $cfg = $req->cfg;
1828   my $cgi = $req->cgi;
1829
1830   my $cart = $req->cart($how);
1831
1832   if ($cart->is_empty) {
1833     $$rmsg = "Your cart is empty";
1834     return;
1835   }
1836
1837   # FIXME? this doesn't take discounting into effect
1838   $values->{gst} = $cart->gst;
1839   $values->{wholesaleTotal} = $cart->wholesaleTotal;
1840
1841   my $items = $cart->items;
1842   my $products = $cart->products;
1843   my $prompt_ship = $cart->cfg_shipping;
1844   if ($prompt_ship) {
1845     if (_any_physical_products($products)) {
1846       my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1847       my $country_code = bse_country_code($values->{delivCountry});
1848       if ($courier) {
1849         unless ($courier->can_deliver(country => $country_code,
1850                                       suburb => $values->{delivSuburb},
1851                                       postcode => $values->{delivPostCode})) {
1852           $cgi->param("courier", undef);
1853           $$rmsg =
1854             "Can't use the selected courier ".
1855               "(". $courier->description(). ") for this order.";
1856           return;
1857         }
1858         my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1859         my $cost = $courier->calculate_shipping
1860           (
1861            parcels => \@parcels,
1862            country => $country_code,
1863            suburb => $values->{delivSuburb},
1864            postcode => $values->{delivPostCode},
1865            products => $products,
1866            items => $items,
1867           );
1868         if (!defined $cost and $courier->name() ne 'contact') {
1869           my $err = $courier->error_message();
1870           $$rmsg = "Error calculating shipping cost";
1871           $$rmsg .= ": $err" if $err;
1872           return;
1873         }
1874         $values->{shipping_method} = $courier->description();
1875         $values->{shipping_name} = $courier->name;
1876         $values->{shipping_cost} = $cost;
1877         $values->{shipping_trace} = $courier->trace;
1878         $values->{delivery_in} = $courier->delivery_in();
1879       }
1880       else {
1881         # XXX: What to do?
1882         $$rmsg = "Error: no usable courier found.";
1883         return;
1884       }
1885     }
1886     else {
1887       $values->{shipping_method} = "Nothing to ship!";
1888       $values->{shipping_name} = "none";
1889       $values->{shipping_cost} = 0;
1890       $values->{shipping_trace} = "All products have zero weight.";
1891     }
1892   }
1893   if ($cart->coupon_active) {
1894     $values->{coupon_id} = $cart->coupon->id;
1895   }
1896   else {
1897     $values->{coupon_id} = undef;
1898   }
1899   $cart->set_shipping_cost($values->{shipping_cost});
1900   $cart->set_shipping_method($values->{shipping_method});
1901   $cart->set_shipping_name($values->{shipping_name});
1902   $cart->set_delivery_in($values->{delivery_in});
1903
1904   $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1905   $values->{total} = $cart->total;
1906
1907   my $cust_class = custom_class($cfg);
1908
1909   eval {
1910     local $SIG{__DIE__};
1911     $session->{custom} = $cart->custom_state || {};
1912     my %custom = %{$session->{custom}};
1913     $cust_class->order_save($cgi, $values, $items, $items,
1914                             \%custom, $cfg);
1915     $session->{custom} = \%custom;
1916   };
1917   if ($@) {
1918     $$rmsg = $@;
1919     return;
1920   }
1921
1922   $values->{total} +=
1923     $cust_class->total_extras($items, $items,
1924                               $session->{custom}, $cfg, $how);
1925
1926   my $affiliate_code = $session->{affiliate_code};
1927   defined $affiliate_code && length $affiliate_code
1928     or $affiliate_code = $cgi->param('affiliate_code');
1929   defined $affiliate_code or $affiliate_code = '';
1930   $values->{affiliate_code} = $affiliate_code;
1931
1932   my $user = $req->siteuser;
1933   if ($user) {
1934     $values->{userId} = $user->{userId};
1935     $values->{siteuser_id} = $user->{id};
1936   }
1937   else {
1938     $values->{userId} = '';
1939     $values->{siteuser_id} = -1;
1940   }
1941
1942   $values->{orderDate} = now_sqldatetime;
1943
1944   # this should be hard to guess
1945   $values->{randomId} = md5_hex(time().rand().{}.$$);
1946
1947   return 1;
1948 }
1949
1950 sub action_prefix { '' }
1951
1952 sub req_location {
1953   my ($class, $req) = @_;
1954
1955   require BSE::TB::Locations;
1956   my $cgi = $req->cgi;
1957   my $location_id = $cgi->param('location_id');
1958   my $location;
1959   if (defined $location_id && $location_id =~ /^\d+$/) {
1960     $location = BSE::TB::Locations->getByPkey($location_id);
1961     my %acts;
1962     %acts =
1963       (
1964        BSE::Util::Tags->static(\%acts, $req->cfg),
1965        location => [ \&tag_hash, $location ],
1966       );
1967
1968     return $req->response('location', \%acts);
1969   }
1970   else {
1971     return
1972       {
1973        type=>BSE::Template->get_type($req->cfg, 'error'),
1974        content=>"Missing or invalid location_id",
1975       };
1976   }
1977 }
1978
1979 sub _validate_add_by_id {
1980   my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1981
1982   my $product;
1983   if ($addid) {
1984     $product = BSE::TB::Seminars->getByPkey($addid);
1985     $product ||= BSE::TB::Products->getByPkey($addid);
1986   }
1987   unless ($product) {
1988     $$error = "Cannot find product $addid";
1989     return;
1990   }
1991
1992   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1993 }
1994
1995 sub _validate_add_by_code {
1996   my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
1997
1998   my $product;
1999   if (defined $code) {
2000     $product = BSE::TB::Seminars->getBy(product_code => $code);
2001     $product ||= BSE::TB::Products->getBy(product_code => $code);
2002   }
2003   unless ($product) {
2004     $$error = "Cannot find product code $code";
2005     return;
2006   }
2007
2008   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2009 }
2010
2011 sub _validate_add {
2012   my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2013
2014   # collect the product options
2015   my @options;
2016   my @option_descs =  $product->option_descs($req->cfg);
2017   my @option_names = map $_->{name}, @option_descs;
2018   my @not_def;
2019   my $cgi = $req->cgi;
2020   for my $name (@option_names) {
2021     my $value = $cgi->param($name);
2022     push @options, $value;
2023     unless (defined $value) {
2024       push @not_def, $name;
2025     }
2026   }
2027   if (@not_def) {
2028     $$error = "Some product options (@not_def) not supplied";
2029     return;
2030   }
2031
2032   # the product must be non-expired and listed
2033   (my $comp_release = $product->{release}) =~ s/ .*//;
2034   (my $comp_expire = $product->{expire}) =~ s/ .*//;
2035   my $today = now_sqldate();
2036   unless ($comp_release le $today) {
2037     $$error = "Product $product->{title} has not been released yet";
2038     return;
2039   }
2040   unless ($today le $comp_expire) {
2041     $$error = "Product $product->{title} has expired";
2042     return;
2043   }
2044   unless ($product->{listed}) {
2045     $$error = "Product $product->{title} not available";
2046     return;
2047   }
2048
2049   # used to refresh if a logon is needed
2050   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2051   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2052   for my $opt_index (0..$#option_names) {
2053     $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2054   }
2055
2056   my $user = $req->siteuser;
2057   # need to be logged on if it has any subs
2058   if ($product->{subscription_id} != -1) {
2059     if ($user) {
2060       my $sub = $product->subscription;
2061       if ($product->is_renew_sub_only) {
2062         unless ($user->subscribed_to_grace($sub)) {
2063           $$error = "The product $product->{title} can only be used to renew your subscription to $sub->{title} and you are not subscribed nor within the renewal grace period";
2064           return;
2065         }
2066       }
2067       elsif ($product->is_start_sub_only) {
2068         if ($user->subscribed_to_grace($sub)) {
2069           $$error = "The product $product->{title} can only be used to start your subscription to $sub->{title} and you are already subscribed or within the grace period";
2070           return;
2071         }
2072       }
2073     }
2074     else {
2075       $$refresh_logon =
2076         [  "You must be logged on to add this product to your cart",
2077            'prodlogon', $r ];
2078       return;
2079     }
2080   }
2081   if ($product->{subscription_required} != -1) {
2082     my $sub = $product->subscription_required;
2083     if ($user) {
2084       unless ($user->subscribed_to($sub)) {
2085         $$error = "You must be subscribed to $sub->{title} to purchase this product";
2086         return;
2087       }
2088     }
2089     else {
2090       # we want to refresh back to adding the item to the cart if possible
2091       $$refresh_logon =
2092         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2093          'prodlogonsub', $r ];
2094       return;
2095     }
2096   }
2097
2098   # we need a natural integer quantity
2099   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2100     $$error = "Invalid quantity";
2101     return;
2102   }
2103
2104   my %extras;
2105   if ($product->isa('BSE::TB::Seminar')) {
2106     # you must be logged on to add a seminar
2107     unless ($user) {
2108       $$refresh_logon =
2109         [ "You must be logged on to add seminars to your cart",
2110           'seminarlogon', $r ];
2111       return;
2112     }
2113
2114     # get and validate the session
2115     my $session_id = $cgi->param('session_id');
2116     unless (defined $session_id) {
2117       $$error = "Please select a session when adding a seminar";
2118       return;
2119     }
2120
2121     unless ($session_id =~ /^\d+$/) {
2122       $$error = "Invalid session_id supplied";
2123       return;
2124     }
2125
2126     require BSE::TB::SeminarSessions;
2127     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2128     unless ($session) {
2129       $$error = "Unknown session id supplied";
2130       return;
2131     }
2132     unless ($session->{seminar_id} == $product->{id}) {
2133       $$error = "Session not for this seminar";
2134       return;
2135     }
2136
2137     # check if the user is already booked for this session
2138     if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2139       $$error = "You are already booked for this session";
2140       return;
2141     }
2142
2143     $extras{session_id} = $session_id;
2144   }
2145
2146   return ( $product, \@options, \%extras );
2147 }
2148
2149 sub _add_refresh {
2150   my ($refresh, $req, $started_empty) = @_;
2151
2152   my $cfg = $req->cfg;
2153   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2154   if ($started_empty && !$cookie_domain) {
2155     my $base_url = $cfg->entryVar('site', 'url');
2156     my $secure_url = $cfg->entryVar('site', 'secureurl');
2157     if ($base_url ne $secure_url) {
2158       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2159
2160       # magical refresh time
2161       # which host are we on?
2162       # first get info about the 2 possible hosts
2163       my ($baseprot, $basehost, $baseport) =
2164         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2165       $baseport ||= $baseprot eq 'http' ? 80 : 443;
2166       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
2167         if $debug;
2168
2169       #my ($secprot, $sechost, $secport) =
2170       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2171
2172       my $onbase = 1;
2173       # get info about the current host
2174       my $port = $ENV{SERVER_PORT} || 80;
2175       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2176       print STDERR "\$ishttps: $ishttps\n" if $debug;
2177       my $protocol = $ishttps ? 'https' : 'http';
2178
2179       if (lc $ENV{SERVER_NAME} ne lc $basehost
2180           || lc $protocol ne $baseprot
2181           || $baseport != $port) {
2182         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
2183         $onbase = 0;
2184       }
2185       my $base = $onbase ? $secure_url : $base_url;
2186       my $finalbase = $onbase ? $base_url : $secure_url;
2187       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2188       my $sessionid = $req->session->{_session_id};
2189       require BSE::SessionSign;
2190       my $sig = BSE::SessionSign->make($sessionid);
2191       my $url = $cfg->user_url("user", undef,
2192                                -base => $base,
2193                                setcookie => $sessionid,
2194                                s => $sig,
2195                                r => $refresh);
2196       print STDERR "Heading to $url to setcookie\n" if $debug;
2197       return $req->get_refresh($url);
2198     }
2199   }
2200
2201   return $req->get_refresh($refresh);
2202 }
2203
2204 sub _same_options {
2205   my ($left, $right) = @_;
2206
2207   for my $index (0 .. $#$left) {
2208     my $left_value = $left->[$index];
2209     my $right_value = $right->[$index];
2210     defined $right_value
2211       or return;
2212     $left_value eq $right_value
2213       or return;
2214   }
2215
2216   return 1;
2217 }
2218
2219 sub _paypal_order {
2220   my ($self, $req, $rmsg) = @_;
2221
2222   my $id = $req->cgi->param("order");
2223   unless ($id) {
2224     $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2225     return;
2226   }
2227   my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2228   unless ($order) {
2229     $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2230     return;
2231   }
2232
2233   return $order;
2234 }
2235
2236 =item paypalret
2237
2238 Handles PayPal returning control.
2239
2240 Expects:
2241
2242 =over
2243
2244 =item *
2245
2246 order - the randomId of the order
2247
2248 =item *
2249
2250 token - paypal token we originally supplied to paypal.  Supplied by
2251 PayPal.
2252
2253 =item *
2254
2255 PayerID - the paypal user who paid the order.  Supplied by PayPal.
2256
2257 =back
2258
2259 =cut
2260
2261 sub req_paypalret {
2262   my ($self, $req) = @_;
2263
2264   require BSE::PayPal;
2265   BSE::PayPal->configured
2266       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2267
2268   my $msg;
2269   my $order = $self->_paypal_order($req, \$msg)
2270     or return $self->req_show_payment($req, { _ => $msg });
2271
2272   $order->complete
2273     and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2274
2275   unless (BSE::PayPal->pay_order(req => $req,
2276                                  order => $order,
2277                                  msg => \$msg)) {
2278     return $self->req_show_payment($req, { _ => $msg });
2279   }
2280
2281   $self->_finish_order($req, $order);
2282
2283   return $req->get_refresh($req->user_url(shop => "orderdone"));
2284 }
2285
2286 sub req_paypalcan {
2287   my ($self, $req) = @_;
2288
2289   require BSE::PayPal;
2290   BSE::PayPal->configured
2291       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2292
2293   my $msg;
2294   my $order = $self->_paypal_order($req, \$msg)
2295     or return $self->req_show_payment($req, { _ => $msg });
2296
2297   $req->flash_notice("msg:bse/shop/paypal/cancelled");
2298
2299   my $url = $req->user_url(shop => "show_payment");
2300   return $req->get_refresh($url);
2301 }
2302
2303 sub _refresh_cart {
2304   my ($self, $req) = @_;
2305
2306   my $user = $req->siteuser
2307     or return;
2308
2309   my $cart = $req->session->{cart}
2310     or return;
2311
2312   for my $item (@$cart) {
2313     if (!$item->{user} || $item->{user} != $user->id) {
2314       my $product = BSE::TB::Products->getByPkey($item->{productId})
2315         or next;
2316       my ($price, $tier) = $product->price(user => $user);
2317       $item->{price} = $price;
2318       $item->{tier} = $tier ? $tier->id : "";
2319     }
2320   }
2321
2322   $req->session->{cart} = $cart;
2323 }
2324
2325 1;
2326
2327 =back
2328
2329 =head1 TAGS
2330
2331 =head2 Cart page
2332
2333 =over 4
2334
2335 =item iterator ... items
2336
2337 Iterates over the items in the shopping cart, setting the C<item> tag
2338 for each one.
2339
2340 =item item I<field>
2341
2342 Retreives the given field from the item.  This can include product
2343 fields for this item.
2344
2345 =item index
2346
2347 The numeric index of the current item.
2348
2349 =item extended [<field>]
2350
2351 The "extended price", the product of the unit cost and the number of
2352 units for the current item in the cart.  I<field> defaults to the
2353 price of the product.
2354
2355 =item money I<which> <field>
2356
2357 Formats the given field as a money value (without a currency symbol.)
2358
2359 =item count
2360
2361 The number of items in the cart.
2362
2363 =item ifUser
2364
2365 Conditional tag, true if a registered user is logged in.
2366
2367 =item user I<field>
2368
2369 Retrieved the given field from the currently logged in user, if any.
2370
2371 =back
2372
2373 =head2 Checkout tags
2374
2375 This has the same tags as the L<Cart page>, and some extras:
2376
2377 =over 4
2378
2379 =item total
2380
2381 The total cost of all items in the cart.
2382
2383 This will need to be formatted as a money value with the C<money> tag.
2384
2385 =item message
2386
2387 An error message, if a validation error occurred.
2388
2389 =item old I<field>
2390
2391 The previously entered value for I<field>.  This should be used as the
2392 value for the various checkout fields, so that if a validation error
2393 occurs the user won't need to re-enter values.
2394
2395 =back
2396
2397 =head2 Completed order
2398
2399 These tags are used in the F<checkoutfinal_base.tmpl>.
2400
2401 =over 4
2402
2403 =item item I<field>
2404
2405 =item product I<field>
2406
2407 This is split out for these forms.
2408
2409 =item order I<field>
2410
2411 Order fields.
2412
2413 =item ifSubscribingTo I<subid>
2414
2415 Can be used to check if this order is intended to be subscribing to a
2416 subscription.
2417
2418 =back
2419
2420 =head2 Mailed order tags
2421
2422 These tags are used in the emails sent to the user to confirm an order
2423 and in the encrypted copy sent to the site administrator:
2424
2425 =over 4
2426
2427 =item *
2428
2429 C<iterate> ... C<items>
2430
2431 Iterates over the items in the order.
2432
2433 =item *
2434
2435 C<item> I<field>
2436
2437 Access to the given field in the order item.
2438
2439 =item *
2440
2441 C<product> I<field>
2442
2443 Access to the product field for the current order item.
2444
2445 =item *
2446
2447 C<order> I<field>
2448
2449 Access to fields of the order.
2450
2451 =item *
2452
2453 C<extended> I<field>
2454
2455 The product of the I<field> in the current item and it's quantity.
2456
2457 =item *
2458
2459 C<money> I<tag> I<parameters>
2460
2461 Formats the given field as a money value.
2462
2463 =back
2464
2465 The mail generation template can use extra formatting specified with
2466 '|format':
2467
2468 =over 4
2469
2470 =item *
2471
2472 m<number>
2473
2474 Format the value as a I<number> wide money value.
2475
2476 =item *
2477
2478 %<format>
2479
2480 Performs sprintf formatting on the value.
2481
2482 =item *
2483
2484 <number>
2485
2486 Left justifies the value in a I<number> wide field.
2487
2488 =back
2489
2490 The order email sent to the site administrator has a couple of extra
2491 fields:
2492
2493 =over
2494
2495 =item *
2496
2497 cardNumber
2498
2499 The credit card number of the user's credit card.
2500
2501 =item *
2502
2503 cardExpiry
2504
2505 The entered expiry date for the user's credit card.
2506
2507 =back
2508
2509 =head2 Order fields
2510
2511 These names can be used with the <: order ... :> tag.
2512
2513 Monetary values should typically be used with <:money order ...:>
2514
2515 =over
2516
2517 =item *
2518
2519 id
2520
2521 The order id or order number.
2522
2523 =item *
2524
2525 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2526 delivPostCode, delivCountry - Delivery information for the order.
2527
2528 =item *
2529
2530 billFirstName, billLastName, billStreet, billSuburb, billState,
2531 billPostCode, billCountry - Billing information for the order.
2532
2533 =item *
2534
2535 telephone, facsimile, emailAddress - Contact information for the
2536 order.
2537
2538 =item *
2539
2540 total - Total price of the order.
2541
2542 =item *
2543
2544 wholesaleTotal - Wholesale cost of the total.  Your costs, if you
2545 entered wholesale prices for the products.
2546
2547 =item *
2548
2549 gst - GST (in Australia) payable on the order, if you entered GST for
2550 the products.
2551
2552 =item *
2553
2554 orderDate - When the order was made.
2555
2556 =item *
2557
2558 filled - Whether or not the order has been filled.  This can be used
2559 with the order_filled target in shopadmin.pl for tracking filled
2560 orders.
2561
2562 =item *
2563
2564 whenFilled - The time and date when the order was filled.
2565
2566 =item *
2567
2568 whoFilled - The user who marked the order as filled.
2569
2570 =item *
2571
2572 paidFor - Whether or not the order has been paid for.  This can be
2573 used with a custom purchasing handler to mark the product as paid for.
2574 You can then filter the order list to only display paid for orders.
2575
2576 =item *
2577
2578 paymentReceipt - A custom payment handler can fill this with receipt
2579 information.
2580
2581 =item *
2582
2583 randomId - Generated by the prePurchase target, this can be used as a
2584 difficult to guess identifier for orders, when working with custom
2585 payment handlers.
2586
2587 =item *
2588
2589 cancelled - This can be used by a custom payment handler to mark an
2590 order as cancelled if the user starts processing an order without
2591 completing payment.
2592
2593 =back
2594
2595 =head2 Order item fields
2596
2597 =over
2598
2599 =item *
2600
2601 productId - The product id of this item.
2602
2603 =item *
2604
2605 orderId - The order Id.
2606
2607 =item *
2608
2609 units - The number of units for this item.
2610
2611 =item *
2612
2613 price - The price paid for the product.
2614
2615 =item *
2616
2617 wholesalePrice - The wholesale price for the product.
2618
2619 =item *
2620
2621 gst - The gst for the product.
2622
2623 =item *
2624
2625 options - A comma separated list of options specified for this item.
2626 These correspond to the option names in the product.
2627
2628 =back
2629
2630 =head2 Options
2631
2632 New with 0.10_04 is the facility to set options for each product.
2633
2634 The cart, checkout and checkoutfinal pages now include the following
2635 tags:
2636
2637 =over
2638
2639 =item *
2640
2641 C<iterator> ... <options>
2642
2643 within an item, iterates over the options for this item in the cart.
2644 Sets the item tag.
2645
2646 =item *
2647
2648 C<option> I<field>
2649
2650 Retrieves the given field from the option, possible field names are:
2651
2652 =over
2653
2654 =item *
2655
2656 id - The type/identifier for this option.  eg. msize for a male
2657 clothing size field.
2658
2659 =item *
2660
2661 value - The underlying value of the option, eg. XL.
2662
2663 =item *
2664
2665 desc - The description of the field from the product options hash.  If
2666 the description isn't defined this is the same as the id. eg. Size.
2667
2668 =item *
2669
2670 label - The description of the value from the product options hash.
2671 eg. "Extra large".
2672
2673 =back
2674
2675 =item *
2676
2677 ifOptions - A conditional tag, true if the current cart item has any
2678 options.
2679
2680 =item *
2681
2682 options - A simple rendering of the options as a parenthesized
2683 comma-separated list.
2684
2685 =back
2686
2687 =cut