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