fix docs
[bse.git] / site / cgi-bin / modules / BSE / UI / Shop.pm
CommitLineData
41e7c841
TC
1package BSE::UI::Shop;
2use strict;
3use base 'BSE::UI::Dispatch';
3f9c8a96 4use BSE::Util::HTML qw(:default popup_menu);
41e7c841 5use BSE::Util::SQL qw(now_sqldate now_sqldatetime);
5d88571c 6use BSE::Shop::Util qw(need_logon shop_cart_tags payment_types nice_options
58baa27b 7 cart_item_opts basic_tags order_item_opts);
cadb5bfa 8use BSE::CfgInfo qw(custom_class credit_card_class bse_default_country);
41e7c841
TC
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';
4a29dc8f 17use BSE::Shipping;
cadb5bfa 18use BSE::Countries qw(bse_country_code);
41e7c841
TC
19
20use constant PAYMENT_CC => 0;
21use constant PAYMENT_CHEQUE => 1;
22use constant PAYMENT_CALLME => 2;
23
56f87a80
TC
24use constant MSG_SHOP_CART_FULL => 'Your shopping cart is full, please remove an item and try adding an item again';
25
41e7c841
TC
26my %actions =
27 (
28 add => 1,
788f3852 29 addmultiple => 1,
41e7c841
TC
30 cart => 1,
31 checkout => 1,
32 checkupdate => 1,
33 recheckout => 1,
34 confirm => 1,
35 recalc=>1,
36 recalculate => 1,
37 #purchase => 1,
38 order => 1,
39 show_payment => 1,
40 payment => 1,
41 orderdone => 1,
718a070d 42 location => 1,
41e7c841
TC
43 );
44
a392c69e
TC
45my %field_map =
46 (
47 name1 => 'delivFirstName',
48 name2 => 'delivLastName',
49 address => 'delivStreet',
37dd20ad 50 organization => 'delivOrganization',
a392c69e
TC
51 city => 'delivSuburb',
52 postcode => 'delivPostCode',
53 state => 'delivState',
54 country => 'delivCountry',
55 email => 'emailAddress',
56 cardHolder => 'ccName',
57 cardType => 'ccType',
58 );
59
60my %rev_field_map = reverse %field_map;
61
41e7c841
TC
62sub actions { \%actions }
63
64sub default_action { 'cart' }
65
66sub other_action {
67 my ($class, $cgi) = @_;
68
69 for my $key ($cgi->param()) {
2c9b9618 70 if ($key =~ /^delete_(\d+)(?:\.x)?$/) {
41e7c841
TC
71 return ( remove_item => $1 );
72 }
7f344ccc
TC
73 elsif ($key =~ /^(?:a_)?addsingle(\d+)(?:\.x)?$/) {
74 return ( addsingle => $1 );
75 }
41e7c841
TC
76 }
77
78 return;
79}
80
81sub req_cart {
82 my ($class, $req, $msg) = @_;
83
84 my @cart = @{$req->session->{cart} || []};
a392c69e
TC
85 my @cart_prods;
86 my @items = $class->_build_items($req, \@cart_prods);
41e7c841
TC
87 my $item_index = -1;
88 my @options;
89 my $option_index;
90
91 $req->session->{custom} ||= {};
92 my %custom_state = %{$req->session->{custom}};
93
94 my $cust_class = custom_class($req->cfg);
95 $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $req->cfg);
96 $msg = '' unless defined $msg;
97 $msg = escape_html($msg);
2bb61f07 98
41e7c841
TC
99 my %acts;
100 %acts =
101 (
102 $cust_class->cart_actions(\%acts, \@cart, \@cart_prods, \%custom_state,
103 $req->cfg),
57d988af 104 shop_cart_tags(\%acts, \@items, \@cart_prods, $req, 'cart'),
41e7c841
TC
105 basic_tags(\%acts),
106 msg => $msg,
107 );
108 $req->session->{custom} = \%custom_state;
109 $req->session->{order_info_confirmed} = 0;
110
2bb61f07
AO
111 # intended to ajax enable the shop cart with partial templates
112 my $template = 'cart';
113 my $embed = $req->cgi->param('embed');
114 if (defined $embed and $embed =~ /^\w+$/) {
115 $template = "include/cart_$embed";
116 }
117 return $req->response($template, \%acts);
41e7c841
TC
118}
119
120sub req_add {
121 my ($class, $req) = @_;
122
123 my $cgi = $req->cgi;
124
41e7c841
TC
125 my $quantity = $cgi->param('quantity');
126 $quantity ||= 1;
788f3852
TC
127
128 my $error;
129 my $refresh_logon;
7b5ef271
TC
130 my ($product, $options, $extras);
131 my $addid = $cgi->param('id');
132 if (defined $addid) {
133 ($product, $options, $extras)
134 = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
135 }
136 else {
137 my $code = $cgi->param('code');
138 if (defined $code) {
139 ($product, $options, $extras)
140 = $class->_validate_add_by_code($req, $code, $quantity, \$error, \$refresh_logon);
141 }
142 else {
143 return $class->req_cart($req, "No product id or code supplied");
144 }
145 }
788f3852
TC
146 if ($refresh_logon) {
147 return $class->_refresh_logon($req, @$refresh_logon);
718a070d 148 }
788f3852
TC
149 elsif ($error) {
150 return $class->req_cart($req, $error);
56f87a80 151 }
41e7c841 152
a53374d2
TC
153 if ($cgi->param('empty')) {
154 $req->session->{cart} = [];
155 }
156
788f3852
TC
157 $req->session->{cart} ||= [];
158 my @cart = @{$req->session->{cart}};
a713d924 159 my $started_empty = @cart == 0;
56f87a80 160
788f3852
TC
161 my $found;
162 for my $item (@cart) {
58baa27b 163 $item->{productId} eq $product->{id} && _same_options($item->{options}, $options)
788f3852
TC
164 or next;
165
166 ++$found;
167 $item->{units} += $quantity;
168 last;
41e7c841 169 }
788f3852 170 unless ($found) {
56f87a80
TC
171 my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
172 if (defined $cart_limit && @cart >= $cart_limit) {
173 return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
174 }
788f3852
TC
175 push @cart,
176 {
7b5ef271 177 productId => $product->{id},
788f3852
TC
178 units => $quantity,
179 price=>$product->{retailPrice},
180 options=>$options,
181 %$extras,
182 };
41e7c841 183 }
788f3852
TC
184
185 $req->session->{cart} = \@cart;
186 $req->session->{order_info_confirmed} = 0;
4e31f786
TC
187
188 my $refresh = $cgi->param('r');
189 unless ($refresh) {
796809d1 190 $refresh = $req->user_url(shop => 'cart');
4e31f786 191 }
a713d924 192
140a380b
TC
193 # speed for ajax
194 if ($refresh eq 'ajaxcart') {
195 return $class->req_cart($req);
196 }
197
a713d924 198 return _add_refresh($refresh, $req, $started_empty);
788f3852
TC
199}
200
7f344ccc
TC
201sub req_addsingle {
202 my ($class, $req, $addid) = @_;
203
204 my $cgi = $req->cgi;
205
206 $addid ||= '';
207 my $quantity = $cgi->param("qty$addid");
208 defined $quantity && $quantity =~ /\S/
209 or $quantity = 1;
210
211 my $error;
212 my $refresh_logon;
213 my ($product, $options, $extras)
7b5ef271 214 = $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
7f344ccc
TC
215 if ($refresh_logon) {
216 return $class->_refresh_logon($req, @$refresh_logon);
217 }
218 elsif ($error) {
219 return $class->req_cart($req, $error);
220 }
221
a53374d2
TC
222 if ($cgi->param('empty')) {
223 $req->session->{cart} = [];
224 }
225
7f344ccc
TC
226 $req->session->{cart} ||= [];
227 my @cart = @{$req->session->{cart}};
a713d924 228 my $started_empty = @cart == 0;
7f344ccc
TC
229
230 my $found;
231 for my $item (@cart) {
58baa27b 232 $item->{productId} eq $addid && _same_options($item->{options}, $options)
7f344ccc
TC
233 or next;
234
235 ++$found;
236 $item->{units} += $quantity;
237 last;
238 }
239 unless ($found) {
56f87a80
TC
240 my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
241 if (defined $cart_limit && @cart >= $cart_limit) {
242 return $class->req_cart($req, $req->text('shop/cartfull', MSG_SHOP_CART_FULL));
243 }
7f344ccc
TC
244 push @cart,
245 {
246 productId => $addid,
247 units => $quantity,
248 price=>$product->{retailPrice},
249 options=>$options,
250 %$extras,
251 };
252 }
253
254 $req->session->{cart} = \@cart;
255 $req->session->{order_info_confirmed} = 0;
256
257 my $refresh = $cgi->param('r');
258 unless ($refresh) {
796809d1 259 $refresh = $req->user_url(shop => 'cart');
7f344ccc 260 }
140a380b
TC
261
262 # speed for ajax
263 if ($refresh eq 'ajaxcart') {
264 return $class->req_cart($req);
265 }
266
a713d924 267 return _add_refresh($refresh, $req, $started_empty);
7f344ccc
TC
268}
269
788f3852
TC
270sub req_addmultiple {
271 my ($class, $req) = @_;
272
273 my $cgi = $req->cgi;
274 my @qty_keys = map /^qty(\d+)/, $cgi->param;
275
276 my @messages;
277 my %additions;
278 for my $addid (@qty_keys) {
279 my $quantity = $cgi->param("qty$addid");
280 defined $quantity && $quantity =~ /^\s*\d+\s*$/
281 or next;
282
283 my $error;
284 my $refresh_logon;
285 my ($product, $options, $extras) =
7b5ef271 286 $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
5eb6bcd6
TC
287 if ($refresh_logon) {
288 return $class->_refresh_logon($req, @$refresh_logon);
289 }
290 elsif ($error) {
291 return $class->req_cart($req, $error);
292 }
293 if ($product->{options}) {
294 push @messages, "$product->{title} has options, you need to use the product page to add this product";
295 next;
296 }
297 $additions{$addid} =
298 {
299 id => $product->{id},
300 product => $product,
301 extras => $extras,
302 quantity => $quantity,
303 };
304 }
305
306 my @qtys = $cgi->param("qty");
307 my @ids = $cgi->param("id");
308 for my $addid (@ids) {
309 my $quantity = shift @qtys;
310 $addid =~ /^\d+$/
311 or next;
312 $additions{$addid}
313 and next;
314 defined $quantity or $quantity = 1;
315 $quantity =~ /^\d+$/
316 or next;
317 $quantity
318 or next;
319 my ($error, $refresh_logon);
320
321 my ($product, $options, $extras) =
322 $class->_validate_add_by_id($req, $addid, $quantity, \$error, \$refresh_logon);
788f3852
TC
323 if ($refresh_logon) {
324 return $class->_refresh_logon($req, @$refresh_logon);
41e7c841 325 }
788f3852
TC
326 elsif ($error) {
327 return $class->req_cart($req, $error);
41e7c841 328 }
788f3852
TC
329 if ($product->{options}) {
330 push @messages, "$product->{title} has options, you need to use the product page to add this product";
331 next;
41e7c841 332 }
788f3852
TC
333 $additions{$addid} =
334 {
335 id => $product->{id},
336 product => $product,
337 extras => $extras,
338 quantity => $quantity,
339 };
41e7c841 340 }
788f3852 341
a713d924 342 my $started_empty = 0;
788f3852 343 if (keys %additions) {
a53374d2
TC
344 if ($cgi->param('empty')) {
345 $req->session->{cart} = [];
346 }
788f3852
TC
347 $req->session->{cart} ||= [];
348 my @cart = @{$req->session->{cart}};
a713d924 349 $started_empty = @cart == 0;
788f3852 350 for my $item (@cart) {
58baa27b 351 @{$item->{options}} == 0 or next;
718a070d 352
788f3852
TC
353 my $addition = delete $additions{$item->{productId}}
354 or next;
718a070d 355
788f3852
TC
356 $item->{units} += $addition->{quantity};
357 }
56f87a80
TC
358
359 my $cart_limit = $req->cfg->entry('shop', 'cart_entry_limit');
360
361 my @additions = grep $_->{quantity} > 0, values %additions;
362
363 my $error;
364 for my $addition (@additions) {
788f3852 365 my $product = $addition->{product};
56f87a80
TC
366
367 if (defined $cart_limit && @cart >= $cart_limit) {
368 $error = $req->text('shop/cartfull', MSG_SHOP_CART_FULL);
369 last;
370 }
371
788f3852
TC
372 push @cart,
373 {
374 productId => $product->{id},
375 units => $addition->{quantity},
376 price=>$product->{retailPrice},
58baa27b 377 options=>[],
788f3852
TC
378 %{$addition->{extras}},
379 };
380 }
381
382 $req->session->{cart} = \@cart;
383 $req->session->{order_info_confirmed} = 0;
56f87a80
TC
384 $error
385 and return $class->req_cart($req, $error);
718a070d
TC
386 }
387
4e31f786
TC
388 my $refresh = $cgi->param('r');
389 unless ($refresh) {
796809d1 390 $refresh = $req->user_url(shop => 'cart');
788f3852 391 }
4e31f786
TC
392 if (@messages) {
393 my $sep = $refresh =~ /\?/ ? '&' : '?';
394
395 for my $message (@messages) {
396 $refresh .= $sep . "m=" . escape_uri($message);
397 $sep = '&';
398 }
788f3852 399 }
140a380b
TC
400
401 # speed for ajax
402 if ($refresh eq 'ajaxcart') {
403 return $class->req_cart($req);
404 }
405
a713d924 406 return _add_refresh($refresh, $req, $started_empty);
41e7c841
TC
407}
408
98bf90ad
TC
409sub tag_ifUser {
410 my ($user, $args) = @_;
411
412 if ($args) {
413 if ($user) {
414 return defined $user->{$args} && $user->{$args};
415 }
416 else {
417 return 0;
418 }
419 }
420 else {
421 return defined $user;
422 }
423}
424
41e7c841
TC
425sub req_checkout {
426 my ($class, $req, $message, $olddata) = @_;
427
428 my $errors = {};
429 if (defined $message) {
430 if (ref $message) {
431 $errors = $message;
432 $message = $req->message($errors);
433 }
434 }
435 else {
436 $message = '';
437 }
438 my $cfg = $req->cfg;
439 my $cgi = $req->cgi;
440
441 $class->update_quantities($req);
442 my @cart = @{$req->session->{cart}};
443
444 @cart or return $class->req_cart($req);
445
a392c69e
TC
446 my @cart_prods;
447 my @items = $class->_build_items($req, \@cart_prods);
41e7c841
TC
448
449 if (my ($msg, $id) = $class->_need_logon($req, \@cart, \@cart_prods)) {
450 return $class->_refresh_logon($req, $msg, $id);
451 return;
452 }
453
454 my $user = $req->siteuser;
455
456 $req->session->{custom} ||= {};
457 my %custom_state = %{$req->session->{custom}};
458
459 my $cust_class = custom_class($cfg);
460 $cust_class->enter_cart(\@cart, \@cart_prods, \%custom_state, $cfg);
461
462 my $affiliate_code = $req->session->{affiliate_code};
463 defined $affiliate_code or $affiliate_code = '';
464
a392c69e
TC
465 my $order_info = $req->session->{order_info};
466
7f9f1137
AMS
467 my $old = sub {
468 my $value;
469
470 if ($olddata) {
471 $value = $cgi->param($_[0]);
472 unless (defined $value) {
473 $value = $user->{$_[0]}
474 if $user;
475 }
476 }
477 elsif ($order_info && defined $order_info->{$_[0]}) {
478 $value = $order_info->{$_[0]};
479 }
480 else {
481 my $field = $_[0];
482 $rev_field_map{$field} and $field = $rev_field_map{$field};
483 $value = $user && defined $user->{$field} ? $user->{$field} : '';
484 }
485
486 defined $value or $value = '';
487 return $value;
488 };
489
cb351412
TC
490 # shipping handling, if enabled
491 my $shipping_select = ''; # select of shipping types
0a36379b 492 my ($delivery_in, $shipping_cost, $shipping_method);
cb351412
TC
493 my $shipping_error = '';
494 my $shipping_name = '';
495 my $prompt_ship = $cfg->entry("shop", "shipping", 0);
496 if ($prompt_ship) {
497 # Get a list of couriers
498 my $sel_cn = $old->("shipping_name") || "";
499 my %fake_order;
500 my %fields = BSE::TB::Order->valid_fields($cfg);
501 for my $name (keys %fields) {
502 $fake_order{$name} = $old->($name);
503 }
cadb5bfa
TC
504 my $country = $fake_order{delivCountry} || bse_default_country($cfg);
505 my $country_code = bse_country_code($country);
4a29dc8f
TC
506 my $suburb = $fake_order{delivSuburb};
507 my $postcode = $fake_order{delivPostCode};
508
cadb5bfa
TC
509 $country_code
510 or $errors->{delivCountry} = "Unknown country name $country";
511
4a29dc8f 512 my @couriers = BSE::Shipping->get_couriers($cfg);
cadb5bfa
TC
513
514 if ($country_code and $postcode) {
515 @couriers = grep $_->can_deliver(country => $country_code,
516 suburb => $suburb,
517 postcode => $postcode), @couriers;
518 }
cb351412
TC
519
520 my ($sel_cour) = grep $_->name eq $sel_cn, @couriers;
5aa1b103
TC
521 # if we don't match against the list (perhaps because of a country
522 # change) the first item in the list will be selected by the
523 # browser anyway, so select it ourselves and display an
524 # appropriate shipping cost for the item
525 unless ($sel_cour) {
526 $sel_cour = $couriers[0];
527 $sel_cn = $sel_cour->name;
528 }
cadb5bfa 529 if ($sel_cour and $postcode and $suburb and $country_code) {
4a29dc8f
TC
530 my @parcels = BSE::Shipping->package_order($cfg, \%fake_order, \@items);
531 $shipping_cost = $sel_cour->calculate_shipping
532 (
533 parcels => \@parcels,
534 suburb => $suburb,
535 postcode => $postcode,
4f1242d7
TC
536 country => $country_code,
537 products => \@cart_prods,
538 items => \@items,
4a29dc8f
TC
539 );
540 $delivery_in = $sel_cour->delivery_in();
541 $shipping_method = $sel_cour->description();
542 $shipping_name = $sel_cour->name;
543 unless (defined $shipping_cost) {
544 $shipping_error = $sel_cour->error_message;
545 $errors->{shipping_name} = $shipping_error;
cb351412
TC
546 }
547 }
548
549 $shipping_select = popup_menu
550 (
551 -name => "shipping_name",
552 -values => [ map $_->name, @couriers ],
553 -labels => { map { $_->name => $_->description } @couriers },
554 -default => $sel_cn,
555 );
7710a464
AMS
556 }
557
cb351412
TC
558 if (!$message && keys %$errors) {
559 $message = $req->message($errors);
560 }
0a36379b 561
41e7c841
TC
562 my $item_index = -1;
563 my @options;
564 my $option_index;
565 my %acts;
566 %acts =
567 (
57d988af 568 shop_cart_tags(\%acts, \@items, \@cart_prods, $req, 'checkout'),
41e7c841
TC
569 basic_tags(\%acts),
570 message => $message,
571 msg => $message,
7f9f1137 572 old => sub { escape_html($old->($_[0])); },
41e7c841
TC
573 $cust_class->checkout_actions(\%acts, \@cart, \@cart_prods,
574 \%custom_state, $req->cgi, $cfg),
98bf90ad 575 ifUser => [ \&tag_ifUser, $user ],
41e7c841
TC
576 user => $user ? [ \&tag_hash, $user ] : '',
577 affiliate_code => escape_html($affiliate_code),
578 error_img => [ \&tag_error_img, $cfg, $errors ],
cb351412 579 ifShipping => $prompt_ship,
0a36379b 580 shipping_select => $shipping_select,
cb351412 581 delivery_in => escape_html($delivery_in),
d8674b8b 582 shipping_cost => $shipping_cost,
cb351412
TC
583 shipping_method => escape_html($shipping_method),
584 shipping_error => escape_html($shipping_error),
585 shipping_name => $shipping_name,
41e7c841
TC
586 );
587 $req->session->{custom} = \%custom_state;
7710a464 588 my $tmp = $acts{total};
49e6e0a4
AMS
589 $acts{total} =
590 sub {
591 my $total = &$tmp();
d8674b8b 592 $total += $shipping_cost if $total and $shipping_cost;
49e6e0a4
AMS
593 return $total;
594 };
41e7c841
TC
595
596 return $req->response('checkoutnew', \%acts);
597}
598
599sub req_checkupdate {
600 my ($class, $req) = @_;
601
2c9b9618 602 $req->session->{cart} ||= [];
41e7c841
TC
603 my @cart = @{$req->session->{cart}};
604 my @cart_prods = map { Products->getByPkey($_->{productId}) } @cart;
605 $req->session->{custom} ||= {};
606 my %custom_state = %{$req->session->{custom}};
607 custom_class($req->cfg)
608 ->checkout_update($req->cgi, \@cart, \@cart_prods, \%custom_state, $req->cfg);
609 $req->session->{custom} = \%custom_state;
610 $req->session->{order_info_confirmed} = 0;
611
612 return $class->req_checkout($req, "", 1);
613}
614
615sub req_remove_item {
616 my ($class, $req, $index) = @_;
2c9b9618
TC
617
618 $req->session->{cart} ||= [];
41e7c841
TC
619 my @cart = @{$req->session->{cart}};
620 if ($index >= 0 && $index < @cart) {
621 splice(@cart, $index, 1);
622 }
623 $req->session->{cart} = \@cart;
624 $req->session->{order_info_confirmed} = 0;
625
796809d1 626 return BSE::Template->get_refresh($req->user_url(shop => 'cart'), $req->cfg);
41e7c841
TC
627}
628
41e7c841
TC
629# saves order and refresh to payment page
630sub req_order {
631 my ($class, $req) = @_;
632
633 my $cfg = $req->cfg;
634 my $cgi = $req->cgi;
635
636 $req->session->{cart} && @{$req->session->{cart}}
637 or return $class->req_cart($req, "Your cart is empty");
638
639 my $msg;
640 $class->_validate_cfg($req, \$msg)
641 or return $class->req_cart($req, $msg);
642
643 my @products;
644 my @items = $class->_build_items($req, \@products);
645
646 my $id;
647 if (($msg, $id) = $class->_need_logon($req, \@items, \@products)) {
648 return $class->_refresh_logon($req, $msg, $id);
649 }
650
651 # some basic validation, in case the user switched off javascript
652 my $cust_class = custom_class($cfg);
653
654 my %fields = BSE::TB::Order->valid_fields($cfg);
655 my %rules = BSE::TB::Order->valid_rules($cfg);
656
657 my %errors;
658 my %values;
659 for my $name (keys %fields) {
660 ($values{$name}) = $cgi->param($name);
661 }
662
663 my @required =
664 $cust_class->required_fields($cgi, $req->session->{custom}, $cfg);
665
666 for my $name (@required) {
667 $field_map{$name} and $name = $field_map{$name};
668
669 $fields{$name}{required} = 1;
670 }
671
672 dh_validate_hash(\%values, \%errors, { rules=>\%rules, fields=>\%fields },
673 $cfg, 'Shop Order Validation');
cadb5bfa
TC
674 my $prompt_ship = $cfg->entry("shop", "shipping", 0);
675 if ($prompt_ship) {
676 my $country = $values{delivCountry} || bse_default_country($cfg);
677 my $country_code = bse_country_code($country);
678 $country_code
679 or $errors{delivCountry} = "Unknown country name $country";
680 }
41e7c841
TC
681 keys %errors
682 and return $class->req_checkout($req, \%errors, 1);
683
4f1242d7 684 $class->_fillout_order($req, \%values, \@items, \@products, \$msg, 'payment')
41e7c841
TC
685 or return $class->req_checkout($req, $msg, 1);
686
687 $req->session->{order_info} = \%values;
688 $req->session->{order_info_confirmed} = 1;
689
a319d280
TC
690 # skip payment page if nothing to pay
691 if ($values{total} == 0) {
692 return $class->req_payment($req);
693 }
694 else {
796809d1 695 return BSE::Template->get_refresh($req->user_url(shop => 'show_payment'), $req->cfg);
a319d280 696 }
41e7c841
TC
697}
698
14604ada 699=item a_show_payment
41e7c841 700
14604ada 701Allows the customer to pay for an existing order.
41e7c841 702
14604ada
TC
703Parameters:
704
705=over
706
707=item *
708
709orderid - the order id to be paid (Optional, otherwise displays the
710cart for payment).
711
712=back
713
714Template: checkoutpay
715
716=cut
717
718
719sub req_show_payment {
720 my ($class, $req, $errors) = @_;
2c9b9618 721
41e7c841
TC
722 my $cfg = $req->cfg;
723 my $cgi = $req->cgi;
724
14604ada
TC
725 my @items;
726 my @products;
727 my $order;
728
954844f6
TC
729 # ideally supply order_id to be consistent with a_payment.
730 my $order_id = $cgi->param('orderid') || $cgi->param("order_id");
14604ada
TC
731 if ($order_id) {
732 $order_id =~ /^\d+$/
733 or return $class->req_cart($req, "No or invalid order id supplied");
734
735 my $user = $req->siteuser
736 or return $class->_refresh_logon
737 ($req, "Please logon before paying your existing order", "logonpayorder",
738 undef, { a_show_payment => 1, orderid => $order_id });
739
740 require BSE::TB::Orders;
741 $order = BSE::TB::Orders->getByPkey($order_id)
742 or return $class->req_cart($req, "Unknown order id");
743
744 $order->siteuser_id == $user->id
745 or return $class->req_cart($req, "You can only pay for your own orders");
746
747 $order->paidFor
748 and return $class->req_cart($req, "Order $order->{id} has been paid");
749
750 @items = $order->items;
751 @products = $order->products;
752 }
753 else {
754 $req->session->{order_info_confirmed}
755 or return $class->req_checkout($req, 'Please proceed via the checkout page');
756
757 $req->session->{cart} && @{$req->session->{cart}}
758 or return $class->req_cart($req, "Your cart is empty");
759
760 $order = $req->session->{order_info}
761 or return $class->req_checkout($req, "You need to enter order information first");
762
763 @items = $class->_build_items($req, \@products);
764 }
765
41e7c841
TC
766 $errors ||= {};
767 my $msg = $req->message($errors);
768
41e7c841
TC
769 my @pay_types = payment_types($cfg);
770 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
771 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
772 @payment_types or @payment_types = ( PAYMENT_CALLME );
773 @payment_types = sort { $a <=> $b } @payment_types;
774 my %payment_types = map { $_=> 1 } @payment_types;
775 my $payment;
776 $errors and $payment = $cgi->param('paymentType');
777 defined $payment or $payment = $payment_types[0];
778
41e7c841
TC
779 my %acts;
780 %acts =
781 (
782 basic_tags(\%acts),
783 message => $msg,
784 msg => $msg,
14604ada 785 order => [ \&tag_hash, $order ],
57d988af 786 shop_cart_tags(\%acts, \@items, \@products, $req, 'payment'),
41e7c841
TC
787 ifMultPaymentTypes => @payment_types > 1,
788 checkedPayment => [ \&tag_checkedPayment, $payment, \%types_by_name ],
789 ifPayments => [ \&tag_ifPayments, \@payment_types, \%types_by_name ],
790 error_img => [ \&tag_error_img, $cfg, $errors ],
14604ada
TC
791 total => $order->{total},
792 delivery_in => $order->{delivery_in},
793 shipping_cost => $order->{shipping_cost},
794 shipping_method => $order->{shipping_method},
41e7c841
TC
795 );
796 for my $type (@pay_types) {
797 my $id = $type->{id};
798 my $name = $type->{name};
799 $acts{"if${name}Payments"} = exists $payment_types{$id};
800 $acts{"if${name}FirstPayment"} = $payment_types[0] == $id;
801 $acts{"checkedIfFirst$name"} = $payment_types[0] == $id ? "checked " : "";
802 $acts{"checkedPayment$name"} = $payment == $id ? 'checked="checked" ' : "";
803 }
804
805 return $req->response('checkoutpay', \%acts);
806}
807
808my %nostore =
809 (
810 cardNumber => 1,
811 cardExpiry => 1,
3dbe6502 812 delivery_in => 1,
41e7c841
TC
813 );
814
815sub req_payment {
816 my ($class, $req, $errors) = @_;
817
14604ada
TC
818 require BSE::TB::Orders;
819 my $cgi = $req->cgi;
820 my $order_id = $cgi->param("order_id");
821 my $user = $req->siteuser;
822 my $order;
823 my $order_values;
824 my $old_order; # true if we're paying an old order
825 if ($order_id) {
826 unless ($user) {
827 return $class->_refresh_logon
828 (
829 $req,
830 "Please logon before paying your existing order",
831 "logonpayorder",
832 undef,
833 { a_show_payment => 1, orderid => $order_id }
834 );
835 }
836 $order_id =~ /^\d+$/
837 or return $class->req_cart($req, "Invalid order id");
838 $order = BSE::TB::Orders->getByPkey($order_id)
839 or return $class->req_cart($req, "Unknown order id");
840 $order->siteuser_id == $user->id
841 or return $class->req_cart($req, "You can only pay for your own orders");
842
843 $order->paidFor
844 and return $class->req_cart($req, "Order $order->{id} has been paid");
845
846 $order_values = $order;
847 $old_order = 1;
848 }
849 else {
850 $req->session->{order_info_confirmed}
851 or return $class->req_checkout($req, 'Please proceed via the checkout page');
41e7c841 852
14604ada
TC
853 $order_values = $req->session->{order_info}
854 or return $class->req_checkout($req, "You need to enter order information first");
855 $old_order = 0;
856 }
41e7c841 857
41e7c841
TC
858 my $cfg = $req->cfg;
859 my $session = $req->session;
860
a319d280
TC
861 my $paymentType;
862 if ($order_values->{total} != 0) {
863 my @pay_types = payment_types($cfg);
864 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
865 my %pay_types = map { $_->{id} => $_ } @pay_types;
866 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
867 @payment_types or @payment_types = ( PAYMENT_CALLME );
868 @payment_types = sort { $a <=> $b } @payment_types;
869 my %payment_types = map { $_=> 1 } @payment_types;
870
871 $paymentType = $cgi->param('paymentType');
872 defined $paymentType or $paymentType = $payment_types[0];
873 $payment_types{$paymentType}
874 or return $class->req_show_payment($req, { paymentType => "Invalid payment type" } , 1);
875
876 my @required;
877 push @required, @{$pay_types{$paymentType}{require}};
878
879 my %fields = BSE::TB::Order->valid_payment_fields($cfg);
880 my %rules = BSE::TB::Order->valid_payment_rules($cfg);
881 for my $field (@required) {
882 if (exists $fields{$field}) {
883 $fields{$field}{required} = 1;
884 }
885 else {
886 $fields{$field} = { description => $field, required=> 1 };
887 }
41e7c841 888 }
a319d280
TC
889
890 my %errors;
891 dh_validate($cgi, \%errors, { rules => \%rules, fields=>\%fields },
892 $cfg, 'Shop Order Validation');
893 keys %errors
894 and return $class->req_show_payment($req, \%errors);
895
26c634af 896 for my $field (keys %fields) {
a319d280 897 unless ($nostore{$field}) {
26c634af
TC
898 my $target = $field_map{$field} || $field;
899 ($order_values->{$target}) = $cgi->param($field);
a319d280 900 }
41e7c841 901 }
41e7c841 902
a319d280
TC
903 }
904 else {
905 $paymentType = -1;
41e7c841
TC
906 }
907
a319d280 908 $order_values->{paymentType} = $paymentType;
41e7c841 909 my @dbitems;
14604ada 910 my @products;
41e7c841 911 my %subscribing_to;
14604ada
TC
912 if ($order) {
913 @dbitems = $order->items;
914 @products = $order->products;
915 for my $product (@products) {
41e7c841 916 my $sub = $product->subscription;
14604ada
TC
917 if ($sub) {
918 $subscribing_to{$sub->{text_id}} = $sub;
58baa27b
TC
919 }
920 }
14604ada
TC
921 }
922 else {
923 $order_values->{filled} = 0;
924 $order_values->{paidFor} = 0;
925
926 my @items = $class->_build_items($req, \@products);
927
928 my @columns = BSE::TB::Order->columns;
929 my %columns;
930 @columns{@columns} = @columns;
931
932 for my $col (@columns) {
933 defined $order_values->{$col} or $order_values->{$col} = '';
41e7c841 934 }
14604ada
TC
935
936 my @data = @{$order_values}{@columns};
937 shift @data;
938
939 if ($session->{order_work}) {
940 $order = BSE::TB::Orders->getByPkey($session->{order_work});
941 }
942 if ($order && !$order->{complete}) {
943 print STDERR "Recycling order $order->{id}\n";
944
945 my @allbutid = @columns;
946 shift @allbutid;
947 @{$order}{@allbutid} = @data;
948
949 $order->clear_items;
950 delete $session->{order_work};
718a070d 951 eval {
14604ada 952 tied(%$session)->save;
718a070d
TC
953 };
954 }
14604ada
TC
955 else {
956 $order = BSE::TB::Orders->add(@data)
957 or die "Cannot add order";
958 }
959
960 my @item_cols = BSE::TB::OrderItem->columns;
961 for my $row_num (0..$#items) {
962 my $item = $items[$row_num];
963 my $product = $products[$row_num];
964 my %item = %$item;
965 $item{orderId} = $order->{id};
966 $item{max_lapsed} = 0;
967 if ($product->{subscription_id} != -1) {
968 my $sub = $product->subscription;
969 $item{max_lapsed} = $sub->{max_lapsed} if $sub;
970 }
971 defined $item{session_id} or $item{session_id} = 0;
972 $item{options} = ""; # not used for new orders
973 my @data = @item{@item_cols};
974 shift @data;
975 my $dbitem = BSE::TB::OrderItems->add(@data);
976 push @dbitems, $dbitem;
977
978 if ($item->{options} and @{$item->{options}}) {
979 require BSE::TB::OrderItemOptions;
980 my @option_descs = $product->option_descs($cfg, $item->{options});
981 my $display_order = 1;
982 for my $option (@option_descs) {
983 BSE::TB::OrderItemOptions->make
984 (
985 order_item_id => $dbitem->{id},
986 original_id => $option->{id},
987 name => $option->{desc},
988 value => $option->{value},
989 display => $option->{display},
990 display_order => $display_order++,
991 );
992 }
993 }
994
995 my $sub = $product->subscription;
996 if ($sub) {
997 $subscribing_to{$sub->{text_id}} = $sub;
998 }
999
1000 if ($item->{session_id}) {
1001 require BSE::TB::SeminarSessions;
1002 my $session = BSE::TB::SeminarSessions->getByPkey($item->{session_id});
1003 my $options = join(",", @{$item->{options}});
1004 eval {
1005 $session->add_attendee($user,
1006 instructions => $order->{instructions},
1007 options => $options);
1008 };
1009 }
1010 }
41e7c841 1011 }
5d88571c
TC
1012
1013 $order->{ccOnline} = 0;
41e7c841
TC
1014
1015 my $ccprocessor = $cfg->entry('shop', 'cardprocessor');
d19b7b5c 1016 if ($paymentType == PAYMENT_CC) {
41e7c841
TC
1017 my $ccNumber = $cgi->param('cardNumber');
1018 my $ccExpiry = $cgi->param('cardExpiry');
d19b7b5c
TC
1019
1020 if ($ccprocessor) {
1021 my $cc_class = credit_card_class($cfg);
1022
1023 $order->{ccOnline} = 1;
1024
1025 $ccExpiry =~ m!^(\d+)\D(\d+)$! or die;
1026 my ($month, $year) = ($1, $2);
1027 $year > 2000 or $year += 2000;
1028 my $expiry = sprintf("%04d%02d", $year, $month);
1029 my $verify = $cgi->param('cardVerify');
1030 defined $verify or $verify = '';
1031 my $result = $cc_class->payment(orderno=>$order->{id},
1032 amount => $order->{total},
1033 cardnumber => $ccNumber,
1034 expirydate => $expiry,
1035 cvv => $verify,
1036 ipaddress => $ENV{REMOTE_ADDR});
1037 unless ($result->{success}) {
1038 use Data::Dumper;
1039 print STDERR Dumper($result);
1040 # failed, back to payments
1041 $order->{ccSuccess} = 0;
1042 $order->{ccStatus} = $result->{statuscode};
1043 $order->{ccStatus2} = 0;
1044 $order->{ccStatusText} = $result->{error};
1045 $order->{ccTranId} = '';
1046 $order->save;
1047 my %errors;
1048 $errors{cardNumber} = $result->{error};
1049 $session->{order_work} = $order->{id};
1050 return $class->req_show_payment($req, \%errors);
1051 }
1052
1053 $order->{ccSuccess} = 1;
1054 $order->{ccReceipt} = $result->{receipt};
1055 $order->{ccStatus} = 0;
1056 $order->{ccStatus2} = 0;
1057 $order->{ccStatusText} = '';
1058 $order->{ccTranId} = $result->{transactionid};
1059 defined $order->{ccTranId} or $order->{ccTranId} = '';
1060 $order->{paidFor} = 1;
1061 }
1062 else {
1063 $ccNumber =~ tr/0-9//cd;
1064 $order->{ccNumberHash} = md5_hex($ccNumber);
1065 $order->{ccExpiryHash} = md5_hex($ccExpiry);
41e7c841 1066 }
41e7c841
TC
1067 }
1068
5d88571c
TC
1069 # order complete
1070 $order->{complete} = 1;
1071 $order->save;
1072
14604ada
TC
1073 my $custom = custom_class($req->cfg);
1074 $custom->can("order_complete")
1075 and $custom->order_complete($req->cfg, $order);
1076
41e7c841
TC
1077 # set the order displayed by orderdone
1078 $session->{order_completed} = $order->{id};
1079 $session->{order_completed_at} = time;
1080
1081 my $noencrypt = $cfg->entryBool('shop', 'noencrypt', 0);
1082 $class->_send_order($req, $order, \@dbitems, \@products, $noencrypt,
1083 \%subscribing_to);
1084
1085 # empty the cart ready for the next order
1086 delete @{$session}{qw/order_info order_info_confirmed cart order_work/};
1087
796809d1 1088 return BSE::Template->get_refresh($req->user_url(shop => 'orderdone'), $req->cfg);
41e7c841
TC
1089}
1090
1091sub req_orderdone {
1092 my ($class, $req) = @_;
1093
1094 my $session = $req->session;
1095 my $cfg = $req->cfg;
1096
1097 my $id = $session->{order_completed};
1098 my $when = $session->{order_completed_at};
1099 $id && defined $when && time < $when + 500
1100 or return $class->req_cart($req);
1101
1102 my $order = BSE::TB::Orders->getByPkey($id)
1103 or return $class->req_cart($req);
1104 my @items = $order->items;
41e7c841
TC
1105 my @products = map { Products->getByPkey($_->{productId}) } @items;
1106
2c9b9618
TC
1107 my @item_cols = BSE::TB::OrderItem->columns;
1108 my %copy_cols = map { $_ => 1 } Product->columns;
1109 delete @copy_cols{@item_cols};
1110 my @copy_cols = keys %copy_cols;
1111 my @showitems;
1112 for my $item_index (0..$#items) {
1113 my $item = $items[$item_index];
1114 my $product = $products[$item_index];
1115 my %entry;
1116 @entry{@item_cols} = @{$item}{@item_cols};
1117 @entry{@copy_cols} = @{$product}{@copy_cols};
1118
1119 push @showitems, \%entry;
1120 }
1121
41e7c841
TC
1122 my $cust_class = custom_class($req->cfg);
1123
1124 my @pay_types = payment_types($cfg);
1125 my @payment_types = map $_->{id}, grep $_->{enabled}, @pay_types;
1126 my %pay_types = map { $_->{id} => $_ } @pay_types;
1127 my %types_by_name = map { $_->{name} => $_->{id} } @pay_types;
1128
1129 my $item_index = -1;
1130 my @options;
1131 my $option_index;
718a070d
TC
1132 my $item;
1133 my $product;
1134 my $sem_session;
1135 my $location;
41e7c841
TC
1136 my %acts;
1137 %acts =
1138 (
a319d280 1139 $req->dyn_user_tags(),
41e7c841
TC
1140 $cust_class->purchase_actions(\%acts, \@items, \@products,
1141 $session->{custom}, $cfg),
1142 BSE::Util::Tags->static(\%acts, $cfg),
1143 iterate_items_reset => sub { $item_index = -1; },
1144 iterate_items =>
1145 sub {
1146 if (++$item_index < @items) {
1147 $option_index = -1;
58baa27b 1148 @options = order_item_opts($req, $items[$item_index]);
718a070d
TC
1149 undef $sem_session;
1150 undef $location;
1151 $item = $items[$item_index];
1152 $product = $products[$item_index];
41e7c841
TC
1153 return 1;
1154 }
718a070d
TC
1155 undef $item;
1156 undef $sem_session;
1157 undef $product;
1158 undef $location;
41e7c841
TC
1159 return 0;
1160 },
2c9b9618 1161 item=> sub { escape_html($showitems[$item_index]{$_[0]}); },
41e7c841
TC
1162 product =>
1163 sub {
1164 my $value = $products[$item_index]{$_[0]};
1165 defined $value or $value = '';
1166
1167 escape_html($value);
1168 },
1169 extended =>
1170 sub {
1171 my $what = $_[0] || 'retailPrice';
1172 $items[$item_index]{units} * $items[$item_index]{$what};
1173 },
1174 order => sub { escape_html($order->{$_[0]}) },
41e7c841
TC
1175 _format =>
1176 sub {
1177 my ($value, $fmt) = @_;
1178 if ($fmt =~ /^m(\d+)/) {
1179 return sprintf("%$1s", sprintf("%.2f", $value/100));
1180 }
1181 elsif ($fmt =~ /%/) {
1182 return sprintf($fmt, $value);
1183 }
1184 },
1185 iterate_options_reset => sub { $option_index = -1 },
1186 iterate_options => sub { ++$option_index < @options },
1187 option => sub { escape_html($options[$option_index]{$_[0]}) },
1188 ifOptions => sub { @options },
1189 options => sub { nice_options(@options) },
1190 ifPayment => [ \&tag_ifPayment, $order->{paymentType}, \%types_by_name ],
1191 #ifSubscribingTo => [ \&tag_ifSubscribingTo, \%subscribing_to ],
718a070d
TC
1192 session => [ \&tag_session, \$item, \$sem_session ],
1193 location => [ \&tag_location, \$item, \$location ],
74b21f6d 1194 msg => '',
3dbe6502 1195 delivery_in => $order->{delivery_in},
d8674b8b
AMS
1196 shipping_cost => $order->{shipping_cost},
1197 shipping_method => $order->{shipping_method},
41e7c841
TC
1198 );
1199 for my $type (@pay_types) {
1200 my $id = $type->{id};
1201 my $name = $type->{name};
1202 $acts{"if${name}Payment"} = $order->{paymentType} == $id;
1203 }
1204
1205 return $req->response('checkoutfinal', \%acts);
1206}
1207
718a070d
TC
1208sub tag_session {
1209 my ($ritem, $rsession, $arg) = @_;
1210
1211 $$ritem or return '';
1212
1213 $$ritem->{session_id} or return '';
1214
1215 unless ($$rsession) {
1216 require BSE::TB::SeminarSessions;
1217 $$rsession = BSE::TB::SeminarSessions->getByPkey($$ritem->{session_id})
1218 or return '';
1219 }
1220
1221 my $value = $$rsession->{$arg};
1222 defined $value or return '';
1223
1224 escape_html($value);
1225}
1226
1227sub tag_location {
1228 my ($ritem, $rlocation, $arg) = @_;
1229
1230 $$ritem or return '';
1231
1232 $$ritem->{session_id} or return '';
1233
1234 unless ($$rlocation) {
1235 require BSE::TB::Locations;
1236 ($$rlocation) = BSE::TB::Locations->getSpecial(session_id => $$ritem->{session_id})
1237 or return '';
1238 }
1239
1240 my $value = $$rlocation->{$arg};
1241 defined $value or return '';
1242
1243 escape_html($value);
1244}
1245
41e7c841
TC
1246sub tag_ifPayment {
1247 my ($payment, $types_by_name, $args) = @_;
1248
1249 my $type = $args;
1250 if ($type !~ /^\d+$/) {
1251 return '' unless exists $types_by_name->{$type};
1252 $type = $types_by_name->{$type};
1253 }
1254
1255 return $payment == $type;
1256}
1257
1258
1259sub _validate_cfg {
1260 my ($class, $req, $rmsg) = @_;
1261
1262 my $cfg = $req->cfg;
1263 my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1264 unless ($from && $from =~ /.\@./) {
1265 $$rmsg = "Configuration error: shop from address not set";
1266 return;
1267 }
1268 my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1269 unless ($toEmail && $toEmail =~ /.\@./) {
1270 $$rmsg = "Configuration error: shop to_email address not set";
1271 return;
1272 }
1273
1274 return 1;
1275}
1276
41e7c841
TC
1277sub req_recalc {
1278 my ($class, $req) = @_;
2c9b9618 1279
41e7c841
TC
1280 $class->update_quantities($req);
1281 $req->session->{order_info_confirmed} = 0;
1282 return $class->req_cart($req);
1283}
1284
1285sub req_recalculate {
1286 my ($class, $req) = @_;
1287
1288 return $class->req_recalc($req);
1289}
1290
1291sub _send_order {
1292 my ($class, $req, $order, $items, $products, $noencrypt,
1293 $subscribing_to) = @_;
1294
1295 my $cfg = $req->cfg;
1296 my $cgi = $req->cgi;
1297
26c634af
TC
1298 my $crypto_class = $cfg->entry('shop', 'crypt_module',
1299 $Constants::SHOP_CRYPTO);
1300 my $signing_id = $cfg->entry('shop', 'crypt_signing_id',
1301 $Constants::SHOP_SIGNING_ID);
1302 my $pgp = $cfg->entry('shop', 'crypt_pgp', $Constants::SHOP_PGP);
1303 my $pgpe = $cfg->entry('shop', 'crypt_pgpe', $Constants::SHOP_PGPE);
1304 my $gpg = $cfg->entry('shop', 'crypt_gpg', $Constants::SHOP_GPG);
1305 my $passphrase = $cfg->entry('shop', 'crypt_passphrase',
1306 $Constants::SHOP_PASSPHRASE);
41e7c841
TC
1307 my $from = $cfg->entry('shop', 'from', $Constants::SHOP_FROM);
1308 my $toName = $cfg->entry('shop', 'to_name', $Constants::SHOP_TO_NAME);
1309 my $toEmail = $cfg->entry('shop', 'to_email', $Constants::SHOP_TO_EMAIL);
1310 my $subject = $cfg->entry('shop', 'subject', $Constants::SHOP_MAIL_SUBJECT);
1311
1312 my $session = $req->session;
1313 my %extras = $cfg->entriesCS('extra tags');
1314 for my $key (keys %extras) {
1315 # follow any links
1316 my $data = $cfg->entryVar('extra tags', $key);
1317 $extras{$key} = sub { $data };
1318 }
1319
1320 my $item_index = -1;
1321 my @options;
1322 my $option_index;
1323 my %acts;
1324 %acts =
1325 (
1326 %extras,
1327 custom_class($cfg)
1328 ->order_mail_actions(\%acts, $order, $items, $products,
1329 $session->{custom}, $cfg),
1330 BSE::Util::Tags->static(\%acts, $cfg),
1331 iterate_items_reset => sub { $item_index = -1; },
1332 iterate_items =>
1333 sub {
1334 if (++$item_index < @$items) {
1335 $option_index = -1;
58baa27b
TC
1336 @options = order_item_opts($req,
1337 $items->[$item_index],
1338 $products->[$item_index]);
41e7c841
TC
1339 return 1;
1340 }
1341 return 0;
1342 },
1343 item=> sub { $items->[$item_index]{$_[0]}; },
1344 product =>
1345 sub {
1346 my $value = $products->[$item_index]{$_[0]};
1347 defined($value) or $value = '';
1348 $value;
1349 },
1350 order => sub { $order->{$_[0]} },
1351 extended =>
1352 sub {
1353 $items->[$item_index]{units} * $items->[$item_index]{$_[0]};
1354 },
1355 _format =>
1356 sub {
1357 my ($value, $fmt) = @_;
1358 if ($fmt =~ /^m(\d+)/) {
1359 return sprintf("%$1s", sprintf("%.2f", $value/100));
1360 }
1361 elsif ($fmt =~ /%/) {
1362 return sprintf($fmt, $value);
1363 }
1364 elsif ($fmt =~ /^\d+$/) {
1365 return substr($value . (" " x $fmt), 0, $fmt);
1366 }
1367 else {
1368 return $value;
1369 }
1370 },
1371 iterate_options_reset => sub { $option_index = -1 },
1372 iterate_options => sub { ++$option_index < @options },
1373 option => sub { escape_html($options[$option_index]{$_[0]}) },
1374 ifOptions => sub { @options },
1375 options => sub { nice_options(@options) },
1376 with_wrap => \&tag_with_wrap,
1377 ifSubscribingTo => [ \&tag_ifSubscribingTo, $subscribing_to ],
1378 );
1379
1380 my $mailer = BSE::Mail->new(cfg=>$cfg);
1381 # ok, send some email
1382 my $confirm = BSE::Template->get_page('mailconfirm', $cfg, \%acts);
1383 my $email_order = $cfg->entryBool('shop', 'email_order', $Constants::SHOP_EMAIL_ORDER);
1384 if ($email_order) {
1385 unless ($noencrypt) {
1386 $acts{cardNumber} = $cgi->param('cardNumber');
1387 $acts{cardExpiry} = $cgi->param('cardExpiry');
6fa347b0 1388 $acts{cardVerify} = $cgi->param('cardVerify');
41e7c841
TC
1389 }
1390 my $ordertext = BSE::Template->get_page('mailorder', $cfg, \%acts);
1391
1392 my $send_text;
1393 if ($noencrypt) {
1394 $send_text = $ordertext;
1395 }
1396 else {
1397 eval "use $crypto_class";
1398 !$@ or die $@;
1399 my $encrypter = $crypto_class->new;
1400
1401 my $debug = $cfg->entryBool('debug', 'mail_encryption', 0);
1402 my $sign = $cfg->entryBool('basic', 'sign', 1);
1403
1404 # encrypt and sign
1405 my %opts =
1406 (
1407 sign=> $sign,
1408 passphrase=> $passphrase,
1409 stripwarn=>1,
8062fbd7 1410 fastcgi => $req->is_fastcgi,
41e7c841
TC
1411 debug=>$debug,
1412 );
1413
1414 $opts{secretkeyid} = $signing_id if $signing_id;
1415 $opts{pgp} = $pgp if $pgp;
1416 $opts{gpg} = $gpg if $gpg;
1417 $opts{pgpe} = $pgpe if $pgpe;
6773470a 1418 my $recip = "$toName $toEmail";
41e7c841 1419
8062fbd7
TC
1420 unless ($send_text = $encrypter->encrypt($recip, $ordertext, %opts )) {
1421 print STDERR "Cannot encrypt email: ", $encrypter->error;
1422 exit 1;
1423 }
41e7c841
TC
1424 }
1425 $mailer->send(to=>$toEmail, from=>$from, subject=>'New Order '.$order->{id},
1426 body=>$send_text)
1427 or print STDERR "Error sending order to admin: ",$mailer->errstr,"\n";
1428 }
1429 $mailer->send(to=>$order->{emailAddress}, from=>$from,
1430 subject=>$subject . " " . localtime,
1431 body=>$confirm)
1432 or print STDERR "Error sending order to customer: ",$mailer->errstr,"\n";
1433}
1434
1435sub tag_with_wrap {
1436 my ($args, $text) = @_;
1437
1438 my $margin = $args =~ /^\d+$/ && $args > 30 ? $args : 70;
1439
1440 require Text::Wrap;
1441 # do it twice to prevent a warning
1442 $Text::Wrap::columns = $margin;
1443 $Text::Wrap::columns = $margin;
1444
1445 return Text::Wrap::fill('', '', split /\n/, $text);
1446}
1447
1448sub _refresh_logon {
14604ada 1449 my ($class, $req, $msg, $msgid, $r, $parms) = @_;
41e7c841
TC
1450
1451 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
1452 my $url = $securlbase."/cgi-bin/user.pl";
14604ada
TC
1453 $parms ||= { checkout => 1 };
1454
1455 unless ($r) {
1456 $r = $securlbase."/cgi-bin/shop.pl?"
1457 . join("&", map "$_=" . escape_uri($parms->{$_}), keys %$parms);
1458 }
41e7c841 1459
41e7c841 1460 my %parms;
a53374d2
TC
1461 if ($req->cfg->entry('shop registration', 'all')
1462 || $req->cfg->entry('shop registration', $msgid)) {
1463 $parms{show_register} = 1;
1464 }
41e7c841 1465 $parms{r} = $r;
a53374d2
TC
1466 if ($msgid) {
1467 $msg = $req->cfg->entry('messages', $msgid, $msg);
1468 }
41e7c841
TC
1469 $parms{message} = $msg if $msg;
1470 $parms{mid} = $msgid if $msgid;
1471 $url .= "?" . join("&", map "$_=".escape_uri($parms{$_}), keys %parms);
1472
1473 return BSE::Template->get_refresh($url, $req->cfg);
1474}
1475
1476sub _need_logon {
1477 my ($class, $req, $cart, $cart_prods) = @_;
1478
1479 return need_logon($req->cfg, $cart, $cart_prods, $req->session, $req->cgi);
1480}
1481
1482sub tag_checkedPayment {
1483 my ($payment, $types_by_name, $args) = @_;
1484
1485 my $type = $args;
1486 if ($type !~ /^\d+$/) {
1487 return '' unless exists $types_by_name->{$type};
1488 $type = $types_by_name->{$type};
1489 }
1490
1491 return $payment == $type ? 'checked="checked"' : '';
1492}
1493
1494sub tag_ifPayments {
1495 my ($enabled, $types_by_name, $args) = @_;
1496
1497 my $type = $args;
1498 if ($type !~ /^\d+$/) {
1499 return '' unless exists $types_by_name->{$type};
1500 $type = $types_by_name->{$type};
1501 }
1502
1503 my @found = grep $_ == $type, @$enabled;
1504
1505 return scalar @found;
1506}
1507
1508sub update_quantities {
1509 my ($class, $req) = @_;
1510
1511 my $session = $req->session;
1512 my $cgi = $req->cgi;
1513 my $cfg = $req->cfg;
1514 my @cart = @{$session->{cart} || []};
1515 for my $index (0..$#cart) {
1516 my $new_quantity = $cgi->param("quantity_$index");
1517 if (defined $new_quantity) {
1518 if ($new_quantity =~ /^\s*(\d+)/) {
1519 $cart[$index]{units} = $1;
1520 }
1521 elsif ($new_quantity =~ /^\s*$/) {
1522 $cart[$index]{units} = 0;
1523 }
1524 }
1525 }
1526 @cart = grep { $_->{units} != 0 } @cart;
1527 $session->{cart} = \@cart;
1528 $session->{custom} ||= {};
1529 my %custom_state = %{$session->{custom}};
1530 custom_class($cfg)->recalc($cgi, \@cart, [], \%custom_state, $cfg);
1531 $session->{custom} = \%custom_state;
1532}
1533
1534sub _build_items {
1535 my ($class, $req, $products) = @_;
1536
1537 my $session = $req->session;
1538 $session->{cart}
1539 or return;
1540 my @msgs;
1541 my @cart = @{$req->session->{cart}}
1542 or return;
1543 my @items;
1544 my @prodcols = Product->columns;
1545 my @newcart;
1546 my $today = now_sqldate();
1547 for my $item (@cart) {
1548 my %work = %$item;
1549 my $product = Products->getByPkey($item->{productId});
1550 if ($product) {
1551 (my $comp_release = $product->{release}) =~ s/ .*//;
1552 (my $comp_expire = $product->{expire}) =~ s/ .*//;
1553 $comp_release le $today
1554 or do { push @msgs, "'$product->{title}' has not been released yet";
1555 next; };
1556 $today le $comp_expire
1557 or do { push @msgs, "'$product->{title}' has expired"; next; };
1558 $product->{listed}
1559 or do { push @msgs, "'$product->{title}' not available"; next; };
1560
1561 for my $col (@prodcols) {
1562 $work{$col} = $product->{$col} unless exists $work{$col};
1563 }
1564 $work{extended_retailPrice} = $work{units} * $work{retailPrice};
1565 $work{extended_gst} = $work{units} * $work{gst};
1566 $work{extended_wholesale} = $work{units} * $work{wholesalePrice};
1567
1568 push @newcart, \%work;
1569 push @$products, $product;
1570 }
1571 }
1572
1573 # we don't use these for anything for now
1574 #if (@msgs) {
1575 # @$rmsg = @msgs;
1576 #}
1577
1578 return @newcart;
1579}
1580
1581sub _fillout_order {
4f1242d7 1582 my ($class, $req, $values, $items, $products, $rmsg, $how) = @_;
41e7c841
TC
1583
1584 my $session = $req->session;
1585 my $cfg = $req->cfg;
1586 my $cgi = $req->cgi;
1587
1588 my $total = 0;
1589 my $total_gst = 0;
1590 my $total_wholesale = 0;
1591 for my $item (@$items) {
1592 $total += $item->{extended_retailPrice};
1593 $total_gst += $item->{extended_gst};
1594 $total_wholesale += $item->{extended_wholesale};
1595 }
1596 $values->{total} = $total;
1597 $values->{gst} = $total_gst;
1598 $values->{wholesale} = $total_wholesale;
53107448 1599
cb351412
TC
1600 my $prompt_ship = $cfg->entry("shop", "shipping", 0);
1601 if ($prompt_ship) {
4a29dc8f 1602 my ($courier) = BSE::Shipping->get_couriers($cfg, $cgi->param("shipping_name"));
cadb5bfa 1603 my $country_code = bse_country_code($values->{delivCountry});
cb351412 1604 if ($courier) {
cadb5bfa 1605 unless ($courier->can_deliver(country => $country_code,
4a29dc8f
TC
1606 suburb => $values->{delivSuburb},
1607 postcode => $values->{delivPostCode})) {
cb351412
TC
1608 $cgi->param("courier", undef);
1609 $$rmsg =
1610 "Can't use the selected courier ".
53107448 1611 "(". $courier->description(). ") for this order.";
cb351412 1612 return;
53107448 1613 }
4a29dc8f
TC
1614 my @parcels = BSE::Shipping->package_order($cfg, $values, $items);
1615 my $cost = $courier->calculate_shipping
1616 (
1617 parcels => \@parcels,
cadb5bfa 1618 country => $country_code,
4a29dc8f 1619 suburb => $values->{delivSuburb},
4f1242d7
TC
1620 postcode => $values->{delivPostCode},
1621 products => $products,
1622 items => $items,
4a29dc8f 1623 );
6dbf8d1f 1624 if (!$cost and $courier->name() ne 'contact') {
cb351412
TC
1625 my $err = $courier->error_message();
1626 $$rmsg = "Error calculating shipping cost";
1627 $$rmsg .= ": $err" if $err;
1628 return;
53107448 1629 }
d8674b8b 1630 $values->{shipping_method} = $courier->description();
d9803c26 1631 $values->{shipping_name} = $courier->name;
53107448 1632 $values->{shipping_cost} = $cost;
cb351412 1633 $values->{shipping_trace} = $courier->trace;
3dbe6502 1634 $values->{delivery_in} = $courier->delivery_in();
53107448 1635 $values->{total} += $values->{shipping_cost};
cb351412
TC
1636 }
1637 else {
53107448
AMS
1638 # XXX: What to do?
1639 $$rmsg = "Error: no usable courier found.";
1640 return;
cb351412 1641 }
53107448 1642 }
41e7c841
TC
1643
1644 my $cust_class = custom_class($cfg);
1645
41e7c841 1646 eval {
74b21f6d 1647 local $SIG{__DIE__};
41e7c841
TC
1648 my %custom = %{$session->{custom}};
1649 $cust_class->order_save($cgi, $values, $items, $items,
1650 \%custom, $cfg);
1651 $session->{custom} = \%custom;
1652 };
1653 if ($@) {
1654 $$rmsg = $@;
1655 return;
1656 }
1657
1658 $values->{total} +=
1659 $cust_class->total_extras($items, $items,
1660 $session->{custom}, $cfg, $how);
1661
1662 my $affiliate_code = $session->{affiliate_code};
1663 defined $affiliate_code && length $affiliate_code
1664 or $affiliate_code = $cgi->param('affiliate_code');
1665 defined $affiliate_code or $affiliate_code = '';
1666 $values->{affiliate_code} = $affiliate_code;
1667
1668 my $user = $req->siteuser;
1669 if ($user) {
1670 $values->{userId} = $user->{userId};
1671 $values->{siteuser_id} = $user->{id};
1672 }
1673 else {
1674 $values->{userId} = '';
1675 $values->{siteuser_id} = -1;
1676 }
1677
1678 $values->{orderDate} = now_sqldatetime;
1679
1680 # this should be hard to guess
1681 $values->{randomId} ||= md5_hex(time().rand().{}.$$);
1682
1683 return 1;
1684}
1685
1686sub action_prefix { '' }
1687
718a070d
TC
1688sub req_location {
1689 my ($class, $req) = @_;
1690
1691 require BSE::TB::Locations;
1692 my $cgi = $req->cgi;
1693 my $location_id = $cgi->param('location_id');
1694 my $location;
b2ea108d 1695 if (defined $location_id && $location_id =~ /^\d+$/) {
718a070d
TC
1696 $location = BSE::TB::Locations->getByPkey($location_id);
1697 my %acts;
1698 %acts =
1699 (
1700 BSE::Util::Tags->static(\%acts, $req->cfg),
1701 location => [ \&tag_hash, $location ],
1702 );
1703
1704 return $req->response('location', \%acts);
1705 }
1706 else {
1707 return
1708 {
1709 type=>BSE::Template->get_type($req->cfg, 'error'),
1710 content=>"Missing or invalid location_id",
1711 };
1712 }
1713}
1714
7b5ef271 1715sub _validate_add_by_id {
788f3852
TC
1716 my ($class, $req, $addid, $quantity, $error, $refresh_logon) = @_;
1717
1718 my $product;
1719 if ($addid) {
1720 $product = BSE::TB::Seminars->getByPkey($addid);
1721 $product ||= Products->getByPkey($addid);
1722 }
1723 unless ($product) {
1724 $$error = "Cannot find product $addid";
1725 return;
1726 }
1727
7b5ef271
TC
1728 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1729}
1730
1731sub _validate_add_by_code {
1732 my ($class, $req, $code, $quantity, $error, $refresh_logon) = @_;
1733
1734 my $product;
1735 if (defined $code) {
1736 $product = BSE::TB::Seminars->getBy(product_code => $code);
1737 $product ||= Products->getBy(product_code => $code);
1738 }
1739 unless ($product) {
1740 $$error = "Cannot find product code $code";
1741 return;
1742 }
1743
1744 return $class->_validate_add($req, $product, $quantity, $error, $refresh_logon);
1745}
1746
1747sub _validate_add {
1748 my ($class, $req, $product, $quantity, $error, $refresh_logon) = @_;
1749
788f3852
TC
1750 # collect the product options
1751 my @options;
58baa27b
TC
1752 my @option_descs = $product->option_descs($req->cfg);
1753 my @option_names = map $_->{name}, @option_descs;
788f3852
TC
1754 my @not_def;
1755 my $cgi = $req->cgi;
58baa27b 1756 for my $name (@option_names) {
788f3852
TC
1757 my $value = $cgi->param($name);
1758 push @options, $value;
1759 unless (defined $value) {
1760 push @not_def, $name;
1761 }
1762 }
1763 if (@not_def) {
1764 $$error = "Some product options (@not_def) not supplied";
1765 return;
1766 }
788f3852
TC
1767
1768 # the product must be non-expired and listed
1769 (my $comp_release = $product->{release}) =~ s/ .*//;
1770 (my $comp_expire = $product->{expire}) =~ s/ .*//;
1771 my $today = now_sqldate();
1772 unless ($comp_release le $today) {
1773 $$error = "Product $product->{title} has not been released yet";
1774 return;
1775 }
1776 unless ($today le $comp_expire) {
1777 $$error = "Product $product->{title} has expired";
1778 return;
1779 }
1780 unless ($product->{listed}) {
1781 $$error = "Product $product->{title} not available";
1782 return;
1783 }
1784
1785 # used to refresh if a logon is needed
1786 my $securlbase = $req->cfg->entryVar('site', 'secureurl');
7b5ef271 1787 my $r = $securlbase . $ENV{SCRIPT_NAME} . "?add=1&id=$product->{id}";
58baa27b
TC
1788 for my $opt_index (0..$#option_names) {
1789 $r .= "&$option_names[$opt_index]=".escape_uri($options[$opt_index]);
788f3852
TC
1790 }
1791
1792 my $user = $req->siteuser;
1793 # need to be logged on if it has any subs
1794 if ($product->{subscription_id} != -1) {
1795 if ($user) {
1796 my $sub = $product->subscription;
1797 if ($product->is_renew_sub_only) {
1798 unless ($user->subscribed_to_grace($sub)) {
1799 $$error = "The product $product->{title} can only be used to renew your subscription to $sub->{title} and you are not subscribed nor within the renewal grace period";
1800 return;
1801 }
1802 }
1803 elsif ($product->is_start_sub_only) {
1804 if ($user->subscribed_to_grace($sub)) {
1805 $$error = "The product $product->{title} can only be used to start your subscription to $sub->{title} and you are already subscribed or within the grace period";
1806 return;
1807 }
1808 }
1809 }
1810 else {
1811 $$refresh_logon =
1812 [ "You must be logged on to add this product to your cart",
1813 'prodlogon', $r ];
1814 return;
1815 }
1816 }
1817 if ($product->{subscription_required} != -1) {
1818 my $sub = $product->subscription_required;
1819 if ($user) {
1820 unless ($user->subscribed_to($sub)) {
1821 $$error = "You must be subscribed to $sub->{title} to purchase this product";
1822 return;
1823 }
1824 }
1825 else {
1826 # we want to refresh back to adding the item to the cart if possible
1827 $$refresh_logon =
1828 [ "You must be logged on and subscribed to $sub->{title} to add this product to your cart",
1829 'prodlogonsub', $r ];
1830 return;
1831 }
1832 }
1833
1834 # we need a natural integer quantity
7f344ccc 1835 unless ($quantity =~ /^\d+$/ && $quantity > 0) {
788f3852
TC
1836 $$error = "Invalid quantity";
1837 return;
1838 }
1839
1840 my %extras;
1841 if ($product->isa('BSE::TB::Seminar')) {
1842 # you must be logged on to add a seminar
1843 unless ($user) {
1844 $$refresh_logon =
1845 [ "You must be logged on to add seminars to your cart",
1846 'seminarlogon', $r ];
1847 return;
1848 }
1849
1850 # get and validate the session
1851 my $session_id = $cgi->param('session_id');
1852 unless (defined $session_id) {
1853 $$error = "Please select a session when adding a seminar";
1854 return;
1855 }
1856
1857 unless ($session_id =~ /^\d+$/) {
1858 $$error = "Invalid session_id supplied";
1859 return;
1860 }
1861
1862 require BSE::TB::SeminarSessions;
1863 my $session = BSE::TB::SeminarSessions->getByPkey($session_id);
1864 unless ($session) {
1865 $$error = "Unknown session id supplied";
1866 return;
1867 }
7b5ef271 1868 unless ($session->{seminar_id} == $product->{id}) {
788f3852
TC
1869 $$error = "Session not for this seminar";
1870 return;
1871 }
1872
1873 # check if the user is already booked for this session
7b5ef271 1874 if (grep($_ == $session_id, $user->seminar_sessions_booked($product->{id}))) {
788f3852
TC
1875 $$error = "You are already booked for this session";
1876 return;
1877 }
1878
1879 $extras{session_id} = $session_id;
1880 }
1881
58baa27b 1882 return ( $product, \@options, \%extras );
788f3852
TC
1883}
1884
a713d924
TC
1885sub _add_refresh {
1886 my ($refresh, $req, $started_empty) = @_;
1887
1888 my $cfg = $req->cfg;
53f53326
TC
1889 my $cookie_domain = $cfg->entry('basic', 'cookie_domain');
1890 if ($started_empty && !$cookie_domain) {
a713d924
TC
1891 my $base_url = $cfg->entryVar('site', 'url');
1892 my $secure_url = $cfg->entryVar('site', 'secureurl');
1893 if ($base_url ne $secure_url) {
1894 my $debug = $cfg->entryBool('debug', 'logon_cookies', 0);
1895
1896 # magical refresh time
1897 # which host are we on?
1898 # first get info about the 2 possible hosts
1899 my ($baseprot, $basehost, $baseport) =
1900 $base_url =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
1901 $baseport ||= $baseprot eq 'http' ? 80 : 443;
1902 print STDERR "Base: prot: $baseprot Host: $basehost Port: $baseport\n"
1903 if $debug;
1904
1905 #my ($secprot, $sechost, $secport) =
1906 # $securl =~ m!^(\w+)://([\w.-]+)(?::(\d+))?!;
1907
1908 my $onbase = 1;
1909 # get info about the current host
1910 my $port = $ENV{SERVER_PORT} || 80;
1911 my $ishttps = exists $ENV{HTTPS} || exists $ENV{SSL_CIPHER};
1912 print STDERR "\$ishttps: $ishttps\n" if $debug;
1913 my $protocol = $ishttps ? 'https' : 'http';
1914
24f4cfc0 1915 if (lc $ENV{SERVER_NAME} ne lc $basehost
a713d924
TC
1916 || lc $protocol ne $baseprot
1917 || $baseport != $port) {
1918 print STDERR "not on base host ('$ENV{SERVER_NAME}' cmp '$basehost' '$protocol cmp '$baseprot' $baseport cmp $port\n" if $debug;
1919 $onbase = 0;
1920 }
1921 my $url = $onbase ? $secure_url : $base_url;
1922 my $finalbase = $onbase ? $base_url : $secure_url;
1923 $refresh = $finalbase . $refresh unless $refresh =~ /^\w+:/;
1924 print STDERR "Heading to $url to setcookie\n" if $debug;
1925 $url .= "/cgi-bin/user.pl?setcookie=".$req->session->{_session_id};
1926 $url .= "&r=".CGI::escape($refresh);
1927 return BSE::Template->get_refresh($url, $cfg);
1928 }
1929 }
1930
1931 return BSE::Template->get_refresh($refresh, $cfg);
1932}
1933
58baa27b
TC
1934sub _same_options {
1935 my ($left, $right) = @_;
1936
1937 for my $index (0 .. $#$left) {
1938 my $left_value = $left->[$index];
1939 my $right_value = $right->[$index];
1940 defined $right_value
1941 or return;
1942 $left_value eq $right_value
1943 or return;
1944 }
1945
1946 return 1;
1947}
1948
41e7c841 19491;