Diff -- /var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/admin_company.cgi
Diff
/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/admin_company.cgi
added on local at 2026-07-11 18:33:11
Added
+423
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 79a75ecae4f3
to 79a75ecae4f3
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 | ################################################################################################################################## | |
| 4 | # ______ ____ ____ ______ ______ ____ ___ __ ___ ______ _ __ ____ ____ __ __ _ __ _____ ____ | |
| 5 | # / ____// __ \ / __ \ / ____/ / ____// __ \ / | / |/ // ____/| | / // __ \ / __ \ / //_/ | | / /|__ / / __ \ | |
| 6 | # / / / / / // / / // __/ / /_ / /_/ // /| | / /|_/ // __/ | | /| / // / / // /_/ // ,< | | / / /_ < / / / / | |
| 7 | # / /___ / /_/ // /_/ // /___ / __/ / _, _// ___ | / / / // /___ | |/ |/ // /_/ // _, _// /| | | |/ / ___/ /_ / /_/ / | |
| 8 | # \____/ \____//_____//_____/ /_/ /_/ |_|/_/ |_|/_/ /_//_____/ |__/|__/ \____//_/ |_|/_/ |_| |___/ /____/(_)\____/ | |
| 9 | # | |
| 10 | # - Written by: Shawn Pickering | |
| 11 | # - shawn@shawnpickering.com | |
| 12 | ################################################################################################################################## | |
| 13 | use strict; | |
| 14 | use lib '/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com'; | |
| 15 | ||
| 16 | ||
| 17 | ############################################################# | |
| 18 | ## Variables | |
| 19 | ############################################################# | |
| 20 | ||
| 21 | ||
| 22 | ||
| 23 | ############################################################ | |
| 24 | # Modules | |
| 25 | ############################################################ | |
| 26 | use CGI; my $query = new CGI; my $form = $query->Vars; | |
| 27 | use MODS::PTMatrix::Urls; my $getlist = new MODS::PTMatrix::Urls; my $url = $getlist->urls(); | |
| 28 | use MODS::Template; my $tfile = new MODS::Template; | |
| 29 | use MODS::PTMatrix::Wrapper; my $load = new MODS::PTMatrix::Wrapper; | |
| 30 | use MODS::DBConnect; my $db = new MODS::DBConnect; | |
| 31 | use MODS::PTMatrix::Config; my $config = new MODS::PTMatrix::Config; my $database_name = $config->settings('database_name'); | |
| 32 | use MODS::PTMatrix::PM; | |
| 33 | ||
| 34 | ||
| 35 | ||
| 36 | ############################################################# | |
| 37 | ## Get form data | |
| 38 | ############################################################# | |
| 39 | #Preserve reasons/prices/dates verbatim before quotemeta chews them | |
| 40 | my %rawform = %$form; | |
| 41 | foreach my $line(keys %$form){ | |
| 42 | $form->{$line} =~ s/[^!-~\s]//g; | |
| 43 | $form->{$line} = quotemeta("$form->{$line}"); | |
| 44 | } | |
| 45 | ||
| 46 | ||
| 47 | ||
| 48 | ############################################################ | |
| 49 | # Program Controls | |
| 50 | ############################################################ | |
| 51 | $|=1; | |
| 52 | my $userinfo = MODS::PTMatrix::PM::require_login(); | |
| 53 | my $is_list = (($ENV{SCRIPT_NAME} || '') =~ m{/admin_companies\.cgi$}) ? 1 : 0; | |
| 54 | ||
| 55 | if(!$userinfo->{is_super_admin} && !$userinfo->{_admin_is_super_admin}){ | |
| 56 | print qq~Status: 302 Found\nLocation: /dashboard.cgi\n\n~; | |
| 57 | exit; | |
| 58 | } | |
| 59 | ||
| 60 | my $cid_target = 0; | |
| 61 | if($is_list){ | |
| 62 | &companies_list; | |
| 63 | }else{ | |
| 64 | $cid_target = MODS::PTMatrix::PM::safe_int($form->{id}); | |
| 65 | if(!$cid_target){ | |
| 66 | print qq~Status: 302 Found\nLocation: /admin_companies.cgi\n\n~; | |
| 67 | exit; | |
| 68 | } | |
| 69 | &admin_company; | |
| 70 | } | |
| 71 | ||
| 72 | ||
| 73 | ############################################################ | |
| 74 | # Subroutines | |
| 75 | ############################################################ | |
| 76 | sub balance_before{ | |
| 77 | #Latest ledger balance for any user in the target company | |
| 78 | my($dbh, $cid) = @_; | |
| 79 | my $bal_row = $db->db_readwrite($dbh, qq~SELECT balance_after FROM `${database_name}`.credit_ledger WHERE user_id IN (SELECT id FROM `${database_name}`.users WHERE company_id='$cid') ORDER BY id DESC LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 80 | return ($bal_row && defined $bal_row->{balance_after}) ? $bal_row->{balance_after} + 0 : 0; | |
| 81 | } | |
| 82 | ||
| 83 | sub pick_billing_uid{ | |
| 84 | #credit_ledger.user_id is NOT NULL - attribute to the company's first admin | |
| 85 | #or, failing that, any user in the company. Returns 0 if the company is | |
| 86 | #completely empty (no users to credit against). | |
| 87 | my($dbh, $cid) = @_; | |
| 88 | my $owner = $db->db_readwrite($dbh, qq~SELECT id FROM `${database_name}`.users WHERE company_id='$cid' AND role='company_admin' ORDER BY id ASC LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 89 | return $owner->{id} + 0 if $owner && $owner->{id}; | |
| 90 | my $any = $db->db_readwrite($dbh, qq~SELECT id FROM `${database_name}`.users WHERE company_id='$cid' ORDER BY id ASC LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 91 | return ($any && $any->{id}) ? $any->{id} + 0 : 0; | |
| 92 | } | |
| 93 | ||
| 94 | sub do_grant_credit{ | |
| 95 | my($dbh, $cid, $admin_uid) = @_; | |
| 96 | my $amount_dollars = $rawform{amount_dollars} // ''; | |
| 97 | my $reason = $rawform{reason} // ''; | |
| 98 | $amount_dollars =~ s/^\s+|\s+$//g; | |
| 99 | return '⚠ Amount must be a number (e.g. 25.00 or -10).' unless $amount_dollars =~ /^-?\d+(\.\d{1,2})?$/; | |
| 100 | ||
| 101 | my $cents = int($amount_dollars * 100); | |
| 102 | my $kind = ($cents >= 0) ? 'grant' : 'adjustment'; | |
| 103 | my $prev_bal = &balance_before($dbh, $cid); | |
| 104 | my $new_bal = $prev_bal + $cents; | |
| 105 | my $target_uid = &pick_billing_uid($dbh, $cid); | |
| 106 | return '⚠ Company has no users yet — nothing to credit against.' unless $target_uid; | |
| 107 | ||
| 108 | my $reason_q = MODS::PTMatrix::PM::sql_quote(substr($reason, 0, 255)); | |
| 109 | $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.credit_ledger (user_id, kind, amount_cents, balance_after, reason, created_by_user_id, created_at) VALUES ('$target_uid', '$kind', '$cents', '$new_bal', '$reason_q', '$admin_uid', NOW())~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 110 | my $disp = sprintf('%.2f', abs($cents) / 100); | |
| 111 | if($cents >= 0){ | |
| 112 | return "✓ Credited \$$disp to this company. New balance: \$" . sprintf('%.2f', $new_bal/100) . "."; | |
| 113 | } | |
| 114 | return "✓ Adjusted -\$$disp. New balance: \$" . sprintf('%.2f', $new_bal/100) . "."; | |
| 115 | } | |
| 116 | ||
| 117 | sub do_set_tier_override{ | |
| 118 | my($dbh, $cid) = @_; | |
| 119 | my $tier = $rawform{override_tier} || ''; | |
| 120 | $tier = '' unless $tier =~ /^(free|starter|pro|business|enterprise)$/; | |
| 121 | my $exp = MODS::PTMatrix::PM::safe_date($rawform{expires_at}); | |
| 122 | my $reason = MODS::PTMatrix::PM::sql_quote(substr($rawform{reason} // '', 0, 255)); | |
| 123 | return '' unless $tier; | |
| 124 | ||
| 125 | my $exp_sql = $exp ? "'$exp 23:59:59'" : 'NULL'; | |
| 126 | $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.companies SET plan_tier_override='$tier', plan_tier_override_expires_at=$exp_sql, plan_tier_override_reason='$reason' WHERE id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 127 | return "✓ Customer pushed to <strong>$tier</strong> until " . ($exp || 'cancelled'); | |
| 128 | } | |
| 129 | ||
| 130 | sub do_clear_tier_override{ | |
| 131 | my($dbh, $cid) = @_; | |
| 132 | $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.companies SET plan_tier_override='', plan_tier_override_expires_at=NULL, plan_tier_override_reason=NULL WHERE id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 133 | return 'Tier override cleared.'; | |
| 134 | } | |
| 135 | ||
| 136 | sub do_set_locked_price{ | |
| 137 | my($dbh, $cid) = @_; | |
| 138 | my $dollars = $rawform{price_dollars} // ''; | |
| 139 | $dollars =~ s/^\s+|\s+$//g; | |
| 140 | my $exp = MODS::PTMatrix::PM::safe_date($rawform{expires_at}); | |
| 141 | my $reason = MODS::PTMatrix::PM::sql_quote(substr($rawform{reason} // '', 0, 255)); | |
| 142 | return '⚠ Price must be a positive number (e.g. 14.99).' unless $dollars =~ /^\d+(\.\d{1,2})?$/; | |
| 143 | ||
| 144 | my $cents = int($dollars * 100); | |
| 145 | my $exp_sql = $exp ? "'$exp 23:59:59'" : 'NULL'; | |
| 146 | $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.companies SET locked_price_cents_per_seat='$cents', locked_price_expires_at=$exp_sql, locked_price_reason='$reason' WHERE id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 147 | my $disp = sprintf('%.2f', $cents/100); | |
| 148 | return "✓ Locked price set to \$$disp / seat / month until " . ($exp || 'cancelled'); | |
| 149 | } | |
| 150 | ||
| 151 | sub do_clear_locked_price{ | |
| 152 | my($dbh, $cid) = @_; | |
| 153 | $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.companies SET locked_price_cents_per_seat=NULL, locked_price_expires_at=NULL, locked_price_reason=NULL WHERE id='$cid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 154 | return 'Locked price cleared.'; | |
| 155 | } | |
| 156 | ||
| 157 | sub do_queue_refund{ | |
| 158 | #Queue a refund intent + apply a soft credit so the customer sees relief | |
| 159 | #immediately, even before Stripe processes the actual refund. | |
| 160 | my($dbh, $cid, $admin_uid) = @_; | |
| 161 | my $invoice_id = MODS::PTMatrix::PM::safe_int($rawform{invoice_id}); | |
| 162 | my $amount_dollars = $rawform{amount_dollars} // ''; | |
| 163 | my $reason = substr($rawform{reason} // '', 0, 500); | |
| 164 | $amount_dollars =~ s/^\s+|\s+$//g; | |
| 165 | return 'Refund failed: pick a valid amount.' unless $invoice_id && $amount_dollars =~ /^\d+(\.\d{1,2})?$/; | |
| 166 | ||
| 167 | my $cents = int($amount_dollars * 100); | |
| 168 | my $r_sql = $reason; | |
| 169 | $r_sql =~ s/'/\\'/g; | |
| 170 | ||
| 171 | $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.refund_intents SET company_id='$cid', invoice_id='$invoice_id', amount_cents='$cents', reason='$r_sql', requested_by_uid='$admin_uid', status='queued'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 172 | ||
| 173 | my $prev_bal = &balance_before($dbh, $cid); | |
| 174 | my $new_bal = $prev_bal + $cents; | |
| 175 | my $target_uid = &pick_billing_uid($dbh, $cid); | |
| 176 | if($target_uid){ | |
| 177 | my $sr_reason = "Refund queued (Stripe pending): $r_sql"; | |
| 178 | $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.credit_ledger SET user_id='$target_uid', kind='refund', amount_cents='$cents', balance_after='$new_bal', reason='$sr_reason', created_by_user_id='$admin_uid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 179 | } | |
| 180 | return 'Refund queued. Soft credit applied; Stripe processes once live keys are active.'; | |
| 181 | } | |
| 182 | ||
| 183 | sub dispatch_post{ | |
| 184 | my($dbh, $cid, $admin_uid) = @_; | |
| 185 | my $act = $rawform{act} || ''; | |
| 186 | if($act eq 'grant_credit') {return &do_grant_credit($dbh, $cid, $admin_uid);} | |
| 187 | if($act eq 'set_tier_override') {return &do_set_tier_override($dbh, $cid);} | |
| 188 | if($act eq 'clear_tier_override') {return &do_clear_tier_override($dbh, $cid);} | |
| 189 | if($act eq 'set_locked_price') {return &do_set_locked_price($dbh, $cid);} | |
| 190 | if($act eq 'clear_locked_price') {return &do_clear_locked_price($dbh, $cid);} | |
| 191 | if($act eq 'queue_refund') {return &do_queue_refund($dbh, $cid, $admin_uid);} | |
| 192 | return ''; | |
| 193 | } | |
| 194 | ||
| 195 | sub admin_company{ | |
| 196 | my $admin_uid = MODS::PTMatrix::PM::get_user_id($userinfo); | |
| 197 | ||
| 198 | my $dbh = $db->db_connect(); | |
| 199 | ||
| 200 | my $company = $db->db_readwrite($dbh, qq~SELECT *, UNIX_TIMESTAMP(trial_ends_at) AS trial_ends_epoch, UNIX_TIMESTAMP(plan_tier_override_expires_at) AS tier_override_expires_epoch, UNIX_TIMESTAMP(locked_price_expires_at) AS locked_price_expires_epoch FROM `${database_name}`.companies WHERE id='$cid_target' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 201 | if(!$company || !$company->{id}){ | |
| 202 | $db->db_disconnect($dbh); | |
| 203 | print qq~Status: 302 Found\nLocation: /admin_companies.cgi?err=nf\n\n~; | |
| 204 | exit; | |
| 205 | } | |
| 206 | ||
| 207 | my $flash = ''; | |
| 208 | if(($ENV{REQUEST_METHOD} || '') eq 'POST'){ | |
| 209 | $flash = &dispatch_post($dbh, $cid_target, $admin_uid); | |
| 210 | #Refresh company row after any mutation | |
| 211 | $company = $db->db_readwrite($dbh, qq~SELECT * FROM `${database_name}`.companies WHERE id='$cid_target' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 212 | } | |
| 213 | ||
| 214 | #Current running credit balance | |
| 215 | my $current_balance_cents = &balance_before($dbh, $cid_target); | |
| 216 | my $current_balance_disp = sprintf('%.2f', $current_balance_cents / 100); | |
| 217 | ||
| 218 | #Recent ledger entries | |
| 219 | my @ledger = $db->db_readwrite_multiple($dbh, qq~SELECT l.id, l.kind, l.amount_cents, l.balance_after, l.reason, l.created_at, UNIX_TIMESTAMP(l.created_at) AS created_epoch, u.display_name AS user_name, cb.display_name AS by_name FROM `${database_name}`.credit_ledger l LEFT JOIN `${database_name}`.users u ON u.id = l.user_id LEFT JOIN `${database_name}`.users cb ON cb.id = l.created_by_user_id WHERE l.user_id IN (SELECT id FROM `${database_name}`.users WHERE company_id='$cid_target') ORDER BY l.id DESC LIMIT 20~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 220 | foreach my $r(@ledger){ | |
| 221 | $r->{user_name} = MODS::PTMatrix::PM::h($r->{user_name} // ''); | |
| 222 | $r->{by_name} = MODS::PTMatrix::PM::h($r->{by_name} // 'system'); | |
| 223 | $r->{reason} = MODS::PTMatrix::PM::h($r->{reason} // ''); | |
| 224 | my $cents = $r->{amount_cents} + 0; | |
| 225 | $r->{amount_disp} = ($cents >= 0 ? '+' : '') . sprintf('$%.2f', $cents/100); | |
| 226 | $r->{balance_disp} = sprintf('$%.2f', $r->{balance_after}/100); | |
| 227 | $r->{is_credit} = ($cents >= 0) ? 1 : 0; | |
| 228 | } | |
| 229 | ||
| 230 | #Users in this company | |
| 231 | my @co_users = $db->db_readwrite_multiple($dbh, qq~SELECT id, email, display_name, role, account_status, last_login_at, created_at, UNIX_TIMESTAMP(last_login_at) AS last_login_epoch, UNIX_TIMESTAMP(created_at) AS created_epoch, avatar_color, is_super_admin, is_admin, two_factor_enabled, email_verified_at FROM `${database_name}`.users WHERE company_id='$cid_target' ORDER BY is_super_admin DESC, last_login_at DESC~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 232 | ||
| 233 | my $users_total = scalar(@co_users); | |
| 234 | my $users_active = scalar(grep { ($_->{account_status} || '') eq 'active' } @co_users); | |
| 235 | my $users_pending = scalar(grep { ($_->{account_status} || '') eq 'pending_verification' } @co_users); | |
| 236 | my $users_susp = scalar(grep { ($_->{account_status} || '') eq 'suspended' } @co_users); | |
| 237 | ||
| 238 | foreach my $usr(@co_users){ | |
| 239 | $usr->{display_name_h} = MODS::PTMatrix::PM::h($usr->{display_name} || $usr->{email}); | |
| 240 | $usr->{email_h} = MODS::PTMatrix::PM::h($usr->{email}); | |
| 241 | $usr->{initials} = MODS::PTMatrix::PM::initials($usr->{display_name} || $usr->{email}); | |
| 242 | $usr->{role_label} = ucfirst($usr->{role} || 'member'); | |
| 243 | $usr->{last_login_disp} = $usr->{last_login_at} || 'never'; | |
| 244 | $usr->{last_login_epoch} = $usr->{last_login_epoch} || ''; | |
| 245 | $usr->{is_verified} = $usr->{email_verified_at} ? 1 : 0; | |
| 246 | } | |
| 247 | ||
| 248 | #Earnings summary | |
| 249 | my $earn_row = $db->db_readwrite($dbh, qq~SELECT COALESCE(SUM(amount_paid_cents),0) AS total, COUNT(*) AS n FROM `${database_name}`.invoices WHERE company_id='$cid_target' AND status='paid'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 250 | my $earn_total_cents = $earn_row && $earn_row->{total} ? $earn_row->{total} + 0 : 0; | |
| 251 | my $earn_count = $earn_row && $earn_row->{n} ? $earn_row->{n} + 0 : 0; | |
| 252 | ||
| 253 | my $earn_30_row = $db->db_readwrite($dbh, qq~SELECT COALESCE(SUM(amount_paid_cents),0) AS total FROM `${database_name}`.invoices WHERE company_id='$cid_target' AND status='paid' AND paid_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 254 | my $earn_30_cents = $earn_30_row && $earn_30_row->{total} ? $earn_30_row->{total} + 0 : 0; | |
| 255 | ||
| 256 | my @recent_invoices = $db->db_readwrite_multiple($dbh, qq~SELECT id, invoice_number, status, amount_paid_cents, amount_due_cents, paid_at, created_at, UNIX_TIMESTAMP(paid_at) AS paid_epoch, UNIX_TIMESTAMP(created_at) AS created_epoch FROM `${database_name}`.invoices WHERE company_id='$cid_target' ORDER BY created_at DESC LIMIT 10~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 257 | foreach my $inv(@recent_invoices){ | |
| 258 | $inv->{amount_disp} = sprintf('$%.2f', ($inv->{amount_paid_cents} || 0)/100); | |
| 259 | $inv->{due_disp} = sprintf('$%.2f', ($inv->{amount_due_cents} || 0)/100); | |
| 260 | } | |
| 261 | ||
| 262 | #Projects + tasks totals | |
| 263 | my $proj_n = $db->db_readwrite($dbh, qq~SELECT COUNT(*) AS n FROM `${database_name}`.projects WHERE company_id='$cid_target' AND deleted_at IS NULL~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 264 | $proj_n = $proj_n && $proj_n->{n} ? $proj_n->{n} + 0 : 0; | |
| 265 | ||
| 266 | my $task_n = $db->db_readwrite($dbh, qq~SELECT COUNT(*) AS n FROM `${database_name}`.tasks WHERE company_id='$cid_target'~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 267 | $task_n = $task_n && $task_n->{n} ? $task_n->{n} + 0 : 0; | |
| 268 | ||
| 269 | #Queued refunds for this company | |
| 270 | my @refund_intents = $db->db_readwrite_multiple($dbh, qq~SELECT id, invoice_id, amount_cents, reason, requested_at, status, stripe_refund_id, processed_at, UNIX_TIMESTAMP(requested_at) AS requested_epoch, UNIX_TIMESTAMP(processed_at) AS processed_epoch FROM `${database_name}`.refund_intents WHERE company_id='$cid_target' ORDER BY id DESC LIMIT 20~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 271 | foreach my $ri(@refund_intents){ | |
| 272 | $ri->{amount_disp} = sprintf('$%.2f', ($ri->{amount_cents} || 0)/100); | |
| 273 | $ri->{reason} = MODS::PTMatrix::PM::h($ri->{reason} // ''); | |
| 274 | } | |
| 275 | ||
| 276 | my $company_name = MODS::PTMatrix::PM::h($company->{name}); | |
| 277 | my $tier_override_active = ($company->{plan_tier_override} && length $company->{plan_tier_override}) ? 1 : 0; | |
| 278 | my $locked_price_active = (defined $company->{locked_price_cents_per_seat} && length $company->{locked_price_cents_per_seat}) ? 1 : 0; | |
| 279 | my $locked_price_disp = $locked_price_active ? sprintf('%.2f', $company->{locked_price_cents_per_seat}/100) : ''; | |
| 280 | ||
| 281 | $db->db_disconnect($dbh); | |
| 282 | ||
| 283 | print qq~Content-Type: text/html; charset=utf-8\nCache-Control: no-store\n\n~; | |
| 284 | ||
| 285 | #Create all template variables | |
| 286 | my $tvars; | |
| 287 | $tvars->{cid} = $cid_target; | |
| 288 | $tvars->{company_name} = $company_name; | |
| 289 | $tvars->{company_slug} = MODS::PTMatrix::PM::h($company->{slug}); | |
| 290 | $tvars->{plan_tier} = $company->{plan_tier}; | |
| 291 | $tvars->{status} = $company->{status}; | |
| 292 | $tvars->{seat_count} = ($company->{seat_count} || 0) + 0; | |
| 293 | $tvars->{trial_ends_at} = $company->{trial_ends_at} // ''; | |
| 294 | $tvars->{trial_ends_epoch} = $company->{trial_ends_epoch} // ''; | |
| 295 | $tvars->{flash} = $flash; | |
| 296 | $tvars->{has_flash} = length($flash) ? 1 : 0; | |
| 297 | $tvars->{current_balance_disp} = $current_balance_disp; | |
| 298 | $tvars->{ledger} = \@ledger; | |
| 299 | $tvars->{has_ledger} = scalar(@ledger) ? 1 : 0; | |
| 300 | $tvars->{tier_override_active} = $tier_override_active; | |
| 301 | $tvars->{plan_tier_override} = $company->{plan_tier_override} // ''; | |
| 302 | $tvars->{tier_override_expires} = $company->{plan_tier_override_expires_at} // ''; | |
| 303 | $tvars->{tier_override_expires_epoch} = $company->{tier_override_expires_epoch} // ''; | |
| 304 | $tvars->{tier_override_reason} = MODS::PTMatrix::PM::h($company->{plan_tier_override_reason} // ''); | |
| 305 | $tvars->{co_users} = \@co_users; | |
| 306 | $tvars->{has_co_users} = scalar(@co_users) ? 1 : 0; | |
| 307 | $tvars->{users_total} = $users_total; | |
| 308 | $tvars->{users_active} = $users_active; | |
| 309 | $tvars->{users_pending} = $users_pending; | |
| 310 | $tvars->{users_susp} = $users_susp; | |
| 311 | $tvars->{earn_total_disp} = sprintf('%.2f', $earn_total_cents/100); | |
| 312 | $tvars->{earn_30_disp} = sprintf('%.2f', $earn_30_cents/100); | |
| 313 | $tvars->{earn_count} = $earn_count; | |
| 314 | $tvars->{recent_invoices} = \@recent_invoices; | |
| 315 | $tvars->{has_invoices} = scalar(@recent_invoices) ? 1 : 0; | |
| 316 | $tvars->{proj_n} = $proj_n; | |
| 317 | $tvars->{task_n} = $task_n; | |
| 318 | $tvars->{refund_intents} = \@refund_intents; | |
| 319 | $tvars->{has_refunds} = scalar(@refund_intents) ? 1 : 0; | |
| 320 | $tvars->{locked_price_active} = $locked_price_active; | |
| 321 | $tvars->{locked_price_disp} = $locked_price_disp; | |
| 322 | $tvars->{locked_price_expires} = $company->{locked_price_expires_at} // ''; | |
| 323 | $tvars->{locked_price_expires_epoch} = $company->{locked_price_expires_epoch} // ''; | |
| 324 | $tvars->{locked_price_reason} = MODS::PTMatrix::PM::h($company->{locked_price_reason} // ''); | |
| 325 | ||
| 326 | my $body = join('', $tfile->template('tf_admin_company.html', $tvars, $userinfo)); | |
| 327 | $load->render({ | |
| 328 | userinfo => $userinfo, | |
| 329 | page_key => 'admin_companies', | |
| 330 | title => "Admin — $company_name", | |
| 331 | body => $body, | |
| 332 | }); | |
| 333 | } | |
| 334 | ||
| 335 | sub companies_list{ | |
| 336 | #SUPER-ADMIN companies list. Filters (all optional, all driven from /admin_metrics.cgi tile clicks): | |
| 337 | # ?status=trial -> active companies on the trial plan | |
| 338 | # ?status=paying -> active companies on a paid plan | |
| 339 | # ?status=active -> active companies, any plan | |
| 340 | # ?recent=30 -> companies created in last N days | |
| 341 | # ?sort=projects -> ORDER BY project count DESC | |
| 342 | # ?sort=tasks -> ORDER BY task count DESC | |
| 343 | # ?sort=tasks_done -> ORDER BY completed task count DESC | |
| 344 | # ?sort=users -> ORDER BY user count DESC | |
| 345 | ||
| 346 | my $f_status = lc($form->{status} || ''); | |
| 347 | my $f_recent = MODS::PTMatrix::PM::safe_int($form->{recent} || 0); | |
| 348 | my $f_sort = lc($form->{sort} || ''); | |
| 349 | my $f_q = MODS::PTMatrix::PM::sql_quote($form->{q} || ''); | |
| 350 | ||
| 351 | my @where = ('1=1'); | |
| 352 | my $filter_label = ''; | |
| 353 | if($f_status eq 'trial'){ | |
| 354 | push @where, "c.plan_tier='trial' AND c.status='active'"; | |
| 355 | $filter_label = 'Trial customers'; | |
| 356 | }elsif($f_status eq 'paying'){ | |
| 357 | push @where, "c.plan_tier IN ('starter','pro','business','enterprise') AND c.status='active'"; | |
| 358 | $filter_label = 'Paying customers'; | |
| 359 | }elsif($f_status eq 'active'){ | |
| 360 | push @where, "c.status='active'"; | |
| 361 | $filter_label = 'Active companies'; | |
| 362 | } | |
| 363 | if($f_recent > 0){ | |
| 364 | push @where, "c.created_at >= DATE_SUB(NOW(), INTERVAL $f_recent DAY)"; | |
| 365 | $filter_label = $filter_label ? "$filter_label - last $f_recent days" : "New signups (last $f_recent days)"; | |
| 366 | } | |
| 367 | if($f_q ne ''){ | |
| 368 | push @where, "c.name LIKE '%$f_q%'"; | |
| 369 | } | |
| 370 | ||
| 371 | my %order = ( | |
| 372 | projects => 'projects_n DESC, c.created_at DESC', | |
| 373 | tasks => 'tasks_n DESC, c.created_at DESC', | |
| 374 | tasks_done => 'tasks_done_n DESC, c.created_at DESC', | |
| 375 | users => 'users_n DESC, c.created_at DESC', | |
| 376 | ); | |
| 377 | my $order_by = $order{$f_sort} || 'c.created_at DESC'; | |
| 378 | my $sort_label_map = { | |
| 379 | projects => 'most projects', | |
| 380 | tasks => 'most tasks', | |
| 381 | tasks_done => 'most tasks completed', | |
| 382 | users => 'most users', | |
| 383 | }; | |
| 384 | my $sort_label = $sort_label_map->{$f_sort} || ''; | |
| 385 | if($sort_label){ | |
| 386 | $filter_label = $filter_label ? "$filter_label - $sort_label" : "Sorted by $sort_label"; | |
| 387 | } | |
| 388 | ||
| 389 | my $where_sql = join(' AND ', @where); | |
| 390 | ||
| 391 | my $dbh = $db->db_connect(); | |
| 392 | ||
| 393 | #Matching companies with rolled-up users / projects / tasks counts | |
| 394 | my $sql = qq~SELECT c.id, c.name, c.slug, c.plan_tier, c.status, c.trial_ends_at, c.created_at, UNIX_TIMESTAMP(c.trial_ends_at) AS trial_ends_epoch, UNIX_TIMESTAMP(c.created_at) AS created_epoch, c.brand_color, c.seat_count, (SELECT COUNT(*) FROM `${database_name}`.users u WHERE u.company_id=c.id AND u.account_status='active') AS users_n, (SELECT COUNT(*) FROM `${database_name}`.projects p WHERE p.company_id=c.id) AS projects_n, (SELECT COUNT(*) FROM `${database_name}`.tasks t WHERE t.company_id=c.id) AS tasks_n, (SELECT COUNT(*) FROM `${database_name}`.tasks t WHERE t.company_id=c.id AND t.status='done') AS tasks_done_n FROM `${database_name}`.companies c WHERE $where_sql ORDER BY $order_by~; | |
| 395 | my @companies = $db->db_readwrite_multiple($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); | |
| 396 | ||
| 397 | $db->db_disconnect($dbh); | |
| 398 | ||
| 399 | foreach my $c(@companies){ | |
| 400 | $c->{name} = MODS::PTMatrix::PM::h($c->{name}); | |
| 401 | } | |
| 402 | ||
| 403 | print qq~Content-type:text/html; Cache-Control:no-cache;\n\n~; | |
| 404 | ||
| 405 | my $tvars; | |
| 406 | $tvars->{companies} = \@companies; | |
| 407 | $tvars->{has_companies} = scalar(@companies) ? 1 : 0; | |
| 408 | $tvars->{filter_label} = MODS::PTMatrix::PM::h($filter_label); | |
| 409 | $tvars->{has_filter} = $filter_label ? 1 : 0; | |
| 410 | $tvars->{f_sort} = MODS::PTMatrix::PM::h($f_sort); | |
| 411 | $tvars->{sort_projects} = ($f_sort eq 'projects') ? 1 : 0; | |
| 412 | $tvars->{sort_tasks} = ($f_sort eq 'tasks') ? 1 : 0; | |
| 413 | $tvars->{sort_done} = ($f_sort eq 'tasks_done') ? 1 : 0; | |
| 414 | ||
| 415 | my $body = join('', $tfile->template('tf_admin_companies.html', $tvars, $userinfo)); | |
| 416 | ||
| 417 | $load->render({ | |
| 418 | userinfo => $userinfo, | |
| 419 | page_key => 'admin_companies', | |
| 420 | title => 'All Companies', | |
| 421 | body => $body, | |
| 422 | }); | |
| 423 | } |