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