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.048";
  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       $work{price} = $product->price(user => scalar $req->siteuser);
1805       $work{extended_retailPrice} = $work{units} * $work{price};
1806       $work{extended_gst} = $work{units} * $work{gst};
1807       $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1808
1809       push @newcart, \%work;
1810     }
1811   }
1812
1813   # we don't use these for anything for now
1814   #if (@msgs) {
1815   #  @$rmsg = @msgs;
1816   #}
1817
1818   return @newcart;
1819 }
1820
1821 sub _fillout_order {
1822   my ($class, $req, $values, $rmsg, $how) = @_;
1823
1824   my $session = $req->session;
1825   my $cfg = $req->cfg;
1826   my $cgi = $req->cgi;
1827
1828   my $cart = $req->cart($how);
1829
1830   if ($cart->is_empty) {
1831     $$rmsg = "Your cart is empty";
1832     return;
1833   }
1834
1835   # FIXME? this doesn't take discounting into effect
1836   $values->{gst} = $cart->gst;
1837   $values->{wholesaleTotal} = $cart->wholesaleTotal;
1838
1839   my $items = $cart->items;
1840   my $products = $cart->products;
1841   my $prompt_ship = $cart->cfg_shipping;
1842   if ($prompt_ship) {
1843     if (_any_physical_products($products)) {
1844       my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1845       my $country_code = bse_country_code($values->{delivCountry});
1846       if ($courier) {
1847         unless ($courier->can_deliver(country => $country_code,
1848                                       suburb => $values->{delivSuburb},
1849                                       postcode => $values->{delivPostCode})) {
1850           $cgi->param("courier", undef);
1851           $$rmsg =
1852             "Can't use the selected courier ".
1853               "(". $courier->description(). ") for this order.";
1854           return;
1855         }
1856         my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1857         my $cost = $courier->calculate_shipping
1858           (
1859            parcels => \@parcels,
1860            country => $country_code,
1861            suburb => $values->{delivSuburb},
1862            postcode => $values->{delivPostCode},
1863            products => $products,
1864            items => $items,
1865           );
1866         if (!defined $cost and $courier->name() ne 'contact') {
1867           my $err = $courier->error_message();
1868           $$rmsg = "Error calculating shipping cost";
1869           $$rmsg .= ": $err" if $err;
1870           return;
1871         }
1872         $values->{shipping_method} = $courier->description();
1873         $values->{shipping_name} = $courier->name;
1874         $values->{shipping_cost} = $cost;
1875         $values->{shipping_trace} = $courier->trace;
1876         $values->{delivery_in} = $courier->delivery_in();
1877       }
1878       else {
1879         # XXX: What to do?
1880         $$rmsg = "Error: no usable courier found.";
1881         return;
1882       }
1883     }
1884     else {
1885       $values->{shipping_method} = "Nothing to ship!";
1886       $values->{shipping_name} = "none";
1887       $values->{shipping_cost} = 0;
1888       $values->{shipping_trace} = "All products have zero weight.";
1889     }
1890   }
1891   if ($cart->coupon_active) {
1892     $values->{coupon_id} = $cart->coupon->id;
1893   }
1894   else {
1895     $values->{coupon_id} = undef;
1896   }
1897   $cart->set_shipping_cost($values->{shipping_cost});
1898   $cart->set_shipping_method($values->{shipping_method});
1899   $cart->set_shipping_name($values->{shipping_name});
1900   $cart->set_delivery_in($values->{delivery_in});
1901
1902   $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1903   $values->{total} = $cart->total;
1904
1905   my $cust_class = custom_class($cfg);
1906
1907   eval {
1908     local $SIG{__DIE__};
1909     $session->{custom} = $cart->custom_state || {};
1910     my %custom = %{$session->{custom}};
1911     $cust_class->order_save($cgi, $values, $items, $items,
1912                             \%custom, $cfg);
1913     $session->{custom} = \%custom;
1914   };
1915   if ($@) {
1916     $$rmsg = $@;
1917     return;
1918   }
1919
1920   $values->{total} +=
1921     $cust_class->total_extras($items, $items,
1922                               $session->{custom}, $cfg, $how);
1923
1924   my $affiliate_code = $session->{affiliate_code};
1925   defined $affiliate_code && length $affiliate_code
1926     or $affiliate_code = $cgi->param('affiliate_code');
1927   defined $affiliate_code or $affiliate_code = '';
1928   $values->{affiliate_code} = $affiliate_code;
1929
1930   my $user = $req->siteuser;
1931   if ($user) {
1932     $values->{userId} = $user->{userId};
1933     $values->{siteuser_id} = $user->{id};
1934   }
1935   else {
1936     $values->{userId} = '';
1937     $values->{siteuser_id} = -1;
1938   }
1939
1940   $values->{orderDate} = now_sqldatetime;
1941
1942   # this should be hard to guess
1943   $values->{randomId} = md5_hex(time().rand().{}.$$);
1944
1945   return 1;
1946 }
1947
1948 sub action_prefix { '' }
1949
1950 sub req_location {
1951   my ($class, $req) = @_;
1952
1953   require BSE::TB::Locations;
1954   my $cgi = $req->cgi;
1955   my $location_id = $cgi->param('location_id');
1956   my $location;
1957   if (defined $location_id && $location_id =~ /^\d+$/) {
1958     $location = BSE::TB::Locations->getByPkey($location_id);
1959     my %acts;
1960     %acts =
1961       (
1962        BSE::Util::Tags->static(\%acts, $req->cfg),
1963        location => [ \&tag_hash, $location ],
1964       );
1965
1966     return $req->response('location', \%acts);
1967   }
1968   else {
1969     return
1970       {
1971        type=>BSE::Template->get_type($req->cfg, 'error'),
1972        content=>"Missing or invalid location_id",
1973       };
1974   }
1975 }
1976
1977 sub _validate_add_by_id {
1978   my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1979
1980   my $product;
1981   if ($addid) {
1982     $product = BSE::TB::Seminars->getByPkey($addid);
1983     $product ||= BSE::TB::Products->getByPkey($addid);
1984   }
1985   unless ($product) {
1986     $$error = "Cannot find product $addid";
1987     return;
1988   }
1989
1990   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1991 }
1992
1993 sub _validate_add_by_code {
1994   my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
1995
1996   my $product;
1997   if (defined $code) {
1998     $product = BSE::TB::Seminars->getBy(product_code => $code);
1999     $product ||= BSE::TB::Products->getBy(product_code => $code);
2000   }
2001   unless ($product) {
2002     $$error = "Cannot find product code $code";
2003     return;
2004   }
2005
2006   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2007 }
2008
2009 sub _validate_add {
2010   my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2011
2012   # collect the product options
2013   my @options;
2014   my @option_descs =  $product->option_descs($req->cfg);
2015   my @option_names = map $_->{name}, @option_descs;
2016   my @not_def;
2017   my $cgi = $req->cgi;
2018   for my $name (@option_names) {
2019     my $value = $cgi->param($name);
2020     push @options, $value;
2021     unless (defined $value) {
2022       push @not_def, $name;
2023     }
2024   }
2025   if (@not_def) {
2026     $$error = "Some product options (@not_def) not supplied";
2027     return;
2028   }
2029
2030   # the product must be non-expired and listed
2031   (my $comp_release = $product->{release}) =~ s/ .*//;
2032   (my $comp_expire = $product->{expire}) =~ s/ .*//;
2033   my $today = now_sqldate();
2034   unless ($comp_release le $today) {
2035     $$error = "Product $product->{title} has not been released yet";
2036     return;
2037   }
2038   unless ($today le $comp_expire) {
2039     $$error = "Product $product->{title} has expired";
2040     return;
2041   }
2042   unless ($product->{listed}) {
2043     $$error = "Product $product->{title} not available";
2044     return;
2045   }
2046
2047   # used to refresh if a logon is needed
2048   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2049   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2050   for my $opt_index (0..$#option_names) {
2051     $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2052   }
2053
2054   my $user = $req->siteuser;
2055   # need to be logged on if it has any subs
2056   if ($product->{subscription_id} != -1) {
2057     if ($user) {
2058       my $sub = $product->subscription;
2059       if ($product->is_renew_sub_only) {
2060         unless ($user->subscribed_to_grace($sub)) {
2061           $$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";
2062           return;
2063         }
2064       }
2065       elsif ($product->is_start_sub_only) {
2066         if ($user->subscribed_to_grace($sub)) {
2067           $$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";
2068           return;
2069         }
2070       }
2071     }
2072     else {
2073       $$refresh_logon =
2074         [  "You must be logged on to add this product to your cart",
2075            'prodlogon', $r ];
2076       return;
2077     }
2078   }
2079   if ($product->{subscription_required} != -1) {
2080     my $sub = $product->subscription_required;
2081     if ($user) {
2082       unless ($user->subscribed_to($sub)) {
2083         $$error = "You must be subscribed to $sub->{title} to purchase this product";
2084         return;
2085       }
2086     }
2087     else {
2088       # we want to refresh back to adding the item to the cart if possible
2089       $$refresh_logon =
2090         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2091          'prodlogonsub', $r ];
2092       return;
2093     }
2094   }
2095
2096   # we need a natural integer quantity
2097   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2098     $$error = "Invalid quantity";
2099     return;
2100   }
2101
2102   my %extras;
2103   if ($product->isa('BSE::TB::Seminar')) {
2104     # you must be logged on to add a seminar
2105     unless ($user) {
2106       $$refresh_logon =
2107         [ "You must be logged on to add seminars to your cart",
2108           'seminarlogon', $r ];
2109       return;
2110     }
2111
2112     # get and validate the session
2113     my $session_id = $cgi->param('session_id');
2114     unless (defined $session_id) {
2115       $$error = "Please select a session when adding a seminar";
2116       return;
2117     }
2118
2119     unless ($session_id =~ /^\d+$/) {
2120       $$error = "Invalid session_id supplied";
2121       return;
2122     }
2123
2124     require BSE::TB::SeminarSessions;
2125     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2126     unless ($session) {
2127       $$error = "Unknown session id supplied";
2128       return;
2129     }
2130     unless ($session->{seminar_id} == $product->{id}) {
2131       $$error = "Session not for this seminar";
2132       return;
2133     }
2134
2135     # check if the user is already booked for this session
2136     if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2137       $$error = "You are already booked for this session";
2138       return;
2139     }
2140
2141     $extras{session_id} = $session_id;
2142   }
2143
2144   return ( $product, \@options, \%extras );
2145 }
2146
2147 sub _add_refresh {
2148   my ($refresh, $req, $started_empty) = @_;
2149
2150   my $cfg = $req->cfg;
2151   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2152   if ($started_empty && !$cookie_domain) {
2153     my $base_url = $cfg->entryVar('site', 'url');
2154     my $secure_url = $cfg->entryVar('site', 'secureurl');
2155     if ($base_url ne $secure_url) {
2156       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2157
2158       # magical refresh time
2159       # which host are we on?
2160       # first get info about the 2 possible hosts
2161       my ($baseprot, $basehost, $baseport) =
2162         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2163       $baseport ||= $baseprot eq 'http' ? 80 : 443;
2164       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
2165         if $debug;
2166
2167       #my ($secprot, $sechost, $secport) =
2168       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2169
2170       my $onbase = 1;
2171       # get info about the current host
2172       my $port = $ENV{SERVER_PORT} || 80;
2173       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2174       print STDERR "\$ishttps: $ishttps\n" if $debug;
2175       my $protocol = $ishttps ? 'https' : 'http';
2176
2177       if (lc $ENV{SERVER_NAME} ne lc $basehost
2178           || lc $protocol ne $baseprot
2179           || $baseport != $port) {
2180         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
2181         $onbase = 0;
2182       }
2183       my $base = $onbase ? $secure_url : $base_url;
2184       my $finalbase = $onbase ? $base_url : $secure_url;
2185       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2186       my $sessionid = $req->session->{_session_id};
2187       require BSE::SessionSign;
2188       my $sig = BSE::SessionSign->make($sessionid);
2189       my $url = $cfg->user_url("user", undef,
2190                                -base => $base,
2191                                setcookie => $sessionid,
2192                                s => $sig,
2193                                r => $refresh);
2194       print STDERR "Heading to $url to setcookie\n" if $debug;
2195       return $req->get_refresh($url);
2196     }
2197   }
2198
2199   return $req->get_refresh($refresh);
2200 }
2201
2202 sub _same_options {
2203   my ($left, $right) = @_;
2204
2205   for my $index (0 .. $#$left) {
2206     my $left_value = $left->[$index];
2207     my $right_value = $right->[$index];
2208     defined $right_value
2209       or return;
2210     $left_value eq $right_value
2211       or return;
2212   }
2213
2214   return 1;
2215 }
2216
2217 sub _paypal_order {
2218   my ($self, $req, $rmsg) = @_;
2219
2220   my $id = $req->cgi->param("order");
2221   unless ($id) {
2222     $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2223     return;
2224   }
2225   my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2226   unless ($order) {
2227     $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2228     return;
2229   }
2230
2231   return $order;
2232 }
2233
2234 =item paypalret
2235
2236 Handles PayPal returning control.
2237
2238 Expects:
2239
2240 =over
2241
2242 =item *
2243
2244 order - the randomId of the order
2245
2246 =item *
2247
2248 token - paypal token we originally supplied to paypal.  Supplied by
2249 PayPal.
2250
2251 =item *
2252
2253 PayerID - the paypal user who paid the order.  Supplied by PayPal.
2254
2255 =back
2256
2257 =cut
2258
2259 sub req_paypalret {
2260   my ($self, $req) = @_;
2261
2262   require BSE::PayPal;
2263   BSE::PayPal->configured
2264       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2265
2266   my $msg;
2267   my $order = $self->_paypal_order($req, \$msg)
2268     or return $self->req_show_payment($req, { _ => $msg });
2269
2270   $order->complete
2271     and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2272
2273   unless (BSE::PayPal->pay_order(req => $req,
2274                                  order => $order,
2275                                  msg => \$msg)) {
2276     return $self->req_show_payment($req, { _ => $msg });
2277   }
2278
2279   $self->_finish_order($req, $order);
2280
2281   return $req->get_refresh($req->user_url(shop => "orderdone"));
2282 }
2283
2284 sub req_paypalcan {
2285   my ($self, $req) = @_;
2286
2287   require BSE::PayPal;
2288   BSE::PayPal->configured
2289       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2290
2291   my $msg;
2292   my $order = $self->_paypal_order($req, \$msg)
2293     or return $self->req_show_payment($req, { _ => $msg });
2294
2295   $req->flash_notice("msg:bse/shop/paypal/cancelled");
2296
2297   my $url = $req->user_url(shop => "show_payment");
2298   return $req->get_refresh($url);
2299 }
2300
2301 sub _refresh_cart {
2302   my ($self, $req) = @_;
2303
2304   my $user = $req->siteuser
2305     or return;
2306
2307   my $cart = $req->session->{cart}
2308     or return;
2309
2310   for my $item (@$cart) {
2311     if (!$item->{user} || $item->{user} != $user->id) {
2312       my $product = BSE::TB::Products->getByPkey($item->{productId})
2313         or next;
2314       my ($price, $tier) = $product->price(user => $user);
2315       $item->{price} = $price;
2316       $item->{tier} = $tier ? $tier->id : "";
2317     }
2318   }
2319
2320   $req->session->{cart} = $cart;
2321 }
2322
2323 1;
2324
2325 =back
2326
2327 =head1 TAGS
2328
2329 =head2 Cart page
2330
2331 =over 4
2332
2333 =item iterator ... items
2334
2335 Iterates over the items in the shopping cart, setting the C<item> tag
2336 for each one.
2337
2338 =item item I<field>
2339
2340 Retreives the given field from the item.  This can include product
2341 fields for this item.
2342
2343 =item index
2344
2345 The numeric index of the current item.
2346
2347 =item extended [<field>]
2348
2349 The "extended price", the product of the unit cost and the number of
2350 units for the current item in the cart.  I<field> defaults to the
2351 price of the product.
2352
2353 =item money I<which> <field>
2354
2355 Formats the given field as a money value (without a currency symbol.)
2356
2357 =item count
2358
2359 The number of items in the cart.
2360
2361 =item ifUser
2362
2363 Conditional tag, true if a registered user is logged in.
2364
2365 =item user I<field>
2366
2367 Retrieved the given field from the currently logged in user, if any.
2368
2369 =back
2370
2371 =head2 Checkout tags
2372
2373 This has the same tags as the L<Cart page>, and some extras:
2374
2375 =over 4
2376
2377 =item total
2378
2379 The total cost of all items in the cart.
2380
2381 This will need to be formatted as a money value with the C<money> tag.
2382
2383 =item message
2384
2385 An error message, if a validation error occurred.
2386
2387 =item old I<field>
2388
2389 The previously entered value for I<field>.  This should be used as the
2390 value for the various checkout fields, so that if a validation error
2391 occurs the user won't need to re-enter values.
2392
2393 =back
2394
2395 =head2 Completed order
2396
2397 These tags are used in the F<checkoutfinal_base.tmpl>.
2398
2399 =over 4
2400
2401 =item item I<field>
2402
2403 =item product I<field>
2404
2405 This is split out for these forms.
2406
2407 =item order I<field>
2408
2409 Order fields.
2410
2411 =item ifSubscribingTo I<subid>
2412
2413 Can be used to check if this order is intended to be subscribing to a
2414 subscription.
2415
2416 =back
2417
2418 =head2 Mailed order tags
2419
2420 These tags are used in the emails sent to the user to confirm an order
2421 and in the encrypted copy sent to the site administrator:
2422
2423 =over 4
2424
2425 =item *
2426
2427 C<iterate> ... C<items>
2428
2429 Iterates over the items in the order.
2430
2431 =item *
2432
2433 C<item> I<field>
2434
2435 Access to the given field in the order item.
2436
2437 =item *
2438
2439 C<product> I<field>
2440
2441 Access to the product field for the current order item.
2442
2443 =item *
2444
2445 C<order> I<field>
2446
2447 Access to fields of the order.
2448
2449 =item *
2450
2451 C<extended> I<field>
2452
2453 The product of the I<field> in the current item and it's quantity.
2454
2455 =item *
2456
2457 C<money> I<tag> I<parameters>
2458
2459 Formats the given field as a money value.
2460
2461 =back
2462
2463 The mail generation template can use extra formatting specified with
2464 '|format':
2465
2466 =over 4
2467
2468 =item *
2469
2470 m<number>
2471
2472 Format the value as a I<number> wide money value.
2473
2474 =item *
2475
2476 %<format>
2477
2478 Performs sprintf formatting on the value.
2479
2480 =item *
2481
2482 <number>
2483
2484 Left justifies the value in a I<number> wide field.
2485
2486 =back
2487
2488 The order email sent to the site administrator has a couple of extra
2489 fields:
2490
2491 =over
2492
2493 =item *
2494
2495 cardNumber
2496
2497 The credit card number of the user's credit card.
2498
2499 =item *
2500
2501 cardExpiry
2502
2503 The entered expiry date for the user's credit card.
2504
2505 =back
2506
2507 =head2 Order fields
2508
2509 These names can be used with the <: order ... :> tag.
2510
2511 Monetary values should typically be used with <:money order ...:>
2512
2513 =over
2514
2515 =item *
2516
2517 id
2518
2519 The order id or order number.
2520
2521 =item *
2522
2523 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2524 delivPostCode, delivCountry - Delivery information for the order.
2525
2526 =item *
2527
2528 billFirstName, billLastName, billStreet, billSuburb, billState,
2529 billPostCode, billCountry - Billing information for the order.
2530
2531 =item *
2532
2533 telephone, facsimile, emailAddress - Contact information for the
2534 order.
2535
2536 =item *
2537
2538 total - Total price of the order.
2539
2540 =item *
2541
2542 wholesaleTotal - Wholesale cost of the total.  Your costs, if you
2543 entered wholesale prices for the products.
2544
2545 =item *
2546
2547 gst - GST (in Australia) payable on the order, if you entered GST for
2548 the products.
2549
2550 =item *
2551
2552 orderDate - When the order was made.
2553
2554 =item *
2555
2556 filled - Whether or not the order has been filled.  This can be used
2557 with the order_filled target in shopadmin.pl for tracking filled
2558 orders.
2559
2560 =item *
2561
2562 whenFilled - The time and date when the order was filled.
2563
2564 =item *
2565
2566 whoFilled - The user who marked the order as filled.
2567
2568 =item *
2569
2570 paidFor - Whether or not the order has been paid for.  This can be
2571 used with a custom purchasing handler to mark the product as paid for.
2572 You can then filter the order list to only display paid for orders.
2573
2574 =item *
2575
2576 paymentReceipt - A custom payment handler can fill this with receipt
2577 information.
2578
2579 =item *
2580
2581 randomId - Generated by the prePurchase target, this can be used as a
2582 difficult to guess identifier for orders, when working with custom
2583 payment handlers.
2584
2585 =item *
2586
2587 cancelled - This can be used by a custom payment handler to mark an
2588 order as cancelled if the user starts processing an order without
2589 completing payment.
2590
2591 =back
2592
2593 =head2 Order item fields
2594
2595 =over
2596
2597 =item *
2598
2599 productId - The product id of this item.
2600
2601 =item *
2602
2603 orderId - The order Id.
2604
2605 =item *
2606
2607 units - The number of units for this item.
2608
2609 =item *
2610
2611 price - The price paid for the product.
2612
2613 =item *
2614
2615 wholesalePrice - The wholesale price for the product.
2616
2617 =item *
2618
2619 gst - The gst for the product.
2620
2621 =item *
2622
2623 options - A comma separated list of options specified for this item.
2624 These correspond to the option names in the product.
2625
2626 =back
2627
2628 =head2 Options
2629
2630 New with 0.10_04 is the facility to set options for each product.
2631
2632 The cart, checkout and checkoutfinal pages now include the following
2633 tags:
2634
2635 =over
2636
2637 =item *
2638
2639 C<iterator> ... <options>
2640
2641 within an item, iterates over the options for this item in the cart.
2642 Sets the item tag.
2643
2644 =item *
2645
2646 C<option> I<field>
2647
2648 Retrieves the given field from the option, possible field names are:
2649
2650 =over
2651
2652 =item *
2653
2654 id - The type/identifier for this option.  eg. msize for a male
2655 clothing size field.
2656
2657 =item *
2658
2659 value - The underlying value of the option, eg. XL.
2660
2661 =item *
2662
2663 desc - The description of the field from the product options hash.  If
2664 the description isn't defined this is the same as the id. eg. Size.
2665
2666 =item *
2667
2668 label - The description of the value from the product options hash.
2669 eg. "Extra large".
2670
2671 =back
2672
2673 =item *
2674
2675 ifOptions - A conditional tag, true if the current cart item has any
2676 options.
2677
2678 =item *
2679
2680 options - A simple rendering of the options as a parenthesized
2681 comma-separated list.
2682
2683 =back
2684
2685 =cut