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

O Operator
Diff

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

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

Added
+531
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to ee80d2df974d
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# Admin -- Test Credit Cards (sandbox CCs that bypass Stripe).
4#
5# Manage fake cards used by staff for end-to-end billing QA. A test
6# card attached to a user (payment_methods.stripe_payment_method_id
7# starts with "test_pm_") causes the Stripe module to short-circuit
8# the charge call and synthesize the response per the card's behavior.
9#
10# Features (canonical pattern shared across all 7 sites):
11# * Create / delete cards
12# * Owner tag (which staff member each card belongs to)
13# * Soft-deactivate + reactivate (offboarding without losing history)
14# * Bulk deactivate-by-owner (one-click cleanup when someone leaves)
15# * Audit log of every action
16# * Assign-as-default for any user (drives the simulated charge)
17#
18# Super-admin only.
19#======================================================================
20use strict;
21use warnings;
22
23use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com';
24use CGI;
25use MODS::Template;
26use MODS::DBConnect;
27use MODS::Login;
28use MODS::ShopCart::Config;
29use MODS::ShopCart::Wrapper;
30use MODS::ShopCart::Admin;
31
32my $q = CGI->new;
33my $form = $q->Vars;
34my $auth = MODS::Login->new;
35my $wrap = MODS::ShopCart::Wrapper->new;
36my $tfile = MODS::Template->new;
37my $db = MODS::DBConnect->new;
38my $cfg = MODS::ShopCart::Config->new;
39my $admin = MODS::ShopCart::Admin->new;
40my $DB = $cfg->settings('database_name');
41
42$| = 1;
43my $userinfo = $auth->login_verify();
44if (!$userinfo) {
45 print "Status: 302 Found\nLocation: /login.cgi\n\n";
46 exit;
47}
48$admin->require_admin($userinfo);
49require MODS::ShopCart::Permissions;
50MODS::ShopCart::Permissions->new->require_super_admin($userinfo);
51
52my $dbh = $db->db_connect();
53my $actor_uid = $userinfo->{user_id} + 0;
54
55# Schema guard.
56my $schema_ready = 0;
57my $chk = $db->db_readwrite($dbh, qq~SHOW TABLES LIKE 'admin_test_cards'~,
58 $ENV{SCRIPT_NAME}, __LINE__);
59$schema_ready = 1 if $chk && %$chk;
60
61my %BEHAVIORS = (
62 approve => 'Approve (succeeded)',
63 decline => 'Decline (generic)',
64 insufficient_funds => 'Decline -- insufficient funds',
65 expired_card => 'Decline -- expired card',
66 processing_error => 'Decline -- processing error',
67 lost_card => 'Decline -- lost card',
68 stolen_card => 'Decline -- stolen card',
69 '3ds_required' => 'Requires 3D Secure auth',
70);
71my @BEHAVIOR_ORDER = qw(approve decline insufficient_funds expired_card processing_error lost_card stolen_card 3ds_required);
72
73# -------- POST actions ----------------------------------------------
74my $flash_kind = '';
75my $flash_msg = '';
76if (($ENV{REQUEST_METHOD} || '') eq 'POST' && $schema_ready) {
77 my $act = $form->{action} || '';
78
79 if ($act eq 'create') {
80 my %f;
81 $f{card_brand} = lc($form->{card_brand} || 'visa');
82 $f{card_brand} =~ s/[^a-z]//g;
83 $f{card_brand} = 'visa' unless $f{card_brand};
84 $f{card_number} = $form->{card_number} || '';
85 $f{card_number} =~ s/\s+//g;
86 $f{card_number} =~ s/[^0-9]//g;
87 $f{card_number} = substr($f{card_number}, 0, 19);
88 $f{last4} = (length $f{card_number} >= 4) ? substr($f{card_number}, -4) : '';
89 $f{exp_month} = ($form->{exp_month} || 12) + 0;
90 $f{exp_month} = 12 if $f{exp_month} < 1 || $f{exp_month} > 12;
91 $f{exp_year} = ($form->{exp_year} || 2030) + 0;
92 $f{exp_year} = 2030 if $f{exp_year} < 2024 || $f{exp_year} > 2100;
93 $f{cvc} = $form->{cvc} || '123';
94 $f{cvc} =~ s/[^0-9]//g;
95 $f{cvc} = substr($f{cvc}, 0, 4);
96 $f{cvc} = '123' unless $f{cvc};
97 $f{holder_name} = $form->{holder_name} || 'Test User';
98 $f{holder_name} =~ s/'/''/g;
99 $f{holder_name} = substr($f{holder_name}, 0, 120);
100 $f{behavior} = $form->{behavior} || 'approve';
101 $f{behavior} = 'approve' unless $BEHAVIORS{$f{behavior}};
102 $f{label} = $form->{label} || '';
103 $f{label} =~ s/'/''/g;
104 $f{label} = substr($f{label}, 0, 120);
105 my $owner_uid = ($form->{owner_user_id} || 0) + 0;
106 my $owner_sql = $owner_uid ? $owner_uid : 'NULL';
107
108 if (!$f{card_number} || length($f{card_number}) < 12) {
109 $flash_kind = 'danger';
110 $flash_msg = 'Card number is required and must be at least 12 digits.';
111 } else {
112 $db->db_readwrite($dbh, qq~
113 INSERT INTO `${DB}`.admin_test_cards
114 SET card_brand='$f{card_brand}',
115 card_number='$f{card_number}',
116 last4='$f{last4}',
117 exp_month=$f{exp_month},
118 exp_year=$f{exp_year},
119 cvc='$f{cvc}',
120 holder_name='$f{holder_name}',
121 behavior='$f{behavior}',
122 label='$f{label}',
123 is_active=1,
124 owner_user_id=$owner_sql,
125 created_by_user_id=$actor_uid,
126 created_at=NOW(),
127 updated_at=NOW()
128 ~, $ENV{SCRIPT_NAME}, __LINE__);
129 my $r = $db->db_readwrite($dbh, "SELECT LAST_INSERT_ID() AS id", $ENV{SCRIPT_NAME}, __LINE__);
130 my $new_id = $r->{id} + 0;
131 _log_action($db, $dbh, $DB, $new_id, $actor_uid, 'created', "brand=$f{card_brand} behavior=$f{behavior}");
132 $flash_kind = 'ok';
133 $flash_msg = "Test card #$new_id created.";
134 }
135 }
136 elsif ($act eq 'update_behavior') {
137 my $id = ($form->{card_id} || 0) + 0;
138 my $b = $form->{behavior} || 'approve';
139 $b = 'approve' unless $BEHAVIORS{$b};
140 if ($id) {
141 $db->db_readwrite($dbh, qq~
142 UPDATE `${DB}`.admin_test_cards
143 SET behavior='$b', updated_at=NOW()
144 WHERE id='$id'
145 ~, $ENV{SCRIPT_NAME}, __LINE__);
146 _log_action($db, $dbh, $DB, $id, $actor_uid, 'behavior_changed', "behavior=$b");
147 $flash_kind = 'ok';
148 $flash_msg = "Behavior updated to '$b'.";
149 }
150 }
151 elsif ($act eq 'deactivate') {
152 my $id = ($form->{card_id} || 0) + 0;
153 if ($id) {
154 $db->db_readwrite($dbh, qq~
155 UPDATE `${DB}`.admin_test_cards
156 SET is_active=0,
157 deactivated_by_user_id=$actor_uid,
158 deactivated_at=NOW(),
159 updated_at=NOW()
160 WHERE id='$id'
161 ~, $ENV{SCRIPT_NAME}, __LINE__);
162 # Drop any payment_methods rows that reference this card so
163 # active billing flows can no longer match it.
164 my $pm_marker = 'test_pm_' . $id;
165 $db->db_readwrite($dbh, qq~
166 DELETE FROM `${DB}`.payment_methods
167 WHERE stripe_payment_method_id='$pm_marker'
168 ~, $ENV{SCRIPT_NAME}, __LINE__);
169 _log_action($db, $dbh, $DB, $id, $actor_uid, 'deactivated', '');
170 $flash_kind = 'ok';
171 $flash_msg = "Test card #$id deactivated. Detached from all user accounts.";
172 }
173 }
174 elsif ($act eq 'reactivate') {
175 my $id = ($form->{card_id} || 0) + 0;
176 if ($id) {
177 $db->db_readwrite($dbh, qq~
178 UPDATE `${DB}`.admin_test_cards
179 SET is_active=1,
180 deactivated_by_user_id=NULL,
181 deactivated_at=NULL,
182 updated_at=NOW()
183 WHERE id='$id'
184 ~, $ENV{SCRIPT_NAME}, __LINE__);
185 _log_action($db, $dbh, $DB, $id, $actor_uid, 'reactivated', '');
186 $flash_kind = 'ok';
187 $flash_msg = "Test card #$id reactivated. Reassign to a user to use it again.";
188 }
189 }
190 elsif ($act eq 'bulk_deactivate_owner') {
191 my $oid = ($form->{owner_user_id} || 0) + 0;
192 if ($oid) {
193 my @victims = $db->db_readwrite_multiple($dbh, qq~
194 SELECT id FROM `${DB}`.admin_test_cards
195 WHERE owner_user_id='$oid' AND is_active=1
196 ~, $ENV{SCRIPT_NAME}, __LINE__);
197 foreach my $v (@victims) {
198 my $vid = $v->{id} + 0;
199 $db->db_readwrite($dbh, qq~
200 UPDATE `${DB}`.admin_test_cards
201 SET is_active=0, deactivated_by_user_id=$actor_uid, deactivated_at=NOW(), updated_at=NOW()
202 WHERE id='$vid'
203 ~, $ENV{SCRIPT_NAME}, __LINE__);
204 my $pm_marker = 'test_pm_' . $vid;
205 $db->db_readwrite($dbh, qq~
206 DELETE FROM `${DB}`.payment_methods
207 WHERE stripe_payment_method_id='$pm_marker'
208 ~, $ENV{SCRIPT_NAME}, __LINE__);
209 _log_action($db, $dbh, $DB, $vid, $actor_uid, 'bulk_deactivated', "owner_user_id=$oid");
210 }
211 my $n = scalar @victims;
212 $flash_kind = 'ok';
213 $flash_msg = "Bulk-deactivated $n card(s) owned by user #$oid.";
214 }
215 }
216 elsif ($act eq 'delete') {
217 my $id = ($form->{card_id} || 0) + 0;
218 if ($id) {
219 my $pm_marker = 'test_pm_' . $id;
220 $db->db_readwrite($dbh, qq~
221 DELETE FROM `${DB}`.payment_methods
222 WHERE stripe_payment_method_id='$pm_marker'
223 ~, $ENV{SCRIPT_NAME}, __LINE__);
224 _log_action($db, $dbh, $DB, $id, $actor_uid, 'deleted', '');
225 $db->db_readwrite($dbh, qq~
226 DELETE FROM `${DB}`.admin_test_cards WHERE id='$id'
227 ~, $ENV{SCRIPT_NAME}, __LINE__);
228 $flash_kind = 'ok';
229 $flash_msg = "Test card #$id removed and detached from all users.";
230 }
231 }
232 elsif ($act eq 'assign') {
233 my $id = ($form->{card_id} || 0) + 0;
234 my $target_uid = ($form->{target_user_id} || 0) + 0;
235 $target_uid = $actor_uid if (($form->{assign_to} || '') eq 'me');
236 if ($id && $target_uid) {
237 my $card = $db->db_readwrite($dbh, qq~
238 SELECT * FROM `${DB}`.admin_test_cards WHERE id='$id' AND is_active=1 LIMIT 1
239 ~, $ENV{SCRIPT_NAME}, __LINE__);
240 if ($card && $card->{id}) {
241 my $pm_marker = 'test_pm_' . $card->{id};
242 my $cus_marker = 'test_cus_' . $target_uid;
243 $db->db_readwrite($dbh, qq~
244 UPDATE `${DB}`.payment_methods SET is_default=0 WHERE user_id='$target_uid'
245 ~, $ENV{SCRIPT_NAME}, __LINE__);
246 my $existing = $db->db_readwrite($dbh, qq~
247 SELECT id FROM `${DB}`.payment_methods
248 WHERE user_id='$target_uid' AND stripe_payment_method_id='$pm_marker' LIMIT 1
249 ~, $ENV{SCRIPT_NAME}, __LINE__);
250 if ($existing && $existing->{id}) {
251 $db->db_readwrite($dbh, qq~
252 UPDATE `${DB}`.payment_methods SET is_default=1 WHERE id='$existing->{id}'
253 ~, $ENV{SCRIPT_NAME}, __LINE__);
254 } else {
255 my $hn = $card->{holder_name} || 'Test User';
256 $hn =~ s/'/''/g;
257 $db->db_readwrite($dbh, qq~
258 INSERT INTO `${DB}`.payment_methods
259 SET user_id='$target_uid',
260 brand='$card->{card_brand}',
261 last4='$card->{last4}',
262 exp_month=$card->{exp_month},
263 exp_year=$card->{exp_year},
264 stripe_payment_method_id='$pm_marker',
265 stripe_customer_id='$cus_marker',
266 is_default=1
267 ~, $ENV{SCRIPT_NAME}, __LINE__);
268 }
269 $db->db_readwrite($dbh, qq~
270 UPDATE `${DB}`.users
271 SET stripe_customer_id=COALESCE(NULLIF(stripe_customer_id,''),'$cus_marker')
272 WHERE id='$target_uid'
273 ~, $ENV{SCRIPT_NAME}, __LINE__);
274 _log_action($db, $dbh, $DB, $id, $actor_uid, 'assigned', "target_user_id=$target_uid behavior=$card->{behavior}");
275 $flash_kind = 'ok';
276 $flash_msg = "Card attached to user #$target_uid. Next charge simulates as '$card->{behavior}'.";
277 } else {
278 $flash_kind = 'danger';
279 $flash_msg = 'Card not found or inactive. Reactivate it first.';
280 }
281 }
282 }
283
284 $db->db_disconnect($dbh);
285 print "Status: 302 Found\nLocation: /admin_test_cards.cgi?flash_kind=$flash_kind&flash_msg=" . _u($flash_msg) . "\n\n";
286 exit;
287}
288
289# Flash from redirect.
290if (defined $form->{flash_kind}) {
291 my $k = $form->{flash_kind}; $k =~ s/[^a-z]//g;
292 $flash_kind = $k if $k eq 'ok' || $k eq 'danger';
293 $flash_msg = $form->{flash_msg} || '';
294 $flash_msg =~ s/[^A-Za-z0-9 .,;:_\-\$()%'#!?]//g;
295 $flash_msg = substr($flash_msg, 0, 240);
296}
297
298# -------- GET (render) ----------------------------------------------
299my (@cards_active, @cards_inactive);
300my %user_by_id;
301
302if ($schema_ready) {
303 my @rows = $db->db_readwrite_multiple($dbh, qq~
304 SELECT id, card_brand, card_number, last4, exp_month, exp_year,
305 cvc, holder_name, behavior, label, is_active,
306 owner_user_id, created_by_user_id, deactivated_by_user_id,
307 deactivated_at, last_used_at, created_at,
308 UNIX_TIMESTAMP(deactivated_at) AS deactivated_at_epoch,
309 UNIX_TIMESTAMP(last_used_at) AS last_used_at_epoch,
310 UNIX_TIMESTAMP(created_at) AS created_at_epoch
311 FROM `${DB}`.admin_test_cards
312 ORDER BY is_active DESC, created_at DESC, id DESC
313 ~, $ENV{SCRIPT_NAME}, __LINE__);
314
315 # Resolve user IDs to display names in one batch.
316 my %need_users;
317 foreach my $r (@rows) {
318 $need_users{$r->{owner_user_id} + 0} = 1 if $r->{owner_user_id};
319 $need_users{$r->{deactivated_by_user_id} + 0} = 1 if $r->{deactivated_by_user_id};
320 }
321 if (%need_users) {
322 my $id_list = join(',', map { $_ + 0 } keys %need_users);
323 my @us = $db->db_readwrite_multiple($dbh, qq~
324 SELECT id, email, display_name FROM `${DB}`.users WHERE id IN ($id_list)
325 ~, $ENV{SCRIPT_NAME}, __LINE__);
326 foreach my $u (@us) {
327 $user_by_id{$u->{id}} = $u->{display_name} || $u->{email} || ('User #' . $u->{id});
328 }
329 }
330
331 foreach my $r (@rows) {
332 my $masked = '**** **** **** ' . ($r->{last4} || '----');
333 my $expanded = '';
334 if ($r->{card_number}) {
335 my $cn = $r->{card_number};
336 $expanded = join(' ', $cn =~ /(\d{1,4})/g);
337 }
338 my $cur_b = $r->{behavior} || 'approve';
339 my @opts_for_card;
340 foreach my $bk (@BEHAVIOR_ORDER) {
341 push @opts_for_card, {
342 value => $bk,
343 label => $BEHAVIORS{$bk},
344 selected_attr => ($bk eq $cur_b) ? ' selected' : '',
345 };
346 }
347 my $owner_uid = $r->{owner_user_id} ? $r->{owner_user_id} + 0 : 0;
348 my $owner_name = $owner_uid ? ($user_by_id{$owner_uid} || "User #$owner_uid") : '';
349 my $deact_uid = $r->{deactivated_by_user_id} ? $r->{deactivated_by_user_id} + 0 : 0;
350 my $deact_name = $deact_uid ? ($user_by_id{$deact_uid} || "User #$deact_uid") : '';
351
352 my $card = {
353 id => $r->{id},
354 brand => $r->{card_brand} || 'visa',
355 brand_label => ucfirst($r->{card_brand} || 'visa'),
356 number_masked => $masked,
357 number_full => $expanded,
358 last4 => ($r->{last4} || '----'),
359 exp_display => sprintf('%02d/%02d', ($r->{exp_month} || 12), (($r->{exp_year} || 0) % 100)),
360 cvc => $r->{cvc} || '',
361 holder_name => _h($r->{holder_name} || ''),
362 behavior => $cur_b,
363 behavior_label => ($BEHAVIORS{$cur_b} || 'Approve'),
364 is_approve => ($cur_b eq 'approve') ? 1 : 0,
365 is_decline => ($cur_b ne 'approve') ? 1 : 0,
366 label => _h($r->{label} || ''),
367 has_label => length($r->{label} || '') ? 1 : 0,
368 is_active => $r->{is_active} ? 1 : 0,
369 is_inactive => $r->{is_active} ? 0 : 1,
370 owner_user_id => $owner_uid,
371 has_owner => $owner_uid ? 1 : 0,
372 owner_name => _h($owner_name),
373 deact_name => _h($deact_name),
374 has_deact => $deact_uid ? 1 : 0,
375 deact_at => (($r->{deactivated_at} && $r->{deactivated_at_epoch})
376 ? qq~<span class="ts" data-ts="$r->{deactivated_at_epoch}" data-fmt="datetime">${\ _h($r->{deactivated_at}) }</span>~
377 : _h($r->{deactivated_at} || '')),
378 created_at => (($r->{created_at} && $r->{created_at_epoch})
379 ? qq~<span class="ts" data-ts="$r->{created_at_epoch}" data-fmt="datetime">${\ _h($r->{created_at}) }</span>~
380 : _h($r->{created_at} || '')),
381 behavior_options => \@opts_for_card,
382 };
383 if ($r->{is_active}) { push @cards_active, $card; }
384 else { push @cards_inactive, $card; }
385 }
386}
387
388# Owners with >=1 active card -- for the bulk-deactivate picker.
389my @owner_groups;
390if ($schema_ready) {
391 my @rows = $db->db_readwrite_multiple($dbh, qq~
392 SELECT owner_user_id, COUNT(*) AS n
393 FROM `${DB}`.admin_test_cards
394 WHERE is_active=1 AND owner_user_id IS NOT NULL
395 GROUP BY owner_user_id
396 HAVING n >= 1
397 ORDER BY n DESC, owner_user_id ASC
398 ~, $ENV{SCRIPT_NAME}, __LINE__);
399 foreach my $g (@rows) {
400 my $uid = $g->{owner_user_id} + 0;
401 push @owner_groups, {
402 owner_user_id => $uid,
403 owner_name => _h($user_by_id{$uid} || "User #$uid"),
404 n => $g->{n} + 0,
405 };
406 }
407}
408
409# Recent users for picker (assign + owner).
410my @user_options;
411{
412 my @rows = $db->db_readwrite_multiple($dbh, qq~
413 SELECT id, email, display_name, plan_tier
414 FROM `${DB}`.users
415 WHERE account_status IN ('active','pending_verification')
416 ORDER BY created_at DESC, id DESC
417 LIMIT 50
418 ~, $ENV{SCRIPT_NAME}, __LINE__);
419 foreach my $u (@rows) {
420 my $label = ($u->{display_name} || $u->{email} || ('User #' . $u->{id}))
421 . ' (' . ($u->{email} || '#' . $u->{id}) . ')';
422 push @user_options, { id => $u->{id}, label => _h($label) };
423 }
424}
425
426# Recent audit log rows -- last 50.
427my @audit_rows;
428if ($schema_ready) {
429 my @rows = $db->db_readwrite_multiple($dbh, qq~
430 SELECT l.id, l.card_id, l.actor_user_id, l.action, l.detail, l.created_at,
431 UNIX_TIMESTAMP(l.created_at) AS created_at_epoch,
432 c.last4, c.card_brand
433 FROM `${DB}`.admin_test_cards_log l
434 LEFT JOIN `${DB}`.admin_test_cards c ON c.id = l.card_id
435 ORDER BY l.id DESC
436 LIMIT 50
437 ~, $ENV{SCRIPT_NAME}, __LINE__);
438 my %actor_need;
439 foreach my $r (@rows) { $actor_need{$r->{actor_user_id} + 0} = 1 if $r->{actor_user_id}; }
440 if (%actor_need) {
441 my $list = join(',', map { $_ + 0 } keys %actor_need);
442 my @us = $db->db_readwrite_multiple($dbh, qq~
443 SELECT id, display_name, email FROM `${DB}`.users WHERE id IN ($list)
444 ~, $ENV{SCRIPT_NAME}, __LINE__);
445 foreach my $u (@us) {
446 $user_by_id{$u->{id}} = $u->{display_name} || $u->{email} || ('User #' . $u->{id});
447 }
448 }
449 foreach my $r (@rows) {
450 my $auid = $r->{actor_user_id} ? $r->{actor_user_id} + 0 : 0;
451 my $aname = $auid ? ($user_by_id{$auid} || "User #$auid") : 'system';
452 push @audit_rows, {
453 id => $r->{id},
454 card_id => $r->{card_id},
455 card_label => $r->{last4} ? (ucfirst($r->{card_brand} || 'card') . ' &middot;&middot;&middot;' . $r->{last4}) : ('card #' . $r->{card_id}),
456 actor_name => _h($aname),
457 action => $r->{action},
458 detail => _h($r->{detail} || ''),
459 has_detail => length($r->{detail} || '') ? 1 : 0,
460 created_at => (($r->{created_at} && $r->{created_at_epoch})
461 ? qq~<span class="ts" data-ts="$r->{created_at_epoch}" data-fmt="datetime">${\ _h($r->{created_at}) }</span>~
462 : _h($r->{created_at} || '')),
463 };
464 }
465}
466
467$db->db_disconnect($dbh);
468
469my @behavior_options = map { { value => $_, label => $BEHAVIORS{$_} } } @BEHAVIOR_ORDER;
470
471my $tvars = {
472 user_id => $userinfo->{user_id},
473 cards_active => \@cards_active,
474 cards_inactive => \@cards_inactive,
475 has_active => scalar(@cards_active) ? 1 : 0,
476 has_inactive => scalar(@cards_inactive) ? 1 : 0,
477 no_cards => (scalar(@cards_active) + scalar(@cards_inactive)) ? 0 : 1,
478 n_active => scalar(@cards_active),
479 n_inactive => scalar(@cards_inactive),
480 owner_groups => \@owner_groups,
481 has_owner_groups => scalar(@owner_groups) ? 1 : 0,
482 user_options => \@user_options,
483 has_users => scalar(@user_options) ? 1 : 0,
484 behavior_options => \@behavior_options,
485 audit_rows => \@audit_rows,
486 has_audit => scalar(@audit_rows) ? 1 : 0,
487 schema_ready => $schema_ready ? 1 : 0,
488 schema_missing => $schema_ready ? 0 : 1,
489 flash_kind => $flash_kind,
490 flash_msg => $flash_msg,
491 has_flash => length $flash_msg ? 1 : 0,
492 flash_is_ok => ($flash_kind eq 'ok') ? 1 : 0,
493 flash_is_err => ($flash_kind eq 'danger') ? 1 : 0,
494};
495
496print "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";
497
498my $body = join('', $tfile->template('shopcart_admin_test_cards.html', $tvars, $userinfo));
499
500$wrap->render({
501 userinfo => $userinfo,
502 page_key => 'admin_test_cards',
503 title => 'Admin &middot; Test Credit Cards',
504 body => $body,
505});
506
507#----------------------------------------------------------------------
508sub _log_action {
509 my ($db, $dbh, $DB, $card_id, $actor_uid, $action, $detail) = @_;
510 return unless $card_id;
511 my $a = $action; $a =~ s/'/''/g; $a = substr($a, 0, 40);
512 my $d = $detail || ''; $d =~ s/'/''/g; $d = substr($d, 0, 255);
513 my $auid_sql = $actor_uid ? ($actor_uid + 0) : 'NULL';
514 $db->db_readwrite($dbh, qq~
515 INSERT INTO `${DB}`.admin_test_cards_log
516 SET card_id='$card_id', actor_user_id=$auid_sql, action='$a', detail='$d'
517 ~, $ENV{SCRIPT_NAME}, __LINE__);
518}
519
520sub _u {
521 my $s = shift; $s = '' unless defined $s;
522 $s =~ s/([^A-Za-z0-9\-_.~])/sprintf('%%%02X', ord($1))/eg;
523 return $s;
524}
525
526sub _h {
527 my $s = shift // '';
528 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
529 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
530 return $s;
531}