Diff -- /var/www/vhosts/3dshawn.com/shop.3dshawn.com/admin_action.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/shop.3dshawn.com/admin_action.cgi

added on local at 2026-07-01 22:09:16

Added
+542
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 6012a3136af8
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# ShopCart - Admin action handler.
4#
5# Single POST chokepoint for every admin-side mutation. Each "act"
6# value performs one tightly-scoped operation against a target user.
7#
8# Actions (POSTed via the buttons in /admin_user.cgi):
9# impersonate u=<id> -- start "Acting as X"
10# stop_impersonation -- end current impersonation
11# suspend u=<id> -- account_status='suspended'
12# reactivate u=<id> -- account_status='active'
13# close u=<id> -- account_status='closed'
14# promote_admin u=<id> -- is_admin=1
15# demote_admin u=<id> -- is_admin=0
16# reset_password u=<id> -- generate one-time token
17# edit_account u=<id> email= name= plan_tier= account_status=
18#
19# Every action goes through require_admin first. We do NOT allow GET
20# anywhere -- accidental link-followers can't trigger a destructive
21# action by sharing a URL.
22#======================================================================
23use strict;
24use warnings;
25
26use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com';
27use CGI;
28use MODS::Template;
29use MODS::DBConnect;
30use MODS::Login;
31use MODS::ShopCart::Config;
32use MODS::ShopCart::Wrapper;
33use MODS::ShopCart::Admin;
34
35my $q = CGI->new;
36my $form = $q->Vars;
37my $auth = MODS::Login->new;
38my $wrap = MODS::ShopCart::Wrapper->new;
39my $tfile = MODS::Template->new;
40my $db = MODS::DBConnect->new;
41my $cfg = MODS::ShopCart::Config->new;
42my $admin = MODS::ShopCart::Admin->new;
43my $DB = $cfg->settings('database_name');
44
45$| = 1;
46
47# Reject non-POST. Admin mutations must always be POST.
48if (($ENV{REQUEST_METHOD} || '') ne 'POST') {
49 print "Status: 405 Method Not Allowed\nContent-Type: text/plain\n\nPOST required\n";
50 exit;
51}
52
53my $userinfo = $auth->login_verify();
54if (!$userinfo) {
55 print "Status: 302 Found\nLocation: /login.cgi\n\n";
56 exit;
57}
58$admin->require_admin($userinfo);
59require MODS::ShopCart::Permissions;
60MODS::ShopCart::Permissions->new->require_feature($userinfo, 'admin_edit_users');
61
62my $act = lc($form->{act} || '');
63$act =~ s/[^a-z_]//g;
64
65my $target_id = $form->{u} || 0;
66$target_id =~ s/[^0-9]//g;
67
68my $admin_user_id = $admin->admin_user_id($userinfo);
69my $admin_sid = $admin->admin_session_id($userinfo);
70
71my $dbh = $db->db_connect();
72
73# Helpers ------------------------------------------------------------------
74sub _exists_user {
75 my ($dbh, $DB, $db, $id) = @_;
76 return 0 unless $id;
77 my $r = $db->db_readwrite($dbh, qq~
78 SELECT id FROM `${DB}`.users WHERE id='$id' LIMIT 1
79 ~, $ENV{SCRIPT_NAME}, __LINE__);
80 return ($r && $r->{id}) ? 1 : 0;
81}
82
83sub _go {
84 my ($where) = @_;
85 print "Status: 302 Found\nLocation: $where\n\n";
86 exit;
87}
88
89sub _go_user {
90 my ($id) = @_;
91 _go("/admin_user.cgi?u=$id");
92}
93
94sub _h {
95 my $s = shift; $s = '' unless defined $s;
96 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
97 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
98 return $s;
99}
100
101# ---- impersonate ---------------------------------------------------------
102if ($act eq 'impersonate') {
103 if (!_exists_user($dbh, $DB, $db, $target_id)) {
104 $db->db_disconnect($dbh);
105 _go('/admin.cgi');
106 }
107 if ($target_id eq $admin_user_id) {
108 $db->db_disconnect($dbh);
109 _go_user($target_id);
110 }
111
112 my $mode = ($form->{mode} || 'control');
113 $admin->start_impersonation($db, $dbh, $DB,
114 $admin_sid, $admin_user_id, $target_id, $mode);
115
116 $db->db_disconnect($dbh);
117 # Send them to the target user's dashboard so the admin immediately
118 # sees what the user sees.
119 _go('/dashboard.cgi');
120}
121
122# ---- stop_impersonation --------------------------------------------------
123if ($act eq 'stop_impersonation') {
124 $admin->stop_impersonation($db, $dbh, $DB, $admin_sid);
125 $db->db_disconnect($dbh);
126 _go('/admin.cgi');
127}
128
129# Everything below mutates the target user. Guard against missing/self
130# in the few spots where self-action would be dangerous.
131if (!$target_id || !_exists_user($dbh, $DB, $db, $target_id)) {
132 $db->db_disconnect($dbh);
133 _go('/admin.cgi');
134}
135
136# ---- suspend / reactivate / close ----------------------------------------
137if ($act eq 'suspend' || $act eq 'reactivate' || $act eq 'close') {
138 my $new = $act eq 'suspend' ? 'suspended'
139 : $act eq 'close' ? 'closed'
140 : 'active';
141
142 # Don't let an admin lock themselves out by suspending/closing self.
143 if (($act eq 'suspend' || $act eq 'close') && $target_id eq $admin_user_id) {
144 $db->db_disconnect($dbh);
145 _go_user($target_id);
146 }
147
148 $db->db_readwrite($dbh, qq~
149 UPDATE `${DB}`.users
150 SET account_status='$new', updated_at=NOW()
151 WHERE id='$target_id'
152 ~, $ENV{SCRIPT_NAME}, __LINE__);
153
154 # Suspending/closing also revokes all of their sessions so they're
155 # kicked out immediately. login_verify rejects non-active accounts
156 # anyway, but revoke is cleaner for any other code that loads
157 # session state directly.
158 if ($act eq 'suspend' || $act eq 'close') {
159 $db->db_readwrite($dbh, qq~
160 UPDATE `${DB}`.user_sessions
161 SET revoked_at=NOW()
162 WHERE user_id='$target_id' AND revoked_at IS NULL
163 ~, $ENV{SCRIPT_NAME}, __LINE__);
164 }
165
166 $db->db_disconnect($dbh);
167 _go_user($target_id);
168}
169
170# ---- promote / demote admin ---------------------------------------------
171# BUILD-57: grant credit (writes to credit_ledger keyed by user_id)
172if ($act eq 'grant_credit') {
173 my $target_uid = $form->{u} || 0; $target_uid =~ s/[^0-9]//g;
174 my $amount_dollars = $form->{amount_dollars} // '';
175 my $reason = $form->{reason} // '';
176 $amount_dollars =~ s/^\s+|\s+$//g;
177 $reason = substr($reason, 0, 500);
178 if ($target_uid && $amount_dollars =~ /^-?\d+(\.\d{1,2})?$/) {
179 my $cents = int($amount_dollars * 100);
180 my $kind = ($cents >= 0) ? 'grant' : 'adjustment';
181 my $r_sql = $reason; $r_sql =~ s/'/\\'/g;
182 my $bal_row = $db->db_readwrite($dbh, qq~
183 SELECT balance_after FROM `${DB}`.credit_ledger
184 WHERE user_id='$target_uid'
185 ORDER BY id DESC LIMIT 1
186 ~, $ENV{SCRIPT_NAME}, __LINE__);
187 my $prev_bal = ($bal_row && defined $bal_row->{balance_after}) ? $bal_row->{balance_after} + 0 : 0;
188 my $new_bal = $prev_bal + $cents;
189 $db->db_readwrite($dbh, qq~
190 INSERT INTO `${DB}`.credit_ledger
191 SET user_id='$target_uid', kind='$kind', amount_cents='$cents',
192 balance_after='$new_bal', reason='$r_sql',
193 created_by_user_id='$admin_user_id'
194 ~, $ENV{SCRIPT_NAME}, __LINE__);
195 }
196 print "Status: 302 Found\nLocation: /admin_user.cgi?u=$target_uid\n\n"; exit;
197}
198
199# BUILD-57: queue refund (writes to refund_intents + soft credit_ledger entry)
200if ($act eq 'queue_refund') {
201 my $target_uid = $form->{u} || 0; $target_uid =~ s/[^0-9]//g;
202 my $amount_dollars = $form->{amount_dollars} // '';
203 my $reason = $form->{reason} // '';
204 my $invoice_id = $form->{invoice_id} || 0; $invoice_id =~ s/[^0-9]//g;
205 $amount_dollars =~ s/^\s+|\s+$//g;
206 $reason = substr($reason, 0, 500);
207 if ($target_uid && $amount_dollars =~ /^\d+(\.\d{1,2})?$/) {
208 my $cents = int($amount_dollars * 100);
209 my $r_sql = $reason; $r_sql =~ s/'/\\'/g;
210 my $inv_sql = $invoice_id ? "'$invoice_id'" : 'NULL';
211 $db->db_readwrite($dbh, qq~
212 INSERT INTO `${DB}`.refund_intents
213 SET user_id='$target_uid', invoice_id=$inv_sql,
214 amount_cents='$cents', reason='$r_sql',
215 requested_by_uid='$admin_user_id', status='queued'
216 ~, $ENV{SCRIPT_NAME}, __LINE__);
217 # Soft credit: customer sees relief immediately
218 my $bal_row = $db->db_readwrite($dbh, qq~
219 SELECT balance_after FROM `${DB}`.credit_ledger
220 WHERE user_id='$target_uid' ORDER BY id DESC LIMIT 1
221 ~, $ENV{SCRIPT_NAME}, __LINE__);
222 my $prev_bal = ($bal_row && defined $bal_row->{balance_after}) ? $bal_row->{balance_after} + 0 : 0;
223 my $new_bal = $prev_bal + $cents;
224 my $sr_reason = "Refund queued (Stripe pending): $r_sql";
225 $db->db_readwrite($dbh, qq~
226 INSERT INTO `${DB}`.credit_ledger
227 SET user_id='$target_uid', kind='refund', amount_cents='$cents',
228 balance_after='$new_bal', reason='$sr_reason',
229 created_by_user_id='$admin_user_id'
230 ~, $ENV{SCRIPT_NAME}, __LINE__);
231 }
232 print "Status: 302 Found\nLocation: /admin_user.cgi?u=$target_uid\n\n"; exit;
233}
234
235
236
237if ($act eq 'promote_admin' || $act eq 'demote_admin') {
238 my $val = $act eq 'promote_admin' ? 1 : 0;
239
240 # An admin can demote themselves but only if there's at least one
241 # other admin. Otherwise we'd lock out the Admin Console forever.
242 if ($act eq 'demote_admin' && $target_id eq $admin_user_id) {
243 my $count = $db->db_readwrite($dbh, qq~
244 SELECT COUNT(*) AS n FROM `${DB}`.users
245 WHERE is_admin=1 AND id != '$target_id'
246 ~, $ENV{SCRIPT_NAME}, __LINE__);
247 if (!$count || !$count->{n}) {
248 $db->db_disconnect($dbh);
249 _go_user($target_id);
250 }
251 }
252
253 $db->db_readwrite($dbh, qq~
254 UPDATE `${DB}`.users
255 SET is_admin='$val', updated_at=NOW()
256 WHERE id='$target_id'
257 ~, $ENV{SCRIPT_NAME}, __LINE__);
258
259 $db->db_disconnect($dbh);
260 _go_user($target_id);
261}
262
263# ---- promote / demote SUPER admin --------------------------------------
264# Only an existing super-admin can grant or revoke super-admin. Wraps
265# the regular is_admin flag too so a super-admin demotion never strands
266# someone with a one-way upgrade (super yes / admin no -- nonsensical).
267# Self-demote is blocked outright: the platform must always have at
268# least one super-admin.
269if ($act eq 'promote_super_admin' || $act eq 'demote_super_admin') {
270 require MODS::ShopCart::Permissions;
271 my $is_super = MODS::ShopCart::Permissions->new->is_super_admin($userinfo);
272 unless ($is_super) {
273 $db->db_disconnect($dbh);
274 _go_user($target_id);
275 }
276
277 my $val = $act eq 'promote_super_admin' ? 1 : 0;
278
279 if ($act eq 'demote_super_admin' && $target_id eq $admin_user_id) {
280 # Never lock the platform out of super-admin -- you can't demote
281 # yourself. Demote someone else first if you really want to step
282 # back.
283 $db->db_disconnect($dbh);
284 _go_user($target_id);
285 }
286 if ($act eq 'demote_super_admin') {
287 my $count = $db->db_readwrite($dbh, qq~
288 SELECT COUNT(*) AS n FROM `${DB}`.users
289 WHERE is_super_admin=1 AND id != '$target_id'
290 ~, $ENV{SCRIPT_NAME}, __LINE__);
291 if (!$count || !$count->{n}) {
292 # Would leave the platform with zero super-admins. Refuse.
293 $db->db_disconnect($dbh);
294 _go_user($target_id);
295 }
296 }
297
298 # Super-admin implies admin. Set both atomically on promote so we
299 # can't end up with is_super_admin=1 AND is_admin=0.
300 my $admin_clause = $val ? ', is_admin=1' : '';
301 $db->db_readwrite($dbh, qq~
302 UPDATE `${DB}`.users
303 SET is_super_admin='$val'$admin_clause,
304 updated_at=NOW()
305 WHERE id='$target_id'
306 ~, $ENV{SCRIPT_NAME}, __LINE__);
307
308 $db->db_disconnect($dbh);
309 _go_user($target_id);
310}
311
312# ---- reset_password ------------------------------------------------------
313# Admin-initiated password reset: mints a one-shot token in
314# password_resets, emails the link to the target user, and shows the
315# admin a confirmation with the link inline (so they can also relay it
316# manually if email delivery is slow or the target's address is wrong).
317if ($act eq 'reset_password') {
318 require Digest::SHA;
319 require MODS::ShopCart::Mailer;
320
321 # Pre-migration guard. Pretend the action ran for the admin's UX
322 # but warn so they know to run the migration.
323 my $tab = $db->db_readwrite($dbh, qq~
324 SELECT COUNT(*) AS n FROM information_schema.tables
325 WHERE table_schema='$DB' AND table_name='password_resets'
326 ~, $ENV{SCRIPT_NAME}, __LINE__);
327 unless ($tab && $tab->{n}) {
328 $db->db_disconnect($dbh);
329 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";
330 my $body = qq~
331 <div class="page-head">
332 <div>
333 <span class="page-eyebrow"><span class="dot"></span> Admin &middot; Reset password</span>
334 <h1 class="page-title">Migration required</h1>
335 <p class="page-subtitle">Cannot send a reset link until the password_resets table is created.</p>
336 </div>
337 <div class="page-actions">
338 <a href="/admin_user.cgi?u=$target_id" class="btn btn-secondary">Back to user</a>
339 </div>
340 </div>
341 <div class="banner warn mb-3">Run the password_resets migration from installation_instructions.html, then try again.</div>
342 ~;
343 $wrap->render({ userinfo => $userinfo, page_key => 'admin', title => 'Reset password', body => $body });
344 exit;
345 }
346
347 # Look up the target user to get their email + display name.
348 my $u = $db->db_readwrite($dbh, qq~
349 SELECT id, email, display_name FROM `${DB}`.users WHERE id='$target_id' LIMIT 1
350 ~, $ENV{SCRIPT_NAME}, __LINE__);
351 unless ($u && $u->{id}) {
352 $db->db_disconnect($dbh);
353 _go_user($target_id);
354 exit;
355 }
356
357 # HMAC-SHA256 hex token (64 chars). Keyed off the platform Stripe
358 # webhook secret if set; otherwise a static fallback. Random 32-byte
359 # nonce makes guessing infeasible even with secret rotation.
360 my $key = $cfg->settings('stripe_webhook_secret')
361 || $cfg->settings('stripe_secret')
362 || 'shopcart-static-fallback';
363 my $rand = '';
364 $rand .= chr(int(rand(256))) for 1..32;
365 my $token = Digest::SHA::hmac_sha256_hex($u->{id} . '|' . time() . '|' . $rand, $key);
366
367 my $ip = $ENV{REMOTE_ADDR} || ''; $ip =~ s/'/''/g; $ip = substr($ip, 0, 45);
368 my $ua = 'admin:' . ($admin_user_id || '?');
369 $ua =~ s/'/''/g; $ua = substr($ua, 0, 255);
370
371 $db->db_readwrite($dbh, qq~
372 INSERT INTO `${DB}`.password_resets
373 SET user_id='$u->{id}',
374 token='$token',
375 requested_ip='$ip',
376 requested_user_agent='$ua',
377 expires_at=DATE_ADD(NOW(), INTERVAL 60 MINUTE)
378 ~, $ENV{SCRIPT_NAME}, __LINE__);
379
380 # Build the link from the request host.
381 my $proto = 'https';
382 $proto = 'http' unless ($ENV{HTTPS} || '') =~ /^on$/i
383 || ($ENV{HTTP_X_FORWARDED_PROTO} || '') =~ /^https$/i;
384 my $host = $ENV{HTTP_HOST} || 'shop.3dshawn.com';
385 my $link = "$proto://$host/reset_password.cgi?t=$token";
386
387 # Send the email. Failure (no SMTP, MTA down, etc.) does NOT block
388 # the admin -- they still see the link inline.
389 my $mailer = MODS::ShopCart::Mailer->new;
390 my $mail_ok = 0;
391 my $mail_error = '';
392 if ($mailer->is_configured) {
393 my $brand = $cfg->settings('brand_name') || 'ShopCart';
394 my $name = $u->{display_name} || 'there';
395 my $body_text = "Hi $name,\n\n"
396 . "A $brand administrator just initiated a password reset on your account.\n\n"
397 . "Use this link within the next 60 minutes:\n\n $link\n\n"
398 . "If you did not expect this, you can ignore the email and your password stays unchanged.\n\n"
399 . "-- $brand\n";
400 my $body_html = '<p>Hi ' . _h($name) . ',</p>'
401 . '<p>A ' . _h($brand) . ' administrator just initiated a password reset on your account.</p>'
402 . '<p><a href="' . _h($link) . '" style="display:inline-block;background:#4f46e5;color:#fff;padding:10px 18px;border-radius:6px;text-decoration:none;font-weight:600">Reset my password</a></p>'
403 . '<p style="font-size:13px;color:#475569">Or copy and paste this URL into your browser:<br><span style="word-break:break-all">' . _h($link) . '</span></p>'
404 . '<p style="font-size:13px;color:#475569">This link expires in 60 minutes. If you did not expect this, you can ignore the email and your password stays unchanged.</p>';
405 my $res = $mailer->send(
406 to => $u->{email},
407 subject => "Password reset for your $brand account",
408 body => $body_text,
409 html => $body_html,
410 );
411 $mail_ok = $res->{ok} ? 1 : 0;
412 $mail_error = $res->{error} || '';
413 } else {
414 $mail_error = 'Email pipeline not configured. Add SMTP settings in Software Configuration or install sendmail.';
415 }
416
417 $db->db_disconnect($dbh);
418
419 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";
420 my $sent_block = $mail_ok
421 ? '<div class="banner mb-3" style="background:rgba(34,197,94,0.10);border:1px solid rgba(34,197,94,0.35);color:#86efac">' .
422 '<strong>Email sent to ' . _h($u->{email}) . '.</strong> The link below is also valid if you need to share it directly.' .
423 '</div>'
424 : '<div class="banner warn mb-3"><strong>Email could NOT be sent:</strong> ' . _h($mail_error) . ' Share the link below manually.</div>';
425 my $body = qq~
426 <div class="page-head">
427 <div>
428 <span class="page-eyebrow"><span class="dot"></span> Admin &middot; Reset password</span>
429 <h1 class="page-title">Reset link issued</h1>
430 <p class="page-subtitle">Valid for 60 minutes, single-use.</p>
431 </div>
432 <div class="page-actions">
433 <a href="/admin_user.cgi?u=$target_id" class="btn btn-secondary">Back to user</a>
434 </div>
435 </div>
436 $sent_block
437 <div class="banner info mb-3" style="word-break:break-all">
438 <strong>Reset URL:</strong>
439 <code>$link</code>
440 </div>
441 ~;
442 $wrap->render({
443 userinfo => $userinfo,
444 page_key => 'admin',
445 title => 'Reset password',
446 body => $body,
447 });
448 exit;
449}
450
451# ---- edit_account --------------------------------------------------------
452if ($act eq 'edit_account') {
453 my $email = $form->{email} || '';
454 my $name = $form->{display_name} || '';
455 my $plan = $form->{plan_tier} || '';
456 my $stat = $form->{account_status} || '';
457
458 $email =~ s/[^A-Za-z0-9._+@\-]//g;
459 $name =~ s/[\\']//g;
460 $plan = '' unless $plan =~ /^(free|pro|business)$/;
461 $stat = '' unless $stat =~ /^(active|suspended|closed|pending_verification)$/;
462
463 # Same self-lockout guard as suspend/close.
464 if ($stat && $stat ne 'active' && $target_id eq $admin_user_id) {
465 $stat = '';
466 }
467
468 my @sets;
469 push @sets, "email='$email'" if $email;
470 push @sets, "display_name='$name'" if $name;
471 push @sets, "plan_tier='$plan'" if $plan;
472 push @sets, "account_status='$stat'" if $stat;
473 push @sets, "updated_at=NOW()";
474
475 if (@sets > 1) {
476 my $sets_sql = join(',', @sets);
477 $db->db_readwrite($dbh, qq~
478 UPDATE `${DB}`.users
479 SET $sets_sql
480 WHERE id='$target_id'
481 ~, $ENV{SCRIPT_NAME}, __LINE__);
482
483 # If we suspended/closed via this form, revoke sessions too.
484 if ($stat && $stat ne 'active') {
485 $db->db_readwrite($dbh, qq~
486 UPDATE `${DB}`.user_sessions
487 SET revoked_at=NOW()
488 WHERE user_id='$target_id' AND revoked_at IS NULL
489 ~, $ENV{SCRIPT_NAME}, __LINE__);
490 }
491 }
492
493 $db->db_disconnect($dbh);
494 _go_user($target_id);
495}
496
497# ---- edit_storage_overrides (Phase 2A) ---------------------------------
498# Sets per-user upload_max_mb_override / storage_hard_cap_gb_override.
499# Empty / 0 / blank input clears the override (NULL = use tier default).
500# Strict sanitization: only positive integers; reject negative,
501# scientific notation, decimals, hex, anything non-digit.
502if ($act eq 'edit_storage_overrides') {
503 my $raw_up = defined $form->{upload_max_mb_override} ? $form->{upload_max_mb_override} : '';
504 my $raw_hd = defined $form->{storage_hard_cap_gb_override} ? $form->{storage_hard_cap_gb_override} : '';
505 $raw_up =~ s/^\s+|\s+$//g;
506 $raw_hd =~ s/^\s+|\s+$//g;
507
508 # NULL clause if blank/zero/non-positive-integer; else integer value.
509 my $up_sql = ($raw_up ne '' && $raw_up =~ /^\d+$/ && $raw_up + 0 > 0)
510 ? "'" . ($raw_up + 0) . "'"
511 : 'NULL';
512 my $hd_sql = ($raw_hd ne '' && $raw_hd =~ /^\d+$/ && $raw_hd + 0 > 0)
513 ? "'" . ($raw_hd + 0) . "'"
514 : 'NULL';
515
516 $db->db_readwrite($dbh, qq~
517 UPDATE `${DB}`.users
518 SET upload_max_mb_override = $up_sql,
519 storage_hard_cap_gb_override = $hd_sql,
520 updated_at = NOW()
521 WHERE id = '$target_id' LIMIT 1
522 ~, $ENV{SCRIPT_NAME}, __LINE__);
523
524 $db->db_disconnect($dbh);
525 _go_user($target_id);
526}
527
528# ---- recompute_storage (Phase 2A) --------------------------------------
529# Authoritative recompute from source tables; rewrites
530# users.storage_used_bytes. Useful when the denormalized count drifts
531# (e.g. after a bulk delete bypassed bump_usage). Reversible (idempotent).
532if ($act eq 'recompute_storage') {
533 require MODS::ShopCart::Storage;
534 my $storage = MODS::ShopCart::Storage->new;
535 $storage->recompute_usage($db, $dbh, $DB, $target_id);
536 $db->db_disconnect($dbh);
537 _go_user($target_id);
538}
539
540# Unknown action -- back to the admin home.
541$db->db_disconnect($dbh);
542_go('/admin.cgi');