Diff -- /var/www/vhosts/3dshawn.com/repricer.3dshawn.com/MODS/RePricer/BuyerCredits.pm
Diff

/var/www/vhosts/3dshawn.com/repricer.3dshawn.com/MODS/RePricer/BuyerCredits.pm

added on local at 2026-07-01 21:47:10

Added
+380
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to c21bc8f0f7b1
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::RePricer::BuyerCredits;
2#======================================================================
3# RePricer -- Per-storefront BUYER credit ledger.
4#
5# Distinct from MODS::RePricer::Billing's credit_ledger:
6# credit_ledger => RePricer platform crediting a SELLER's
7# account against their subscription invoices.
8# buyer_credit_ledger => a SELLER crediting one of THEIR BUYERS
9# against future orders on that seller's
10# storefront.
11#
12# Scoping invariant: a buyer credit is keyed on (storefront_id, buyer).
13# A credit issued by Storefront A is NEVER redeemable on Storefront B,
14# even if it's the same buyer email registered on both.
15#
16# Buyer identity: prefer buyer_account_id (registered buyer). Guests get
17# the credit row written with buyer_account_id=NULL and the email
18# carried in buyer_email. When that email later signs up on the same
19# storefront, link_email_to_account() backfills buyer_account_id on
20# every historic ledger row so balances follow the buyer.
21#
22# Application invariant: applying credit to an order is a NEGATIVE
23# ledger row with reason='order_apply' and related_order_id set. The
24# balance is always SUM(amount_cents) over the keyed buyer rows -- the
25# ledger is append-only; never UPDATE a historic row.
26#======================================================================
27use strict;
28use warnings;
29
30sub new {
31 my ($class) = @_;
32 return bless({}, $class);
33}
34
35# Lazy probe -- the buyer_credit_ledger table is added by a separate
36# migration; guard so the module loads cleanly on a fresh checkout
37# before the user runs the ALTER. Cached per-process.
38my $_schema_ok = undef;
39sub schema_ready {
40 my ($self, $db, $dbh, $DB) = @_;
41 return $_schema_ok if defined $_schema_ok;
42 # Need BOTH the ledger table AND orders.store_credit_applied_cents
43 # before we can safely write to either. SELECTing a missing column
44 # is fatal at the DBConnect layer (same as a missing table).
45 my $r = $db->db_readwrite($dbh, qq~
46 SELECT
47 (SELECT COUNT(*) FROM information_schema.tables
48 WHERE table_schema='$DB' AND table_name='buyer_credit_ledger') AS t,
49 (SELECT COUNT(*) FROM information_schema.columns
50 WHERE table_schema='$DB' AND table_name='orders'
51 AND column_name='store_credit_applied_cents') AS c
52 ~, $ENV{SCRIPT_NAME}, __LINE__);
53 $_schema_ok = ($r && $r->{t} && $r->{c}) ? 1 : 0;
54 return $_schema_ok;
55}
56
57#----------------------------------------------------------------------
58# Balance lookup
59#----------------------------------------------------------------------
60# Returns balance in cents (may be 0). $buyer_key is either
61# { buyer_account_id => N } -- registered buyer
62# { buyer_email => '..' } -- guest / pre-signup
63# When both are present, buyer_account_id wins.
64sub balance_cents {
65 my ($self, $db, $dbh, $DB, $sid, $buyer_key) = @_;
66 return 0 unless $self->schema_ready($db, $dbh, $DB);
67 $sid =~ s/[^0-9]//g;
68 return 0 unless $sid;
69
70 my $where = $self->_buyer_where($sid, $buyer_key);
71 return 0 unless $where;
72
73 my $r = $db->db_readwrite($dbh, qq~
74 SELECT COALESCE(SUM(amount_cents),0) AS n
75 FROM `${DB}`.buyer_credit_ledger
76 WHERE $where
77 ~, $ENV{SCRIPT_NAME}, __LINE__);
78 return ($r && defined $r->{n}) ? ($r->{n} + 0) : 0;
79}
80
81# History rows newest-first. Returns list of hashrefs.
82sub history {
83 my ($self, $db, $dbh, $DB, $sid, $buyer_key, $limit) = @_;
84 return () unless $self->schema_ready($db, $dbh, $DB);
85 $sid =~ s/[^0-9]//g;
86 return () unless $sid;
87 my $where = $self->_buyer_where($sid, $buyer_key);
88 return () unless $where;
89
90 $limit ||= 50;
91 $limit =~ s/[^0-9]//g;
92 $limit = 50 unless $limit;
93 $limit = 200 if $limit > 200;
94
95 return $db->db_readwrite_multiple($dbh, qq~
96 SELECT id, amount_cents, reason, related_order_id,
97 granted_by_user_id, note, created_at
98 FROM `${DB}`.buyer_credit_ledger
99 WHERE $where
100 ORDER BY created_at DESC, id DESC
101 LIMIT $limit
102 ~, $ENV{SCRIPT_NAME}, __LINE__);
103}
104
105#----------------------------------------------------------------------
106# Grant a positive credit (seller manually crediting a buyer, OR
107# converting a cash refund into store credit).
108#----------------------------------------------------------------------
109# Args:
110# storefront_id => N (required)
111# buyer_account_id => N (optional; preferred when buyer is registered)
112# buyer_email => '..' (required if buyer_account_id missing)
113# amount_cents => N (positive integer)
114# reason => 'manual_grant' | 'order_refund' | 'promotional'
115# related_order_id => N (optional, links a refund-as-credit to its order)
116# granted_by_user_id => N (the seller / team member who did it)
117# note => '..' (visible to buyer in their credit history; <=480 chars)
118#
119# Returns the new ledger row id on success, 0 on validation failure.
120sub grant {
121 my ($self, $db, $dbh, $DB, %a) = @_;
122 return 0 unless $self->schema_ready($db, $dbh, $DB);
123
124 my $sid = $a{storefront_id} || 0;
125 $sid =~ s/[^0-9]//g;
126 return 0 unless $sid;
127
128 my $bai = defined $a{buyer_account_id} ? $a{buyer_account_id} : '';
129 $bai =~ s/[^0-9]//g;
130 my $email = defined $a{buyer_email} ? $a{buyer_email} : '';
131 $email =~ s/^\s+|\s+$//g;
132 $email = substr($email, 0, 191);
133 return 0 unless $bai || ($email =~ /\@/ && $email =~ /\./);
134
135 my $amt = defined $a{amount_cents} ? $a{amount_cents} : '';
136 $amt =~ s/[^0-9]//g;
137 return 0 unless $amt && $amt > 0;
138
139 my $reason = $a{reason} || 'manual_grant';
140 my %ok = map { $_ => 1 } qw(manual_grant order_refund promotional reversal);
141 return 0 unless $ok{$reason};
142
143 my $rel = defined $a{related_order_id} ? $a{related_order_id} : '';
144 $rel =~ s/[^0-9]//g;
145 my $admin = defined $a{granted_by_user_id} ? $a{granted_by_user_id} : '';
146 $admin =~ s/[^0-9]//g;
147 my $note = defined $a{note} ? $a{note} : '';
148 $note =~ s/[\r\n]+/ /g;
149 $note = substr($note, 0, 480);
150 $note =~ s/'/''/g;
151 my $esc_email = $email; $esc_email =~ s/'/''/g;
152
153 # If we have a buyer_account_id, also try to derive the canonical
154 # email from the buyer_accounts row so future guest-checkouts under
155 # the same email find the credit even without the account id.
156 if ($bai && !$email) {
157 my $ba = $db->db_readwrite($dbh, qq~
158 SELECT email FROM `${DB}`.buyer_accounts
159 WHERE id='$bai' AND storefront_id='$sid' LIMIT 1
160 ~, $ENV{SCRIPT_NAME}, __LINE__);
161 if ($ba && $ba->{email}) {
162 $email = $ba->{email};
163 $esc_email = $email; $esc_email =~ s/'/''/g;
164 }
165 }
166
167 my $bai_sql = $bai ? "'$bai'" : 'NULL';
168 my $rel_sql = $rel ? "'$rel'" : 'NULL';
169 my $admin_sql = $admin ? "'$admin'" : 'NULL';
170 my $email_sql = length($email) ? "'$esc_email'" : 'NULL';
171
172 my $r = $db->db_readwrite($dbh, qq~
173 INSERT INTO `${DB}`.buyer_credit_ledger
174 SET storefront_id='$sid',
175 buyer_account_id=$bai_sql,
176 buyer_email=$email_sql,
177 amount_cents='$amt',
178 reason='$reason',
179 related_order_id=$rel_sql,
180 granted_by_user_id=$admin_sql,
181 note='$note'
182 ~, $ENV{SCRIPT_NAME}, __LINE__);
183 return ($r && $r->{mysql_insertid}) ? $r->{mysql_insertid} : 0;
184}
185
186#----------------------------------------------------------------------
187# Apply credit to a paid order. Writes a NEGATIVE ledger row.
188# Called from stripe_webhook.cgi (payment_intent.succeeded) AND from
189# the free-order short-circuit in checkout_intent.cgi when an order
190# is fully covered by credit + promo.
191#
192# Idempotent on (related_order_id, reason='order_apply'): if a row
193# already exists for this order with that reason, the call is a no-op
194# returning 0. The negative amount is whatever orders.store_credit_applied_cents
195# is set to at the time of call -- that column is the source of truth
196# (set by checkout_intent.cgi when the buyer authorized using credit).
197#----------------------------------------------------------------------
198sub apply_to_order {
199 my ($self, $db, $dbh, $DB, $oid) = @_;
200 return 0 unless $self->schema_ready($db, $dbh, $DB);
201 $oid =~ s/[^0-9]//g;
202 return 0 unless $oid;
203
204 my $o = $db->db_readwrite($dbh, qq~
205 SELECT id, storefront_id, buyer_account_id, buyer_email,
206 store_credit_applied_cents
207 FROM `${DB}`.orders
208 WHERE id='$oid' LIMIT 1
209 ~, $ENV{SCRIPT_NAME}, __LINE__);
210 return 0 unless $o && $o->{id};
211
212 my $applied = $o->{store_credit_applied_cents} || 0;
213 return 0 unless $applied > 0;
214
215 # Idempotent guard: don't write twice for the same order.
216 my $existing = $db->db_readwrite($dbh, qq~
217 SELECT id FROM `${DB}`.buyer_credit_ledger
218 WHERE related_order_id='$oid' AND reason='order_apply'
219 LIMIT 1
220 ~, $ENV{SCRIPT_NAME}, __LINE__);
221 return 0 if $existing && $existing->{id};
222
223 my $sid = $o->{storefront_id} || 0;
224 my $bai = $o->{buyer_account_id} || 0;
225 my $email = $o->{buyer_email} || '';
226 my $esc_email = $email; $esc_email =~ s/'/''/g;
227 my $neg = 0 - $applied;
228
229 my $bai_sql = $bai ? "'$bai'" : 'NULL';
230 my $email_sql = length($email) ? "'$esc_email'" : 'NULL';
231
232 my $r = $db->db_readwrite($dbh, qq~
233 INSERT INTO `${DB}`.buyer_credit_ledger
234 SET storefront_id='$sid',
235 buyer_account_id=$bai_sql,
236 buyer_email=$email_sql,
237 amount_cents='$neg',
238 reason='order_apply',
239 related_order_id='$oid',
240 granted_by_user_id=NULL,
241 note='Applied to order #${oid}'
242 ~, $ENV{SCRIPT_NAME}, __LINE__);
243 return ($r && $r->{mysql_insertid}) ? $r->{mysql_insertid} : 0;
244}
245
246#----------------------------------------------------------------------
247# Reverse an order's credit consumption. Called when a paid order is
248# refunded so the buyer gets their spent credit back.
249#----------------------------------------------------------------------
250sub reverse_for_order {
251 my ($self, $db, $dbh, $DB, $oid) = @_;
252 return 0 unless $self->schema_ready($db, $dbh, $DB);
253 $oid =~ s/[^0-9]//g;
254 return 0 unless $oid;
255
256 my $consumed = $db->db_readwrite($dbh, qq~
257 SELECT id, storefront_id, buyer_account_id, buyer_email,
258 amount_cents
259 FROM `${DB}`.buyer_credit_ledger
260 WHERE related_order_id='$oid' AND reason='order_apply'
261 LIMIT 1
262 ~, $ENV{SCRIPT_NAME}, __LINE__);
263 return 0 unless $consumed && $consumed->{id};
264 return 0 unless $consumed->{amount_cents} && $consumed->{amount_cents} < 0;
265
266 # Idempotency: don't reverse twice.
267 my $already = $db->db_readwrite($dbh, qq~
268 SELECT id FROM `${DB}`.buyer_credit_ledger
269 WHERE related_order_id='$oid' AND reason='reversal'
270 LIMIT 1
271 ~, $ENV{SCRIPT_NAME}, __LINE__);
272 return 0 if $already && $already->{id};
273
274 my $sid = $consumed->{storefront_id} || 0;
275 my $bai = $consumed->{buyer_account_id} || 0;
276 my $email = $consumed->{buyer_email} || '';
277 my $esc_email = $email; $esc_email =~ s/'/''/g;
278 my $pos = 0 - $consumed->{amount_cents};
279
280 my $bai_sql = $bai ? "'$bai'" : 'NULL';
281 my $email_sql = length($email) ? "'$esc_email'" : 'NULL';
282
283 my $r = $db->db_readwrite($dbh, qq~
284 INSERT INTO `${DB}`.buyer_credit_ledger
285 SET storefront_id='$sid',
286 buyer_account_id=$bai_sql,
287 buyer_email=$email_sql,
288 amount_cents='$pos',
289 reason='reversal',
290 related_order_id='$oid',
291 granted_by_user_id=NULL,
292 note='Reversed (order #${oid} refunded)'
293 ~, $ENV{SCRIPT_NAME}, __LINE__);
294 return ($r && $r->{mysql_insertid}) ? $r->{mysql_insertid} : 0;
295}
296
297#----------------------------------------------------------------------
298# Backfill buyer_account_id on historic ledger rows when a guest later
299# signs up under the same email at the same storefront. Call from
300# buyer_signup.cgi right after the buyer_accounts row is created.
301#----------------------------------------------------------------------
302sub link_email_to_account {
303 my ($self, $db, $dbh, $DB, $sid, $buyer_id, $email) = @_;
304 return 0 unless $self->schema_ready($db, $dbh, $DB);
305 $sid =~ s/[^0-9]//g;
306 $buyer_id =~ s/[^0-9]//g;
307 return 0 unless $sid && $buyer_id;
308 $email =~ s/^\s+|\s+$//g;
309 return 0 unless length($email);
310 my $esc = $email; $esc =~ s/'/''/g;
311
312 $db->db_readwrite($dbh, qq~
313 UPDATE `${DB}`.buyer_credit_ledger
314 SET buyer_account_id='$buyer_id'
315 WHERE storefront_id='$sid'
316 AND buyer_email='$esc'
317 AND buyer_account_id IS NULL
318 ~, $ENV{SCRIPT_NAME}, __LINE__);
319 return 1;
320}
321
322#----------------------------------------------------------------------
323# Aggregate balances per buyer for a single storefront. Used by
324# customers.cgi to render a list. Returns hashrefs with keys:
325# buyer_account_id, buyer_email, balance_cents, last_activity_at,
326# ledger_row_count, display_name (if registered).
327# $limit caps the list (default 200).
328#----------------------------------------------------------------------
329sub list_buyers_for_storefront {
330 my ($self, $db, $dbh, $DB, $sid, $limit) = @_;
331 return () unless $self->schema_ready($db, $dbh, $DB);
332 $sid =~ s/[^0-9]//g;
333 return () unless $sid;
334 $limit ||= 200;
335 $limit =~ s/[^0-9]//g;
336 $limit = 200 unless $limit;
337 $limit = 1000 if $limit > 1000;
338
339 # Group on COALESCE(buyer_account_id, 0) + buyer_email so a buyer
340 # who first appeared as a guest (buyer_account_id NULL) and later
341 # signed up still rolls up under one row IF link_email_to_account
342 # was run. We left-join buyer_accounts for the display name.
343 return $db->db_readwrite_multiple($dbh, qq~
344 SELECT bcl.buyer_account_id,
345 bcl.buyer_email,
346 SUM(bcl.amount_cents) AS balance_cents,
347 COUNT(*) AS ledger_row_count,
348 MAX(bcl.created_at) AS last_activity_at,
349 ba.display_name AS display_name,
350 ba.lifetime_value_cents AS lifetime_value_cents,
351 ba.order_count AS order_count
352 FROM `${DB}`.buyer_credit_ledger bcl
353 LEFT JOIN `${DB}`.buyer_accounts ba
354 ON ba.id = bcl.buyer_account_id
355 WHERE bcl.storefront_id='$sid'
356 GROUP BY COALESCE(bcl.buyer_account_id, 0), bcl.buyer_email
357 ORDER BY last_activity_at DESC
358 LIMIT $limit
359 ~, $ENV{SCRIPT_NAME}, __LINE__);
360}
361
362#----------------------------------------------------------------------
363# Helpers
364#----------------------------------------------------------------------
365sub _buyer_where {
366 my ($self, $sid, $buyer_key) = @_;
367 return '' unless ref($buyer_key) eq 'HASH';
368 my $bai = defined $buyer_key->{buyer_account_id} ? $buyer_key->{buyer_account_id} : '';
369 $bai =~ s/[^0-9]//g;
370 if ($bai) {
371 return "storefront_id='$sid' AND buyer_account_id='$bai'";
372 }
373 my $email = defined $buyer_key->{buyer_email} ? $buyer_key->{buyer_email} : '';
374 $email =~ s/^\s+|\s+$//g;
375 return '' unless length($email);
376 my $esc = $email; $esc =~ s/'/''/g;
377 return "storefront_id='$sid' AND buyer_account_id IS NULL AND buyer_email='$esc'";
378}
379
3801;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help