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