Diff

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

added on local at 2026-07-11 18:36:50

Added

+696

lines

Removed

-0

lines

Context

unchanged

Blobs

from
to ec5d8fa38f70

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