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