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.051";
  22
  23 =head1 NAME
  24
  25 BSE::UI::Shop - implements the shop for BSE
  26
  27 =head1 DESCRIPTION
  28
  29 BSE::UI::Shop implements the shop for BSE.
  30
  31 =head1 TARGETS
  32
  33 =over
  34
  35 =cut
  36
  37 use constant MSG_SHOP_CART_FULL => 'Your shopping cart is full, please remove an item and try adding an item again';
  38
  39 my %actions =
  40   (
  41    add => 1,
  42    addmultiple => 1,
  43    cart => 1,
  44    checkout => 1,
  45    checkupdate => 1,
  46    recheckout => 1,
  47    recalc=>1,
  48    recalculate => 1,
  49    #purchase => 1,
  50    order => 1,
  51    show_payment => 1,
  52    payment => 1,
  53    orderdone => 1,
  54    location => 1,
  55    paypalret => 1,
  56    paypalcan => 1,
  57    emptycart => 1,
  58   );
  59
  60 # map of SiteUser field names to order field names - mostly
  61 my %field_map =
  62   (
  63    name1 => 'billFirstName',
  64    name2 => 'billLastName',
  65    street => 'billStreet',
  66    street2 => 'billStreet2',
  67    suburb => 'billSuburb',
  68    postcode => 'billPostCode',
  69    state => 'billState',
  70    country => 'billCountry',
  71    telephone => 'billTelephone',
  72    facsimile => 'billFacsimile',
  73    mobile => 'billMobile',
  74    organization => 'billOrganization',
  75    email => 'billEmail',
  76    delivFacsimile => 'facsimile',
  77    delivTelephone => 'telephone',
  78    delivEmail => 'emailAddress',
  79   );
  80
  81 my %rev_field_map = reverse %field_map;
  82
  83 sub actions { \%actions }
  84
  85 sub default_action { 'cart' }
  86
  87 sub other_action {
  88   my ($class, $cgi) = @_;
  89
  90   for my $key ($cgi->param()) {
  91     if ($key =~ /^delete_(\d+)(?:\.x)?$/) {
  92       return ( remove_item => $1 );
  93     }
  94     elsif ($key =~ /^(?:a_)?addsingle(\d+)(?:\.x)?$/) {
  95       return ( addsingle => $1 );
  96     }
  97   }
  98
  99   return;
 100 }
 101
 102 sub req_cart {
 103   my ($class, $req, $msg) = @_;
 104
 105   $class->_refresh_cart($req);
 106
 107   my $cart = $req->cart("cart");
 108
 109   my $cust_class = custom_class($req->cfg);
 110   # $req->session->{custom} ||= {};
 111   # my %custom_state = %{$req->session->{custom}};
 112
 113   # $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $req->cfg);
 114   $msg = $req->message($msg);
 115
 116   my %acts;
 117   %acts =
 118     (
 119      $cust_class->cart_actions(\%acts, scalar $cart->items, scalar $cart->products,
 120                                $cart->custom_state, $req->cfg),
 121      shop_cart_tags(\%acts, $cart, $req, 'cart'),
 122      basic_tags(\%acts),
 123      msg => $msg,
 124     );
 125
 126   $req->session->{custom} = { %{$cart->custom_state} };
 127   $req->session->{order_info_confirmed} = 0;
 128
 129   # intended to ajax enable the shop cart with partial templates
 130   my $template = 'cart';
 131   my $embed = $req->cgi->param('embed');
 132   if (defined $embed and $embed =~ /^\w+$/) {
 133     $template = "include/cart_$embed";
 134   }
 135   return $req->response($template, \%acts);
 136 }
 137
 138 =item a_emptycart
 139
 140 Empty the shopping cart.
 141
 142 Refreshes to the URL in C<r> or the cart otherwise.
 143
 144 Flashes msg:bse/shop/cart/empty unless C<r> is supplied.
 145
 146 =cut
 147
 148 sub req_emptycart {
 149   my ($self, $req) = @_;
 150
 151   my $cart = $req->cart;
 152   my $item_count = @{$cart->items};
 153   $cart->empty;
 154
 155   my $refresh = $req->cgi->param('r');
 156   unless ($refresh) {
 157     $refresh = $req->user_url(shop => 'cart');
 158     $req->flash_notice("msg:bse/shop/cart/empty");
 159   }
 160
 161   return _add_refresh($refresh, $req, !$item_count);
 162 }
 163
 164 sub req_add {
 165   my ($class, $req) = @_;
 166
 167   my $cgi = $req->cgi;
 168
 169   my $quantity = $cgi->param('quantity');
 170   $quantity ||= 1;
 171
 172   my $error;
 173   my $refresh_logon;
 174   my ($product, $options, $extras);
 175   my $addid = $cgi->param('id');
 176   if (defined $addid) {
 177     ($product, $options, $extras)
 178       = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 179   }
 180   else {
 181     my $code = $cgi->param('code');
 182     if (defined $code) {
 183       ($product, $options, $extras)
 184         = $class->_validate_add_by_code($req, $code, $quantity, \$error, \$refresh_logon);
 185     }
 186     else {
 187       return $class->req_cart($req, "No product id or code supplied");
 188     }
 189   }
 190   if ($refresh_logon) {
 191     return $class->_refresh_logon($req, @$refresh_logon);
 192   }
 193   elsif ($error) {
 194     return $class->req_cart($req, $error);
 195   }
 196
 197   if ($cgi->param('empty')) {
 198     $req->session->{cart} = [];
 199   }
 200
 201   $req->session->{cart} ||= [];
 202   my @cart = @{$req->session->{cart}};
 203   my $started_empty = @cart == 0;
 204
 205   my $found;
 206   for my $item (@cart) {
 207     $item->{productId} eq $product->{id} && _same_options($item->{options}, $options)
 208       or next;
 209
 210     ++$found;
 211     $item->{units} += $quantity;
 212     $req->flash_notice("msg:bse/shop/cart/addquant", [ $product, $quantity ]);
 213     last;
 214   }
 215   unless ($found) {
 216     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
 217     if (defined $cart_limit && @cart >= $cart_limit) {
 218       return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
 219     }
 220     my $user = $req->siteuser;
 221     my ($price, $tier) = $product->price(user => $user);
 222     push @cart,
 223       {
 224        productId => $product->{id},
 225        units => $quantity,
 226        price=> $price,
 227        options=>$options,
 228        tier => $tier ? $tier->id : "",
 229        user => $user ? $user->id : 0,
 230        %$extras,
 231       };
 232     $req->flash_notice("msg:bse/shop/cart/add", [ $product, $quantity ]);
 233   }
 234
 235   $req->session->{cart} = \@cart;
 236   $req->session->{order_info_confirmed} = 0;
 237
 238   my $refresh = $cgi->param('r');
 239   unless ($refresh) {
 240     $refresh = $req->user_url(shop => 'cart');
 241   }
 242
 243   # speed for ajax
 244   if ($refresh eq 'ajaxcart') {
 245     return $class->req_cart($req);
 246   }
 247
 248   return _add_refresh($refresh, $req, $started_empty);
 249 }
 250
 251 sub req_addsingle {
 252   my ($class, $req, $addid) = @_;
 253
 254   my $cgi = $req->cgi;
 255
 256   $addid ||= '';
 257   my $quantity = $cgi->param("qty$addid");
 258   defined $quantity && $quantity =~ /\S/
 259     or $quantity = 1;
 260
 261   my $error;
 262   my $refresh_logon;
 263   my ($product, $options, $extras)
 264     = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 265   if ($refresh_logon) {
 266     return $class->_refresh_logon($req, @$refresh_logon);
 267   }
 268   elsif ($error) {
 269     return $class->req_cart($req, $error);
 270   }
 271
 272   if ($cgi->param('empty')) {
 273     $req->session->{cart} = [];
 274   }
 275
 276   $req->session->{cart} ||= [];
 277   my @cart = @{$req->session->{cart}};
 278   my $started_empty = @cart == 0;
 279
 280   my $found;
 281   for my $item (@cart) {
 282     $item->{productId} eq $addid && _same_options($item->{options}, $options)
 283       or next;
 284
 285     ++$found;
 286     $item->{units} += $quantity;
 287     $req->flash_notice("msg:bse/shop/cart/addquant", [ $product, $quantity ]);
 288     last;
 289   }
 290   unless ($found) {
 291     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
 292     if (defined $cart_limit && @cart >= $cart_limit) {
 293       return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
 294     }
 295     my $user = $req->siteuser;
 296     my ($price, $tier) = $product->price(user => $user);
 297     push @cart,
 298       {
 299        productId => $addid,
 300        units => $quantity,
 301        price=> $price,
 302        options=>$options,
 303        tier => $tier ? $tier->id : "",
 304        user => $user ? $user->id : 0,
 305        %$extras,
 306       };
 307     $req->flash_notice("msg:bse/shop/cart/add", [ $product, $quantity ]);
 308   }
 309
 310   $req->session->{cart} = \@cart;
 311   $req->session->{order_info_confirmed} = 0;
 312
 313   my $refresh = $cgi->param('r');
 314   unless ($refresh) {
 315     $refresh = $req->user_url(shop => 'cart');
 316   }
 317
 318   # speed for ajax
 319   if ($refresh eq 'ajaxcart') {
 320     return $class->req_cart($req);
 321   }
 322
 323   return _add_refresh($refresh, $req, $started_empty);
 324 }
 325
 326 sub req_addmultiple {
 327   my ($class, $req) = @_;
 328
 329   my $cgi = $req->cgi;
 330   my @qty_keys = map /^qty(\d+)/, $cgi->param;
 331
 332   my @messages;
 333   my %additions;
 334   for my $addid (@qty_keys) {
 335     my $quantity = $cgi->param("qty$addid");
 336     defined $quantity && $quantity =~ /^\s*\d+\s*$/
 337       or next;
 338
 339     my $error;
 340     my $refresh_logon;
 341     my ($product, $options, $extras) =
 342       $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 343     if ($refresh_logon) {
 344       return $class->_refresh_logon($req, @$refresh_logon);
 345     }
 346     elsif ($error) {
 347       return $class->req_cart($req, $error);
 348     }
 349     if ($product->{options}) {
 350       push @messages, "$product->{title} has options, you need to use the product page to add this product";
 351       next;
 352     }
 353     $additions{$addid} =
 354       {
 355        id => $product->{id},
 356        product => $product,
 357        extras => $extras,
 358        quantity => $quantity,
 359       };
 360   }
 361
 362   my @qtys = $cgi->param("qty");
 363   my @ids = $cgi->param("id");
 364   for my $addid (@ids) {
 365     my $quantity = shift @qtys;
 366     $addid =~ /^\d+$/
 367       or next;
 368     $additions{$addid}
 369       and next;
 370     defined $quantity or $quantity = 1;
 371     $quantity =~ /^\d+$/
 372       or next;
 373     $quantity
 374       or next;
 375     my ($error, $refresh_logon);
 376
 377     my ($product, $options, $extras) =
 378       $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 379     if ($refresh_logon) {
 380       return $class->_refresh_logon($req, @$refresh_logon);
 381     }
 382     elsif ($error) {
 383       return $class->req_cart($req, $error);
 384     }
 385     if ($product->{options}) {
 386       push @messages, "$product->{title} has options, you need to use the product page to add this product";
 387       next;
 388     }
 389     $additions{$addid} =
 390       {
 391        id => $product->{id},
 392        product => $product,
 393        extras => $extras,
 394        quantity => $quantity,
 395       };
 396   }
 397
 398   my $started_empty = 0;
 399   if (keys %additions) {
 400     if ($cgi->param('empty')) {
 401       $req->session->{cart} = [];
 402     }
 403     $req->session->{cart} ||= [];
 404     my @cart = @{$req->session->{cart}};
 405     $started_empty = @cart == 0;
 406     for my $item (@cart) {
 407       @{$item->{options}} == 0 or next;
 408
 409       my $addition = delete $additions{$item->{productId}}
 410         or next;
 411
 412       $item->{units} += $addition->{quantity};
 413       $req->flash_notice("msg:bse/shop/cart/addquant",
 414                          [ $addition->{product}, $addition->{quantity} ]);
 415     }
 416
 417     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
 418
 419     my @additions = grep $_->{quantity} > 0, values %additions;
 420
 421     my $user = $req->siteuser;
 422     my $error;
 423     for my $addition (@additions) {
 424       my $product = $addition->{product};
 425
 426       if (defined $cart_limit && @cart >= $cart_limit) {
 427         $error = $req->text('shop/cartfull', MSG_SHOP_CART_FULL);
 428         last;
 429       }
 430
 431       my ($price, $tier) = $product->price(user => $user);
 432       push @cart,
 433         {
 434          productId => $product->{id},
 435          units => $addition->{quantity},
 436          price=> $price,
 437          tier => $tier ? $tier->id : "",
 438          user => $user ? $user->id : 0,
 439          options=>[],
 440          %{$addition->{extras}},
 441         };
 442       $req->flash_notice("msg:bse/shop/cart/add",
 443                          [ $addition->{product}, $addition->{quantity} ]);
 444     }
 445
 446     $req->session->{cart} = \@cart;
 447     $req->session->{order_info_confirmed} = 0;
 448     $error
 449       and return $class->req_cart($req, $error);
 450   }
 451
 452   my $refresh = $cgi->param('r');
 453   unless ($refresh) {
 454     $refresh = $req->user_url(shop => 'cart');
 455   }
 456   if (@messages) {
 457     $req->flash_error($_) for @messages;
 458   }
 459
 460   # speed for ajax
 461   if ($refresh eq 'ajaxcart') {
 462     return $class->req_cart($req);
 463   }
 464
 465   return _add_refresh($refresh, $req, $started_empty);
 466 }
 467
 468 sub tag_ifUser {
 469   my ($user, $args) = @_;
 470
 471   if ($args) {
 472     if ($user) {
 473       return defined $user->{$args} && $user->{$args};
 474     }
 475     else {
 476       return 0;
 477     }
 478   }
 479   else {
 480     return defined $user;
 481   }
 482 }
 483
 484 sub _any_physical_products {
 485   my $prods = shift;
 486
 487   for my $prod (@$prods) {
 488     if ($prod->weight) {
 489       return 1;
 490       last;
 491     }
 492   }
 493
 494   return 0;
 495 }
 496
 497 =item checkout
 498
 499 Display the checkout form.
 500
 501 Variables:
 502
 503 =over
 504
 505 =item *
 506
 507 old - a function returning the old value for most fields.
 508
 509 =item *
 510
 511 errors - any errors from attempting to progress to payment
 512
 513 =item *
 514
 515 need_delivery - true if the user indicates they want separate delivery
 516 and billing details.
 517
 518 =back
 519
 520 Template C<checkoutnew>
 521
 522 =cut
 523
 524 sub req_checkout {
 525   my ($class, $req, $message, $olddata) = @_;
 526
 527   $class->_refresh_cart($req);
 528
 529   my $errors = {};
 530   if (defined $message) {
 531     if (ref $message) {
 532       $errors = $message;
 533       $message = $req->message($errors);
 534     }
 535   }
 536   else {
 537     $message = '';
 538   }
 539   my $cfg = $req->cfg;
 540   my $cgi = $req->cgi;
 541
 542   my $need_delivery = ( $olddata ? $cgi->param("need_delivery") : $req->session->{order_need_delivery} ) || 0;
 543
 544   $class->update_quantities($req);
 545   my $cart = $req->cart("checkout");
 546   my @cart = @{$cart->items};
 547
 548   @cart or return $class->req_cart($req);
 549
 550   my @cart_prods = @{$cart->products};
 551   my @items = @{$cart->items};
 552
 553   if ($cart->need_logon) {
 554     my ($msg, $id) = $cart->need_logon_message;
 555     return $class->_refresh_logon($req, $msg, $id);
 556   }
 557
 558   my $user = $req->siteuser;
 559
 560   my $order_info = $req->session->{order_info};
 561
 562   my $billing_map = BSE::TB::Order->billing_to_delivery_map;
 563   my %delivery_map = reverse %$billing_map;
 564
 565   if ($order_info && !$need_delivery) {
 566     # if need delivery is off, remove any delivery fields
 567     my $map = BSE::TB::Order->billing_to_delivery_map;
 568     delete @{$order_info}{keys %delivery_map};
 569   }
 570
 571   my $old = sub {
 572     my $field = $_[0];
 573     my $value;
 574
 575     if ($olddata && defined($cgi->param($field))) {
 576       $value = $cgi->param($field);
 577     }
 578     elsif ($order_info && defined $order_info->{$field}) {
 579       $value = $order_info->{$field};
 580     }
 581     elsif ($user) {
 582       $rev_field_map{$field} and $field = $rev_field_map{$field};
 583       $value = $user && defined $user->{$field} ? $user->{$field} : '';
 584     }
 585
 586     defined $value or $value = '';
 587     return $value;
 588   };
 589
 590   # shipping handling, if enabled
 591   my $shipping_select = ''; # select of shipping types
 592   my ($delivery_in, $shipping_cost, $shipping_method);
 593   my $shipping_error = '';
 594   my $shipping_name = '';
 595   my $prompt_ship = $cart->cfg_shipping;
 596
 597   my $physical = $cart->any_physical_products;
 598
 599   if ($prompt_ship) {
 600     my $sel_cn = $old->("shipping_name") || "";
 601     if ($physical) {
 602       my $work_order;
 603       $work_order = $order_info unless $olddata;
 604       unless ($work_order) {
 605         my %fake_order;
 606         my %fields = $class->_order_fields($req);
 607         $class->_order_hash($req, \%fake_order, \%fields, user => 1);
 608         $work_order = \%fake_order;
 609       }
 610
 611       # Get a list of couriers
 612       my $country_field = $need_delivery ? "delivCountry" : "billCountry";
 613       my $country = $old->($country_field)
 614         || bse_default_country($cfg);
 615       my $country_code = bse_country_code($country);
 616       my $suburb = $old->($need_delivery ? "delivSuburb" : "billSuburb");
 617       my $postcode = $old->($need_delivery ? "delivPostCode" : "billPostCode");
 618
 619       $country_code
 620         or $errors->{$country_field} = "Unknown country name $country";
 621
 622       my @couriers = BSE::Shipping->get_couriers($cfg);
 623
 624       if ($country_code and $postcode) {
 625         @couriers = grep $_->can_deliver(country => $country_code,
 626                                          suburb => $suburb,
 627                                          postcode => $postcode), @couriers;
 628       }
 629
 630       my ($sel_cour) = grep $_->name eq $sel_cn, @couriers;
 631       # if we don't match against the list (perhaps because of a country
 632       # change) the first item in the list will be selected by the
 633       # browser anyway, so select it ourselves and display an
 634       # appropriate shipping cost for the item
 635       unless ($sel_cour) {
 636         $sel_cour = $couriers[0];
 637         $sel_cn = $sel_cour->name;
 638       }
 639       if ($sel_cour and $postcode and $suburb and $country_code) {
 640         my @parcels = BSE::Shipping->package_order($cfg, $order_info, \@items);
 641         $shipping_cost = $sel_cour->calculate_shipping
 642           (
 643            parcels => \@parcels,
 644            suburb => $suburb,
 645            postcode => $postcode,
 646            country => $country_code,
 647            products => \@cart_prods,
 648            items => \@items,
 649           );
 650         $delivery_in = $sel_cour->delivery_in();
 651         $shipping_method = $sel_cour->description();
 652         $shipping_name = $sel_cour->name;
 653         unless (defined $shipping_cost) {
 654           $shipping_error = "$shipping_method: " . $sel_cour->error_message;
 655           $errors->{shipping_name} = $shipping_error;
 656
 657           # use the last one, which should be the Null shipper
 658           $sel_cour = $couriers[-1];
 659           $sel_cn = $sel_cour->name;
 660           $shipping_method = $sel_cour->description;
 661         }
 662       }
 663
 664       $shipping_select = popup_menu
 665         (
 666          -name => "shipping_name",
 667          -id => "shipping_name",
 668          -values => [ map $_->name, @couriers ],
 669          -labels => { map { $_->name => $_->description } @couriers },
 670          -default => $sel_cn,
 671         );
 672     }
 673     else {
 674       $sel_cn = $shipping_name = "none";
 675       $shipping_method = "Nothing to ship!";
 676       $shipping_select = popup_menu
 677         (
 678          -name => "shipping_name",
 679          -id => "shipping_name",
 680          -values => [ "none" ],
 681          -labels => { none => $shipping_method },
 682          -default => $sel_cn,
 683         );
 684     }
 685   }
 686
 687   my $cust_class = custom_class($cfg);
 688
 689   if (!$message && keys %$errors) {
 690     $message = $req->message($errors);
 691   }
 692   $cart->set_shipping_cost($shipping_cost);
 693   $cart->set_shipping_method($shipping_method);
 694   $cart->set_shipping_name($shipping_name);
 695   $cart->set_delivery_in($delivery_in);
 696   $req->set_variable(old => $old);
 697   $req->set_variable(errors => $errors);
 698   $req->set_variable(need_delivery => $need_delivery);
 699
 700   my $item_index = -1;
 701   my @options;
 702   my $option_index;
 703   my %acts;
 704   %acts =
 705     (
 706      shop_cart_tags(\%acts, $cart, $req, 'checkout'),
 707      basic_tags(\%acts),
 708      message => $message,
 709      msg => $message,
 710      old => sub { escape_html($old->($_[0])); },
 711      $cust_class->checkout_actions(\%acts, \@cart, \@cart_prods,
 712                                    $cart->custom_state, $req->cgi, $cfg),
 713      ifUser => [ \&tag_ifUser, $user ],
 714      user => $user ? [ \&tag_hash, $user ] : '',
 715      affiliate_code => escape_html($cart->affiliate_code),
 716      error_img => [ \&tag_error_img, $cfg, $errors ],
 717      ifShipping => $prompt_ship,
 718      shipping_select => $shipping_select,
 719      delivery_in => escape_html(defined $delivery_in ? $delivery_in : ""),
 720      shipping_cost => $shipping_cost,
 721      shipping_method => escape_html($shipping_method),
 722      shipping_error => escape_html($shipping_error),
 723      shipping_name => $shipping_name,
 724      ifPhysical => $physical,
 725      ifNeedDelivery => $need_delivery,
 726     );
 727   $req->session->{custom} = $cart->custom_state;
 728
 729   return $req->response('checkoutnew', \%acts);
 730 }
 731
 732 sub req_checkupdate {
 733   my ($self, $req) = @_;
 734
 735   my $cart = $req->cart("checkupdate");
 736
 737   $self->update_quantities($req);
 738
 739   $req->session->{custom} = $cart->custom_state;
 740   $req->session->{order_info_confirmed} = 0;
 741
 742   my %fields = $self->_order_fields($req);
 743   my %values;
 744   $self->_order_hash($req, \%values, \%fields);
 745   $req->session->{order_info} = \%values;
 746   $req->session->{order_need_delivery} = $req->cgi->param("need_delivery");
 747
 748   return $req->get_refresh($req->user_url(shop => "checkout"));
 749 }
 750
 751 sub req_remove_item {
 752   my ($class, $req, $index) = @_;
 753
 754   $req->session->{cart} ||= [];
 755   my @cart = @{$req->session->{cart}};
 756   if ($index >= 0 && $index < @cart) {
 757     my ($item) = splice(@cart, $index, 1);
 758     my $product = BSE::TB::Products->getByPkey($item->{productId});
 759     $req->flash_notice("msg:bse/shop/cart/remove", [ $product ]);
 760   }
 761   $req->session->{cart} = \@cart;
 762   $req->session->{order_info_confirmed} = 0;
 763
 764   return BSE::Template->get_refresh($req->user_url(shop => 'cart'), $req->cfg);
 765 }
 766
 767 sub _order_fields {
 768   my ($self, $req) = @_;
 769
 770   my %fields = BSE::TB::Order->valid_fields($req->cfg);
 771   my $cust_class = custom_class($req->cfg);
 772   my @required =
 773     $cust_class->required_fields($req->cgi, $req->session->{custom}, $req->cfg);
 774
 775   for my $name (@required) {
 776     $fields{$name}{required} = 1;
 777   }
 778
 779   return %fields;
 780 }
 781
 782 sub _order_hash {
 783   my ($self, $req, $values, $fields, %opts) = @_;
 784
 785   my $cgi = $req->cgi;
 786   my $user = $req->siteuser;
 787   for my $name (keys %$fields) {
 788     my ($value) = $cgi->param($name);
 789     if (!defined $value && $opts{user} && $user) {
 790       my $field = $rev_field_map{$name} || $name;
 791       if ($user->can($field)) {
 792         $value = $user->$field();
 793       }
 794     }
 795     defined $value or $value = "";
 796     $values->{$name} = $value;
 797   }
 798
 799   unless ($cgi->param("need_delivery")) {
 800     my $map = BSE::TB::Order->billing_to_delivery_map;
 801     keys %$map; # reset iterator
 802     while (my ($billing, $delivery) = each %$map) {
 803       $values->{$delivery} = $values->{$billing};
 804     }
 805   }
 806   my $cart = $req->cart;
 807   if ($cart->cfg_shipping && $cart->any_physical_products) {
 808     my $shipping_name = $cgi->param("shipping_name");
 809     defined $shipping_name and $values->{shipping_name} = $shipping_name;
 810   }
 811 }
 812
 813 # saves order and refresh to payment page
 814 sub req_order {
 815   my ($class, $req) = @_;
 816
 817   my $cfg = $req->cfg;
 818   my $cgi = $req->cgi;
 819
 820   $req->session->{cart} && @{$req->session->{cart}}
 821     or return $class->req_cart($req, "Your cart is empty");
 822
 823   my $msg;
 824   $class->_validate_cfg($req, \$msg)
 825     or return $class->req_cart($req, $msg);
 826
 827   my $cart = $req->cart("order");
 828
 829   my @products = @{$cart->products};
 830   my @items = @{$cart->items};
 831
 832   my $id;
 833   if ($cart->need_logon) {
 834     my ($msg, $id) = $cart->need_logon_message;
 835     return $class->_refresh_logon($req, $msg, $id);
 836   }
 837
 838   my %fields = $class->_order_fields($req);
 839   my %rules = BSE::TB::Order->valid_rules($cfg);
 840
 841   my %errors;
 842   my %values;
 843   $class->_order_hash($req, \%values, \%fields);
 844
 845   dh_validate_hash(\%values, \%errors, { rules=>\%rules, fields=>\%fields },
 846                    $cfg, 'Shop Order Validation');
 847   my $prompt_ship = $cart->cfg_shipping;
 848   if ($prompt_ship) {
 849     my $country = $values{delivCountry} || bse_default_country($cfg);
 850     my $country_code = bse_country_code($country);
 851     $country_code
 852       or $errors{delivCountry} = "Unknown country name $country";
 853   }
 854   keys %errors
 855     and return $class->req_checkout($req, \%errors, 1);
 856
 857   $class->_fillout_order($req, \%values, \$msg, 'payment')
 858     or return $class->req_checkout($req, $msg, 1);
 859
 860   $req->session->{order_info} = \%values;
 861   $req->session->{order_need_delivery} = $cgi->param("need_delivery");
 862   $req->session->{order_info_confirmed} = 1;
 863
 864   # skip payment page if nothing to pay
 865   if ($values{total} == 0) {
 866     return $class->req_payment($req);
 867   }
 868   else {
 869     return BSE::Template->get_refresh($req->user_url(shop => 'show_payment'), $req->cfg);
 870   }
 871 }
 872
 873 =item a_show_payment
 874
 875 Allows the customer to pay for an existing order.
 876
 877 Parameters:
 878
 879 =over
 880
 881 =item *
 882
 883 orderid - the order id to be paid (Optional, otherwise displays the
 884 cart for payment).
 885
 886 =back
 887
 888 Template: checkoutpay
 889
 890 =cut
 891
 892
 893 sub req_show_payment {
 894   my ($class, $req, $errors) = @_;
 895
 896   my $cfg = $req->cfg;
 897   my $cgi = $req->cgi;
 898
 899   my @items;
 900   my @products;
 901   my $order;
 902
 903   # ideally supply order_id to be consistent with a_payment.
 904   my $order_id = $cgi->param('orderid') || $cgi->param("order_id");
 905   my $cart;
 906   if ($order_id) {
 907     $order_id =~ /^\d+$/
 908       or return $class->req_cart($req, "No or invalid order id supplied");
 909
 910     my $user = $req->siteuser
 911       or return $class->_refresh_logon
 912         ($req, "Please logon before paying your existing order", "logonpayorder",
 913          undef, { a_show_payment => 1, orderid => $order_id });
 914
 915     require BSE::TB::Orders;
 916     $order = BSE::TB::Orders->getByPkey($order_id)
 917       or return $class->req_cart($req, "Unknown order id");
 918
 919     $order->siteuser_id == $user->id
 920       or return $class->req_cart($req, "You can only pay for your own orders");
 921
 922     $order->paidFor
 923       and return $class->req_cart($req, "Order $order->{id} has been paid");
 924
 925     $cart = $order;
 926   }
 927   else {
 928     $req->session->{order_info_confirmed}
 929       or return $class->req_checkout($req, 'Please proceed via the checkout page');
 930
 931     $req->session->{cart} && @{$req->session->{cart}}
 932       or return $class->req_cart($req, "Your cart is empty");
 933
 934     $order = $req->session->{order_info}
 935       or return $class->req_checkout($req, "You need to enter order information first");
 936
 937     $cart = $req->cart("payment");
 938   }
 939
 940   $errors ||= {};
 941   my $msg = $req->message($errors);
 942
 943   my @pay_types = payment_types($cfg);
 944   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
 945   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
 946   @payment_types or @payment_types = ( PAYMENT_CALLME );
 947   @payment_types = sort { $a <=> $b } @payment_types;
 948   my %payment_types = map { $_=> 1 } @payment_types;
 949   my $payment;
 950   $errors and $payment = $cgi->param('paymentType');
 951   defined $payment or $payment = $payment_types[0];
 952
 953   $cart->set_shipping_cost($order->{shipping_cost});
 954   $cart->set_shipping_method($order->{shipping_method});
 955   $cart->set_shipping_name($order->{shipping_name});
 956   $req->set_variable(errors => $errors);
 957
 958   my %acts;
 959   %acts =
 960     (
 961      basic_tags(\%acts),
 962      message => $msg,
 963      msg => $msg,
 964      order => [ \&tag_hash, $order ],
 965      shop_cart_tags(\%acts, $cart, $req, 'payment'),
 966      ifMultPaymentTypes => @payment_types > 1,
 967      checkedPayment => [ \&tag_checkedPayment, $payment, \%types_by_name ],
 968      ifPayments => [ \&tag_ifPayments, \@payment_types, \%types_by_name ],
 969      paymentTypeId => [ \&tag_paymentTypeId, \%types_by_name ],
 970      error_img => [ \&tag_error_img, $cfg, $errors ],
 971      total => $cart->total,
 972      delivery_in => $order->{delivery_in},
 973      shipping_cost => $order->{shipping_cost},
 974      shipping_method => $order->{shipping_method},
 975     );
 976   for my $type (@pay_types) {
 977     my $id = $type->{id};
 978     my $name = $type->{name};
 979     $acts{"if${name}Payments"} = exists $payment_types{$id};
 980     $acts{"if${name}FirstPayment"} = $payment_types[0] == $id;
 981     $acts{"checkedIfFirst$name"} = $payment_types[0] == $id ? "checked " : "";
 982     $acts{"checkedPayment$name"} = $payment == $id ? 'checked="checked" ' : "";
 983   }
 984   $req->set_variable(ordercart => $cart);
 985   $req->set_variable(order => $order);
 986   $req->set_variable(is_order => !!$order_id);
 987
 988   return $req->response('checkoutpay', \%acts);
 989 }
 990
 991 my %nostore =
 992   (
 993    cardNumber => 1,
 994    cardExpiry => 1,
 995    delivery_in => 1,
 996    cardVerify => 1,
 997    ccName => 1,
 998   );
 999
