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