added on local at 2026-07-01 22:09:31
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ShopCart - Checkout page + associated endpoints. | |
| 4 | # | |
| 5 | # Consolidates the former trio via SCRIPT_NAME dispatch: | |
| 6 | # checkout.cgi -- HTML checkout page (Stripe Elements) | |
| 7 | # checkout_intent.cgi -- POST JSON: creates PaymentIntent + order row | |
| 8 | # checkout_complete.cgi -- HTML post-purchase landing page | |
| 9 | # | |
| 10 | # Payment / callback contracts are preserved exactly. The webhook | |
| 11 | # still flips orders.status via /stripe_webhook.cgi on | |
| 12 | # `payment_intent.succeeded`. This file never modifies that path. | |
| 13 | #====================================================================== | |
| 14 | use strict; | |
| 15 | use warnings; | |
| 16 | ||
| 17 | use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com'; | |
| 18 | use CGI; | |
| 19 | use MODS::Template; | |
| 20 | use MODS::DBConnect; | |
| 21 | use MODS::ShopCart::Config; | |
| 22 | use MODS::ShopCart::Themes; | |
| 23 | use MODS::ShopCart::Cart; | |
| 24 | use MODS::ShopCart::BuyerAuth; | |
| 25 | ||
| 26 | $| = 1; | |
| 27 | ||
| 28 | my $q = CGI->new; | |
| 29 | my $form = $q->Vars; | |
| 30 | my $tfile = MODS::Template->new; | |
| 31 | my $db = MODS::DBConnect->new; | |
| 32 | my $config = MODS::ShopCart::Config->new; | |
| 33 | my $themes = MODS::ShopCart::Themes->new; | |
| 34 | my $cart = MODS::ShopCart::Cart->new; | |
| 35 | my $buyer_auth = MODS::ShopCart::BuyerAuth->new; | |
| 36 | my $DB = $config->settings('database_name'); | |
| 37 | ||
| 38 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'checkout'; | |
| 39 | ||
| 40 | if ($entry eq 'checkout_intent') { _co_intent(); exit; } | |
| 41 | elsif ($entry eq 'checkout_complete') { _co_complete(); exit; } | |
| 42 | else { _co_view(); exit; } | |
| 43 | ||
| 44 | #====================================================================== | |
| 45 | # checkout.cgi -- Stripe Elements page | |
| 46 | #====================================================================== | |
| 47 | sub _co_view { | |
| 48 | require MODS::ShopCart::Stripe; | |
| 49 | my $stripe = MODS::ShopCart::Stripe->new; | |
| 50 | ||
| 51 | my $sid = $form->{id} || $form->{storefront_id} || 0; | |
| 52 | $sid =~ s/[^0-9]//g; | |
| 53 | unless ($sid) { | |
| 54 | print "Status: 302 Found\nLocation: /\n\n"; | |
| 55 | return; | |
| 56 | } | |
| 57 | ||
| 58 | my $dbh = $db->db_connect(); | |
| 59 | my $store = $db->db_readwrite($dbh, | |
| 60 | qq~SELECT id, name, subdomain, theme_id, stripe_account_id, stripe_onboarded_at | |
| 61 | FROM `${DB}`.storefronts WHERE id='$sid' AND status='live' LIMIT 1~, | |
| 62 | $ENV{SCRIPT_NAME}, __LINE__); | |
| 63 | unless ($store && $store->{id}) { | |
| 64 | $db->db_disconnect($dbh); | |
| 65 | print "Status: 302 Found\nLocation: /\n\n"; | |
| 66 | return; | |
| 67 | } | |
| 68 | ||
| 69 | my $theme = $themes->by_id($store->{theme_id}); | |
| 70 | my $css_vars = $themes->css_vars($theme); | |
| 71 | ||
| 72 | my $token = $cart->read_token($q); | |
| 73 | my @rows = $cart->items($db, $dbh, $DB, $token, $sid); | |
| 74 | my $total = $cart->total_cents($db, $dbh, $DB, $token, $sid); | |
| 75 | ||
| 76 | my $needs_shipping = $cart->requires_shipping($db, $dbh, $DB, $token, $sid); | |
| 77 | ||
| 78 | my @ship_zones; | |
| 79 | my $ship_from_country = ''; | |
| 80 | if ($needs_shipping) { | |
| 81 | foreach my $r (@rows) { | |
| 82 | next unless ($r->{purchase_kind} || '') eq 'physical'; | |
| 83 | my $mid = $r->{model_id}; $mid =~ s/[^0-9]//g; | |
| 84 | next unless $mid; | |
| 85 | my $mr = $db->db_readwrite($dbh, qq~ | |
| 86 | SELECT shipping_options_json, ship_from_country | |
| 87 | FROM `${DB}`.models WHERE id='$mid' LIMIT 1 | |
| 88 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 89 | next unless $mr; | |
| 90 | $ship_from_country ||= $mr->{ship_from_country} || ''; | |
| 91 | my $raw = $mr->{shipping_options_json} || ''; | |
| 92 | foreach my $line (split /\r?\n/, $raw) { | |
| 93 | $line =~ s/^\s+|\s+$//g; | |
| 94 | next unless $line =~ /^([A-Za-z0-9_\-]{1,40})\s*=\s*(\d+)$/; | |
| 95 | push @ship_zones, { slug => $1, cents => $2 + 0 }; | |
| 96 | } | |
| 97 | last; | |
| 98 | } | |
| 99 | unless (@ship_zones) { | |
| 100 | @ship_zones = ({ slug => 'standard', cents => 0 }); | |
| 101 | } | |
| 102 | } | |
| 103 | ||
| 104 | my @ship_options; | |
| 105 | my $ship_idx = 0; | |
| 106 | foreach my $z (@ship_zones) { | |
| 107 | my $label = ucfirst($z->{slug}); | |
| 108 | $label =~ s/_/ /g; | |
| 109 | push @ship_options, { | |
| 110 | slug => $z->{slug}, | |
| 111 | cents => $z->{cents}, | |
| 112 | label => $label, | |
| 113 | cost_label=> $z->{cents} > 0 | |
| 114 | ? '$' . sprintf('%.2f', $z->{cents} / 100) | |
| 115 | : 'Free', | |
| 116 | is_first => ($ship_idx == 0) ? 1 : 0, | |
| 117 | checked_attr => ($ship_idx == 0) ? 'checked' : '', | |
| 118 | }; | |
| 119 | $ship_idx++; | |
| 120 | } | |
| 121 | ||
| 122 | my $buyer = $buyer_auth->verify($q, $db, $dbh, $DB); | |
| 123 | my $prefill_email = ($buyer && $buyer->{email}) ? $buyer->{email} : ''; | |
| 124 | ||
| 125 | $db->db_disconnect($dbh); | |
| 126 | ||
| 127 | my $platform_ready = $stripe->is_configured ? 1 : 0; | |
| 128 | my $seller_ready = ($store->{stripe_account_id} && $store->{stripe_onboarded_at}) ? 1 : 0; | |
| 129 | my $is_payable = ($platform_ready && $seller_ready && scalar(@rows) && $total > 0) ? 1 : 0; | |
| 130 | ||
| 131 | my @items; | |
| 132 | foreach my $r (@rows) { | |
| 133 | my $title = $r->{title} || ''; | |
| 134 | $title =~ s/&/&/g; $title =~ s/</</g; $title =~ s/>/>/g; $title =~ s/"/"/g; | |
| 135 | push @items, { | |
| 136 | title => $title, | |
| 137 | qty => $r->{quantity} || 1, | |
| 138 | line_total => '$' . sprintf('%.2f', ($r->{price_cents} || 0) * ($r->{quantity} || 1) / 100), | |
| 139 | }; | |
| 140 | } | |
| 141 | ||
| 142 | require MODS::ShopCart::StoreChrome; | |
| 143 | my $chrome_dbh = $db->db_connect(); | |
| 144 | my $chrome_html = MODS::ShopCart::StoreChrome->header_html({ | |
| 145 | store_id => $store->{id}, | |
| 146 | store_name => $store->{name} || $store->{subdomain}, | |
| 147 | is_buyer_in => ($prefill_email ? 1 : 0), | |
| 148 | cart_count => scalar(@rows), | |
| 149 | db => $db, | |
| 150 | dbh => $chrome_dbh, | |
| 151 | DB => $DB, | |
| 152 | }); | |
| 153 | $db->db_disconnect($chrome_dbh); | |
| 154 | ||
| 155 | my $tvars = { | |
| 156 | theme_css_vars => $css_vars, | |
| 157 | store_id => $store->{id}, | |
| 158 | store_name => $store->{name} || $store->{subdomain}, | |
| 159 | store_chrome_html => $chrome_html, | |
| 160 | item_count => scalar(@rows), | |
| 161 | has_items => scalar(@rows) ? 1 : 0, | |
| 162 | items => \@items, | |
| 163 | total_display => '$' . sprintf('%.2f', $total / 100), | |
| 164 | total_cents => $total, | |
| 165 | cart_href => "/cart.cgi?id=$sid", | |
| 166 | back_href => "/store.cgi?id=$sid", | |
| 167 | ||
| 168 | is_payable => $is_payable, | |
| 169 | not_payable => $is_payable ? 0 : 1, | |
| 170 | seller_not_ready => ($platform_ready && !$seller_ready) ? 1 : 0, | |
| 171 | platform_not_ready => $platform_ready ? 0 : 1, | |
| 172 | ||
| 173 | stripe_pk => $stripe->publishable_key, | |
| 174 | prefill_email => $prefill_email, | |
| 175 | ||
| 176 | needs_shipping => $needs_shipping, | |
| 177 | ship_options => \@ship_options, | |
| 178 | has_ship_options => $needs_shipping ? 1 : 0, | |
| 179 | ship_from_country => $ship_from_country, | |
| 180 | }; | |
| 181 | ||
| 182 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n"; | |
| 183 | print join('', $tfile->template('shopcart_checkout.html', $tvars, undef)); | |
| 184 | return; | |
| 185 | } | |
| 186 | ||
| 187 | #====================================================================== | |
| 188 | # checkout_complete.cgi -- post-purchase landing | |
| 189 | #====================================================================== | |
| 190 | sub _co_complete { | |
| 191 | require MODS::ShopCart::Tax; | |
| 192 | my $oid = $form->{order} || 0; | |
| 193 | $oid =~ s/[^0-9]//g; | |
| 194 | ||
| 195 | my $redirect_status = $form->{redirect_status} || ''; | |
| 196 | ||
| 197 | unless ($oid) { | |
| 198 | print "Status: 302 Found\nLocation: /\n\n"; | |
| 199 | return; | |
| 200 | } | |
| 201 | ||
| 202 | my $dbh = $db->db_connect(); | |
| 203 | ||
| 204 | my $order = $db->db_readwrite($dbh, qq~ | |
| 205 | SELECT o.id, o.storefront_id, o.status, o.buyer_email, | |
| 206 | o.total_amount_cents, o.subtotal_cents, o.tax_amount_cents, o.currency, | |
| 207 | s.name AS store_name, s.subdomain, s.theme_id | |
| 208 | FROM `${DB}`.orders o | |
| 209 | JOIN `${DB}`.storefronts s ON s.id = o.storefront_id | |
| 210 | WHERE o.id='$oid' LIMIT 1 | |
| 211 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 212 | ||
| 213 | unless ($order && $order->{id}) { | |
| 214 | $db->db_disconnect($dbh); | |
| 215 | print "Status: 302 Found\nLocation: /\n\n"; | |
| 216 | return; | |
| 217 | } | |
| 218 | ||
| 219 | my @items = $db->db_readwrite_multiple($dbh, qq~ | |
| 220 | SELECT oi.id, oi.price_paid_cents, oi.quantity, | |
| 221 | m.id AS model_id, m.title | |
| 222 | FROM `${DB}`.order_items oi | |
| 223 | JOIN `${DB}`.models m ON m.id = oi.model_id | |
| 224 | WHERE oi.order_id='$oid' | |
| 225 | ORDER BY oi.id | |
| 226 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 227 | ||
| 228 | if (($order->{status} || '') eq 'paid') { | |
| 229 | my $token = $cart->read_token($q); | |
| 230 | $cart->clear($db, $dbh, $DB, $token, $order->{storefront_id}) if $token; | |
| 231 | } | |
| 232 | ||
| 233 | my $theme = $themes->by_id($order->{theme_id}); | |
| 234 | my $css_vars = $themes->css_vars($theme); | |
| 235 | ||
| 236 | my $tax_summary = MODS::ShopCart::Tax->new->summary_for_order($db, $dbh, $DB, $oid); | |
| 237 | ||
| 238 | $db->db_disconnect($dbh); | |
| 239 | ||
| 240 | my $status = $order->{status} || 'pending'; | |
| 241 | ||
| 242 | my $is_paid = ($status eq 'paid') ? 1 : 0; | |
| 243 | my $is_failed = ($status eq 'failed') ? 1 : 0; | |
| 244 | my $is_pending = (!$is_paid && !$is_failed) ? 1 : 0; | |
| 245 | ||
| 246 | if (lc($redirect_status) eq 'failed') { | |
| 247 | $is_paid = 0; | |
| 248 | $is_pending = 0; | |
| 249 | $is_failed = 1; | |
| 250 | } | |
| 251 | ||
| 252 | my @item_rows; | |
| 253 | foreach my $it (@items) { | |
| 254 | my $title = $it->{title} || ('Model #' . $it->{model_id}); | |
| 255 | $title =~ s/&/&/g; $title =~ s/</</g; $title =~ s/>/>/g; $title =~ s/"/"/g; | |
| 256 | push @item_rows, { | |
| 257 | title => $title, | |
| 258 | qty => $it->{quantity} || 1, | |
| 259 | line_total => '$' . sprintf('%.2f', ($it->{price_paid_cents} || 0) * ($it->{quantity} || 1) / 100), | |
| 260 | download_url => $is_paid ? "/download.cgi?order=$oid&item=$it->{id}" : '', | |
| 261 | }; | |
| 262 | } | |
| 263 | ||
| 264 | my @tax_rows; | |
| 265 | foreach my $l (@$tax_summary) { | |
| 266 | push @tax_rows, { | |
| 267 | label => $l->{jurisdiction_label}, | |
| 268 | rate => sprintf('%.2f', $l->{rate_pct}), | |
| 269 | cents => '$' . sprintf('%.2f', ($l->{tax_amount_cents} || 0) / 100), | |
| 270 | }; | |
| 271 | } | |
| 272 | ||
| 273 | require MODS::ShopCart::StoreChrome; | |
| 274 | my $chrome_dbh = $db->db_connect(); | |
| 275 | my $chrome_html = MODS::ShopCart::StoreChrome->header_html({ | |
| 276 | store_id => $order->{storefront_id}, | |
| 277 | store_name => $order->{store_name} || $order->{subdomain}, | |
| 278 | is_buyer_in => ($order->{buyer_email} ? 1 : 0), | |
| 279 | cart_count => 0, | |
| 280 | db => $db, | |
| 281 | dbh => $chrome_dbh, | |
| 282 | DB => $DB, | |
| 283 | }); | |
| 284 | $db->db_disconnect($chrome_dbh); | |
| 285 | ||
| 286 | my $tvars = { | |
| 287 | theme_css_vars => $css_vars, | |
| 288 | order_id => $oid + 0, | |
| 289 | store_name => $order->{store_name} || $order->{subdomain}, | |
| 290 | store_id => $order->{storefront_id}, | |
| 291 | store_chrome_html => $chrome_html, | |
| 292 | buyer_email => $order->{buyer_email}, | |
| 293 | subtotal_display => '$' . sprintf('%.2f', ($order->{subtotal_cents} || 0) / 100), | |
| 294 | tax_display => '$' . sprintf('%.2f', ($order->{tax_amount_cents} || 0) / 100), | |
| 295 | has_tax => ($order->{tax_amount_cents} && $order->{tax_amount_cents} > 0) ? 1 : 0, | |
| 296 | tax_lines => \@tax_rows, | |
| 297 | total_display => '$' . sprintf('%.2f', ($order->{total_amount_cents} || 0) / 100), | |
| 298 | is_paid => $is_paid, | |
| 299 | is_pending => $is_pending, | |
| 300 | is_failed => $is_failed, | |
| 301 | items => \@item_rows, | |
| 302 | has_items => scalar(@item_rows) ? 1 : 0, | |
| 303 | back_href => "/store.cgi?id=$order->{storefront_id}", | |
| 304 | orders_href => "/my_orders.cgi?id=$order->{storefront_id}", | |
| 305 | }; | |
| 306 | ||
| 307 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n"; | |
| 308 | print join('', $tfile->template('shopcart_checkout_complete.html', $tvars, undef)); | |
| 309 | return; | |
| 310 | } | |
| 311 | ||
| 312 | #====================================================================== | |
| 313 | # checkout_intent.cgi -- PaymentIntent creator (JSON) | |
| 314 | #====================================================================== | |
| 315 | sub _co_intent { | |
| 316 | require JSON::PP; | |
| 317 | require MODS::ShopCart::Promotions; | |
| 318 | require MODS::ShopCart::Stripe; | |
| 319 | require MODS::ShopCart::Receipts; | |
| 320 | require MODS::ShopCart::Tax; | |
| 321 | require MODS::ShopCart::BuyerCredits; | |
| 322 | ||
| 323 | my $stripe = MODS::ShopCart::Stripe->new; | |
| 324 | my $tax = MODS::ShopCart::Tax->new; | |
| 325 | my $bc = MODS::ShopCart::BuyerCredits->new; | |
| 326 | my $cfg = $config; | |
| 327 | ||
| 328 | _co_json_out({ ok => 0, error => 'POST only' }, '405 Method Not Allowed') | |
| 329 | unless ($ENV{REQUEST_METHOD} || '') eq 'POST'; | |
| 330 | ||
| 331 | unless ($stripe->is_configured) { | |
| 332 | _co_json_out({ ok => 0, error => 'Payments are not configured yet.' }); | |
| 333 | } | |
| 334 | ||
| 335 | my $sid = $form->{storefront_id} || 0; | |
| 336 | $sid =~ s/[^0-9]//g; | |
| 337 | my $email = $form->{email} || ''; | |
| 338 | $email =~ s/^\s+|\s+$//g; | |
| 339 | $email = substr($email, 0, 191); | |
| 340 | ||
| 341 | _co_json_out({ ok => 0, error => 'Please enter a valid email.' }) | |
| 342 | unless $email =~ /\@/ && $email =~ /\./; | |
| 343 | _co_json_out({ ok => 0, error => 'Storefront not specified.' }) unless $sid; | |
| 344 | ||
| 345 | my $dbh = $db->db_connect(); | |
| 346 | ||
| 347 | my $store = $db->db_readwrite($dbh, qq~ | |
| 348 | SELECT id, stripe_account_id, stripe_onboarded_at | |
| 349 | FROM `${DB}`.storefronts | |
| 350 | WHERE id='$sid' AND status='live' LIMIT 1 | |
| 351 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 352 | unless ($store && $store->{stripe_account_id} && $store->{stripe_onboarded_at}) { | |
| 353 | $db->db_disconnect($dbh); | |
| 354 | _co_json_out({ ok => 0, error => "This storefront isn't accepting payments yet." }); | |
| 355 | } | |
| 356 | ||
| 357 | my $token = $cart->read_token($q); | |
| 358 | my @rows = $cart->items($db, $dbh, $DB, $token, $sid); | |
| 359 | my $subtotal = $cart->total_cents($db, $dbh, $DB, $token, $sid); | |
| 360 | ||
| 361 | unless (scalar(@rows) && $subtotal > 0) { | |
| 362 | $db->db_disconnect($dbh); | |
| 363 | _co_json_out({ ok => 0, error => 'Your cart is empty.' }); | |
| 364 | } | |
| 365 | ||
| 366 | my $promo_mod = MODS::ShopCart::Promotions->new; | |
| 367 | my $applied_promo = $promo_mod->cart_applied($db, $dbh, $DB, $token, $sid); | |
| 368 | my $discount_cents = 0; | |
| 369 | my $applied_promo_id = 0; | |
| 370 | my $applied_code_str = ''; | |
| 371 | if ($applied_promo) { | |
| 372 | my %v = $promo_mod->validate($db, $dbh, $DB, $applied_promo, | |
| 373 | kind => 'model', | |
| 374 | subtotal_cents => $subtotal, | |
| 375 | buyer_email => $email, | |
| 376 | new_customer => 1, | |
| 377 | ); | |
| 378 | if ($v{ok}) { | |
| 379 | $discount_cents = $promo_mod->apply_to_total_cents($applied_promo, $subtotal); | |
| 380 | $applied_promo_id = $applied_promo->{id}; | |
| 381 | $applied_code_str = $applied_promo->{code} || ''; | |
| 382 | } else { | |
| 383 | $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid); | |
| 384 | } | |
| 385 | } | |
| 386 | my $after_discount = $subtotal - $discount_cents; | |
| 387 | $after_discount = 0 if $after_discount < 0; | |
| 388 | ||
| 389 | my $bill_country = uc($form->{bill_country} || ''); $bill_country =~ s/[^A-Z]//g; | |
| 390 | my $bill_region = uc($form->{bill_region} || ''); $bill_region =~ s/[^A-Z0-9]//g; | |
| 391 | my $bill_vat_id = uc($form->{vat_id} || ''); $bill_vat_id =~ s/[^A-Z0-9]//g; | |
| 392 | $bill_country = substr($bill_country, 0, 2); | |
| 393 | $bill_region = substr($bill_region, 0, 10); | |
| 394 | $bill_vat_id = substr($bill_vat_id, 0, 20); | |
| 395 | ||
| 396 | my $reverse_charge = 0; | |
| 397 | my $vat_country = ''; | |
| 398 | if (length($bill_vat_id) >= 4) { | |
| 399 | my $vsafe = $bill_vat_id; $vsafe =~ s/'/''/g; | |
| 400 | my $vc = $db->db_readwrite($dbh, qq~ | |
| 401 | SELECT vat_country, is_valid, | |
| 402 | DATEDIFF(NOW(), validated_at) AS age | |
| 403 | FROM `${DB}`.buyer_tax_info | |
| 404 | WHERE vat_id='$vsafe' | |
| 405 | ORDER BY id DESC LIMIT 1 | |
| 406 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 407 | if ($vc && $vc->{is_valid} && defined $vc->{age} && $vc->{age} < 180) { | |
| 408 | $reverse_charge = 1; | |
| 409 | $vat_country = $vc->{vat_country}; | |
| 410 | } | |
| 411 | } | |
| 412 | ||
| 413 | my $dominant_kind = 'digital'; | |
| 414 | { | |
| 415 | my $has_physical = 0; | |
| 416 | foreach my $row (@rows) { | |
| 417 | my $mid = $row->{model_id} || 0; $mid =~ s/[^0-9]//g; | |
| 418 | next unless $mid; | |
| 419 | my $m = $db->db_readwrite($dbh, qq~ | |
| 420 | SELECT product_kind FROM `${DB}`.models WHERE id='$mid' LIMIT 1 | |
| 421 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 422 | if ($m && $m->{product_kind} && $m->{product_kind} ne 'digital') { | |
| 423 | $has_physical = 1; last; | |
| 424 | } | |
| 425 | } | |
| 426 | $dominant_kind = $has_physical ? 'physical' : 'digital'; | |
| 427 | } | |
| 428 | ||
| 429 | my @tax_lines; | |
| 430 | my $tax_total = 0; | |
| 431 | if (length $bill_country == 2 && $after_discount > 0) { | |
| 432 | @tax_lines = $tax->calc_tax_lines( | |
| 433 | db => $db, | |
| 434 | dbh => $dbh, | |
| 435 | DB => $DB, | |
| 436 | storefront_id => $sid, | |
| 437 | country_iso2 => $bill_country, | |
| 438 | region_code => $bill_region, | |
| 439 | product_kind => $dominant_kind, | |
| 440 | taxable_amount_cents => $after_discount, | |
| 441 | reverse_charge => $reverse_charge, | |
| 442 | buyer_vat_id => $reverse_charge ? $bill_vat_id : '', | |
| 443 | buyer_vat_country => $reverse_charge ? $vat_country : '', | |
| 444 | evidence => { | |
| 445 | buyer_country_billing => $bill_country, | |
| 446 | buyer_country_ip => '', | |
| 447 | }, | |
| 448 | ); | |
| 449 | foreach my $l (@tax_lines) { $tax_total += ($l->{tax_amount_cents} || 0); } | |
| 450 | } | |
| 451 | ||
| 452 | my $total = $after_discount + $tax_total; | |
| 453 | $total = 0 if $total < 0; | |
| 454 | ||
| 455 | # ---- Shipping fields + fee --------------------------------------- | |
| 456 | my %ship = ( | |
| 457 | name => substr(_co_trim_s($form->{ship_name} || ''), 0, 120), | |
| 458 | addr1 => substr(_co_trim_s($form->{ship_addr1} || ''), 0, 200), | |
| 459 | addr2 => substr(_co_trim_s($form->{ship_addr2} || ''), 0, 200), | |
| 460 | city => substr(_co_trim_s($form->{ship_city} || ''), 0, 120), | |
| 461 | region => substr(_co_trim_s($form->{ship_region} || ''), 0, 80), | |
| 462 | postal => substr(_co_trim_s($form->{ship_postal} || ''), 0, 20), | |
| 463 | country => uc(substr(_co_trim_s($form->{ship_country} || ''), 0, 2)), | |
| 464 | phone => substr(_co_trim_s($form->{ship_phone} || ''), 0, 40), | |
| 465 | zone => substr(_co_trim_s($form->{ship_zone} || ''), 0, 40), | |
| 466 | ); | |
| 467 | my %bill = ( | |
| 468 | name => substr(_co_trim_s($form->{bill_name} || ''), 0, 120), | |
| 469 | addr1 => substr(_co_trim_s($form->{bill_addr1} || ''), 0, 200), | |
| 470 | addr2 => substr(_co_trim_s($form->{bill_addr2} || ''), 0, 200), | |
| 471 | city => substr(_co_trim_s($form->{bill_city} || ''), 0, 120), | |
| 472 | postal => substr(_co_trim_s($form->{bill_postal} || ''), 0, 20), | |
| 473 | phone => substr(_co_trim_s($form->{bill_phone} || ''), 0, 40), | |
| 474 | ); | |
| 475 | $ship{country} =~ s/[^A-Z]//g; | |
| 476 | my $ship_cents = 0; | |
| 477 | my $has_physical_line = 0; | |
| 478 | foreach my $r (@rows) { | |
| 479 | if (($r->{purchase_kind} || '') eq 'physical') { $has_physical_line = 1; last; } | |
| 480 | } | |
| 481 | if ($has_physical_line) { | |
| 482 | if (!$ship{name} || !$ship{addr1} || !$ship{city} || !$ship{postal} || length($ship{country}) != 2) { | |
| 483 | $db->db_disconnect($dbh); | |
| 484 | _co_json_out({ ok => 0, error => 'Shipping address is required for printed items.' }); | |
| 485 | } | |
| 486 | if ($ship{zone}) { | |
| 487 | foreach my $r (@rows) { | |
| 488 | next unless ($r->{purchase_kind} || '') eq 'physical'; | |
| 489 | my $mid = $r->{model_id}; $mid =~ s/[^0-9]//g; | |
| 490 | next unless $mid; | |
| 491 | my $mr = $db->db_readwrite($dbh, qq~ | |
| 492 | SELECT shipping_options_json FROM `${DB}`.models WHERE id='$mid' LIMIT 1 | |
| 493 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 494 | my $raw = $mr->{shipping_options_json} || ''; | |
| 495 | foreach my $line (split /\r?\n/, $raw) { | |
| 496 | $line =~ s/^\s+|\s+$//g; | |
| 497 | next unless $line =~ /^([A-Za-z0-9_\-]{1,40})\s*=\s*(\d+)$/; | |
| 498 | if ($1 eq $ship{zone}) { $ship_cents = $2 + 0; last; } | |
| 499 | } | |
| 500 | last; | |
| 501 | } | |
| 502 | } | |
| 503 | $total += $ship_cents; | |
| 504 | } | |
| 505 | ||
| 506 | my $have_ship_cols = 0; | |
| 507 | { | |
| 508 | my $r = $db->db_readwrite($dbh, qq~ | |
| 509 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 510 | WHERE table_schema='$DB' AND table_name='orders' | |
| 511 | AND column_name='requires_shipping' | |
| 512 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 513 | $have_ship_cols = 1 if $r && $r->{n}; | |
| 514 | } | |
| 515 | my $have_oi_variant_cols = 0; | |
| 516 | { | |
| 517 | my $r = $db->db_readwrite($dbh, qq~ | |
| 518 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 519 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 520 | AND column_name='purchase_kind' | |
| 521 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 522 | $have_oi_variant_cols = 1 if $r && $r->{n}; | |
| 523 | } | |
| 524 | my $ship_set = ''; | |
| 525 | if ($have_ship_cols) { | |
| 526 | my $req = $has_physical_line ? 1 : 0; | |
| 527 | my @bits = ("requires_shipping='$req'", "shipping_cents='$ship_cents'"); | |
| 528 | if ($has_physical_line) { | |
| 529 | push @bits, "shipping_zone='" . _co_esc_safe($ship{zone}) . "'"; | |
| 530 | push @bits, "ship_name='" . _co_esc_safe($ship{name}) . "'"; | |
| 531 | push @bits, "ship_addr1='" . _co_esc_safe($ship{addr1}) . "'"; | |
| 532 | push @bits, "ship_addr2='" . _co_esc_safe($ship{addr2}) . "'"; | |
| 533 | push @bits, "ship_city='" . _co_esc_safe($ship{city}) . "'"; | |
| 534 | push @bits, "ship_region='" . _co_esc_safe($ship{region}) . "'"; | |
| 535 | push @bits, "ship_postal='" . _co_esc_safe($ship{postal}) . "'"; | |
| 536 | push @bits, "ship_country='" . _co_esc_safe($ship{country}) . "'"; | |
| 537 | push @bits, "ship_phone='" . _co_esc_safe($ship{phone}) . "'"; | |
| 538 | } | |
| 539 | $ship_set = ',' . join(',', @bits); | |
| 540 | } | |
| 541 | my $have_bill_cols = 0; | |
| 542 | { | |
| 543 | my $r = $db->db_readwrite($dbh, qq~ | |
| 544 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 545 | WHERE table_schema='$DB' AND table_name='orders' | |
| 546 | AND column_name='bill_name' | |
| 547 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 548 | $have_bill_cols = 1 if $r && $r->{n}; | |
| 549 | } | |
| 550 | my $bill_set = ''; | |
| 551 | if ($have_bill_cols && length $bill{name}) { | |
| 552 | my @bits; | |
| 553 | push @bits, "bill_name='" . _co_esc_safe($bill{name}) . "'"; | |
| 554 | push @bits, "bill_addr1='" . _co_esc_safe($bill{addr1}) . "'"; | |
| 555 | push @bits, "bill_addr2='" . _co_esc_safe($bill{addr2}) . "'"; | |
| 556 | push @bits, "bill_city='" . _co_esc_safe($bill{city}) . "'"; | |
| 557 | push @bits, "bill_postal='" . _co_esc_safe($bill{postal}) . "'"; | |
| 558 | push @bits, "bill_phone='" . _co_esc_safe($bill{phone}) . "'"; | |
| 559 | $bill_set = ',' . join(',', @bits); | |
| 560 | } | |
| 561 | ||
| 562 | my $have_oi_bundle = 0; | |
| 563 | { | |
| 564 | my $r = $db->db_readwrite($dbh, qq~ | |
| 565 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 566 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 567 | AND column_name='bundle_id' | |
| 568 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 569 | $have_oi_bundle = 1 if $r && $r->{n}; | |
| 570 | } | |
| 571 | ||
| 572 | my $buyer_account_id = 0; | |
| 573 | { | |
| 574 | my $b = $buyer_auth->verify($q, $db, $dbh, $DB); | |
| 575 | if ($b && lc($b->{email}) eq lc($email)) { | |
| 576 | $buyer_account_id = $b->{id}; | |
| 577 | $buyer_account_id =~ s/[^0-9]//g; | |
| 578 | } | |
| 579 | } | |
| 580 | ||
| 581 | my $store_credit_applied = 0; | |
| 582 | if ($buyer_account_id && $total > 0) { | |
| 583 | my $bal = $bc->balance_cents($db, $dbh, $DB, $sid, | |
| 584 | { buyer_account_id => $buyer_account_id }); | |
| 585 | if ($bal > 0) { | |
| 586 | $store_credit_applied = $bal > $total ? $total : $bal; | |
| 587 | $total -= $store_credit_applied; | |
| 588 | } | |
| 589 | } | |
| 590 | ||
| 591 | # ---- Free-order short-circuit ----------------------------------------- | |
| 592 | if ($total <= 0) { | |
| 593 | my $currency = uc($cfg->settings('stripe_currency_default') || 'USD'); | |
| 594 | my $promo_sql = $applied_promo_id ? "'$applied_promo_id'" : 'NULL'; | |
| 595 | my $code_sql = $applied_code_str ? "'" . _co_esc($applied_code_str) . "'" : 'NULL'; | |
| 596 | ||
| 597 | my $credit_set = $store_credit_applied > 0 | |
| 598 | ? ",store_credit_applied_cents='$store_credit_applied'" : ''; | |
| 599 | $db->db_readwrite($dbh, qq~ | |
| 600 | INSERT INTO `${DB}`.orders | |
| 601 | SET storefront_id='$sid', | |
| 602 | buyer_email='~ . _co_esc($email) . qq~', | |
| 603 | buyer_account_id=~ . ($buyer_account_id ? "'$buyer_account_id'" : "NULL") . qq~, | |
| 604 | total_amount_cents='0', | |
| 605 | currency='~ . _co_esc($currency) . qq~', | |
| 606 | status='paid', | |
| 607 | payment_processor='free', | |
| 608 | platform_fee_cents='0', | |
| 609 | creator_payout_cents='0', | |
| 610 | promotional_code_used=$code_sql, | |
| 611 | applied_promotion_id=$promo_sql, | |
| 612 | discount_applied_cents='$discount_cents'$credit_set$ship_set$bill_set, | |
| 613 | paid_at=NOW(), | |
| 614 | created_at=NOW() | |
| 615 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 616 | ||
| 617 | my $oid_row = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 618 | my $oid = $oid_row->{id} || 0; | |
| 619 | $oid =~ s/[^0-9]//g; | |
| 620 | unless ($oid) { | |
| 621 | $db->db_disconnect($dbh); | |
| 622 | _co_json_out({ ok => 0, error => 'Free order create failed.' }); | |
| 623 | } | |
| 624 | ||
| 625 | foreach my $r (@rows) { | |
| 626 | my $mid = $r->{model_id} || 0; | |
| 627 | my $bid = $r->{bundle_id} || 0; | |
| 628 | my $qty = $r->{quantity} || 1; | |
| 629 | $mid =~ s/[^0-9]//g; $bid =~ s/[^0-9]//g; $qty =~ s/[^0-9]//g; | |
| 630 | next unless $mid || $bid; | |
| 631 | my $variant_set = _co_oi_variant_set($r, $have_oi_variant_cols); | |
| 632 | my $mid_sql = $mid ? "'$mid'" : 'NULL'; | |
| 633 | my $bundle_set = ($have_oi_bundle && $bid) | |
| 634 | ? ",bundle_id='$bid'" : ''; | |
| 635 | $db->db_readwrite($dbh, qq~ | |
| 636 | INSERT INTO `${DB}`.order_items | |
| 637 | SET order_id='$oid', | |
| 638 | model_id=$mid_sql, | |
| 639 | price_paid_cents='0', | |
| 640 | quantity='$qty'$variant_set$bundle_set | |
| 641 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 642 | } | |
| 643 | ||
| 644 | if ($applied_promo_id && $applied_promo_id > 0) { | |
| 645 | $promo_mod->redeem($db, $dbh, $DB, | |
| 646 | promotion_id => $applied_promo_id, | |
| 647 | target_kind => 'model', | |
| 648 | order_id => $oid, | |
| 649 | buyer_account_id => $buyer_account_id || undef, | |
| 650 | buyer_email => $email, | |
| 651 | discount_applied_cents => $discount_cents, | |
| 652 | ); | |
| 653 | } | |
| 654 | ||
| 655 | if ($email && $sid) { | |
| 656 | my $ba = $db->db_readwrite($dbh, qq~ | |
| 657 | SELECT id FROM `${DB}`.buyer_accounts | |
| 658 | WHERE storefront_id='$sid' AND email='~ . _co_esc($email) . qq~' | |
| 659 | LIMIT 1 | |
| 660 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 661 | if ($ba && $ba->{id}) { | |
| 662 | $db->db_readwrite($dbh, qq~ | |
| 663 | UPDATE `${DB}`.orders SET buyer_account_id='$ba->{id}' | |
| 664 | WHERE id='$oid' AND buyer_account_id IS NULL | |
| 665 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 666 | } | |
| 667 | } | |
| 668 | ||
| 669 | $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid) if $applied_promo_id; | |
| 670 | ||
| 671 | $bc->apply_to_order($db, $dbh, $DB, $oid) if $store_credit_applied > 0; | |
| 672 | ||
| 673 | eval { | |
| 674 | MODS::ShopCart::Receipts->send_for_order($db, $dbh, $DB, $oid); | |
| 675 | }; | |
| 676 | ||
| 677 | $db->db_disconnect($dbh); | |
| 678 | _co_json_out({ | |
| 679 | ok => 1, | |
| 680 | free => 1, | |
| 681 | order_id => $oid + 0, | |
| 682 | redirect => "/checkout_complete.cgi?order=$oid", | |
| 683 | }); | |
| 684 | } | |
| 685 | ||
| 686 | my $bps = $cfg->settings('stripe_platform_fee_bps') || 1000; | |
| 687 | my $platform_fee = int($total * $bps / 10000); | |
| 688 | my $payout = $total - $platform_fee; | |
| 689 | my $currency = uc($cfg->settings('stripe_currency_default') || 'USD'); | |
| 690 | ||
| 691 | my $ip = $ENV{REMOTE_ADDR} || ''; | |
| 692 | my $promo_sql = $applied_promo_id ? "'$applied_promo_id'" : 'NULL'; | |
| 693 | my $code_sql = $applied_code_str ? "'" . _co_esc($applied_code_str) . "'" : 'NULL'; | |
| 694 | my $bc_sql = length($bill_country) == 2 ? "'$bill_country'" : 'NULL'; | |
| 695 | my $br_sql = length($bill_region) ? "'$bill_region'" : 'NULL'; | |
| 696 | my $credit_set = $store_credit_applied > 0 | |
| 697 | ? ",store_credit_applied_cents='$store_credit_applied'" : ''; | |
| 698 | $db->db_readwrite($dbh, qq~ | |
| 699 | INSERT INTO `${DB}`.orders | |
| 700 | SET storefront_id='$sid', | |
| 701 | buyer_email='~ . _co_esc($email) . qq~', | |
| 702 | buyer_account_id=~ . ($buyer_account_id ? "'$buyer_account_id'" : "NULL") . qq~, | |
| 703 | total_amount_cents='$total', | |
| 704 | subtotal_cents='$subtotal', | |
| 705 | tax_amount_cents='$tax_total', | |
| 706 | buyer_country_iso2=$bc_sql, | |
| 707 | buyer_region_code=$br_sql, | |
| 708 | currency='~ . _co_esc($currency) . qq~', | |
| 709 | status='pending', | |
| 710 | payment_processor='stripe', | |
| 711 | platform_fee_cents='$platform_fee', | |
| 712 | creator_payout_cents='$payout', | |
| 713 | promotional_code_used=$code_sql, | |
| 714 | applied_promotion_id=$promo_sql, | |
| 715 | discount_applied_cents='$discount_cents'$credit_set$ship_set, | |
| 716 | created_at=NOW() | |
| 717 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 718 | ||
| 719 | my $oid_row = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 720 | my $oid = $oid_row->{id} || 0; | |
| 721 | $oid =~ s/[^0-9]//g; | |
| 722 | unless ($oid) { | |
| 723 | $db->db_disconnect($dbh); | |
| 724 | _co_json_out({ ok => 0, error => 'Order create failed.' }); | |
| 725 | } | |
| 726 | ||
| 727 | foreach my $r (@rows) { | |
| 728 | my $mid = $r->{model_id} || 0; | |
| 729 | my $bid = $r->{bundle_id} || 0; | |
| 730 | my $price = $r->{price_cents} || $r->{unit_price_cents} || 0; | |
| 731 | my $qty = $r->{quantity} || 1; | |
| 732 | $mid =~ s/[^0-9]//g; | |
| 733 | $bid =~ s/[^0-9]//g; | |
| 734 | $price =~ s/[^0-9]//g; | |
| 735 | $qty =~ s/[^0-9]//g; | |
| 736 | next unless ($mid || $bid) && $price; | |
| 737 | my $variant_set = _co_oi_variant_set($r, $have_oi_variant_cols); | |
| 738 | my $mid_sql = $mid ? "'$mid'" : 'NULL'; | |
| 739 | my $bundle_set = ($have_oi_bundle && $bid) | |
| 740 | ? ",bundle_id='$bid'" : ''; | |
| 741 | $db->db_readwrite($dbh, qq~ | |
| 742 | INSERT INTO `${DB}`.order_items | |
| 743 | SET order_id='$oid', | |
| 744 | model_id=$mid_sql, | |
| 745 | price_paid_cents='$price', | |
| 746 | quantity='$qty'$variant_set$bundle_set | |
| 747 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 748 | } | |
| 749 | ||
| 750 | $tax->write_order_tax_lines($db, $dbh, $DB, $oid, \@tax_lines) if @tax_lines; | |
| 751 | ||
| 752 | my $pi = $stripe->create_payment_intent( | |
| 753 | amount_cents => $total, | |
| 754 | currency => lc($currency), | |
| 755 | seller_account => $store->{stripe_account_id}, | |
| 756 | platform_fee_cents => $platform_fee, | |
| 757 | buyer_email => $email, | |
| 758 | order_id => $oid, | |
| 759 | storefront_id => $sid, | |
| 760 | idempotency_key => "shopcart_order_$oid", | |
| 761 | ); | |
| 762 | ||
| 763 | if ($pi->{error} || !$pi->{client_secret}) { | |
| 764 | $db->db_readwrite($dbh, qq~ | |
| 765 | UPDATE `${DB}`.orders SET status='failed' WHERE id='$oid' | |
| 766 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 767 | $db->db_disconnect($dbh); | |
| 768 | _co_json_out({ ok => 0, error => 'Stripe error: ' . ($pi->{error} || 'unknown') }); | |
| 769 | } | |
| 770 | ||
| 771 | my $pi_id = $pi->{id}; | |
| 772 | $pi_id =~ s/'/''/g; | |
| 773 | $db->db_readwrite($dbh, qq~ | |
| 774 | UPDATE `${DB}`.orders | |
| 775 | SET stripe_payment_intent_id='$pi_id' | |
| 776 | WHERE id='$oid' | |
| 777 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 778 | ||
| 779 | $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid) if $applied_promo_id; | |
| 780 | ||
| 781 | $db->db_disconnect($dbh); | |
| 782 | ||
| 783 | _co_json_out({ | |
| 784 | ok => 1, | |
| 785 | client_secret => $pi->{client_secret}, | |
| 786 | order_id => $oid + 0, | |
| 787 | }); | |
| 788 | return; | |
| 789 | } | |
| 790 | ||
| 791 | #====================================================================== | |
| 792 | # Helpers (used by _co_intent) | |
| 793 | #====================================================================== | |
| 794 | sub _co_json_out { | |
| 795 | my ($h, $status) = @_; | |
| 796 | $status ||= '200 OK'; | |
| 797 | print "Status: $status\nContent-Type: application/json; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n"; | |
| 798 | print JSON::PP::encode_json($h); | |
| 799 | exit; | |
| 800 | } | |
| 801 | ||
| 802 | sub _co_esc { | |
| 803 | my $s = shift // ''; | |
| 804 | $s =~ s/\\/\\\\/g; | |
| 805 | $s =~ s/'/''/g; | |
| 806 | return $s; | |
| 807 | } | |
| 808 | ||
| 809 | sub _co_trim_s { my $s = shift // ''; $s =~ s/^\s+|\s+$//g; return $s; } | |
| 810 | sub _co_esc_safe { my $s = shift // ''; $s =~ s/\\/\\\\/g; $s =~ s/'/''/g; return $s; } | |
| 811 | ||
| 812 | sub _co_oi_variant_set { | |
| 813 | my ($r, $have) = @_; | |
| 814 | return '' unless $have; | |
| 815 | my $kind = ($r->{purchase_kind} && $r->{purchase_kind} eq 'physical') ? 'physical' : 'digital'; | |
| 816 | my $color = $r->{selected_color} || ''; $color =~ s/\\/\\\\/g; $color =~ s/'/''/g; | |
| 817 | my $mat = $r->{selected_material} || ''; $mat =~ s/\\/\\\\/g; $mat =~ s/'/''/g; | |
| 818 | my $fstat = ($kind eq 'physical') ? 'pending' : 'not_required'; | |
| 819 | return ",purchase_kind='$kind',selected_color='$color',selected_material='$mat',fulfillment_status='$fstat'"; | |
| 820 | } |