added on local at 2026-07-01 21:47:32
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # RePricer - PaymentIntent creator (JSON endpoint). | |
| 4 | # | |
| 5 | # POST /checkout_intent.cgi | |
| 6 | # storefront_id, email | |
| 7 | # | |
| 8 | # Returns JSON: | |
| 9 | # { ok: 1, client_secret: '...', order_id: N } | |
| 10 | # { ok: 0, error: 'message' } | |
| 11 | # | |
| 12 | # Side effects: | |
| 13 | # - Inserts a pending row into `orders` | |
| 14 | # - Inserts rows into `order_items` | |
| 15 | # - Creates a Stripe PaymentIntent (destination charge to the | |
| 16 | # seller's connected account, with RePricer' application fee) | |
| 17 | # - Stores stripe_payment_intent_id on the order row | |
| 18 | # | |
| 19 | # Order is flipped to `paid` later by /stripe_webhook.cgi when Stripe | |
| 20 | # fires `payment_intent.succeeded`. | |
| 21 | #====================================================================== | |
| 22 | use strict; | |
| 23 | use warnings; | |
| 24 | ||
| 25 | use lib '/var/www/vhosts/3dshawn.com/repricer.3dshawn.com'; | |
| 26 | use CGI; | |
| 27 | use JSON::PP; | |
| 28 | use MODS::DBConnect; | |
| 29 | use MODS::RePricer::Config; | |
| 30 | use MODS::RePricer::Cart; | |
| 31 | use MODS::RePricer::Promotions; | |
| 32 | use MODS::RePricer::Stripe; | |
| 33 | use MODS::RePricer::BuyerAuth; | |
| 34 | use MODS::RePricer::Receipts; | |
| 35 | use MODS::RePricer::Tax; | |
| 36 | use MODS::RePricer::BuyerCredits; | |
| 37 | ||
| 38 | $| = 1; | |
| 39 | ||
| 40 | my $q = CGI->new; | |
| 41 | my $form = $q->Vars; | |
| 42 | my $db = MODS::DBConnect->new; | |
| 43 | my $cfg = MODS::RePricer::Config->new; | |
| 44 | my $cart = MODS::RePricer::Cart->new; | |
| 45 | my $stripe = MODS::RePricer::Stripe->new; | |
| 46 | my $buyer_auth = MODS::RePricer::BuyerAuth->new; | |
| 47 | my $tax = MODS::RePricer::Tax->new; | |
| 48 | my $bc = MODS::RePricer::BuyerCredits->new; | |
| 49 | my $DB = $cfg->settings('database_name'); | |
| 50 | ||
| 51 | sub _json_out { | |
| 52 | my ($h, $status) = @_; | |
| 53 | $status ||= '200 OK'; | |
| 54 | print "Status: $status\nContent-Type: application/json; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 55 | print JSON::PP::encode_json($h); | |
| 56 | exit; | |
| 57 | } | |
| 58 | sub _esc { | |
| 59 | my $s = shift // ''; | |
| 60 | $s =~ s/\\/\\\\/g; | |
| 61 | $s =~ s/'/''/g; | |
| 62 | return $s; | |
| 63 | } | |
| 64 | ||
| 65 | _json_out({ ok => 0, error => 'POST only' }, '405 Method Not Allowed') | |
| 66 | unless ($ENV{REQUEST_METHOD} || '') eq 'POST'; | |
| 67 | ||
| 68 | unless ($stripe->is_configured) { | |
| 69 | _json_out({ ok => 0, error => 'Payments are not configured yet.' }); | |
| 70 | } | |
| 71 | ||
| 72 | my $sid = $form->{storefront_id} || 0; | |
| 73 | $sid =~ s/[^0-9]//g; | |
| 74 | my $email = $form->{email} || ''; | |
| 75 | $email =~ s/^\s+|\s+$//g; | |
| 76 | $email = substr($email, 0, 191); | |
| 77 | ||
| 78 | _json_out({ ok => 0, error => 'Please enter a valid email.' }) | |
| 79 | unless $email =~ /\@/ && $email =~ /\./; | |
| 80 | _json_out({ ok => 0, error => 'Storefront not specified.' }) unless $sid; | |
| 81 | ||
| 82 | my $dbh = $db->db_connect(); | |
| 83 | ||
| 84 | my $store = $db->db_readwrite($dbh, qq~ | |
| 85 | SELECT id, stripe_account_id, stripe_onboarded_at | |
| 86 | FROM `${DB}`.storefronts | |
| 87 | WHERE id='$sid' AND status='live' LIMIT 1 | |
| 88 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 89 | unless ($store && $store->{stripe_account_id} && $store->{stripe_onboarded_at}) { | |
| 90 | $db->db_disconnect($dbh); | |
| 91 | _json_out({ ok => 0, error => "This storefront isn't accepting payments yet." }); | |
| 92 | } | |
| 93 | ||
| 94 | # Read cart from cookie. | |
| 95 | my $token = $cart->read_token($q); | |
| 96 | my @rows = $cart->items($db, $dbh, $DB, $token, $sid); | |
| 97 | my $subtotal = $cart->total_cents($db, $dbh, $DB, $token, $sid); | |
| 98 | ||
| 99 | unless (scalar(@rows) && $subtotal > 0) { | |
| 100 | $db->db_disconnect($dbh); | |
| 101 | _json_out({ ok => 0, error => 'Your cart is empty.' }); | |
| 102 | } | |
| 103 | ||
| 104 | # Re-validate any applied cart promo and bake the discount into the | |
| 105 | # total BEFORE creating the order + PaymentIntent. The redemption row | |
| 106 | # itself is written by stripe_webhook.cgi on payment_intent.succeeded | |
| 107 | # (so a failed payment doesn't burn the buyer's max_per_user slot). | |
| 108 | my $promo_mod = MODS::RePricer::Promotions->new; | |
| 109 | my $applied_promo = $promo_mod->cart_applied($db, $dbh, $DB, $token, $sid); | |
| 110 | my $discount_cents = 0; | |
| 111 | my $applied_promo_id = 0; | |
| 112 | my $applied_code_str = ''; | |
| 113 | if ($applied_promo) { | |
| 114 | my %v = $promo_mod->validate($db, $dbh, $DB, $applied_promo, | |
| 115 | kind => 'model', | |
| 116 | subtotal_cents => $subtotal, | |
| 117 | buyer_email => $email, | |
| 118 | new_customer => 1, | |
| 119 | ); | |
| 120 | if ($v{ok}) { | |
| 121 | $discount_cents = $promo_mod->apply_to_total_cents($applied_promo, $subtotal); | |
| 122 | $applied_promo_id = $applied_promo->{id}; | |
| 123 | $applied_code_str = $applied_promo->{code} || ''; | |
| 124 | } else { | |
| 125 | # Stale code (expired between cart and checkout). Clear it so the | |
| 126 | # buyer isn't stuck and gets a clean re-apply prompt on retry. | |
| 127 | $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid); | |
| 128 | } | |
| 129 | } | |
| 130 | my $after_discount = $subtotal - $discount_cents; | |
| 131 | $after_discount = 0 if $after_discount < 0; | |
| 132 | ||
| 133 | # Tax calculation. Buyer hands us billing country (+ optional region | |
| 134 | # for US states / CA provinces) on the checkout form. Storefront-level | |
| 135 | # tax_mode short-circuits inside calc_tax_lines -- if the seller is on | |
| 136 | # 'seller_handles' the platform stays out and tax_lines is empty. | |
| 137 | my $bill_country = uc($form->{bill_country} || ''); $bill_country =~ s/[^A-Z]//g; | |
| 138 | my $bill_region = uc($form->{bill_region} || ''); $bill_region =~ s/[^A-Z0-9]//g; | |
| 139 | my $bill_vat_id = uc($form->{vat_id} || ''); $bill_vat_id =~ s/[^A-Z0-9]//g; | |
| 140 | $bill_country = substr($bill_country, 0, 2); | |
| 141 | $bill_region = substr($bill_region, 0, 10); | |
| 142 | $bill_vat_id = substr($bill_vat_id, 0, 20); | |
| 143 | ||
| 144 | # Reverse-charge check (B2B EU): cached VIES validation overrides the | |
| 145 | # normal tax calc and writes a zero-amount audit line. | |
| 146 | my $reverse_charge = 0; | |
| 147 | my $vat_country = ''; | |
| 148 | if (length($bill_vat_id) >= 4) { | |
| 149 | my $vsafe = $bill_vat_id; $vsafe =~ s/'/''/g; | |
| 150 | my $vc = $db->db_readwrite($dbh, qq~ | |
| 151 | SELECT vat_country, is_valid, | |
| 152 | DATEDIFF(NOW(), validated_at) AS age | |
| 153 | FROM `${DB}`.buyer_tax_info | |
| 154 | WHERE vat_id='$vsafe' | |
| 155 | ORDER BY id DESC LIMIT 1 | |
| 156 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 157 | if ($vc && $vc->{is_valid} && defined $vc->{age} && $vc->{age} < 180) { | |
| 158 | $reverse_charge = 1; | |
| 159 | $vat_country = $vc->{vat_country}; | |
| 160 | } | |
| 161 | } | |
| 162 | ||
| 163 | # Dominant product_kind across the cart. Mixed-kind carts: prefer | |
| 164 | # 'physical' (broader applies_to coverage). All-digital cart stays | |
| 165 | # 'digital' so digital-exempt US states (e.g. Florida sales tax) | |
| 166 | # correctly skip the line. | |
| 167 | my $dominant_kind = 'digital'; | |
| 168 | { | |
| 169 | my $has_physical = 0; | |
| 170 | foreach my $row (@rows) { | |
| 171 | my $mid = $row->{model_id} || 0; $mid =~ s/[^0-9]//g; | |
| 172 | next unless $mid; | |
| 173 | my $m = $db->db_readwrite($dbh, qq~ | |
| 174 | SELECT product_kind FROM `${DB}`.models WHERE id='$mid' LIMIT 1 | |
| 175 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 176 | if ($m && $m->{product_kind} && $m->{product_kind} ne 'digital') { | |
| 177 | $has_physical = 1; last; | |
| 178 | } | |
| 179 | } | |
| 180 | $dominant_kind = $has_physical ? 'physical' : 'digital'; | |
| 181 | } | |
| 182 | ||
| 183 | my @tax_lines; | |
| 184 | my $tax_total = 0; | |
| 185 | if (length $bill_country == 2 && $after_discount > 0) { | |
| 186 | @tax_lines = $tax->calc_tax_lines( | |
| 187 | db => $db, | |
| 188 | dbh => $dbh, | |
| 189 | DB => $DB, | |
| 190 | storefront_id => $sid, | |
| 191 | country_iso2 => $bill_country, | |
| 192 | region_code => $bill_region, | |
| 193 | product_kind => $dominant_kind, | |
| 194 | taxable_amount_cents => $after_discount, | |
| 195 | reverse_charge => $reverse_charge, | |
| 196 | buyer_vat_id => $reverse_charge ? $bill_vat_id : '', | |
| 197 | buyer_vat_country => $reverse_charge ? $vat_country : '', | |
| 198 | evidence => { | |
| 199 | buyer_country_billing => $bill_country, | |
| 200 | buyer_country_ip => '', # TODO: IP-geo lookup -- skipped v1 | |
| 201 | }, | |
| 202 | ); | |
| 203 | foreach my $l (@tax_lines) { $tax_total += ($l->{tax_amount_cents} || 0); } | |
| 204 | } | |
| 205 | ||
| 206 | my $total = $after_discount + $tax_total; | |
| 207 | $total = 0 if $total < 0; | |
| 208 | ||
| 209 | # ---- Shipping fields + fee --------------------------------------- | |
| 210 | # Buyer fills these in on the checkout page when at least one cart | |
| 211 | # line is purchase_kind='physical'. We trust the seller's shipping | |
| 212 | # rates configured in shipping_options_json -- the front-end already | |
| 213 | # chose one and we re-resolve here defensively to prevent a tampered | |
| 214 | # `ship_cents` from underpaying shipping. | |
| 215 | sub _trim_s { my $s = shift // ''; $s =~ s/^\s+|\s+$//g; return $s; } | |
| 216 | sub _esc_safe { my $s = shift // ''; $s =~ s/\\/\\\\/g; $s =~ s/'/''/g; return $s; } | |
| 217 | my %ship = ( | |
| 218 | name => substr(_trim_s($form->{ship_name} || ''), 0, 120), | |
| 219 | addr1 => substr(_trim_s($form->{ship_addr1} || ''), 0, 200), | |
| 220 | addr2 => substr(_trim_s($form->{ship_addr2} || ''), 0, 200), | |
| 221 | city => substr(_trim_s($form->{ship_city} || ''), 0, 120), | |
| 222 | region => substr(_trim_s($form->{ship_region} || ''), 0, 80), | |
| 223 | postal => substr(_trim_s($form->{ship_postal} || ''), 0, 20), | |
| 224 | country => uc(substr(_trim_s($form->{ship_country} || ''), 0, 2)), | |
| 225 | phone => substr(_trim_s($form->{ship_phone} || ''), 0, 40), | |
| 226 | zone => substr(_trim_s($form->{ship_zone} || ''), 0, 40), | |
| 227 | ); | |
| 228 | my %bill = ( | |
| 229 | name => substr(_trim_s($form->{bill_name} || ''), 0, 120), | |
| 230 | addr1 => substr(_trim_s($form->{bill_addr1} || ''), 0, 200), | |
| 231 | addr2 => substr(_trim_s($form->{bill_addr2} || ''), 0, 200), | |
| 232 | city => substr(_trim_s($form->{bill_city} || ''), 0, 120), | |
| 233 | postal => substr(_trim_s($form->{bill_postal} || ''), 0, 20), | |
| 234 | phone => substr(_trim_s($form->{bill_phone} || ''), 0, 40), | |
| 235 | ); | |
| 236 | $ship{country} =~ s/[^A-Z]//g; | |
| 237 | my $ship_cents = 0; | |
| 238 | my $has_physical_line = 0; | |
| 239 | foreach my $r (@rows) { | |
| 240 | if (($r->{purchase_kind} || '') eq 'physical') { $has_physical_line = 1; last; } | |
| 241 | } | |
| 242 | if ($has_physical_line) { | |
| 243 | if (!$ship{name} || !$ship{addr1} || !$ship{city} || !$ship{postal} || length($ship{country}) != 2) { | |
| 244 | $db->db_disconnect($dbh); | |
| 245 | _json_out({ ok => 0, error => 'Shipping address is required for printed items.' }); | |
| 246 | } | |
| 247 | # Resolve the rate server-side from the first physical model's | |
| 248 | # shipping_options_json so a tampered client can't underpay. | |
| 249 | if ($ship{zone}) { | |
| 250 | foreach my $r (@rows) { | |
| 251 | next unless ($r->{purchase_kind} || '') eq 'physical'; | |
| 252 | my $mid = $r->{model_id}; $mid =~ s/[^0-9]//g; | |
| 253 | next unless $mid; | |
| 254 | my $mr = $db->db_readwrite($dbh, qq~ | |
| 255 | SELECT shipping_options_json FROM `${DB}`.models WHERE id='$mid' LIMIT 1 | |
| 256 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 257 | my $raw = $mr->{shipping_options_json} || ''; | |
| 258 | foreach my $line (split /\r?\n/, $raw) { | |
| 259 | $line =~ s/^\s+|\s+$//g; | |
| 260 | next unless $line =~ /^([A-Za-z0-9_\-]{1,40})\s*=\s*(\d+)$/; | |
| 261 | if ($1 eq $ship{zone}) { $ship_cents = $2 + 0; last; } | |
| 262 | } | |
| 263 | last; | |
| 264 | } | |
| 265 | } | |
| 266 | $total += $ship_cents; | |
| 267 | } | |
| 268 | ||
| 269 | # Probe for new schema columns ONCE here so both the free-order | |
| 270 | # branch and the paid branch below can emit the right SET clauses. | |
| 271 | my $have_ship_cols = 0; | |
| 272 | { | |
| 273 | my $r = $db->db_readwrite($dbh, qq~ | |
| 274 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 275 | WHERE table_schema='$DB' AND table_name='orders' | |
| 276 | AND column_name='requires_shipping' | |
| 277 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 278 | $have_ship_cols = 1 if $r && $r->{n}; | |
| 279 | } | |
| 280 | my $have_oi_variant_cols = 0; | |
| 281 | { | |
| 282 | my $r = $db->db_readwrite($dbh, qq~ | |
| 283 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 284 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 285 | AND column_name='purchase_kind' | |
| 286 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 287 | $have_oi_variant_cols = 1 if $r && $r->{n}; | |
| 288 | } | |
| 289 | my $ship_set = ''; | |
| 290 | if ($have_ship_cols) { | |
| 291 | my $req = $has_physical_line ? 1 : 0; | |
| 292 | my @bits = ("requires_shipping='$req'", "shipping_cents='$ship_cents'"); | |
| 293 | if ($has_physical_line) { | |
| 294 | push @bits, "shipping_zone='" . _esc_safe($ship{zone}) . "'"; | |
| 295 | push @bits, "ship_name='" . _esc_safe($ship{name}) . "'"; | |
| 296 | push @bits, "ship_addr1='" . _esc_safe($ship{addr1}) . "'"; | |
| 297 | push @bits, "ship_addr2='" . _esc_safe($ship{addr2}) . "'"; | |
| 298 | push @bits, "ship_city='" . _esc_safe($ship{city}) . "'"; | |
| 299 | push @bits, "ship_region='" . _esc_safe($ship{region}) . "'"; | |
| 300 | push @bits, "ship_postal='" . _esc_safe($ship{postal}) . "'"; | |
| 301 | push @bits, "ship_country='" . _esc_safe($ship{country}) . "'"; | |
| 302 | push @bits, "ship_phone='" . _esc_safe($ship{phone}) . "'"; | |
| 303 | } | |
| 304 | $ship_set = ',' . join(',', @bits); | |
| 305 | } | |
| 306 | # Billing address snapshot (always written when columns exist). Probes | |
| 307 | # bill_name column separately because the bill_* set landed in a later | |
| 308 | # migration than the ship_* set. | |
| 309 | my $have_bill_cols = 0; | |
| 310 | { | |
| 311 | my $r = $db->db_readwrite($dbh, qq~ | |
| 312 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 313 | WHERE table_schema='$DB' AND table_name='orders' | |
| 314 | AND column_name='bill_name' | |
| 315 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 316 | $have_bill_cols = 1 if $r && $r->{n}; | |
| 317 | } | |
| 318 | my $bill_set = ''; | |
| 319 | if ($have_bill_cols && length $bill{name}) { | |
| 320 | my @bits; | |
| 321 | push @bits, "bill_name='" . _esc_safe($bill{name}) . "'"; | |
| 322 | push @bits, "bill_addr1='" . _esc_safe($bill{addr1}) . "'"; | |
| 323 | push @bits, "bill_addr2='" . _esc_safe($bill{addr2}) . "'"; | |
| 324 | push @bits, "bill_city='" . _esc_safe($bill{city}) . "'"; | |
| 325 | push @bits, "bill_postal='" . _esc_safe($bill{postal}) . "'"; | |
| 326 | push @bits, "bill_phone='" . _esc_safe($bill{phone}) . "'"; | |
| 327 | $bill_set = ',' . join(',', @bits); | |
| 328 | } | |
| 329 | sub _oi_variant_set { | |
| 330 | my ($r, $have) = @_; | |
| 331 | return '' unless $have; | |
| 332 | my $kind = ($r->{purchase_kind} && $r->{purchase_kind} eq 'physical') ? 'physical' : 'digital'; | |
| 333 | my $color = $r->{selected_color} || ''; $color =~ s/\\/\\\\/g; $color =~ s/'/''/g; | |
| 334 | my $mat = $r->{selected_material} || ''; $mat =~ s/\\/\\\\/g; $mat =~ s/'/''/g; | |
| 335 | my $fstat = ($kind eq 'physical') ? 'pending' : 'not_required'; | |
| 336 | return ",purchase_kind='$kind',selected_color='$color',selected_material='$mat',fulfillment_status='$fstat'"; | |
| 337 | } | |
| 338 | ||
| 339 | # Does order_items have the bundle_id column? Probe once. | |
| 340 | my $have_oi_bundle = 0; | |
| 341 | { | |
| 342 | my $r = $db->db_readwrite($dbh, qq~ | |
| 343 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 344 | WHERE table_schema='$DB' AND table_name='order_items' | |
| 345 | AND column_name='bundle_id' | |
| 346 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 347 | $have_oi_bundle = 1 if $r && $r->{n}; | |
| 348 | } | |
| 349 | ||
| 350 | # ---- Resolve buyer_account_id (used by credit + free-order branches) --- | |
| 351 | # We never trust the cookie alone -- the buyer must be logged in AND the | |
| 352 | # email they typed must match their session, so a guest session can't | |
| 353 | # silently spend a registered buyer's credit. | |
| 354 | my $buyer_account_id = 0; | |
| 355 | { | |
| 356 | my $b = $buyer_auth->verify($q, $db, $dbh, $DB); | |
| 357 | if ($b && lc($b->{email}) eq lc($email)) { | |
| 358 | $buyer_account_id = $b->{id}; | |
| 359 | $buyer_account_id =~ s/[^0-9]//g; | |
| 360 | } | |
| 361 | } | |
| 362 | ||
| 363 | # ---- Apply available store credit ------------------------------------- | |
| 364 | # Only registered buyers can redeem. Guest checkouts that match an | |
| 365 | # email with credit must sign in first (we surface this on the cart UI; | |
| 366 | # here we just refuse to apply it without auth so an email-spoof attack | |
| 367 | # can't drain another user's credit). | |
| 368 | my $store_credit_applied = 0; | |
| 369 | if ($buyer_account_id && $total > 0) { | |
| 370 | my $bal = $bc->balance_cents($db, $dbh, $DB, $sid, | |
| 371 | { buyer_account_id => $buyer_account_id }); | |
| 372 | if ($bal > 0) { | |
| 373 | $store_credit_applied = $bal > $total ? $total : $bal; | |
| 374 | $total -= $store_credit_applied; | |
| 375 | } | |
| 376 | } | |
| 377 | ||
| 378 | # ---- Free-order short-circuit ----------------------------------------- | |
| 379 | # Stripe rejects $0 PaymentIntents, so a 100%-off promo (or a $0 cart) | |
| 380 | # can't go through the normal flow. Instead we create the order as | |
| 381 | # already-paid, redeem the promo inline (the webhook usually handles | |
| 382 | # that on PI success -- there's no webhook for free orders), link to | |
| 383 | # the buyer_account if we can, drop the cart_promotions row, and | |
| 384 | # return a `free=>1` response with a redirect URL. The JS in | |
| 385 | # repricer_checkout.html navigates straight to /checkout_complete.cgi. | |
| 386 | if ($total <= 0) { | |
| 387 | # buyer_account_id was resolved above (shared with the paid branch | |
| 388 | # and with the credit-application step). | |
| 389 | my $currency = uc($cfg->settings('stripe_currency_default') || 'USD'); | |
| 390 | my $promo_sql = $applied_promo_id ? "'$applied_promo_id'" : 'NULL'; | |
| 391 | my $code_sql = $applied_code_str ? "'" . _esc($applied_code_str) . "'" : 'NULL'; | |
| 392 | ||
| 393 | # platform_fee + payout stay zero -- nothing changed hands. | |
| 394 | # store_credit_applied_cents is conditional: only emit the column | |
| 395 | # in the INSERT when there's actually credit to record. That way | |
| 396 | # this CGI keeps working on a server that has the new BuyerCredits | |
| 397 | # code but hasn't run the ALTER orders ADD COLUMN yet. | |
| 398 | my $credit_set = $store_credit_applied > 0 | |
| 399 | ? ",store_credit_applied_cents='$store_credit_applied'" : ''; | |
| 400 | $db->db_readwrite($dbh, qq~ | |
| 401 | INSERT INTO `${DB}`.orders | |
| 402 | SET storefront_id='$sid', | |
| 403 | buyer_email='~ . _esc($email) . qq~', | |
| 404 | buyer_account_id=~ . ($buyer_account_id ? "'$buyer_account_id'" : "NULL") . qq~, | |
| 405 | total_amount_cents='0', | |
| 406 | currency='~ . _esc($currency) . qq~', | |
| 407 | status='paid', | |
| 408 | payment_processor='free', | |
| 409 | platform_fee_cents='0', | |
| 410 | creator_payout_cents='0', | |
| 411 | promotional_code_used=$code_sql, | |
| 412 | applied_promotion_id=$promo_sql, | |
| 413 | discount_applied_cents='$discount_cents'$credit_set$ship_set$bill_set, | |
| 414 | paid_at=NOW(), | |
| 415 | created_at=NOW() | |
| 416 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 417 | ||
| 418 | my $oid_row = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 419 | my $oid = $oid_row->{id} || 0; | |
| 420 | $oid =~ s/[^0-9]//g; | |
| 421 | unless ($oid) { | |
| 422 | $db->db_disconnect($dbh); | |
| 423 | _json_out({ ok => 0, error => 'Free order create failed.' }); | |
| 424 | } | |
| 425 | ||
| 426 | # Line items at the discounted price (which may be zero). Pull | |
| 427 | # per-line kind/color/material through to order_items so even a | |
| 428 | # free order surfaces "Print pending" in the seller's queue. | |
| 429 | foreach my $r (@rows) { | |
| 430 | my $mid = $r->{model_id} || 0; | |
| 431 | my $bid = $r->{bundle_id} || 0; | |
| 432 | my $qty = $r->{quantity} || 1; | |
| 433 | $mid =~ s/[^0-9]//g; $bid =~ s/[^0-9]//g; $qty =~ s/[^0-9]//g; | |
| 434 | next unless $mid || $bid; | |
| 435 | my $variant_set = _oi_variant_set($r, $have_oi_variant_cols); | |
| 436 | my $mid_sql = $mid ? "'$mid'" : 'NULL'; | |
| 437 | my $bundle_set = ($have_oi_bundle && $bid) | |
| 438 | ? ",bundle_id='$bid'" : ''; | |
| 439 | $db->db_readwrite($dbh, qq~ | |
| 440 | INSERT INTO `${DB}`.order_items | |
| 441 | SET order_id='$oid', | |
| 442 | model_id=$mid_sql, | |
| 443 | price_paid_cents='0', | |
| 444 | quantity='$qty'$variant_set$bundle_set | |
| 445 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 446 | } | |
| 447 | ||
| 448 | # Burn the promo redemption slot -- otherwise a buyer with a | |
| 449 | # max_per_user=1 free promo could replay it on a different cart. | |
| 450 | if ($applied_promo_id && $applied_promo_id > 0) { | |
| 451 | $promo_mod->redeem($db, $dbh, $DB, | |
| 452 | promotion_id => $applied_promo_id, | |
| 453 | target_kind => 'model', | |
| 454 | order_id => $oid, | |
| 455 | buyer_account_id => $buyer_account_id || undef, | |
| 456 | buyer_email => $email, | |
| 457 | discount_applied_cents => $discount_cents, | |
| 458 | ); | |
| 459 | } | |
| 460 | ||
| 461 | # Mirror the webhook's buyer_account back-link logic so /my_orders.cgi | |
| 462 | # picks the order up immediately for a signed-in buyer. | |
| 463 | if ($email && $sid) { | |
| 464 | my $ba = $db->db_readwrite($dbh, qq~ | |
| 465 | SELECT id FROM `${DB}`.buyer_accounts | |
| 466 | WHERE storefront_id='$sid' AND email='~ . _esc($email) . qq~' | |
| 467 | LIMIT 1 | |
| 468 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 469 | if ($ba && $ba->{id}) { | |
| 470 | $db->db_readwrite($dbh, qq~ | |
| 471 | UPDATE `${DB}`.orders SET buyer_account_id='$ba->{id}' | |
| 472 | WHERE id='$oid' AND buyer_account_id IS NULL | |
| 473 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 474 | } | |
| 475 | } | |
| 476 | ||
| 477 | # Drop the cart_promotions row to mirror the paid-branch behavior. | |
| 478 | $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid) if $applied_promo_id; | |
| 479 | ||
| 480 | # Write the negative buyer_credit_ledger row that consumes the | |
| 481 | # applied balance. Free-order path has no Stripe webhook so we have | |
| 482 | # to do it inline. Idempotent on (related_order_id, reason). | |
| 483 | $bc->apply_to_order($db, $dbh, $DB, $oid) if $store_credit_applied > 0; | |
| 484 | ||
| 485 | # Receipt email with signed download links. eval'd because a mail | |
| 486 | # failure must not block the JSON response -- the buyer still | |
| 487 | # needs the redirect URL to reach /checkout_complete.cgi and see | |
| 488 | # in-app download buttons. | |
| 489 | eval { | |
| 490 | MODS::RePricer::Receipts->send_for_order($db, $dbh, $DB, $oid); | |
| 491 | }; | |
| 492 | ||
| 493 | $db->db_disconnect($dbh); | |
| 494 | _json_out({ | |
| 495 | ok => 1, | |
| 496 | free => 1, | |
| 497 | order_id => $oid + 0, | |
| 498 | redirect => "/checkout_complete.cgi?order=$oid", | |
| 499 | }); | |
| 500 | } | |
| 501 | ||
| 502 | # $buyer_account_id was resolved above (shared with the credit + free | |
| 503 | # branches). Compute the platform fee next. | |
| 504 | # bps = basis points; 1000 bps = 10%. | |
| 505 | my $bps = $cfg->settings('stripe_platform_fee_bps') || 1000; | |
| 506 | my $platform_fee = int($total * $bps / 10000); | |
| 507 | my $payout = $total - $platform_fee; | |
| 508 | my $currency = uc($cfg->settings('stripe_currency_default') || 'USD'); | |
| 509 | ||
| 510 | # Insert the pending order row. Trigger sets created_at automatically | |
| 511 | # (BEFORE INSERT) but we set it here explicitly to be defensive. | |
| 512 | my $ip = $ENV{REMOTE_ADDR} || ''; | |
| 513 | my $promo_sql = $applied_promo_id ? "'$applied_promo_id'" : 'NULL'; | |
| 514 | my $code_sql = $applied_code_str ? "'" . _esc($applied_code_str) . "'" : 'NULL'; | |
| 515 | my $bc_sql = length($bill_country) == 2 ? "'$bill_country'" : 'NULL'; | |
| 516 | my $br_sql = length($bill_region) ? "'$bill_region'" : 'NULL'; | |
| 517 | my $credit_set = $store_credit_applied > 0 | |
| 518 | ? ",store_credit_applied_cents='$store_credit_applied'" : ''; | |
| 519 | $db->db_readwrite($dbh, qq~ | |
| 520 | INSERT INTO `${DB}`.orders | |
| 521 | SET storefront_id='$sid', | |
| 522 | buyer_email='~ . _esc($email) . qq~', | |
| 523 | buyer_account_id=~ . ($buyer_account_id ? "'$buyer_account_id'" : "NULL") . qq~, | |
| 524 | total_amount_cents='$total', | |
| 525 | subtotal_cents='$subtotal', | |
| 526 | tax_amount_cents='$tax_total', | |
| 527 | buyer_country_iso2=$bc_sql, | |
| 528 | buyer_region_code=$br_sql, | |
| 529 | currency='~ . _esc($currency) . qq~', | |
| 530 | status='pending', | |
| 531 | payment_processor='stripe', | |
| 532 | platform_fee_cents='$platform_fee', | |
| 533 | creator_payout_cents='$payout', | |
| 534 | promotional_code_used=$code_sql, | |
| 535 | applied_promotion_id=$promo_sql, | |
| 536 | discount_applied_cents='$discount_cents'$credit_set$ship_set, | |
| 537 | created_at=NOW() | |
| 538 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 539 | ||
| 540 | my $oid_row = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 541 | my $oid = $oid_row->{id} || 0; | |
| 542 | $oid =~ s/[^0-9]//g; | |
| 543 | unless ($oid) { | |
| 544 | $db->db_disconnect($dbh); | |
| 545 | _json_out({ ok => 0, error => 'Order create failed.' }); | |
| 546 | } | |
| 547 | ||
| 548 | # Insert the line items. Per-line kind/color/material/fulfillment | |
| 549 | # come from the cart row via the shared _oi_variant_set helper. | |
| 550 | # Bundle rows arrive with model_id NULL + bundle_id set. | |
| 551 | foreach my $r (@rows) { | |
| 552 | my $mid = $r->{model_id} || 0; | |
| 553 | my $bid = $r->{bundle_id} || 0; | |
| 554 | my $price = $r->{price_cents} || $r->{unit_price_cents} || 0; | |
| 555 | my $qty = $r->{quantity} || 1; | |
| 556 | $mid =~ s/[^0-9]//g; | |
| 557 | $bid =~ s/[^0-9]//g; | |
| 558 | $price =~ s/[^0-9]//g; | |
| 559 | $qty =~ s/[^0-9]//g; | |
| 560 | next unless ($mid || $bid) && $price; | |
| 561 | my $variant_set = _oi_variant_set($r, $have_oi_variant_cols); | |
| 562 | my $mid_sql = $mid ? "'$mid'" : 'NULL'; | |
| 563 | my $bundle_set = ($have_oi_bundle && $bid) | |
| 564 | ? ",bundle_id='$bid'" : ''; | |
| 565 | $db->db_readwrite($dbh, qq~ | |
| 566 | INSERT INTO `${DB}`.order_items | |
| 567 | SET order_id='$oid', | |
| 568 | model_id=$mid_sql, | |
| 569 | price_paid_cents='$price', | |
| 570 | quantity='$qty'$variant_set$bundle_set | |
| 571 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 572 | } | |
| 573 | ||
| 574 | # Persist per-jurisdiction tax breakdown for this order. The | |
| 575 | # Tax module also rolls the total back onto orders.tax_amount_cents | |
| 576 | # (idempotent with what we wrote on INSERT above, but cheap). | |
| 577 | $tax->write_order_tax_lines($db, $dbh, $DB, $oid, \@tax_lines) if @tax_lines; | |
| 578 | ||
| 579 | # Create the PaymentIntent. Idempotency key ties this to the order row | |
| 580 | # so retries don't create duplicate intents in Stripe. | |
| 581 | my $pi = $stripe->create_payment_intent( | |
| 582 | amount_cents => $total, | |
| 583 | currency => lc($currency), | |
| 584 | seller_account => $store->{stripe_account_id}, | |
| 585 | platform_fee_cents => $platform_fee, | |
| 586 | buyer_email => $email, | |
| 587 | order_id => $oid, | |
| 588 | storefront_id => $sid, | |
| 589 | idempotency_key => "repricer_order_$oid", | |
| 590 | ); | |
| 591 | ||
| 592 | if ($pi->{error} || !$pi->{client_secret}) { | |
| 593 | # Mark the order failed so it doesn't sit pending forever. | |
| 594 | $db->db_readwrite($dbh, qq~ | |
| 595 | UPDATE `${DB}`.orders SET status='failed' WHERE id='$oid' | |
| 596 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 597 | $db->db_disconnect($dbh); | |
| 598 | _json_out({ ok => 0, error => 'Stripe error: ' . ($pi->{error} || 'unknown') }); | |
| 599 | } | |
| 600 | ||
| 601 | my $pi_id = $pi->{id}; | |
| 602 | $pi_id =~ s/'/''/g; | |
| 603 | $db->db_readwrite($dbh, qq~ | |
| 604 | UPDATE `${DB}`.orders | |
| 605 | SET stripe_payment_intent_id='$pi_id' | |
| 606 | WHERE id='$oid' | |
| 607 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 608 | ||
| 609 | # Drop the cart_promotions row -- the discount is now baked into the | |
| 610 | # order. Keeping it would mean a retry (e.g. fresh PaymentIntent after | |
| 611 | # a network glitch) re-applies it on top of the already-discounted | |
| 612 | # total. The webhook reads from orders.applied_promotion_id directly. | |
| 613 | $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid) if $applied_promo_id; | |
| 614 | ||
| 615 | $db->db_disconnect($dbh); | |
| 616 | ||
| 617 | _json_out({ | |
| 618 | ok => 1, | |
| 619 | client_secret => $pi->{client_secret}, | |
| 620 | order_id => $oid + 0, | |
| 621 | }); |