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 need_logon 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 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
  20 our $VERSION = "1.034";
  21
  22 use constant MSG_SHOP_CART_FULL => 'Your shopping cart is full, please remove an item and try adding an item again';
  23
  24 my %actions =
  25   (
  26    add => 1,
  27    addmultiple => 1,
  28    cart => 1,
  29    checkout => 1,
  30    checkupdate => 1,
  31    recheckout => 1,
  32    recalc=>1,
  33    recalculate => 1,
  34    #purchase => 1,
  35    order => 1,
  36    show_payment => 1,
  37    payment => 1,
  38    orderdone => 1,
  39    location => 1,
  40    paypalret => 1,
  41    paypalcan => 1,
  42    emptycart => 1,
  43   );
  44
  45 # map of SiteUser field names to order field names - mostly
  46 my %field_map =
  47   (
  48    name1 => 'billFirstName',
  49    name2 => 'billLastName',
  50    street => 'billStreet',
  51    street2 => 'billStreet2',
  52    suburb => 'billSuburb',
  53    postcode => 'billPostCode',
  54    state => 'billState',
  55    country => 'billCountry',
  56    telephone => 'billTelephone',
  57    facsimile => 'billFacsimile',
  58    mobile => 'billMobile',
  59    organization => 'billOrganization',
  60    email => 'billEmail',
  61    delivFacsimile => 'facsimile',
  62    delivTelephone => 'telephone',
  63    delivEmail => 'emailAddress',
  64   );
  65
  66 my %rev_field_map = reverse %field_map;
  67
  68 sub actions { \%actions }
  69
  70 sub default_action { 'cart' }
  71
  72 sub other_action {
  73   my ($class, $cgi) = @_;
  74
  75   for my $key ($cgi->param()) {
  76     if ($key =~ /^delete_(\d+)(?:\.x)?$/) {
  77       return ( remove_item => $1 );
  78     }
  79     elsif ($key =~ /^(?:a_)?addsingle(\d+)(?:\.x)?$/) {
  80       return ( addsingle => $1 );
  81     }
  82   }
  83
  84   return;
  85 }
  86
  87 sub req_cart {
  88   my ($class, $req, $msg) = @_;
  89
  90   $class->_refresh_cart($req);
  91
  92   my @cart = @{$req->session->{cart} || []};
  93   my @cart_prods;
  94   my @items = $class->_build_items($req, \@cart_prods);
  95   my $item_index = -1;
  96   my @options;
  97   my $option_index;
  98
  99   $req->session->{custom} ||= {};
 100   my %custom_state = %{$req->session->{custom}};
 101
 102   my $cust_class = custom_class($req->cfg);
 103   $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $req->cfg);
 104   $msg = '' unless defined $msg;
 105   $msg = escape_html($msg);
 106
 107   $msg ||= $req->message;
 108
 109   my %acts;
 110   %acts =
 111     (
 112      $cust_class->cart_actions(\%acts, \@cart, \@cart_prods, \%custom_state,
 113                                $req->cfg),
 114      shop_cart_tags(\%acts, \@items, \@cart_prods, $req, 'cart'),
 115      basic_tags(\%acts),
 116      msg => $msg,
 117     );
 118   $req->session->{custom} = \%custom_state;
 119   $req->session->{order_info_confirmed} = 0;
 120
 121   # intended to ajax enable the shop cart with partial templates
 122   my $template = 'cart';
 123   my $embed = $req->cgi->param('embed');
 124   if (defined $embed and $embed =~ /^\w+$/) {
 125     $template = "include/cart_$embed";
 126   }
 127   return $req->response($template, \%acts);
 128 }
 129
 130 =item a_emptycart
 131
 132 Empty the shopping cart.
 133
 134 Refreshes to the URL in C<r> or the cart otherwise.
 135
 136 Flashes msg:bse/shop/cart/empty unless C<r> is supplied.
 137
 138 =cut
 139
 140 sub req_emptycart {
 141   my ($self, $req) = @_;
 142
 143   my $old = $req->session->{cart};;
 144   $req->session->{cart} = [];
 145
 146   my $refresh = $req->cgi->param('r');
 147   unless ($refresh) {
 148     $refresh = $req->user_url(shop => 'cart');
 149     $req->flash("msg:bse/shop/cart/empty");
 150   }
 151
 152   return _add_refresh($refresh, $req, !$old);
 153 }
 154
 155 sub req_add {
 156   my ($class, $req) = @_;
 157
 158   my $cgi = $req->cgi;
 159
 160   my $quantity = $cgi->param('quantity');
 161   $quantity ||= 1;
 162
 163   my $error;
 164   my $refresh_logon;
 165   my ($product, $options, $extras);
 166   my $addid = $cgi->param('id');
 167   if (defined $addid) {
 168     ($product, $options, $extras)
 169       = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 170   }
 171   else {
 172     my $code = $cgi->param('code');
 173     if (defined $code) {
 174       ($product, $options, $extras)
 175         = $class->_validate_add_by_code($req, $code, $quantity, \$error, \$refresh_logon);
 176     }
 177     else {
 178       return $class->req_cart($req, "No product id or code supplied");
 179     }
 180   }
 181   if ($refresh_logon) {
 182     return $class->_refresh_logon($req, @$refresh_logon);
 183   }
 184   elsif ($error) {
 185     return $class->req_cart($req, $error);
 186   }
 187
 188   if ($cgi->param('empty')) {
 189     $req->session->{cart} = [];
 190   }
 191
 192   $req->session->{cart} ||= [];
 193   my @cart = @{$req->session->{cart}};
 194   my $started_empty = @cart == 0;
 195
 196   my $found;
 197   for my $item (@cart) {
 198     $item->{productId} eq $product->{id} && _same_options($item->{options}, $options)
 199       or next;
 200
 201     ++$found;
 202     $item->{units} += $quantity;
 203     last;
 204   }
 205   unless ($found) {
 206     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
 207     if (defined $cart_limit && @cart >= $cart_limit) {
 208       return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
 209     }
 210     my $user = $req->siteuser;
 211     my ($price, $tier) = $product->price(user => $user);
 212     push @cart,
 213       {
 214        productId => $product->{id},
 215        units => $quantity,
 216        price=> $price,
 217        options=>$options,
 218        tier => $tier ? $tier->id : "",
 219        user => $user ? $user->id : 0,
 220        %$extras,
 221       };
 222   }
 223
 224   $req->session->{cart} = \@cart;
 225   $req->session->{order_info_confirmed} = 0;
 226
 227   my $refresh = $cgi->param('r');
 228   unless ($refresh) {
 229     $refresh = $req->user_url(shop => 'cart');
 230   }
 231
 232   # speed for ajax
 233   if ($refresh eq 'ajaxcart') {
 234     return $class->req_cart($req);
 235   }
 236
 237   return _add_refresh($refresh, $req, $started_empty);
 238 }
 239
 240 sub req_addsingle {
 241   my ($class, $req, $addid) = @_;
 242
 243   my $cgi = $req->cgi;
 244
 245   $addid ||= '';
 246   my $quantity = $cgi->param("qty$addid");
 247   defined $quantity && $quantity =~ /\S/
 248     or $quantity = 1;
 249
 250   my $error;
 251   my $refresh_logon;
 252   my ($product, $options, $extras)
 253     = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 254   if ($refresh_logon) {
 255     return $class->_refresh_logon($req, @$refresh_logon);
 256   }
 257   elsif ($error) {
 258     return $class->req_cart($req, $error);
 259   }
 260
 261   if ($cgi->param('empty')) {
 262     $req->session->{cart} = [];
 263   }
 264
 265   $req->session->{cart} ||= [];
 266   my @cart = @{$req->session->{cart}};
 267   my $started_empty = @cart == 0;
 268
 269   my $found;
 270   for my $item (@cart) {
 271     $item->{productId} eq $addid && _same_options($item->{options}, $options)
 272       or next;
 273
 274     ++$found;
 275     $item->{units} += $quantity;
 276     last;
 277   }
 278   unless ($found) {
 279     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
 280     if (defined $cart_limit && @cart >= $cart_limit) {
 281       return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
 282     }
 283     my $user = $req->siteuser;
 284     my ($price, $tier) = $product->price(user => $user);
 285     push @cart,
 286       {
 287        productId => $addid,
 288        units => $quantity,
 289        price=> $price,
 290        options=>$options,
 291        tier => $tier ? $tier->id : "",
 292        user => $user ? $user->id : 0,
 293        %$extras,
 294       };
 295   }
 296
 297   $req->session->{cart} = \@cart;
 298   $req->session->{order_info_confirmed} = 0;
 299
 300   my $refresh = $cgi->param('r');
 301   unless ($refresh) {
 302     $refresh = $req->user_url(shop => 'cart');
 303   }
 304
 305   # speed for ajax
 306   if ($refresh eq 'ajaxcart') {
 307     return $class->req_cart($req);
 308   }
 309
 310   return _add_refresh($refresh, $req, $started_empty);
 311 }
 312
 313 sub req_addmultiple {
 314   my ($class, $req) = @_;
 315
 316   my $cgi = $req->cgi;
 317   my @qty_keys = map /^qty(\d+)/, $cgi->param;
 318
 319   my @messages;
 320   my %additions;
 321   for my $addid (@qty_keys) {
 322     my $quantity = $cgi->param("qty$addid");
 323     defined $quantity && $quantity =~ /^\s*\d+\s*$/
 324       or next;
 325
 326     my $error;
 327     my $refresh_logon;
 328     my ($product, $options, $extras) =
 329       $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 330     if ($refresh_logon) {
 331       return $class->_refresh_logon($req, @$refresh_logon);
 332     }
 333     elsif ($error) {
 334       return $class->req_cart($req, $error);
 335     }
 336     if ($product->{options}) {
 337       push @messages, "$product->{title} has options, you need to use the product page to add this product";
 338       next;
 339     }
 340     $additions{$addid} =
 341       {
 342        id => $product->{id},
 343        product => $product,
 344        extras => $extras,
 345        quantity => $quantity,
 346       };
 347   }
 348
 349   my @qtys = $cgi->param("qty");
 350   my @ids = $cgi->param("id");
 351   for my $addid (@ids) {
 352     my $quantity = shift @qtys;
 353     $addid =~ /^\d+$/
 354       or next;
 355     $additions{$addid}
 356       and next;
 357     defined $quantity or $quantity = 1;
 358     $quantity =~ /^\d+$/
 359       or next;
 360     $quantity
 361       or next;
 362     my ($error, $refresh_logon);
 363
 364     my ($product, $options, $extras) =
 365       $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
 366     if ($refresh_logon) {
 367       return $class->_refresh_logon($req, @$refresh_logon);
 368     }
 369     elsif ($error) {
 370       return $class->req_cart($req, $error);
 371     }
 372     if ($product->{options}) {
 373       push @messages, "$product->{title} has options, you need to use the product page to add this product";
 374       next;
 375     }
 376     $additions{$addid} =
 377       {
 378        id => $product->{id},
 379        product => $product,
 380        extras => $extras,
 381        quantity => $quantity,
 382       };
 383   }
 384
 385   my $started_empty = 0;
 386   if (keys %additions) {
 387     if ($cgi->param('empty')) {
 388       $req->session->{cart} = [];
 389     }
 390     $req->session->{cart} ||= [];
 391     my @cart = @{$req->session->{cart}};
 392     $started_empty = @cart == 0;
 393     for my $item (@cart) {
 394       @{$item->{options}} == 0 or next;
 395
 396       my $addition = delete $additions{$item->{productId}}
 397         or next;
 398
 399       $item->{units} += $addition->{quantity};
 400     }
 401
 402     my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
 403
 404     my @additions = grep $_->{quantity} > 0, values %additions;
 405
 406     my $user = $req->siteuser;
 407     my $error;
 408     for my $addition (@additions) {
 409       my $product = $addition->{product};
 410
 411       if (defined $cart_limit && @cart >= $cart_limit) {
 412         $error = $req->text('shop/cartfull', MSG_SHOP_CART_FULL);
 413         last;
 414       }
 415
 416       my ($price, $tier) = $product->price(user => $user);
 417       push @cart,
 418         {
 419          productId => $product->{id},
 420          units => $addition->{quantity},
 421          price=> $price,
 422          tier => $tier ? $tier->id : "",
 423          user => $user ? $user->id : 0,
 424          options=>[],
 425          %{$addition->{extras}},
 426         };
 427     }
 428
 429     $req->session->{cart} = \@cart;
 430     $req->session->{order_info_confirmed} = 0;
 431     $error
 432       and return $class->req_cart($req, $error);
 433   }
 434
 435   my $refresh = $cgi->param('r');
 436   unless ($refresh) {
 437     $refresh = $req->user_url(shop => 'cart');
 438   }
 439   if (@messages) {
 440     my $sep = $refresh =~ /\?/ ? '&' : '?';
 441
 442     for my $message (@messages) {
 443       $refresh .= $sep . "m=" . escape_uri($message);
 444       $sep = '&';
 445     }
 446   }
 447
 448   # speed for ajax
 449   if ($refresh eq 'ajaxcart') {
 450     return $class->req_cart($req);
 451   }
 452
 453   return _add_refresh($refresh, $req, $started_empty);
 454 }
 455
 456 sub tag_ifUser {
 457   my ($user, $args) = @_;
 458
 459   if ($args) {
 460     if ($user) {
 461       return defined $user->{$args} && $user->{$args};
 462     }
 463     else {
 464       return 0;
 465     }
 466   }
 467   else {
 468     return defined $user;
 469   }
 470 }
 471
 472 sub _any_physical_products {
 473   my $prods = shift;
 474
 475   for my $prod (@$prods) {
 476     if ($prod->weight) {
 477       return 1;
 478       last;
 479     }
 480   }
 481
 482   return 0;
 483 }
 484
 485 sub req_checkout {
 486   my ($class, $req, $message, $olddata) = @_;
 487
 488   $class->_refresh_cart($req);
 489
 490   my $errors = {};
 491   if (defined $message) {
 492     if (ref $message) {
 493       $errors = $message;
 494       $message = $req->message($errors);
 495     }
 496   }
 497   else {
 498     $message = '';
 499   }
 500   my $cfg = $req->cfg;
 501   my $cgi = $req->cgi;
 502
 503   my $need_delivery = ( $olddata ? $cgi->param("need_delivery") : $req->session->{order_need_delivery} ) || 0;
 504
 505   $class->update_quantities($req);
 506   my @cart = @{$req->session->{cart}};
 507
 508   @cart or return $class->req_cart($req);
 509
 510   my @cart_prods;
 511   my @items = $class->_build_items($req, \@cart_prods);
 512
 513   if (my ($msg, $id) = $class->_need_logon($req, \@cart, \@cart_prods)) {
 514     return $class->_refresh_logon($req, $msg, $id);
 515     return;
 516   }
 517
 518   my $user = $req->siteuser;
 519
 520   $req->session->{custom} ||= {};
 521   my %custom_state = %{$req->session->{custom}};
 522
 523   my $cust_class = custom_class($cfg);
 524   $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $cfg);
 525
 526   my $affiliate_code = $req->session->{affiliate_code};
 527   defined $affiliate_code or $affiliate_code = '';
 528
 529   my $order_info = $req->session->{order_info};
 530
 531   my $billing_map = BSE::TB::Order->billing_to_delivery_map;
 532   my %delivery_map = reverse %$billing_map;
 533
 534   if ($order_info && !$need_delivery) {
 535     # if need delivery is off, remove any delivery fields
 536     my $map = BSE::TB::Order->billing_to_delivery_map;
 537     delete @{$order_info}{keys %delivery_map};
 538   }
 539
 540   my $old = sub {
 541     my $field = $_[0];
 542     my $value;
 543
 544     if ($olddata && defined($cgi->param($field))) {
 545       $value = $cgi->param($field);
 546     }
 547     elsif ($order_info && defined $order_info->{$field}) {
 548       $value = $order_info->{$field};
 549     }
 550     elsif ($user) {
 551       $rev_field_map{$field} and $field = $rev_field_map{$field};
 552       $value = $user && defined $user->{$field} ? $user->{$field} : '';
 553     }
 554
 555     defined $value or $value = '';
 556     return $value;
 557   };
 558
 559   # shipping handling, if enabled
 560   my $shipping_select = ''; # select of shipping types
 561   my ($delivery_in, $shipping_cost, $shipping_method);
 562   my $shipping_error = '';
 563   my $shipping_name = '';
 564   my $prompt_ship = $cfg->entry("shop", "shipping", 0);
 565
 566   my $physical = _any_physical_products(\@cart_prods);
 567
 568   if ($prompt_ship) {
 569     my $sel_cn = $old->("shipping_name") || "";
 570     if ($physical) {
 571       my $work_order;
 572       $work_order = $order_info unless $olddata;
 573       unless ($work_order) {
 574         my %fake_order;
 575         my %fields = $class->_order_fields($req);
 576         $class->_order_hash($req, \%fake_order, \%fields, user => 1);
 577         $work_order = \%fake_order;
 578       }
 579
 580       # Get a list of couriers
 581       my $country_field = $need_delivery ? "delivCountry" : "billCountry";
 582       my $country = $old->($country_field)
 583         || bse_default_country($cfg);
 584       my $country_code = bse_country_code($country);
 585       my $suburb = $old->($need_delivery ? "delivSuburb" : "billSuburb");
 586       my $postcode = $old->($need_delivery ? "delivPostCode" : "billPostCode");
 587
 588       $country_code
 589         or $errors->{$country_field} = "Unknown country name $country";
 590
 591       my @couriers = BSE::Shipping->get_couriers($cfg);
 592
 593       if ($country_code and $postcode) {
 594         @couriers = grep $_->can_deliver(country => $country_code,
 595                                          suburb => $suburb,
 596                                          postcode => $postcode), @couriers;
 597       }
 598
 599       my ($sel_cour) = grep $_->name eq $sel_cn, @couriers;
 600       # if we don't match against the list (perhaps because of a country
 601       # change) the first item in the list will be selected by the
 602       # browser anyway, so select it ourselves and display an
 603       # appropriate shipping cost for the item
 604       unless ($sel_cour) {
 605         $sel_cour = $couriers[0];
 606         $sel_cn = $sel_cour->name;
 607       }
 608       if ($sel_cour and $postcode and $suburb and $country_code) {
 609         my @parcels = BSE::Shipping->package_order($cfg, $order_info, \@items);
 610         $shipping_cost = $sel_cour->calculate_shipping
 611           (
 612            parcels => \@parcels,
 613            suburb => $suburb,
 614            postcode => $postcode,
 615            country => $country_code,
 616            products => \@cart_prods,
 617            items => \@items,
 618           );
 619         $delivery_in = $sel_cour->delivery_in();
 620         $shipping_method = $sel_cour->description();
 621         $shipping_name = $sel_cour->name;
 622         unless (defined $shipping_cost) {
 623           $shipping_error = "$shipping_method: " . $sel_cour->error_message;
 624           $errors->{shipping_name} = $shipping_error;
 625
 626           # use the last one, which should be the Null shipper
 627           $sel_cour = $couriers[-1];
 628           $sel_cn = $sel_cour->name;
 629           $shipping_method = $sel_cour->description;
 630         }
 631       }
 632
 633       $shipping_select = popup_menu
 634         (
 635          -name => "shipping_name",
 636          -id => "shipping_name",
 637          -values => [ map $_->name, @couriers ],
 638          -labels => { map { $_->name => $_->description } @couriers },
 639          -default => $sel_cn,
 640         );
 641     }
 642     else {
 643       $sel_cn = $shipping_name = "none";
 644       $shipping_method = "Nothing to ship!";
 645       $shipping_select = popup_menu
 646         (
 647          -name => "shipping_name",
 648          -id => "shipping_name",
 649          -values => [ "none" ],
 650          -labels => { none => $shipping_method },
 651          -default => $sel_cn,
 652         );
 653     }
 654   }
 655
 656   if (!$message && keys %$errors) {
 657     $message = $req->message($errors);
 658   }
 659
 660   my $item_index = -1;
 661   my @options;
 662   my $option_index;
 663   my %acts;
 664   %acts =
 665     (
 666      shop_cart_tags(\%acts, \@items, \@cart_prods, $req, 'checkout'),
 667      basic_tags(\%acts),
 668      message => $message,
 669      msg => $message,
 670      old => sub { escape_html($old->($_[0])); },
 671      $cust_class->checkout_actions(\%acts, \@cart, \@cart_prods,
 672                                    \%custom_state, $req->cgi, $cfg),
 673      ifUser => [ \&tag_ifUser, $user ],
 674      user => $user ? [ \&tag_hash, $user ] : '',
 675      affiliate_code => escape_html($affiliate_code),
 676      error_img => [ \&tag_error_img, $cfg, $errors ],
 677      ifShipping => $prompt_ship,
 678      shipping_select => $shipping_select,
 679      delivery_in => escape_html($delivery_in),
 680      shipping_cost => $shipping_cost,
 681      shipping_method => escape_html($shipping_method),
 682      shipping_error => escape_html($shipping_error),
 683      shipping_name => $shipping_name,
 684      ifPhysical => $physical,
 685      ifNeedDelivery => $need_delivery,
 686     );
 687   $req->session->{custom} = \%custom_state;
 688   my $tmp = $acts{total};
 689   $acts{total} =
 690     sub {
 691         my $total = &$tmp();
 692         $total += $shipping_cost if $total and $shipping_cost;
 693         return $total;
 694     };
 695
 696   return $req->response('checkoutnew', \%acts);
 697 }
 698
 699 sub req_checkupdate {
 700   my ($class, $req) = @_;
 701
 702   $req->session->{cart} ||= [];
 703   my @cart = @{$req->session->{cart}};
 704   my @cart_prods = map { Products->getByPkey($_->{productId}) } @cart;
 705   $req->session->{custom} ||= {};
 706   my %custom_state = %{$req->session->{custom}};
 707   custom_class($req->cfg)
 708       ->checkout_update($req->cgi, \@cart, \@cart_prods, \%custom_state, $req->cfg);
 709   $req->session->{custom} = \%custom_state;
 710   $req->session->{order_info_confirmed} = 0;
 711
 712   return $class->req_checkout($req, "", 1);
 713 }
 714
 715 sub req_remove_item {
 716   my ($class, $req, $index) = @_;
 717
 718   $req->session->{cart} ||= [];
 719   my @cart = @{$req->session->{cart}};
 720   if ($index >= 0 && $index < @cart) {
 721     splice(@cart, $index, 1);
 722   }
 723   $req->session->{cart} = \@cart;
 724   $req->session->{order_info_confirmed} = 0;
 725
 726   return BSE::Template->get_refresh($req->user_url(shop => 'cart'), $req->cfg);
 727 }
 728
 729 sub _order_fields {
 730   my ($self, $req) = @_;
 731
 732   my %fields = BSE::TB::Order->valid_fields($req->cfg);
 733   my $cust_class = custom_class($req->cfg);
 734   my @required =
 735     $cust_class->required_fields($req->cgi, $req->session->{custom}, $req->cfg);
 736
 737   for my $name (@required) {
 738     $fields{$name}{required} = 1;
 739   }
 740
 741   return %fields;
 742 }
 743
 744 sub _order_hash {
 745   my ($self, $req, $values, $fields, %opts) = @_;
 746
 747   my $cgi = $req->cgi;
 748   my $user = $req->siteuser;
 749   for my $name (keys %$fields) {
 750     my ($value) = $cgi->param($name);
 751     if (!defined $value && $opts{user} && $user) {
 752       my $field = $rev_field_map{$name} || $name;
 753       if ($user->can($field)) {
 754         $value = $user->$field();
 755       }
 756     }
 757     defined $value or $value = "";
 758     $values->{$name} = $value;
 759   }
 760
 761   unless ($cgi->param("need_delivery")) {
 762     my $map = BSE::TB::Order->billing_to_delivery_map;
 763     keys %$map; # reset iterator
 764     while (my ($billing, $delivery) = each %$map) {
 765       $values->{$delivery} = $values->{$billing};
 766     }
 767   }
 768 }
 769
 770 # saves order and refresh to payment page
 771 sub req_order {
 772   my ($class, $req) = @_;
 773
 774   my $cfg = $req->cfg;
 775   my $cgi = $req->cgi;
 776
 777   $req->session->{cart} && @{$req->session->{cart}}
 778     or return $class->req_cart($req, "Your cart is empty");
 779
 780   my $msg;
 781   $class->_validate_cfg($req, \$msg)
 782     or return $class->req_cart($req, $msg);
 783
 784   my @products;
 785   my @items = $class->_build_items($req, \@products);
 786
 787   my $id;
 788   if (($msg, $id) = $class->_need_logon($req, \@items, \@products)) {
 789     return $class->_refresh_logon($req, $msg, $id);
 790   }
 791
 792   my %fields = $class->_order_fields($req);
 793   my %rules = BSE::TB::Order->valid_rules($cfg);
 794
 795   my %errors;
 796   my %values;
 797   $class->_order_hash($req, \%values, \%fields);
 798
 799   dh_validate_hash(\%values, \%errors, { rules=>\%rules, fields=>\%fields },
 800                    $cfg, 'Shop Order Validation');
 801   my $prompt_ship = $cfg->entry("shop", "shipping", 0);
 802   if ($prompt_ship) {
 803     my $country = $values{delivCountry} || bse_default_country($cfg);
 804     my $country_code = bse_country_code($country);
 805     $country_code
 806       or $errors{delivCountry} = "Unknown country name $country";
 807   }
 808   keys %errors
 809     and return $class->req_checkout($req, \%errors, 1);
 810
 811   $class->_fillout_order($req, \%values, \@items, \@products, \$msg, 'payment')
 812     or return $class->req_checkout($req, $msg, 1);
 813
 814   $req->session->{order_info} = \%values;
 815   $req->session->{order_need_delivery} = $cgi->param("need_delivery");
 816   $req->session->{order_info_confirmed} = 1;
 817
 818   # skip payment page if nothing to pay
 819   if ($values{total} == 0) {
 820     return $class->req_payment($req);
 821   }
 822   else {
 823     return BSE::Template->get_refresh($req->user_url(shop => 'show_payment'), $req->cfg);
 824   }
 825 }
 826
 827 =item a_show_payment
 828
 829 Allows the customer to pay for an existing order.
 830
 831 Parameters:
 832
 833 =over
 834
 835 =item *
 836
 837 orderid - the order id to be paid (Optional, otherwise displays the
 838 cart for payment).
 839
 840 =back
 841
 842 Template: checkoutpay
 843
 844 =cut
 845
 846
 847 sub req_show_payment {
 848   my ($class, $req, $errors) = @_;
 849
 850   my $cfg = $req->cfg;
 851   my $cgi = $req->cgi;
 852
 853   my @items;
 854   my @products;
 855   my $order;
 856
 857   # ideally supply order_id to be consistent with a_payment.
 858   my $order_id = $cgi->param('orderid') || $cgi->param("order_id");
 859   if ($order_id) {
 860     $order_id =~ /^\d+$/
 861       or return $class->req_cart($req, "No or invalid order id supplied");
 862
 863     my $user = $req->siteuser
 864       or return $class->_refresh_logon
 865         ($req, "Please logon before paying your existing order", "logonpayorder",
 866          undef, { a_show_payment => 1, orderid => $order_id });
 867
 868     require BSE::TB::Orders;
 869     $order = BSE::TB::Orders->getByPkey($order_id)
 870       or return $class->req_cart($req, "Unknown order id");
 871
 872     $order->siteuser_id == $user->id
 873       or return $class->req_cart($req, "You can only pay for your own orders");
 874
 875     $order->paidFor
 876       and return $class->req_cart($req, "Order $order->{id} has been paid");
 877
 878     @items = $order->items;
 879     @products = $order->products;
 880   }
 881   else {
 882     $req->session->{order_info_confirmed}
 883       or return $class->req_checkout($req, 'Please proceed via the checkout page');
 884
 885     $req->session->{cart} && @{$req->session->{cart}}
 886       or return $class->req_cart($req, "Your cart is empty");
 887
 888     $order = $req->session->{order_info}
 889       or return $class->req_checkout($req, "You need to enter order information first");
 890
 891     @items = $class->_build_items($req, \@products);
 892   }
 893
 894   $errors ||= {};
 895   my $msg = $req->message($errors);
 896
 897   my @pay_types = payment_types($cfg);
 898   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
 899   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
 900   @payment_types or @payment_types = ( PAYMENT_CALLME );
 901   @payment_types = sort { $a <=> $b } @payment_types;
 902   my %payment_types = map { $_=> 1 } @payment_types;
 903   my $payment;
 904   $errors and $payment = $cgi->param('paymentType');
 905   defined $payment or $payment = $payment_types[0];
 906
 907   my %acts;
 908   %acts =
 909     (
 910      basic_tags(\%acts),
 911      message => $msg,
 912      msg => $msg,
 913      order => [ \&tag_hash, $order ],
 914      shop_cart_tags(\%acts, \@items, \@products, $req, 'payment'),
 915      ifMultPaymentTypes => @payment_types > 1,
 916      checkedPayment => [ \&tag_checkedPayment, $payment, \%types_by_name ],
 917      ifPayments => [ \&tag_ifPayments, \@payment_types, \%types_by_name ],
 918      paymentTypeId => [ \&tag_paymentTypeId, \%types_by_name ],
 919      error_img => [ \&tag_error_img, $cfg, $errors ],
 920      total => $order->{total},
 921      delivery_in => $order->{delivery_in},
 922      shipping_cost => $order->{shipping_cost},
 923      shipping_method => $order->{shipping_method},
 924     );
 925   for my $type (@pay_types) {
 926     my $id = $type->{id};
 927     my $name = $type->{name};
 928     $acts{"if${name}Payments"} = exists $payment_types{$id};
 929     $acts{"if${name}FirstPayment"} = $payment_types[0] == $id;
 930     $acts{"checkedIfFirst$name"} = $payment_types[0] == $id ? "checked " : "";
 931     $acts{"checkedPayment$name"} = $payment == $id ? 'checked="checked" ' : "";
 932   }
 933
 934   return $req->response('checkoutpay', \%acts);
 935 }
 936
 937 my %nostore =
 938   (
 939    cardNumber => 1,
 940    cardExpiry => 1,
 941    delivery_in => 1,
 942    cardVerify => 1,
 943    ccName => 1,
 944   );
 945
 946 my %bill_ccmap =
 947   (
 948    # hash of CC payment parameter names to arrays of billing address fields
 949    firstname => "billFirstName",
 950    lastname => "billLastName",
 951    address1 => "billStreet",
 952    address2 => "billStreet2",
 953    postcode => "billPostCode",
 954    state => "billState",
 955    suburb => "billSuburb",
 956    email => "billEmail",
 957   );
 958
 959 sub req_payment {
 960   my ($class, $req, $errors) = @_;
 961
 962   require BSE::TB::Orders;
 963   my $cgi = $req->cgi;
 964   my $order_id = $cgi->param("order_id");
 965   my $user = $req->siteuser;
 966   my $order;
 967   my $order_values;
 968   my $old_order; # true if we're paying an old order
 969   if ($order_id) {
 970     unless ($user) {
 971       return $class->_refresh_logon
 972         (
 973          $req,
 974          "Please logon before paying your existing order",
 975          "logonpayorder",
 976          undef,
 977          { a_show_payment => 1, orderid => $order_id }
 978         );
 979     }
 980     $order_id =~ /^\d+$/
 981       or return $class->req_cart($req, "Invalid order id");
 982     $order = BSE::TB::Orders->getByPkey($order_id)
 983       or return $class->req_cart($req, "Unknown order id");
 984     $order->siteuser_id == $user->id
 985       or return $class->req_cart($req, "You can only pay for your own orders");
 986
 987     $order->paidFor
 988       and return $class->req_cart($req, "Order $order->{id} has been paid");
 989
 990     $order_values = $order;
 991     $old_order = 1;
 992   }
 993   else {
 994     $req->session->{order_info_confirmed}
 995       or return $class->req_checkout($req, 'Please proceed via the checkout page');
 996
 997     $order_values = $req->session->{order_info}
 998       or return $class->req_checkout($req, "You need to enter order information first");
 999     $old_order = 0;
1000   }
1001
1002   my $cfg = $req->cfg;
1003   my $session = $req->session;
1004
1005   my $paymentType;
1006   if ($order_values->{total} != 0) {
1007     my @pay_types = payment_types($cfg);
1008     my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1009     my %pay_types = map { $_->{id} => $_ } @pay_types;
1010     my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1011     @payment_types or @payment_types = ( PAYMENT_CALLME );
1012     @payment_types = sort { $a <=> $b } @payment_types;
1013     my %payment_types = map { $_=> 1 } @payment_types;
1014
1015     $paymentType = $cgi->param('paymentType');
1016     defined $paymentType or $paymentType = $payment_types[0];
1017     $payment_types{$paymentType}
1018       or return $class->req_show_payment($req, { paymentType => "Invalid payment type" } , 1);
1019
1020     my @required;
1021     push @required, @{$pay_types{$paymentType}{require}};
1022
1023     my %fields = BSE::TB::Order->valid_payment_fields($cfg);
1024     my %rules = BSE::TB::Order->valid_payment_rules($cfg);
1025     for my $field (@required) {
1026       if (exists $fields{$field}) {
1027         $fields{$field}{required} = 1;
1028       }
1029       else {
1030         $fields{$field} = { description => $field, required=> 1 };
1031       }
1032     }
1033
1034     my %errors;
1035     dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
1036                 $cfg, 'Shop Order Validation');
1037     keys %errors
1038       and return $class->req_show_payment($req, \%errors);
1039
1040     for my $field (keys %fields) {
1041       unless ($nostore{$field}) {
1042         if (my ($value) = $cgi->param($field)) {
1043           $order_values->{$field} = $value;
1044         }
1045       }
1046     }
1047
1048   }
1049   else {
1050     $paymentType = -1;
1051   }
1052
1053   $order_values->{paymentType} = $paymentType;
1054   my @dbitems;
1055   my @products;
1056   my %subscribing_to;
1057   if ($order) {
1058     @dbitems = $order->items;
1059     @products = $order->products;
1060     for my $product (@products) {
1061       my $sub = $product->subscription;
1062       if ($sub) {
1063         $subscribing_to{$sub->{text_id}} = $sub;
1064       }
1065     }
1066   }
1067   else {
1068     $order_values->{filled} = 0;
1069     $order_values->{paidFor} = 0;
1070
1071     my @items = $class->_build_items($req, \@products);
1072
1073     if ($session->{order_work}) {
1074       $order = BSE::TB::Orders->getByPkey($session->{order_work});
1075     }
1076     if ($order && !$order->{complete}) {
1077       my @columns = BSE::TB::Order->columns;
1078       shift @columns; # don't set id
1079       my %columns;
1080       @columns{@columns} = @columns;
1081
1082       for my $col (@columns) {
1083         defined $order_values->{$col} or $order_values->{$col} = '';
1084       }
1085
1086       my @data = @{$order_values}{@columns};
1087       shift @data;
1088
1089       print STDERR "Recycling order $order->{id}\n";
1090
1091       my @allbutid = @columns;
1092       shift @allbutid;
1093       @{$order}{@allbutid} = @data;
1094
1095       $order->clear_items;
1096       delete $session->{order_work};
1097       eval {
1098         tied(%$session)->save;
1099       };
1100     }
1101     else {
1102       $order = BSE::TB::Orders->make(%$order_values)
1103         or die "Cannot add order";
1104     }
1105
1106     my @item_cols = BSE::TB::OrderItem->columns;
1107     for my $row_num (0..$#items) {
1108       my $item = $items[$row_num];
1109       my $product = $products[$row_num];
1110       my %item = %$item;
1111       $item{orderId} = $order->{id};
1112       $item{max_lapsed} = 0;
1113       if ($product->{subscription_id} != -1) {
1114         my $sub = $product->subscription;
1115         $item{max_lapsed} = $sub->{max_lapsed} if $sub;
1116       }
1117       defined $item{session_id} or $item{session_id} = 0;
1118       $item{options} = ""; # not used for new orders
1119       my @data = @item{@item_cols};
1120     shift @data;
1121       my $dbitem = BSE::TB::OrderItems->add(@data);
1122       push @dbitems, $dbitem;
1123
1124       if ($item->{options} and @{$item->{options}}) {
1125         require BSE::TB::OrderItemOptions;
1126         my @option_descs = $product->option_descs($cfg, $item->{options});
1127         my $display_order = 1;
1128         for my $option (@option_descs) {
1129           BSE::TB::OrderItemOptions->make
1130               (
1131                order_item_id => $dbitem->{id},
1132                original_id => $option->{id},
1133                name => $option->{desc},
1134                value => $option->{value},
1135                display => $option->{display},
1136                display_order => $display_order++,
1137               );
1138         }
1139       }
1140
1141       my $sub = $product->subscription;
1142       if ($sub) {
1143         $subscribing_to{$sub->{text_id}} = $sub;
1144       }
1145
1146       if ($item->{session_id}) {
1147         require BSE::TB::SeminarSessions;
1148         my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
1149         my $options = join(",", @{$item->{options}});
1150         $session->add_attendee($user,
1151                                customer_instructions => $order->{instructions},
1152                                options => $options);
1153       }
1154     }
1155   }
1156
1157   $order->set_randomId(make_secret($cfg));
1158   $order->{ccOnline} = 0;
1159
1160   my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
1161   if ($paymentType == PAYMENT_CC) {
1162     my $ccNumber = $cgi->param('cardNumber');
1163     my $ccExpiry = $cgi->param('cardExpiry');
1164     my $ccName   = $cgi->param('ccName');
1165
1166     if ($ccprocessor) {
1167       my $cc_class = credit_card_class($cfg);
1168
1169       $order->{ccOnline} = 1;
1170
1171       $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
1172       my ($month, $year) = ($1, $2);
1173       $year > 2000 or $year += 2000;
1174       my $expiry = sprintf("%04d%02d", $year, $month);
1175       my $verify = $cgi->param('cardVerify');
1176       defined $verify or $verify = '';
1177       my %more;
1178       while (my ($cc_field, $order_field) = each %bill_ccmap) {
1179         if ($order->$order_field()) {
1180           $more{$cc_field} = $order->$order_field();
1181         }
1182       }
1183       my $result = $cc_class->payment
1184         (
1185          orderno => $order->{id},
1186          amount => $order->{total},
1187          cardnumber => $ccNumber,
1188          nameoncard => $ccName,
1189          expirydate => $expiry,
1190          cvv => $verify,
1191          ipaddress => $ENV{REMOTE_ADDR},
1192          %more,
1193         );
1194       unless ($result->{success}) {
1195         use Data::Dumper;
1196         print STDERR Dumper($result);
1197         # failed, back to payments
1198         $order->{ccSuccess}     = 0;
1199         $order->{ccStatus}      = $result->{statuscode};
1200         $order->{ccStatus2}     = 0;
1201         $order->{ccStatusText}  = $result->{error};
1202         $order->{ccTranId}      = '';
1203         $order->save;
1204         my %errors;
1205         $errors{cardNumber} = $result->{error};
1206         $session->{order_work} = $order->{id};
1207         return $class->req_show_payment($req, \%errors);
1208       }
1209
1210       $order->{ccSuccess}           = 1;
1211       $order->{ccReceipt}           = $result->{receipt};
1212       $order->{ccStatus}            = 0;
1213       $order->{ccStatus2}           = 0;
1214       $order->{ccStatusText}  = '';
1215       $order->{ccTranId}            = $result->{transactionid};
1216       $order->set_ccPANTruncate($ccNumber);
1217       defined $order->{ccTranId} or $order->{ccTranId} = '';
1218       $order->{paidFor}     = 1;
1219     }
1220     else {
1221       $ccNumber =~ tr/0-9//cd;
1222       $order->{ccExpiryHash} = md5_hex($ccExpiry);
1223       $order->set_ccPANTruncate($ccNumber);
1224     }
1225     $order->set_ccName($ccName);
1226   }
1227   elsif ($paymentType == PAYMENT_PAYPAL) {
1228     require BSE::PayPal;
1229     my $msg;
1230     my $url = BSE::PayPal->payment_url(order => $order,
1231                                        user => $user,
1232                                        msg => \$msg);
1233     unless ($url) {
1234       $session->{order_work} = $order->{id};
1235       my %errors;
1236       $errors{_} = "PayPal error: $msg" if $msg;
1237       return $class->req_show_payment($req, \%errors);
1238     }
1239
1240     # have to mark it complete so it doesn't get used by something else
1241     return BSE::Template->get_refresh($url, $req->cfg);
1242   }
1243
1244   # order complete
1245   $order->set_complete(1);
1246   $order->set_stage("unprocessed");
1247   $order->save;
1248
1249   $class->_finish_order($req, $order);
1250
1251   return BSE::Template->get_refresh($req->user_url(shop => 'orderdone'), $req->cfg);
1252 }
1253
1254 # do final processing of an order after payment
1255 sub _finish_order {
1256   my ($self, $req, $order) = @_;
1257
1258
1259   my $custom = custom_class($req->cfg);
1260   $custom->can("order_complete")
1261     and $custom->order_complete($req->cfg, $order);
1262
1263   # set the order displayed by orderdone
1264   $req->session->{order_completed} = $order->{id};
1265   $req->session->{order_completed_at} = time;
1266
1267   $self->_send_order($req, $order);
1268
1269   # empty the cart ready for the next order
1270   delete @{$req->session}{qw/order_info order_info_confirmed order_need_delivery cart order_work/};
1271 }
1272
1273 sub req_orderdone {
1274   my ($class, $req) = @_;
1275
1276   my $session = $req->session;
1277   my $cfg = $req->cfg;
1278
1279   my $id = $session->{order_completed};
1280   my $when = $session->{order_completed_at};
1281   $id && defined $when && time < $when + 500
1282     or return $class->req_cart($req);
1283
1284   my $order = BSE::TB::Orders->getByPkey($id)
1285     or return $class->req_cart($req);
1286   my @items = $order->items;
1287   my @products = map { Products->getByPkey($_->{productId}) } @items;
1288
1289   my @item_cols = BSE::TB::OrderItem->columns;
1290   my %copy_cols = map { $_ => 1 } Product->columns;
1291   delete @copy_cols{@item_cols};
1292   my @copy_cols = keys %copy_cols;
1293   my @showitems;
1294   for my $item_index (0..$#items) {
1295     my $item = $items[$item_index];
1296     my $product = $products[$item_index];
1297     my %entry;
1298     @entry{@item_cols} = @{$item}{@item_cols};
1299     @entry{@copy_cols} = @{$product}{@copy_cols};
1300
1301     push @showitems, \%entry;
1302   }
1303
1304   my $cust_class = custom_class($req->cfg);
1305
1306   my @pay_types = payment_types($cfg);
1307   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1308   my %pay_types = map { $_->{id} => $_ } @pay_types;
1309   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1310
1311   my $item_index = -1;
1312   my @options;
1313   my $option_index;
1314   my $item;
1315   my $product;
1316   my $sem_session;
1317   my $location;
1318   require BSE::Util::Iterate;
1319   my $it = BSE::Util::Iterate::Objects->new(cfg => $req->cfg);
1320   my $message = $req->message();
1321   my %acts;
1322   %acts =
1323     (
1324      $req->dyn_user_tags(),
1325      $cust_class->purchase_actions(\%acts, \@items, \@products,
1326                                    $session->{custom}, $cfg),
1327      BSE::Util::Tags->static(\%acts, $cfg),
1328      iterate_items_reset => sub { $item_index = -1; },
1329      iterate_items =>
1330      sub {
1331        if (++$item_index < @items) {
1332          $option_index = -1;
1333          @options = order_item_opts($req, $items[$item_index]);
1334          undef $sem_session;
1335          undef $location;
1336          $item = $items[$item_index];
1337          $product = $products[$item_index];
1338          return 1;
1339        }
1340        undef $item;
1341        undef $sem_session;
1342        undef $product;
1343        undef $location;
1344        return 0;
1345      },
1346      item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
1347      product =>
1348      sub {
1349        return tag_article($product, $cfg, $_[0]);
1350      },
1351      extended =>
1352      sub {
1353        my $what = $_[0] || 'retailPrice';
1354        $items[$item_index]{units} * $items[$item_index]{$what};
1355      },
1356      order => sub { escape_html($order->{$_[0]}) },
1357      _format =>
1358      sub {
1359        my ($value, $fmt) = @_;
1360        if ($fmt =~ /^m(\d+)/) {
1361          return sprintf("%$1s", sprintf("%.2f", $value/100));
1362        }
1363        elsif ($fmt =~ /%/) {
1364          return sprintf($fmt, $value);
1365        }
1366      },
1367      iterate_options_reset => sub { $option_index = -1 },
1368      iterate_options => sub { ++$option_index < @options },
1369      option => sub { escape_html($options[$option_index]{$_[0]}) },
1370      ifOptions => sub { @options },
1371      options => sub { nice_options(@options) },
1372      ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
1373      #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1374      session => [ \&tag_session, \$item, \$sem_session ],
1375      location => [ \&tag_location, \$item, \$location ],
1376      msg => $message,
1377      delivery_in => $order->{delivery_in},
1378      shipping_cost => $order->{shipping_cost},
1379      shipping_method => $order->{shipping_method},
1380      $it->make
1381      (
1382       single => "orderpaidfile",
1383       plural => "orderpaidfiles",
1384       code => [ paid_files => $order ],
1385      ),
1386     );
1387   for my $type (@pay_types) {
1388     my $id = $type->{id};
1389     my $name = $type->{name};
1390     $acts{"if${name}Payment"} = $order->{paymentType} == $id;
1391   }
1392
1393   return $req->response('checkoutfinal', \%acts);
1394 }
1395
1396 sub tag_session {
1397   my ($ritem, $rsession, $arg) = @_;
1398
1399   $$ritem or return '';
1400
1401   $$ritem->{session_id} or return '';
1402
1403   unless ($$rsession) {
1404     require BSE::TB::SeminarSessions;
1405     $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
1406       or return '';
1407   }
1408
1409   my $value = $$rsession->{$arg};
1410   defined $value or return '';
1411
1412   escape_html($value);
1413 }
1414
1415 sub tag_location {
1416   my ($ritem, $rlocation, $arg) = @_;
1417
1418   $$ritem or return '';
1419
1420   $$ritem->{session_id} or return '';
1421
1422   unless ($$rlocation) {
1423     require BSE::TB::Locations;
1424     ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
1425       or return '';
1426   }
1427
1428   my $value = $$rlocation->{$arg};
1429   defined $value or return '';
1430
1431   escape_html($value);
1432 }
1433
1434 sub tag_ifPayment {
1435   my ($payment, $types_by_name, $args) = @_;
1436
1437   my $type = $args;
1438   if ($type !~ /^\d+$/) {
1439     return '' unless exists $types_by_name->{$type};
1440     $type = $types_by_name->{$type};
1441   }
1442
1443   return $payment == $type;
1444 }
1445
1446 sub tag_paymentTypeId {
1447   my ($types_by_name, $args) = @_;
1448
1449   if (exists $types_by_name->{$args}) {
1450     return $types_by_name->{$args};
1451   }
1452
1453   return '';
1454 }
1455
1456
1457 sub _validate_cfg {
1458   my ($class, $req, $rmsg) = @_;
1459
1460   my $cfg = $req->cfg;
1461   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1462   unless ($from && $from =~ /.\@./) {
1463     $$rmsg = "Configuration error: shop from address not set";
1464     return;
1465   }
1466   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1467   unless ($toEmail && $toEmail =~ /.\@./) {
1468     $$rmsg = "Configuration error: shop to_email address not set";
1469     return;
1470   }
1471
1472   return 1;
1473 }
1474
1475 sub req_recalc {
1476   my ($class, $req) = @_;
1477
1478   $class->update_quantities($req);
1479   $req->session->{order_info_confirmed} = 0;
1480   return $class->req_cart($req);
1481 }
1482
1483 sub req_recalculate {
1484   my ($class, $req) = @_;
1485
1486   return $class->req_recalc($req);
1487 }
1488
1489 sub _send_order {
1490   my ($class, $req, $order) = @_;
1491
1492   my $cfg = $req->cfg;
1493   my $cgi = $req->cgi;
1494
1495   my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
1496   my $crypto_class = $cfg->entry('shop', 'crypt_module',
1497                                  $Constants::SHOP_CRYPTO);
1498   my $signing_id = $cfg->entry('shop', 'crypt_signing_id',
1499                                $Constants::SHOP_SIGNING_ID);
1500   my $pgp = $cfg->entry('shop', 'crypt_pgp', $Constants::SHOP_PGP);
1501   my $pgpe = $cfg->entry('shop', 'crypt_pgpe', $Constants::SHOP_PGPE);
1502   my $gpg = $cfg->entry('shop', 'crypt_gpg', $Constants::SHOP_GPG);
1503   my $passphrase = $cfg->entry('shop', 'crypt_passphrase',
1504                                $Constants::SHOP_PASSPHRASE);
1505   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1506   my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
1507   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1508   my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
1509
1510   my $session = $req->session;
1511   my %extras = $cfg->entriesCS('extra tags');
1512   for my $key (keys %extras) {
1513     # follow any links
1514     my $data = $cfg->entryVar('extra tags', $key);
1515     $extras{$key} = sub { $data };
1516   }
1517
1518   my @items = $order->items;
1519   my @products = map $_->product, @items;
1520   my %subscribing_to;
1521   for my $product (@products) {
1522     my $sub = $product->subscription;
1523     if ($sub) {
1524       $subscribing_to{$sub->{text_id}} = $sub;
1525     }
1526   }
1527
1528   my $item_index = -1;
1529   my @options;
1530   my $option_index;
1531   my %acts;
1532   %acts =
1533     (
1534      %extras,
1535      custom_class($cfg)
1536      ->order_mail_actions(\%acts, $order, \@items, \@products,
1537                           $session->{custom}, $cfg),
1538      BSE::Util::Tags->mail_tags(),
1539      $order->mail_tags(),
1540      ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
1541     );
1542
1543   my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
1544   require BSE::ComposeMail;
1545   if ($email_order) {
1546     unless ($noencrypt) {
1547       $acts{cardNumber} = $cgi->param('cardNumber');
1548       $acts{cardExpiry} = $cgi->param('cardExpiry');
1549       $acts{cardVerify} = $cgi->param('cardVerify');
1550     }
1551
1552     my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1553     $mailer->start
1554       (
1555        to=>$toEmail,
1556        from=>$from,
1557        subject=>'New Order '.$order->{id},
1558        acts => \%acts,
1559        template => "mailorder",
1560        log_component => "shop:sendorder:mailowner",
1561        log_object => $order,
1562        log_msg => "Order $order->{id} sent to site owner",
1563       );
1564
1565     unless ($noencrypt) {
1566       my %crypt_opts;
1567       my $sign = $cfg->entryBool('basic', 'sign', 1);
1568       $sign or $crypt_opts{signing_id} = "";
1569       $crypt_opts{recipient} =
1570         $cfg->entry("shop", "crypt_recipient", "$toName $toEmail");
1571       $mailer->encrypt_body(%crypt_opts);
1572     }
1573
1574     unless ($mailer->done) {
1575       $req->flash_error("Could not mail order to admin: " . $mailer->errstr);
1576     }
1577
1578     delete @acts{qw/cardNumber cardExpiry cardVerify/};
1579   }
1580   my $to_email = $order->billEmail;
1581   my $user = $req->siteuser;
1582   my $to = $to_email;
1583   if ($user && $user->email eq $to_email) {
1584     $to = $user;
1585   }
1586   my $mailer = BSE::ComposeMail->new(cfg => $cfg);
1587   my %opts =
1588     (
1589      to => $to,
1590      from => $from,
1591      subject => $subject . " " . localtime,
1592      template => "mailconfirm",
1593      acts => \%acts,
1594      log_component => "shop:sendorder:mailbuyer",
1595      log_object => $order,
1596      log_msg => "Order $order->{id} sent to purchaser $to_email",
1597     );
1598   my $bcc_order = $cfg->entry("shop", "bcc_email");
1599   if ($bcc_order) {
1600     $opts{bcc} = $bcc_order;
1601   }
1602   $mailer->send(%opts)
1603     or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1604 }
1605
1606 sub _refresh_logon {
1607   my ($class, $req, $msg, $msgid, $r, $parms) = @_;
1608
1609   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1610   my $url = $securlbase."/cgi-bin/user.pl";
1611   $parms ||= { checkout => 1 };
1612
1613   unless ($r) {
1614     $r = $securlbase."/cgi-bin/shop.pl?"
1615       . join("&", map "$_=" . escape_uri($parms->{$_}), keys %$parms);
1616   }
1617
1618   my %parms;
1619   if ($req->cfg->entry('shop registration', 'all')
1620       || $req->cfg->entry('shop registration', $msgid)) {
1621     $parms{show_register} = 1;
1622   }
1623   $parms{r} = $r;
1624   if ($msgid) {
1625     $msg = $req->cfg->entry('messages', $msgid, $msg);
1626   }
1627   $parms{message} = $msg if $msg;
1628   $parms{mid} = $msgid if $msgid;
1629   $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1630
1631   return BSE::Template->get_refresh($url, $req->cfg);
1632 }
1633
1634 sub _need_logon {
1635   my ($class, $req, $cart, $cart_prods) = @_;
1636
1637   return need_logon($req, $cart, $cart_prods);
1638 }
1639
1640 sub tag_checkedPayment {
1641   my ($payment, $types_by_name, $args) = @_;
1642
1643   my $type = $args;
1644   if ($type !~ /^\d+$/) {
1645     return '' unless exists $types_by_name->{$type};
1646     $type = $types_by_name->{$type};
1647   }
1648
1649   return $payment == $type  ? 'checked="checked"' : '';
1650 }
1651
1652 sub tag_ifPayments {
1653   my ($enabled, $types_by_name, $args) = @_;
1654
1655   my $type = $args;
1656   if ($type !~ /^\d+$/) {
1657     return '' unless exists $types_by_name->{$type};
1658     $type = $types_by_name->{$type};
1659   }
1660
1661   my @found = grep $_ == $type, @$enabled;
1662
1663   return scalar @found;
1664 }
1665
1666 sub update_quantities {
1667   my ($class, $req) = @_;
1668
1669   my $session = $req->session;
1670   my $cgi = $req->cgi;
1671   my $cfg = $req->cfg;
1672   my @cart = @{$session->{cart} || []};
1673   for my $index (0..$#cart) {
1674     my $new_quantity = $cgi->param("quantity_$index");
1675     if (defined $new_quantity) {
1676       if ($new_quantity =~ /^\s*(\d+)/) {
1677         $cart[$index]{units} = $1;
1678       }
1679       elsif ($new_quantity =~ /^\s*$/) {
1680         $cart[$index]{units} = 0;
1681       }
1682     }
1683   }
1684   @cart = grep { $_->{units} != 0 } @cart;
1685   $session->{cart} = \@cart;
1686   $session->{custom} ||= {};
1687   my %custom_state = %{$session->{custom}};
1688   custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1689   $session->{custom} = \%custom_state;
1690 }
1691
1692 sub _build_items {
1693   my ($class, $req, $products) = @_;
1694
1695   my $session = $req->session;
1696   $session->{cart}
1697     or return;
1698   my @msgs;
1699   my @cart = @{$req->session->{cart}}
1700     or return;
1701   my @items;
1702   my @prodcols = Product->columns;
1703   my @newcart;
1704   my $today = now_sqldate();
1705   for my $item (@cart) {
1706     my %work = %$item;
1707     my $product = Products->getByPkey($item->{productId});
1708     if ($product) {
1709       (my $comp_release = $product->{release}) =~ s/ .*//;
1710       (my $comp_expire = $product->{expire}) =~ s/ .*//;
1711       $comp_release le $today
1712         or do { push @msgs, "'$product->{title}' has not been released yet";
1713                 next; };
1714       $today le $comp_expire
1715         or do { push @msgs, "'$product->{title}' has expired"; next; };
1716       $product->{listed}
1717         or do { push @msgs, "'$product->{title}' not available"; next; };
1718
1719       for my $col (@prodcols) {
1720         $work{$col} = $product->$col() unless exists $work{$col};
1721       }
1722       $work{price} = $product->price(user => scalar $req->siteuser);
1723       $work{extended_retailPrice} = $work{units} * $work{price};
1724       $work{extended_gst} = $work{units} * $work{gst};
1725       $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1726
1727       push @newcart, \%work;
1728       push @$products, $product;
1729     }
1730   }
1731
1732   # we don't use these for anything for now
1733   #if (@msgs) {
1734   #  @$rmsg = @msgs;
1735   #}
1736
1737   return @newcart;
1738 }
1739
1740 sub _fillout_order {
1741   my ($class, $req, $values, $items, $products, $rmsg, $how) = @_;
1742
1743   my $session = $req->session;
1744   my $cfg = $req->cfg;
1745   my $cgi = $req->cgi;
1746
1747   my $total = 0;
1748   my $total_gst = 0;
1749   my $total_wholesale = 0;
1750   for my $item (@$items) {
1751     $total += $item->{extended_retailPrice};
1752     $total_gst += $item->{extended_gst};
1753     $total_wholesale += $item->{extended_wholesale};
1754   }
1755   $values->{total} = $total;
1756   $values->{gst} = $total_gst;
1757   $values->{wholesaleTotal} = $total_wholesale;
1758
1759   my $prompt_ship = $cfg->entry("shop", "shipping", 0);
1760   if ($prompt_ship) {
1761     if (_any_physical_products($products)) {
1762       my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
1763       my $country_code = bse_country_code($values->{delivCountry});
1764       if ($courier) {
1765         unless ($courier->can_deliver(country => $country_code,
1766                                       suburb => $values->{delivSuburb},
1767                                       postcode => $values->{delivPostCode})) {
1768           $cgi->param("courier", undef);
1769           $$rmsg =
1770             "Can't use the selected courier ".
1771               "(". $courier->description(). ") for this order.";
1772           return;
1773         }
1774         my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1775         my $cost = $courier->calculate_shipping
1776           (
1777            parcels => \@parcels,
1778            country => $country_code,
1779            suburb => $values->{delivSuburb},
1780            postcode => $values->{delivPostCode},
1781            products => $products,
1782            items => $items,
1783           );
1784         if (!defined $cost and $courier->name() ne 'contact') {
1785           my $err = $courier->error_message();
1786           $$rmsg = "Error calculating shipping cost";
1787           $$rmsg .= ": $err" if $err;
1788           return;
1789         }
1790         $values->{shipping_method} = $courier->description();
1791         $values->{shipping_name} = $courier->name;
1792         $values->{shipping_cost} = $cost;
1793         $values->{shipping_trace} = $courier->trace;
1794         #$values->{delivery_in} = $courier->delivery_in();
1795         $values->{total} += $values->{shipping_cost};
1796       }
1797       else {
1798         # XXX: What to do?
1799         $$rmsg = "Error: no usable courier found.";
1800         return;
1801       }
1802     }
1803     else {
1804       $values->{shipping_method} = "Nothing to ship!";
1805       $values->{shipping_name} = "none";
1806       $values->{shipping_cost} = 0;
1807       $values->{shipping_trace} = "All products have zero weight.";
1808     }
1809   }
1810
1811   my $cust_class = custom_class($cfg);
1812
1813   eval {
1814     local $SIG{__DIE__};
1815     my %custom = %{$session->{custom}};
1816     $cust_class->order_save($cgi, $values, $items, $items,
1817                             \%custom, $cfg);
1818     $session->{custom} = \%custom;
1819   };
1820   if ($@) {
1821     $$rmsg = $@;
1822     return;
1823   }
1824
1825   $values->{total} +=
1826     $cust_class->total_extras($items, $items,
1827                               $session->{custom}, $cfg, $how);
1828
1829   my $affiliate_code = $session->{affiliate_code};
1830   defined $affiliate_code && length $affiliate_code
1831     or $affiliate_code = $cgi->param('affiliate_code');
1832   defined $affiliate_code or $affiliate_code = '';
1833   $values->{affiliate_code} = $affiliate_code;
1834
1835   my $user = $req->siteuser;
1836   if ($user) {
1837     $values->{userId} = $user->{userId};
1838     $values->{siteuser_id} = $user->{id};
1839   }
1840   else {
1841     $values->{userId} = '';
1842     $values->{siteuser_id} = -1;
1843   }
1844
1845   $values->{orderDate} = now_sqldatetime;
1846
1847   # this should be hard to guess
1848   $values->{randomId} = md5_hex(time().rand().{}.$$);
1849
1850   return 1;
1851 }
1852
1853 sub action_prefix { '' }
1854
1855 sub req_location {
1856   my ($class, $req) = @_;
1857
1858   require BSE::TB::Locations;
1859   my $cgi = $req->cgi;
1860   my $location_id = $cgi->param('location_id');
1861   my $location;
1862   if (defined $location_id && $location_id =~ /^\d+$/) {
1863     $location = BSE::TB::Locations->getByPkey($location_id);
1864     my %acts;
1865     %acts =
1866       (
1867        BSE::Util::Tags->static(\%acts, $req->cfg),
1868        location => [ \&tag_hash, $location ],
1869       );
1870
1871     return $req->response('location', \%acts);
1872   }
1873   else {
1874     return
1875       {
1876        type=>BSE::Template->get_type($req->cfg, 'error'),
1877        content=>"Missing or invalid location_id",
1878       };
1879   }
1880 }
1881
1882 sub _validate_add_by_id {
1883   my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1884
1885   my $product;
1886   if ($addid) {
1887     $product = BSE::TB::Seminars->getByPkey($addid);
1888     $product ||= Products->getByPkey($addid);
1889   }
1890   unless ($product) {
1891     $$error = "Cannot find product $addid";
1892     return;
1893   }
1894
1895   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1896 }
1897
1898 sub _validate_add_by_code {
1899   my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
1900
1901   my $product;
1902   if (defined $code) {
1903     $product = BSE::TB::Seminars->getBy(product_code => $code);
1904     $product ||= Products->getBy(product_code => $code);
1905   }
1906   unless ($product) {
1907     $$error = "Cannot find product code $code";
1908     return;
1909   }
1910
1911   return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1912 }
1913
1914 sub _validate_add {
1915   my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
1916
1917   # collect the product options
1918   my @options;
1919   my @option_descs =  $product->option_descs($req->cfg);
1920   my @option_names = map $_->{name}, @option_descs;
1921   my @not_def;
1922   my $cgi = $req->cgi;
1923   for my $name (@option_names) {
1924     my $value = $cgi->param($name);
1925     push @options, $value;
1926     unless (defined $value) {
1927       push @not_def, $name;
1928     }
1929   }
1930   if (@not_def) {
1931     $$error = "Some product options (@not_def) not supplied";
1932     return;
1933   }
1934
1935   # the product must be non-expired and listed
1936   (my $comp_release = $product->{release}) =~ s/ .*//;
1937   (my $comp_expire = $product->{expire}) =~ s/ .*//;
1938   my $today = now_sqldate();
1939   unless ($comp_release le $today) {
1940     $$error = "Product $product->{title} has not been released yet";
1941     return;
1942   }
1943   unless ($today le $comp_expire) {
1944     $$error = "Product $product->{title} has expired";
1945     return;
1946   }
1947   unless ($product->{listed}) {
1948     $$error = "Product $product->{title} not available";
1949     return;
1950   }
1951
1952   # used to refresh if a logon is needed
1953   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1954   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
1955   for my $opt_index (0..$#option_names) {
1956     $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
1957   }
1958
1959   my $user = $req->siteuser;
1960   # need to be logged on if it has any subs
1961   if ($product->{subscription_id} != -1) {
1962     if ($user) {
1963       my $sub = $product->subscription;
1964       if ($product->is_renew_sub_only) {
1965         unless ($user->subscribed_to_grace($sub)) {
1966           $$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";
1967           return;
1968         }
1969       }
1970       elsif ($product->is_start_sub_only) {
1971         if ($user->subscribed_to_grace($sub)) {
1972           $$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";
1973           return;
1974         }
1975       }
1976     }
1977     else {
1978       $$refresh_logon =
1979         [  "You must be logged on to add this product to your cart",
1980            'prodlogon', $r ];
1981       return;
1982     }
1983   }
1984   if ($product->{subscription_required} != -1) {
1985     my $sub = $product->subscription_required;
1986     if ($user) {
1987       unless ($user->subscribed_to($sub)) {
1988         $$error = "You must be subscribed to $sub->{title} to purchase this product";
1989         return;
1990       }
1991     }
1992     else {
1993       # we want to refresh back to adding the item to the cart if possible
1994       $$refresh_logon =
1995         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
1996          'prodlogonsub', $r ];
1997       return;
1998     }
1999   }
2000
2001   # we need a natural integer quantity
2002   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
2003     $$error = "Invalid quantity";
2004     return;
2005   }
2006
2007   my %extras;
2008   if ($product->isa('BSE::TB::Seminar')) {
2009     # you must be logged on to add a seminar
2010     unless ($user) {
2011       $$refresh_logon =
2012         [ "You must be logged on to add seminars to your cart",
2013           'seminarlogon', $r ];
2014       return;
2015     }
2016
2017     # get and validate the session
2018     my $session_id = $cgi->param('session_id');
2019     unless (defined $session_id) {
2020       $$error = "Please select a session when adding a seminar";
2021       return;
2022     }
2023
2024     unless ($session_id =~ /^\d+$/) {
2025       $$error = "Invalid session_id supplied";
2026       return;
2027     }
2028
2029     require BSE::TB::SeminarSessions;
2030     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
2031     unless ($session) {
2032       $$error = "Unknown session id supplied";
2033       return;
2034     }
2035     unless ($session->{seminar_id} == $product->{id}) {
2036       $$error = "Session not for this seminar";
2037       return;
2038     }
2039
2040     # check if the user is already booked for this session
2041     if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
2042       $$error = "You are already booked for this session";
2043       return;
2044     }
2045
2046     $extras{session_id} = $session_id;
2047   }
2048
2049   return ( $product, \@options, \%extras );
2050 }
2051
2052 sub _add_refresh {
2053   my ($refresh, $req, $started_empty) = @_;
2054
2055   my $cfg = $req->cfg;
2056   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
2057   if ($started_empty && !$cookie_domain) {
2058     my $base_url = $cfg->entryVar('site', 'url');
2059     my $secure_url = $cfg->entryVar('site', 'secureurl');
2060     if ($base_url ne $secure_url) {
2061       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
2062
2063       # magical refresh time
2064       # which host are we on?
2065       # first get info about the 2 possible hosts
2066       my ($baseprot, $basehost, $baseport) =
2067         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2068       $baseport ||= $baseprot eq 'http' ? 80 : 443;
2069       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
2070         if $debug;
2071
2072       #my ($secprot, $sechost, $secport) =
2073       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
2074
2075       my $onbase = 1;
2076       # get info about the current host
2077       my $port = $ENV{SERVER_PORT} || 80;
2078       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
2079       print STDERR "\$ishttps: $ishttps\n" if $debug;
2080       my $protocol = $ishttps ? 'https' : 'http';
2081
2082       if (lc $ENV{SERVER_NAME} ne lc $basehost
2083           || lc $protocol ne $baseprot
2084           || $baseport != $port) {
2085         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
2086         $onbase = 0;
2087       }
2088       my $base = $onbase ? $secure_url : $base_url;
2089       my $finalbase = $onbase ? $base_url : $secure_url;
2090       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
2091       my $sessionid = $req->session->{_session_id};
2092       require BSE::SessionSign;
2093       my $sig = BSE::SessionSign->make($sessionid);
2094       my $url = $cfg->user_url("user", undef,
2095                                -base => $base,
2096                                setcookie => $sessionid,
2097                                s => $sig,
2098                                r => $refresh);
2099       print STDERR "Heading to $url to setcookie\n" if $debug;
2100       return $req->get_refresh($url);
2101     }
2102   }
2103
2104   return $req->get_refresh($refresh);
2105 }
2106
2107 sub _same_options {
2108   my ($left, $right) = @_;
2109
2110   for my $index (0 .. $#$left) {
2111     my $left_value = $left->[$index];
2112     my $right_value = $right->[$index];
2113     defined $right_value
2114       or return;
2115     $left_value eq $right_value
2116       or return;
2117   }
2118
2119   return 1;
2120 }
2121
2122 sub _paypal_order {
2123   my ($self, $req, $rmsg) = @_;
2124
2125   my $id = $req->cgi->param("order");
2126   unless ($id) {
2127     $$rmsg = $req->catmsg("msg:bse/shop/paypal/noorderid");
2128     return;
2129   }
2130   my ($order) = BSE::TB::Orders->getBy(randomId => $id);
2131   unless ($order) {
2132     $$rmsg = $req->catmsg("msg:bse/shop/paypal/unknownorderid");
2133     return;
2134   }
2135
2136   return $order;
2137 }
2138
2139 =item paypalret
2140
2141 Handles PayPal returning control.
2142
2143 Expects:
2144
2145 =over
2146
2147 =item *
2148
2149 order - the randomId of the order
2150
2151 =item *
2152
2153 token - paypal token we originally supplied to paypal.  Supplied by
2154 PayPal.
2155
2156 =item *
2157
2158 PayerID - the paypal user who paid the order.  Supplied by PayPal.
2159
2160 =back
2161
2162 =cut
2163
2164 sub req_paypalret {
2165   my ($self, $req) = @_;
2166
2167   require BSE::PayPal;
2168   BSE::PayPal->configured
2169       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2170
2171   my $msg;
2172   my $order = $self->_paypal_order($req, \$msg)
2173     or return $self->req_show_payment($req, { _ => $msg });
2174
2175   $order->complete
2176     and return $self->req_cart($req, { _ => "msg:bse/shop/paypal/alreadypaid" });
2177
2178   unless (BSE::PayPal->pay_order(req => $req,
2179                                  order => $order,
2180                                  msg => \$msg)) {
2181     return $self->req_show_payment($req, { _ => $msg });
2182   }
2183
2184   $self->_finish_order($req, $order);
2185
2186   return $req->get_refresh($req->user_url(shop => "orderdone"));
2187 }
2188
2189 sub req_paypalcan {
2190   my ($self, $req) = @_;
2191
2192   require BSE::PayPal;
2193   BSE::PayPal->configured
2194       or return $self->req_cart($req, { _ => "msg:bse/shop/paypal/unconfigured" });
2195
2196   my $msg;
2197   my $order = $self->_paypal_order($req, \$msg)
2198     or return $self->req_show_payment($req, { _ => $msg });
2199
2200   $req->flash("msg:bse/shop/paypal/cancelled");
2201
2202   my $url = $req->user_url(shop => "show_payment");
2203   return $req->get_refresh($url);
2204 }
2205
2206 sub _refresh_cart {
2207   my ($self, $req) = @_;
2208
2209   my $user = $req->siteuser
2210     or return;
2211
2212   my $cart = $req->session->{cart}
2213     or return;
2214
2215   for my $item (@$cart) {
2216     if (!$item->{user} || $item->{user} != $user->id) {
2217       my $product = Products->getByPkey($item->{productId})
2218         or next;
2219       my ($price, $tier) = $product->price(user => $user);
2220       $item->{price} = $price;
2221       $item->{tier} = $tier ? $tier->id : "";
2222     }
2223   }
2224
2225   $req->session->{cart} = $cart;
2226 }
2227
2228 1;