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

O Operator
Diff

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

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

Added
+541
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 4912ab6a3f83
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 -- Seller-side customer (buyer) directory + per-buyer detail.
4#
5# GET /customers.cgi
6# List every buyer who has placed an order or holds store credit
7# on any storefront owned by the signed-in seller. Columns: email,
8# display name, storefront, lifetime spend, order count, current
9# store-credit balance.
10#
11# GET /customers.cgi?sid=S&b=N
12# Detail view for one buyer on one storefront. Shows orders, credit
13# history, and (with refund_orders ptag) a Grant Credit button.
14#
15# GET /customers.cgi?sid=S&email=foo@bar.com
16# Detail view for a guest-checkout buyer (no buyer_accounts row).
17#
18# Consolidates the former /customer_action.cgi (POST handler) via
19# SCRIPT_NAME dispatch. The customer_action.cgi file is a wrapper that
20# `do`s this file.
21#======================================================================
22use strict;
23use warnings;
24
25use lib '/var/www/vhosts/3dshawn.com/shop.3dshawn.com';
26use CGI;
27use MODS::Template;
28use MODS::DBConnect;
29use MODS::Login;
30use MODS::ShopCart::Config;
31use MODS::ShopCart::Wrapper;
32use MODS::ShopCart::Permissions;
33use MODS::ShopCart::BuyerCredits;
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 $perm = MODS::ShopCart::Permissions->new;
43my $bc = MODS::ShopCart::BuyerCredits->new;
44my $DB = $cfg->settings('database_name');
45
46$|=1;
47my $userinfo = $auth->login_verify();
48
49my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'customers';
50
51if ($entry eq 'customer_action') {
52 unless ($userinfo) {
53 print "Status: 302 Found\nLocation: /login.cgi\n\n";
54 exit;
55 }
56 _handle_action($q, $form);
57 exit;
58}
59
60unless ($userinfo) {
61 print "Status: 302 Found\nLocation: /login.cgi\n\n";
62 exit;
63}
64$perm->require_feature($userinfo, 'view_orders');
65
66my $uid = $userinfo->{user_id};
67$uid =~ s/[^0-9]//g;
68my $owner_uid = $userinfo->{owner_user_id} || $uid;
69$owner_uid =~ s/[^0-9]//g;
70my $can_grant = $perm->has_feature($userinfo, 'refund_orders') ? 1 : 0;
71
72my $dbh = $db->db_connect();
73
74# Flash from customer_action.cgi.
75my ($flash_msg, $flash_kind) = ('', '');
76if (defined $form->{ok}) {
77 my $k = $form->{ok}; $k =~ s/[^a-z_]//g;
78 my %h = (
79 credit_granted => 'Credit granted.',
80 credit_failed => 'Could not grant credit -- check the inputs.',
81 );
82 $flash_msg = $h{$k} || 'Done.';
83 $flash_kind = 'ok';
84}
85if (defined $form->{err}) {
86 my $k = $form->{err}; $k =~ s/[^a-z_]//g;
87 my %h = (
88 bad_input => 'Missing or invalid input.',
89 denied => 'You do not have permission for that action.',
90 not_found => 'Buyer or storefront not found.',
91 schema => 'The buyer credit ledger table is not installed yet.',
92 );
93 $flash_msg = $h{$k} || 'Error.';
94 $flash_kind = 'danger';
95}
96
97my $sid_in = defined $form->{sid} ? $form->{sid} : '';
98$sid_in =~ s/[^0-9]//g;
99my $b_in = defined $form->{b} ? $form->{b} : '';
100$b_in =~ s/[^0-9]//g;
101my $email_in = defined $form->{email} ? $form->{email} : '';
102$email_in =~ s/^\s+|\s+$//g;
103$email_in = substr($email_in, 0, 191);
104
105# Map of storefront_id -> 1 for the seller's owned stores. Used to
106# authorize ?sid= / ?b= queries (can't peek at someone else's customer).
107my %owned_sid;
108{
109 my @sf = $db->db_readwrite_multiple($dbh, qq~
110 SELECT id FROM `${DB}`.storefronts WHERE user_id='$owner_uid'
111 ~, $ENV{SCRIPT_NAME}, __LINE__);
112 $owned_sid{$_->{id}} = 1 foreach @sf;
113}
114
115# Storefront pick used for "Grant credit to any email" button. Default
116# to the first owned storefront when no ?sid is in URL.
117my $default_sid = 0;
118foreach my $id (sort { $a <=> $b } keys %owned_sid) { $default_sid = $id; last; }
119
120# ====== Detail view ======================================================
121if ($sid_in && $owned_sid{$sid_in} && ($b_in || length $email_in)) {
122 _render_detail($sid_in, $b_in, $email_in);
123 exit;
124}
125
126# ====== List view ========================================================
127_render_list();
128exit;
129
130# ----------------------------------------------------------------------
131sub _render_list {
132 # Aggregate orders to get one row per buyer per storefront.
133 # We pull buyer_email as the canonical identity (every order has one)
134 # and join buyer_accounts to surface the display name when registered.
135 my @rows;
136 if (keys %owned_sid) {
137 my $sid_list = join(',', map { "'$_'" } keys %owned_sid);
138 @rows = $db->db_readwrite_multiple($dbh, qq~
139 SELECT o.storefront_id,
140 o.buyer_email,
141 MAX(o.buyer_account_id) AS buyer_account_id,
142 COUNT(*) AS order_count,
143 SUM(CASE WHEN o.status='paid' THEN o.total_amount_cents ELSE 0 END) AS spent_cents,
144 MAX(o.created_at) AS last_order_at,
145 UNIX_TIMESTAMP(MAX(o.created_at)) AS last_order_at_epoch,
146 s.name AS store_name,
147 ba.display_name AS display_name
148 FROM `${DB}`.orders o
149 JOIN `${DB}`.storefronts s ON s.id = o.storefront_id
150 LEFT JOIN `${DB}`.buyer_accounts ba
151 ON ba.id = o.buyer_account_id
152 WHERE o.storefront_id IN ($sid_list)
153 GROUP BY o.storefront_id, o.buyer_email, s.name, ba.display_name
154 ORDER BY last_order_at DESC
155 LIMIT 500
156 ~, $ENV{SCRIPT_NAME}, __LINE__);
157 }
158
159 my @list;
160 foreach my $r (@rows) {
161 my $bal = 0;
162 if ($r->{buyer_account_id}) {
163 $bal = $bc->balance_cents($db, $dbh, $DB, $r->{storefront_id},
164 { buyer_account_id => $r->{buyer_account_id} });
165 } else {
166 $bal = $bc->balance_cents($db, $dbh, $DB, $r->{storefront_id},
167 { buyer_email => $r->{buyer_email} });
168 }
169
170 my $detail_qs = $r->{buyer_account_id}
171 ? "sid=$r->{storefront_id}&b=$r->{buyer_account_id}"
172 : "sid=$r->{storefront_id}&email=" . _u($r->{buyer_email});
173
174 push @list, {
175 store_name => _h($r->{store_name}),
176 storefront_id => $r->{storefront_id} + 0,
177 buyer_email => _h($r->{buyer_email}),
178 display_name => _h($r->{display_name} || ''),
179 has_account => $r->{buyer_account_id} ? 1 : 0,
180 order_count => $r->{order_count} + 0,
181 spent_dollars => '$' . sprintf('%.2f', ($r->{spent_cents} || 0)/100),
182 last_order_at => ($r->{last_order_at} && $r->{last_order_at_epoch})
183 ? qq~<span class="ts" data-ts="$r->{last_order_at_epoch}" data-fmt="datetime">$r->{last_order_at}</span>~
184 : '-',
185 balance_dollars => ($bal < 0 ? '-' : '') . '$' . sprintf('%.2f', abs($bal)/100),
186 balance_cents => $bal + 0,
187 has_credit => $bal > 0 ? 1 : 0,
188 no_credit => $bal == 0 ? 1 : 0,
189 has_debit => $bal < 0 ? 1 : 0,
190 detail_qs => $detail_qs,
191 };
192 }
193
194 $db->db_disconnect($dbh);
195
196 my $tvars = {
197 rows => \@list,
198 has_rows => scalar(@list) ? 1 : 0,
199 no_rows => scalar(@list) ? 0 : 1,
200 can_grant => $can_grant,
201 default_sid => $default_sid + 0,
202 flash_msg => $flash_msg,
203 flash_kind => $flash_kind,
204 has_flash => length $flash_msg ? 1 : 0,
205 is_list_view => 1,
206 is_detail_view => 0,
207 };
208
209 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";
210 my $body = join('', $tfile->template('shopcart_customers.html', $tvars, $userinfo));
211 $wrap->render({
212 userinfo => $userinfo,
213 page_key => 'customers',
214 title => 'Customers',
215 body => $body,
216 });
217}
218
219# ----------------------------------------------------------------------
220sub _render_detail {
221 my ($sid, $bid, $email) = @_;
222
223 my $store = $db->db_readwrite($dbh, qq~
224 SELECT id, name FROM `${DB}`.storefronts WHERE id='$sid' LIMIT 1
225 ~, $ENV{SCRIPT_NAME}, __LINE__);
226 unless ($store && $store->{id}) {
227 $db->db_disconnect($dbh);
228 print "Status: 302 Found\nLocation: /customers.cgi?err=not_found\n\n";
229 return;
230 }
231
232 # Resolve the buyer. Either we have a buyer_accounts.id, or we
233 # only have an email (guest checkout case).
234 my $buyer = { display_name => '', email => $email, has_account => 0, id => 0 };
235 if ($bid) {
236 my $b = $db->db_readwrite($dbh, qq~
237 SELECT id, email, display_name, lifetime_value_cents, order_count,
238 created_at, last_login_at,
239 UNIX_TIMESTAMP(created_at) AS created_at_epoch,
240 UNIX_TIMESTAMP(last_login_at) AS last_login_at_epoch
241 FROM `${DB}`.buyer_accounts
242 WHERE id='$bid' AND storefront_id='$sid' LIMIT 1
243 ~, $ENV{SCRIPT_NAME}, __LINE__);
244 unless ($b && $b->{id}) {
245 $db->db_disconnect($dbh);
246 print "Status: 302 Found\nLocation: /customers.cgi?err=not_found\n\n";
247 return;
248 }
249 $buyer = {
250 id => $b->{id} + 0,
251 email => $b->{email},
252 display_name => $b->{display_name} || '',
253 has_account => 1,
254 lifetime_dollars => '$' . sprintf('%.2f', ($b->{lifetime_value_cents} || 0)/100),
255 order_count => $b->{order_count} + 0,
256 joined_at => ($b->{created_at} && $b->{created_at_epoch})
257 ? qq~<span class="ts" data-ts="$b->{created_at_epoch}" data-fmt="datetime">$b->{created_at}</span>~
258 : '-',
259 last_login_at=> ($b->{last_login_at} && $b->{last_login_at_epoch})
260 ? qq~<span class="ts" data-ts="$b->{last_login_at_epoch}" data-fmt="datetime">$b->{last_login_at}</span>~
261 : 'Never',
262 };
263 } else {
264 # Guest path: also synthesize lifetime_value / order_count from orders.
265 my $esc = $email; $esc =~ s/'/''/g;
266 my $r = $db->db_readwrite($dbh, qq~
267 SELECT COUNT(*) AS n,
268 SUM(CASE WHEN status='paid' THEN total_amount_cents ELSE 0 END) AS spent
269 FROM `${DB}`.orders
270 WHERE storefront_id='$sid' AND buyer_email='$esc'
271 ~, $ENV{SCRIPT_NAME}, __LINE__);
272 $buyer->{order_count} = $r ? ($r->{n} + 0) : 0;
273 $buyer->{lifetime_dollars} = '$' . sprintf('%.2f', (($r ? $r->{spent} : 0) || 0)/100);
274 $buyer->{joined_at} = '-';
275 $buyer->{last_login_at} = 'Never (guest checkout)';
276 }
277
278 # Orders. Only SELECT store_credit_applied_cents when the schema
279 # migration has run -- otherwise the column is absent and the
280 # query would crash at the DBConnect layer.
281 my @orders;
282 {
283 my $esc = $buyer->{email}; $esc =~ s/'/''/g;
284 my $where = $buyer->{id}
285 ? "buyer_account_id='$buyer->{id}'"
286 : "buyer_account_id IS NULL AND buyer_email='$esc'";
287 my $credit_col = $bc->schema_ready($db, $dbh, $DB)
288 ? 'store_credit_applied_cents'
289 : '0 AS store_credit_applied_cents';
290 @orders = $db->db_readwrite_multiple($dbh, qq~
291 SELECT id, total_amount_cents, currency, status, created_at,
292 UNIX_TIMESTAMP(created_at) AS created_at_epoch,
293 $credit_col
294 FROM `${DB}`.orders
295 WHERE storefront_id='$sid' AND $where
296 ORDER BY created_at DESC
297 LIMIT 50
298 ~, $ENV{SCRIPT_NAME}, __LINE__);
299 }
300 my @order_rows;
301 foreach my $o (@orders) {
302 my $credit_used = $o->{store_credit_applied_cents} || 0;
303 push @order_rows, {
304 id => $o->{id} + 0,
305 placed_at => ($o->{created_at} && $o->{created_at_epoch})
306 ? qq~<span class="ts" data-ts="$o->{created_at_epoch}" data-fmt="datetime">$o->{created_at}</span>~
307 : '-',
308 status => $o->{status},
309 status_label => ucfirst($o->{status} || 'pending'),
310 is_paid => $o->{status} eq 'paid' ? 1 : 0,
311 is_refunded => ($o->{status} eq 'refunded' || $o->{status} eq 'partially_refunded') ? 1 : 0,
312 total_dollars => '$' . sprintf('%.2f', ($o->{total_amount_cents} || 0)/100),
313 credit_used_dollars => $credit_used > 0 ? ('$' . sprintf('%.2f', $credit_used/100)) : '',
314 has_credit_used => $credit_used > 0 ? 1 : 0,
315 };
316 }
317
318 # Credit history.
319 my @hist = $bc->history($db, $dbh, $DB, $sid,
320 ($buyer->{id} ? { buyer_account_id => $buyer->{id} } : { buyer_email => $buyer->{email} }), 100);
321 my @hist_rows;
322 foreach my $h (@hist) {
323 my $a = $h->{amount_cents} || 0;
324 my %label = (
325 manual_grant => 'Goodwill grant',
326 order_refund => 'Refund as credit',
327 promotional => 'Promotional',
328 order_apply => 'Used on order',
329 reversal => 'Reversed (order refunded)',
330 );
331 push @hist_rows, {
332 id => $h->{id} + 0,
333 amount_dollars => ($a < 0 ? '-' : '+') . '$' . sprintf('%.2f', abs($a)/100),
334 is_positive => $a > 0 ? 1 : 0,
335 is_negative => $a < 0 ? 1 : 0,
336 reason => $h->{reason},
337 reason_label => $label{$h->{reason}} || $h->{reason},
338 related_order_id => $h->{related_order_id} ? ($h->{related_order_id} + 0) : 0,
339 has_related => $h->{related_order_id} ? 1 : 0,
340 note => _h($h->{note} || ''),
341 created_at => _cust_ts_span($h->{created_at}, '-'),
342 };
343 }
344
345 my $balance = $bc->balance_cents($db, $dbh, $DB, $sid,
346 ($buyer->{id} ? { buyer_account_id => $buyer->{id} } : { buyer_email => $buyer->{email} }));
347
348 $db->db_disconnect($dbh);
349
350 my $tvars = {
351 is_list_view => 0,
352 is_detail_view => 1,
353 can_grant => $can_grant,
354 flash_msg => $flash_msg,
355 flash_kind => $flash_kind,
356 has_flash => length $flash_msg ? 1 : 0,
357
358 store_id => $store->{id} + 0,
359 store_name => _h($store->{name}),
360
361 buyer_id => $buyer->{id} + 0,
362 buyer_email => _h($buyer->{email}),
363 buyer_name => _h($buyer->{display_name} || $buyer->{email}),
364 buyer_has_account => $buyer->{has_account} ? 1 : 0,
365 buyer_no_account => $buyer->{has_account} ? 0 : 1,
366 buyer_lifetime => $buyer->{lifetime_dollars},
367 buyer_order_count => $buyer->{order_count},
368 buyer_joined => $buyer->{joined_at},
369 buyer_last_login => $buyer->{last_login_at},
370
371 balance_cents => $balance + 0,
372 balance_dollars => ($balance < 0 ? '-' : '') . '$' . sprintf('%.2f', abs($balance)/100),
373 has_credit => $balance > 0 ? 1 : 0,
374 no_credit => $balance == 0 ? 1 : 0,
375 has_debit => $balance < 0 ? 1 : 0,
376
377 orders => \@order_rows,
378 has_orders => scalar(@order_rows) ? 1 : 0,
379 no_orders => scalar(@order_rows) ? 0 : 1,
380
381 history => \@hist_rows,
382 has_history => scalar(@hist_rows) ? 1 : 0,
383 no_history => scalar(@hist_rows) ? 0 : 1,
384 };
385
386 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";
387 my $body = join('', $tfile->template('shopcart_customers.html', $tvars, $userinfo));
388 $wrap->render({
389 userinfo => $userinfo,
390 page_key => 'customers',
391 title => 'Customer: ' . ($buyer->{display_name} || $buyer->{email}),
392 body => $body,
393 });
394}
395
396sub _h {
397 my $s = shift; $s = '' unless defined $s;
398 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
399 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
400 return $s;
401}
402sub _u {
403 my $s = shift; $s = '' unless defined $s;
404 $s =~ s/([^A-Za-z0-9\-_.~])/sprintf('%%%02X', ord($1))/eg;
405 return $s;
406}
407sub _cust_ts_span {
408 my ($s, $fallback) = @_;
409 $fallback = '-' unless defined $fallback;
410 return $fallback unless $s && length $s;
411 return $s unless $s =~ /^(\d{4})-(\d{2})-(\d{2})[ T](\d{2}):(\d{2}):(\d{2})/;
412 require Time::Local;
413 my $ep = eval { Time::Local::timelocal($6,$5,$4,$3,$2-1,$1-1900) } || 0;
414 return $s unless $ep;
415 return qq~<span class="ts" data-ts="$ep" data-fmt="datetime">$s</span>~;
416}
417
418#======================================================================
419# customer_action entry: POST handler
420# act=grant_credit
421# storefront_id=S -- must be owned by the caller (or their owner)
422# buyer_account_id=N -- preferred (registered buyer)
423# buyer_email=... -- required if buyer_account_id is missing
424# amount_cents=N -- positive integer (cents)
425# note=... -- shown to buyer in their credit history
426# return_to=URL -- same-site absolute path; default /customers.cgi
427#
428# Authorization: requires the `refund_orders` ptag (granting store
429# credit is conceptually a soft refund). Storefront ownership is
430# verified before the ledger write.
431#======================================================================
432sub _handle_action {
433 my ($q, $form) = @_;
434
435 my $return_to = defined $form->{return_to} ? $form->{return_to} : '/customers.cgi';
436 $return_to = '/customers.cgi' unless $return_to =~ m{^/[^/]} || $return_to eq '/';
437
438 my $_go = sub {
439 my ($qs) = @_;
440 my $sep = ($return_to =~ /\?/) ? '&' : '?';
441 print "Status: 302 Found\nLocation: $return_to$sep$qs\n\n";
442 return;
443 };
444
445 unless (($ENV{REQUEST_METHOD} || '') eq 'POST') {
446 $_go->('err=bad_input');
447 return;
448 }
449
450 my $act = defined $form->{act} ? $form->{act} : '';
451 unless ($act eq 'grant_credit') { $_go->('err=bad_input'); return; }
452
453 my $caller_uid = $userinfo->{user_id};
454 $caller_uid =~ s/[^0-9]//g;
455 my $owner_uid = $userinfo->{owner_user_id} || $caller_uid;
456 $owner_uid =~ s/[^0-9]//g;
457
458 unless ($perm->has_feature($userinfo, 'refund_orders')) {
459 $_go->('err=denied');
460 return;
461 }
462
463 my $sid = defined $form->{storefront_id} ? $form->{storefront_id} : '';
464 $sid =~ s/[^0-9]//g;
465 unless ($sid) { $_go->('err=bad_input'); return; }
466
467 my $bid = defined $form->{buyer_account_id} ? $form->{buyer_account_id} : '';
468 $bid =~ s/[^0-9]//g;
469
470 my $email = defined $form->{buyer_email} ? $form->{buyer_email} : '';
471 $email =~ s/^\s+|\s+$//g;
472 $email = substr($email, 0, 191);
473
474 unless ($bid || ($email =~ /\@/ && $email =~ /\./)) {
475 $_go->('err=bad_input');
476 return;
477 }
478
479 my $amt = defined $form->{amount_cents} ? $form->{amount_cents} : '';
480 $amt =~ s/[^0-9]//g;
481 unless ($amt && $amt > 0) { $_go->('err=bad_input'); return; }
482
483 my $note = defined $form->{note} ? $form->{note} : '';
484 $note =~ s/[\r\n]+/ /g;
485 $note = substr($note, 0, 480);
486
487 my $dbh = $db->db_connect();
488
489 # Authorize storefront ownership. Platform admins always pass.
490 my $is_admin = $userinfo->{is_admin} ? 1 : 0;
491 unless ($is_admin) {
492 my $owns = $db->db_readwrite($dbh, qq~
493 SELECT id FROM `${DB}`.storefronts
494 WHERE id='$sid' AND user_id='$owner_uid' LIMIT 1
495 ~, $ENV{SCRIPT_NAME}, __LINE__);
496 unless ($owns && $owns->{id}) {
497 $db->db_disconnect($dbh);
498 $_go->('err=denied');
499 return;
500 }
501 }
502
503 unless ($bc->schema_ready($db, $dbh, $DB)) {
504 $db->db_disconnect($dbh);
505 $_go->('err=schema');
506 return;
507 }
508
509 # If buyer_account_id is given, verify it actually belongs to this
510 # storefront -- otherwise a malicious admin could credit a buyer of
511 # a different storefront via crafted POST.
512 if ($bid) {
513 my $ba = $db->db_readwrite($dbh, qq~
514 SELECT id, email FROM `${DB}`.buyer_accounts
515 WHERE id='$bid' AND storefront_id='$sid' LIMIT 1
516 ~, $ENV{SCRIPT_NAME}, __LINE__);
517 unless ($ba && $ba->{id}) {
518 $db->db_disconnect($dbh);
519 $_go->('err=not_found');
520 return;
521 }
522 # Use the canonical email from buyer_accounts so a follow-up guest
523 # checkout (no session) under the same email finds the credit.
524 $email = $ba->{email} unless length $email;
525 }
526
527 my $new_id = $bc->grant($db, $dbh, $DB,
528 storefront_id => $sid,
529 buyer_account_id => $bid || undef,
530 buyer_email => $email,
531 amount_cents => $amt,
532 reason => 'manual_grant',
533 granted_by_user_id => $caller_uid,
534 note => $note,
535 );
536
537 $db->db_disconnect($dbh);
538
539 $_go->($new_id ? 'ok=credit_granted' : 'err=credit_failed');
540 return;
541}