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