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