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

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

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

Added
+309
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 459fd4b07fde
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::Marketplaces::Base;
2#======================================================================
3# RePricer -- marketplace adapter base class.
4#
5# Shared plumbing for the three live adapters: Amazon, eBay, Walmart.
6# Each subclass overrides the API-specific bits; this base provides:
7# - HTTP::Tiny client (timeout/UA/SSL verify)
8# - JSON encode/decode wrappers
9# - request() with retry on 429 / 5xx
10# - log_call() for the marketplace_call_log table (audit trail)
11# - touch_account() to update last_used_at on marketplace_accounts
12# - mark_account_error() to set status=error + last_error on failure
13#
14# Adapter contract (subclasses MUST implement):
15# new($self, $account) # $account = marketplace_accounts hashref
16# test_connection() # cheap call; returns { ok => 1 } or { error => '...' }
17# list_my_listings($opts) # paged seller listings; returns { items => [...], next => '...' }
18# get_competitor_offers($product) # competitor pricing for one product row
19# update_price($product, $cents) # push new price; { ok => 1, sync_id => '...' }
20# refresh_token_if_needed() # OAuth-based platforms; api_key platforms return ok immediately
21#
22# Adapters DO NOT call save_account() inside read methods -- only
23# refresh_token_if_needed() and explicit setters do. This keeps reads
24# safe to call concurrently from the worker.
25#======================================================================
26use strict;
27use warnings;
28use HTTP::Tiny;
29use JSON::PP;
30use Time::HiRes qw(time);
31
32use MODS::DBConnect;
33use MODS::RePricer::Config;
34
35sub new {
36 my ($class, $account) = @_;
37 my $cfg = MODS::RePricer::Config->new;
38 my $self = {
39 account => $account,
40 cfg => $cfg,
41 db => MODS::DBConnect->new,
42 DB => $cfg->settings('database_name'),
43 ua => HTTP::Tiny->new(
44 agent => 'RePricer/1.0 (+https://repricer.3dshawn.com)',
45 timeout => 30,
46 verify_SSL => 1,
47 ),
48 json => JSON::PP->new->utf8->allow_nonref,
49 };
50 return bless $self, $class;
51}
52
53sub account { return $_[0]->{account}; }
54sub cfg { return $_[0]->{cfg}; }
55
56# Parse the per-account metadata blob (stored as JSON in
57# marketplace_accounts.metadata). Returns {} if missing or malformed.
58sub metadata {
59 my ($self) = @_;
60 return $self->{_meta} if $self->{_meta};
61 my $raw = $self->{account}{metadata};
62 if ($raw && length $raw) {
63 my $parsed = eval { JSON::PP::decode_json($raw) };
64 $self->{_meta} = (ref $parsed eq 'HASH') ? $parsed : {};
65 } else {
66 $self->{_meta} = {};
67 }
68 return $self->{_meta};
69}
70
71# Persist back to marketplace_accounts. Pass a flat hashref of column =>
72# value to update; updated_at + last_used_at handled automatically when
73# relevant. Returns 1 on success, 0 on no-op.
74sub save_account {
75 my ($self, $updates) = @_;
76 return 0 unless $updates && ref $updates eq 'HASH';
77 my $id = $self->{account}{id} or return 0;
78 $id =~ s/[^0-9]//g;
79 my $dbh = $self->{db}->db_connect();
80 my @set;
81 foreach my $k (sort keys %$updates) {
82 next unless $k =~ /^[a-z_]+\z/; # gate column names
83 my $v = $updates->{$k};
84 if (!defined $v) {
85 push @set, "`$k`=NULL";
86 } elsif ($k eq 'metadata' && ref $v eq 'HASH') {
87 my $j = JSON::PP::encode_json($v);
88 $j =~ s/'/''/g;
89 push @set, "`$k`='$j'";
90 $self->{_meta} = $v;
91 } else {
92 (my $vq = $v) =~ s/'/''/g;
93 push @set, "`$k`='$vq'";
94 $self->{account}{$k} = $v;
95 }
96 }
97 return 0 unless @set;
98 push @set, "updated_at=NOW()";
99 my $sql = "UPDATE `$self->{DB}`.marketplace_accounts SET "
100 . join(',', @set) . " WHERE id='$id'";
101 $self->{db}->db_readwrite($dbh, $sql, __PACKAGE__, __LINE__);
102 return 1;
103}
104
105# Bump last_used_at to NOW(). Cheap; no-op without an id.
106sub touch_account {
107 my ($self) = @_;
108 return $self->save_account({ last_used_at => _now_sql_safe() });
109}
110
111# Helper used by save_account directly for non-shell time.
112sub _now_sql_safe {
113 my @t = gmtime;
114 return sprintf('%04d-%02d-%02d %02d:%02d:%02d',
115 $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);
116}
117
118# Mark this account as errored with a short message (truncated to 500
119# chars). Used by adapters when an API call returns a fatal /
120# user-visible problem ("token revoked", "seller suspended", etc.).
121sub mark_account_error {
122 my ($self, $message) = @_;
123 $message = substr(($message // 'unknown error'), 0, 500);
124 $self->save_account({
125 status => 'error',
126 last_error => $message,
127 });
128}
129
130# Inverse: clear an error and put the account back into the "connected"
131# state. Adapters call this after a successful refresh / call following
132# a previously errored state.
133sub clear_account_error {
134 my ($self) = @_;
135 return unless ($self->{account}{status} // '') eq 'error';
136 $self->save_account({
137 status => 'connected',
138 last_error => undef,
139 });
140}
141
142# ----- HTTP plumbing -------------------------------------------------
143
144# request($method, $url, %opts)
145# headers => { ... }
146# body => raw string OR hashref (encoded as JSON if 'json' opt set)
147# json => 1 -> set Content-Type: application/json + encode hash body
148# form => 1 -> set Content-Type: application/x-www-form-urlencoded +
149# URL-encode hash body
150# timeout => seconds (default 30)
151# retries => count (default 2 -- so 3 total attempts on 429/5xx)
152# no_retry => 1 -> skip retry on any failure (useful for OAuth swap
153# where the auth code is single-use)
154#
155# Returns a normalised hashref:
156# { ok => 0|1,
157# status => http_status,
158# headers => { ... },
159# body => raw string,
160# parsed => decoded JSON hash/array if response is JSON,
161# error => 'human-readable' on !ok,
162# }
163sub request {
164 my ($self, $method, $url, %opts) = @_;
165
166 my $retries = exists $opts{retries} ? $opts{retries} : 2;
167 $retries = 0 if $opts{no_retry};
168 my $timeout = $opts{timeout} || 30;
169 $self->{ua}{timeout} = $timeout;
170
171 my $headers = $opts{headers} || {};
172 my $body = $opts{body};
173
174 if ($opts{json} && ref $body eq 'HASH') {
175 $headers->{'Content-Type'} //= 'application/json';
176 $body = $self->{json}->encode($body);
177 } elsif ($opts{form} && ref $body eq 'HASH') {
178 $headers->{'Content-Type'} //= 'application/x-www-form-urlencoded';
179 my @pairs;
180 foreach my $k (sort keys %$body) {
181 push @pairs, _url_encode($k) . '=' . _url_encode($body->{$k});
182 }
183 $body = join('&', @pairs);
184 }
185
186 my $attempt = 0;
187 my $last;
188 while (1) {
189 $attempt++;
190 my $req = { headers => $headers };
191 $req->{content} = $body if defined $body;
192 my $t0 = time;
193 my $r = $self->{ua}->request($method, $url, $req);
194 my $dur_ms = int((time - $t0) * 1000);
195
196 $last = {
197 ok => $r->{success} ? 1 : 0,
198 status => $r->{status},
199 headers => $r->{headers} || {},
200 body => $r->{content} // '',
201 dur_ms => $dur_ms,
202 attempt => $attempt,
203 };
204 # Best-effort JSON parse if the response is JSON-shaped.
205 if ($last->{body} =~ /^\s*[\[\{]/) {
206 my $p = eval { $self->{json}->decode($last->{body}) };
207 $last->{parsed} = $p if defined $p;
208 }
209 if (!$last->{ok}) {
210 $last->{error} = _extract_error_message($last);
211 }
212
213 # Retry on transient failures only.
214 my $transient = ($last->{status} == 429
215 || $last->{status} == 500
216 || $last->{status} == 502
217 || $last->{status} == 503
218 || $last->{status} == 504
219 || $last->{status} == 599);
220 last if $last->{ok};
221 last if !$transient;
222 last if $attempt > $retries;
223 # Honor Retry-After when present; otherwise exp backoff.
224 my $delay = 0;
225 if (my $ra = $last->{headers}{'retry-after'}) {
226 $delay = ($ra =~ /^\d+\z/) ? $ra : 2;
227 }
228 $delay ||= (2 ** ($attempt - 1));
229 $delay = 30 if $delay > 30; # cap so we don't sleep forever
230 select(undef, undef, undef, $delay);
231 }
232 return $last;
233}
234
235sub _url_encode {
236 my $s = shift;
237 $s = '' unless defined $s;
238 $s =~ s/([^A-Za-z0-9\-._~])/sprintf('%%%02X', ord($1))/ge;
239 return $s;
240}
241
242sub _extract_error_message {
243 my ($r) = @_;
244 # Try common JSON error shapes first.
245 if (ref $r->{parsed} eq 'HASH') {
246 my $p = $r->{parsed};
247 return $p->{error_description} if $p->{error_description};
248 return $p->{error} if $p->{error} && !ref $p->{error};
249 return $p->{message} if $p->{message};
250 if (ref $p->{errors} eq 'ARRAY' && @{$p->{errors}}) {
251 my $e = $p->{errors}[0];
252 return $e->{message} if ref $e eq 'HASH' && $e->{message};
253 return $e if !ref $e;
254 }
255 }
256 # Fall back to the raw body trimmed.
257 my $b = $r->{body} // '';
258 $b =~ s/^\s+|\s+\z//g;
259 if (length $b > 280) { $b = substr($b, 0, 280) . '...'; }
260 return $b || "HTTP $r->{status}";
261}
262
263# Optional structured call log. Adapters opt in by calling this at end
264# of significant operations. Silently no-ops when the table is absent
265# (so adapters work even before the schema patch is applied).
266sub log_call {
267 my ($self, $op, $resp, $extra) = @_;
268 return unless $self->{account} && $self->{account}{id};
269 my $aid = $self->{account}{id}; $aid =~ s/[^0-9]//g;
270 my $uid = $self->{account}{user_id} || 0; $uid =~ s/[^0-9]//g;
271 my $platform = $self->{account}{platform} || '';
272 my $status = $resp->{status} // 0;
273 my $ok = $resp->{ok} ? 1 : 0;
274 my $err = $resp->{error} // '';
275 my $dur = $resp->{dur_ms} // 0;
276 my $note = $extra ? ($self->{json}->encode($extra)) : '';
277 foreach ($op, $platform, $err, $note) { s/'/''/g; }
278 my $dbh = $self->{db}->db_connect();
279 my $sql = qq~
280 INSERT IGNORE INTO `$self->{DB}`.marketplace_call_log
281 (marketplace_account_id, user_id, platform, op, http_status,
282 ok, error_msg, duration_ms, note, created_at)
283 VALUES ('$aid', '$uid', '$platform', '$op', '$status',
284 '$ok', '$err', '$dur', '$note', NOW())
285 ~;
286 eval { $self->{db}->db_readwrite($dbh, $sql, __PACKAGE__, __LINE__); };
287}
288
289# ----- Adapter contract default stubs --------------------------------
290# Subclasses MUST override these; the defaults return an error envelope
291# so a half-built adapter fails loudly instead of silently no-opping.
292
293sub test_connection {
294 return { error => 'test_connection() not implemented by adapter' };
295}
296sub list_my_listings {
297 return { error => 'list_my_listings() not implemented by adapter' };
298}
299sub get_competitor_offers {
300 return { error => 'get_competitor_offers() not implemented by adapter' };
301}
302sub update_price {
303 return { error => 'update_price() not implemented by adapter' };
304}
305sub refresh_token_if_needed {
306 return { ok => 1 }; # api_key platforms can leave this as a no-op
307}
308
3091;
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help