1000 my %bill_ccmap =
1001   (
1002    # hash of CC payment parameter names to arrays of billing address fields
1003    firstname => "billFirstName",
1004    lastname => "billLastName",
1005    address1 => "billStreet",
1006    address2 => "billStreet2",
1007    postcode => "billPostCode",
1008    state => "billState",
1009    suburb => "billSuburb",
1010    email => "billEmail",
1011   );
1012
1013 sub req_payment {
1014   my ($class, $req, $errors) = @_;
1015
1016   require BSE::TB::Orders;
1017   my $cgi = $req->cgi;
1018   my $order_id = $cgi->param("order_id");
1019   my $user = $req->siteuser;
1020   my $order;
1021   my $order_values;
1022   my $old_order; # true if we're paying an old order
1023   if ($order_id) {
1024     unless ($user) {
1025       return $class->_refresh_logon
1026         (
1027          $req,
1028          "Please logon before paying your existing order",
1029          "logonpayorder",
1030          undef,
1031          { a_show_payment => 1, orderid => $order_id }
1032         );
1033     }
1034     $order_id =~ /^\d+$/
1035       or return $class->req_cart($req, "Invalid order id");
1036     $order = BSE::TB::Orders->getByPkey($order_id)
1037       or return $class->req_cart($req, "Unknown order id");
1038     $order->siteuser_id == $user->id
1039       or return $class->req_cart($req, "You can only pay for your own orders");
1040
1041     $order->paidFor
1042       and return $class->req_cart($req, "Order $order->{id} has been paid");
1043
1044     $order_values = $order;
1045     $old_order = 1;
1046   }
1047   else {
1048     $req->session->{order_info_confirmed}
1049       or return $class->req_checkout($req, 'Please proceed via the checkout page');
1050
1051     $order_values = $req->session->{order_info}
1052       or return $class->req_checkout($req, "You need to enter order information first");
1053     $old_order = 0;
1054   }
1055
1056   my $cfg = $req->cfg;
1057   my $session = $req->session;
1058
1059   my $paymentType;
1060   if ($order_values->{total} != 0) {
1061     my @pay_types = payment_types($cfg);
1062     my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1063     my %pay_types = map { $_->{id} => $_ } @pay_types;
1064     my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1065     @payment_types or @payment_types = ( PAYMENT_CALLME );
1066     @payment_types = sort { $a <=> $b } @payment_types;
1067     my %payment_types = map { $_=> 1 } @payment_types;
1068
1069     $paymentType = $cgi->param('paymentType');
1070     defined $paymentType or $paymentType = $payment_types[0];
1071     $payment_types{$paymentType}
1072       or return $class->req_show_payment($req, { paymentType => "Invalid payment type" } , 1);
1073
1074     my @required;
1075     push @required, @{$pay_types{$paymentType}{require}};
1076
1077     my %fields = BSE::TB::Order->valid_payment_fields($cfg);
1078     my %rules = BSE::TB::Order->valid_payment_rules($cfg);
1079     for my $field (@required) {
1080       if (exists $fields{$field}) {
1081         $fields{$field}{required} = 1;
1082       }
1083       else {
1084         $fields{$field} = { description => $field, required=> 1 };
1085       }
1086     }
1087
1088     my %errors;
1089     dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
1090                 $cfg, 'Shop Order Validation');
1091     keys %errors
1092       and return $class->req_show_payment($req, \%errors);
1093
1094     for my $field (keys %fields) {
1095       unless ($nostore{$field}) {
1096         if (my ($value) = $cgi->param($field)) {
1097           $order_values->{$field} = $value;
1098         }
1099       }
1100     }
1101
1102   }
1103   else {
1104     $paymentType = -1;
1105   }
1106
1107   $order_values->{paymentType} = $paymentType;
1108   my @dbitems;
1109   my @products;
1110   my %subscribing_to;
1111   if ($order) {
1112     @dbitems = $order->items;
1113     @products = $order->products;
1114     for my $product (@products) {
1115       my $sub = $product->subscription;
1116       if ($sub) {
1117         $subscribing_to{$sub->{text_id}} = $sub;
1118       }
1119     }
1120   }
1121   else {
1122     my $cart = $req->cart("payment");
1123
1124     $order_values->{filled} = 0;
1125     $order_values->{paidFor} = 0;
1126
1127     my @items = $class->_build_items($req);
1128     @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       if ($cart->coupon_active) {
1811         $work{product_discount} = $item->product_discount;
1812         $work{product_discount_units} = $item->product_discount_units;
1813       }
1814       else {
1815         $work{product_discount} = 0;
1816         $work{product_discount_units} = 0;
1817       }
1818
1819       push @newcart, \%work;
1820     }
1821   }
1822
1823   # we don't use these for anything for now
1824   #if (@msgs) {
1825   #  @$rmsg = @msgs;
1826   #}
1827
1828   return @newcart;
1829 }
1830
1831 sub _fillout_order {
1832   my ($class, $req, $values, $rmsg, $how) = @_;
1833
1834   my $session = $req->session;
1835   my $cfg = $req->cfg;
1836   my $cgi = $req->cgi;
1837
1838   my $cart = $req->cart($how);
1839
1840   if ($cart->is_empty) {
1841     $$rmsg = "Your cart is empty";
1842     return;
1843   }
1844
1845   # FIXME? this doesn't take discounting into effect
1846   $values->{gst} = $cart->gst;
1847   $values->{wholesaleTotal} = $cart->wholesaleTotal;
1848
1849   my $items = $cart->items;
1850   my $products = $cart->products;
1851   my $prompt_ship = $cart->cfg_shipping;
1852   if ($prompt_ship) {
1853     if (_any_physical_products($products)) {
1854       my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1855       my $country_code = bse_country_code($values->{delivCountry});
1856       if ($courier) {
1857         unless ($courier->can_deliver(country => $country_code,
1858                                       suburb => $values->{delivSuburb},
1859                                       postcode => $values->{delivPostCode})) {
1860           $cgi->param("courier", undef);
1861           $$rmsg =
1862             "Can't use the selected courier ".
1863               "(". $courier->description(). ") for this order.";
1864           return;
1865         }
1866         my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1867         my $cost = $courier->calculate_shipping
1868           (
1869            parcels => \@parcels,
1870            country => $country_code,
1871            suburb => $values->{delivSuburb},
1872            postcode => $values->{delivPostCode},
1873            products => $products,
1874            items => $items,
1875           );
1876         if (!defined $cost and $courier->name() ne 'contact') {
1877           my $err = $courier->error_message();
1878           $$rmsg = "Error calculating shipping cost";
1879           $$rmsg .= ": $err" if $err;
1880           return;
1881         }
1882         $values->{shipping_method} = $courier->description();
1883         $values->{shipping_name} = $courier->name;
1884         $values->{shipping_cost} = $cost;
1885         $values->{shipping_trace} = $courier->trace;
1886         $values->{delivery_in} = $courier->delivery_in();
1887       }
1888       else {
1889         # XXX: What to do?
1890         $$rmsg = "Error: no usable courier found.";
1891         return;
1892       }
1893     }
1894     else {
1895       $values->{shipping_method} = "Nothing to ship!";
1896       $values->{shipping_name} = "none";
1897       $values->{shipping_cost} = 0;
1898       $values->{shipping_trace} = "All products have zero weight.";
1899     }
1900   }
1901   if ($cart->coupon_active) {
1902     $values->{coupon_id} = $cart->coupon->id;
1903     $values->{coupon_description} = $cart->coupon_description;
1904     $values->{coupon_cart_wide} = $cart->coupon_cart_wide;
1905   }
1906   else {
1907     $values->{coupon_id} = undef;
1908     $values->{coupon_description} = "";
1909     $values->{coupon_cart_wide} = 0;
1910   }
1911   $cart->set_shipping_cost($values->{shipping_cost});
1912   $cart->set_shipping_method($values->{shipping_method});
1913   $cart->set_shipping_name($values->{shipping_name});
1914   $cart->set_delivery_in($values->{delivery_in});
1915
1916   $values->{coupon_code_discount_pc} = $cart->coupon_code_discount_pc;
1917   $values->{product_cost_discount} = $cart->product_cost_discount;
1918   $values->{total} = $cart->total;
1919
1920   my $cust_class = custom_class($cfg);
1921
1922   eval {
1923     local $SIG{__DIE__};
1924     $session->{custom} = $cart->custom_state || {};
1925     my %custom = %{$session->{custom}};
1926     $cust_class->order_save($cgi, $values, $items, $items,
1927                             \%custom, $cfg);
1928     $session->{custom} = \%custom;
1929   };
1930   if ($@) {
1931     $$rmsg = $@;
1932     return;
1933   }
1934
1935   $values->{total} +=
1936     $cust_class->total_extras($items, $items,
1937                               $session->{custom}, $cfg, $how);
1938
1939   my $affiliate_code = $session->{affiliate_code};
1940   defined $affiliate_code && length $affiliate_code
1941     or $affiliate_code = $cgi->param('affiliate_code');
1942   defined $affiliate_code or $affiliate_code = '';
1943   $values->{affiliate_code} = $affiliate_code;
1944
1945   my $user = $req->siteuser;
1946   if ($user) {
1947     $values->{userId} = $user->{userId};
1948     $values->{siteuser_id} = $user->{id};
1949   }
1950   else {
1951     $values->{userId} = '';
1952     $values->{siteuser_id} = -1;
1953   }
1954
1955   $values->{orderDate} = now_sqldatetime;
1956
1957   # this should be hard to guess
1958   $values->{randomId} = md5_hex(time().rand().{}.$$);
1959
1960   return 1;
1961 }
1962
1963 sub action_prefix { '' }
1964
1965 sub req_location {
1966   my ($class, $req) = @_;
1967
1968   require BSE::TB::Locations;
1969   my $cgi = $req->cgi;
1970   my $location_id = $cgi->param('location_id');
1971   my $location;
1972   if (defined $location_id && $location_id =~ /^\d+$/) {
1973     $location = BSE::TB::Locations->getByPkey($location_id);
1974     my %acts;
1975     %acts =
1976       (
1977        BSE::Util::Tags->static(\%acts, $req->cfg),
1978        location => [ \&tag_hash, $location ],
1979       );
1980
1981     return $req->response('location', \%acts);
1982   }
1983   else {
1984     return
1985       {
1986        type=>BSE::Template->get_type($req->cfg, 'error'),
1987        content=>"Missing or invalid location_id",
1988       };
1989   }
1990 }
1991
1992 sub _validate_add_by_id {
1993   my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1994
1995   my $product;
1996   if ($addid) {
1997     $product = BSE::TB::Seminars->getByPkey($addid);
1998     $product ||= BSE::TB::Products->getByPkey($addid);
1999   }
2000   unless ($product) {
2001     $$error = "Cannot find product $addid";
2002     return;
2003   }
2004
2005   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2006 }
2007
2008 sub _validate_add_by_code {
2009   my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
2010
2011   my $product;
2012   if (defined $code) {
2013     $product = BSE::TB::Seminars->getBy(product_code => $code);
2014     $product ||= BSE::TB::Products->getBy(product_code => $code);
2015   }
2016   unless ($product) {
2017     $$error = "Cannot find product code $code";
2018     return;
2019   }
2020
2021   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
2022 }
2023
2024 sub _validate_add {
2025   my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
2026
2027   # collect the product options
2028   my @options;
2029   my @option_descs =  $product->option_descs($req->cfg);
2030   my @option_names = map $_->{name}, @option_descs;
2031   my @not_def;
2032   my $cgi = $req->cgi;
2033   for my $name (@option_names) {
2034     my $value = $cgi->param($name);
2035     push @options, $value;
2036     unless (defined $value) {
2037       push @not_def, $name;
2038     }
2039   }
2040   if (@not_def) {
2041     $$error = "Some product options (@not_def) not supplied";
2042     return;
2043   }
2044
2045   # the product must be non-expired and listed
2046   (my $comp_release = $product->{release}) =~ s/ .*//;
2047   (my $comp_expire = $product->{expire}) =~ s/ .*//;
2048   my $today = now_sqldate();
2049   unless ($comp_release le $today) {
2050     $$error = "Product $product->{title} has not been released yet";
2051     return;
2052   }
2053   unless ($today le $comp_expire) {
2054     $$error = "Product $product->{title} has expired";
2055     return;
2056   }
2057   unless ($product->{listed}) {
2058     $$error = "Product $product->{title} not available";
2059     return;
2060   }
2061
2062   # used to refresh if a logon is needed
2063   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
2064   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
2065   for my $opt_index (0..$#option_names) {
2066     $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
2067   }
2068
2069   my $user = $req->siteuser;
2070   # need to be logged on if it has any subs
2071   if ($product->{subscription_id} != -1) {
2072     if ($user) {
2073       my $sub = $product->subscription;
2074       if ($product->is_renew_sub_only) {
2075         unless ($user->subscribed_to_grace($sub)) {
2076           $$error = "The product $product->{title} can only be used to renew your subscription to $sub->{title} and you are not subscribed nor within the renewal grace period";
2077           return;
2078         }
2079       }
2080       elsif ($product->is_start_sub_only) {
2081         if ($user->subscribed_to_grace($sub)) {
2082           $$error = "The product $product->{title} can only be used to start your subscription to $sub->{title} and you are already subscribed or within the grace period";
2083           return;
2084         }
2085       }
2086     }
2087     else {
2088       $$refresh_logon =
2089         [  "You must be logged on to add this product to your cart",
2090            'prodlogon', $r ];
2091       return;
2092     }
2093   }
2094   if ($product->{subscription_required} != -1) {
2095     my $sub = $product->subscription_required;
2096     if ($user) {
2097       unless ($user->subscribed_to($sub)) {
2098         $$error = "You must be subscribed to $sub->{title} to purchase this product";
2099         return;
2100       }
2101     }
2102     else {
2103       # we want to refresh back to adding the item to the cart if possible
2104       $$refresh_logon =
2105         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
2106          'prodlogonsub', $r ];
2107       return;
2108     }
2109   }
2110
2111   # we need a natural integer quantity
2112   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2113     $$error = "Invalid quantity";
2114     return;
2115   }
2116
2117   my %extras;
2118   if ($product->isa('BSE::TB::Seminar')) {
2119     # you must be logged on to add a seminar
2120     unless ($user) {
2121       $$refresh_logon =
2122         [ "You must be logged on to add seminars to your cart",
2123           'seminarlogon', $r ];
2124       return;
2125     }
2126
2127     # get and validate the session
2128     my $session_id = $cgi->param('session_id');
2129     unless (defined $session_id) {
2130       $$error = "Please select a session when adding a seminar";
2131       return;
2132     }
2133
2134     unless ($session_id =~ /^\d+$/) {
2135       $$error = "Invalid session_id supplied";
2136       return;
2137     }
2138
2139     require BSE::TB::SeminarSessions;
2140     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2141     unless ($session) {
2142       $$error = "Unknown session id supplied";
2143       return;
2144     }
2145     unless ($session->{seminar_id} == $product->{id}) {
2146       $$error = "Session not for this seminar";
2147       return;
2148     }
2149
2150     # check if the user is already booked for this session
2151     if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2152       $$error = "You are already booked for this session";
2153       return;
2154     }
2155
2156     $extras{session_id} = $session_id;
2157   }
2158
2159   return ( $product, \@options, \%extras );
2160 }
2161
2162 sub _add_refresh {
2163   my ($refresh, $req, $started_empty) = @_;
2164
2165   my $cfg = $req->cfg;
2166   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2167   if ($started_empty && !$cookie_domain) {
2168     my $base_url = $cfg->entryVar('site', 'url');
2169     my $secure_url = $cfg->entryVar('site', 'secureurl');
2170     if ($base_url ne $secure_url) {
2171       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2172
2173       # magical refresh time
2174       # which host are we on?
2175       # first get info about the 2 possible hosts
2176       my ($baseprot, $basehost, $baseport) =
2177         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2178       $baseport ||= $baseprot eq 'http' ? 80 : 443;
2179       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
2180         if $debug;
2181
2182       #my ($secprot, $sechost, $secport) =
2183       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2184
2185       my $onbase = 1;
2186       # get info about the current host
2187       my $port = $ENV{SERVER_PORT} || 80;
2188       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2189       print STDERR "\$ishttps: $ishttps\n" if $debug;
2190       my $protocol = $ishttps ? 'https' : 'http';
2191
2192       if (lc $ENV{SERVER_NAME} ne lc $basehost
2193           || lc $protocol ne $baseprot
2194           || $baseport != $port) {
2195         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
2196         $onbase = 0;
2197       }
2198       my $base = $onbase ? $secure_url : $base_url;
2199       my $finalbase = $onbase ? $base_url : $secure_url;
2200       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2201       my $sessionid = $req->session->{_session_id};
2202       require BSE::SessionSign;
2203       my $sig = BSE::SessionSign->make($sessionid);
2204       my $url = $cfg->user_url("user", undef,
2205                                -base => $base,
2206                                setcookie => $sessionid,
2207                                s => $sig,
2208                                r => $refresh);
2209       print STDERR "Heading to $url to setcookie\n" if $debug;
2210       return $req->get_refresh($url);
2211     }
2212   }
2213
2214   return $req->get_refresh($refresh);
2215 }
2216
2217 sub _same_options {
2218   my ($left, $right) = @_;
2219
2220   for my $index (0 .. $#$left) {
2221     my $left_value = $left->[$index];
2222     my $right_value = $right->[$index];
2223     defined $right_value
2224       or return;
2225     $left_value eq $right_value
2226       or return;
2227   }
2228
2229   return 1;
2230 }
2231
2232 sub _paypal_order {
2233   my ($self, $req, $rmsg) = @_;
2234
2235   my $id = $req->cgi->param("order");
2236   unless ($id) {
2237     $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2238     return;
2239   }
2240   my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2241   unless ($order) {
2242     $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2243     return;
2244   }
2245
2246   return $order;
2247 }
2248
2249 =item paypalret
2250
2251 Handles PayPal returning control.
2252
2253 Expects:
2254
2255 =over
2256
2257 =item *
2258
2259 order - the randomId of the order
2260
2261 =item *
2262
2263 token - paypal token we originally supplied to paypal.  Supplied by
2264 PayPal.
2265
2266 =item *
2267
2268 PayerID - the paypal user who paid the order.  Supplied by PayPal.
2269
2270 =back
2271
2272 =cut
2273
2274 sub req_paypalret {
2275   my ($self, $req) = @_;
2276
2277   require BSE::PayPal;
2278   BSE::PayPal->configured
2279       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2280
2281   my $msg;
2282   my $order = $self->_paypal_order($req, \$msg)
2283     or return $self->req_show_payment($req, { _ => $msg });
2284
2285   $order->complete
2286     and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2287
2288   unless (BSE::PayPal->pay_order(req => $req,
2289                                  order => $order,
2290                                  msg => \$msg)) {
2291     return $self->req_show_payment($req, { _ => $msg });
2292   }
2293
2294   $self->_finish_order($req, $order);
2295
2296   return $req->get_refresh($req->user_url(shop => "orderdone"));
2297 }
2298
2299 sub req_paypalcan {
2300   my ($self, $req) = @_;
2301
2302   require BSE::PayPal;
2303   BSE::PayPal->configured
2304       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2305
2306   my $msg;
2307   my $order = $self->_paypal_order($req, \$msg)
2308     or return $self->req_show_payment($req, { _ => $msg });
2309
2310   $req->flash_notice("msg:bse/shop/paypal/cancelled");
2311
2312   my $url = $req->user_url(shop => "show_payment");
2313   return $req->get_refresh($url);
2314 }
2315
2316 sub _refresh_cart {
2317   my ($self, $req) = @_;
2318
2319   my $user = $req->siteuser
2320     or return;
2321
2322   my $cart = $req->session->{cart}
2323     or return;
2324
2325   for my $item (@$cart) {
2326     if (!$item->{user} || $item->{user} != $user->id) {
2327       my $product = BSE::TB::Products->getByPkey($item->{productId})
2328         or next;
2329       my ($price, $tier) = $product->price(user => $user);
2330       $item->{price} = $price;
2331       $item->{tier} = $tier ? $tier->id : "";
2332     }
2333   }
2334
2335   $req->session->{cart} = $cart;
2336 }
2337
2338 1;
2339
2340 =back
2341
2342 =head1 TAGS
2343
2344 =head2 Cart page
2345
2346 =over 4
2347
2348 =item iterator ... items
2349
2350 Iterates over the items in the shopping cart, setting the C<item> tag
2351 for each one.
2352
2353 =item item I<field>
2354
2355 Retreives the given field from the item.  This can include product
2356 fields for this item.
2357
2358 =item index
2359
2360 The numeric index of the current item.
2361
2362 =item extended [<field>]
2363
2364 The "extended price", the product of the unit cost and the number of
2365 units for the current item in the cart.  I<field> defaults to the
2366 price of the product.
2367
2368 =item money I<which> <field>
2369
2370 Formats the given field as a money value (without a currency symbol.)
2371
2372 =item count
2373
2374 The number of items in the cart.
2375
2376 =item ifUser
2377
2378 Conditional tag, true if a registered user is logged in.
2379
2380 =item user I<field>
2381
2382 Retrieved the given field from the currently logged in user, if any.
2383
2384 =back
2385
2386 =head2 Checkout tags
2387
2388 This has the same tags as the L<Cart page>, and some extras:
2389
2390 =over 4
2391
2392 =item total
2393
2394 The total cost of all items in the cart.
2395
2396 This will need to be formatted as a money value with the C<money> tag.
2397
2398 =item message
2399
2400 An error message, if a validation error occurred.
2401
2402 =item old I<field>
2403
2404 The previously entered value for I<field>.  This should be used as the
2405 value for the various checkout fields, so that if a validation error
2406 occurs the user won't need to re-enter values.
2407
2408 =back
2409
2410 =head2 Completed order
2411
2412 These tags are used in the F<checkoutfinal_base.tmpl>.
2413
2414 =over 4
2415
2416 =item item I<field>
2417
2418 =item product I<field>
2419
2420 This is split out for these forms.
2421
2422 =item order I<field>
2423
2424 Order fields.
2425
2426 =item ifSubscribingTo I<subid>
2427
2428 Can be used to check if this order is intended to be subscribing to a
2429 subscription.
2430
2431 =back
2432
2433 =head2 Mailed order tags
2434
2435 These tags are used in the emails sent to the user to confirm an order
2436 and in the encrypted copy sent to the site administrator:
2437
2438 =over 4
2439
2440 =item *
2441
2442 C<iterate> ... C<items>
2443
2444 Iterates over the items in the order.
2445
2446 =item *
2447
2448 C<item> I<field>
2449
2450 Access to the given field in the order item.
2451
2452 =item *
2453
2454 C<product> I<field>
2455
2456 Access to the product field for the current order item.
2457
2458 =item *
2459
2460 C<order> I<field>
2461
2462 Access to fields of the order.
2463
2464 =item *
2465
2466 C<extended> I<field>
2467
2468 The product of the I<field> in the current item and it's quantity.
2469
2470 =item *
2471
2472 C<money> I<tag> I<parameters>
2473
2474 Formats the given field as a money value.
2475
2476 =back
2477
2478 The mail generation template can use extra formatting specified with
2479 '|format':
2480
2481 =over 4
2482
2483 =item *
2484
2485 m<number>
2486
2487 Format the value as a I<number> wide money value.
2488
2489 =item *
2490
2491 %<format>
2492
2493 Performs sprintf formatting on the value.
2494
2495 =item *
2496
2497 <number>
2498
2499 Left justifies the value in a I<number> wide field.
2500
2501 =back
2502
2503 The order email sent to the site administrator has a couple of extra
2504 fields:
2505
2506 =over
2507
2508 =item *
2509
2510 cardNumber
2511
2512 The credit card number of the user's credit card.
2513
2514 =item *
2515
2516 cardExpiry
2517
2518 The entered expiry date for the user's credit card.
2519
2520 =back
2521
2522 =head2 Order fields
2523
2524 These names can be used with the <: order ... :> tag.
2525
2526 Monetary values should typically be used with <:money order ...:>
2527
2528 =over
2529
2530 =item *
2531
2532 id
2533
2534 The order id or order number.
2535
2536 =item *
2537
2538 delivFirstName, delivLastName, delivStreet, delivSuburb, delivState,
2539 delivPostCode, delivCountry - Delivery information for the order.
2540
2541 =item *
2542
2543 billFirstName, billLastName, billStreet, billSuburb, billState,
2544 billPostCode, billCountry - Billing information for the order.
2545
2546 =item *
2547
2548 telephone, facsimile, emailAddress - Contact information for the
2549 order.
2550
2551 =item *
2552
2553 total - Total price of the order.
2554
2555 =item *
2556
2557 wholesaleTotal - Wholesale cost of the total.  Your costs, if you
2558 entered wholesale prices for the products.
2559
2560 =item *
2561
2562 gst - GST (in Australia) payable on the order, if you entered GST for
2563 the products.
2564
2565 =item *
2566
2567 orderDate - When the order was made.
2568
2569 =item *
2570
2571 filled - Whether or not the order has been filled.  This can be used
2572 with the order_filled target in shopadmin.pl for tracking filled
2573 orders.
2574
2575 =item *
2576
2577 whenFilled - The time and date when the order was filled.
2578
2579 =item *
2580
2581 whoFilled - The user who marked the order as filled.
2582
2583 =item *
2584
2585 paidFor - Whether or not the order has been paid for.  This can be
2586 used with a custom purchasing handler to mark the product as paid for.
2587 You can then filter the order list to only display paid for orders.
2588
2589 =item *
2590
2591 paymentReceipt - A custom payment handler can fill this with receipt
2592 information.
2593
2594 =item *
2595
2596 randomId - Generated by the prePurchase target, this can be used as a
2597 difficult to guess identifier for orders, when working with custom
2598 payment handlers.
2599
2600 =item *
2601
2602 cancelled - This can be used by a custom payment handler to mark an
2603 order as cancelled if the user starts processing an order without
2604 completing payment.
2605
2606 =back
2607
2608 =head2 Order item fields
2609
2610 =over
2611
2612 =item *
2613
2614 productId - The product id of this item.
2615
2616 =item *
2617
2618 orderId - The order Id.
2619
2620 =item *
2621
2622 units - The number of units for this item.
2623
2624 =item *
2625
2626 price - The price paid for the product.
2627
2628 =item *
2629
2630 wholesalePrice - The wholesale price for the product.
2631
2632 =item *
2633
2634 gst - The gst for the product.
2635
2636 =item *
2637
2638 options - A comma separated list of options specified for this item.
2639 These correspond to the option names in the product.
2640
2641 =back
2642
2643 =head2 Options
2644
2645 New with 0.10_04 is the facility to set options for each product.
2646
2647 The cart, checkout and checkoutfinal pages now include the following
2648 tags:
2649
2650 =over
2651
2652 =item *
2653
2654 C<iterator> ... <options>
2655
2656 within an item, iterates over the options for this item in the cart.
2657 Sets the item tag.
2658
2659 =item *
2660
2661 C<option> I<field>
2662
2663 Retrieves the given field from the option, possible field names are:
2664
2665 =over
2666
2667 =item *
2668
2669 id - The type/identifier for this option.  eg. msize for a male
2670 clothing size field.
2671
2672 =item *
2673
2674 value - The underlying value of the option, eg. XL.
2675
2676 =item *
2677
2678 desc - The description of the field from the product options hash.  If
2679 the description isn't defined this is the same as the id. eg. Size.
2680
2681 =item *
2682
2683 label - The description of the value from the product options hash.
2684 eg. "Extra large".
2685
2686 =back
2687
2688 =item *
2689
2690 ifOptions - A conditional tag, true if the current cart item has any
2691 options.
2692
2693 =item *
2694
2695 options - A simple rendering of the options as a parenthesized
2696 comma-separated list.
2697
2698 =back
2699
2700 =cut