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