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