Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/admin_users.cgi
Diff
/var/www/vhosts/3dshawn.com/crm.3dshawn.com/admin_users.cgi
added on local at 2026-07-11 18:31:48
Added
+342
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to d4bc4ab04dc7
to d4bc4ab04dc7
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 - SUPER-ADMIN: All Users (TF-mirror layout) | |
| 4 | # PLUS per-user detail (drill-in via ?u=<int>). | |
| 5 | # | |
| 6 | # Consolidates the former /admin_user.cgi via dispatch on ?u=<int>. | |
| 7 | # The admin_user.cgi file is a 3-line wrapper that `do`s this file. | |
| 8 | #====================================================================== | |
| 9 | use strict; use warnings; | |
| 10 | use lib '/var/www/vhosts/3dshawn.com/crm.3dshawn.com'; | |
| 11 | use CGI; | |
| 12 | use MODS::Template; | |
| 13 | use MODS::DBConnect; | |
| 14 | use MODS::Login; | |
| 15 | use MODS::ContactForge::Config; | |
| 16 | use MODS::ContactForge::Wrapper; | |
| 17 | use MODS::ContactForge::Admin; | |
| 18 | use MODS::ContactForge::Billing; | |
| 19 | use MODS::ContactForge::NoOp; | |
| 20 | ||
| 21 | my $q = CGI->new; | |
| 22 | my $form = $q->Vars; | |
| 23 | my $auth = MODS::Login->new; | |
| 24 | my $wrap = MODS::ContactForge::Wrapper->new; | |
| 25 | my $tfile = MODS::Template->new; | |
| 26 | my $db = MODS::DBConnect->new; | |
| 27 | my $cfg = MODS::ContactForge::Config->new; | |
| 28 | my $admin = MODS::ContactForge::Admin->new; | |
| 29 | my $mp = MODS::ContactForge::NoOp->new; | |
| 30 | my $bill = MODS::ContactForge::Billing->new; | |
| 31 | my $DB = $cfg->settings('database_name'); | |
| 32 | ||
| 33 | $|=1; | |
| 34 | my $userinfo = $auth->login_verify(); | |
| 35 | if (!$userinfo) { print "Status: 302 Found\nLocation: /login.cgi\n\n"; exit; } | |
| 36 | $admin->require_admin($userinfo); | |
| 37 | require MODS::ContactForge::Permissions; | |
| 38 | MODS::ContactForge::Permissions->new->require_feature($userinfo, 'admin_view_users'); | |
| 39 | ||
| 40 | # ---- Detail dispatch: ?u=<nonzero int> renders per-user detail ------ | |
| 41 | my $_u_param = $form->{u} || 0; $_u_param =~ s/[^0-9]//g; | |
| 42 | if ($_u_param) { | |
| 43 | _det_render($_u_param); | |
| 44 | exit; | |
| 45 | } | |
| 46 | ||
| 47 | my $sq = $form->{q} || ''; | |
| 48 | $sq =~ s/[^A-Za-z0-9_\-\.\s\@]//g; | |
| 49 | ||
| 50 | my $dbh = $db->db_connect(); | |
| 51 | ||
| 52 | my $where = '1=1'; | |
| 53 | $where .= " AND (u.email LIKE '%$sq%' OR u.display_name LIKE '%$sq%' OR s.name LIKE '%$sq%' OR s.subdomain LIKE '%$sq%')" if $sq; | |
| 54 | ||
| 55 | my @users = $db->db_readwrite_multiple($dbh, qq~ | |
| 56 | SELECT u.id, u.email, u.display_name, u.plan_tier, u.account_status, | |
| 57 | u.is_admin, u.last_login_at, u.created_at, | |
| 58 | UNIX_TIMESTAMP(u.last_login_at) AS last_login_epoch, | |
| 59 | UNIX_TIMESTAMP(u.created_at) AS created_epoch, | |
| 60 | s.id AS storefront_id, s.name AS storefront_name, s.subdomain | |
| 61 | FROM `${DB}`.users u | |
| 62 | LEFT JOIN `${DB}`.storefronts s ON s.user_id = u.id | |
| 63 | WHERE $where | |
| 64 | GROUP BY u.id | |
| 65 | ORDER BY u.created_at DESC | |
| 66 | LIMIT 200 | |
| 67 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 68 | ||
| 69 | my @palette = ('#5aa9ff','#34d399','#fbbf24','#a78bfa','#f87171','#22c55e','#06b6d4','#ec4899','#f59e0b'); | |
| 70 | foreach my $u (@users) { | |
| 71 | my $dn = $u->{display_name} || $u->{email} || ('User #' . $u->{id}); | |
| 72 | $u->{display_name} = _h($dn); | |
| 73 | $u->{email} = _h($u->{email}); | |
| 74 | $u->{plan_tier} = ucfirst($u->{plan_tier} || 'free'); | |
| 75 | $u->{account_status} = _h($u->{account_status} || 'active'); | |
| 76 | $u->{is_admin_flag} = $u->{is_admin} ? 1 : 0; | |
| 77 | $u->{last_login_at} = $u->{last_login_at} || '-'; | |
| 78 | $u->{storefront_name} = _h($u->{storefront_name} || '-'); | |
| 79 | $u->{avatar_color} = $palette[ ($u->{id} || 0) % scalar(@palette) ]; | |
| 80 | my @parts = split /\s+/, $dn, 2; | |
| 81 | my $ini = ''; | |
| 82 | $ini .= uc(substr($parts[0], 0, 1)) if defined $parts[0]; | |
| 83 | $ini .= uc(substr($parts[1], 0, 1)) if defined $parts[1] && length $parts[1]; | |
| 84 | $ini = uc(substr($dn, 0, 2)) unless length $ini; | |
| 85 | $u->{initials} = $ini; | |
| 86 | $u->{is_self} = ($u->{id} == $userinfo->{user_id}) ? 1 : 0; | |
| 87 | } | |
| 88 | $db->db_disconnect($dbh); | |
| 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 $tvars = { | |
| 92 | users => \@users, | |
| 93 | has_users => scalar(@users) ? 1 : 0, | |
| 94 | q => _h($sq), | |
| 95 | }; | |
| 96 | my $body = join('', $tfile->template('cf_admin_users.html', $tvars, $userinfo)); | |
| 97 | $wrap->render({ | |
| 98 | userinfo => $userinfo, | |
| 99 | page_key => 'admin_users', | |
| 100 | title => 'All Users', | |
| 101 | body => $body, | |
| 102 | }); | |
| 103 | ||
| 104 | sub _h { | |
| 105 | my $s = shift; | |
| 106 | return '' unless defined $s; | |
| 107 | $s =~ s/&/&/g; | |
| 108 | $s =~ s/</</g; | |
| 109 | $s =~ s/>/>/g; | |
| 110 | $s =~ s/"/"/g; | |
| 111 | return $s; | |
| 112 | } | |
| 113 | ||
| 114 | #====================================================================== | |
| 115 | # Detail view -- ported from former admin_user.cgi. | |
| 116 | # Auth + admin gate were already verified above. | |
| 117 | #====================================================================== | |
| 118 | sub _det_scalar { | |
| 119 | my ($db, $dbh, $sql, $key) = @_; | |
| 120 | my $r = $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); | |
| 121 | return ($r && defined $r->{$key}) ? $r->{$key} : 0; | |
| 122 | } | |
| 123 | ||
| 124 | sub _det_esc { | |
| 125 | my $s = shift; | |
| 126 | return '' unless defined $s; | |
| 127 | $s =~ s/&/&/g; | |
| 128 | $s =~ s/</</g; | |
| 129 | $s =~ s/>/>/g; | |
| 130 | $s =~ s/"/"/g; | |
| 131 | return $s; | |
| 132 | } | |
| 133 | ||
| 134 | sub _det_render { | |
| 135 | my ($uid) = @_; | |
| 136 | ||
| 137 | my $dbh = $db->db_connect(); | |
| 138 | ||
| 139 | # ---- The target user --------------------------------------------- | |
| 140 | my $u = $db->db_readwrite($dbh, qq~ | |
| 141 | SELECT id, email, display_name, plan_tier, account_status, is_admin, | |
| 142 | trust_level, two_factor_enabled, email_verified_at, | |
| 143 | last_login_at, default_currency, timezone, created_at, updated_at, | |
| 144 | UNIX_TIMESTAMP(email_verified_at) AS email_verified_epoch, | |
| 145 | UNIX_TIMESTAMP(last_login_at) AS last_login_epoch, | |
| 146 | UNIX_TIMESTAMP(created_at) AS created_epoch, | |
| 147 | UNIX_TIMESTAMP(updated_at) AS updated_epoch | |
| 148 | FROM `${DB}`.users | |
| 149 | WHERE id='$uid' | |
| 150 | LIMIT 1 | |
| 151 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 152 | ||
| 153 | if (!$u || !$u->{id}) { | |
| 154 | $db->db_disconnect($dbh); | |
| 155 | print "Status: 302 Found\nLocation: /admin.cgi\n\n"; | |
| 156 | return; | |
| 157 | } | |
| 158 | ||
| 159 | # ---- Dashboard(s) ------------------------------------------------ | |
| 160 | my @dashboards = $db->db_readwrite_multiple($dbh, qq~ | |
| 161 | SELECT id, name, subdomain, created_at, | |
| 162 | UNIX_TIMESTAMP(created_at) AS created_epoch | |
| 163 | FROM `${DB}`.dashboards | |
| 164 | WHERE user_id='$uid' | |
| 165 | ORDER BY id ASC | |
| 166 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 167 | ||
| 168 | # ---- Model counts ------------------------------------------------ | |
| 169 | my $m_total = _det_scalar($db, $dbh, | |
| 170 | "SELECT COUNT(*) AS n FROM `${DB}`.models WHERE user_id='$uid' AND purged_at IS NULL", 'n'); | |
| 171 | my $m_purged = _det_scalar($db, $dbh, | |
| 172 | "SELECT COUNT(*) AS n FROM `${DB}`.models WHERE user_id='$uid' AND purged_at IS NOT NULL", 'n'); | |
| 173 | my $m_published = _det_scalar($db, $dbh, | |
| 174 | "SELECT COUNT(*) AS n FROM `${DB}`.models WHERE user_id='$uid' AND status='published' AND purged_at IS NULL", 'n'); | |
| 175 | ||
| 176 | # Last 10 models so the admin can see what they're working on. | |
| 177 | my @models = $db->db_readwrite_multiple($dbh, qq~ | |
| 178 | SELECT id, title, status, visibility, currency, base_price_cents, | |
| 179 | created_at, updated_at, | |
| 180 | UNIX_TIMESTAMP(created_at) AS created_epoch, | |
| 181 | UNIX_TIMESTAMP(updated_at) AS updated_epoch | |
| 182 | FROM `${DB}`.models | |
| 183 | WHERE user_id='$uid' AND purged_at IS NULL | |
| 184 | ORDER BY updated_at DESC | |
| 185 | LIMIT 10 | |
| 186 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 187 | ||
| 188 | foreach my $m (@models) { | |
| 189 | $m->{price} = '$' . sprintf('%.2f', ($m->{base_price_cents} || 0) / 100); | |
| 190 | $m->{title} = $m->{title} || ('Model #' . $m->{id}); | |
| 191 | } | |
| 192 | ||
| 193 | # ---- Orders / revenue -------------------------------------------- | |
| 194 | # Sum across every dashboard the user owns. | |
| 195 | my $orders_30d_count = 0; | |
| 196 | my $orders_30d_cents = 0; | |
| 197 | my $orders_all_cents = 0; | |
| 198 | my @recent_orders; | |
| 199 | ||
| 200 | if (@dashboards) { | |
| 201 | my $sids = join(',', map { "'$_->{id}'" } @dashboards); | |
| 202 | ||
| 203 | my $rec30 = $db->db_readwrite($dbh, qq~ | |
| 204 | SELECT COUNT(*) AS n, COALESCE(SUM(total_amount_cents),0) AS cents | |
| 205 | FROM `${DB}`.orders | |
| 206 | WHERE dashboard_id IN ($sids) | |
| 207 | AND status='paid' | |
| 208 | AND created_at >= DATE_SUB(NOW(), INTERVAL 30 DAY) | |
| 209 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 210 | if ($rec30) { | |
| 211 | $orders_30d_count = $rec30->{n} || 0; | |
| 212 | $orders_30d_cents = $rec30->{cents} || 0; | |
| 213 | } | |
| 214 | ||
| 215 | my $allr = $db->db_readwrite($dbh, qq~ | |
| 216 | SELECT COALESCE(SUM(total_amount_cents),0) AS cents | |
| 217 | FROM `${DB}`.orders | |
| 218 | WHERE dashboard_id IN ($sids) | |
| 219 | AND status='paid' | |
| 220 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 221 | $orders_all_cents = ($allr && $allr->{cents}) ? $allr->{cents} : 0; | |
| 222 | ||
| 223 | @recent_orders = $db->db_readwrite_multiple($dbh, qq~ | |
| 224 | SELECT id, dashboard_id, contact_email, total_amount_cents, | |
| 225 | currency, status, created_at, | |
| 226 | UNIX_TIMESTAMP(created_at) AS created_epoch | |
| 227 | FROM `${DB}`.orders | |
| 228 | WHERE dashboard_id IN ($sids) | |
| 229 | ORDER BY created_at DESC | |
| 230 | LIMIT 10 | |
| 231 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 232 | ||
| 233 | foreach my $o (@recent_orders) { | |
| 234 | $o->{total} = '$' . sprintf('%.2f', ($o->{total_amount_cents} || 0) / 100); | |
| 235 | } | |
| 236 | } | |
| 237 | ||
| 238 | # ---- Channel connections ----------------------------------------- | |
| 239 | my @mp_rows; | |
| 240 | my $have_mp = _det_scalar($db, $dbh, qq~ | |
| 241 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 242 | WHERE table_schema='$DB' AND table_name='channel_accounts' | |
| 243 | ~, 'n'); | |
| 244 | if ($have_mp) { | |
| 245 | @mp_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 246 | SELECT platform, status, account_handle, connected_at, last_used_at, | |
| 247 | UNIX_TIMESTAMP(connected_at) AS connected_epoch, | |
| 248 | UNIX_TIMESTAMP(last_used_at) AS last_used_epoch | |
| 249 | FROM `${DB}`.channel_accounts | |
| 250 | WHERE user_id='$uid' | |
| 251 | ORDER BY platform ASC | |
| 252 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 253 | foreach my $r (@mp_rows) { | |
| 254 | my $p = $mp->by_slug($r->{platform}); | |
| 255 | $r->{name} = $p ? $p->{name} : ucfirst($r->{platform}); | |
| 256 | $r->{connected_at} = $r->{connected_at} || '-'; | |
| 257 | $r->{last_used_at} = $r->{last_used_at} || '-'; | |
| 258 | } | |
| 259 | } | |
| 260 | ||
| 261 | # ---- Credit balance ---------------------------------------------- | |
| 262 | # Billing helpers self-guard against missing credit_ledger table. | |
| 263 | my $credit_cents = $bill->credit_balance_cents($db, $dbh, $DB, $uid); | |
| 264 | ||
| 265 | $db->db_disconnect($dbh); | |
| 266 | ||
| 267 | # ---- Format / tvars ---------------------------------------------- | |
| 268 | my $is_self = ($uid eq $userinfo->{_admin_user_id} || $uid eq $userinfo->{user_id}) ? 1 : 0; | |
| 269 | ||
| 270 | my $tvars = { | |
| 271 | target_id => $u->{id}, | |
| 272 | target_email => _det_esc($u->{email}), | |
| 273 | target_display_name => _det_esc($u->{display_name} || $u->{email}), | |
| 274 | target_plan_tier => ucfirst($u->{plan_tier} || 'free'), | |
| 275 | target_plan_raw => $u->{plan_tier} || 'free', | |
| 276 | target_account_status => $u->{account_status} || 'active', | |
| 277 | target_is_admin => $u->{is_admin} ? 1 : 0, | |
| 278 | target_is_super_admin => $u->{is_super_admin} ? 1 : 0, | |
| 279 | target_not_super_admin => $u->{is_super_admin} ? 0 : 1, | |
| 280 | # login_verify() does NOT include is_super_admin -- read it through | |
| 281 | # Permissions->is_super_admin() which probes lazily and caches. | |
| 282 | viewer_is_super_admin => do { | |
| 283 | require MODS::ContactForge::Permissions; | |
| 284 | MODS::ContactForge::Permissions->new->is_super_admin($userinfo) ? 1 : 0; | |
| 285 | }, | |
| 286 | target_2fa => $u->{two_factor_enabled} ? 'On' : 'Off', | |
| 287 | target_trust_level => $u->{trust_level} || 0, | |
| 288 | target_currency => $u->{default_currency} || 'USD', | |
| 289 | target_timezone => $u->{timezone} || 'UTC', | |
| 290 | target_created_at => $u->{created_at} || '-', | |
| 291 | target_created_epoch => $u->{created_epoch} || 0, | |
| 292 | target_last_login_at => $u->{last_login_at} || '-', | |
| 293 | target_last_login_epoch => $u->{last_login_epoch} || 0, | |
| 294 | target_email_verified => $u->{email_verified_at} ? 'Verified' : 'Unverified', | |
| 295 | ||
| 296 | is_self => $is_self, | |
| 297 | is_active => (($u->{account_status} || '') eq 'active') ? 1 : 0, | |
| 298 | is_suspended => (($u->{account_status} || '') eq 'suspended') ? 1 : 0, | |
| 299 | is_closed => (($u->{account_status} || '') eq 'closed') ? 1 : 0, | |
| 300 | ||
| 301 | # Sub-data | |
| 302 | dashboards => \@dashboards, | |
| 303 | dashboard_count => scalar(@dashboards), | |
| 304 | has_dashboard => scalar(@dashboards) ? 1 : 0, | |
| 305 | ||
| 306 | models => \@models, | |
| 307 | model_count => scalar(@models), | |
| 308 | m_total => $m_total, | |
| 309 | m_published => $m_published, | |
| 310 | m_purged => $m_purged, | |
| 311 | has_models => scalar(@models) ? 1 : 0, | |
| 312 | ||
| 313 | recent_orders => \@recent_orders, | |
| 314 | has_orders => scalar(@recent_orders) ? 1 : 0, | |
| 315 | orders_30d_count => $orders_30d_count, | |
| 316 | orders_30d_revenue => '$' . sprintf('%.2f', $orders_30d_cents / 100), | |
| 317 | orders_all_revenue => '$' . sprintf('%.2f', $orders_all_cents / 100), | |
| 318 | ||
| 319 | channels => \@mp_rows, | |
| 320 | has_channels => scalar(@mp_rows) ? 1 : 0, | |
| 321 | ||
| 322 | # Credits (account-level credit ledger balance) | |
| 323 | target_credit_cents => $credit_cents, | |
| 324 | target_credit_dollars => ($credit_cents < 0 ? '-' : '') . '$' . sprintf('%.2f', abs($credit_cents) / 100), | |
| 325 | target_has_credit => $credit_cents > 0 ? 1 : 0, | |
| 326 | target_has_debit => $credit_cents < 0 ? 1 : 0, | |
| 327 | target_no_credit => $credit_cents == 0 ? 1 : 0, | |
| 328 | }; | |
| 329 | ||
| 330 | 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"; | |
| 331 | ||
| 332 | my $body = join('', $tfile->template('cf_admin_user.html', $tvars, $userinfo)); | |
| 333 | ||
| 334 | $wrap->render({ | |
| 335 | userinfo => $userinfo, | |
| 336 | page_key => 'admin', | |
| 337 | title => 'Admin: ' . ($u->{display_name} || $u->{email}), | |
| 338 | body => $body, | |
| 339 | extra_js => ['/assets/javascript/graphs.js'], | |
| 340 | }); | |
| 341 | return; | |
| 342 | } |