Diff -- /var/www/vhosts/3dshawn.com/abforge.3dshawn.com/admin_companies.cgi
Diff
/var/www/vhosts/3dshawn.com/abforge.3dshawn.com/admin_companies.cgi
added on local at 2026-07-11 18:36:52
Added
+217
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 01e6875820b6
to 01e6875820b6
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 - SUPER-ADMIN: Companies (storefronts) list + detail | |
| 4 | # | |
| 5 | # Dispatches on SCRIPT_NAME: | |
| 6 | # /admin_companies.cgi -> list customer storefronts/workspaces | |
| 7 | # /admin_company.cgi?id=<int> -> per-storefront detail | |
| 8 | # | |
| 9 | # admin_company.cgi is a thin wrapper that `do`s this file. | |
| 10 | #====================================================================== | |
| 11 | use strict; use warnings; | |
| 12 | use lib '/var/www/vhosts/3dshawn.com/abforge.3dshawn.com'; | |
| 13 | use CGI; | |
| 14 | use MODS::Template; | |
| 15 | use MODS::DBConnect; | |
| 16 | use MODS::Login; | |
| 17 | use MODS::ABForge::Config; | |
| 18 | use MODS::ABForge::Wrapper; | |
| 19 | use MODS::ABForge::Admin; | |
| 20 | ||
| 21 | my $q = CGI->new; | |
| 22 | my $form = $q->Vars; | |
| 23 | my $auth = MODS::Login->new; | |
| 24 | my $wrap = MODS::ABForge::Wrapper->new; | |
| 25 | my $tfile = MODS::Template->new; | |
| 26 | my $db = MODS::DBConnect->new; | |
| 27 | my $cfg = MODS::ABForge::Config->new; | |
| 28 | my $admin = MODS::ABForge::Admin->new; | |
| 29 | my $DB = $cfg->settings('database_name'); | |
| 30 | ||
| 31 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_companies'; | |
| 32 | ||
| 33 | my $userinfo = $auth->login_verify(); | |
| 34 | if (!$userinfo) { print "Status: 302 Found\nLocation: /login.cgi\n\n"; exit; } | |
| 35 | $admin->require_admin($userinfo); | |
| 36 | require MODS::ABForge::Permissions; | |
| 37 | MODS::ABForge::Permissions->new->require_feature($userinfo, 'admin_view_users'); | |
| 38 | ||
| 39 | if ($entry eq 'admin_company') { | |
| 40 | _co_render_detail(); | |
| 41 | exit; | |
| 42 | } | |
| 43 | ||
| 44 | # ---- Companies list (default) --------------------------------------- | |
| 45 | my $sq = $form->{q} || ''; | |
| 46 | $sq =~ s/[^A-Za-z0-9_\-\.\s\@]//g; | |
| 47 | ||
| 48 | my $dbh = $db->db_connect(); | |
| 49 | ||
| 50 | my $where = '1=1'; | |
| 51 | $where .= " AND (s.name LIKE '%$sq%' OR s.subdomain LIKE '%$sq%' OR u.email LIKE '%$sq%')" if $sq; | |
| 52 | ||
| 53 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 54 | SELECT s.id, s.name, s.subdomain, s.status, s.created_at, | |
| 55 | UNIX_TIMESTAMP(s.created_at) AS created_at_epoch, | |
| 56 | s.user_id, u.email AS owner_email, u.display_name AS owner_name, | |
| 57 | u.plan_tier AS owner_plan, u.account_status AS owner_status | |
| 58 | FROM `${DB}`.storefronts s | |
| 59 | LEFT JOIN `${DB}`.users u ON u.id = s.user_id | |
| 60 | WHERE $where | |
| 61 | ORDER BY s.created_at DESC | |
| 62 | LIMIT 500 | |
| 63 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 64 | ||
| 65 | # Color palette for the storefront chip (deterministic per id) | |
| 66 | my @palette = ('#5aa9ff','#34d399','#fbbf24','#a78bfa','#f87171','#22c55e','#06b6d4','#ec4899','#f59e0b'); | |
| 67 | ||
| 68 | foreach my $r (@rows) { | |
| 69 | $r->{name} = _co_h($r->{name} || '(unnamed)'); | |
| 70 | $r->{owner_email} = _co_h($r->{owner_email} || ''); | |
| 71 | $r->{owner_name} = _co_h($r->{owner_name} || $r->{owner_email}); | |
| 72 | $r->{subdomain} = _co_h($r->{subdomain}); | |
| 73 | $r->{status} = _co_h($r->{status}); | |
| 74 | $r->{created_at} = _co_ts_wrap($r->{created_at}, $r->{created_at_epoch}, 'datetime'); | |
| 75 | $r->{plan_tier} = ucfirst($r->{owner_plan} || 'free'); | |
| 76 | $r->{brand_color} = $palette[ ($r->{id} || 0) % scalar(@palette) ]; | |
| 77 | $r->{users_n} = 1; # one storefront per user on these platforms | |
| 78 | $r->{trial_ends_at} = '-'; | |
| 79 | } | |
| 80 | ||
| 81 | $db->db_disconnect($dbh); | |
| 82 | ||
| 83 | my $tvars = { | |
| 84 | rows => \@rows, | |
| 85 | has_rows => scalar(@rows) ? 1 : 0, | |
| 86 | row_count => scalar(@rows), | |
| 87 | q => _co_h($sq), | |
| 88 | }; | |
| 89 | ||
| 90 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n"; | |
| 91 | my $body = join('', $tfile->template('abforge_admin_companies.html', $tvars, $userinfo)); | |
| 92 | $wrap->render({ | |
| 93 | userinfo => $userinfo, | |
| 94 | page_key => 'admin_companies', | |
| 95 | title => 'All Companies', | |
| 96 | body => $body, | |
| 97 | }); | |
| 98 | exit; | |
| 99 | ||
| 100 | #====================================================================== | |
| 101 | # admin_company.cgi ?id=<sid> -- per-storefront detail | |
| 102 | #====================================================================== | |
| 103 | sub _co_render_detail { | |
| 104 | my $sid = $form->{id} || 0; | |
| 105 | $sid =~ s/[^0-9]//g; | |
| 106 | unless ($sid) { | |
| 107 | print "Status: 302 Found\nLocation: /admin_companies.cgi\n\n"; return; | |
| 108 | } | |
| 109 | ||
| 110 | my $dbh = $db->db_connect(); | |
| 111 | ||
| 112 | my $sf = $db->db_readwrite($dbh, qq~ | |
| 113 | SELECT s.*, u.email AS owner_email, u.display_name AS owner_name, | |
| 114 | u.id AS owner_user_id, u.plan_tier AS owner_plan, | |
| 115 | u.account_status AS owner_status, u.last_login_at AS owner_last_login, | |
| 116 | u.created_at AS owner_created_at, u.avatar_color AS owner_avatar, | |
| 117 | UNIX_TIMESTAMP(s.created_at) AS sf_created_at_epoch, | |
| 118 | UNIX_TIMESTAMP(u.last_login_at) AS owner_last_login_epoch, | |
| 119 | UNIX_TIMESTAMP(u.created_at) AS owner_created_at_epoch | |
| 120 | FROM `${DB}`.storefronts s | |
| 121 | LEFT JOIN `${DB}`.users u ON u.id = s.user_id | |
| 122 | WHERE s.id='$sid' LIMIT 1 | |
| 123 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 124 | ||
| 125 | unless ($sf && $sf->{id}) { | |
| 126 | $db->db_disconnect($dbh); | |
| 127 | print "Status: 302 Found\nLocation: /admin_companies.cgi\n\n"; return; | |
| 128 | } | |
| 129 | ||
| 130 | # Orders summary (if orders table exists) | |
| 131 | my ($orders_total, $orders_30, $orders_count, @recent_orders) = (0,0,0); | |
| 132 | my $tbl = $db->db_readwrite($dbh, qq~SHOW TABLES LIKE 'orders'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 133 | if ($tbl && %$tbl) { | |
| 134 | my $all = $db->db_readwrite($dbh, qq~ | |
| 135 | SELECT COALESCE(SUM(total_amount_cents),0) AS total, COUNT(*) AS n | |
| 136 | FROM `${DB}`.orders WHERE storefront_id='$sid' AND status='paid' | |
| 137 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 138 | $orders_total = $all && $all->{total} ? $all->{total} + 0 : 0; | |
| 139 | $orders_count = $all && $all->{n} ? $all->{n} + 0 : 0; | |
| 140 | my $r30 = $db->db_readwrite($dbh, qq~ | |
| 141 | SELECT COALESCE(SUM(total_amount_cents),0) AS total | |
| 142 | FROM `${DB}`.orders WHERE storefront_id='$sid' AND status='paid' | |
| 143 | AND created_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 144 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 145 | $orders_30 = $r30 && $r30->{total} ? $r30->{total} + 0 : 0; | |
| 146 | @recent_orders = $db->db_readwrite_multiple($dbh, qq~ | |
| 147 | SELECT id, buyer_email, total_amount_cents, status, created_at, | |
| 148 | UNIX_TIMESTAMP(created_at) AS created_at_epoch | |
| 149 | FROM `${DB}`.orders WHERE storefront_id='$sid' | |
| 150 | ORDER BY created_at DESC LIMIT 10 | |
| 151 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 152 | foreach my $o (@recent_orders) { | |
| 153 | $o->{total_disp} = sprintf('$%.2f', ($o->{total_amount_cents}||0)/100); | |
| 154 | $o->{buyer_email} = _co_h($o->{buyer_email}); | |
| 155 | $o->{status} = _co_h($o->{status}); | |
| 156 | $o->{created_at} = _co_ts_wrap($o->{created_at}, $o->{created_at_epoch}, 'datetime'); | |
| 157 | } | |
| 158 | } | |
| 159 | ||
| 160 | $db->db_disconnect($dbh); | |
| 161 | ||
| 162 | my $tvars = { | |
| 163 | sid => $sf->{id}, | |
| 164 | sf_name => _co_h($sf->{name} || '(unnamed)'), | |
| 165 | sf_subdomain => _co_h($sf->{subdomain} || ''), | |
| 166 | sf_status => _co_h($sf->{status} || 'draft'), | |
| 167 | sf_custom_domain => _co_h($sf->{custom_domain} || ''), | |
| 168 | sf_created_at => _co_ts_wrap($sf->{created_at}, $sf->{sf_created_at_epoch}, 'datetime'), | |
| 169 | sf_ssl_status => _co_h($sf->{ssl_status} || 'none'), | |
| 170 | ||
| 171 | owner_user_id => $sf->{owner_user_id} || 0, | |
| 172 | owner_email => _co_h($sf->{owner_email} || ''), | |
| 173 | owner_name => _co_h($sf->{owner_name} || $sf->{owner_email} || ''), | |
| 174 | owner_plan => ucfirst($sf->{owner_plan} || 'free'), | |
| 175 | owner_status => _co_h($sf->{owner_status} || ''), | |
| 176 | owner_last_login => ($sf->{owner_last_login} | |
| 177 | ? _co_ts_wrap($sf->{owner_last_login}, $sf->{owner_last_login_epoch}, 'datetime') | |
| 178 | : 'never'), | |
| 179 | owner_created_at => _co_ts_wrap($sf->{owner_created_at}, $sf->{owner_created_at_epoch}, 'datetime'), | |
| 180 | owner_avatar => $sf->{owner_avatar} || '#5aa9ff', | |
| 181 | ||
| 182 | orders_count => $orders_count, | |
| 183 | orders_total_disp => sprintf('%.2f', $orders_total/100), | |
| 184 | orders_30_disp => sprintf('%.2f', $orders_30/100), | |
| 185 | recent_orders => \@recent_orders, | |
| 186 | has_orders => scalar(@recent_orders) ? 1 : 0, | |
| 187 | }; | |
| 188 | ||
| 189 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store\n\n"; | |
| 190 | my $body = join('', $tfile->template('abforge_admin_company.html', $tvars, $userinfo)); | |
| 191 | $wrap->render({ | |
| 192 | userinfo => $userinfo, | |
| 193 | page_key => 'admin_companies', | |
| 194 | title => 'Admin - ' . ($sf->{name} || 'Storefront'), | |
| 195 | body => $body, | |
| 196 | }); | |
| 197 | } | |
| 198 | ||
| 199 | sub _co_h { | |
| 200 | my $s = shift; | |
| 201 | return '' unless defined $s; | |
| 202 | $s =~ s/&/&/g; | |
| 203 | $s =~ s/</</g; | |
| 204 | $s =~ s/>/>/g; | |
| 205 | $s =~ s/"/"/g; | |
| 206 | return $s; | |
| 207 | } | |
| 208 | ||
| 209 | # ---- Viewer-local timestamp wrapper --------------------------------- | |
| 210 | sub _co_ts_wrap { | |
| 211 | my ($human, $epoch, $fmt) = @_; | |
| 212 | $fmt = 'datetime' unless defined $fmt && length $fmt; | |
| 213 | return '-' unless defined($human) && length($human); | |
| 214 | my $esc = _co_h($human); | |
| 215 | return $esc unless $epoch && $epoch =~ /^\d+$/; | |
| 216 | return qq~<span class="ts" data-ts="$epoch" data-fmt="$fmt">$esc</span>~; | |
| 217 | } |