0.15_25 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;
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
418 return BSE::Template->get_refresh("$ENV{SCRIPT_NAME}?a_show_payment=1", $req->cfg);
419}
420
421sub req_show_payment {
422 my ($class, $req, $errors) = @_;
423
424 $req->session->{order_info_confirmed}
425 or return $class->req_checkout($req, 'Please proceed via the checkout page');
426
2c9b9618
TC
427 $req->session->{cart} && @{$req->session->{cart}}
428 or return $class->req_cart($req, "Your cart is empty");
429
41e7c841
TC
430 my $cfg = $req->cfg;
431 my $cgi = $req->cgi;
432
433 $errors ||= {};
434 my $msg = $req->message($errors);
435
436 my $order_values = $req->session->{order_info}
437 or return $class->req_checkout($req, "You need to enter order information first");
438
439 my @pay_types = payment_types($cfg);
440 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
441 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
442 @payment_types or @payment_types = ( PAYMENT_CALLME );
443 @payment_types = sort { $a <=> $b } @payment_types;
444 my %payment_types = map { $_=> 1 } @payment_types;
445 my $payment;
446 $errors and $payment = $cgi->param('paymentType');
447 defined $payment or $payment = $payment_types[0];
448
449 my @products;
450 my @items = $class->_build_items($req, \@products);
451
452 my %acts;
453 %acts =
454 (
455 basic_tags(\%acts),
456 message => $msg,
457 msg => $msg,
458 order => [ \&tag_hash, $order_values ],
57d988af 459 shop_cart_tags(\%acts, \@items, \@products, $req, 'payment'),
41e7c841
TC
460 ifMultPaymentTypes => @payment_types > 1,
461 checkedPayment => [ \&tag_checkedPayment, $payment, \%types_by_name ],
462 ifPayments => [ \&tag_ifPayments, \@payment_types, \%types_by_name ],
463 error_img => [ \&tag_error_img, $cfg, $errors ],
464 );
465 for my $type (@pay_types) {
466 my $id = $type->{id};
467 my $name = $type->{name};
468 $acts{"if${name}Payments"} = exists $payment_types{$id};
469 $acts{"if${name}FirstPayment"} = $payment_types[0] == $id;
470 $acts{"checkedIfFirst$name"} = $payment_types[0] == $id ? "checked " : "";
471 $acts{"checkedPayment$name"} = $payment == $id ? 'checked="checked" ' : "";
472 }
473
474 return $req->response('checkoutpay', \%acts);
475}
476
477my %nostore =
478 (
479 cardNumber => 1,
480 cardExpiry => 1,
481 );
482
483sub req_payment {
484 my ($class, $req, $errors) = @_;
485
486 $req->session->{order_info_confirmed}
487 or return $class->req_checkout($req, 'Please proceed via the checkout page');
488
489 my $order_values = $req->session->{order_info}
490 or return $class->req_checkout($req, "You need to enter order information first");
491
492
493 my $cgi = $req->cgi;
494 my $cfg = $req->cfg;
495 my $session = $req->session;
496
497 my @pay_types = payment_types($cfg);
498 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
499 my %pay_types = map { $_->{id} => $_ } @pay_types;
500 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
501 @payment_types or @payment_types = ( PAYMENT_CALLME );
502 @payment_types = sort { $a <=> $b } @payment_types;
503 my %payment_types = map { $_=> 1 } @payment_types;
504
505 my $paymentType = $cgi->param('paymentType');
506 defined $paymentType or $paymentType = $payment_types[0];
507 $payment_types{$paymentType}
508 or return $class->req_show_payment($req, { paymentType => "Invalid payment type" } , 1);
509
510 my @required;
511 push @required, @{$pay_types{$paymentType}{require}};
512
513 my %fields = BSE::TB::Order->valid_payment_fields($cfg);
514 my %rules = BSE::TB::Order->valid_payment_rules($cfg);
515 for my $field (@required) {
516 if (exists $fields{$field}) {
517 $fields{$field}{required} = 1;
518 }
519 else {
520 $fields{$field} = { description => $field, required=> 1 };
521 }
522 }
523
524 my %errors;
525 dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
526 $cfg, 'Shop Order Validation');
527 keys %errors
528 and return $class->req_show_payment($req, \%errors);
529
530 my @products;
531 my @items = $class->_build_items($req, \@products);
532
533 for my $field (@required) {
534 unless ($nostore{$field}) {
535 ($order_values->{$field}) = $cgi->param($field);
536 }
537 }
538
539 $order_values->{filled} = 0;
540 $order_values->{paidFor} = 0;
541
542 my $cust_class = custom_class($req->cfg);
543 eval {
544 my %custom = %{$session->{custom}};
545 $cust_class->order_save($cgi, $order_values, \@items, \@products,
546 \%custom, $cfg);
547 $session->{custom} = \%custom;
548 };
549 if ($@) {
550 return $class->req_checkout($req, $@, 1);
551 }
552
553 my @columns = BSE::TB::Order->columns;
554 my %columns;
555 @columns{@columns} = @columns;
556
557 for my $col (@columns) {
558 defined $order_values->{$col} or $order_values->{$col} = '';
559 }
560
561 $order_values->{paymentType} = $paymentType;
562
563 my @data = @{$order_values}{@columns};
564 shift @data;
5d88571c
TC
565
566 my $order;
567 if ($session->{order_work}) {
568 $order = BSE::TB::Orders->getByPkey($session->{order_work});
569 }
570 if ($order) {
571 print STDERR "Recycling order $order->{id}\n";
572
573 my @allbutid = @columns;
574 shift @allbutid;
575 @{$order}{@allbutid} = @data;
576
577 $order->clear_items;
578 }
579 else {
580 $order = BSE::TB::Orders->add(@data)
581 or die "Cannot add order";
582 }
41e7c841
TC
583
584 my @dbitems;
585 my %subscribing_to;
586 my @item_cols = BSE::TB::OrderItem->columns;
587 for my $row_num (0..$#items) {
588 my $item = $items[$row_num];
589 my $product = $products[$row_num];
590 $item->{orderId} = $order->{id};
591 $item->{max_lapsed} = 0;
592 if ($product->{subscription_id} != -1) {
593 my $sub = $product->subscription;
594 $item->{max_lapsed} = $sub->{max_lapsed} if $sub;
595 }
596 my @data = @{$item}{@item_cols};
597
598 shift @data;
599 push(@dbitems, BSE::TB::OrderItems->add(@data));
600
601 my $sub = $product->subscription;
602 if ($sub) {
603 $subscribing_to{$sub->{text_id}} = $sub;
604 }
718a070d
TC
605
606 if ($item->{session_id}) {
607 my $user = $req->siteuser;
608 require BSE::TB::SeminarSessions;
609 my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
610 eval {
611 $session->add_attendee($user, 0);
612 };
613 }
41e7c841 614 }
5d88571c
TC
615
616 $order->{ccOnline} = 0;
41e7c841
TC
617
618 my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
619 if ($paymentType == PAYMENT_CC && $ccprocessor) {
620 my $cc_class = credit_card_class($cfg);
621
622 $order->{ccOnline} = 1;
623
624 my $ccNumber = $cgi->param('cardNumber');
625 my $ccExpiry = $cgi->param('cardExpiry');
626 $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
627 my ($month, $year) = ($1, $2);
628 $year > 2000 or $year += 2000;
629 my $expiry = sprintf("%04d%02d", $year, $month);
630 my $verify = $cgi->param('cardVerify');
631 defined $verify or $verify = '';
632 my $result = $cc_class->payment(orderno=>$order->{id},
633 amount => $order->{total},
634 cardnumber => $ccNumber,
635 expirydate => $expiry,
636 cvv => $verify,
637 ipaddress => $ENV{REMOTE_ADDR});
638 unless ($result->{success}) {
639 use Data::Dumper;
640 print STDERR Dumper($result);
641 # failed, back to payments
642 $order->{ccSuccess} = 0;
643 $order->{ccStatus} = $result->{statuscode};
644 $order->{ccStatus2} = 0;
645 $order->{ccStatusText} = $result->{error};
646 $order->{ccTranId} = '';
647 $order->save;
648 $errors{cardNumber} = $result->{error};
649 $session->{order_work} = $order->{id};
650 return $class->req_show_payment($req, \%errors);
651 }
652
653 $order->{ccSuccess} = 1;
654 $order->{ccReceipt} = $result->{receipt};
655 $order->{ccStatus} = 0;
656 $order->{ccStatus2} = 0;
657 $order->{ccStatusText} = '';
658 $order->{ccTranId} = $result->{transactionid};
659 $order->{paidFor} = 1;
41e7c841
TC
660 }
661
5d88571c
TC
662 # order complete
663 $order->{complete} = 1;
664 $order->save;
665
41e7c841
TC
666 # set the order displayed by orderdone
667 $session->{order_completed} = $order->{id};
668 $session->{order_completed_at} = time;
669
670 my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
671 $class->_send_order($req, $order, \@dbitems, \@products, $noencrypt,
672 \%subscribing_to);
673
674 # empty the cart ready for the next order
675 delete @{$session}{qw/order_info order_info_confirmed cart order_work/};
676
677 return BSE::Template->get_refresh("$ENV{SCRIPT_NAME}?a_orderdone=1", $req->cfg);
678}
679
680sub req_orderdone {
681 my ($class, $req) = @_;
682
683 my $session = $req->session;
684 my $cfg = $req->cfg;
685
686 my $id = $session->{order_completed};
687 my $when = $session->{order_completed_at};
688 $id && defined $when && time < $when + 500
689 or return $class->req_cart($req);
690
691 my $order = BSE::TB::Orders->getByPkey($id)
692 or return $class->req_cart($req);
693 my @items = $order->items;
41e7c841
TC
694 my @products = map { Products->getByPkey($_->{productId}) } @items;
695
2c9b9618
TC
696 my @item_cols = BSE::TB::OrderItem->columns;
697 my %copy_cols = map { $_ => 1 } Product->columns;
698 delete @copy_cols{@item_cols};
699 my @copy_cols = keys %copy_cols;
700 my @showitems;
701 for my $item_index (0..$#items) {
702 my $item = $items[$item_index];
703 my $product = $products[$item_index];
704 my %entry;
705 @entry{@item_cols} = @{$item}{@item_cols};
706 @entry{@copy_cols} = @{$product}{@copy_cols};
707
708 push @showitems, \%entry;
709 }
710
41e7c841
TC
711 my $cust_class = custom_class($req->cfg);
712
713 my @pay_types = payment_types($cfg);
714 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
715 my %pay_types = map { $_->{id} => $_ } @pay_types;
716 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
717
718 my $item_index = -1;
719 my @options;
720 my $option_index;
718a070d
TC
721 my $item;
722 my $product;
723 my $sem_session;
724 my $location;
41e7c841
TC
725 my %acts;
726 %acts =
727 (
728 $cust_class->purchase_actions(\%acts, \@items, \@products,
729 $session->{custom}, $cfg),
730 BSE::Util::Tags->static(\%acts, $cfg),
731 iterate_items_reset => sub { $item_index = -1; },
732 iterate_items =>
733 sub {
734 if (++$item_index < @items) {
735 $option_index = -1;
736 @options = cart_item_opts($items[$item_index],
737 $products[$item_index]);
718a070d
TC
738 undef $sem_session;
739 undef $location;
740 $item = $items[$item_index];
741 $product = $products[$item_index];
41e7c841
TC
742 return 1;
743 }
718a070d
TC
744 undef $item;
745 undef $sem_session;
746 undef $product;
747 undef $location;
41e7c841
TC
748 return 0;
749 },
2c9b9618 750 item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
41e7c841
TC
751 product =>
752 sub {
753 my $value = $products[$item_index]{$_[0]};
754 defined $value or $value = '';
755
756 escape_html($value);
757 },
758 extended =>
759 sub {
760 my $what = $_[0] || 'retailPrice';
761 $items[$item_index]{units} * $items[$item_index]{$what};
762 },
763 order => sub { escape_html($order->{$_[0]}) },
764 money =>
765 sub {
766 my ($func, $args) = split ' ', $_[0], 2;
767 $acts{$func} || return "<: money $_[0] :>";
768 return sprintf("%.02f", $acts{$func}->($args)/100);
769 },
770 _format =>
771 sub {
772 my ($value, $fmt) = @_;
773 if ($fmt =~ /^m(\d+)/) {
774 return sprintf("%$1s", sprintf("%.2f", $value/100));
775 }
776 elsif ($fmt =~ /%/) {
777 return sprintf($fmt, $value);
778 }
779 },
780 iterate_options_reset => sub { $option_index = -1 },
781 iterate_options => sub { ++$option_index < @options },
782 option => sub { escape_html($options[$option_index]{$_[0]}) },
783 ifOptions => sub { @options },
784 options => sub { nice_options(@options) },
785 ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
786 #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
718a070d
TC
787 session => [ \&tag_session, \$item, \$sem_session ],
788 location => [ \&tag_location, \$item, \$location ],
41e7c841
TC
789 );
790 for my $type (@pay_types) {
791 my $id = $type->{id};
792 my $name = $type->{name};
793 $acts{"if${name}Payment"} = $order->{paymentType} == $id;
794 }
795
796 return $req->response('checkoutfinal', \%acts);
797}
798
718a070d
TC
799sub tag_session {
800 my ($ritem, $rsession, $arg) = @_;
801
802 $$ritem or return '';
803
804 $$ritem->{session_id} or return '';
805
806 unless ($$rsession) {
807 require BSE::TB::SeminarSessions;
808 $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
809 or return '';
810 }
811
812 my $value = $$rsession->{$arg};
813 defined $value or return '';
814
815 escape_html($value);
816}
817
818sub tag_location {
819 my ($ritem, $rlocation, $arg) = @_;
820
821 $$ritem or return '';
822
823 $$ritem->{session_id} or return '';
824
825 unless ($$rlocation) {
826 require BSE::TB::Locations;
827 ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
828 or return '';
829 }
830
831 my $value = $$rlocation->{$arg};
832 defined $value or return '';
833
834 escape_html($value);
835}
836
41e7c841
TC
837sub tag_ifPayment {
838 my ($payment, $types_by_name, $args) = @_;
839
840 my $type = $args;
841 if ($type !~ /^\d+$/) {
842 return '' unless exists $types_by_name->{$type};
843 $type = $types_by_name->{$type};
844 }
845
846 return $payment == $type;
847}
848
849
850sub _validate_cfg {
851 my ($class, $req, $rmsg) = @_;
852
853 my $cfg = $req->cfg;
854 my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
855 unless ($from && $from =~ /.\@./) {
856 $$rmsg = "Configuration error: shop from address not set";
857 return;
858 }
859 my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
860 unless ($toEmail && $toEmail =~ /.\@./) {
861 $$rmsg = "Configuration error: shop to_email address not set";
862 return;
863 }
864
865 return 1;
866}
867
41e7c841
TC
868sub req_recalc {
869 my ($class, $req) = @_;
2c9b9618 870
41e7c841
TC
871 $class->update_quantities($req);
872 $req->session->{order_info_confirmed} = 0;
873 return $class->req_cart($req);
874}
875
876sub req_recalculate {
877 my ($class, $req) = @_;
878
879 return $class->req_recalc($req);
880}
881
882sub _send_order {
883 my ($class, $req, $order, $items, $products, $noencrypt,
884 $subscribing_to) = @_;
885
886 my $cfg = $req->cfg;
887 my $cgi = $req->cgi;
888
889 my $crypto_class = $Constants::SHOP_CRYPTO;
890 my $signing_id = $Constants::SHOP_SIGNING_ID;
891 my $pgp = $Constants::SHOP_PGP;
892 my $pgpe = $Constants::SHOP_PGPE;
893 my $gpg = $Constants::SHOP_GPG;
894 my $passphrase = $Constants::SHOP_PASSPHRASE;
895 my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
896 my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
897 my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
898 my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
899
900 my $session = $req->session;
901 my %extras = $cfg->entriesCS('extra tags');
902 for my $key (keys %extras) {
903 # follow any links
904 my $data = $cfg->entryVar('extra tags', $key);
905 $extras{$key} = sub { $data };
906 }
907
908 my $item_index = -1;
909 my @options;
910 my $option_index;
911 my %acts;
912 %acts =
913 (
914 %extras,
915 custom_class($cfg)
916 ->order_mail_actions(\%acts, $order, $items, $products,
917 $session->{custom}, $cfg),
918 BSE::Util::Tags->static(\%acts, $cfg),
919 iterate_items_reset => sub { $item_index = -1; },
920 iterate_items =>
921 sub {
922 if (++$item_index < @$items) {
923 $option_index = -1;
924 @options = cart_item_opts($items->[$item_index],
925 $products->[$item_index]);
926 return 1;
927 }
928 return 0;
929 },
930 item=> sub { $items->[$item_index]{$_[0]}; },
931 product =>
932 sub {
933 my $value = $products->[$item_index]{$_[0]};
934 defined($value) or $value = '';
935 $value;
936 },
937 order => sub { $order->{$_[0]} },
938 extended =>
939 sub {
940 $items->[$item_index]{units} * $items->[$item_index]{$_[0]};
941 },
942 _format =>
943 sub {
944 my ($value, $fmt) = @_;
945 if ($fmt =~ /^m(\d+)/) {
946 return sprintf("%$1s", sprintf("%.2f", $value/100));
947 }
948 elsif ($fmt =~ /%/) {
949 return sprintf($fmt, $value);
950 }
951 elsif ($fmt =~ /^\d+$/) {
952 return substr($value . (" " x $fmt), 0, $fmt);
953 }
954 else {
955 return $value;
956 }
957 },
958 iterate_options_reset => sub { $option_index = -1 },
959 iterate_options => sub { ++$option_index < @options },
960 option => sub { escape_html($options[$option_index]{$_[0]}) },
961 ifOptions => sub { @options },
962 options => sub { nice_options(@options) },
963 with_wrap => \&tag_with_wrap,
964 ifSubscribingTo => [ \&tag_ifSubscribingTo, $subscribing_to ],
965 );
966
967 my $mailer = BSE::Mail->new(cfg=>$cfg);
968 # ok, send some email
969 my $confirm = BSE::Template->get_page('mailconfirm', $cfg, \%acts);
970 my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
971 if ($email_order) {
972 unless ($noencrypt) {
973 $acts{cardNumber} = $cgi->param('cardNumber');
974 $acts{cardExpiry} = $cgi->param('cardExpiry');
975 }
976 my $ordertext = BSE::Template->get_page('mailorder', $cfg, \%acts);
977
978 my $send_text;
979 if ($noencrypt) {
980 $send_text = $ordertext;
981 }
982 else {
983 eval "use $crypto_class";
984 !$@ or die $@;
985 my $encrypter = $crypto_class->new;
986
987 my $debug = $cfg->entryBool('debug', 'mail_encryption', 0);
988 my $sign = $cfg->entryBool('basic', 'sign', 1);
989
990 # encrypt and sign
991 my %opts =
992 (
993 sign=> $sign,
994 passphrase=> $passphrase,
995 stripwarn=>1,
996 debug=>$debug,
997 );
998
999 $opts{secretkeyid} = $signing_id if $signing_id;
1000 $opts{pgp} = $pgp if $pgp;
1001 $opts{gpg} = $gpg if $gpg;
1002 $opts{pgpe} = $pgpe if $pgpe;
1003 my $recip = "$toName $toEmail";
1004
1005 $send_text = $encrypter->encrypt($recip, $ordertext, %opts )
1006 or die "Cannot encrypt ", $encrypter->error;
1007 }
1008 $mailer->send(to=>$toEmail, from=>$from, subject=>'New Order '.$order->{id},
1009 body=>$send_text)
1010 or print STDERR "Error sending order to admin: ",$mailer->errstr,"\n";
1011 }
1012 $mailer->send(to=>$order->{emailAddress}, from=>$from,
1013 subject=>$subject . " " . localtime,
1014 body=>$confirm)
1015 or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1016}
1017
1018sub tag_with_wrap {
1019 my ($args, $text) = @_;
1020
1021 my $margin = $args =~ /^\d+$/ && $args > 30 ? $args : 70;
1022
1023 require Text::Wrap;
1024 # do it twice to prevent a warning
1025 $Text::Wrap::columns = $margin;
1026 $Text::Wrap::columns = $margin;
1027
1028 return Text::Wrap::fill('', '', split /\n/, $text);
1029}
1030
1031sub _refresh_logon {
1032 my ($class, $req, $msg, $msgid, $r) = @_;
1033
1034 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1035 my $url = $securlbase."/cgi-bin/user.pl";
1036
1037 $r ||= $securlbase."/cgi-bin/shop.pl?checkout=1";
1038
1039 my %parms;
1040 $parms{r} = $r;
1041 $parms{message} = $msg if $msg;
1042 $parms{mid} = $msgid if $msgid;
1043 $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1044
1045 return BSE::Template->get_refresh($url, $req->cfg);
1046}
1047
1048sub _need_logon {
1049 my ($class, $req, $cart, $cart_prods) = @_;
1050
1051 return need_logon($req->cfg, $cart, $cart_prods, $req->session, $req->cgi);
1052}
1053
1054sub tag_checkedPayment {
1055 my ($payment, $types_by_name, $args) = @_;
1056
1057 my $type = $args;
1058 if ($type !~ /^\d+$/) {
1059 return '' unless exists $types_by_name->{$type};
1060 $type = $types_by_name->{$type};
1061 }
1062
1063 return $payment == $type ? 'checked="checked"' : '';
1064}
1065
1066sub tag_ifPayments {
1067 my ($enabled, $types_by_name, $args) = @_;
1068
1069 my $type = $args;
1070 if ($type !~ /^\d+$/) {
1071 return '' unless exists $types_by_name->{$type};
1072 $type = $types_by_name->{$type};
1073 }
1074
1075 my @found = grep $_ == $type, @$enabled;
1076
1077 return scalar @found;
1078}
1079
1080sub update_quantities {
1081 my ($class, $req) = @_;
1082
1083 my $session = $req->session;
1084 my $cgi = $req->cgi;
1085 my $cfg = $req->cfg;
1086 my @cart = @{$session->{cart} || []};
1087 for my $index (0..$#cart) {
1088 my $new_quantity = $cgi->param("quantity_$index");
1089 if (defined $new_quantity) {
1090 if ($new_quantity =~ /^\s*(\d+)/) {
1091 $cart[$index]{units} = $1;
1092 }
1093 elsif ($new_quantity =~ /^\s*$/) {
1094 $cart[$index]{units} = 0;
1095 }
1096 }
1097 }
1098 @cart = grep { $_->{units} != 0 } @cart;
1099 $session->{cart} = \@cart;
1100 $session->{custom} ||= {};
1101 my %custom_state = %{$session->{custom}};
1102 custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1103 $session->{custom} = \%custom_state;
1104}
1105
1106sub _build_items {
1107 my ($class, $req, $products) = @_;
1108
1109 my $session = $req->session;
1110 $session->{cart}
1111 or return;
1112 my @msgs;
1113 my @cart = @{$req->session->{cart}}
1114 or return;
1115 my @items;
1116 my @prodcols = Product->columns;
1117 my @newcart;
1118 my $today = now_sqldate();
1119 for my $item (@cart) {
1120 my %work = %$item;
1121 my $product = Products->getByPkey($item->{productId});
1122 if ($product) {
1123 (my $comp_release = $product->{release}) =~ s/ .*//;
1124 (my $comp_expire = $product->{expire}) =~ s/ .*//;
1125 $comp_release le $today
1126 or do { push @msgs, "'$product->{title}' has not been released yet";
1127 next; };
1128 $today le $comp_expire
1129 or do { push @msgs, "'$product->{title}' has expired"; next; };
1130 $product->{listed}
1131 or do { push @msgs, "'$product->{title}' not available"; next; };
1132
1133 for my $col (@prodcols) {
1134 $work{$col} = $product->{$col} unless exists $work{$col};
1135 }
1136 $work{extended_retailPrice} = $work{units} * $work{retailPrice};
1137 $work{extended_gst} = $work{units} * $work{gst};
1138 $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1139
1140 push @newcart, \%work;
1141 push @$products, $product;
1142 }
1143 }
1144
1145 # we don't use these for anything for now
1146 #if (@msgs) {
1147 # @$rmsg = @msgs;
1148 #}
1149
1150 return @newcart;
1151}
1152
1153sub _fillout_order {
1154 my ($class, $req, $values, $items, $rmsg, $how) = @_;
1155
1156 my $session = $req->session;
1157 my $cfg = $req->cfg;
1158 my $cgi = $req->cgi;
1159
1160 my $total = 0;
1161 my $total_gst = 0;
1162 my $total_wholesale = 0;
1163 for my $item (@$items) {
1164 $total += $item->{extended_retailPrice};
1165 $total_gst += $item->{extended_gst};
1166 $total_wholesale += $item->{extended_wholesale};
1167 }
1168 $values->{total} = $total;
1169 $values->{gst} = $total_gst;
1170 $values->{wholesale} = $total_wholesale;
1171 $values->{shipping_cost} = 0;
1172
1173 my $cust_class = custom_class($cfg);
1174
1175 # if it sets shipping cost it must also update the total
1176 eval {
1177 my %custom = %{$session->{custom}};
1178 $cust_class->order_save($cgi, $values, $items, $items,
1179 \%custom, $cfg);
1180 $session->{custom} = \%custom;
1181 };
1182 if ($@) {
1183 $$rmsg = $@;
1184 return;
1185 }
1186
1187 $values->{total} +=
1188 $cust_class->total_extras($items, $items,
1189 $session->{custom}, $cfg, $how);
1190
1191 my $affiliate_code = $session->{affiliate_code};
1192 defined $affiliate_code && length $affiliate_code
1193 or $affiliate_code = $cgi->param('affiliate_code');
1194 defined $affiliate_code or $affiliate_code = '';
1195 $values->{affiliate_code} = $affiliate_code;
1196
1197 my $user = $req->siteuser;
1198 if ($user) {
1199 $values->{userId} = $user->{userId};
1200 $values->{siteuser_id} = $user->{id};
1201 }
1202 else {
1203 $values->{userId} = '';
1204 $values->{siteuser_id} = -1;
1205 }
1206
1207 $values->{orderDate} = now_sqldatetime;
1208
1209 # this should be hard to guess
1210 $values->{randomId} ||= md5_hex(time().rand().{}.$$);
1211
1212 return 1;
1213}
1214
1215sub action_prefix { '' }
1216
718a070d
TC
1217sub req_location {
1218 my ($class, $req) = @_;
1219
1220 require BSE::TB::Locations;
1221 my $cgi = $req->cgi;
1222 my $location_id = $cgi->param('location_id');
1223 my $location;
1224 if (defined $location_id && $location_id =~ /^\d$/) {
1225 $location = BSE::TB::Locations->getByPkey($location_id);
1226 my %acts;
1227 %acts =
1228 (
1229 BSE::Util::Tags->static(\%acts, $req->cfg),
1230 location => [ \&tag_hash, $location ],
1231 );
1232
1233 return $req->response('location', \%acts);
1234 }
1235 else {
1236 return
1237 {
1238 type=>BSE::Template->get_type($req->cfg, 'error'),
1239 content=>"Missing or invalid location_id",
1240 };
1241 }
1242}
1243
41e7c841 12441;