Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/Tax.pm
Diff

/var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/Tax.pm

added on local at 2026-07-01 15:02:57

Added
+469
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 56e32f159b46
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::ContactForge::Tax;
2#======================================================================
3# WebSTLs -- tax computation + storage helpers.
4#
5# Marketplace-facilitator model (same pattern as Etsy/eBay): the
6# platform decides per-jurisdiction whether it collects tax. Sellers
7# never configure rates -- everything is driven from tax_jurisdictions
8# + tax_settings managed in /admin_tax.cgi.
9#
10# Public methods most callers care about:
11# schema_ready($db,$dbh,$DB) -- 1 if the tax tables exist
12# resolve_for_order(...) -- pick the right jurisdiction
13# rows for a buyer location
14# and product kind
15# calc_tax_lines(...) -- compute order_tax_lines rows
16# for an order (in cents)
17# write_order_tax_lines(...) -- persist the calc output
18# summary_for_order($db,$dbh,$DB,$oid) -- read back the lines
19# for receipts/reports
20# list_jurisdictions(...) -- admin listing helpers
21# list_settings(...)
22# audit($db,$dbh,$DB,$opts) -- write a tax_audit_log row
23#
24# Tax math is intentionally simple-as-possible (one rate per
25# jurisdiction, no compounding) so it's predictable + auditable.
26# More complex schemes -- compounding QST on top of GST, reduced VAT
27# rates for ebooks etc. -- are handled by adding extra rows to
28# tax_jurisdictions and letting calc_tax_lines pick up all matches.
29#======================================================================
30use strict;
31use warnings;
32
33sub new { bless {}, shift }
34
35#----------------------------------------------------------------------
36# schema_ready -- guards against running on a DB that hasn't been
37# migrated yet. Cheap (info_schema lookup, cached per connection).
38#----------------------------------------------------------------------
39sub schema_ready {
40 my ($self, $db, $dbh, $DB) = @_;
41 foreach my $t (qw(tax_jurisdictions tax_settings order_tax_lines buyer_tax_info tax_audit_log)) {
42 my $r = $db->db_readwrite($dbh, qq~
43 SELECT COUNT(*) AS n FROM information_schema.tables
44 WHERE table_schema='$DB' AND table_name='$t'
45 ~, $ENV{SCRIPT_NAME}, __LINE__);
46 return 0 unless ($r && $r->{n});
47 }
48 return 1;
49}
50
51#----------------------------------------------------------------------
52# list_jurisdictions($db,$dbh,$DB,%filter)
53#
54# Filter keys (all optional):
55# country -- 'US' (exact match on country_iso2)
56# active_only -- 1 to skip is_active=0 rows
57# currently_in_effect -- 1 to filter for effective_from/to overlap NOW()
58#----------------------------------------------------------------------
59sub list_jurisdictions {
60 my ($self, $db, $dbh, $DB, %f) = @_;
61 return () unless $self->schema_ready($db, $dbh, $DB);
62
63 my @w;
64 if (my $c = $f{country}) {
65 $c =~ s/[^A-Za-z]//g;
66 $c = uc(substr($c, 0, 2));
67 push @w, "country_iso2='$c'" if length $c;
68 }
69 push @w, "is_active=1" if $f{active_only};
70 if ($f{currently_in_effect}) {
71 push @w, "effective_from <= CURDATE()";
72 push @w, "(effective_to IS NULL OR effective_to > CURDATE())";
73 }
74 my $where = @w ? ('WHERE ' . join(' AND ', @w)) : '';
75
76 return $db->db_readwrite_multiple($dbh, qq~
77 SELECT id, country_iso2, region_code, display_name, tax_type,
78 rate_pct, applies_to, effective_from, effective_to,
79 is_active, notes
80 FROM `${DB}`.tax_jurisdictions
81 $where
82 ORDER BY country_iso2, region_code, effective_from DESC
83 ~, $ENV{SCRIPT_NAME}, __LINE__);
84}
85
86#----------------------------------------------------------------------
87# list_settings($db,$dbh,$DB) -- one row per (country,region) with
88# the marketplace-facilitator policy. Used by admin_tax.cgi.
89#----------------------------------------------------------------------
90sub list_settings {
91 my ($self, $db, $dbh, $DB) = @_;
92 return () unless $self->schema_ready($db, $dbh, $DB);
93 return $db->db_readwrite_multiple($dbh, qq~
94 SELECT id, country_iso2, region_code, platform_collects,
95 oss_scheme, registration_number, registered_at,
96 threshold_hit_at, price_display, notes, updated_at
97 FROM `${DB}`.tax_settings
98 ORDER BY country_iso2, region_code
99 ~, $ENV{SCRIPT_NAME}, __LINE__);
100}
101
102#----------------------------------------------------------------------
103# get_setting($db,$dbh,$DB,$country,$region) -- one row, or undef.
104# Used by checkout to decide whether to collect at all.
105#----------------------------------------------------------------------
106sub get_setting {
107 my ($self, $db, $dbh, $DB, $country, $region) = @_;
108 return undef unless $self->schema_ready($db, $dbh, $DB);
109 my $c = uc($country || ''); $c =~ s/[^A-Z]//g; return undef unless length $c == 2;
110 my $r = $region || ''; $r =~ s/[^A-Za-z0-9]//g;
111 return $db->db_readwrite($dbh, qq~
112 SELECT id, country_iso2, region_code, platform_collects,
113 oss_scheme, registration_number, price_display
114 FROM `${DB}`.tax_settings
115 WHERE country_iso2='$c' AND region_code='$r'
116 LIMIT 1
117 ~, $ENV{SCRIPT_NAME}, __LINE__);
118}
119
120#----------------------------------------------------------------------
121# resolve_for_order($db,$dbh,$DB, country=>'DE', region=>'',
122# product_kind=>'digital')
123#
124# Returns the active tax_jurisdictions row that should apply, or
125# undef. Order of preference: (country+region+applies_to=product)
126# > (country+region+applies_to=both) > (country+applies_to=product)
127# > (country+applies_to=both). Lets a state-level rate override a
128# country rate AND a product-specific rate override the 'both'
129# fallback.
130#----------------------------------------------------------------------
131sub resolve_for_order {
132 my ($self, $db, $dbh, $DB, %a) = @_;
133 return undef unless $self->schema_ready($db, $dbh, $DB);
134
135 my $c = uc($a{country} || ''); $c =~ s/[^A-Z]//g;
136 return undef unless length $c == 2;
137 my $r = $a{region} || ''; $r =~ s/[^A-Za-z0-9]//g;
138 my $k = lc($a{product_kind} || 'digital');
139 $k = 'digital' unless $k =~ /^(digital|physical|both)$/;
140
141 # Build a 4-step ranking with FIELD() so the most-specific row
142 # wins. effective_from/to filters guarantee we never pick a
143 # retired rate. We don't filter on is_active=1 explicitly here
144 # because retired rates carry is_active=0 already.
145 my $sql = qq~
146 SELECT id, country_iso2, region_code, display_name, tax_type,
147 rate_pct, applies_to
148 FROM `${DB}`.tax_jurisdictions
149 WHERE is_active=1
150 AND country_iso2='$c'
151 AND (region_code='$r' OR region_code='')
152 AND (applies_to='$k' OR applies_to='both')
153 AND effective_from <= CURDATE()
154 AND (effective_to IS NULL OR effective_to > CURDATE())
155 ORDER BY
156 CASE WHEN region_code='$r' AND region_code<>'' THEN 0 ELSE 1 END,
157 CASE WHEN applies_to='$k' THEN 0 ELSE 1 END,
158 effective_from DESC
159 LIMIT 1
160 ~;
161 return $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__);
162}
163
164#----------------------------------------------------------------------
165# storefront_tax_mode($db,$dbh,$DB,$sf_id)
166#
167# Returns 'platform_collects' (default) or 'seller_handles'. Used by
168# checkout to decide whether to invoke calc_tax_lines at all. In
169# seller_handles mode the seller is the merchant of record and owns
170# their own tax compliance -- platform stays out entirely.
171#----------------------------------------------------------------------
172sub storefront_tax_mode {
173 my ($self, $db, $dbh, $DB, $sf_id) = @_;
174 $sf_id =~ s/[^0-9]//g if defined $sf_id;
175 return 'platform_collects' unless $sf_id;
176 # Guarded SELECT -- the column doesn't exist until the tax
177 # migration has run, so check first to avoid 500'ing the page.
178 my $col = $db->db_readwrite($dbh, qq~
179 SELECT COUNT(*) AS n FROM information_schema.columns
180 WHERE table_schema='$DB' AND table_name='storefronts' AND column_name='tax_mode'
181 ~, $ENV{SCRIPT_NAME}, __LINE__);
182 return 'platform_collects' unless ($col && $col->{n});
183 my $r = $db->db_readwrite($dbh, qq~
184 SELECT tax_mode FROM `${DB}`.storefronts WHERE id='$sf_id' LIMIT 1
185 ~, $ENV{SCRIPT_NAME}, __LINE__);
186 return ($r && $r->{tax_mode}) ? $r->{tax_mode} : 'platform_collects';
187}
188
189#----------------------------------------------------------------------
190# seller_tax_id($db,$dbh,$DB,$sf_id)
191#
192# Returns ($kind, $value) for the seller's own tax registration ID,
193# or ('','') if not set. Used on receipts so the seller's VAT/permit
194# ID is printed alongside any platform-collected lines.
195#----------------------------------------------------------------------
196sub seller_tax_id {
197 my ($self, $db, $dbh, $DB, $sf_id) = @_;
198 $sf_id =~ s/[^0-9]//g if defined $sf_id;
199 return ('', '') unless $sf_id;
200 my $r = $db->db_readwrite($dbh, qq~
201 SELECT seller_tax_id_kind AS k, seller_tax_id_value AS v
202 FROM `${DB}`.storefronts WHERE id='$sf_id' LIMIT 1
203 ~, $ENV{SCRIPT_NAME}, __LINE__);
204 return ('', '') unless $r;
205 return ($r->{k} || '', $r->{v} || '');
206}
207
208#----------------------------------------------------------------------
209# calc_tax_lines(\%ctx)
210#
211# Pure function: takes a context hash, returns an array of line hashes
212# WITHOUT touching the DB. Caller decides whether to persist via
213# write_order_tax_lines or just show as a checkout preview.
214#
215# Context keys:
216# db, dbh, DB -- standard
217# country_iso2, region_code -- buyer location (final)
218# product_kind -- 'digital'|'physical'|'both' (the
219# order's dominant kind -- we group
220# since one order = one tax line)
221# taxable_amount_cents -- subtotal after discount
222# reverse_charge -- 1 if buyer has valid VIES VAT ID
223# (B2B EU) -- skip tax, basis becomes
224# 'reverse_charge'
225# buyer_vat_id, buyer_vat_country
226# evidence -- hashref with buyer_country_*
227# keys for the audit snapshot
228#
229# Returns: list of hashrefs with these keys (matches order_tax_lines):
230# jurisdiction_id, country_iso2, region_code, jurisdiction_label,
231# tax_type, rate_pct, taxable_amount_cents, tax_amount_cents, basis,
232# evidence_json, buyer_vat_id, buyer_vat_country
233#----------------------------------------------------------------------
234sub calc_tax_lines {
235 my ($self, %a) = @_;
236 my ($db, $dbh, $DB) = @a{qw(db dbh DB)};
237 return () unless $self->schema_ready($db, $dbh, $DB);
238
239 # Storefront-level opt-out. When the admin flipped this seller to
240 # 'seller_handles' from /admin_tax.cgi, the platform stays out
241 # entirely -- no tax calc, no order_tax_lines, no audit.
242 if (my $sf = $a{storefront_id}) {
243 my $mode = $self->storefront_tax_mode($db, $dbh, $DB, $sf);
244 return () if $mode eq 'seller_handles';
245 }
246
247 my $taxable = int($a{taxable_amount_cents} || 0);
248 return () if $taxable <= 0;
249
250 my $country = uc($a{country_iso2} || ''); $country =~ s/[^A-Z]//g;
251 return () unless length $country == 2;
252 my $region = $a{region_code} || ''; $region =~ s/[^A-Za-z0-9]//g;
253 my $kind = lc($a{product_kind} || 'digital');
254 $kind = 'digital' unless $kind =~ /^(digital|physical|both)$/;
255
256 # Step 1: does platform collect here at all?
257 my $setting = $self->get_setting($db, $dbh, $DB, $country, $region)
258 || $self->get_setting($db, $dbh, $DB, $country, '');
259 return () unless $setting && $setting->{platform_collects};
260
261 # Step 2: pick the right jurisdiction row.
262 my $jur = $self->resolve_for_order($db, $dbh, $DB,
263 country => $country,
264 region => $region,
265 product_kind => $kind,
266 );
267 return () unless $jur;
268
269 # Step 3: B2B reverse charge -- record a zero-tax line so the
270 # audit trail still has the VAT-ID + jurisdiction snapshot.
271 my $basis = 'marketplace_facilitator';
272 my $tax_cents = 0;
273 if ($a{reverse_charge}) {
274 $basis = 'reverse_charge';
275 } else {
276 # Standard math. rate_pct is a DECIMAL(7,4) -- treat as percent.
277 # tax = round(taxable * rate_pct / 100).
278 $tax_cents = int(($taxable * $jur->{rate_pct} / 100) + 0.5);
279 }
280
281 my $evidence = '';
282 if (ref $a{evidence} eq 'HASH') {
283 $evidence = _flatten_evidence($a{evidence});
284 }
285
286 return ({
287 jurisdiction_id => $jur->{id},
288 country_iso2 => $jur->{country_iso2},
289 region_code => $jur->{region_code} || '',
290 jurisdiction_label => $jur->{display_name},
291 tax_type => $jur->{tax_type},
292 rate_pct => $jur->{rate_pct} + 0,
293 taxable_amount_cents => $taxable,
294 tax_amount_cents => $tax_cents,
295 basis => $basis,
296 evidence_json => $evidence,
297 buyer_vat_id => $a{buyer_vat_id} || '',
298 buyer_vat_country => $a{buyer_vat_country} || '',
299 });
300}
301
302#----------------------------------------------------------------------
303# write_order_tax_lines($db,$dbh,$DB,$order_id,\@lines)
304#
305# Persists what calc_tax_lines returned. Also updates the order's
306# tax_amount_cents + buyer_country fields to match so receipts/list
307# views don't have to join.
308#----------------------------------------------------------------------
309sub write_order_tax_lines {
310 my ($self, $db, $dbh, $DB, $order_id, $lines) = @_;
311 return 0 unless $self->schema_ready($db, $dbh, $DB);
312 return 0 unless $order_id && ref($lines) eq 'ARRAY';
313 $order_id =~ s/[^0-9]//g;
314 return 0 unless $order_id;
315
316 my $tax_sum = 0;
317 my ($country, $region) = ('', '');
318 foreach my $l (@$lines) {
319 my $oid = $order_id;
320 my $jid = ($l->{jurisdiction_id} || 0) + 0;
321 next unless $jid;
322 my $c = _esc($l->{country_iso2} || '');
323 my $r = _esc($l->{region_code} || '');
324 my $lbl = _esc(substr($l->{jurisdiction_label} || '', 0, 120));
325 my $tt = _esc(substr($l->{tax_type} || 'vat', 0, 20));
326 my $rate = sprintf('%.4f', $l->{rate_pct} || 0);
327 my $taxable = int($l->{taxable_amount_cents} || 0);
328 my $tax = int($l->{tax_amount_cents} || 0);
329 my $basis = _esc($l->{basis} || 'marketplace_facilitator');
330 my $ev = _esc(substr($l->{evidence_json} || '', 0, 4096));
331 my $vid = _esc(substr($l->{buyer_vat_id} || '', 0, 20));
332 my $vco = _esc(substr($l->{buyer_vat_country} || '', 0, 2));
333 my $vid_sql = length($vid) ? "'$vid'" : 'NULL';
334 my $vco_sql = length($vco) ? "'$vco'" : 'NULL';
335
336 $db->db_readwrite($dbh, qq~
337 INSERT INTO `${DB}`.order_tax_lines SET
338 order_id='$oid',
339 jurisdiction_id='$jid',
340 country_iso2='$c',
341 region_code='$r',
342 jurisdiction_label='$lbl',
343 tax_type='$tt',
344 rate_pct=$rate,
345 taxable_amount_cents='$taxable',
346 tax_amount_cents='$tax',
347 basis='$basis',
348 evidence_json='$ev',
349 buyer_vat_id=$vid_sql,
350 buyer_vat_country=$vco_sql
351 ~, $ENV{SCRIPT_NAME}, __LINE__);
352
353 $tax_sum += $tax;
354 $country = $c if length $c && !length $country;
355 $region = $r if length $r && !length $region;
356 }
357
358 # Roll up onto the orders row so list queries don't have to join.
359 my $c_sql = length($country) ? "'$country'" : 'NULL';
360 my $r_sql = length($region) ? "'$region'" : 'NULL';
361 $db->db_readwrite($dbh, qq~
362 UPDATE `${DB}`.orders
363 SET tax_amount_cents='$tax_sum',
364 buyer_country_iso2=$c_sql,
365 buyer_region_code=$r_sql
366 WHERE id='$order_id'
367 ~, $ENV{SCRIPT_NAME}, __LINE__);
368
369 return $tax_sum;
370}
371
372#----------------------------------------------------------------------
373# summary_for_order($db,$dbh,$DB,$order_id) -- returns the lines as
374# an arrayref. Empty if no tax was charged on this order.
375#----------------------------------------------------------------------
376sub summary_for_order {
377 my ($self, $db, $dbh, $DB, $order_id) = @_;
378 return [] unless $self->schema_ready($db, $dbh, $DB);
379 $order_id =~ s/[^0-9]//g;
380 return [] unless $order_id;
381 my @rows = $db->db_readwrite_multiple($dbh, qq~
382 SELECT id, jurisdiction_id, country_iso2, region_code,
383 jurisdiction_label, tax_type, rate_pct,
384 taxable_amount_cents, tax_amount_cents, basis,
385 buyer_vat_id, buyer_vat_country, created_at
386 FROM `${DB}`.order_tax_lines
387 WHERE order_id='$order_id'
388 ORDER BY id
389 ~, $ENV{SCRIPT_NAME}, __LINE__);
390 return \@rows;
391}
392
393#----------------------------------------------------------------------
394# best_evidence_country(\%ev) -- pick the best buyer-country signal
395# given a snapshot of evidence pieces. Implements the EU two-evidence
396# rule: returns the country if at least 2 of {billing, ip, bank, tz}
397# agree; otherwise returns the billing country (most authoritative)
398# or undef if nothing's known.
399#----------------------------------------------------------------------
400sub best_evidence_country {
401 my ($self, $ev) = @_;
402 return undef unless ref $ev eq 'HASH';
403 my @signals = grep { length $_ } map { uc($ev->{$_} || '') } qw(
404 buyer_country_billing
405 buyer_country_ip
406 buyer_country_bank
407 buyer_country_timezone
408 );
409 return undef unless @signals;
410 # Count occurrences; pick most-frequent. Ties prefer billing.
411 my %n; $n{$_}++ for @signals;
412 my @sorted = sort { $n{$b} <=> $n{$a} } keys %n;
413 my $top = $sorted[0];
414 return $top if ($n{$top} || 0) >= 2;
415 return $ev->{buyer_country_billing} ? uc($ev->{buyer_country_billing}) : $top;
416}
417
418#----------------------------------------------------------------------
419# audit($db,$dbh,$DB, actor_user_id=>..., action=>..., target_kind=>..., target_id=>..., before=>..., after=>...)
420#----------------------------------------------------------------------
421sub audit {
422 my ($self, $db, $dbh, $DB, %a) = @_;
423 return 0 unless $self->schema_ready($db, $dbh, $DB);
424 my $uid = ($a{actor_user_id} || 0) + 0;
425 my $act = _esc(substr($a{action} || '', 0, 40));
426 my $tk = _esc(substr($a{target_kind} || '', 0, 40));
427 my $tid = ($a{target_id} || 0) + 0;
428 my $b = _esc(substr($a{before} || '', 0, 4096));
429 my $af = _esc(substr($a{after} || '', 0, 4096));
430 my $uid_sql = $uid ? "'$uid'" : 'NULL';
431 my $tid_sql = $tid ? "'$tid'" : 'NULL';
432 $db->db_readwrite($dbh, qq~
433 INSERT INTO `${DB}`.tax_audit_log SET
434 actor_user_id=$uid_sql,
435 action='$act',
436 target_kind='$tk',
437 target_id=$tid_sql,
438 before_json='$b',
439 after_json='$af'
440 ~, $ENV{SCRIPT_NAME}, __LINE__);
441 return 1;
442}
443
444#======================================================================
445# Internals
446#======================================================================
447sub _esc {
448 my $s = shift; $s = '' unless defined $s;
449 $s =~ s/\\/\\\\/g;
450 $s =~ s/'/''/g;
451 return $s;
452}
453
454sub _flatten_evidence {
455 my $h = shift;
456 return '' unless ref $h eq 'HASH';
457 my @kv;
458 foreach my $k (sort keys %$h) {
459 my $v = $h->{$k};
460 $v = '' unless defined $v;
461 # Strip anything weird; this is for audit, not display.
462 $v =~ s/[^A-Za-z0-9 .,:_+\-\/]//g;
463 $v = substr($v, 0, 64);
464 push @kv, "$k=$v";
465 }
466 return join('; ', @kv);
467}
468
4691;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help