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