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