Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/admin_billing.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/crm.3dshawn.com/admin_billing.cgi

added on local at 2026-07-11 18:31:38

Added
+693
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 31790bc0a1d5
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# ContactForge - Admin Billing Console
4#
5# Consolidates the former /admin_billing_action.cgi (POST handler)
6# via SCRIPT_NAME dispatch. The _action.cgi file is a wrapper that
7# `do`s this file.
8#
9# Company-staff only. Surfaces every dimension of the billing system:
10# - Money received (MTD) -- actual cash received this calendar month
11# - Credit consumed (30d) -- services delivered against credit
12# - Outstanding credit -- liability still on the books
13# - MRR / ARR + plan breakdown
14# - Recent invoices (all users) with status + refund-as-credit action
15# - Accounts with non-zero credit balance
16#
17# Critically: cash revenue and credit consumption are reported as
18# separate numbers. The cash tile NEVER includes credit applications,
19# so the staff can never mistake credit-applied revenue for cash.
20#======================================================================
21use strict;
22use warnings;
23
24use lib '/var/www/vhosts/3dshawn.com/crm.3dshawn.com';
25use CGI;
26use MODS::Template;
27use MODS::DBConnect;
28use MODS::Login;
29use MODS::ContactForge::Config;
30use MODS::ContactForge::Wrapper;
31use MODS::ContactForge::Admin;
32use MODS::ContactForge::Billing;
33
34my $q = CGI->new;
35my $form = $q->Vars;
36my $auth = MODS::Login->new;
37my $wrap = MODS::ContactForge::Wrapper->new;
38my $tfile = MODS::Template->new;
39my $db = MODS::DBConnect->new;
40my $cfg = MODS::ContactForge::Config->new;
41my $admin = MODS::ContactForge::Admin->new;
42my $bill = MODS::ContactForge::Billing->new;
43my $DB = $cfg->settings('database_name');
44
45$| = 1;
46my $userinfo = $auth->login_verify();
47if (!$userinfo) {
48 print "Status: 302 Found\nLocation: /login.cgi\n\n";
49 exit;
50}
51$admin->require_admin($userinfo);
52require MODS::ContactForge::Permissions;
53my $perm = MODS::ContactForge::Permissions->new;
54
55my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_billing';
56
57if ($entry eq 'admin_billing_action') {
58 # Action handler runs under the stricter admin_edit_billing feature.
59 $perm->require_feature($userinfo, 'admin_edit_billing');
60 _handle_action($q, $form);
61 exit;
62}
63
64$perm->require_feature($userinfo, 'admin_view_billing');
65
66# Two-tier visibility on this page:
67# - Manager / Editor (anyone with admin_view_billing) sees the per-user
68# panels: Recent invoices (with refund-as-credit) and Credit holders
69# (with grant-credit). These power day-to-day user support.
70# - Only super-admin sees the platform-wide aggregates: cash revenue,
71# MRR/ARR, projected month-end, signups chart, plan distribution.
72# is_super_admin() reads users.is_super_admin lazily and caches on
73# $userinfo -- login_verify intentionally doesn't include the flag.
74my $is_super = $perm->is_super_admin($userinfo);
75
76my $tutorial_mode = ($form->{tutorial} && $form->{tutorial} eq '1') ? 1 : 0;
77
78# Month selector. Param is 'month' as YYYY-MM (e.g. 2026-04). Defaults
79# to the current calendar month. Anything else falls back silently
80# rather than 500-ing -- this is a query-string toggle, not a form.
81my ($sel_year, $sel_month) = _parse_month_param($form->{month});
82
83my $dbh = $db->db_connect();
84my $schema_ready = $bill->schema_ready($db, $dbh, $DB);
85
86# Daily series powering the in-modal mini-charts on each banner tile.
87# Scoped to the SELECTED month so the chart matches the tile numbers
88# (one bar per day of that month). Computed first so it runs while the
89# DB connection is fresh -- admin_summary and the recent-invoices /
90# credit-holder queries that follow are heavier and can leave the
91# connection in a state where a subsequent GROUP BY fails on slow links.
92my @daily_billing;
93if ($schema_ready) {
94 my $period_start = sprintf('%04d-%02d-01', $sel_year, $sel_month);
95 my $days_in_sel = _days_in_month($sel_year, $sel_month);
96 my %by_date;
97 my @rows = $db->db_readwrite_multiple($dbh, qq~
98 SELECT DATE(paid_at) AS d,
99 COALESCE(SUM(cash_paid_cents),0) AS cash,
100 COALESCE(SUM(credit_applied_cents),0) AS credit,
101 COUNT(*) AS invoices
102 FROM `${DB}`.invoices
103 WHERE status='paid' AND paid_at IS NOT NULL
104 AND paid_at >= '$period_start 00:00:00'
105 AND paid_at < DATE_ADD('$period_start 00:00:00', INTERVAL 1 MONTH)
106 GROUP BY DATE(paid_at)
107 ~, $ENV{SCRIPT_NAME}, __LINE__);
108 foreach my $r (@rows) { $by_date{$r->{d} || ''} = $r; }
109 for (my $d = 1; $d <= $days_in_sel; $d++) {
110 my $ymd = sprintf('%04d-%02d-%02d', $sel_year, $sel_month, $d);
111 my $r = $by_date{$ymd} || {};
112 push @daily_billing, {
113 date => $ymd,
114 cash => int(($r->{cash} || 0) / 100),
115 credit => int(($r->{credit} || 0) / 100),
116 invoices => $r->{invoices} || 0,
117 };
118 }
119}
120my $daily_billing_json = _ab_to_json_array(\@daily_billing);
121
122my $summary = $schema_ready ? $bill->admin_summary($db, $dbh, $DB, $sel_year, $sel_month) : {};
123my @recent_invoices_raw = $schema_ready ? $bill->admin_recent_invoices($db, $dbh, $DB, 30) : ();
124my @credit_holders_raw = $schema_ready ? $bill->admin_credit_holders($db, $dbh, $DB, 25) : ();
125my $signups_daily = $schema_ready ? $bill->admin_signups_daily($db, $dbh, $DB, 30) : [];
126my $signups_monthly = $schema_ready ? $bill->admin_signups_monthly($db, $dbh, $DB, 12) : [];
127
128# Format invoice rows for the table.
129my @recent_invoices;
130foreach my $r (@recent_invoices_raw) {
131 my $status = $r->{status} || 'open';
132 my $issued = $r->{issued_at} || $r->{created_at} || '';
133 push @recent_invoices, {
134 id => $r->{id},
135 invoice_number => $r->{invoice_number} || ('INV-' . $r->{id}),
136 user_id => $r->{user_id},
137 user_label => ($r->{display_name} || $r->{email} || ('User #' . $r->{user_id})),
138 user_email => $r->{email} || '',
139 amount_due_display => $bill->fmt_money($r->{amount_due_cents} || 0),
140 credit_applied_display => $bill->fmt_money($r->{credit_applied_cents} || 0),
141 cash_paid_display => $bill->fmt_money($r->{cash_paid_cents} || 0),
142 cash_paid_cents => $r->{cash_paid_cents} || 0,
143 status => $status,
144 is_paid => $status eq 'paid' ? 1 : 0,
145 is_open => $status eq 'open' ? 1 : 0,
146 is_failed => $status eq 'failed' ? 1 : 0,
147 is_refunded => $status eq 'refunded' ? 1 : 0,
148 is_void => $status eq 'void' ? 1 : 0,
149 can_refund => ($status eq 'paid' && ($r->{cash_paid_cents} || 0) > 0) ? 1 : 0,
150 issued_at => $issued,
151 issued_epoch => _ab_ts_epoch($issued),
152 paid_at => $r->{paid_at} || '-',
153 };
154}
155
156# Credit-holder rows.
157my @credit_holders;
158foreach my $r (@credit_holders_raw) {
159 push @credit_holders, {
160 user_id => $r->{user_id},
161 user_label => ($r->{display_name} || $r->{email} || ('User #' . $r->{user_id})),
162 user_email => $r->{email} || '',
163 balance_cents => $r->{balance_cents} || 0,
164 balance_display => $bill->fmt_money($r->{balance_cents} || 0),
165 is_positive => (($r->{balance_cents} || 0) > 0) ? 1 : 0,
166 is_negative => (($r->{balance_cents} || 0) < 0) ? 1 : 0,
167 };
168}
169
170# Plan breakdown for the donut-ish list.
171my @plan_breakdown;
172my %tier_color = (
173 # Post pricing-v3: 2 paid tiers. Pro = brand violet, Business = gold.
174 pro=>'#a855f7', business=>'#fbbf24',
175);
176my $plan_total = 0;
177foreach my $r (@{ $summary->{plan_breakdown} || [] }) { $plan_total += $r->{n}; }
178foreach my $r (@{ $summary->{plan_breakdown} || [] }) {
179 my $pct = $plan_total ? sprintf('%.1f', ($r->{n} / $plan_total) * 100) : '0.0';
180 push @plan_breakdown, {
181 tier => $r->{tier},
182 tier_label => ucfirst($r->{tier}),
183 count => $r->{n},
184 pct => $pct,
185 color => $tier_color{ $r->{tier} } || '#94a3b8',
186 };
187}
188
189$db->db_disconnect($dbh);
190
191# ---- Projected monthly earnings -------------------------------------
192# For the CURRENT month: linear pace extrapolation + scheduled renewals.
193# For PAST months: the month is closed; "projected" == actual cash
194# received that month and days_elapsed == days_in_month.
195my ($proj_total_cents, $pace_only_cents,
196 $days_elapsed, $days_in_month, $days_left,
197 $expected_subs_cents) = _project_month_earnings($summary, $sel_year, $sel_month);
198
199# Build the month-selector dropdown options. 24 months back from today.
200my @month_options = _build_month_options($sel_year, $sel_month, 24);
201
202# Format signup chart series for JSON.
203my $signups_daily_json = _ab_to_json_array($signups_daily);
204my $signups_monthly_json = _ab_to_json_array($signups_monthly);
205my $signups_total_30d = 0;
206my $signups_paid_30d = 0;
207foreach my $row (@$signups_daily) {
208 $signups_total_30d += $row->{total};
209 $signups_paid_30d += $row->{paid};
210}
211
212my $tvars = {
213 user_id => $userinfo->{user_id},
214 is_super_admin => $is_super,
215 not_super_admin => $is_super ? 0 : 1,
216
217 # Month-selector state
218 sel_period_label => _period_label($sel_year, $sel_month),
219 sel_period_ym => sprintf('%04d-%02d', $sel_year, $sel_month),
220 is_current_month => $summary->{is_current_month} ? 1 : 0,
221 not_current_month => $summary->{is_current_month} ? 0 : 1,
222 month_options => \@month_options,
223
224 # Cash / credit / liability tiles -- all scoped to the selected month.
225 cash_mtd => $bill->fmt_money($summary->{cash_revenue_mtd_cents} || 0),
226 credit_mtd => $bill->fmt_money($summary->{credit_consumed_mtd_cents} || 0),
227 outstanding_credit => $bill->fmt_money($summary->{outstanding_credit_cents} || 0),
228
229 # Projected earnings tile
230 projected_month => $bill->fmt_money($proj_total_cents),
231 projected_pace_only => $bill->fmt_money($pace_only_cents),
232 projected_subs_due => $bill->fmt_money($expected_subs_cents),
233 projection_days_left => $days_left,
234 projection_days_elap => $days_elapsed,
235 projection_days_in_m => $days_in_month,
236
237 # Signups module
238 signups_daily_json => $signups_daily_json,
239 signups_monthly_json => $signups_monthly_json,
240 signups_total_30d => $signups_total_30d,
241 signups_paid_30d => $signups_paid_30d,
242 signups_free_30d => $signups_total_30d - $signups_paid_30d,
243 has_signups => scalar(@$signups_daily) ? 1 : 0,
244
245 # Subscription counts
246 active_subs => $summary->{active_subs} || 0,
247 trialing_subs => $summary->{trialing_subs} || 0,
248 past_due_subs => $summary->{past_due_subs} || 0,
249 canceled_subs_30d => $summary->{canceled_subs_30d}|| 0,
250
251 # MRR / ARR
252 mrr_display => $bill->fmt_money($summary->{mrr_cents} || 0),
253 arr_display => $bill->fmt_money($summary->{arr_cents} || 0),
254
255 # Breakdowns / tables
256 plan_breakdown => \@plan_breakdown,
257 has_plan_breakdown => scalar(@plan_breakdown) ? 1 : 0,
258 recent_invoices => \@recent_invoices,
259 has_recent_invoices => scalar(@recent_invoices) ? 1 : 0,
260 credit_holders => \@credit_holders,
261 has_credit_holders => scalar(@credit_holders) ? 1 : 0,
262
263 # Banners
264 schema_ready => $schema_ready ? 1 : 0,
265 schema_missing => $schema_ready ? 0 : 1,
266
267 # Daily series feeding the KPI-modal area charts
268 daily_billing_json => $daily_billing_json,
269 has_daily_billing => scalar(@daily_billing) ? 1 : 0,
270
271 # Tutorial mode
272 tutorial_mode => $tutorial_mode,
273 not_tutorial_mode => $tutorial_mode ? 0 : 1,
274};
275
276# ---- Tutorial-mode overlay -----------------------------------------
277if ($tutorial_mode) {
278 $tvars->{cash_mtd} = '$18,440.00';
279 $tvars->{credit_mtd} = '$1,284.00';
280 $tvars->{outstanding_credit} = '$3,612.00';
281 $tvars->{projected_month} = '$44,920.00';
282 $tvars->{projected_pace_only}= '$36,880.00';
283 $tvars->{projected_subs_due} = '$8,040.00';
284 $tvars->{projection_days_left}= 19;
285 $tvars->{projection_days_elap}= 12;
286 $tvars->{projection_days_in_m}= 31;
287 $tvars->{active_subs} = 1089;
288 $tvars->{trialing_subs} = 24;
289 $tvars->{past_due_subs} = 11;
290 $tvars->{canceled_subs_30d} = 18;
291 $tvars->{mrr_display} = '$31,420.00';
292 $tvars->{arr_display} = '$377,040.00';
293
294 # Sample signup data -- 2-tier paid mix; trial counter mirrors total
295 # since every signup starts a 14-day trial.
296 my @sample_daily;
297 for (my $i = 29; $i >= 0; $i--) {
298 my @t = localtime(time - $i * 86400);
299 my $ymd = sprintf('%04d-%02d-%02d', $t[5]+1900, $t[4]+1, $t[3]);
300 my $dow = $t[6];
301 my $pro = (($dow == 0 || $dow == 6) ? 12 : 18) + int(rand(5)) - 2;
302 my $business = (($dow == 0 || $dow == 6) ? 2 : 4) + int(rand(2));
303 $pro = 0 if $pro < 0;
304 $business = 0 if $business < 0;
305 my $paid = $pro + $business;
306 my $trialing = int($paid * 0.92); # most signups are still in trial window
307 push @sample_daily, {
308 date => $ymd, pro => $pro, business => $business,
309 trialing => $trialing, paid => $paid, total => $paid,
310 };
311 }
312 $tvars->{signups_daily_json} = _ab_to_json_array(\@sample_daily);
313 my @sample_monthly;
314 my @t = localtime(time);
315 my ($y, $m) = ($t[5]+1900, $t[4]+1);
316 for (my $i = 11; $i >= 0; $i--) {
317 my $bm = $m - $i; my $by = $y;
318 while ($bm <= 0) { $bm += 12; $by--; }
319 my $pro = 420 + int(rand(120));
320 my $business = 60 + int(rand(20));
321 my $paid = $pro + $business;
322 my $trialing = int($paid * 0.88);
323 push @sample_monthly, {
324 month => sprintf('%04d-%02d', $by, $bm),
325 pro => $pro, business => $business,
326 trialing => $trialing, paid => $paid, total => $paid,
327 };
328 }
329 $tvars->{signups_monthly_json} = _ab_to_json_array(\@sample_monthly);
330 my $t30 = 0; my $p30 = 0;
331 foreach my $r (@sample_daily) { $t30 += $r->{total}; $p30 += $r->{paid}; }
332 $tvars->{signups_total_30d} = $t30;
333 $tvars->{signups_paid_30d} = $p30;
334 $tvars->{signups_free_30d} = $t30 - $p30;
335 $tvars->{has_signups} = 1;
336
337 # Sample month-selector state
338 $tvars->{sel_period_label} = _period_label($y, $m);
339 $tvars->{sel_period_ym} = sprintf('%04d-%02d', $y, $m);
340 $tvars->{is_current_month} = 1;
341 $tvars->{not_current_month} = 0;
342 $tvars->{month_options} = [ _build_month_options($y, $m, 24) ];
343
344 # Post pricing-v3: 2-tier paid breakdown. Pro = brand violet, Business = gold.
345 $tvars->{plan_breakdown} = [
346 { tier=>'pro', tier_label=>'Pro', count=>892, pct=>'82.0', color=>'#a855f7' },
347 { tier=>'business', tier_label=>'Business', count=>197, pct=>'18.0', color=>'#fbbf24' },
348 ];
349 $tvars->{has_plan_breakdown} = 1;
350
351 $tvars->{recent_invoices} = [
352 { id=>4012, invoice_number=>'INV-0001247-202605', user_id=>1247,
353 user_label=>'Rune Caster', user_email=>'rune.caster@example.com',
354 amount_due_display=>'$29.00', credit_applied_display=>'$12.00',
355 cash_paid_display=>'$17.00', cash_paid_cents=>1700,
356 status=>'paid', is_paid=>1, is_open=>0, is_failed=>0, is_refunded=>0, is_void=>0,
357 can_refund=>1, issued_at=>'2026-05-12', paid_at=>'2026-05-12' },
358 { id=>4011, invoice_number=>'INV-0001192-202605', user_id=>1192,
359 user_label=>'Maya R.', user_email=>'maya.r@example.com',
360 amount_due_display=>'$29.00', credit_applied_display=>'$0.00',
361 cash_paid_display=>'$29.00', cash_paid_cents=>2900,
362 status=>'paid', is_paid=>1, is_open=>0, is_failed=>0, is_refunded=>0, is_void=>0,
363 can_refund=>1, issued_at=>'2026-05-12', paid_at=>'2026-05-12' },
364 { id=>4010, invoice_number=>'INV-0001088-202605', user_id=>1088,
365 user_label=>'Bench Hammer', user_email=>'bench.hammer@example.com',
366 amount_due_display=>'$9.00', credit_applied_display=>'$0.00',
367 cash_paid_display=>'$9.00', cash_paid_cents=>900,
368 status=>'paid', is_paid=>1, is_open=>0, is_failed=>0, is_refunded=>0, is_void=>0,
369 can_refund=>1, issued_at=>'2026-05-12', paid_at=>'2026-05-12' },
370 { id=>4009, invoice_number=>'INV-0000987-202605', user_id=>987,
371 user_label=>'Priya T.', user_email=>'priya.t@example.com',
372 amount_due_display=>'$29.00', credit_applied_display=>'$0.00',
373 cash_paid_display=>'$0.00', cash_paid_cents=>0,
374 status=>'failed', is_paid=>0, is_open=>0, is_failed=>1, is_refunded=>0, is_void=>0,
375 can_refund=>0, issued_at=>'2026-05-12', paid_at=>'-' },
376 { id=>4008, invoice_number=>'INV-0001247-202604', user_id=>1247,
377 user_label=>'Rune Caster', user_email=>'rune.caster@example.com',
378 amount_due_display=>'$29.00', credit_applied_display=>'$0.00',
379 cash_paid_display=>'$29.00', cash_paid_cents=>2900,
380 status=>'refunded', is_paid=>0, is_open=>0, is_failed=>0, is_refunded=>1, is_void=>0,
381 can_refund=>0, issued_at=>'2026-04-12', paid_at=>'2026-04-12' },
382 ];
383 foreach my $r (@{ $tvars->{recent_invoices} }) {
384 $r->{issued_epoch} = _ab_ts_epoch($r->{issued_at});
385 }
386 $tvars->{has_recent_invoices} = 1;
387
388 $tvars->{credit_holders} = [
389 { user_id=>1247, user_label=>'Rune Caster', user_email=>'rune.caster@example.com',
390 balance_cents=>2900, balance_display=>'$29.00', is_positive=>1, is_negative=>0 },
391 { user_id=>1192, user_label=>'Maya R.', user_email=>'maya.r@example.com',
392 balance_cents=>1500, balance_display=>'$15.00', is_positive=>1, is_negative=>0 },
393 { user_id=>987, user_label=>'Priya T.', user_email=>'priya.t@example.com',
394 balance_cents=>1000, balance_display=>'$10.00', is_positive=>1, is_negative=>0 },
395 { user_id=>1088, user_label=>'Bench Hammer', user_email=>'bench.hammer@example.com',
396 balance_cents=>500, balance_display=>'$5.00', is_positive=>1, is_negative=>0 },
397 ];
398 $tvars->{has_credit_holders} = 1;
399
400 $tvars->{schema_ready} = 1;
401 $tvars->{schema_missing} = 0;
402}
403
404print "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";
405
406my $body = join('', $tfile->template('cf_admin_billing.html', $tvars, $userinfo));
407
408$wrap->render({
409 userinfo => $userinfo,
410 page_key => 'admin_billing',
411 title => 'Admin &middot; Billing',
412 body => $body,
413 extra_js => ['/assets/javascript/graphs.js'],
414});
415
416#----------------------------------------------------------------------
417# Monthly-earnings projection.
418#
419# Current month -> linear pace extrapolation + scheduled renewals.
420# Past months -> month is closed; "projected" equals the actual cash
421# that landed that month (days_elapsed == days_in_month,
422# days_left == 0, expected_subs == 0).
423#
424# Returns: (projected_total_cents, pace_only_cents,
425# days_elapsed_including_today, days_in_month, days_left,
426# expected_subscription_renewals_remaining_this_month)
427sub _project_month_earnings {
428 my ($s, $year, $month) = @_;
429 $s ||= {};
430 my $mtd_cents = $s->{cash_revenue_mtd_cents} || 0;
431 my $expected = $s->{expected_subs_remaining_cents} || 0;
432 my $is_current = $s->{is_current_month} ? 1 : 0;
433
434 my $days_in_month = _days_in_month($year, $month);
435 my ($days_elapsed, $days_left);
436
437 if ($is_current) {
438 my @t = localtime(time);
439 $days_elapsed = $t[3]; # day-of-month, includes today
440 $days_left = $days_in_month - $days_elapsed;
441 } else {
442 $days_elapsed = $days_in_month;
443 $days_left = 0;
444 }
445
446 my $pace_only = 0;
447 if ($days_elapsed > 0) {
448 $pace_only = int( ($mtd_cents * $days_in_month) / $days_elapsed );
449 }
450 my $pace_remaining = $pace_only - $mtd_cents;
451 $pace_remaining = 0 if $pace_remaining < 0;
452 my $projected_total = $is_current
453 ? ($mtd_cents + $pace_remaining + $expected)
454 : $mtd_cents;
455
456 return ($projected_total, $pace_only,
457 $days_elapsed, $days_in_month, $days_left, $expected);
458}
459
460sub _days_in_month {
461 my ($year, $month) = @_;
462 my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
463 if ($month == 2) {
464 my $leap = ($year % 4 == 0 && $year % 100 != 0) || ($year % 400 == 0);
465 return $leap ? 29 : 28;
466 }
467 return $days[$month - 1];
468}
469
470# Parse `month` query string. Accepts YYYY-MM; anything else falls back
471# to the current calendar month. Returns ($year, $month).
472sub _parse_month_param {
473 my ($raw) = @_;
474 my @t = localtime(time);
475 my $cur_year = $t[5] + 1900;
476 my $cur_month = $t[4] + 1;
477 return ($cur_year, $cur_month) unless defined $raw && $raw =~ /^(\d{4})-(\d{1,2})$/;
478 my ($y, $m) = ($1 + 0, $2 + 0);
479 return ($cur_year, $cur_month) unless $y >= 2000 && $y <= 2100;
480 return ($cur_year, $cur_month) unless $m >= 1 && $m <= 12;
481 return ($y, $m);
482}
483
484# Long-form label for the selected period -- "May 2026".
485sub _period_label {
486 my ($year, $month) = @_;
487 my @names = qw(January February March April May June July August September October November December);
488 return $names[$month - 1] . ' ' . $year;
489}
490
491# Build the dropdown options list for the month picker. Most-recent
492# month first. Each entry: { ym => 'YYYY-MM', label => 'Month YYYY',
493# selected_attr => ' selected' if it matches the requested period }.
494sub _build_month_options {
495 my ($sel_year, $sel_month, $count) = @_;
496 $count ||= 24;
497 my @t = localtime(time);
498 my $y = $t[5] + 1900;
499 my $m = $t[4] + 1;
500 my @out;
501 for (my $i = 0; $i < $count; $i++) {
502 my $ym = sprintf('%04d-%02d', $y, $m);
503 my $is_sel = ($y == $sel_year && $m == $sel_month) ? 1 : 0;
504 push @out, {
505 ym => $ym,
506 label => _period_label($y, $m),
507 selected_attr => $is_sel ? ' selected' : '',
508 is_selected => $is_sel,
509 };
510 $m--;
511 if ($m == 0) { $m = 12; $y--; }
512 }
513 return @out;
514}
515
516# Convert a MySQL DATETIME/DATE string to a UNIX epoch. Feeds the
517# data-ts attribute for portfolio-wide <span class="ts"> timezone
518# localization. Empty / '-' / 'NEVER' / unparseable returns 0 so the
519# tzLocalize() JS falls back to the human string in the span body.
520sub _ab_ts_epoch {
521 my $s = shift;
522 return 0 unless defined $s && length $s;
523 return 0 if $s eq '-' || $s eq 'NEVER';
524 if ($s =~ /^(\d{4})-(\d{1,2})-(\d{1,2})(?:[ T](\d{1,2}):(\d{1,2})(?::(\d{1,2}))?)?/) {
525 require Time::Local;
526 my $ep = eval { Time::Local::timelocal(($6||0), ($5||0), ($4||0), $3, $2 - 1, $1 - 1900) };
527 return $ep ? $ep + 0 : 0;
528 }
529 return 0;
530}
531
532# Tiny JSON-array encoder for the daily_billing series. Local copy
533# (prefixed _ab_) so admin_billing.cgi stays self-contained and we
534# don't accidentally rely on a helper that might move.
535sub _ab_to_json_array {
536 my ($aref) = @_;
537 $aref ||= [];
538 my @out;
539 foreach my $row (@$aref) {
540 my @pairs;
541 foreach my $k (sort keys %$row) {
542 my $v = $row->{$k};
543 if (!defined $v) { push @pairs, '"'.$k.'":null'; next; }
544 if ($v =~ /^-?(?:\d+\.?\d*|\.\d+)$/) { push @pairs, '"'.$k.'":'.($v+0); next; }
545 $v =~ s/\\/\\\\/g; $v =~ s/"/\\"/g;
546 $v =~ s/\r/\\r/g; $v =~ s/\n/\\n/g; $v =~ s/\t/\\t/g;
547 $v =~ s|</|<\\/|g;
548 push @pairs, '"'.$k.'":"'.$v.'"';
549 }
550 push @out, '{' . join(',', @pairs) . '}';
551 }
552 return '[' . join(',', @out) . ']';
553}
554
555#======================================================================
556# admin_billing_action entry: POST-only billing action handler.
557#
558# Actions:
559# act=refund_as_credit -> credit invoice's cash_paid to user's
560# credit_ledger; mark invoice status='refunded'.
561# act=grant_credit -> insert positive credit_ledger row with
562# reason='manual_grant'.
563# act=void_invoice -> mark an open/failed invoice as void.
564# All redirect back to /admin_billing.cgi with a status flash.
565#======================================================================
566sub _act_redirect {
567 my $url = shift;
568 print "Status: 302 Found\nLocation: $url\n\n";
569}
570
571# Pick the redirect target: caller-supplied return_to (must be a same-site
572# absolute path; rejects protocol-relative // and full URLs) or fall back
573# to the per-action default. $suffix is the query-string flash, with or
574# without leading '?'.
575sub _act_back {
576 my ($form, $default, $suffix) = @_;
577 my $rt = defined $form->{return_to} ? $form->{return_to} : '';
578 if ($rt !~ m{^/[^/]} && $rt ne '/') { $rt = ''; } # reject //, http://, empty
579 my $base = $rt || $default;
580 return $base unless defined $suffix && length $suffix;
581 $suffix =~ s/^\?//;
582 my $sep = ($base =~ /\?/) ? '&' : '?';
583 return $base . $sep . $suffix;
584}
585
586sub _handle_action {
587 my ($q, $form) = @_;
588
589 my $admin_id = $userinfo->{user_id};
590 $admin_id =~ s/[^0-9]//g;
591
592 my $act = defined $form->{act} ? $form->{act} : '';
593
594 my $dbh = $db->db_connect();
595 unless ($bill->schema_ready($db, $dbh, $DB)) {
596 $db->db_disconnect($dbh);
597 _act_redirect('/admin_billing.cgi?err=schema');
598 return;
599 }
600
601 if ($act eq 'refund_as_credit') {
602 my $invoice_id = defined $form->{invoice_id} ? $form->{invoice_id} : '';
603 $invoice_id =~ s/[^0-9]//g;
604 unless ($invoice_id) {
605 $db->db_disconnect($dbh);
606 _act_redirect('/admin_billing.cgi?err=bad_invoice');
607 return;
608 }
609
610 my $inv = $bill->get_invoice($db, $dbh, $DB, $invoice_id);
611 unless ($inv && $inv->{id} && $inv->{status} eq 'paid' && ($inv->{cash_paid_cents} || 0) > 0) {
612 $db->db_disconnect($dbh);
613 _act_redirect('/admin_billing.cgi?err=not_refundable');
614 return;
615 }
616
617 my $cash = $inv->{cash_paid_cents};
618 my $note = 'Refund for invoice ' . ($inv->{invoice_number} || $inv->{id}) . ' issued as account credit.';
619
620 # 1) credit_ledger row: positive grant
621 $bill->grant_credit($db, $dbh, $DB,
622 user_id => $inv->{user_id},
623 amount_cents => $cash,
624 reason => 'refund',
625 related_invoice_id => $inv->{id},
626 granted_by_user_id => $admin_id,
627 note => $note,
628 );
629
630 # 2) mark the invoice as refunded so the rep billing page
631 # surfaces the "Refunded as credit" pill on this row.
632 $db->db_readwrite($dbh, qq~
633 UPDATE `${DB}`.invoices
634 SET status='refunded'
635 WHERE id='$inv->{id}'
636 ~, $ENV{SCRIPT_NAME}, __LINE__);
637
638 $db->db_disconnect($dbh);
639 _act_redirect('/admin_billing.cgi?ok=refunded');
640 return;
641 }
642
643 if ($act eq 'grant_credit') {
644 my $target_uid = defined $form->{user_id} ? $form->{user_id} : '';
645 $target_uid =~ s/[^0-9]//g;
646 my $amount_cents = defined $form->{amount_cents}? $form->{amount_cents}: '';
647 $amount_cents =~ s/[^0-9]//g; # positive integer cents only
648 my $note = defined $form->{note} ? $form->{note} : '';
649 $note =~ s/[\r\n]+/ /g;
650 $note = substr($note, 0, 480);
651
652 unless ($target_uid && $amount_cents) {
653 $db->db_disconnect($dbh);
654 _act_redirect(_act_back($form, '/admin_billing.cgi', 'err=bad_grant'));
655 return;
656 }
657
658 $bill->grant_credit($db, $dbh, $DB,
659 user_id => $target_uid,
660 amount_cents => $amount_cents,
661 reason => 'manual_grant',
662 granted_by_user_id => $admin_id,
663 note => $note,
664 );
665
666 $db->db_disconnect($dbh);
667 _act_redirect(_act_back($form, '/admin_billing.cgi', 'ok=credit_granted'));
668 return;
669 }
670
671 if ($act eq 'void_invoice') {
672 my $invoice_id = defined $form->{invoice_id} ? $form->{invoice_id} : '';
673 $invoice_id =~ s/[^0-9]//g;
674 unless ($invoice_id) {
675 $db->db_disconnect($dbh);
676 _act_redirect('/admin_billing.cgi?err=bad_invoice');
677 return;
678 }
679 $db->db_readwrite($dbh, qq~
680 UPDATE `${DB}`.invoices
681 SET status='void'
682 WHERE id='$invoice_id' AND status IN ('open','failed','draft')
683 ~, $ENV{SCRIPT_NAME}, __LINE__);
684
685 $db->db_disconnect($dbh);
686 _act_redirect('/admin_billing.cgi?ok=voided');
687 return;
688 }
689
690 $db->db_disconnect($dbh);
691 _act_redirect('/admin_billing.cgi?err=unknown_act');
692 return;
693}