Diff -- /var/www/vhosts/3dshawn.com/abforge.3dshawn.com/billing.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/abforge.3dshawn.com/billing.cgi

added on local at 2026-07-01 16:01:17

Added
+844
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 99014612aee0
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# ABForge - Seller Billing
4#
5# Per-user billing page. Five panels:
6# 1. Current subscription + next charge
7# 2. Credit balance + recent ledger activity
8# 3. Plan picker (upgrade/downgrade) - posts to billing_action.cgi
9# 4. Recent invoices (with credit_applied vs cash_paid split)
10# 5. Payment method (card brand + last4)
11#
12# Credit system: cash is NEVER charged while credit covers the bill.
13# The billing worker (deferred / Stripe Subscriptions API) applies
14# credit before charging. Customer here only sees the read-out.
15#======================================================================
16use strict;
17use warnings;
18
19use lib '/var/www/vhosts/abforge.com/httpdocs';
20use CGI;
21use MODS::Template;
22use MODS::DBConnect;
23use MODS::Login;
24use MODS::ABForge::Config;
25use MODS::ABForge::Wrapper;
26use MODS::ABForge::Billing;
27use MODS::ABForge::Promotions;
28
29my $q = CGI->new;
30my $form = $q->Vars;
31my $auth = MODS::Login->new;
32my $wrap = MODS::ABForge::Wrapper->new;
33my $tfile = MODS::Template->new;
34my $db = MODS::DBConnect->new;
35my $cfg = MODS::ABForge::Config->new;
36my $bill = MODS::ABForge::Billing->new;
37my $DB = $cfg->settings('database_name');
38
39$|=1;
40my $userinfo = $auth->login_verify();
41if (!$userinfo) {
42 print "Status: 302 Found\nLocation: /login.cgi\n\n";
43 exit;
44}
45require MODS::ABForge::Permissions;
46# Billing is owner-by-default but can be delegated to a team seat via
47# the `manage_billing` ptag. Owners pass through has_feature's owner
48# short-circuit; team members without the grant bounce to /dashboard.cgi.
49MODS::ABForge::Permissions->new->require_feature(
50 $userinfo, 'manage_billing', '/dashboard.cgi?denied=manage_billing'
51);
52my $uid = $userinfo->{user_id};
53$uid =~ s/[^0-9]//g;
54
55my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'billing';
56
57if ($entry eq 'billing_action') {
58 _handle_action($q, $form);
59 exit;
60}
61
62# Tutorial mode: when ?tutorial=1 we paint an example subscription,
63# credit ledger and invoice history so a brand-new account can see
64# what their billing page reads like once they have history.
65my $tutorial_mode = ($form->{tutorial} && $form->{tutorial} eq '1') ? 1 : 0;
66
67my $dbh = $db->db_connect();
68my $schema_ready = $bill->schema_ready($db, $dbh, $DB);
69
70# Flip any deferred downgrades whose pending_change_at has passed.
71# Cheap: most page-loads see zero rows due. Until the dedicated billing
72# worker exists, this keeps a scheduled downgrade from sitting beyond
73# its anchor date.
74$bill->apply_pending_changes_if_due($db, $dbh, $DB, $uid) if $schema_ready;
75
76# ---- Subscription + credit balance ----------------------------------
77my $sub = $schema_ready ? $bill->active_subscription($db, $dbh, $DB, $uid) : {};
78my $balance = $schema_ready ? $bill->credit_balance_cents($db, $dbh, $DB, $uid) : 0;
79my @ledger = $schema_ready ? $bill->credit_history($db, $dbh, $DB, $uid, 10) : ();
80my @invoices_raw = $schema_ready ? $bill->list_invoices($db, $dbh, $DB, $uid, 24) : ();
81my @pms = $schema_ready ? $bill->list_payment_methods($db, $dbh, $DB, $uid) : ();
82my @all_plans = $schema_ready ? $bill->list_plans($db, $dbh, $DB) : ();
83
84# Group plans by tier so the picker shows one card per tier with both
85# cadence prices side-by-side.
86my %plans_by_tier;
87foreach my $p (@all_plans) {
88 push @{ $plans_by_tier{ $p->{tier} } }, $p;
89}
90
91# Helper: decode plan features JSON for the picker card body.
92sub _parse_features {
93 my $blob = shift;
94 return [] unless defined $blob && $blob ne '';
95 my @out;
96 # Quick & tolerant parser: features ship as
97 # [{"name":"X","included":true}, ...]
98 # Avoid pulling JSON.pm just for this; rows are short and trusted.
99 while ($blob =~ /\{\s*"name"\s*:\s*"([^"]+)"\s*,\s*"included"\s*:\s*(true|false)\s*\}/gs) {
100 push @out, { name => $1, included => ($2 eq 'true') ? 1 : 0 };
101 }
102 return \@out;
103}
104
105# Build the plan-tier cards for the template.
106# Resolve the user's "current" tier: an active subscription wins, but
107# free users have no subscription row, so fall back to users.plan_tier
108# from the login session so the Free card still highlights for them.
109my $current_tier = ($sub && $sub->{tier})
110 ? $sub->{tier}
111 : ($userinfo->{plan_tier} || 'free');
112
113my @plan_cards;
114foreach my $tier (qw(free starter pro studio)) {
115 my $variants = $plans_by_tier{$tier} || [];
116 next unless @$variants;
117 my $monthly = (grep { $_->{cadence} eq 'monthly' } @$variants)[0];
118 my $annual = (grep { $_->{cadence} eq 'annual' } @$variants)[0];
119 my $price_m_cents = $monthly ? $monthly->{price_cents} : 0;
120 my $price_y_cents = $annual ? $annual->{price_cents} : 0;
121 my $features = _parse_features($monthly ? $monthly->{features} : '');
122 my $is_current = ($current_tier eq $tier) ? 1 : 0;
123
124 # Quote the switch into THIS plan so the confirm modal can be
125 # specific about money: "Charged $17.00 now (prorated)..." rather
126 # than the generic "upgrades take effect now" copy. Skipped for
127 # the user's own current tier since there's no button anyway.
128 my ($confirm_title, $confirm_message, $confirm_style, $confirm_label);
129 if (!$is_current && $monthly && $monthly->{id}) {
130 my $q = $bill->quote_plan_change($db, $dbh, $DB, $uid, $monthly->{id}, 'monthly');
131 my $charge_today = $q->{charge_today_cents} || 0;
132 my $proration = $q->{proration_credit_cents} || 0;
133 my $renewal = $q->{renewal_amount_cents} || 0;
134 my $cls = $q->{classification} || 'immediate';
135
136 if ($tier eq 'free') {
137 # Cancel-to-free path. Always deferred to end of cycle.
138 $confirm_title = 'Cancel paid plan and move to Free?';
139 $confirm_message = 'You stay on your current plan until the end of the cycle, then drop to Free automatically. No further charges.';
140 $confirm_label = 'Move to Free';
141 $confirm_style = 'warning';
142 } elsif ($cls eq 'deferred') {
143 $confirm_title = 'Schedule downgrade to ' . ucfirst($tier) . '?';
144 $confirm_message = 'You keep your current plan until the end of this cycle, then switch to ' . ucfirst($tier) . ' at ' . $bill->fmt_money($renewal) . '/month. No charge today.';
145 $confirm_label = 'Schedule downgrade';
146 $confirm_style = 'warning';
147 } else {
148 my $charge_str = $bill->fmt_money($charge_today);
149 my $renew_str = $bill->fmt_money($renewal);
150 $confirm_title = 'Switch to the ' . ucfirst($tier) . ' plan?';
151 if ($proration > 0) {
152 $confirm_message =
153 "You'll be charged $charge_str today. That's the $renew_str price minus a "
154 . $bill->fmt_money($proration)
155 . ' credit for the unused days of your current plan. Next renewal: ' . $renew_str . '/month.';
156 } elsif ($q->{needs_payment_method}) {
157 $confirm_message =
158 "You'll be charged $charge_str today, then $renew_str/month going forward. "
159 . 'You will be prompted to add a payment method first.';
160 } else {
161 $confirm_message =
162 "You'll be charged $charge_str today, then $renew_str/month going forward. "
163 . 'The charge runs against your card on file.';
164 }
165 $confirm_label = 'Switch to ' . ucfirst($tier) . ' · charge ' . $charge_str;
166 $confirm_style = 'primary';
167 }
168 } else {
169 $confirm_title = '';
170 $confirm_message = '';
171 $confirm_label = '';
172 $confirm_style = 'primary';
173 }
174
175 push @plan_cards, {
176 tier => $tier,
177 tier_label => ucfirst($tier),
178 display_name => $monthly ? $monthly->{display_name} : ucfirst($tier),
179 price_monthly => $bill->fmt_money($price_m_cents),
180 price_annual => $bill->fmt_money($price_y_cents),
181 is_free => ($tier eq 'free') ? 1 : 0,
182 price_m_cents => $price_m_cents,
183 price_y_cents => $price_y_cents,
184 plan_id_monthly => $monthly ? $monthly->{id} : 0,
185 plan_id_annual => $annual ? $annual->{id} : 0,
186 features => $features,
187 is_current => $is_current,
188 confirm_title => $confirm_title,
189 confirm_message => $confirm_message,
190 confirm_label => $confirm_label,
191 confirm_style => $confirm_style,
192 };
193}
194
195# Format invoice rows for the table.
196my @invoices;
197foreach my $r (@invoices_raw) {
198 my $status = $r->{status} || 'open';
199 push @invoices, {
200 id => $r->{id},
201 invoice_number => $r->{invoice_number} || ('INV-' . $r->{id}),
202 period_label => _format_period($r->{period_start}, $r->{period_end}),
203 amount_due_display => $bill->fmt_money($r->{amount_due_cents} || 0),
204 credit_applied_display => $bill->fmt_money($r->{credit_applied_cents} || 0),
205 cash_paid_display => $bill->fmt_money($r->{cash_paid_cents} || 0),
206 has_credit_applied => (($r->{credit_applied_cents} || 0) > 0) ? 1 : 0,
207 status => $status,
208 status_label => _status_label($status),
209 is_paid => $status eq 'paid' ? 1 : 0,
210 is_open => $status eq 'open' ? 1 : 0,
211 is_failed => $status eq 'failed' ? 1 : 0,
212 is_void => $status eq 'void' ? 1 : 0,
213 is_refunded => $status eq 'refunded' ? 1 : 0,
214 issued_at => $r->{issued_at} || $r->{created_at} || '',
215 paid_at => $r->{paid_at} || '-',
216 failure_reason => _h($r->{failure_reason} || ''),
217 has_failure => ($r->{failure_reason} && $status eq 'failed') ? 1 : 0,
218 };
219}
220
221# Credit-ledger rows for the activity feed.
222my @credit_rows;
223foreach my $r (@ledger) {
224 my $amt = $r->{amount_cents} || 0;
225 push @credit_rows, {
226 id => $r->{id},
227 amount_display => $bill->fmt_money($amt),
228 is_positive => ($amt >= 0) ? 1 : 0,
229 is_negative => ($amt < 0) ? 1 : 0,
230 reason => $r->{reason},
231 reason_label => _reason_label($r->{reason}),
232 note => _h($r->{note} || ''),
233 has_note => ($r->{note} && $r->{note} ne '') ? 1 : 0,
234 invoice_id => $r->{related_invoice_id} || 0,
235 created_at => $r->{created_at} || '',
236 };
237}
238
239# Default payment method.
240my %pm;
241foreach my $p (@pms) {
242 if ($p->{is_default} || !%pm) { %pm = %$p; }
243}
244my $has_pm = %pm ? 1 : 0;
245my $pm_brand_label = $has_pm ? (ucfirst($pm{brand} || 'card')) : '';
246my $pm_last4 = $has_pm ? ($pm{last4} || '----') : '';
247my $pm_exp = $has_pm ? sprintf('%02d/%02d', ($pm{exp_month} || 0), (($pm{exp_year} || 0) % 100)) : '';
248
249# Subscription display fields.
250my $has_sub = ($sub && $sub->{id}) ? 1 : 0;
251my $sub_status = $has_sub ? $sub->{status} : 'none';
252my $sub_plan_label = $has_sub ? $sub->{display_name} : 'Free';
253my $sub_tier = $has_sub ? $sub->{tier} : 'free';
254my $sub_cadence = $has_sub ? $sub->{cadence} : 'monthly';
255my $sub_price = $has_sub ? $bill->fmt_money($sub->{price_cents}) : '$0.00';
256my $sub_cadence_lbl = $bill->fmt_cadence($sub_cadence);
257my $sub_next_charge = $has_sub ? ($sub->{next_invoice_at} || 'not scheduled') : 'no upcoming charge';
258my $sub_is_canceling = ($has_sub && $sub->{cancel_at_period_end}) ? 1 : 0;
259my $sub_is_past_due = ($has_sub && $sub_status eq 'past_due') ? 1 : 0;
260my $sub_is_trialing = ($has_sub && $sub_status eq 'trialing') ? 1 : 0;
261
262# Pending plan change (scheduled downgrade). active_subscription() pulls
263# pending_plan_display_name / pending_plan_tier / pending_change_at when
264# the migration is in place; falsy when nothing is queued.
265my $has_pending_change = ($has_sub && $sub->{pending_plan_id}) ? 1 : 0;
266my $pending_plan_label = $has_pending_change ? ($sub->{pending_plan_display_name} || ucfirst($sub->{pending_plan_tier} || '')) : '';
267my $pending_change_at = $has_pending_change ? ($sub->{pending_change_at} || '') : '';
268my $pending_cadence_lbl = $has_pending_change ? ($bill->fmt_cadence($sub->{pending_cadence} || $sub->{cadence})) : '';
269
270# Estimate of the next-charge cash + credit split. Pure preview;
271# the worker recomputes against actual balance at invoice time.
272my $next_charge_cents = $has_sub ? ($sub->{price_cents} || 0) : 0;
273my $next_credit_applied = ($balance >= $next_charge_cents)
274 ? $next_charge_cents
275 : ($balance > 0 ? $balance : 0);
276my $next_cash_due = $next_charge_cents - $next_credit_applied;
277$next_cash_due = 0 if $next_cash_due < 0;
278
279$db->db_disconnect($dbh);
280
281# Active plan promo (for the marketing banner on the same panel; also
282# pre-fills the input so the seller can just click Apply).
283my $promo_obj = MODS::ABForge::Promotions->new;
284my $active_promo = $schema_ready ? $promo_obj->active_plan_promo($db, $dbh, $DB) : undef;
285my $promo_banner_code = ($active_promo && $active_promo->{code}) ? $active_promo->{code} : '';
286my $promo_banner_label = $active_promo ? $promo_obj->marketing_label($active_promo) : '';
287
288# Flash messages for the promo-code panel (set by billing_action.cgi
289# via ?promo_ok / ?promo_err query params on redirect).
290my $promo_flash_msg = '';
291my $promo_flash_kind = '';
292if (defined $form->{promo_ok} && length $form->{promo_ok}) {
293 my $cents = $form->{promo_ok}; $cents =~ s/[^0-9]//g; $cents = 0 unless $cents;
294 $promo_flash_kind = 'ok';
295 $promo_flash_msg = $cents
296 ? 'Code applied -- ' . $bill->fmt_money($cents) . ' in credit added. It will be used on your next invoice automatically.'
297 : 'Code accepted. Once you are on a paid plan, the discount will apply to your next invoice.';
298}
299if (defined $form->{promo_err} && length $form->{promo_err}) {
300 my $r = $form->{promo_err};
301 $r =~ s/[^A-Za-z0-9 .,;:_\-\$()%']//g;
302 $r = substr($r, 0, 200);
303 $promo_flash_kind = 'danger';
304 $promo_flash_msg = $r;
305}
306
307# Resume-upgrade hint: user just added a card after being bounced from
308# the change_plan flow. Quote the pending plan so we can render a one-
309# click "Complete upgrade" CTA at the top of the page.
310my $resume_plan = $form->{resume_plan} || '';
311$resume_plan =~ s/[^0-9]//g;
312my $resume_quote;
313my $resume_plan_label = '';
314my $resume_charge_str = '';
315if ($resume_plan) {
316 $resume_quote = $bill->quote_plan_change($db, $dbh, $DB, $uid, $resume_plan, '');
317 if ($resume_quote && ($resume_quote->{charge_today_cents} || 0) > 0) {
318 my $rp = $bill->plan_by_id($db, $dbh, $DB, $resume_plan);
319 $resume_plan_label = ($rp && $rp->{display_name}) ? $rp->{display_name} : 'paid';
320 $resume_charge_str = $bill->fmt_money($resume_quote->{charge_today_cents});
321 } else {
322 $resume_plan = '';
323 }
324}
325
326# Plan-change / charge flash. Same banner mechanism as the promo one,
327# just keyed off ?ok=plan_changed_charged or ?err=charge_failed.
328my $plan_flash_msg = '';
329my $plan_flash_kind = '';
330my $okv = defined $form->{ok} ? $form->{ok} : '';
331my $errv = defined $form->{err} ? $form->{err} : '';
332if ($okv eq 'plan_changed_charged') {
333 my $amt = $form->{amount}; $amt =~ s/[^0-9]//g if defined $amt; $amt = 0 unless $amt;
334 $plan_flash_kind = 'ok';
335 $plan_flash_msg = $amt
336 ? ('Plan upgraded and ' . $bill->fmt_money($amt) . ' charged to your card. Your new features are active right now.')
337 : 'Plan upgraded. Your new features are active right now.';
338} elsif ($okv eq 'plan_changed') {
339 $plan_flash_kind = 'ok';
340 $plan_flash_msg = 'Plan updated.';
341} elsif ($okv eq 'plan_scheduled') {
342 my $when = $form->{when}; $when =~ s/[^0-9\-: ]//g if defined $when;
343 $plan_flash_kind = 'ok';
344 $plan_flash_msg = 'Downgrade scheduled' . ($when ? " for $when." : '. It takes effect at the end of your current cycle.');
345} elsif ($errv eq 'charge_failed') {
346 my $detail = $form->{detail} || '';
347 $detail =~ s/[^A-Za-z0-9 .,;:_\-\$()%'#]//g;
348 $detail = substr($detail, 0, 240);
349 $plan_flash_kind = 'danger';
350 $plan_flash_msg = $detail
351 ? "Charge failed: $detail Your plan was NOT changed. Try a different card or contact support."
352 : 'Charge failed. Your plan was NOT changed. Try a different card or contact support.';
353} elsif ($errv eq 'plan_change_failed') {
354 $plan_flash_kind = 'danger';
355 $plan_flash_msg = 'Could not change your plan. Please try again or contact support.';
356}
357
358my $tvars = {
359 user_id => $uid,
360 promo_flash_msg => $promo_flash_msg,
361 promo_flash_kind => $promo_flash_kind,
362 has_promo_flash => length $promo_flash_msg ? 1 : 0,
363 plan_flash_msg => $plan_flash_msg,
364 plan_flash_kind => $plan_flash_kind,
365 plan_flash_is_ok => ($plan_flash_kind eq 'ok') ? 1 : 0,
366 plan_flash_is_err => ($plan_flash_kind eq 'danger') ? 1 : 0,
367 has_plan_flash => length $plan_flash_msg ? 1 : 0,
368 has_resume_plan => $resume_plan ? 1 : 0,
369 resume_plan_id => $resume_plan,
370 resume_plan_label => $resume_plan_label,
371 resume_charge_str => $resume_charge_str,
372 has_active_promo => $active_promo ? 1 : 0,
373 active_promo_code => $promo_banner_code,
374 active_promo_label => $promo_banner_label,
375
376 # Subscription
377 has_sub => $has_sub,
378 sub_status => $sub_status,
379 sub_status_label => _status_label($sub_status),
380 sub_plan_label => $sub_plan_label,
381 sub_tier => $sub_tier,
382 sub_tier_label => ucfirst($sub_tier || 'free'),
383 sub_cadence => $sub_cadence,
384 sub_cadence_label => $sub_cadence_lbl,
385 sub_price => $sub_price,
386 sub_next_charge => $sub_next_charge,
387 sub_is_canceling => $sub_is_canceling,
388 sub_is_past_due => $sub_is_past_due,
389 sub_is_trialing => $sub_is_trialing,
390
391 # Pending downgrade banner
392 has_pending_change => $has_pending_change,
393 pending_plan_label => $pending_plan_label,
394 pending_change_at => $pending_change_at,
395 pending_cadence_label => $pending_cadence_lbl,
396
397 next_charge_display => $bill->fmt_money($next_charge_cents),
398 next_credit_display => $bill->fmt_money($next_credit_applied),
399 next_cash_display => $bill->fmt_money($next_cash_due),
400 has_next_credit_applied => ($next_credit_applied > 0) ? 1 : 0,
401 next_cash_due_zero => ($next_cash_due == 0 && $next_charge_cents > 0) ? 1 : 0,
402
403 # Credit
404 credit_balance_display => $bill->fmt_money($balance),
405 credit_balance_cents => $balance,
406 has_credit_balance => ($balance > 0) ? 1 : 0,
407 credit_rows => \@credit_rows,
408 has_credit_history => scalar(@credit_rows) ? 1 : 0,
409
410 # Plans
411 plan_cards => \@plan_cards,
412 has_plans => scalar(@plan_cards) ? 1 : 0,
413
414 # Invoices
415 invoices => \@invoices,
416 has_invoices => scalar(@invoices) ? 1 : 0,
417
418 # Payment method
419 has_pm => $has_pm,
420 pm_brand_label => $pm_brand_label,
421 pm_last4 => $pm_last4,
422 pm_exp => $pm_exp,
423
424 # Schema readiness banner
425 schema_ready => $schema_ready ? 1 : 0,
426 schema_missing => $schema_ready ? 0 : 1,
427
428 # Tutorial mode
429 tutorial_mode => $tutorial_mode,
430 not_tutorial_mode => $tutorial_mode ? 0 : 1,
431};
432
433# ---- Tutorial-mode overlay -----------------------------------------
434# Painted only when ?tutorial=1. No DB; illustrative.
435if ($tutorial_mode) {
436 $tvars->{has_sub} = 1;
437 $tvars->{sub_status} = 'active';
438 $tvars->{sub_status_label} = 'Active';
439 $tvars->{sub_plan_label} = 'Pro';
440 $tvars->{sub_tier} = 'pro';
441 $tvars->{sub_tier_label} = 'Pro';
442 $tvars->{sub_cadence} = 'monthly';
443 $tvars->{sub_cadence_label} = 'month';
444 $tvars->{sub_price} = '$29.00';
445 $tvars->{sub_next_charge} = '2026-06-12';
446 $tvars->{sub_is_canceling} = 0;
447 $tvars->{sub_is_past_due} = 0;
448 $tvars->{sub_is_trialing} = 0;
449
450 $tvars->{next_charge_display} = '$29.00';
451 $tvars->{next_credit_display} = '$12.00';
452 $tvars->{next_cash_display} = '$17.00';
453 $tvars->{has_next_credit_applied} = 1;
454 $tvars->{next_cash_due_zero} = 0;
455
456 $tvars->{credit_balance_display} = '$12.00';
457 $tvars->{credit_balance_cents} = 1200;
458 $tvars->{has_credit_balance} = 1;
459 $tvars->{credit_rows} = [
460 { id=>3, amount_display=>'$25.00', is_positive=>1, is_negative=>0,
461 reason=>'refund', reason_label=>'Refund as credit',
462 note=>'Refund for April invoice issue (admin-issued).', has_note=>1,
463 invoice_id=>0, created_at=>'2026-05-02' },
464 { id=>2, amount_display=>'-$13.00', is_positive=>0, is_negative=>1,
465 reason=>'applied_to_invoice', reason_label=>'Applied to invoice INV-0001247-202605',
466 note=>'', has_note=>0,
467 invoice_id=>0, created_at=>'2026-05-12' },
468 { id=>1, amount_display=>'$10.00', is_positive=>1, is_negative=>0,
469 reason=>'promotional', reason_label=>'Promotional credit',
470 note=>'Welcome bonus for upgrading to Pro.', has_note=>1,
471 invoice_id=>0, created_at=>'2026-03-01' },
472 ];
473 $tvars->{has_credit_history} = 1;
474
475 # Pretend plans for the picker. Pro = current.
476 $tvars->{plan_cards} = [
477 { tier=>'free', tier_label=>'Free', display_name=>'Free',
478 price_monthly=>'$0.00', price_annual=>'$0.00',
479 is_free=>1, price_m_cents=>0, price_y_cents=>0,
480 plan_id_monthly=>1, plan_id_annual=>2,
481 features=>[
482 { name=>'Storefront with 5 active models', included=>1 },
483 { name=>'Stripe checkout (10% platform fee)', included=>1 },
484 { name=>'Cross-platform publishing', included=>0 },
485 { name=>'Pooled-data recommendations', included=>0 },
486 ],
487 is_current=>0 },
488 { tier=>'starter', tier_label=>'Starter', display_name=>'Starter',
489 price_monthly=>'$9.00', price_annual=>'$90.00',
490 is_free=>0, price_m_cents=>900, price_y_cents=>9000,
491 plan_id_monthly=>3, plan_id_annual=>4,
492 features=>[
493 { name=>'Unlimited models', included=>1 },
494 { name=>'Cross-platform publishing (2 marketplaces)', included=>1 },
495 { name=>'A/B and price experiments', included=>1 },
496 { name=>'Pooled-data recommendations', included=>0 },
497 ],
498 is_current=>0 },
499 { tier=>'pro', tier_label=>'Pro', display_name=>'Pro',
500 price_monthly=>'$29.00', price_annual=>'$290.00',
501 is_free=>0, price_m_cents=>2900, price_y_cents=>29000,
502 plan_id_monthly=>5, plan_id_annual=>6,
503 features=>[
504 { name=>'Unlimited models', included=>1 },
505 { name=>'Cross-platform publishing (all marketplaces)', included=>1 },
506 { name=>'A/B and price experiments', included=>1 },
507 { name=>'Pooled-data recommendations', included=>1 },
508 { name=>'Priority support', included=>1 },
509 ],
510 is_current=>1 },
511 { tier=>'studio', tier_label=>'Studio', display_name=>'Studio',
512 price_monthly=>'$99.00', price_annual=>'$990.00',
513 is_free=>0, price_m_cents=>9900, price_y_cents=>99000,
514 plan_id_monthly=>7, plan_id_annual=>8,
515 features=>[
516 { name=>'Everything in Pro', included=>1 },
517 { name=>'Team collaboration (up to 5 seats)', included=>1 },
518 { name=>'Custom domain + branded checkout', included=>1 },
519 { name=>'Dedicated onboarding', included=>1 },
520 ],
521 is_current=>0 },
522 ];
523 $tvars->{has_plans} = 1;
524
525 $tvars->{invoices} = [
526 { id=>4, invoice_number=>'INV-0001247-202605',
527 period_label=>'May 12 - Jun 11, 2026',
528 amount_due_display=>'$29.00', credit_applied_display=>'$12.00',
529 cash_paid_display=>'$17.00', has_credit_applied=>1,
530 status=>'paid', status_label=>'Paid',
531 is_paid=>1, is_open=>0, is_failed=>0, is_void=>0, is_refunded=>0,
532 issued_at=>'2026-05-12', paid_at=>'2026-05-12',
533 failure_reason=>'', has_failure=>0 },
534 { id=>3, invoice_number=>'INV-0001247-202604',
535 period_label=>'Apr 12 - May 11, 2026',
536 amount_due_display=>'$29.00', credit_applied_display=>'$0.00',
537 cash_paid_display=>'$29.00', has_credit_applied=>0,
538 status=>'refunded', status_label=>'Refunded as credit',
539 is_paid=>0, is_open=>0, is_failed=>0, is_void=>0, is_refunded=>1,
540 issued_at=>'2026-04-12', paid_at=>'2026-04-12',
541 failure_reason=>'', has_failure=>0 },
542 { id=>2, invoice_number=>'INV-0001247-202603',
543 period_label=>'Mar 12 - Apr 11, 2026',
544 amount_due_display=>'$29.00', credit_applied_display=>'$0.00',
545 cash_paid_display=>'$29.00', has_credit_applied=>0,
546 status=>'paid', status_label=>'Paid',
547 is_paid=>1, is_open=>0, is_failed=>0, is_void=>0, is_refunded=>0,
548 issued_at=>'2026-03-12', paid_at=>'2026-03-12',
549 failure_reason=>'', has_failure=>0 },
550 { id=>1, invoice_number=>'INV-0001247-202602',
551 period_label=>'Feb 12 - Mar 11, 2026',
552 amount_due_display=>'$29.00', credit_applied_display=>'$0.00',
553 cash_paid_display=>'$29.00', has_credit_applied=>0,
554 status=>'paid', status_label=>'Paid',
555 is_paid=>1, is_open=>0, is_failed=>0, is_void=>0, is_refunded=>0,
556 issued_at=>'2026-02-12', paid_at=>'2026-02-12',
557 failure_reason=>'', has_failure=>0 },
558 ];
559 $tvars->{has_invoices} = 1;
560
561 $tvars->{has_pm} = 1;
562 $tvars->{pm_brand_label} = 'Visa';
563 $tvars->{pm_last4} = '4242';
564 $tvars->{pm_exp} = '08/29';
565
566 $tvars->{schema_ready} = 1;
567 $tvars->{schema_missing} = 0;
568}
569
570print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
571
572my $body = join('', $tfile->template('abforge_billing.html', $tvars, $userinfo));
573
574$wrap->render({
575 userinfo => $userinfo,
576 page_key => 'billing',
577 title => 'Billing',
578 body => $body,
579});
580
581# ----------------------------------------------------------------- helpers
582sub _format_period {
583 my ($s, $e) = @_;
584 return '-' unless ($s || $e);
585 return ($s || '') . ' - ' . ($e || '');
586}
587
588sub _status_label {
589 my $s = shift || '';
590 return 'Active' if $s eq 'active';
591 return 'Trialing' if $s eq 'trialing';
592 return 'Past due' if $s eq 'past_due';
593 return 'Canceled' if $s eq 'canceled';
594 return 'Paused' if $s eq 'paused';
595 return 'Paid' if $s eq 'paid';
596 return 'Open' if $s eq 'open';
597 return 'Failed' if $s eq 'failed';
598 return 'Void' if $s eq 'void';
599 return 'Refunded as credit' if $s eq 'refunded';
600 return ucfirst($s);
601}
602
603sub _reason_label {
604 my $r = shift || '';
605 return 'Refund as credit' if $r eq 'refund';
606 return 'Manual credit grant' if $r eq 'manual_grant';
607 return 'Promotional credit' if $r eq 'promotional';
608 return 'Applied to invoice' if $r eq 'applied_to_invoice';
609 return 'Reversal' if $r eq 'reversal';
610 return 'Expired' if $r eq 'expired';
611 return ucfirst($r);
612}
613
614sub _h {
615 my $s = shift;
616 $s //= '';
617 $s =~ s/&/&amp;/g;
618 $s =~ s/</&lt;/g;
619 $s =~ s/>/&gt;/g;
620 $s =~ s/"/&quot;/g;
621 return $s;
622}
623
624#======================================================================
625# billing_action entry: POST handler
626#
627# Supported actions:
628# act=change_plan - upgrade (immediate) or downgrade
629# (deferred to current cycle end)
630# act=clear_pending_change - cancel a queued deferred downgrade
631# act=cancel_subscription - mark cancel_at_period_end=1
632# act=resume_subscription - undo a pending cancellation
633# act=apply_promo_code - redeem a plan-scope promo code
634# act=update_payment_method - legacy alias, bounces to /billing_payment.cgi
635# act=add_payment_method - legacy alias, bounces to /billing_payment.cgi
636# Every action redirects back to /billing.cgi (or /billing_payment.cgi)
637# with a status flash.
638#======================================================================
639sub _handle_action {
640 my ($q, $form) = @_;
641
642 my $act = defined $form->{act} ? $form->{act} : '';
643
644 my $dbh = $db->db_connect();
645 unless ($bill->schema_ready($db, $dbh, $DB)) {
646 $db->db_disconnect($dbh);
647 _act_redirect('/billing.cgi?err=schema');
648 return;
649 }
650
651 if ($act eq 'apply_promo_code') {
652 # User typed a code into the "Have a promo code?" panel on
653 # /billing.cgi. We validate against the platform promotions table,
654 # compute the discount against the user's CURRENT subscription
655 # price, then grant the equivalent as promotional credit via the
656 # existing credit_ledger flow.
657 my $code = defined $form->{promo_code} ? $form->{promo_code} : '';
658 my $promo = MODS::ABForge::Promotions->new;
659
660 my $row = $promo->load_by_code($db, $dbh, $DB, $code, kind => 'plan');
661 unless ($row && $row->{id}) {
662 $db->db_disconnect($dbh);
663 _act_redirect('/billing.cgi?promo_err=' . _act_u('That code is not valid for plan upgrades.'));
664 return;
665 }
666
667 my $sub = $bill->active_subscription($db, $dbh, $DB, $uid);
668 my $ref_cents = ($sub && $sub->{price_cents}) ? $sub->{price_cents} : 0;
669 unless ($ref_cents > 0) {
670 $db->db_disconnect($dbh);
671 _act_redirect('/billing.cgi?promo_err=' . _act_u('Upgrade to a paid plan first, then apply your promo code.'));
672 return;
673 }
674
675 my $plan_now = ($sub && $sub->{plan_id})
676 ? $bill->plan_by_id($db, $dbh, $DB, $sub->{plan_id})
677 : undef;
678 unless ($plan_now && $promo->promo_applies_to_plan($db, $dbh, $DB, $row->{id}, $plan_now)) {
679 $db->db_disconnect($dbh);
680 _act_redirect('/billing.cgi?promo_err=' . _act_u("That code isn't valid on your current plan. Switch to a covered plan first, then re-apply."));
681 return;
682 }
683
684 my %v = $promo->validate($db, $dbh, $DB, $row,
685 kind => 'plan',
686 user_id => $uid,
687 subtotal_cents => $ref_cents,
688 new_customer => 1,
689 );
690 unless ($v{ok}) {
691 $db->db_disconnect($dbh);
692 _act_redirect('/billing.cgi?promo_err=' . _act_u($v{reason} || 'That code is not valid right now.'));
693 return;
694 }
695
696 my $disc = $promo->apply_to_total_cents($row, $ref_cents);
697 my $rid = $promo->redeem($db, $dbh, $DB,
698 promotion_id => $row->{id},
699 target_kind => 'plan',
700 user_id => $uid,
701 subscription_id => ($sub && $sub->{id}) ? $sub->{id} : undef,
702 invoice_id => undef,
703 discount_applied_cents => $disc,
704 );
705 unless ($rid) {
706 $db->db_disconnect($dbh);
707 _act_redirect('/billing.cgi?promo_err=' . _act_u('Could not redeem the code. Please try again.'));
708 return;
709 }
710
711 if ($disc > 0) {
712 my $note = 'Promotion ' . ($row->{code} || ('#' . $row->{id}));
713 $bill->grant_credit($db, $dbh, $DB,
714 user_id => $uid,
715 amount_cents => $disc,
716 reason => 'promotional',
717 note => $note,
718 related_invoice_id => undef,
719 granted_by_user_id => undef,
720 );
721 }
722
723 $db->db_disconnect($dbh);
724 _act_redirect('/billing.cgi?promo_ok=' . $disc);
725 return;
726 }
727
728 if ($act eq 'change_plan') {
729 my $plan_id = defined $form->{plan_id} ? $form->{plan_id} : '';
730 $plan_id =~ s/[^0-9]//g;
731 unless ($plan_id) {
732 $db->db_disconnect($dbh);
733 _act_redirect('/billing.cgi?err=bad_plan');
734 return;
735 }
736
737 my $cadence = defined $form->{cadence} ? $form->{cadence} : '';
738 $cadence = 'annual' if $cadence eq 'annual';
739 $cadence = '' unless $cadence eq 'annual' || $cadence eq 'monthly';
740
741 my $quote = $bill->quote_plan_change($db, $dbh, $DB, $uid, $plan_id, $cadence);
742
743 if (($quote->{charge_today_cents} || 0) > 0) {
744 if ($quote->{needs_payment_method}) {
745 $db->db_disconnect($dbh);
746 _act_redirect('/billing_payment.cgi?need_card=1&next_plan=' . $plan_id);
747 return;
748 }
749 require MODS::ABForge::Stripe;
750 my $stripe = MODS::ABForge::Stripe->new;
751 my $result = $bill->change_plan_with_charge(
752 $db, $dbh, $DB, $uid, $plan_id, $cadence, $stripe
753 );
754 $db->db_disconnect($dbh);
755 if (!$result || !$result->{ok}) {
756 my $reason = ($result && $result->{reason}) ? $result->{reason} : 'unknown';
757 my $msg = ($result && $result->{error}) ? $result->{error} : '';
758 if ($reason eq 'no_pm') {
759 _act_redirect('/billing_payment.cgi?need_card=1&next_plan=' . $plan_id);
760 } else {
761 _act_redirect('/billing.cgi?err=charge_failed&reason=' . _act_u($reason)
762 . ($msg ? '&detail=' . _act_u($msg) : ''));
763 }
764 return;
765 }
766 _act_redirect('/billing.cgi?ok=plan_changed_charged&amount=' . ($result->{amount_cents} || 0));
767 return;
768 }
769
770 my $result = $bill->change_plan($db, $dbh, $DB, $uid, $plan_id, $cadence);
771 $db->db_disconnect($dbh);
772
773 if (!$result || !$result->{mode}) {
774 _act_redirect('/billing.cgi?err=plan_change_failed');
775 return;
776 }
777 if ($result->{mode} eq 'immediate') {
778 _act_redirect('/billing.cgi?ok=plan_changed');
779 return;
780 }
781 if ($result->{mode} eq 'deferred') {
782 my $when = defined $result->{effective_at} ? $result->{effective_at} : '';
783 _act_redirect('/billing.cgi?ok=plan_scheduled&when=' . _act_u($when));
784 return;
785 }
786 _act_redirect('/billing.cgi');
787 return;
788 }
789
790 if ($act eq 'clear_pending_change') {
791 $bill->clear_pending_change($db, $dbh, $DB, $uid);
792 $db->db_disconnect($dbh);
793 _act_redirect('/billing.cgi?ok=pending_cleared');
794 return;
795 }
796
797 if ($act eq 'cancel_subscription') {
798 my $sub = $bill->active_subscription($db, $dbh, $DB, $uid);
799 if ($sub && $sub->{id}) {
800 $db->db_readwrite($dbh, qq~
801 UPDATE `${DB}`.subscriptions
802 SET cancel_at_period_end=1
803 WHERE id='$sub->{id}' AND user_id='$uid'
804 ~, $ENV{SCRIPT_NAME}, __LINE__);
805 }
806 $db->db_disconnect($dbh);
807 _act_redirect('/billing.cgi?ok=canceled');
808 return;
809 }
810
811 if ($act eq 'resume_subscription') {
812 my $sub = $bill->active_subscription($db, $dbh, $DB, $uid);
813 if ($sub && $sub->{id}) {
814 $db->db_readwrite($dbh, qq~
815 UPDATE `${DB}`.subscriptions
816 SET cancel_at_period_end=0,
817 status='active'
818 WHERE id='$sub->{id}' AND user_id='$uid'
819 ~, $ENV{SCRIPT_NAME}, __LINE__);
820 }
821 $db->db_disconnect($dbh);
822 _act_redirect('/billing.cgi?ok=resumed');
823 return;
824 }
825
826 if ($act eq 'update_payment_method' || $act eq 'add_payment_method') {
827 $db->db_disconnect($dbh);
828 _act_redirect('/billing_payment.cgi');
829 return;
830 }
831
832 $db->db_disconnect($dbh);
833 _act_redirect('/billing.cgi?err=unknown_act');
834}
835
836sub _act_redirect {
837 my $url = shift;
838 print "Status: 302 Found\nLocation: $url\n\n";
839}
840sub _act_u {
841 my $s = shift; $s = '' unless defined $s;
842 $s =~ s/([^A-Za-z0-9\-_.~])/sprintf('%%%02X', ord($1))/eg;
843 return $s;
844}