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