added on local at 2026-07-01 21:47:42
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # RePricer -- _vies_check.cgi (JSON, GET or POST) | |
| 4 | # | |
| 5 | # Validate an EU VAT number against the European Commission's VIES | |
| 6 | # REST API. Cached results are stored in buyer_tax_info; revalidate | |
| 7 | # every 180 days. Returns: | |
| 8 | # { ok:1, valid:1|0, name:"...", country:"DE", vat_id:"DE123456789" } | |
| 9 | # { ok:0, error:"..." } | |
| 10 | # | |
| 11 | # Used by: | |
| 12 | # - checkout flow (B2B reverse charge): if VAT is valid, tax=0 and | |
| 13 | # order_tax_lines basis becomes 'reverse_charge' | |
| 14 | # - admin buyer_tax_info maintenance (manual revalidation) | |
| 15 | # | |
| 16 | # Vanilla core-only: HTTP::Tiny (Perl 5.14+) + JSON::PP. No CPAN deps. | |
| 17 | #====================================================================== | |
| 18 | use strict; | |
| 19 | use warnings; | |
| 20 | ||
| 21 | use lib '/var/www/vhosts/3dshawn.com/repricer.3dshawn.com'; | |
| 22 | use CGI; | |
| 23 | use HTTP::Tiny; | |
| 24 | use JSON::PP; | |
| 25 | use MODS::DBConnect; | |
| 26 | use MODS::RePricer::Config; | |
| 27 | ||
| 28 | my $q = CGI->new; | |
| 29 | my $form = $q->Vars; | |
| 30 | my $db = MODS::DBConnect->new; | |
| 31 | my $cfg = MODS::RePricer::Config->new; | |
| 32 | my $DB = $cfg->settings('database_name'); | |
| 33 | ||
| 34 | sub _json { | |
| 35 | my ($h) = @_; | |
| 36 | print "Content-Type: application/json; charset=utf-8\nCache-Control: no-store\n\n"; | |
| 37 | print JSON::PP::encode_json($h); | |
| 38 | exit; | |
| 39 | } | |
| 40 | ||
| 41 | my $vat_raw = $form->{vat_id} || ''; | |
| 42 | $vat_raw = uc($vat_raw); | |
| 43 | $vat_raw =~ s/[^A-Z0-9]//g; # VIES doesn't accept spaces/dashes | |
| 44 | _json({ ok=>0, error=>'vat_id required' }) unless length $vat_raw >= 4; | |
| 45 | ||
| 46 | # Country prefix is the first two letters; the rest is the local number. | |
| 47 | my ($mc, $nat) = ($vat_raw =~ /^([A-Z]{2})([A-Z0-9]+)$/); | |
| 48 | _json({ ok=>0, error=>'malformed -- expected like DE123456789' }) unless $mc; | |
| 49 | ||
| 50 | # Greece uses 'EL' as VIES prefix even though ISO is 'GR'. | |
| 51 | my $iso_country = ($mc eq 'EL') ? 'GR' : $mc; | |
| 52 | ||
| 53 | my $email = lc(substr(($form->{email} || ''), 0, 255)); | |
| 54 | ||
| 55 | my $dbh = $db->db_connect(); | |
| 56 | _json({ ok=>0, error=>'db' }) unless $dbh; | |
| 57 | ||
| 58 | # Cache hit? Re-check only when older than 180 days. is_valid=0 rows | |
| 59 | # also get a refresh (in case the seller registered for VAT since the | |
| 60 | # last check). | |
| 61 | my $cache = $db->db_readwrite($dbh, qq~ | |
| 62 | SELECT id, vat_id, vat_country, company_name, is_valid, | |
| 63 | DATEDIFF(NOW(), validated_at) AS age_days | |
| 64 | FROM `${DB}`.buyer_tax_info | |
| 65 | WHERE vat_id='$vat_raw' | |
| 66 | ORDER BY id DESC LIMIT 1 | |
| 67 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 68 | ||
| 69 | if ($cache && defined $cache->{age_days} && $cache->{age_days} < 180 && $cache->{is_valid}) { | |
| 70 | $db->db_disconnect($dbh); | |
| 71 | _json({ | |
| 72 | ok => 1, | |
| 73 | valid => 1, | |
| 74 | cached => 1, | |
| 75 | name => $cache->{company_name} || '', | |
| 76 | country => $cache->{vat_country}, | |
| 77 | vat_id => $cache->{vat_id}, | |
| 78 | }); | |
| 79 | } | |
| 80 | ||
| 81 | # Live VIES round-trip. Endpoint is public, no auth, ~5s timeout. | |
| 82 | my $url = "https://ec.europa.eu/taxation_customs/vies/rest-api/ms/$mc/vat/$nat"; | |
| 83 | my $ua = HTTP::Tiny->new(timeout => 5, agent => 'RePricer/1.0 (+https://repricer.3dshawn.com)'); | |
| 84 | my $resp = $ua->get($url); | |
| 85 | ||
| 86 | my ($is_valid, $name, $address, $err) = (0, '', '', ''); | |
| 87 | if ($resp && $resp->{success}) { | |
| 88 | my $payload = eval { JSON::PP::decode_json($resp->{content}) }; | |
| 89 | if (ref $payload eq 'HASH') { | |
| 90 | $is_valid = $payload->{isValid} ? 1 : 0; | |
| 91 | $name = $payload->{name} || ''; | |
| 92 | $address = $payload->{address} || ''; | |
| 93 | $err = $payload->{userError} || ''; | |
| 94 | } else { | |
| 95 | $err = 'unparseable VIES response'; | |
| 96 | } | |
| 97 | } else { | |
| 98 | $err = 'VIES unreachable (HTTP ' . ($resp->{status} || 'err') . ')'; | |
| 99 | } | |
| 100 | ||
| 101 | # Persist. Insert a new buyer_tax_info row OR update the existing | |
| 102 | # stalest one for this vat_id. | |
| 103 | my $safe_vat = $vat_raw; $safe_vat =~ s/'/''/g; | |
| 104 | my $safe_co = $iso_country; | |
| 105 | my $safe_nm = substr($name, 0, 180); $safe_nm =~ s/'/''/g; | |
| 106 | my $safe_em = $email; $safe_em =~ s/'/''/g; | |
| 107 | my $em_sql = length($email) ? "'$safe_em'" : 'NULL'; | |
| 108 | my $resp_short = substr($err || ($is_valid ? 'valid' : 'invalid'), 0, 500); | |
| 109 | $resp_short =~ s/'/''/g; | |
| 110 | ||
| 111 | if ($cache && $cache->{id}) { | |
| 112 | $db->db_readwrite($dbh, qq~ | |
| 113 | UPDATE `${DB}`.buyer_tax_info SET | |
| 114 | vat_country='$safe_co', | |
| 115 | company_name=~ . (length($safe_nm) ? "'$safe_nm'" : 'NULL') . qq~, | |
| 116 | validated_at=NOW(), | |
| 117 | validated_via='vies', | |
| 118 | is_valid='$is_valid', | |
| 119 | last_check_response='$resp_short' | |
| 120 | WHERE id='$cache->{id}' | |
| 121 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 122 | } else { | |
| 123 | $db->db_readwrite($dbh, qq~ | |
| 124 | INSERT INTO `${DB}`.buyer_tax_info SET | |
| 125 | email=$em_sql, | |
| 126 | vat_id='$safe_vat', | |
| 127 | vat_country='$safe_co', | |
| 128 | company_name=~ . (length($safe_nm) ? "'$safe_nm'" : 'NULL') . qq~, | |
| 129 | validated_at=NOW(), | |
| 130 | validated_via='vies', | |
| 131 | is_valid='$is_valid', | |
| 132 | last_check_response='$resp_short' | |
| 133 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 134 | } | |
| 135 | ||
| 136 | $db->db_disconnect($dbh); | |
| 137 | ||
| 138 | _json({ | |
| 139 | ok => 1, | |
| 140 | valid => $is_valid, | |
| 141 | cached => 0, | |
| 142 | name => $name, | |
| 143 | country => $iso_country, | |
| 144 | vat_id => $vat_raw, | |
| 145 | ($err ? (note => $err) : ()), | |
| 146 | }); |