site/cgi-bin/modules/BSE/UI/Shop.pm

   1 package BSE::UI::Shop;
   2 use strict;
   3 use base 'BSE::UI::Dispatch';
   4 use DevHelp::HTML;
   5 use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
   6 use BSE::Shop::Util qw(need_logon shop_cart_tags payment_types nice_options
   7                        cart_item_opts basic_tags);
   8 use BSE::CfgInfo qw(custom_class credit_card_class);
   9 use BSE::TB::Orders;
  10 use BSE::TB::OrderItems;
  11 use BSE::Mail;
  12 use BSE::Util::Tags qw(tag_error_img tag_hash);
  13 use Products;
  14 use BSE::TB::Seminars;
  15 use DevHelp::Validate qw(dh_validate dh_validate_hash);
  16 use Digest::MD5 'md5_hex';
  17
  18 use constant PAYMENT_CC => 0;
  19 use constant PAYMENT_CHEQUE => 1;
  20 use constant PAYMENT_CALLME => 2;
  21
  22 my %actions =
  23   (
  24    add => 1,
  25    addmultiple => 1,
  26    cart => 1,
  27    checkout => 1,
  28    checkupdate => 1,
  29    recheckout => 1,
  30    confirm => 1,
  31    recalc=>1,
  32    recalculate => 1,
  33    #purchase => 1,
  34    order => 1,
  35    show_payment => 1,
  36    payment => 1,
  37    orderdone => 1,
  38    location => 1,
  39   );
  40
  41 my %field_map =
  42   (
  43    name1 => 'delivFirstName',
  44    name2 => 'delivLastName',
  45    address => 'delivStreet',
  46    organization => 'delivOrganization',
  47    city => 'delivSuburb',
  48    postcode => 'delivPostCode',
  49    state => 'delivState',
  50    country => 'delivCountry',
  51    email => 'emailAddress',
  52    cardHolder => 'ccName',
  53    cardType => 'ccType',
  54   );
  55
  56 my %rev_field_map = reverse %field_map;
  57
  58 sub actions { \%actions }
  59
  60 sub default_action { 'cart' }
  61
  62 sub other_action {
  63   my ($class, $cgi) = @_;
  64
  65   for my $key ($cgi->param()) {
  66     if ($key =~ /^delete_(\d+)(?:\.x)?$/) {
  67       return ( remove_item => $1 );
  68     }
  69     elsif ($key =~ /^(?:a_)?addsingle(\d+)(?:\.x)?$/) {
  70       return ( addsingle => $1 );
  71     }
  72   }
  73
  74   return;
  75 }
  76
  77 sub req_cart {
  78   my ($class, $req, $msg) = @_;
  79
  80   my @cart = @{$req->session->{cart} || []};
  81   my @cart_prods;
  82   my @items = $class->_build_items($req, \@cart_prods);
  83   my $item_index = -1;
  84   my @options;
  85   my $option_index;
  86
  87   $req->session->{custom} ||= {};
  88   my %custom_state = %{$req->session->{custom}};
  89
  90   my $cust_class = custom_class($req->cfg);
  91   $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $req->cfg);
  92   $msg = '' unless defined $msg;
  93   $msg = escape_html($msg);
  94
  95   my %acts;
  96   %acts =
  97     (
  98      $cust_class->cart_actions(\%acts, \@cart, \@cart_prods, \%custom_state,
  99                                $req->cfg),
 100      shop_cart_tags(\%acts, \@items, \@cart_prods, $req, 'cart'),
 101      basic_tags(\%acts),
 102      msg => $msg,
 103     );
 104   $req->session->{custom} = \%custom_state;
 105   $req->session->{order_info_confirmed} = 0;
 106
 107   # intended to ajax enable the shop cart with partial templates
 108   my $template = 'cart';
 109   my $embed = $req->cgi->param('embed');
 110   if (defined $embed and $embed =~ /^\w+$/) {
 111     $template = "include/cart_$embed";
 112   }
 113   return $req->response($template, \%acts);
 114 }
 115
 116 sub req_add {
 117   my ($class, $req) = @_;
 118
 119   my $cgi = $req->cgi;
 120
 121   my $addid = $cgi->param('id');
 122   $addid ||= '';
 123   my $quantity = $cgi->param('quantity');
 124   $quantity ||= 1;
 125
 126   my $error;
 127   my $refresh_logon;
 128   my ($product, $options, $extras)
 129     = $class->_validate_add($req, $addid, $quantity, \$error, \$refresh_logon);
 130   if ($refresh_logon) {
 131     return $class->_refresh_logon($req, @$refresh_logon);
 132   }
 133   elsif ($error) {
 134     return $class->req_cart($req, $error);
 135   }
 136
 137   $req->session->{cart} ||= [];
 138   my @cart = @{$req->session->{cart}};
 139   my $started_empty = @cart == 0;
 140
 141   my $found;
 142   for my $item (@cart) {
 143     $item->{productId} eq $addid && $item->{options} eq $options
 144       or next;
 145
 146     ++$found;
 147     $item->{units} += $quantity;
 148     last;
 149   }
 150   unless ($found) {
 151     push @cart,
 152       {
 153        productId => $addid,
 154        units => $quantity,
 155        price=>$product->{retailPrice},
 156        options=>$options,
 157        %$extras,
 158       };
 159   }
 160
 161   $req->session->{cart} = \@cart;
 162   $req->session->{order_info_confirmed} = 0;
 163
 164   my $refresh = $cgi->param('r');
 165   unless ($refresh) {
 166     $refresh = $ENV{SCRIPT_NAME};
 167   }
 168
 169   # speed for ajax
 170   if ($refresh eq 'ajaxcart') {
 171     return $class->req_cart($req);
 172   }
 173
 174   return _add_refresh($refresh, $req, $started_empty);
 175 }
 176
 177 sub req_addsingle {
 178   my ($class, $req, $addid) = @_;
 179
 180   my $cgi = $req->cgi;
 181
 182   $addid ||= '';
 183   my $quantity = $cgi->param("qty$addid");
 184   defined $quantity && $quantity =~ /\S/
 185     or $quantity = 1;
 186
 187   my $error;
 188   my $refresh_logon;
 189   my ($product, $options, $extras)
 190     = $class->_validate_add($req, $addid, $quantity, \$error, \$refresh_logon);
 191   if ($refresh_logon) {
 192     return $class->_refresh_logon($req, @$refresh_logon);
 193   }
 194   elsif ($error) {
 195     return $class->req_cart($req, $error);
 196   }
 197
 198   $req->session->{cart} ||= [];
 199   my @cart = @{$req->session->{cart}};
 200   my $started_empty = @cart == 0;
 201
 202   my $found;
 203   for my $item (@cart) {
 204     $item->{productId} eq $addid && $item->{options} eq $options
 205       or next;
 206
 207     ++$found;
 208     $item->{units} += $quantity;
 209     last;
 210   }
 211   unless ($found) {
 212     push @cart,
 213       {
 214        productId => $addid,
 215        units => $quantity,
 216        price=>$product->{retailPrice},
 217        options=>$options,
 218        %$extras,
 219       };
 220   }
 221
 222   $req->session->{cart} = \@cart;
 223   $req->session->{order_info_confirmed} = 0;
 224
 225   my $refresh = $cgi->param('r');
 226   unless ($refresh) {
 227     $refresh = $ENV{SCRIPT_NAME};
 228   }
 229
 230   # speed for ajax
 231   if ($refresh eq 'ajaxcart') {
 232     return $class->req_cart($req);
 233   }
 234
 235   return _add_refresh($refresh, $req, $started_empty);
 236 }
 237
 238 sub req_addmultiple {
 239   my ($class, $req) = @_;
 240
 241   my $cgi = $req->cgi;
 242   my @qty_keys = map /^qty(\d+)/, $cgi->param;
 243
 244   my @messages;
 245   my %additions;
 246   for my $addid (@qty_keys) {
 247     my $quantity = $cgi->param("qty$addid");
 248     defined $quantity && $quantity =~ /^\s*\d+\s*$/
 249       or next;
 250
 251     my $error;
 252     my $refresh_logon;
 253     my ($product, $options, $extras) =
 254       $class->_validate_add($req, $addid, $quantity, \$error, \$refresh_logon);
 255     if ($refresh_logon) {
 256       return $class->_refresh_logon($req, @$refresh_logon);
 257     }
 258     elsif ($error) {
 259       return $class->req_cart($req, $error);
 260     }
 261     if ($product->{options}) {
 262       push @messages, "$product->{title} has options, you need to use the product page to add this product";
 263       next;
 264     }
 265     $additions{$addid} =
 266       {
 267        id => $product->{id},
 268        product => $product,
 269        extras => $extras,
 270        quantity => $quantity,
 271       };
 272   }
 273
 274   my $started_empty = 0;
 275   if (keys %additions) {
 276     $req->session->{cart} ||= [];
 277     my @cart = @{$req->session->{cart}};
 278     $started_empty = @cart == 0;
 279     for my $item (@cart) {
 280       $item->{options} eq '' or next;
 281
 282       my $addition = delete $additions{$item->{productId}}
 283         or next;
 284
 285       $item->{units} += $addition->{quantity};
 286     }
 287     for my $addition (values %additions) {
 288       $addition->{quantity} > 0 or next;
 289       my $product = $addition->{product};
 290       push @cart,
 291         {
 292          productId => $product->{id},
 293          units => $addition->{quantity},
 294          price=>$product->{retailPrice},
 295          options=>'',
 296          %{$addition->{extras}},
 297         };
 298     }
 299
 300     $req->session->{cart} = \@cart;
 301     $req->session->{order_info_confirmed} = 0;
 302   }
 303
 304   my $refresh = $cgi->param('r');
 305   unless ($refresh) {
 306     $refresh = $ENV{SCRIPT_NAME};
 307   }
 308   if (@messages) {
 309     my $sep = $refresh =~ /\?/ ? '&' : '?';
 310
 311     for my $message (@messages) {
 312       $refresh .= $sep . "m=" . escape_uri($message);
 313       $sep = '&';
 314     }
 315   }
 316
 317   # speed for ajax
 318   if ($refresh eq 'ajaxcart') {
 319     return $class->req_cart($req);
 320   }
 321
 322   return _add_refresh($refresh, $req, $started_empty);
 323 }
 324
 325 sub req_checkout {
 326   my ($class, $req, $message, $olddata) = @_;
 327
 328   my $errors = {};
 329   if (defined $message) {
 330     if (ref $message) {
 331       $errors = $message;
 332       $message = $req->message($errors);
 333     }
 334   }
 335   else {
 336     $message = '';
 337   }
 338   my $cfg = $req->cfg;
 339   my $cgi = $req->cgi;
 340
 341   $class->update_quantities($req);
 342   my @cart = @{$req->session->{cart}};
 343
 344   @cart or return $class->req_cart($req);
 345
 346   my @cart_prods;
 347   my @items = $class->_build_items($req, \@cart_prods);
 348
 349   if (my ($msg, $id) = $class->_need_logon($req, \@cart, \@cart_prods)) {
 350     return $class->_refresh_logon($req, $msg, $id);
 351     return;
 352   }
 353
 354   my $user = $req->siteuser;
 355
 356   $req->session->{custom} ||= {};
 357   my %custom_state = %{$req->session->{custom}};
 358
 359   my $cust_class = custom_class($cfg);
 360   $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $cfg);
 361
 362   my $affiliate_code = $req->session->{affiliate_code};
 363   defined $affiliate_code or $affiliate_code = '';
 364
 365   my $order_info = $req->session->{order_info};
 366
 367   my $item_index = -1;
 368   my @options;
 369   my $option_index;
 370   my %acts;
 371   %acts =
 372     (
 373      shop_cart_tags(\%acts, \@items, \@cart_prods, $req, 'checkout'),
 374      basic_tags(\%acts),
 375      message => $message,
 376      msg => $message,
 377      old =>
 378      sub {
 379        my $value;
 380
 381        if ($olddata) {
 382          $value = $cgi->param($_[0]);
 383          unless (defined $value) {
 384            $value = $user->{$_[0]}
 385              if $user;
 386          }
 387        }
 388        elsif ($order_info && defined $order_info->{$_[0]}) {
 389          $value = $order_info->{$_[0]};
 390        }
 391        else {
 392          my $field = $_[0];
 393          $rev_field_map{$field} and $field = $rev_field_map{$field};
 394          $value = $user && defined $user->{$field} ? $user->{$field} : '';
 395        }
 396
 397        defined $value or $value = '';
 398        escape_html($value);
 399      },
 400      $cust_class->checkout_actions(\%acts, \@cart, \@cart_prods,
 401                                    \%custom_state, $req->cgi, $cfg),
 402      ifUser => defined $user,
 403      user => $user ? [ \&tag_hash, $user ] : '',
 404      affiliate_code => escape_html($affiliate_code),
 405      error_img => [ \&tag_error_img, $cfg, $errors ],
 406     );
 407   $req->session->{custom} = \%custom_state;
 408
 409   return $req->response('checkoutnew', \%acts);
 410 }
 411
 412 sub req_checkupdate {
 413   my ($class, $req) = @_;
 414
 415   $req->session->{cart} ||= [];
 416   my @cart = @{$req->session->{cart}};
 417   my @cart_prods = map { Products->getByPkey($_->{productId}) } @cart;
 418   $req->session->{custom} ||= {};
 419   my %custom_state = %{$req->session->{custom}};
 420   custom_class($req->cfg)
 421       ->checkout_update($req->cgi, \@cart, \@cart_prods, \%custom_state, $req->cfg);
 422   $req->session->{custom} = \%custom_state;
 423   $req->session->{order_info_confirmed} = 0;
 424
 425   return $class->req_checkout($req, "", 1);
 426 }
 427
 428 sub req_remove_item {
 429   my ($class, $req, $index) = @_;
 430
 431   $req->session->{cart} ||= [];
 432   my @cart = @{$req->session->{cart}};
 433   if ($index >= 0 && $index < @cart) {
 434     splice(@cart, $index, 1);
 435   }
 436   $req->session->{cart} = \@cart;
 437   $req->session->{order_info_confirmed} = 0;
 438
 439   return BSE::Template->get_refresh($ENV{SCRIPT_NAME}, $req->cfg);
 440 }
 441
 442
 443 # saves order and refresh to payment page
 444 sub req_order {
 445   my ($class, $req) = @_;
 446
 447   my $cfg = $req->cfg;
 448   my $cgi = $req->cgi;
 449
 450   $req->session->{cart} && @{$req->session->{cart}}
 451     or return $class->req_cart($req, "Your cart is empty");
 452
 453   my $msg;
 454   $class->_validate_cfg($req, \$msg)
 455     or return $class->req_cart($req, $msg);
 456
 457   my @products;
 458   my @items = $class->_build_items($req, \@products);
 459
 460   my $id;
 461   if (($msg, $id) = $class->_need_logon($req, \@items, \@products)) {
 462     return $class->_refresh_logon($req, $msg, $id);
 463   }
 464
 465   # some basic validation, in case the user switched off javascript
 466   my $cust_class = custom_class($cfg);
 467
 468   my %fields = BSE::TB::Order->valid_fields($cfg);
 469   my %rules = BSE::TB::Order->valid_rules($cfg);
 470
 471   my %errors;
 472   my %values;
 473   for my $name (keys %fields) {
 474     ($values{$name}) = $cgi->param($name);
 475   }
 476
 477   my @required =
 478     $cust_class->required_fields($cgi, $req->session->{custom}, $cfg);
 479
 480   for my $name (@required) {
 481     $field_map{$name} and $name = $field_map{$name};
 482
 483     $fields{$name}{required} = 1;
 484   }
 485
 486   dh_validate_hash(\%values, \%errors, { rules=>\%rules, fields=>\%fields },
 487                    $cfg, 'Shop Order Validation');
 488   keys %errors
 489     and return $class->req_checkout($req, \%errors, 1);
 490
 491   $class->_fillout_order($req, \%values, \@items, \$msg, 'payment')
 492     or return $class->req_checkout($req, $msg, 1);
 493
 494   $req->session->{order_info} = \%values;
 495   $req->session->{order_info_confirmed} = 1;
 496
 497   # skip payment page if nothing to pay
 498   if ($values{total} == 0) {
 499     return $class->req_payment($req);
 500   }
 501   else {
 502     return BSE::Template->get_refresh("$ENV{SCRIPT_NAME}?a_show_payment=1", $req->cfg);
 503   }
 504 }
 505
 506 sub req_show_payment {
 507   my ($class, $req, $errors) = @_;
 508
 509   $req->session->{order_info_confirmed}
 510     or return $class->req_checkout($req, 'Please proceed via the checkout page');
 511
 512   $req->session->{cart} && @{$req->session->{cart}}
 513     or return $class->req_cart($req, "Your cart is empty");
 514
 515   my $cfg = $req->cfg;
 516   my $cgi = $req->cgi;
 517
 518   $errors ||= {};
 519   my $msg = $req->message($errors);
 520
 521   my $order_values = $req->session->{order_info}
 522     or return $class->req_checkout($req, "You need to enter order information first");
 523
 524   my @pay_types = payment_types($cfg);
 525   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
 526   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
 527   @payment_types or @payment_types = ( PAYMENT_CALLME );
 528   @payment_types = sort { $a <=> $b } @payment_types;
 529   my %payment_types = map { $_=> 1 } @payment_types;
 530   my $payment;
 531   $errors and $payment = $cgi->param('paymentType');
 532   defined $payment or $payment = $payment_types[0];
 533
 534   my @products;
 535   my @items = $class->_build_items($req, \@products);
 536
 537   my %acts;
 538   %acts =
 539     (
 540      basic_tags(\%acts),
 541      message => $msg,
 542      msg => $msg,
 543      order => [ \&tag_hash, $order_values ],
 544      shop_cart_tags(\%acts, \@items, \@products, $req, 'payment'),
 545      ifMultPaymentTypes => @payment_types > 1,
 546      checkedPayment => [ \&tag_checkedPayment, $payment, \%types_by_name ],
 547      ifPayments => [ \&tag_ifPayments, \@payment_types, \%types_by_name ],
 548      error_img => [ \&tag_error_img, $cfg, $errors ],
 549      total => $order_values->{total},
 550     );
 551   for my $type (@pay_types) {
 552     my $id = $type->{id};
 553     my $name = $type->{name};
 554     $acts{"if${name}Payments"} = exists $payment_types{$id};
 555     $acts{"if${name}FirstPayment"} = $payment_types[0] == $id;
 556     $acts{"checkedIfFirst$name"} = $payment_types[0] == $id ? "checked " : "";
 557     $acts{"checkedPayment$name"} = $payment == $id ? 'checked="checked" ' : "";
 558   }
 559
 560   return $req->response('checkoutpay', \%acts);
 561 }
 562
 563 my %nostore =
 564   (
 565    cardNumber => 1,
 566    cardExpiry => 1,
 567   );
 568
 569 sub req_payment {
 570   my ($class, $req, $errors) = @_;
 571
 572   $req->session->{order_info_confirmed}
 573     or return $class->req_checkout($req, 'Please proceed via the checkout page');
 574
 575   my $order_values = $req->session->{order_info}
 576     or return $class->req_checkout($req, "You need to enter order information first");
 577
 578   my $cgi = $req->cgi;
 579   my $cfg = $req->cfg;
 580   my $session = $req->session;
 581
 582   my $paymentType;
 583   if ($order_values->{total} != 0) {
 584     my @pay_types = payment_types($cfg);
 585     my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
 586     my %pay_types = map { $_->{id} => $_ } @pay_types;
 587     my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
 588     @payment_types or @payment_types = ( PAYMENT_CALLME );
 589     @payment_types = sort { $a <=> $b } @payment_types;
 590     my %payment_types = map { $_=> 1 } @payment_types;
 591
 592     $paymentType = $cgi->param('paymentType');
 593     defined $paymentType or $paymentType = $payment_types[0];
 594     $payment_types{$paymentType}
 595       or return $class->req_show_payment($req, { paymentType => "Invalid payment type" } , 1);
 596
 597     my @required;
 598     push @required, @{$pay_types{$paymentType}{require}};
 599
 600     my %fields = BSE::TB::Order->valid_payment_fields($cfg);
 601     my %rules = BSE::TB::Order->valid_payment_rules($cfg);
 602     for my $field (@required) {
 603       if (exists $fields{$field}) {
 604         $fields{$field}{required} = 1;
 605       }
 606       else {
 607         $fields{$field} = { description => $field, required=> 1 };
 608       }
 609     }
 610
 611     my %errors;
 612     dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
 613                 $cfg, 'Shop Order Validation');
 614     keys %errors
 615       and return $class->req_show_payment($req, \%errors);
 616
 617     for my $field (keys %fields) {
 618       unless ($nostore{$field}) {
 619         my $target = $field_map{$field} || $field;
 620         ($order_values->{$target}) = $cgi->param($field);
 621       }
 622     }
 623
 624   }
 625   else {
 626     $paymentType = -1;
 627   }
 628
 629   $order_values->{paymentType} = $paymentType;
 630
 631   $order_values->{filled} = 0;
 632   $order_values->{paidFor} = 0;
 633
 634   my @products;
 635   my @items = $class->_build_items($req, \@products);
 636
 637   my @columns = BSE::TB::Order->columns;
 638   my %columns;
 639   @columns{@columns} = @columns;
 640
 641   for my $col (@columns) {
 642     defined $order_values->{$col} or $order_values->{$col} = '';
 643   }
 644
 645   my @data = @{$order_values}{@columns};
 646   shift @data;
 647
 648   my $order;
 649   if ($session->{order_work}) {
 650     $order = BSE::TB::Orders->getByPkey($session->{order_work});
 651   }
 652   if ($order && !$order->{complete}) {
 653     print STDERR "Recycling order $order->{id}\n";
 654
 655     my @allbutid = @columns;
 656     shift @allbutid;
 657     @{$order}{@allbutid} = @data;
 658
 659     $order->clear_items;
 660     delete $session->{order_work};
 661     eval {
 662       tied(%$session)->save;
 663     };
 664   }
 665   else {
 666     $order = BSE::TB::Orders->add(@data)
 667       or die "Cannot add order";
 668   }
 669
 670   my @dbitems;
 671   my %subscribing_to;
 672   my @item_cols = BSE::TB::OrderItem->columns;
 673   for my $row_num (0..$#items) {
 674     my $item = $items[$row_num];
 675     my $product = $products[$row_num];
 676     $item->{orderId} = $order->{id};
 677     $item->{max_lapsed} = 0;
 678     if ($product->{subscription_id} != -1) {
 679       my $sub = $product->subscription;
 680       $item->{max_lapsed} = $sub->{max_lapsed} if $sub;
 681     }
 682     defined $item->{session_id} or $item->{session_id} = 0;
 683     my @data = @{$item}{@item_cols};
 684
 685     shift @data;
 686     push(@dbitems, BSE::TB::OrderItems->add(@data));
 687
 688     my $sub = $product->subscription;
 689     if ($sub) {
 690       $subscribing_to{$sub->{text_id}} = $sub;
 691     }
 692
 693     if ($item->{session_id}) {
 694       my $user = $req->siteuser;
 695       require BSE::TB::SeminarSessions;
 696       my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
 697       eval {
 698         $session->add_attendee($user,
 699                                instructions => $order->{instructions},
 700                                options => $item->{options});
 701       };
 702     }
 703   }
 704
 705   $order->{ccOnline} = 0;
 706
 707   my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
 708   if ($paymentType == PAYMENT_CC) {
 709     my $ccNumber = $cgi->param('cardNumber');
 710     my $ccExpiry = $cgi->param('cardExpiry');
 711
 712     if ($ccprocessor) {
 713       my $cc_class = credit_card_class($cfg);
 714
 715       $order->{ccOnline} = 1;
 716
 717       $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
 718       my ($month, $year) = ($1, $2);
 719       $year > 2000 or $year += 2000;
 720       my $expiry = sprintf("%04d%02d", $year, $month);
 721       my $verify = $cgi->param('cardVerify');
 722       defined $verify or $verify = '';
 723       my $result = $cc_class->payment(orderno=>$order->{id},
 724                                       amount => $order->{total},
 725                                       cardnumber => $ccNumber,
 726                                       expirydate => $expiry,
 727                                       cvv => $verify,
 728                                       ipaddress => $ENV{REMOTE_ADDR});
 729       unless ($result->{success}) {
 730         use Data::Dumper;
 731         print STDERR Dumper($result);
 732         # failed, back to payments
 733         $order->{ccSuccess}     = 0;
 734         $order->{ccStatus}      = $result->{statuscode};
 735         $order->{ccStatus2}     = 0;
 736         $order->{ccStatusText}  = $result->{error};
 737         $order->{ccTranId}      = '';
 738         $order->save;
 739         my %errors;
 740         $errors{cardNumber} = $result->{error};
 741         $session->{order_work} = $order->{id};
 742         return $class->req_show_payment($req, \%errors);
 743       }
 744
 745       $order->{ccSuccess}           = 1;
 746       $order->{ccReceipt}           = $result->{receipt};
 747       $order->{ccStatus}            = 0;
 748       $order->{ccStatus2}           = 0;
 749       $order->{ccStatusText}  = '';
 750       $order->{ccTranId}            = $result->{transactionid};
 751       defined $order->{ccTranId} or $order->{ccTranId} = '';
 752       $order->{paidFor}     = 1;
 753     }
 754     else {
 755       $ccNumber =~ tr/0-9//cd;
 756       $order->{ccNumberHash} = md5_hex($ccNumber);
 757       $order->{ccExpiryHash} = md5_hex($ccExpiry);
 758     }
 759   }
 760
 761   # order complete
 762   $order->{complete} = 1;
 763   $order->save;
 764
 765   # set the order displayed by orderdone
 766   $session->{order_completed} = $order->{id};
 767   $session->{order_completed_at} = time;
 768
 769   my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
 770   $class->_send_order($req, $order, \@dbitems, \@products, $noencrypt,
 771                       \%subscribing_to);
 772
 773   # empty the cart ready for the next order
 774   delete @{$session}{qw/order_info order_info_confirmed cart order_work/};
 775
 776   return BSE::Template->get_refresh("$ENV{SCRIPT_NAME}?a_orderdone=1", $req->cfg);
 777 }
 778
 779 sub req_orderdone {
 780   my ($class, $req) = @_;
 781
 782   my $session = $req->session;
 783   my $cfg = $req->cfg;
 784
 785   my $id = $session->{order_completed};
 786   my $when = $session->{order_completed_at};
 787   $id && defined $when && time < $when + 500
 788     or return $class->req_cart($req);
 789
 790   my $order = BSE::TB::Orders->getByPkey($id)
 791     or return $class->req_cart($req);
 792   my @items = $order->items;
 793   my @products = map { Products->getByPkey($_->{productId}) } @items;
 794
 795   my @item_cols = BSE::TB::OrderItem->columns;
 796   my %copy_cols = map { $_ => 1 } Product->columns;
 797   delete @copy_cols{@item_cols};
 798   my @copy_cols = keys %copy_cols;
 799   my @showitems;
 800   for my $item_index (0..$#items) {
 801     my $item = $items[$item_index];
 802     my $product = $products[$item_index];
 803     my %entry;
 804     @entry{@item_cols} = @{$item}{@item_cols};
 805     @entry{@copy_cols} = @{$product}{@copy_cols};
 806
 807     push @showitems, \%entry;
 808   }
 809
 810   my $cust_class = custom_class($req->cfg);
 811
 812   my @pay_types = payment_types($cfg);
 813   my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
 814   my %pay_types = map { $_->{id} => $_ } @pay_types;
 815   my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
 816
 817   my $item_index = -1;
 818   my @options;
 819   my $option_index;
 820   my $item;
 821   my $product;
 822   my $sem_session;
 823   my $location;
 824   my %acts;
 825   %acts =
 826     (
 827      $req->dyn_user_tags(),
 828      $cust_class->purchase_actions(\%acts, \@items, \@products,
 829                                    $session->{custom}, $cfg),
 830      BSE::Util::Tags->static(\%acts, $cfg),
 831      iterate_items_reset => sub { $item_index = -1; },
 832      iterate_items =>
 833      sub {
 834        if (++$item_index < @items) {
 835          $option_index = -1;
 836          @options = cart_item_opts($req,
 837                                    $items[$item_index],
 838                                    $products[$item_index]);
 839          undef $sem_session;
 840          undef $location;
 841          $item = $items[$item_index];
 842          $product = $products[$item_index];
 843          return 1;
 844        }
 845        undef $item;
 846        undef $sem_session;
 847        undef $product;
 848        undef $location;
 849        return 0;
 850      },
 851      item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
 852      product =>
 853      sub {
 854        my $value = $products[$item_index]{$_[0]};
 855        defined $value or $value = '';
 856
 857        escape_html($value);
 858      },
 859      extended =>
 860      sub {
 861        my $what = $_[0] || 'retailPrice';
 862        $items[$item_index]{units} * $items[$item_index]{$what};
 863      },
 864      order => sub { escape_html($order->{$_[0]}) },
 865      _format =>
 866      sub {
 867        my ($value, $fmt) = @_;
 868        if ($fmt =~ /^m(\d+)/) {
 869          return sprintf("%$1s", sprintf("%.2f", $value/100));
 870        }
 871        elsif ($fmt =~ /%/) {
 872          return sprintf($fmt, $value);
 873        }
 874      },
 875      iterate_options_reset => sub { $option_index = -1 },
 876      iterate_options => sub { ++$option_index < @options },
 877      option => sub { escape_html($options[$option_index]{$_[0]}) },
 878      ifOptions => sub { @options },
 879      options => sub { nice_options(@options) },
 880      ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
 881      #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
 882      session => [ \&tag_session, \$item, \$sem_session ],
 883      location => [ \&tag_location, \$item, \$location ],
 884      msg => '',
 885     );
 886   for my $type (@pay_types) {
 887     my $id = $type->{id};
 888     my $name = $type->{name};
 889     $acts{"if${name}Payment"} = $order->{paymentType} == $id;
 890   }
 891
 892   return $req->response('checkoutfinal', \%acts);
 893 }
 894
 895 sub tag_session {
 896   my ($ritem, $rsession, $arg) = @_;
 897
 898   $$ritem or return '';
 899
 900   $$ritem->{session_id} or return '';
 901
 902   unless ($$rsession) {
 903     require BSE::TB::SeminarSessions;
 904     $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
 905       or return '';
 906   }
 907
 908   my $value = $$rsession->{$arg};
 909   defined $value or return '';
 910
 911   escape_html($value);
 912 }
 913
 914 sub tag_location {
 915   my ($ritem, $rlocation, $arg) = @_;
 916
 917   $$ritem or return '';
 918
 919   $$ritem->{session_id} or return '';
 920
 921   unless ($$rlocation) {
 922     require BSE::TB::Locations;
 923     ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
 924       or return '';
 925   }
 926
 927   my $value = $$rlocation->{$arg};
 928   defined $value or return '';
 929
 930   escape_html($value);
 931 }
 932
 933 sub tag_ifPayment {
 934   my ($payment, $types_by_name, $args) = @_;
 935
 936   my $type = $args;
 937   if ($type !~ /^\d+$/) {
 938     return '' unless exists $types_by_name->{$type};
 939     $type = $types_by_name->{$type};
 940   }
 941
 942   return $payment == $type;
 943 }
 944
 945
 946 sub _validate_cfg {
 947   my ($class, $req, $rmsg) = @_;
 948
 949   my $cfg = $req->cfg;
 950   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
 951   unless ($from && $from =~ /.\@./) {
 952     $$rmsg = "Configuration error: shop from address not set";
 953     return;
 954   }
 955   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
 956   unless ($toEmail && $toEmail =~ /.\@./) {
 957     $$rmsg = "Configuration error: shop to_email address not set";
 958     return;
 959   }
 960
 961   return 1;
 962 }
 963
 964 sub req_recalc {
 965   my ($class, $req) = @_;
 966
 967   $class->update_quantities($req);
 968   $req->session->{order_info_confirmed} = 0;
 969   return $class->req_cart($req);
 970 }
 971
 972 sub req_recalculate {
 973   my ($class, $req) = @_;
 974
 975   return $class->req_recalc($req);
 976 }
 977
 978 sub _send_order {
 979   my ($class, $req, $order, $items, $products, $noencrypt,
 980       $subscribing_to) = @_;
 981
 982   my $cfg = $req->cfg;
 983   my $cgi = $req->cgi;
 984
 985   my $crypto_class = $cfg->entry('shop', 'crypt_module',
 986                                  $Constants::SHOP_CRYPTO);
 987   my $signing_id = $cfg->entry('shop', 'crypt_signing_id',
 988                                $Constants::SHOP_SIGNING_ID);
 989   my $pgp = $cfg->entry('shop', 'crypt_pgp', $Constants::SHOP_PGP);
 990   my $pgpe = $cfg->entry('shop', 'crypt_pgpe', $Constants::SHOP_PGPE);
 991   my $gpg = $cfg->entry('shop', 'crypt_gpg', $Constants::SHOP_GPG);
 992   my $passphrase = $cfg->entry('shop', 'crypt_passphrase',
 993                                $Constants::SHOP_PASSPHRASE);
 994   my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
 995   my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
 996   my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
 997   my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
 998
 999   my $session = $req->session;
1000   my %extras = $cfg->entriesCS('extra tags');
1001   for my $key (keys %extras) {
1002     # follow any links
1003     my $data = $cfg->entryVar('extra tags', $key);
1004     $extras{$key} = sub { $data };
1005   }
1006
1007   my $item_index = -1;
1008   my @options;
1009   my $option_index;
1010   my %acts;
1011   %acts =
1012     (
1013      %extras,
1014      custom_class($cfg)
1015      ->order_mail_actions(\%acts, $order, $items, $products,
1016                           $session->{custom}, $cfg),
1017      BSE::Util::Tags->static(\%acts, $cfg),
1018      iterate_items_reset => sub { $item_index = -1; },
1019      iterate_items =>
1020      sub {
1021        if (++$item_index < @$items) {
1022          $option_index = -1;
1023          @options = cart_item_opts($req,
1024                                    $items->[$item_index],
1025                                    $products->[$item_index]);
1026          return 1;
1027        }
1028        return 0;
1029      },
1030      item=> sub { $items->[$item_index]{$_[0]}; },
1031      product =>
1032      sub {
1033        my $value = $products->[$item_index]{$_[0]};
1034        defined($value) or $value = '';
1035        $value;
1036      },
1037      order => sub { $order->{$_[0]} },
1038      extended =>
1039      sub {
1040        $items->[$item_index]{units} * $items->[$item_index]{$_[0]};
1041      },
1042      _format =>
1043      sub {
1044        my ($value, $fmt) = @_;
1045        if ($fmt =~ /^m(\d+)/) {
1046          return sprintf("%$1s", sprintf("%.2f", $value/100));
1047        }
1048        elsif ($fmt =~ /%/) {
1049          return sprintf($fmt, $value);
1050        }
1051        elsif ($fmt =~ /^\d+$/) {
1052          return substr($value . (" " x $fmt), 0, $fmt);
1053        }
1054        else {
1055          return $value;
1056        }
1057      },
1058      iterate_options_reset => sub { $option_index = -1 },
1059      iterate_options => sub { ++$option_index < @options },
1060      option => sub { escape_html($options[$option_index]{$_[0]}) },
1061      ifOptions => sub { @options },
1062      options => sub { nice_options(@options) },
1063      with_wrap => \&tag_with_wrap,
1064      ifSubscribingTo => [ \&tag_ifSubscribingTo, $subscribing_to ],
1065     );
1066
1067   my $mailer = BSE::Mail->new(cfg=>$cfg);
1068   # ok, send some email
1069   my $confirm = BSE::Template->get_page('mailconfirm', $cfg, \%acts);
1070   my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
1071   if ($email_order) {
1072     unless ($noencrypt) {
1073       $acts{cardNumber} = $cgi->param('cardNumber');
1074       $acts{cardExpiry} = $cgi->param('cardExpiry');
1075       $acts{cardVerify} = $cgi->param('cardVerify');
1076     }
1077     my $ordertext = BSE::Template->get_page('mailorder', $cfg, \%acts);
1078
1079     my $send_text;
1080     if ($noencrypt) {
1081       $send_text = $ordertext;
1082     }
1083     else {
1084       eval "use $crypto_class";
1085       !$@ or die $@;
1086       my $encrypter = $crypto_class->new;
1087
1088       my $debug = $cfg->entryBool('debug', 'mail_encryption', 0);
1089       my $sign = $cfg->entryBool('basic', 'sign', 1);
1090
1091       # encrypt and sign
1092       my %opts =
1093         (
1094          sign=> $sign,
1095          passphrase=> $passphrase,
1096          stripwarn=>1,
1097          fastcgi => $req->is_fastcgi,
1098          debug=>$debug,
1099         );
1100
1101       $opts{secretkeyid} = $signing_id if $signing_id;
1102       $opts{pgp} = $pgp if $pgp;
1103       $opts{gpg} = $gpg if $gpg;
1104       $opts{pgpe} = $pgpe if $pgpe;
1105       my $recip = "$toName <$toEmail>";
1106
1107       unless ($send_text = $encrypter->encrypt($recip, $ordertext, %opts )) {
1108         print STDERR "Cannot encrypt email: ", $encrypter->error;
1109         exit 1;
1110       }
1111     }
1112     $mailer->send(to=>$toEmail, from=>$from, subject=>'New Order '.$order->{id},
1113                   body=>$send_text)
1114       or print STDERR "Error sending order to admin: ",$mailer->errstr,"\n";
1115   }
1116   $mailer->send(to=>$order->{emailAddress}, from=>$from,
1117                 subject=>$subject . " " . localtime,
1118                 body=>$confirm)
1119     or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1120 }
1121
1122 sub tag_with_wrap {
1123   my ($args, $text) = @_;
1124
1125   my $margin = $args =~ /^\d+$/ && $args > 30 ? $args : 70;
1126
1127   require Text::Wrap;
1128   # do it twice to prevent a warning
1129   $Text::Wrap::columns = $margin;
1130   $Text::Wrap::columns = $margin;
1131
1132   return Text::Wrap::fill('', '', split /\n/, $text);
1133 }
1134
1135 sub _refresh_logon {
1136   my ($class, $req, $msg, $msgid, $r) = @_;
1137
1138   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1139   my $url = $securlbase."/cgi-bin/user.pl";
1140
1141   $r ||= $securlbase."/cgi-bin/shop.pl?checkout=1";
1142
1143   my %parms;
1144   $parms{r} = $r;
1145   $parms{message} = $msg if $msg;
1146   $parms{mid} = $msgid if $msgid;
1147   $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1148
1149   return BSE::Template->get_refresh($url, $req->cfg);
1150 }
1151
1152 sub _need_logon {
1153   my ($class, $req, $cart, $cart_prods) = @_;
1154
1155   return need_logon($req->cfg, $cart, $cart_prods, $req->session, $req->cgi);
1156 }
1157
1158 sub tag_checkedPayment {
1159   my ($payment, $types_by_name, $args) = @_;
1160
1161   my $type = $args;
1162   if ($type !~ /^\d+$/) {
1163     return '' unless exists $types_by_name->{$type};
1164     $type = $types_by_name->{$type};
1165   }
1166
1167   return $payment == $type  ? 'checked="checked"' : '';
1168 }
1169
1170 sub tag_ifPayments {
1171   my ($enabled, $types_by_name, $args) = @_;
1172
1173   my $type = $args;
1174   if ($type !~ /^\d+$/) {
1175     return '' unless exists $types_by_name->{$type};
1176     $type = $types_by_name->{$type};
1177   }
1178
1179   my @found = grep $_ == $type, @$enabled;
1180
1181   return scalar @found;
1182 }
1183
1184 sub update_quantities {
1185   my ($class, $req) = @_;
1186
1187   my $session = $req->session;
1188   my $cgi = $req->cgi;
1189   my $cfg = $req->cfg;
1190   my @cart = @{$session->{cart} || []};
1191   for my $index (0..$#cart) {
1192     my $new_quantity = $cgi->param("quantity_$index");
1193     if (defined $new_quantity) {
1194       if ($new_quantity =~ /^\s*(\d+)/) {
1195         $cart[$index]{units} = $1;
1196       }
1197       elsif ($new_quantity =~ /^\s*$/) {
1198         $cart[$index]{units} = 0;
1199       }
1200     }
1201   }
1202   @cart = grep { $_->{units} != 0 } @cart;
1203   $session->{cart} = \@cart;
1204   $session->{custom} ||= {};
1205   my %custom_state = %{$session->{custom}};
1206   custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1207   $session->{custom} = \%custom_state;
1208 }
1209
1210 sub _build_items {
1211   my ($class, $req, $products) = @_;
1212
1213   my $session = $req->session;
1214   $session->{cart}
1215     or return;
1216   my @msgs;
1217   my @cart = @{$req->session->{cart}}
1218     or return;
1219   my @items;
1220   my @prodcols = Product->columns;
1221   my @newcart;
1222   my $today = now_sqldate();
1223   for my $item (@cart) {
1224     my %work = %$item;
1225     my $product = Products->getByPkey($item->{productId});
1226     if ($product) {
1227       (my $comp_release = $product->{release}) =~ s/ .*//;
1228       (my $comp_expire = $product->{expire}) =~ s/ .*//;
1229       $comp_release le $today
1230         or do { push @msgs, "'$product->{title}' has not been released yet";
1231                 next; };
1232       $today le $comp_expire
1233         or do { push @msgs, "'$product->{title}' has expired"; next; };
1234       $product->{listed}
1235         or do { push @msgs, "'$product->{title}' not available"; next; };
1236
1237       for my $col (@prodcols) {
1238         $work{$col} = $product->{$col} unless exists $work{$col};
1239       }
1240       $work{extended_retailPrice} = $work{units} * $work{retailPrice};
1241       $work{extended_gst} = $work{units} * $work{gst};
1242       $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1243
1244       push @newcart, \%work;
1245       push @$products, $product;
1246     }
1247   }
1248
1249   # we don't use these for anything for now
1250   #if (@msgs) {
1251   #  @$rmsg = @msgs;
1252   #}
1253
1254   return @newcart;
1255 }
1256
1257 sub _fillout_order {
1258   my ($class, $req, $values, $items, $rmsg, $how) = @_;
1259
1260   my $session = $req->session;
1261   my $cfg = $req->cfg;
1262   my $cgi = $req->cgi;
1263
1264   my $total = 0;
1265   my $total_gst = 0;
1266   my $total_wholesale = 0;
1267   for my $item (@$items) {
1268     $total += $item->{extended_retailPrice};
1269     $total_gst += $item->{extended_gst};
1270     $total_wholesale += $item->{extended_wholesale};
1271   }
1272   $values->{total} = $total;
1273   $values->{gst} = $total_gst;
1274   $values->{wholesale} = $total_wholesale;
1275   $values->{shipping_cost} = 0;
1276
1277   my $cust_class = custom_class($cfg);
1278
1279   # if it sets shipping cost it must also update the total
1280   eval {
1281     local $SIG{__DIE__};
1282     my %custom = %{$session->{custom}};
1283     $cust_class->order_save($cgi, $values, $items, $items,
1284                             \%custom, $cfg);
1285     $session->{custom} = \%custom;
1286   };
1287   if ($@) {
1288     $$rmsg = $@;
1289     return;
1290   }
1291
1292   $values->{total} +=
1293     $cust_class->total_extras($items, $items,
1294                               $session->{custom}, $cfg, $how);
1295
1296   my $affiliate_code = $session->{affiliate_code};
1297   defined $affiliate_code && length $affiliate_code
1298     or $affiliate_code = $cgi->param('affiliate_code');
1299   defined $affiliate_code or $affiliate_code = '';
1300   $values->{affiliate_code} = $affiliate_code;
1301
1302   my $user = $req->siteuser;
1303   if ($user) {
1304     $values->{userId} = $user->{userId};
1305     $values->{siteuser_id} = $user->{id};
1306   }
1307   else {
1308     $values->{userId} = '';
1309     $values->{siteuser_id} = -1;
1310   }
1311
1312   $values->{orderDate} = now_sqldatetime;
1313
1314   # this should be hard to guess
1315   $values->{randomId} ||= md5_hex(time().rand().{}.$$);
1316
1317   return 1;
1318 }
1319
1320 sub action_prefix { '' }
1321
1322 sub req_location {
1323   my ($class, $req) = @_;
1324
1325   require BSE::TB::Locations;
1326   my $cgi = $req->cgi;
1327   my $location_id = $cgi->param('location_id');
1328   my $location;
1329   if (defined $location_id && $location_id =~ /^\d+$/) {
1330     $location = BSE::TB::Locations->getByPkey($location_id);
1331     my %acts;
1332     %acts =
1333       (
1334        BSE::Util::Tags->static(\%acts, $req->cfg),
1335        location => [ \&tag_hash, $location ],
1336       );
1337
1338     return $req->response('location', \%acts);
1339   }
1340   else {
1341     return
1342       {
1343        type=>BSE::Template->get_type($req->cfg, 'error'),
1344        content=>"Missing or invalid location_id",
1345       };
1346   }
1347 }
1348
1349 sub _validate_add {
1350   my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1351
1352   my $product;
1353   if ($addid) {
1354     $product = BSE::TB::Seminars->getByPkey($addid);
1355     $product ||= Products->getByPkey($addid);
1356   }
1357   unless ($product) {
1358     $$error = "Cannot find product $addid";
1359     return;
1360   }
1361
1362   # collect the product options
1363   my @options;
1364   my @opt_names = split /,/, $product->{options};
1365   my @not_def;
1366   my $cgi = $req->cgi;
1367   for my $name (@opt_names) {
1368     my $value = $cgi->param($name);
1369     push @options, $value;
1370     unless (defined $value) {
1371       push @not_def, $name;
1372     }
1373   }
1374   if (@not_def) {
1375     $$error = "Some product options (@not_def) not supplied";
1376     return;
1377   }
1378   my $options = join(",", @options);
1379
1380   # the product must be non-expired and listed
1381   (my $comp_release = $product->{release}) =~ s/ .*//;
1382   (my $comp_expire = $product->{expire}) =~ s/ .*//;
1383   my $today = now_sqldate();
1384   unless ($comp_release le $today) {
1385     $$error = "Product $product->{title} has not been released yet";
1386     return;
1387   }
1388   unless ($today le $comp_expire) {
1389     $$error = "Product $product->{title} has expired";
1390     return;
1391   }
1392   unless ($product->{listed}) {
1393     $$error = "Product $product->{title} not available";
1394     return;
1395   }
1396
1397   # used to refresh if a logon is needed
1398   my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1399   my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$addid";
1400   for my $opt_index (0..$#opt_names) {
1401     $r .= "&$opt_names[$opt_index]=".escape_uri($options[$opt_index]);
1402   }
1403
1404   my $user = $req->siteuser;
1405   # need to be logged on if it has any subs
1406   if ($product->{subscription_id} != -1) {
1407     if ($user) {
1408       my $sub = $product->subscription;
1409       if ($product->is_renew_sub_only) {
1410         unless ($user->subscribed_to_grace($sub)) {
1411           $$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";
1412           return;
1413         }
1414       }
1415       elsif ($product->is_start_sub_only) {
1416         if ($user->subscribed_to_grace($sub)) {
1417           $$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";
1418           return;
1419         }
1420       }
1421     }
1422     else {
1423       $$refresh_logon =
1424         [  "You must be logged on to add this product to your cart",
1425            'prodlogon', $r ];
1426       return;
1427     }
1428   }
1429   if ($product->{subscription_required} != -1) {
1430     my $sub = $product->subscription_required;
1431     if ($user) {
1432       unless ($user->subscribed_to($sub)) {
1433         $$error = "You must be subscribed to $sub->{title} to purchase this product";
1434         return;
1435       }
1436     }
1437     else {
1438       # we want to refresh back to adding the item to the cart if possible
1439       $$refresh_logon =
1440         [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
1441          'prodlogonsub', $r ];
1442       return;
1443     }
1444   }
1445
1446   # we need a natural integer quantity
1447   unless ($quantity =~ /^\d+$/ && $quantity > 0) {
1448     $$error = "Invalid quantity";
1449     return;
1450   }
1451
1452   my %extras;
1453   if ($product->isa('BSE::TB::Seminar')) {
1454     # you must be logged on to add a seminar
1455     unless ($user) {
1456       $$refresh_logon =
1457         [ "You must be logged on to add seminars to your cart",
1458           'seminarlogon', $r ];
1459       return;
1460     }
1461
1462     # get and validate the session
1463     my $session_id = $cgi->param('session_id');
1464     unless (defined $session_id) {
1465       $$error = "Please select a session when adding a seminar";
1466       return;
1467     }
1468
1469     unless ($session_id =~ /^\d+$/) {
1470       $$error = "Invalid session_id supplied";
1471       return;
1472     }
1473
1474     require BSE::TB::SeminarSessions;
1475     my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
1476     unless ($session) {
1477       $$error = "Unknown session id supplied";
1478       return;
1479     }
1480     unless ($session->{seminar_id} == $addid) {
1481       $$error = "Session not for this seminar";
1482       return;
1483     }
1484
1485     # check if the user is already booked for this session
1486     if (grep($_ == $session_id, $user->seminar_sessions_booked($addid))) {
1487       $$error = "You are already booked for this session";
1488       return;
1489     }
1490
1491     $extras{session_id} = $session_id;
1492   }
1493
1494   return ( $product, $options, \%extras );
1495 }
1496
1497 sub _add_refresh {
1498   my ($refresh, $req, $started_empty) = @_;
1499
1500   my $cfg = $req->cfg;
1501   my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
1502   if ($started_empty && !$cookie_domain) {
1503     my $base_url = $cfg->entryVar('site', 'url');
1504     my $secure_url = $cfg->entryVar('site', 'secureurl');
1505     if ($base_url ne $secure_url) {
1506       my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
1507
1508       # magical refresh time
1509       # which host are we on?
1510       # first get info about the 2 possible hosts
1511       my ($baseprot, $basehost, $baseport) =
1512         $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
1513       $baseport ||= $baseprot eq 'http' ? 80 : 443;
1514       print STDERR "Base: prot: $baseprot  Host: $basehost  Port: $baseport\n"
1515         if $debug;
1516
1517       #my ($secprot, $sechost, $secport) =
1518       #  $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
1519
1520       my $onbase = 1;
1521       # get info about the current host
1522       my $port = $ENV{SERVER_PORT} || 80;
1523       my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
1524       print STDERR "\$ishttps: $ishttps\n" if $debug;
1525       my $protocol = $ishttps ? 'https' : 'http';
1526
1527       if (lc $ENV{SERVER_NAME} ne lc $basehost
1528           || lc $protocol ne $baseprot
1529           || $baseport != $port) {
1530         print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot'  $baseport cmp $port\n" if $debug;
1531         $onbase = 0;
1532       }
1533       my $url = $onbase ? $secure_url : $base_url;
1534       my $finalbase = $onbase ? $base_url : $secure_url;
1535       $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
1536       print STDERR "Heading to $url to setcookie\n" if $debug;
1537       $url .= "/cgi-bin/user.pl?setcookie=".$req->session->{_session_id};
1538       $url .= "&r=".CGI::escape($refresh);
1539       return BSE::Template->get_refresh($url, $cfg);
1540     }
1541   }
1542
1543   return BSE::Template->get_refresh($refresh, $cfg);
1544 }
1545
1546 1;