Diff -- /var/www/vhosts/webstls.com/httpdocs/checkout.cgi
Diff

/var/www/vhosts/webstls.com/httpdocs/checkout.cgi

added on WebSTLs (webstls.com) at 2026-07-01 22:26:30

Added
+996
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 18e14ace6d5f
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1#!/usr/bin/perl
2#======================================================================
3# WebSTLs - Checkout (buyer-facing).
4#
5# Consolidates three former endpoints via SCRIPT_NAME dispatch:
6# /checkout.cgi -> render checkout page (HTML)
7# /checkout_intent.cgi -> create Stripe PaymentIntent (JSON)
8# /checkout_complete.cgi -> post-purchase landing page (HTML)
9#
10# The _intent and _complete .cgi files are now 3-line wrappers that
11# `do` this file.
12#
13# Stripe flow preserved byte-for-byte:
14# - Intent endpoint returns JSON { ok, client_secret, order_id }
15# (or { ok:1, free:1, order_id, redirect } for free orders).
16# - Complete endpoint is the redirect target for stripe.confirmPayment.
17# - Order state is authoritative from /stripe_webhook.cgi.
18#======================================================================
19use strict;
20use warnings;
21
22use lib '/var/www/vhosts/webstls.com/httpdocs';
23use CGI;
24use MODS::Template;
25use MODS::DBConnect;
26use MODS::WebSTLs::Config;
27use MODS::WebSTLs::Themes;
28use MODS::WebSTLs::Cart;
29use MODS::WebSTLs::Stripe;
30use MODS::WebSTLs::BuyerAuth;
31
32$| = 1;
33
34my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'checkout';
35
36if ($entry eq 'checkout_intent') {
37 _chk_intent();
38 exit;
39}
40elsif ($entry eq 'checkout_complete') {
41 _chk_complete();
42 exit;
43}
44
45# Default entry: render the checkout page.
46_chk_render();
47exit;
48
49#======================================================================
50# _chk_render -- GET /checkout.cgi?id=<storefront_id>
51#
52# When the storefront is connected to Stripe, this page renders the
53# real Stripe Elements payment form. The actual PaymentIntent is
54# created on demand by /checkout_intent.cgi (POSTed from the form) so
55# we don't generate intents for buyers who never type their email.
56#
57# When Stripe is not configured (platform-wide or seller-side), this
58# page falls back to a "checkout coming soon" panel.
59#======================================================================
60sub _chk_render {
61 my $q = CGI->new;
62 my $form = $q->Vars;
63 my $tfile = MODS::Template->new;
64 my $db = MODS::DBConnect->new;
65 my $config = MODS::WebSTLs::Config->new;
66 my $themes = MODS::WebSTLs::Themes->new;
67 my $cart = MODS::WebSTLs::Cart->new;
68 my $stripe = MODS::WebSTLs::Stripe->new;
69 my $buyer_auth = MODS::WebSTLs::BuyerAuth->new;
70 my $DB = $config->settings('database_name');
71
72 my $sid = $form->{id} || $form->{storefront_id} || 0;
73 $sid =~ s/[^0-9]//g;
74 unless ($sid) {
75 print "Status: 302 Found\nLocation: /\n\n";
76 return;
77 }
78
79 my $dbh = $db->db_connect();
80 my $store = $db->db_readwrite($dbh,
81 qq~SELECT id, name, subdomain, theme_id, stripe_account_id, stripe_onboarded_at
82 FROM `${DB}`.storefronts WHERE id='$sid' AND status='live' LIMIT 1~,
83 $ENV{SCRIPT_NAME}, __LINE__);
84 unless ($store && $store->{id}) {
85 $db->db_disconnect($dbh);
86 print "Status: 302 Found\nLocation: /\n\n";
87 return;
88 }
89
90 my $theme = $themes->by_id($store->{theme_id});
91 my $css_vars = $themes->css_vars($theme);
92
93 my $token = $cart->read_token($q);
94 my @rows = $cart->items($db, $dbh, $DB, $token, $sid);
95 my $total = $cart->total_cents($db, $dbh, $DB, $token, $sid);
96
97 # Detect whether any cart line requires shipping (a kind='physical'
98 # row). When so, the checkout page renders a shipping address form
99 # and a shipping-fee selector. Rates come from the seller's
100 # shipping_options_json (zone=cents lines on the model row).
101 my $needs_shipping = $cart->requires_shipping($db, $dbh, $DB, $token, $sid);
102
103 # Resolve the storefront's shipping zones. We probe models touched by
104 # this cart and use the FIRST physical line's shipping_options_json
105 # as the menu -- realistic for single-seller storefronts (the common
106 # case here). A multi-line cart with diverging rates per model would
107 # need a more elaborate "max per line" calc later.
108 my @ship_zones;
109 my $ship_from_country = '';
110 if ($needs_shipping) {
111 foreach my $r (@rows) {
112 next unless ($r->{purchase_kind} || '') eq 'physical';
113 my $mid = $r->{model_id}; $mid =~ s/[^0-9]//g;
114 next unless $mid;
115 my $mr = $db->db_readwrite($dbh, qq~
116 SELECT shipping_options_json, ship_from_country
117 FROM `${DB}`.models WHERE id='$mid' LIMIT 1
118 ~, $ENV{SCRIPT_NAME}, __LINE__);
119 next unless $mr;
120 $ship_from_country ||= $mr->{ship_from_country} || '';
121 my $raw = $mr->{shipping_options_json} || '';
122 foreach my $line (split /\r?\n/, $raw) {
123 $line =~ s/^\s+|\s+$//g;
124 next unless $line =~ /^([A-Za-z0-9_\-]{1,40})\s*=\s*(\d+)$/;
125 push @ship_zones, { slug => $1, cents => $2 + 0 };
126 }
127 last; # take the first physical model's rate set
128 }
129 # No rates? Fall back to a single free domestic zone so the
130 # buyer can still complete the order.
131 unless (@ship_zones) {
132 @ship_zones = ({ slug => 'standard', cents => 0 });
133 }
134 }
135
136 # Decorate shipping zones for the radio list. First zone is the
137 # default selection so the form always submits a valid ship_zone.
138 my @ship_options;
139 my $ship_idx = 0;
140 foreach my $z (@ship_zones) {
141 my $label = ucfirst($z->{slug});
142 $label =~ s/_/ /g;
143 push @ship_options, {
144 slug => $z->{slug},
145 cents => $z->{cents},
146 label => $label,
147 cost_label=> $z->{cents} > 0
148 ? '$' . sprintf('%.2f', $z->{cents} / 100)
149 : 'Free',
150 is_first => ($ship_idx == 0) ? 1 : 0,
151 checked_attr => ($ship_idx == 0) ? 'checked' : '',
152 };
153 $ship_idx++;
154 }
155
156 # Pull buyer email from session if they're logged in. Used to prefill
157 # the email field; buyer is free to overwrite.
158 my $buyer = $buyer_auth->verify($q, $db, $dbh, $DB);
159 my $prefill_email = ($buyer && $buyer->{email}) ? $buyer->{email} : '';
160
161 $db->db_disconnect($dbh);
162
163 # Three checkout states the template renders against.
164 my $platform_ready = $stripe->is_configured ? 1 : 0;
165 my $seller_ready = ($store->{stripe_account_id} && $store->{stripe_onboarded_at}) ? 1 : 0;
166 my $is_payable = ($platform_ready && $seller_ready && scalar(@rows) && $total > 0) ? 1 : 0;
167
168 # Decorate cart items for display.
169 my @items;
170 foreach my $r (@rows) {
171 my $title = $r->{title} || '';
172 $title =~ s/&/&amp;/g; $title =~ s/</&lt;/g; $title =~ s/>/&gt;/g; $title =~ s/"/&quot;/g;
173 push @items, {
174 title => $title,
175 qty => $r->{quantity} || 1,
176 line_total => '$' . sprintf('%.2f', ($r->{price_cents} || 0) * ($r->{quantity} || 1) / 100),
177 };
178 }
179
180 # Storefront header chrome (brand + search + sign in + cart) -- same
181 # shared helper every buyer-facing page uses so the header stays
182 # consistent across cart/checkout/listing_details/my_orders.
183 require MODS::WebSTLs::StoreChrome;
184 # Re-open a connection just for the nav-pages lookup -- the main
185 # checkout work already closed $dbh above.
186 my $chrome_dbh = $db->db_connect();
187 my $chrome_html = MODS::WebSTLs::StoreChrome->header_html({
188 store_id => $store->{id},
189 store_name => $store->{name} || $store->{subdomain},
190 is_buyer_in => ($prefill_email ? 1 : 0),
191 cart_count => scalar(@rows),
192 db => $db,
193 dbh => $chrome_dbh,
194 DB => $DB,
195 });
196 $db->db_disconnect($chrome_dbh);
197
198 my $tvars = {
199 theme_css_vars => $css_vars,
200 store_id => $store->{id},
201 store_name => $store->{name} || $store->{subdomain},
202 store_chrome_html => $chrome_html,
203 item_count => scalar(@rows),
204 has_items => scalar(@rows) ? 1 : 0,
205 items => \@items,
206 total_display => '$' . sprintf('%.2f', $total / 100),
207 total_cents => $total,
208 cart_href => "/cart.cgi?id=$sid",
209 back_href => "/store.cgi?id=$sid",
210
211 is_payable => $is_payable,
212 not_payable => $is_payable ? 0 : 1,
213 seller_not_ready => ($platform_ready && !$seller_ready) ? 1 : 0,
214 platform_not_ready => $platform_ready ? 0 : 1,
215
216 stripe_pk => $stripe->publishable_key,
217 prefill_email => $prefill_email,
218
219 needs_shipping => $needs_shipping,
220 ship_options => \@ship_options,
221 has_ship_options => $needs_shipping ? 1 : 0,
222 ship_from_country => $ship_from_country,
223 };
224
225 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";
226 print join('', $tfile->template('webstls_checkout.html', $tvars, undef));
227}
228
229#======================================================================
230# _chk_intent -- POST /checkout_intent.cgi
231# storefront_id, email
232#
233# Returns JSON:
234# { ok: 1, client_secret: '...', order_id: N }
235# { ok: 0, error: 'message' }
236#
237# Side effects:
238# - Inserts a pending row into `orders`
239# - Inserts rows into `order_items`
240# - Creates a Stripe PaymentIntent (destination charge to the
241# seller's connected account, with WebSTLs' application fee)
242# - Stores stripe_payment_intent_id on the order row
243#
244# Order is flipped to `paid` later by /stripe_webhook.cgi when Stripe
245# fires `payment_intent.succeeded`.
246#======================================================================
247sub _chk_intent {
248 require JSON::PP;
249 require MODS::WebSTLs::Promotions;
250 require MODS::WebSTLs::Receipts;
251 require MODS::WebSTLs::Tax;
252 require MODS::WebSTLs::BuyerCredits;
253
254 my $q = CGI->new;
255 my $form = $q->Vars;
256 my $db = MODS::DBConnect->new;
257 my $cfg = MODS::WebSTLs::Config->new;
258 my $cart = MODS::WebSTLs::Cart->new;
259 my $stripe = MODS::WebSTLs::Stripe->new;
260 my $buyer_auth = MODS::WebSTLs::BuyerAuth->new;
261 my $tax = MODS::WebSTLs::Tax->new;
262 my $bc = MODS::WebSTLs::BuyerCredits->new;
263 my $DB = $cfg->settings('database_name');
264
265 _chk_json_out({ ok => 0, error => 'POST only' }, '405 Method Not Allowed')
266 unless ($ENV{REQUEST_METHOD} || '') eq 'POST';
267
268 unless ($stripe->is_configured) {
269 _chk_json_out({ ok => 0, error => 'Payments are not configured yet.' });
270 }
271
272 my $sid = $form->{storefront_id} || 0;
273 $sid =~ s/[^0-9]//g;
274 my $email = $form->{email} || '';
275 $email =~ s/^\s+|\s+$//g;
276 $email = substr($email, 0, 191);
277
278 _chk_json_out({ ok => 0, error => 'Please enter a valid email.' })
279 unless $email =~ /\@/ && $email =~ /\./;
280 _chk_json_out({ ok => 0, error => 'Storefront not specified.' }) unless $sid;
281
282 my $dbh = $db->db_connect();
283
284 my $store = $db->db_readwrite($dbh, qq~
285 SELECT id, stripe_account_id, stripe_onboarded_at
286 FROM `${DB}`.storefronts
287 WHERE id='$sid' AND status='live' LIMIT 1
288 ~, $ENV{SCRIPT_NAME}, __LINE__);
289 unless ($store && $store->{stripe_account_id} && $store->{stripe_onboarded_at}) {
290 $db->db_disconnect($dbh);
291 _chk_json_out({ ok => 0, error => "This storefront isn't accepting payments yet." });
292 }
293
294 # Read cart from cookie.
295 my $token = $cart->read_token($q);
296 my @rows = $cart->items($db, $dbh, $DB, $token, $sid);
297 my $subtotal = $cart->total_cents($db, $dbh, $DB, $token, $sid);
298
299 unless (scalar(@rows) && $subtotal > 0) {
300 $db->db_disconnect($dbh);
301 _chk_json_out({ ok => 0, error => 'Your cart is empty.' });
302 }
303
304 # Re-validate any applied cart promo and bake the discount into the
305 # total BEFORE creating the order + PaymentIntent. The redemption row
306 # itself is written by stripe_webhook.cgi on payment_intent.succeeded
307 # (so a failed payment doesn't burn the buyer's max_per_user slot).
308 my $promo_mod = MODS::WebSTLs::Promotions->new;
309 my $applied_promo = $promo_mod->cart_applied($db, $dbh, $DB, $token, $sid);
310 my $discount_cents = 0;
311 my $applied_promo_id = 0;
312 my $applied_code_str = '';
313 if ($applied_promo) {
314 my %v = $promo_mod->validate($db, $dbh, $DB, $applied_promo,
315 kind => 'model',
316 subtotal_cents => $subtotal,
317 buyer_email => $email,
318 new_customer => 1,
319 );
320 if ($v{ok}) {
321 $discount_cents = $promo_mod->apply_to_total_cents($applied_promo, $subtotal);
322 $applied_promo_id = $applied_promo->{id};
323 $applied_code_str = $applied_promo->{code} || '';
324 } else {
325 # Stale code (expired between cart and checkout). Clear it so the
326 # buyer isn't stuck and gets a clean re-apply prompt on retry.
327 $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid);
328 }
329 }
330 my $after_discount = $subtotal - $discount_cents;
331 $after_discount = 0 if $after_discount < 0;
332
333 # Tax calculation. Buyer hands us billing country (+ optional region
334 # for US states / CA provinces) on the checkout form. Storefront-level
335 # tax_mode short-circuits inside calc_tax_lines -- if the seller is on
336 # 'seller_handles' the platform stays out and tax_lines is empty.
337 my $bill_country = uc($form->{bill_country} || ''); $bill_country =~ s/[^A-Z]//g;
338 my $bill_region = uc($form->{bill_region} || ''); $bill_region =~ s/[^A-Z0-9]//g;
339 my $bill_vat_id = uc($form->{vat_id} || ''); $bill_vat_id =~ s/[^A-Z0-9]//g;
340 $bill_country = substr($bill_country, 0, 2);
341 $bill_region = substr($bill_region, 0, 10);
342 $bill_vat_id = substr($bill_vat_id, 0, 20);
343
344 # Reverse-charge check (B2B EU): cached VIES validation overrides the
345 # normal tax calc and writes a zero-amount audit line.
346 my $reverse_charge = 0;
347 my $vat_country = '';
348 if (length($bill_vat_id) >= 4) {
349 my $vsafe = $bill_vat_id; $vsafe =~ s/'/''/g;
350 my $vc = $db->db_readwrite($dbh, qq~
351 SELECT vat_country, is_valid,
352 DATEDIFF(NOW(), validated_at) AS age
353 FROM `${DB}`.buyer_tax_info
354 WHERE vat_id='$vsafe'
355 ORDER BY id DESC LIMIT 1
356 ~, $ENV{SCRIPT_NAME}, __LINE__);
357 if ($vc && $vc->{is_valid} && defined $vc->{age} && $vc->{age} < 180) {
358 $reverse_charge = 1;
359 $vat_country = $vc->{vat_country};
360 }
361 }
362
363 # Dominant product_kind across the cart. Mixed-kind carts: prefer
364 # 'physical' (broader applies_to coverage). All-digital cart stays
365 # 'digital' so digital-exempt US states (e.g. Florida sales tax)
366 # correctly skip the line.
367 my $dominant_kind = 'digital';
368 {
369 my $has_physical = 0;
370 foreach my $row (@rows) {
371 my $mid = $row->{model_id} || 0; $mid =~ s/[^0-9]//g;
372 next unless $mid;
373 my $m = $db->db_readwrite($dbh, qq~
374 SELECT product_kind FROM `${DB}`.models WHERE id='$mid' LIMIT 1
375 ~, $ENV{SCRIPT_NAME}, __LINE__);
376 if ($m && $m->{product_kind} && $m->{product_kind} ne 'digital') {
377 $has_physical = 1; last;
378 }
379 }
380 $dominant_kind = $has_physical ? 'physical' : 'digital';
381 }
382
383 my @tax_lines;
384 my $tax_total = 0;
385 if (length $bill_country == 2 && $after_discount > 0) {
386 @tax_lines = $tax->calc_tax_lines(
387 db => $db,
388 dbh => $dbh,
389 DB => $DB,
390 storefront_id => $sid,
391 country_iso2 => $bill_country,
392 region_code => $bill_region,
393 product_kind => $dominant_kind,
394 taxable_amount_cents => $after_discount,
395 reverse_charge => $reverse_charge,
396 buyer_vat_id => $reverse_charge ? $bill_vat_id : '',
397 buyer_vat_country => $reverse_charge ? $vat_country : '',
398 evidence => {
399 buyer_country_billing => $bill_country,
400 buyer_country_ip => '', # TODO: IP-geo lookup -- skipped v1
401 },
402 );
403 foreach my $l (@tax_lines) { $tax_total += ($l->{tax_amount_cents} || 0); }
404 }
405
406 my $total = $after_discount + $tax_total;
407 $total = 0 if $total < 0;
408
409 # ---- Shipping fields + fee ---------------------------------------
410 # Buyer fills these in on the checkout page when at least one cart
411 # line is purchase_kind='physical'. We trust the seller's shipping
412 # rates configured in shipping_options_json -- the front-end already
413 # chose one and we re-resolve here defensively to prevent a tampered
414 # `ship_cents` from underpaying shipping.
415 my %ship = (
416 name => substr(_chk_trim($form->{ship_name} || ''), 0, 120),
417 addr1 => substr(_chk_trim($form->{ship_addr1} || ''), 0, 200),
418 addr2 => substr(_chk_trim($form->{ship_addr2} || ''), 0, 200),
419 city => substr(_chk_trim($form->{ship_city} || ''), 0, 120),
420 region => substr(_chk_trim($form->{ship_region} || ''), 0, 80),
421 postal => substr(_chk_trim($form->{ship_postal} || ''), 0, 20),
422 country => uc(substr(_chk_trim($form->{ship_country} || ''), 0, 2)),
423 phone => substr(_chk_trim($form->{ship_phone} || ''), 0, 40),
424 zone => substr(_chk_trim($form->{ship_zone} || ''), 0, 40),
425 );
426 my %bill = (
427 name => substr(_chk_trim($form->{bill_name} || ''), 0, 120),
428 addr1 => substr(_chk_trim($form->{bill_addr1} || ''), 0, 200),
429 addr2 => substr(_chk_trim($form->{bill_addr2} || ''), 0, 200),
430 city => substr(_chk_trim($form->{bill_city} || ''), 0, 120),
431 postal => substr(_chk_trim($form->{bill_postal} || ''), 0, 20),
432 phone => substr(_chk_trim($form->{bill_phone} || ''), 0, 40),
433 );
434 $ship{country} =~ s/[^A-Z]//g;
435 my $ship_cents = 0;
436 my $has_physical_line = 0;
437 foreach my $r (@rows) {
438 if (($r->{purchase_kind} || '') eq 'physical') { $has_physical_line = 1; last; }
439 }
440 if ($has_physical_line) {
441 if (!$ship{name} || !$ship{addr1} || !$ship{city} || !$ship{postal} || length($ship{country}) != 2) {
442 $db->db_disconnect($dbh);
443 _chk_json_out({ ok => 0, error => 'Shipping address is required for printed items.' });
444 }
445 # Resolve the rate server-side from the first physical model's
446 # shipping_options_json so a tampered client can't underpay.
447 if ($ship{zone}) {
448 foreach my $r (@rows) {
449 next unless ($r->{purchase_kind} || '') eq 'physical';
450 my $mid = $r->{model_id}; $mid =~ s/[^0-9]//g;
451 next unless $mid;
452 my $mr = $db->db_readwrite($dbh, qq~
453 SELECT shipping_options_json FROM `${DB}`.models WHERE id='$mid' LIMIT 1
454 ~, $ENV{SCRIPT_NAME}, __LINE__);
455 my $raw = $mr->{shipping_options_json} || '';
456 foreach my $line (split /\r?\n/, $raw) {
457 $line =~ s/^\s+|\s+$//g;
458 next unless $line =~ /^([A-Za-z0-9_\-]{1,40})\s*=\s*(\d+)$/;
459 if ($1 eq $ship{zone}) { $ship_cents = $2 + 0; last; }
460 }
461 last;
462 }
463 }
464 $total += $ship_cents;
465 }
466
467 # Probe for new schema columns ONCE here so both the free-order
468 # branch and the paid branch below can emit the right SET clauses.
469 my $have_ship_cols = 0;
470 {
471 my $r = $db->db_readwrite($dbh, qq~
472 SELECT COUNT(*) AS n FROM information_schema.columns
473 WHERE table_schema='$DB' AND table_name='orders'
474 AND column_name='requires_shipping'
475 ~, $ENV{SCRIPT_NAME}, __LINE__);
476 $have_ship_cols = 1 if $r && $r->{n};
477 }
478 my $have_oi_variant_cols = 0;
479 {
480 my $r = $db->db_readwrite($dbh, qq~
481 SELECT COUNT(*) AS n FROM information_schema.columns
482 WHERE table_schema='$DB' AND table_name='order_items'
483 AND column_name='purchase_kind'
484 ~, $ENV{SCRIPT_NAME}, __LINE__);
485 $have_oi_variant_cols = 1 if $r && $r->{n};
486 }
487 my $ship_set = '';
488 if ($have_ship_cols) {
489 my $req = $has_physical_line ? 1 : 0;
490 my @bits = ("requires_shipping='$req'", "shipping_cents='$ship_cents'");
491 if ($has_physical_line) {
492 push @bits, "shipping_zone='" . _chk_esc($ship{zone}) . "'";
493 push @bits, "ship_name='" . _chk_esc($ship{name}) . "'";
494 push @bits, "ship_addr1='" . _chk_esc($ship{addr1}) . "'";
495 push @bits, "ship_addr2='" . _chk_esc($ship{addr2}) . "'";
496 push @bits, "ship_city='" . _chk_esc($ship{city}) . "'";
497 push @bits, "ship_region='" . _chk_esc($ship{region}) . "'";
498 push @bits, "ship_postal='" . _chk_esc($ship{postal}) . "'";
499 push @bits, "ship_country='" . _chk_esc($ship{country}) . "'";
500 push @bits, "ship_phone='" . _chk_esc($ship{phone}) . "'";
501 }
502 $ship_set = ',' . join(',', @bits);
503 }
504 # Billing address snapshot (always written when columns exist). Probes
505 # bill_name column separately because the bill_* set landed in a later
506 # migration than the ship_* set.
507 my $have_bill_cols = 0;
508 {
509 my $r = $db->db_readwrite($dbh, qq~
510 SELECT COUNT(*) AS n FROM information_schema.columns
511 WHERE table_schema='$DB' AND table_name='orders'
512 AND column_name='bill_name'
513 ~, $ENV{SCRIPT_NAME}, __LINE__);
514 $have_bill_cols = 1 if $r && $r->{n};
515 }
516 my $bill_set = '';
517 if ($have_bill_cols && length $bill{name}) {
518 my @bits;
519 push @bits, "bill_name='" . _chk_esc($bill{name}) . "'";
520 push @bits, "bill_addr1='" . _chk_esc($bill{addr1}) . "'";
521 push @bits, "bill_addr2='" . _chk_esc($bill{addr2}) . "'";
522 push @bits, "bill_city='" . _chk_esc($bill{city}) . "'";
523 push @bits, "bill_postal='" . _chk_esc($bill{postal}) . "'";
524 push @bits, "bill_phone='" . _chk_esc($bill{phone}) . "'";
525 $bill_set = ',' . join(',', @bits);
526 }
527
528 # Does order_items have the bundle_id column? Probe once.
529 my $have_oi_bundle = 0;
530 {
531 my $r = $db->db_readwrite($dbh, qq~
532 SELECT COUNT(*) AS n FROM information_schema.columns
533 WHERE table_schema='$DB' AND table_name='order_items'
534 AND column_name='bundle_id'
535 ~, $ENV{SCRIPT_NAME}, __LINE__);
536 $have_oi_bundle = 1 if $r && $r->{n};
537 }
538
539 # ---- Resolve buyer_account_id (used by credit + free-order branches) ---
540 # We never trust the cookie alone -- the buyer must be logged in AND the
541 # email they typed must match their session, so a guest session can't
542 # silently spend a registered buyer's credit.
543 my $buyer_account_id = 0;
544 {
545 my $b = $buyer_auth->verify($q, $db, $dbh, $DB);
546 if ($b && lc($b->{email}) eq lc($email)) {
547 $buyer_account_id = $b->{id};
548 $buyer_account_id =~ s/[^0-9]//g;
549 }
550 }
551
552 # ---- Apply available store credit -------------------------------------
553 # Only registered buyers can redeem. Guest checkouts that match an
554 # email with credit must sign in first (we surface this on the cart UI;
555 # here we just refuse to apply it without auth so an email-spoof attack
556 # can't drain another user's credit).
557 my $store_credit_applied = 0;
558 if ($buyer_account_id && $total > 0) {
559 my $bal = $bc->balance_cents($db, $dbh, $DB, $sid,
560 { buyer_account_id => $buyer_account_id });
561 if ($bal > 0) {
562 $store_credit_applied = $bal > $total ? $total : $bal;
563 $total -= $store_credit_applied;
564 }
565 }
566
567 # ---- Free-order short-circuit -----------------------------------------
568 # Stripe rejects $0 PaymentIntents, so a 100%-off promo (or a $0 cart)
569 # can't go through the normal flow. Instead we create the order as
570 # already-paid, redeem the promo inline (the webhook usually handles
571 # that on PI success -- there's no webhook for free orders), link to
572 # the buyer_account if we can, drop the cart_promotions row, and
573 # return a `free=>1` response with a redirect URL. The JS in
574 # webstls_checkout.html navigates straight to /checkout_complete.cgi.
575 if ($total <= 0) {
576 # buyer_account_id was resolved above (shared with the paid branch
577 # and with the credit-application step).
578 my $currency = uc($cfg->settings('stripe_currency_default') || 'USD');
579 my $promo_sql = $applied_promo_id ? "'$applied_promo_id'" : 'NULL';
580 my $code_sql = $applied_code_str ? "'" . _chk_esc($applied_code_str) . "'" : 'NULL';
581
582 # platform_fee + payout stay zero -- nothing changed hands.
583 # store_credit_applied_cents is conditional: only emit the column
584 # in the INSERT when there's actually credit to record. That way
585 # this CGI keeps working on a server that has the new BuyerCredits
586 # code but hasn't run the ALTER orders ADD COLUMN yet.
587 my $credit_set = $store_credit_applied > 0
588 ? ",store_credit_applied_cents='$store_credit_applied'" : '';
589 $db->db_readwrite($dbh, qq~
590 INSERT INTO `${DB}`.orders
591 SET storefront_id='$sid',
592 buyer_email='~ . _chk_esc($email) . qq~',
593 buyer_account_id=~ . ($buyer_account_id ? "'$buyer_account_id'" : "NULL") . qq~,
594 total_amount_cents='0',
595 currency='~ . _chk_esc($currency) . qq~',
596 status='paid',
597 payment_processor='free',
598 platform_fee_cents='0',
599 creator_payout_cents='0',
600 promotional_code_used=$code_sql,
601 applied_promotion_id=$promo_sql,
602 discount_applied_cents='$discount_cents'$credit_set$ship_set$bill_set,
603 paid_at=NOW(),
604 created_at=NOW()
605 ~, $ENV{SCRIPT_NAME}, __LINE__);
606
607 my $oid_row = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__);
608 my $oid = $oid_row->{id} || 0;
609 $oid =~ s/[^0-9]//g;
610 unless ($oid) {
611 $db->db_disconnect($dbh);
612 _chk_json_out({ ok => 0, error => 'Free order create failed.' });
613 }
614
615 # Line items at the discounted price (which may be zero). Pull
616 # per-line kind/color/material through to order_items so even a
617 # free order surfaces "Print pending" in the seller's queue.
618 foreach my $r (@rows) {
619 my $mid = $r->{model_id} || 0;
620 my $bid = $r->{bundle_id} || 0;
621 my $qty = $r->{quantity} || 1;
622 $mid =~ s/[^0-9]//g; $bid =~ s/[^0-9]//g; $qty =~ s/[^0-9]//g;
623 next unless $mid || $bid;
624 my $variant_set = _chk_oi_variant_set($r, $have_oi_variant_cols);
625 my $mid_sql = $mid ? "'$mid'" : 'NULL';
626 my $bundle_set = ($have_oi_bundle && $bid)
627 ? ",bundle_id='$bid'" : '';
628 $db->db_readwrite($dbh, qq~
629 INSERT INTO `${DB}`.order_items
630 SET order_id='$oid',
631 model_id=$mid_sql,
632 price_paid_cents='0',
633 quantity='$qty'$variant_set$bundle_set
634 ~, $ENV{SCRIPT_NAME}, __LINE__);
635 }
636
637 # Burn the promo redemption slot -- otherwise a buyer with a
638 # max_per_user=1 free promo could replay it on a different cart.
639 if ($applied_promo_id && $applied_promo_id > 0) {
640 $promo_mod->redeem($db, $dbh, $DB,
641 promotion_id => $applied_promo_id,
642 target_kind => 'model',
643 order_id => $oid,
644 buyer_account_id => $buyer_account_id || undef,
645 buyer_email => $email,
646 discount_applied_cents => $discount_cents,
647 );
648 }
649
650 # Mirror the webhook's buyer_account back-link logic so /my_orders.cgi
651 # picks the order up immediately for a signed-in buyer.
652 if ($email && $sid) {
653 my $ba = $db->db_readwrite($dbh, qq~
654 SELECT id FROM `${DB}`.buyer_accounts
655 WHERE storefront_id='$sid' AND email='~ . _chk_esc($email) . qq~'
656 LIMIT 1
657 ~, $ENV{SCRIPT_NAME}, __LINE__);
658 if ($ba && $ba->{id}) {
659 $db->db_readwrite($dbh, qq~
660 UPDATE `${DB}`.orders SET buyer_account_id='$ba->{id}'
661 WHERE id='$oid' AND buyer_account_id IS NULL
662 ~, $ENV{SCRIPT_NAME}, __LINE__);
663 }
664 }
665
666 # Drop the cart_promotions row to mirror the paid-branch behavior.
667 $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid) if $applied_promo_id;
668
669 # Write the negative buyer_credit_ledger row that consumes the
670 # applied balance. Free-order path has no Stripe webhook so we have
671 # to do it inline. Idempotent on (related_order_id, reason).
672 $bc->apply_to_order($db, $dbh, $DB, $oid) if $store_credit_applied > 0;
673
674 # Receipt email with signed download links. eval'd because a mail
675 # failure must not block the JSON response -- the buyer still
676 # needs the redirect URL to reach /checkout_complete.cgi and see
677 # in-app download buttons.
678 eval {
679 MODS::WebSTLs::Receipts->send_for_order($db, $dbh, $DB, $oid);
680 };
681
682 $db->db_disconnect($dbh);
683 _chk_json_out({
684 ok => 1,
685 free => 1,
686 order_id => $oid + 0,
687 redirect => "/checkout_complete.cgi?order=$oid",
688 });
689 }
690
691 # $buyer_account_id was resolved above (shared with the credit + free
692 # branches). Compute the platform fee next.
693 # bps = basis points; 1000 bps = 10%.
694 my $bps = $cfg->settings('stripe_platform_fee_bps') || 1000;
695 my $platform_fee = int($total * $bps / 10000);
696 my $payout = $total - $platform_fee;
697 my $currency = uc($cfg->settings('stripe_currency_default') || 'USD');
698
699 # Insert the pending order row. Trigger sets created_at automatically
700 # (BEFORE INSERT) but we set it here explicitly to be defensive.
701 my $ip = $ENV{REMOTE_ADDR} || '';
702 my $promo_sql = $applied_promo_id ? "'$applied_promo_id'" : 'NULL';
703 my $code_sql = $applied_code_str ? "'" . _chk_esc($applied_code_str) . "'" : 'NULL';
704 my $bc_sql = length($bill_country) == 2 ? "'$bill_country'" : 'NULL';
705 my $br_sql = length($bill_region) ? "'$bill_region'" : 'NULL';
706 my $credit_set = $store_credit_applied > 0
707 ? ",store_credit_applied_cents='$store_credit_applied'" : '';
708 $db->db_readwrite($dbh, qq~
709 INSERT INTO `${DB}`.orders
710 SET storefront_id='$sid',
711 buyer_email='~ . _chk_esc($email) . qq~',
712 buyer_account_id=~ . ($buyer_account_id ? "'$buyer_account_id'" : "NULL") . qq~,
713 total_amount_cents='$total',
714 subtotal_cents='$subtotal',
715 tax_amount_cents='$tax_total',
716 buyer_country_iso2=$bc_sql,
717 buyer_region_code=$br_sql,
718 currency='~ . _chk_esc($currency) . qq~',
719 status='pending',
720 payment_processor='stripe',
721 platform_fee_cents='$platform_fee',
722 creator_payout_cents='$payout',
723 promotional_code_used=$code_sql,
724 applied_promotion_id=$promo_sql,
725 discount_applied_cents='$discount_cents'$credit_set$ship_set,
726 created_at=NOW()
727 ~, $ENV{SCRIPT_NAME}, __LINE__);
728
729 my $oid_row = $db->db_readwrite($dbh, qq~SELECT LAST_INSERT_ID() AS id~, $ENV{SCRIPT_NAME}, __LINE__);
730 my $oid = $oid_row->{id} || 0;
731 $oid =~ s/[^0-9]//g;
732 unless ($oid) {
733 $db->db_disconnect($dbh);
734 _chk_json_out({ ok => 0, error => 'Order create failed.' });
735 }
736
737 # Insert the line items. Per-line kind/color/material/fulfillment
738 # come from the cart row via the shared _chk_oi_variant_set helper.
739 # Bundle rows arrive with model_id NULL + bundle_id set.
740 foreach my $r (@rows) {
741 my $mid = $r->{model_id} || 0;
742 my $bid = $r->{bundle_id} || 0;
743 my $price = $r->{price_cents} || $r->{unit_price_cents} || 0;
744 my $qty = $r->{quantity} || 1;
745 $mid =~ s/[^0-9]//g;
746 $bid =~ s/[^0-9]//g;
747 $price =~ s/[^0-9]//g;
748 $qty =~ s/[^0-9]//g;
749 next unless ($mid || $bid) && $price;
750 my $variant_set = _chk_oi_variant_set($r, $have_oi_variant_cols);
751 my $mid_sql = $mid ? "'$mid'" : 'NULL';
752 my $bundle_set = ($have_oi_bundle && $bid)
753 ? ",bundle_id='$bid'" : '';
754 $db->db_readwrite($dbh, qq~
755 INSERT INTO `${DB}`.order_items
756 SET order_id='$oid',
757 model_id=$mid_sql,
758 price_paid_cents='$price',
759 quantity='$qty'$variant_set$bundle_set
760 ~, $ENV{SCRIPT_NAME}, __LINE__);
761 }
762
763 # Persist per-jurisdiction tax breakdown for this order. The
764 # Tax module also rolls the total back onto orders.tax_amount_cents
765 # (idempotent with what we wrote on INSERT above, but cheap).
766 $tax->write_order_tax_lines($db, $dbh, $DB, $oid, \@tax_lines) if @tax_lines;
767
768 # Create the PaymentIntent. Idempotency key ties this to the order row
769 # so retries don't create duplicate intents in Stripe.
770 my $pi = $stripe->create_payment_intent(
771 amount_cents => $total,
772 currency => lc($currency),
773 seller_account => $store->{stripe_account_id},
774 platform_fee_cents => $platform_fee,
775 buyer_email => $email,
776 order_id => $oid,
777 storefront_id => $sid,
778 idempotency_key => "webstls_order_$oid",
779 );
780
781 if ($pi->{error} || !$pi->{client_secret}) {
782 # Mark the order failed so it doesn't sit pending forever.
783 $db->db_readwrite($dbh, qq~
784 UPDATE `${DB}`.orders SET status='failed' WHERE id='$oid'
785 ~, $ENV{SCRIPT_NAME}, __LINE__);
786 $db->db_disconnect($dbh);
787 _chk_json_out({ ok => 0, error => 'Stripe error: ' . ($pi->{error} || 'unknown') });
788 }
789
790 my $pi_id = $pi->{id};
791 $pi_id =~ s/'/''/g;
792 $db->db_readwrite($dbh, qq~
793 UPDATE `${DB}`.orders
794 SET stripe_payment_intent_id='$pi_id'
795 WHERE id='$oid'
796 ~, $ENV{SCRIPT_NAME}, __LINE__);
797
798 # Drop the cart_promotions row -- the discount is now baked into the
799 # order. Keeping it would mean a retry (e.g. fresh PaymentIntent after
800 # a network glitch) re-applies it on top of the already-discounted
801 # total. The webhook reads from orders.applied_promotion_id directly.
802 $promo_mod->cart_clear($db, $dbh, $DB, $token, $sid) if $applied_promo_id;
803
804 $db->db_disconnect($dbh);
805
806 _chk_json_out({
807 ok => 1,
808 client_secret => $pi->{client_secret},
809 order_id => $oid + 0,
810 });
811}
812
813#======================================================================
814# _chk_complete -- GET /checkout_complete.cgi?order=N
815# [&payment_intent=...&payment_intent_client_secret=...]
816#
817# Stripe redirects the buyer here after stripe.confirmPayment(). The
818# definitive payment state comes from the webhook (orders.status), but
819# Stripe also appends a `redirect_status` query param we use as a hint
820# while the webhook is in flight.
821#======================================================================
822sub _chk_complete {
823 require MODS::WebSTLs::Tax;
824
825 my $q = CGI->new;
826 my $form = $q->Vars;
827 my $tfile = MODS::Template->new;
828 my $db = MODS::DBConnect->new;
829 my $config = MODS::WebSTLs::Config->new;
830 my $themes = MODS::WebSTLs::Themes->new;
831 my $cart = MODS::WebSTLs::Cart->new;
832 my $DB = $config->settings('database_name');
833
834 my $oid = $form->{order} || 0;
835 $oid =~ s/[^0-9]//g;
836
837 my $redirect_status = $form->{redirect_status} || '';
838
839 unless ($oid) {
840 print "Status: 302 Found\nLocation: /\n\n";
841 return;
842 }
843
844 my $dbh = $db->db_connect();
845
846 my $order = $db->db_readwrite($dbh, qq~
847 SELECT o.id, o.storefront_id, o.status, o.buyer_email,
848 o.total_amount_cents, o.subtotal_cents, o.tax_amount_cents, o.currency,
849 s.name AS store_name, s.subdomain, s.theme_id
850 FROM `${DB}`.orders o
851 JOIN `${DB}`.storefronts s ON s.id = o.storefront_id
852 WHERE o.id='$oid' LIMIT 1
853 ~, $ENV{SCRIPT_NAME}, __LINE__);
854
855 unless ($order && $order->{id}) {
856 $db->db_disconnect($dbh);
857 print "Status: 302 Found\nLocation: /\n\n";
858 return;
859 }
860
861 # Pull line items so the receipt is itemized.
862 my @items = $db->db_readwrite_multiple($dbh, qq~
863 SELECT oi.id, oi.price_paid_cents, oi.quantity,
864 m.id AS model_id, m.title
865 FROM `${DB}`.order_items oi
866 JOIN `${DB}`.models m ON m.id = oi.model_id
867 WHERE oi.order_id='$oid'
868 ORDER BY oi.id
869 ~, $ENV{SCRIPT_NAME}, __LINE__);
870
871 # Clear the cart if the order is paid (webhook already fired) so the
872 # buyer doesn't see stale items when they return to the storefront.
873 if (($order->{status} || '') eq 'paid') {
874 my $token = $cart->read_token($q);
875 $cart->clear($db, $dbh, $DB, $token, $order->{storefront_id}) if $token;
876 }
877
878 my $theme = $themes->by_id($order->{theme_id});
879 my $css_vars = $themes->css_vars($theme);
880
881 # Per-jurisdiction tax breakdown for the receipt.
882 my $tax_summary = MODS::WebSTLs::Tax->new->summary_for_order($db, $dbh, $DB, $oid);
883
884 $db->db_disconnect($dbh);
885
886 my $status = $order->{status} || 'pending';
887
888 # UI state. Three possibilities:
889 # paid -> webhook already fired; show success + download links
890 # pending -> webhook in flight; show "processing" with auto-refresh
891 # failed -> something went wrong; surface the error path
892 my $is_paid = ($status eq 'paid') ? 1 : 0;
893 my $is_failed = ($status eq 'failed') ? 1 : 0;
894 my $is_pending = (!$is_paid && !$is_failed) ? 1 : 0;
895
896 # A failed redirect_status from Stripe means the buyer's card was
897 # declined or 3DS failed -- treat that as definitive failure even if
898 # our DB row is still pending.
899 if (lc($redirect_status) eq 'failed') {
900 $is_paid = 0;
901 $is_pending = 0;
902 $is_failed = 1;
903 }
904
905 my @item_rows;
906 foreach my $it (@items) {
907 my $title = $it->{title} || ('Model #' . $it->{model_id});
908 $title =~ s/&/&amp;/g; $title =~ s/</&lt;/g; $title =~ s/>/&gt;/g; $title =~ s/"/&quot;/g;
909 push @item_rows, {
910 title => $title,
911 qty => $it->{quantity} || 1,
912 line_total => '$' . sprintf('%.2f', ($it->{price_paid_cents} || 0) * ($it->{quantity} || 1) / 100),
913 download_url => $is_paid ? "/download.cgi?order=$oid&item=$it->{id}" : '',
914 };
915 }
916
917 my @tax_rows;
918 foreach my $l (@$tax_summary) {
919 push @tax_rows, {
920 label => $l->{jurisdiction_label},
921 rate => sprintf('%.2f', $l->{rate_pct}),
922 cents => '$' . sprintf('%.2f', ($l->{tax_amount_cents} || 0) / 100),
923 };
924 }
925
926 require MODS::WebSTLs::StoreChrome;
927 my $chrome_dbh = $db->db_connect();
928 my $chrome_html = MODS::WebSTLs::StoreChrome->header_html({
929 store_id => $order->{storefront_id},
930 store_name => $order->{store_name} || $order->{subdomain},
931 is_buyer_in => ($order->{buyer_email} ? 1 : 0),
932 cart_count => 0,
933 db => $db,
934 dbh => $chrome_dbh,
935 DB => $DB,
936 });
937 $db->db_disconnect($chrome_dbh);
938
939 my $tvars = {
940 theme_css_vars => $css_vars,
941 order_id => $oid + 0,
942 store_name => $order->{store_name} || $order->{subdomain},
943 store_id => $order->{storefront_id},
944 store_chrome_html => $chrome_html,
945 buyer_email => $order->{buyer_email},
946 subtotal_display => '$' . sprintf('%.2f', ($order->{subtotal_cents} || 0) / 100),
947 tax_display => '$' . sprintf('%.2f', ($order->{tax_amount_cents} || 0) / 100),
948 has_tax => ($order->{tax_amount_cents} && $order->{tax_amount_cents} > 0) ? 1 : 0,
949 tax_lines => \@tax_rows,
950 total_display => '$' . sprintf('%.2f', ($order->{total_amount_cents} || 0) / 100),
951 is_paid => $is_paid,
952 is_pending => $is_pending,
953 is_failed => $is_failed,
954 items => \@item_rows,
955 has_items => scalar(@item_rows) ? 1 : 0,
956 back_href => "/store.cgi?id=$order->{storefront_id}",
957 orders_href => "/my_orders.cgi?id=$order->{storefront_id}",
958 };
959
960 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";
961 print join('', $tfile->template('webstls_checkout_complete.html', $tvars, undef));
962}
963
964#======================================================================
965# Shared helpers (intent branch)
966#======================================================================
967sub _chk_json_out {
968 my ($h, $status) = @_;
969 $status ||= '200 OK';
970 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";
971 print JSON::PP::encode_json($h);
972 exit;
973}
974
975sub _chk_esc {
976 my $s = shift // '';
977 $s =~ s/\\/\\\\/g;
978 $s =~ s/'/''/g;
979 return $s;
980}
981
982sub _chk_trim {
983 my $s = shift // '';
984 $s =~ s/^\s+|\s+$//g;
985 return $s;
986}
987
988sub _chk_oi_variant_set {
989 my ($r, $have) = @_;
990 return '' unless $have;
991 my $kind = ($r->{purchase_kind} && $r->{purchase_kind} eq 'physical') ? 'physical' : 'digital';
992 my $color = $r->{selected_color} || ''; $color =~ s/\\/\\\\/g; $color =~ s/'/''/g;
993 my $mat = $r->{selected_material} || ''; $mat =~ s/\\/\\\\/g; $mat =~ s/'/''/g;
994 my $fstat = ($kind eq 'physical') ? 'pending' : 'not_required';
995 return ",purchase_kind='$kind',selected_color='$color',selected_material='$mat',fulfillment_status='$fstat'";
996}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help