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