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