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

O Operator
Diff

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

added on local at 2026-07-11 18:33:22

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