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

O Operator
Diff

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

added on local at 2026-07-11 18:33:18

Added
+438
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to c50d57ac70fd
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##################################################################################################################################
4# ______ ____ ____ ______ ______ ____ ___ __ ___ ______ _ __ ____ ____ __ __ _ __ _____ ____
5# / ____// __ \ / __ \ / ____/ / ____// __ \ / | / |/ // ____/| | / // __ \ / __ \ / //_/ | | / /|__ / / __ \
6# / / / / / // / / // __/ / /_ / /_/ // /| | / /|_/ // __/ | | /| / // / / // /_/ // ,< | | / / /_ < / / / /
7# / /___ / /_/ // /_/ // /___ / __/ / _, _// ___ | / / / // /___ | |/ |/ // /_/ // _, _// /| | | |/ / ___/ /_ / /_/ /
8# \____/ \____//_____//_____/ /_/ /_/ |_|/_/ |_|/_/ /_//_____/ |__/|__/ \____//_/ |_|/_/ |_| |___/ /____/(_)\____/
9#
10# - Written by: Shawn Pickering
11# - shawn@shawnpickering.com
12##################################################################################################################################
13use strict;
14use lib '/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com';
15
16
17#############################################################
18## Variables
19#############################################################
20
21
22
23############################################################
24# Modules
25############################################################
26use CGI; my $query = new CGI; my $form = $query->Vars;
27use MODS::Template; my $tfile = new MODS::Template;
28use MODS::DBConnect; my $db = new MODS::DBConnect;
29use MODS::PTMatrix::Wrapper; my $load = new MODS::PTMatrix::Wrapper;
30use MODS::PTMatrix::Config; my $config = new MODS::PTMatrix::Config; my $database_name = $config->settings('database_name');
31use MODS::PTMatrix::PM;
32
33
34
35#############################################################
36## Get form data
37#############################################################
38#Preserve raw label/holder_name/behavior codes before quotemeta
39my %rawform = %$form;
40
41
42
43############################################################
44# Program Controls
45############################################################
46$|=1;
47my $userinfo = MODS::PTMatrix::PM::require_login();
48
49if(!$userinfo->{is_super_admin} && !$userinfo->{_admin_is_super_admin}){
50 print qq~Status: 403 Forbidden\nContent-Type: text/plain\n\nSuper-admin only.\n~;
51 exit;
52}
53
54&admin_test_cards;
55
56
57############################################################
58# Subroutines
59############################################################
60sub behaviors_map{
61 return (
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 );
71}
72
73sub behavior_order{
74 return qw(approve decline insufficient_funds expired_card processing_error lost_card stolen_card 3ds_required);
75}
76
77sub url_encode{
78 my $s = shift;
79 $s = '' unless defined $s;
80 $s =~ s/([^A-Za-z0-9\-_.~])/sprintf('%%%02X', ord($1))/eg;
81 return $s;
82}
83
84sub log_action{
85 #Append an audit_log row. Skips if no card_id.
86 my($dbh, $card_id, $actor_uid, $action, $detail) = @_;
87 return unless $card_id;
88 my $a = $action; $a =~ s/'/''/g; $a = substr($a, 0, 40);
89 my $d = $detail || ''; $d =~ s/'/''/g; $d = substr($d, 0, 255);
90 my $auid_sql = $actor_uid ? ($actor_uid + 0) : 'NULL';
91 $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.admin_test_cards_log SET card_id='$card_id', actor_user_id=$auid_sql, action='$a', detail='$d'~, $ENV{SCRIPT_NAME}, __LINE__);
92}
93
94sub do_create{
95 my($dbh, $actor_uid) = @_;
96 my %BEHAVIORS = &behaviors_map;
97
98 my %f;
99 $f{card_brand} = lc($rawform{card_brand} || 'visa');
100 $f{card_brand} =~ s/[^a-z]//g;
101 $f{card_brand} = 'visa' unless $f{card_brand};
102 $f{card_number} = $rawform{card_number} || '';
103 $f{card_number} =~ s/\s+//g;
104 $f{card_number} =~ s/[^0-9]//g;
105 $f{card_number} = substr($f{card_number}, 0, 19);
106 $f{last4} = (length $f{card_number} >= 4) ? substr($f{card_number}, -4) : '';
107 $f{exp_month} = ($rawform{exp_month} || 12) + 0;
108 $f{exp_month} = 12 if $f{exp_month} < 1 || $f{exp_month} > 12;
109 $f{exp_year} = ($rawform{exp_year} || 2030) + 0;
110 $f{exp_year} = 2030 if $f{exp_year} < 2024 || $f{exp_year} > 2100;
111 $f{cvc} = $rawform{cvc} || '123';
112 $f{cvc} =~ s/[^0-9]//g;
113 $f{cvc} = substr($f{cvc}, 0, 4);
114 $f{cvc} = '123' unless $f{cvc};
115 $f{holder_name} = $rawform{holder_name} || 'Test User';
116 $f{holder_name} =~ s/'/''/g;
117 $f{holder_name} = substr($f{holder_name}, 0, 120);
118 $f{behavior} = $rawform{behavior} || 'approve';
119 $f{behavior} = 'approve' unless $BEHAVIORS{$f{behavior}};
120 $f{label} = $rawform{label} || '';
121 $f{label} =~ s/'/''/g;
122 $f{label} = substr($f{label}, 0, 120);
123 my $owner_uid = ($rawform{owner_user_id} || 0) + 0;
124 my $owner_sql = $owner_uid ? $owner_uid : 'NULL';
125
126 if(!$f{card_number} || length($f{card_number}) < 12){
127 return ('danger', 'Card number is required and must be at least 12 digits.');
128 }
129
130 $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.admin_test_cards SET card_brand='$f{card_brand}', card_number='$f{card_number}', last4='$f{last4}', exp_month=$f{exp_month}, exp_year=$f{exp_year}, cvc='$f{cvc}', holder_name='$f{holder_name}', behavior='$f{behavior}', label='$f{label}', is_active=1, owner_user_id=$owner_sql, created_by_user_id=$actor_uid, created_at=NOW(), updated_at=NOW()~, $ENV{SCRIPT_NAME}, __LINE__);
131 my $r = $db->db_readwrite($dbh, "SELECT LAST_INSERT_ID() AS id", $ENV{SCRIPT_NAME}, __LINE__);
132 my $new_id = $r->{id} + 0;
133 &log_action($dbh, $new_id, $actor_uid, 'created', "brand=$f{card_brand} behavior=$f{behavior}");
134 return ('ok', "Test card #$new_id created.");
135}
136
137sub do_update_behavior{
138 my($dbh, $actor_uid) = @_;
139 my %BEHAVIORS = &behaviors_map;
140 my $id = ($rawform{card_id} || 0) + 0;
141 my $b = $rawform{behavior} || 'approve';
142 $b = 'approve' unless $BEHAVIORS{$b};
143 return ('', '') unless $id;
144 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.admin_test_cards SET behavior='$b', updated_at=NOW() WHERE id='$id'~, $ENV{SCRIPT_NAME}, __LINE__);
145 &log_action($dbh, $id, $actor_uid, 'behavior_changed', "behavior=$b");
146 return ('ok', "Behavior updated to '$b'.");
147}
148
149sub do_deactivate{
150 my($dbh, $actor_uid) = @_;
151 my $id = ($rawform{card_id} || 0) + 0;
152 return ('', '') unless $id;
153 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.admin_test_cards SET is_active=0, deactivated_by_user_id=$actor_uid, deactivated_at=NOW(), updated_at=NOW() WHERE id='$id'~, $ENV{SCRIPT_NAME}, __LINE__);
154 my $pm_marker = 'test_pm_' . $id;
155 $db->db_readwrite($dbh, qq~DELETE FROM `${database_name}`.payment_methods WHERE stripe_payment_method_id='$pm_marker'~, $ENV{SCRIPT_NAME}, __LINE__);
156 &log_action($dbh, $id, $actor_uid, 'deactivated', '');
157 return ('ok', "Test card #$id deactivated. Detached from all user accounts.");
158}
159
160sub do_reactivate{
161 my($dbh, $actor_uid) = @_;
162 my $id = ($rawform{card_id} || 0) + 0;
163 return ('', '') unless $id;
164 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.admin_test_cards SET is_active=1, deactivated_by_user_id=NULL, deactivated_at=NULL, updated_at=NOW() WHERE id='$id'~, $ENV{SCRIPT_NAME}, __LINE__);
165 &log_action($dbh, $id, $actor_uid, 'reactivated', '');
166 return ('ok', "Test card #$id reactivated. Reassign to a user to use it again.");
167}
168
169sub do_bulk_deactivate_owner{
170 #Offboarding shortcut: kill every active card belonging to owner_user_id
171 my($dbh, $actor_uid) = @_;
172 my $oid = ($rawform{owner_user_id} || 0) + 0;
173 return ('', '') unless $oid;
174 my @victims = $db->db_readwrite_multiple($dbh, qq~SELECT id FROM `${database_name}`.admin_test_cards WHERE owner_user_id='$oid' AND is_active=1~, $ENV{SCRIPT_NAME}, __LINE__);
175 foreach my $v(@victims){
176 my $vid = $v->{id} + 0;
177 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.admin_test_cards SET is_active=0, deactivated_by_user_id=$actor_uid, deactivated_at=NOW(), updated_at=NOW() WHERE id='$vid'~, $ENV{SCRIPT_NAME}, __LINE__);
178 my $pm_marker = 'test_pm_' . $vid;
179 $db->db_readwrite($dbh, qq~DELETE FROM `${database_name}`.payment_methods WHERE stripe_payment_method_id='$pm_marker'~, $ENV{SCRIPT_NAME}, __LINE__);
180 &log_action($dbh, $vid, $actor_uid, 'bulk_deactivated', "owner_user_id=$oid");
181 }
182 my $n = scalar @victims;
183 return ('ok', "Bulk-deactivated $n card(s) owned by user #$oid.");
184}
185
186sub do_delete{
187 my($dbh, $actor_uid) = @_;
188 my $id = ($rawform{card_id} || 0) + 0;
189 return ('', '') unless $id;
190 my $pm_marker = 'test_pm_' . $id;
191 $db->db_readwrite($dbh, qq~DELETE FROM `${database_name}`.payment_methods WHERE stripe_payment_method_id='$pm_marker'~, $ENV{SCRIPT_NAME}, __LINE__);
192 &log_action($dbh, $id, $actor_uid, 'deleted', '');
193 $db->db_readwrite($dbh, qq~DELETE FROM `${database_name}`.admin_test_cards WHERE id='$id'~, $ENV{SCRIPT_NAME}, __LINE__);
194 return ('ok', "Test card #$id removed and detached from all users.");
195}
196
197sub do_assign{
198 #Attach the (test_pm_N marker) as user's default payment_method so Stripe
199 #short-circuits the next charge to the card's synthetic behavior.
200 my($dbh, $actor_uid) = @_;
201 my $id = ($rawform{card_id} || 0) + 0;
202 my $target_uid = ($rawform{target_user_id} || 0) + 0;
203 $target_uid = $actor_uid if (($rawform{assign_to} || '') eq 'me');
204 return ('', '') unless $id && $target_uid;
205
206 my $card = $db->db_readwrite($dbh, qq~SELECT * FROM `${database_name}`.admin_test_cards WHERE id='$id' AND is_active=1 LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
207 if(!$card || !$card->{id}){
208 return ('danger', 'Card not found or inactive. Reactivate it first.');
209 }
210
211 my $pm_marker = 'test_pm_' . $card->{id};
212 my $cus_marker = 'test_cus_' . $target_uid;
213 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.payment_methods SET is_default=0 WHERE user_id='$target_uid'~, $ENV{SCRIPT_NAME}, __LINE__);
214 my $existing = $db->db_readwrite($dbh, qq~SELECT id FROM `${database_name}`.payment_methods WHERE user_id='$target_uid' AND stripe_payment_method_id='$pm_marker' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
215 if($existing && $existing->{id}){
216 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.payment_methods SET is_default=1 WHERE id='$existing->{id}'~, $ENV{SCRIPT_NAME}, __LINE__);
217 }else{
218 my $hn = $card->{holder_name} || 'Test User';
219 $hn =~ s/'/''/g;
220 $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.payment_methods SET user_id='$target_uid', brand='$card->{card_brand}', last4='$card->{last4}', exp_month=$card->{exp_month}, exp_year=$card->{exp_year}, stripe_payment_method_id='$pm_marker', stripe_customer_id='$cus_marker', is_default=1~, $ENV{SCRIPT_NAME}, __LINE__);
221 }
222 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.users SET stripe_customer_id=COALESCE(NULLIF(stripe_customer_id,''),'$cus_marker') WHERE id='$target_uid'~, $ENV{SCRIPT_NAME}, __LINE__);
223 &log_action($dbh, $id, $actor_uid, 'assigned', "target_user_id=$target_uid behavior=$card->{behavior}");
224 return ('ok', "Card attached to user #$target_uid. Next charge simulates as '$card->{behavior}'.");
225}
226
227sub dispatch_post{
228 my($dbh, $actor_uid) = @_;
229 my $act = $rawform{action} || '';
230 if($act eq 'create') {return &do_create($dbh, $actor_uid);}
231 if($act eq 'update_behavior') {return &do_update_behavior($dbh, $actor_uid);}
232 if($act eq 'deactivate') {return &do_deactivate($dbh, $actor_uid);}
233 if($act eq 'reactivate') {return &do_reactivate($dbh, $actor_uid);}
234 if($act eq 'bulk_deactivate_owner') {return &do_bulk_deactivate_owner($dbh, $actor_uid);}
235 if($act eq 'delete') {return &do_delete($dbh, $actor_uid);}
236 if($act eq 'assign') {return &do_assign($dbh, $actor_uid);}
237 return ('', '');
238}
239
240sub decorate_card{
241 my($r, $BEHAVIORS_ref, $BEHAVIOR_ORDER_ref, $user_by_id_ref) = @_;
242
243 my $expanded = '';
244 if($r->{card_number}){
245 my $cn = $r->{card_number};
246 $expanded = join(' ', $cn =~ /(\d{1,4})/g);
247 }
248
249 my $cur_b = $r->{behavior} || 'approve';
250 my @opts_for_card;
251 foreach my $bk(@$BEHAVIOR_ORDER_ref){
252 push @opts_for_card, {
253 value => $bk,
254 label => $BEHAVIORS_ref->{$bk},
255 selected_attr => ($bk eq $cur_b) ? ' selected' : '',
256 };
257 }
258 my $owner_uid = $r->{owner_user_id} ? $r->{owner_user_id} + 0 : 0;
259 my $owner_name = $owner_uid ? ($user_by_id_ref->{$owner_uid} || "User #$owner_uid") : '';
260 my $deact_uid = $r->{deactivated_by_user_id} ? $r->{deactivated_by_user_id} + 0 : 0;
261 my $deact_name = $deact_uid ? ($user_by_id_ref->{$deact_uid} || "User #$deact_uid") : '';
262
263 return {
264 id => $r->{id},
265 brand => $r->{card_brand} || 'visa',
266 brand_label => ucfirst($r->{card_brand} || 'visa'),
267 number_full => $expanded,
268 last4 => ($r->{last4} || '----'),
269 exp_display => sprintf('%02d/%02d', ($r->{exp_month} || 12), (($r->{exp_year} || 0) % 100)),
270 cvc => $r->{cvc} || '',
271 holder_name => MODS::PTMatrix::PM::h($r->{holder_name} || ''),
272 behavior => $cur_b,
273 behavior_label => ($BEHAVIORS_ref->{$cur_b} || 'Approve'),
274 is_approve => ($cur_b eq 'approve') ? 1 : 0,
275 is_decline => ($cur_b ne 'approve') ? 1 : 0,
276 label => MODS::PTMatrix::PM::h($r->{label} || ''),
277 has_label => length($r->{label} || '') ? 1 : 0,
278 is_active => $r->{is_active} ? 1 : 0,
279 is_inactive => $r->{is_active} ? 0 : 1,
280 owner_user_id => $owner_uid,
281 has_owner => $owner_uid ? 1 : 0,
282 owner_name => MODS::PTMatrix::PM::h($owner_name),
283 deact_name => MODS::PTMatrix::PM::h($deact_name),
284 has_deact => $deact_uid ? 1 : 0,
285 deact_at => MODS::PTMatrix::PM::h($r->{deactivated_at} || ''),
286 deact_epoch => ($r->{deact_epoch} || ''),
287 created_at => MODS::PTMatrix::PM::h($r->{created_at} || ''),
288 created_epoch => ($r->{created_epoch} || ''),
289 behavior_options => \@opts_for_card,
290 };
291}
292
293sub admin_test_cards{
294 my $actor_uid = MODS::PTMatrix::PM::get_user_id($userinfo);
295 my %BEHAVIORS = &behaviors_map;
296 my @BEHAVIOR_ORDER = &behavior_order;
297
298 my $dbh = $db->db_connect();
299
300 my $schema_ready = 0;
301 my $chk = $db->db_readwrite($dbh, qq~SHOW TABLES LIKE 'admin_test_cards'~, $ENV{SCRIPT_NAME}, __LINE__);
302 $schema_ready = 1 if $chk && %$chk;
303
304 my $flash_kind = '';
305 my $flash_msg = '';
306 if(($ENV{REQUEST_METHOD} || '') eq 'POST' && $schema_ready){
307 ($flash_kind, $flash_msg) = &dispatch_post($dbh, $actor_uid);
308 $db->db_disconnect($dbh);
309 print qq~Status: 302 Found\nLocation: /admin_test_cards.cgi?flash_kind=$flash_kind&flash_msg=~ . &url_encode($flash_msg) . qq~\n\n~;
310 exit;
311 }
312
313 #Flash from a prior redirect
314 if(defined $rawform{flash_kind}){
315 my $k = $rawform{flash_kind}; $k =~ s/[^a-z]//g;
316 $flash_kind = $k if $k eq 'ok' || $k eq 'danger';
317 $flash_msg = $rawform{flash_msg} || '';
318 $flash_msg =~ s/[^A-Za-z0-9 .,;:_\-\$()%'#!?]//g;
319 $flash_msg = substr($flash_msg, 0, 240);
320 }
321
322 my(@cards_active, @cards_inactive);
323 my %user_by_id;
324
325 if($schema_ready){
326 my @rows = $db->db_readwrite_multiple($dbh, qq~SELECT id, card_brand, card_number, last4, exp_month, exp_year, cvc, holder_name, behavior, label, is_active, owner_user_id, created_by_user_id, deactivated_by_user_id, deactivated_at, last_used_at, created_at, UNIX_TIMESTAMP(deactivated_at) AS deact_epoch, UNIX_TIMESTAMP(created_at) AS created_epoch FROM `${database_name}`.admin_test_cards ORDER BY is_active DESC, created_at DESC, id DESC~, $ENV{SCRIPT_NAME}, __LINE__);
327
328 my %need_users;
329 foreach my $r(@rows){
330 $need_users{$r->{owner_user_id} + 0} = 1 if $r->{owner_user_id};
331 $need_users{$r->{deactivated_by_user_id} + 0} = 1 if $r->{deactivated_by_user_id};
332 }
333 if(%need_users){
334 my $id_list = join(',', map { $_ + 0 } keys %need_users);
335 my @us = $db->db_readwrite_multiple($dbh, qq~SELECT id, email, display_name FROM `${database_name}`.users WHERE id IN ($id_list)~, $ENV{SCRIPT_NAME}, __LINE__);
336 foreach my $usr(@us){
337 $user_by_id{$usr->{id}} = $usr->{display_name} || $usr->{email} || ('User #' . $usr->{id});
338 }
339 }
340
341 foreach my $r(@rows){
342 my $card = &decorate_card($r, \%BEHAVIORS, \@BEHAVIOR_ORDER, \%user_by_id);
343 if($r->{is_active}){push @cards_active, $card;}
344 else {push @cards_inactive, $card;}
345 }
346 }
347
348 my @owner_groups;
349 if($schema_ready){
350 my @rows = $db->db_readwrite_multiple($dbh, qq~SELECT owner_user_id, COUNT(*) AS n FROM `${database_name}`.admin_test_cards WHERE is_active=1 AND owner_user_id IS NOT NULL GROUP BY owner_user_id HAVING n >= 1 ORDER BY n DESC, owner_user_id ASC~, $ENV{SCRIPT_NAME}, __LINE__);
351 foreach my $g(@rows){
352 my $uid = $g->{owner_user_id} + 0;
353 push @owner_groups, {
354 owner_user_id => $uid,
355 owner_name => MODS::PTMatrix::PM::h($user_by_id{$uid} || "User #$uid"),
356 n => $g->{n} + 0,
357 };
358 }
359 }
360
361 my @user_options;
362 {
363 my @rows = $db->db_readwrite_multiple($dbh, qq~SELECT id, email, display_name FROM `${database_name}`.users WHERE account_status IN ('active','pending_verification') ORDER BY created_at DESC, id DESC LIMIT 50~, $ENV{SCRIPT_NAME}, __LINE__);
364 foreach my $usr(@rows){
365 my $label = ($usr->{display_name} || $usr->{email} || ('User #' . $usr->{id}))
366 . ' (' . ($usr->{email} || '#' . $usr->{id}) . ')';
367 push @user_options, { id => $usr->{id}, label => MODS::PTMatrix::PM::h($label) };
368 }
369 }
370
371 my @audit_rows;
372 if($schema_ready){
373 my @rows = $db->db_readwrite_multiple($dbh, qq~SELECT l.id, l.card_id, l.actor_user_id, l.action, l.detail, l.created_at, UNIX_TIMESTAMP(l.created_at) AS created_epoch, c.last4, c.card_brand FROM `${database_name}`.admin_test_cards_log l LEFT JOIN `${database_name}`.admin_test_cards c ON c.id = l.card_id ORDER BY l.id DESC LIMIT 50~, $ENV{SCRIPT_NAME}, __LINE__);
374 my %actor_need;
375 foreach my $r(@rows){$actor_need{$r->{actor_user_id} + 0} = 1 if $r->{actor_user_id};}
376 if(%actor_need){
377 my $list = join(',', map { $_ + 0 } keys %actor_need);
378 my @us = $db->db_readwrite_multiple($dbh, qq~SELECT id, display_name, email FROM `${database_name}`.users WHERE id IN ($list)~, $ENV{SCRIPT_NAME}, __LINE__);
379 foreach my $usr(@us){
380 $user_by_id{$usr->{id}} = $usr->{display_name} || $usr->{email} || ('User #' . $usr->{id});
381 }
382 }
383 foreach my $r(@rows){
384 my $auid = $r->{actor_user_id} ? $r->{actor_user_id} + 0 : 0;
385 my $aname = $auid ? ($user_by_id{$auid} || "User #$auid") : 'system';
386 push @audit_rows, {
387 id => $r->{id},
388 card_id => $r->{card_id},
389 card_label => $r->{last4} ? (ucfirst($r->{card_brand} || 'card') . ' &middot;&middot;&middot;' . $r->{last4}) : ('card #' . $r->{card_id}),
390 actor_name => MODS::PTMatrix::PM::h($aname),
391 action => $r->{action},
392 detail => MODS::PTMatrix::PM::h($r->{detail} || ''),
393 has_detail => length($r->{detail} || '') ? 1 : 0,
394 created_at => MODS::PTMatrix::PM::h($r->{created_at} || ''),
395 created_epoch => ($r->{created_epoch} || ''),
396 };
397 }
398 }
399
400 $db->db_disconnect($dbh);
401
402 my @behavior_options = map { { value => $_, label => $BEHAVIORS{$_} } } @BEHAVIOR_ORDER;
403
404 print qq~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~;
405
406 #Create all template variables
407 my $tvars;
408 $tvars->{user_id} = $actor_uid;
409 $tvars->{cards_active} = \@cards_active;
410 $tvars->{cards_inactive} = \@cards_inactive;
411 $tvars->{has_active} = scalar(@cards_active) ? 1 : 0;
412 $tvars->{has_inactive} = scalar(@cards_inactive) ? 1 : 0;
413 $tvars->{no_cards} = (scalar(@cards_active) + scalar(@cards_inactive)) ? 0 : 1;
414 $tvars->{n_active} = scalar(@cards_active);
415 $tvars->{n_inactive} = scalar(@cards_inactive);
416 $tvars->{owner_groups} = \@owner_groups;
417 $tvars->{has_owner_groups} = scalar(@owner_groups) ? 1 : 0;
418 $tvars->{user_options} = \@user_options;
419 $tvars->{has_users} = scalar(@user_options) ? 1 : 0;
420 $tvars->{behavior_options} = \@behavior_options;
421 $tvars->{audit_rows} = \@audit_rows;
422 $tvars->{has_audit} = scalar(@audit_rows) ? 1 : 0;
423 $tvars->{schema_ready} = $schema_ready ? 1 : 0;
424 $tvars->{schema_missing} = $schema_ready ? 0 : 1;
425 $tvars->{flash_kind} = $flash_kind;
426 $tvars->{flash_msg} = $flash_msg;
427 $tvars->{has_flash} = length $flash_msg ? 1 : 0;
428 $tvars->{flash_is_ok} = ($flash_kind eq 'ok') ? 1 : 0;
429 $tvars->{flash_is_err} = ($flash_kind eq 'danger') ? 1 : 0;
430
431 my $body = join('', $tfile->template('tf_admin_test_cards.html', $tvars, $userinfo));
432 $load->render({
433 userinfo => $userinfo,
434 page_key => 'admin_test_cards',
435 title => 'Test Credit Cards',
436 body => $body,
437 });
438}