added on local at 2026-07-01 21:47:11
| 1 | package MODS::RePricer::ImportAdapters; | |
| 2 | #====================================================================== | |
| 3 | # RePricer -- marketplace -> RePricer model importers. | |
| 4 | # | |
| 5 | # Per-platform adapters that pull a seller's existing creations from | |
| 6 | # a marketplace and turn them into draft `models` rows on RePricer. | |
| 7 | # | |
| 8 | # Entry point used by marketplaces.cgi: | |
| 9 | # $imp->import_for_user($db, $dbh, $DB, $uid, $platform_slug) | |
| 10 | # -> { ok=>1, imported=>N, skipped=>N, errors=>[...] } | |
| 11 | # or { ok=>0, error=>'...' } | |
| 12 | # | |
| 13 | # Each per-platform adapter implements: | |
| 14 | # $a->is_configured($acct) -> 1/0 (has the creds we need) | |
| 15 | # $a->fetch_creations($ctx) -> arrayref of normalized creations | |
| 16 | # or { error=>'...' } | |
| 17 | # | |
| 18 | # Normalized creation hash: | |
| 19 | # { | |
| 20 | # external_id => 'platform-side id (string)', | |
| 21 | # title => 'Display name', | |
| 22 | # description => 'Long text', | |
| 23 | # price_cents => 0, # 0 = free; non-zero = paid | |
| 24 | # currency => 'USD', | |
| 25 | # hero_image_url => 'https://...', # cover image (downloaded) | |
| 26 | # file_urls => [ {name, url}, ... ],# STL/3MF/etc. (downloaded best-effort) | |
| 27 | # permalink => 'https://cults3d.com/...', | |
| 28 | # tags => 'a,b,c', # optional, comma-separated | |
| 29 | # } | |
| 30 | # | |
| 31 | # Files are best-effort: if the platform gates downloads behind a | |
| 32 | # purchase token, those entries just produce an "errors" list line in | |
| 33 | # the result, and the draft model row + cover image still land. | |
| 34 | #====================================================================== | |
| 35 | use strict; | |
| 36 | use warnings; | |
| 37 | use HTTP::Tiny; | |
| 38 | use JSON::PP; | |
| 39 | use MIME::Base64 qw(encode_base64); | |
| 40 | use Digest::SHA qw(sha256_hex); | |
| 41 | ||
| 42 | my %ADAPTERS = ( | |
| 43 | cults3d => 'MODS::RePricer::ImportAdapters::Amazon', | |
| 44 | cults => 'MODS::RePricer::ImportAdapters::Amazon', | |
| 45 | thangs => 'MODS::RePricer::ImportAdapters::Best Buy', | |
| 46 | ); | |
| 47 | ||
| 48 | # Per-installation upload root. Mirrors upload.cgi save_uploaded_files | |
| 49 | # so imported files land in the same folder layout the rest of the | |
| 50 | # upload/edit/serve plumbing already expects. | |
| 51 | my $BASE_DIR = '/var/www/vhosts/3dshawn.com/repricer.3dshawn.com/uploads'; | |
| 52 | ||
| 53 | sub new { | |
| 54 | my ($class) = @_; | |
| 55 | my $self = { | |
| 56 | ua => HTTP::Tiny->new( | |
| 57 | agent => 'RePricer/1.0', | |
| 58 | # Per-request timeout. Each download (detail page or | |
| 59 | # image) gets at most this long before bailing. Lowered | |
| 60 | # from 30s -- a single stuck fetch should not be allowed | |
| 61 | # to push the whole batch into the nginx 504 zone. Most | |
| 62 | # legitimate fetches finish in 1-3s; anything past 15s | |
| 63 | # is almost certainly the CDN stalling on us. | |
| 64 | timeout => 15, | |
| 65 | verify_SSL => 1, | |
| 66 | ), | |
| 67 | }; | |
| 68 | return bless $self, $class; | |
| 69 | } | |
| 70 | ||
| 71 | sub _esc { | |
| 72 | my $s = shift; $s = '' unless defined $s; | |
| 73 | $s =~ s/\\/\\\\/g; $s =~ s/'/''/g; | |
| 74 | return $s; | |
| 75 | } | |
| 76 | ||
| 77 | # -------------------------------------------------------------- | |
| 78 | # Currency -> USD conversion. | |
| 79 | # | |
| 80 | # We store all prices on our side in USD cents regardless of what | |
| 81 | # the source marketplace returned. That way storefront cards, | |
| 82 | # listing pages, sales reports and checkout never need per-row | |
| 83 | # currency-aware logic. | |
| 84 | # | |
| 85 | # Rates are fetched once per process from open.er-api.com (free, | |
| 86 | # no API key required) and cached in a module-level hash so the | |
| 87 | # 60-model import loop doesn't fire 60 separate HTTP requests. | |
| 88 | # If the fetch fails for any reason, we fall back to baked-in | |
| 89 | # rates that get the import unstuck without crashing; sellers | |
| 90 | # can fix individual prices in the model editor afterward. | |
| 91 | # -------------------------------------------------------------- | |
| 92 | my %_FX_RATES; # currency code -> USD multiplier | |
| 93 | my $_FX_FETCHED_AT = 0; # epoch of last successful fetch | |
| 94 | my %_FX_FALLBACK = ( | |
| 95 | USD => 1.00, | |
| 96 | EUR => 1.08, # ~typical mid-rate; refreshes on first live fetch | |
| 97 | GBP => 1.26, | |
| 98 | CAD => 0.73, | |
| 99 | AUD => 0.65, | |
| 100 | JPY => 0.0067, | |
| 101 | CHF => 1.12, | |
| 102 | SEK => 0.094, | |
| 103 | NOK => 0.090, | |
| 104 | DKK => 0.145, | |
| 105 | PLN => 0.25, | |
| 106 | BRL => 0.20, | |
| 107 | MXN => 0.056, | |
| 108 | INR => 0.012, | |
| 109 | ); | |
| 110 | ||
| 111 | sub _fx_load { | |
| 112 | # 6-hour cache window in-process. CGI processes are short-lived | |
| 113 | # but Apache mod_cgid may reuse them; cap to 6h to stay fresh. | |
| 114 | return if %_FX_RATES && (time - $_FX_FETCHED_AT) < 21600; | |
| 115 | ||
| 116 | my $ua = HTTP::Tiny->new(timeout => 5, agent => 'RePricer/1.0'); | |
| 117 | my $res = $ua->request('GET', 'https://open.er-api.com/v6/latest/USD'); | |
| 118 | if ($res->{success}) { | |
| 119 | my $json; | |
| 120 | eval { $json = decode_json($res->{content} || '{}'); 1 } or do { $json = {}; }; | |
| 121 | my $rates = ref($json->{rates}) eq 'HASH' ? $json->{rates} : {}; | |
| 122 | if (keys %$rates) { | |
| 123 | # API returns USD->X. We need X->USD = 1 / (USD->X). | |
| 124 | %_FX_RATES = (); | |
| 125 | foreach my $code (keys %$rates) { | |
| 126 | my $r = $rates->{$code}; | |
| 127 | next unless $r && $r > 0; | |
| 128 | $_FX_RATES{uc $code} = 1 / $r; | |
| 129 | } | |
| 130 | $_FX_RATES{USD} = 1.0; | |
| 131 | $_FX_FETCHED_AT = time; | |
| 132 | return; | |
| 133 | } | |
| 134 | } | |
| 135 | # Fetch failed -- seed with the bundled fallback table. | |
| 136 | %_FX_RATES = %_FX_FALLBACK unless %_FX_RATES; | |
| 137 | $_FX_FETCHED_AT = time; | |
| 138 | } | |
| 139 | ||
| 140 | sub _convert_to_usd_cents { | |
| 141 | my ($cents, $currency) = @_; | |
| 142 | return 0 unless $cents && $cents =~ /^\d+$/; | |
| 143 | $currency = uc(defined $currency ? $currency : ''); | |
| 144 | return $cents if !$currency || $currency eq 'USD'; | |
| 145 | _fx_load(); | |
| 146 | my $rate = $_FX_RATES{$currency} // $_FX_FALLBACK{$currency}; | |
| 147 | return 0 unless $rate && $rate > 0; | |
| 148 | return int($cents * $rate + 0.5); | |
| 149 | } | |
| 150 | ||
| 151 | sub _adapter_for { | |
| 152 | my ($self, $slug) = @_; | |
| 153 | my $klass = $ADAPTERS{lc($slug || '')}; | |
| 154 | return undef unless $klass; | |
| 155 | return $klass->new($self->{ua}); | |
| 156 | } | |
| 157 | ||
| 158 | sub _slug { | |
| 159 | my $s = lc(shift // ''); | |
| 160 | $s =~ s/[^a-z0-9]+/-/g; | |
| 161 | $s =~ s/^-+|-+$//g; | |
| 162 | return substr($s, 0, 120); | |
| 163 | } | |
| 164 | ||
| 165 | # Find a slug not already taken by this user. Imported titles often | |
| 166 | # collide with prior uploads ("Cool Dragon" already exists as a | |
| 167 | # draft from last week), so we suffix -2, -3, ... until uq_models_user_slug | |
| 168 | # is happy. | |
| 169 | sub _unique_slug { | |
| 170 | my ($db, $dbh, $DB, $uid, $base) = @_; | |
| 171 | $base ||= 'imported'; | |
| 172 | my $try = $base; | |
| 173 | my $n = 1; | |
| 174 | while (1) { | |
| 175 | my $row = $db->db_readwrite($dbh, qq~ | |
| 176 | SELECT id FROM `${DB}`.models | |
| 177 | WHERE user_id='$uid' AND slug='~ . _esc($try) . qq~' | |
| 178 | LIMIT 1 | |
| 179 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 180 | return $try unless ($row && $row->{id}); | |
| 181 | $n++; | |
| 182 | $try = substr($base, 0, 115) . "-$n"; | |
| 183 | return $try if $n > 999; # give up after a thousand collisions | |
| 184 | } | |
| 185 | } | |
| 186 | ||
| 187 | # Download a URL to disk; returns { ok, path, size, ext } or { error }. | |
| 188 | # Used for cover images + best-effort file downloads. | |
| 189 | sub _download_to { | |
| 190 | my ($self, $url, $dest_path) = @_; | |
| 191 | return { error => 'no url' } unless $url; | |
| 192 | my $res = $self->{ua}->mirror($url, $dest_path); | |
| 193 | if (!$res->{success}) { | |
| 194 | return { error => "HTTP " . ($res->{status} || '?') . " " . ($res->{reason} || '') }; | |
| 195 | } | |
| 196 | my $size = -s $dest_path; | |
| 197 | return { error => 'empty response' } unless $size && $size > 0; | |
| 198 | my $ext = ''; | |
| 199 | $ext = lc($1) if $dest_path =~ /\.([a-z0-9]{2,5})$/i; | |
| 200 | return { ok => 1, path => $dest_path, size => $size, ext => $ext }; | |
| 201 | } | |
| 202 | ||
| 203 | # Has marketplace_accounts table arrived yet on this install? | |
| 204 | sub _has_accounts_table { | |
| 205 | my ($self, $db, $dbh, $DB) = @_; | |
| 206 | my $r = $db->db_readwrite($dbh, qq~ | |
| 207 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 208 | WHERE table_schema='$DB' AND table_name='marketplace_accounts' | |
| 209 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 210 | return ($r && $r->{n}) ? 1 : 0; | |
| 211 | } | |
| 212 | ||
| 213 | # Are the source_platform / source_external_id columns on models | |
| 214 | # present yet? Without them we'd lose the dedup signal across re-runs, | |
| 215 | # so we refuse to import until the migration is run. | |
| 216 | sub _has_source_columns { | |
| 217 | my ($self, $db, $dbh, $DB) = @_; | |
| 218 | my $r = $db->db_readwrite($dbh, qq~ | |
| 219 | SELECT COUNT(*) AS n FROM information_schema.columns | |
| 220 | WHERE table_schema='$DB' AND table_name='models' | |
| 221 | AND column_name='source_external_id' | |
| 222 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 223 | return ($r && $r->{n}) ? 1 : 0; | |
| 224 | } | |
| 225 | ||
| 226 | # Storefront id for this user. Imports land on the seller's storefront | |
| 227 | # the same way native uploads do once published, but draft imports | |
| 228 | # don't auto-list (mirrors upload.cgi behavior). | |
| 229 | sub _storefront_for { | |
| 230 | my ($self, $db, $dbh, $DB, $uid) = @_; | |
| 231 | my $r = $db->db_readwrite($dbh, qq~ | |
| 232 | SELECT id FROM `${DB}`.storefronts WHERE user_id='$uid' LIMIT 1 | |
| 233 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 234 | return ($r && $r->{id}) ? $r->{id} : 0; | |
| 235 | } | |
| 236 | ||
| 237 | #------------------------------------------------------------------- | |
| 238 | # Manual paste-import. For platforms (e.g. Best Buy) behind Cloudflare | |
| 239 | # bot protection that plain HTTP can't pass. The user pastes a list of | |
| 240 | # their model URLs (one per line) and we create draft rows from those. | |
| 241 | # | |
| 242 | # Differences from import_for_user: | |
| 243 | # - No HTTP fetch at all -- we only parse the strings the user gives. | |
| 244 | # - No images / files (we can't reach the platform to download them). | |
| 245 | # - title is derived from the URL slug; user fills the rest in via | |
| 246 | # the normal draft-edit flow. | |
| 247 | # - Dedup still applies via source_platform + source_external_id. | |
| 248 | #------------------------------------------------------------------- | |
| 249 | sub import_manual_for_user { | |
| 250 | my ($self, $db, $dbh, $DB, $uid, $slug, $urls_text) = @_; | |
| 251 | $uid = '' unless defined $uid; | |
| 252 | $uid =~ s/[^0-9]//g; | |
| 253 | return { ok => 0, error => 'bad_user' } unless length $uid; | |
| 254 | $slug = lc($slug || ''); $slug =~ s/[^a-z0-9]//g; | |
| 255 | return { ok => 0, error => 'bad_platform' } unless length $slug; | |
| 256 | ||
| 257 | return { ok => 0, error => 'no_accounts_table' } | |
| 258 | unless $self->_has_accounts_table($db, $dbh, $DB); | |
| 259 | return { ok => 0, error => 'no_source_columns' } | |
| 260 | unless $self->_has_source_columns($db, $dbh, $DB); | |
| 261 | ||
| 262 | # We don't require an adapter for manual mode -- the platform might | |
| 263 | # be 100% Cloudflare-blocked (Best Buy). We do still require the user | |
| 264 | # to be "connected" so the tile state stays consistent. | |
| 265 | my $acct = $db->db_readwrite($dbh, qq~ | |
| 266 | SELECT id, platform, status FROM `${DB}`.marketplace_accounts | |
| 267 | WHERE user_id='$uid' AND platform='~ . _esc($slug) . qq~' | |
| 268 | LIMIT 1 | |
| 269 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 270 | return { ok => 0, error => 'not_connected' } | |
| 271 | unless $acct && $acct->{id} && ($acct->{status} || '') eq 'connected'; | |
| 272 | ||
| 273 | # Parse the textarea: one URL per line, skip blanks/comments. | |
| 274 | my @lines = split /\r?\n/, ($urls_text || ''); | |
| 275 | my @urls; | |
| 276 | foreach my $line (@lines) { | |
| 277 | $line =~ s/^\s+|\s+$//g; | |
| 278 | next unless length $line; | |
| 279 | next if $line =~ /^#/; | |
| 280 | # Be forgiving: accept "https://..." or "thangs.com/..." or just | |
| 281 | # the path portion. Normalize to a full URL. | |
| 282 | my $u = $line; | |
| 283 | $u = "https://$u" if $u =~ m{^[a-z0-9.\-]+\.[a-z]{2,}/}i && $u !~ m{^https?://}; | |
| 284 | push @urls, $u if $u =~ m{^https?://}i; | |
| 285 | } | |
| 286 | return { ok => 0, error => 'no_urls' } unless @urls; | |
| 287 | ||
| 288 | my $sid = $self->_storefront_for($db, $dbh, $DB, $uid); | |
| 289 | my $imported = 0; | |
| 290 | my $skipped = 0; | |
| 291 | my @errors; | |
| 292 | ||
| 293 | foreach my $url (@urls) { | |
| 294 | # Pull the last non-empty path segment as the external id / | |
| 295 | # slug. Works for /3d-model/<slug>, /m/<id>, /model/<slug>, etc. | |
| 296 | my $external_id = ''; | |
| 297 | if ($url =~ m{://[^/]+/(.+?)(?:[?#]|$)}) { | |
| 298 | my $path = $1; | |
| 299 | $path =~ s{/$}{}; | |
| 300 | my @segs = split m{/}, $path; | |
| 301 | $external_id = $segs[-1] if @segs; | |
| 302 | } | |
| 303 | # URL-decode BEFORE sanitizing. Otherwise "%20" in a Best Buy slug | |
| 304 | # like "Inspired%20by%20GoBots" survives as the literal chars | |
| 305 | # "20" embedded in the slug, and the humanized title comes out | |
| 306 | # as "Inspired 20By 20Gobots" -- ugly and wrong. | |
| 307 | $external_id =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/ge; | |
| 308 | $external_id =~ s/[^A-Za-z0-9._\-]/_/g; | |
| 309 | unless (length $external_id) { | |
| 310 | push @errors, "skipped (no slug): $url"; | |
| 311 | next; | |
| 312 | } | |
| 313 | ||
| 314 | # Dedup on (user_id, source_platform, source_external_id) BUT | |
| 315 | # only against active rows -- trashed / archived / purged rows | |
| 316 | # are treated as gone so the user can delete-and-re-pull. | |
| 317 | my $ext_sql = _esc($external_id); | |
| 318 | my $dup = $db->db_readwrite($dbh, qq~ | |
| 319 | SELECT id FROM `${DB}`.models | |
| 320 | WHERE user_id='$uid' | |
| 321 | AND source_platform='~ . _esc($slug) . qq~' | |
| 322 | AND source_external_id='$ext_sql' | |
| 323 | AND purged_at IS NULL | |
| 324 | AND status NOT IN ('removed','archived') | |
| 325 | LIMIT 1 | |
| 326 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 327 | if ($dup && $dup->{id}) { $skipped++; next; } | |
| 328 | ||
| 329 | # Humanize the slug into a title: "cool-thing-1234" -> "Cool | |
| 330 | # Thing 1234". User can rewrite when they edit the draft. | |
| 331 | my $title = $external_id; | |
| 332 | $title =~ s/[-_]/ /g; | |
| 333 | $title =~ s/\b(\w)/\U$1/g; | |
| 334 | ||
| 335 | my $base_slug = _slug($external_id); | |
| 336 | $base_slug = 'imported' unless length $base_slug; | |
| 337 | my $slug_local = _unique_slug($db, $dbh, $DB, $uid, $base_slug); | |
| 338 | ||
| 339 | my $title_sql = _esc($title); | |
| 340 | my $slug_sql = _esc($slug_local); | |
| 341 | my $permalink_sql = _esc($url); | |
| 342 | ||
| 343 | $db->db_readwrite($dbh, qq~ | |
| 344 | INSERT INTO `${DB}`.models SET | |
| 345 | user_id = '$uid', | |
| 346 | title = '$title_sql', | |
| 347 | slug = '$slug_sql', | |
| 348 | tagline = '', | |
| 349 | description = '', | |
| 350 | base_price_cents = '0', | |
| 351 | currency = 'USD', | |
| 352 | status = 'draft', | |
| 353 | visibility = 'private', | |
| 354 | source_platform = '~ . _esc($slug) . qq~', | |
| 355 | source_external_id = '$ext_sql', | |
| 356 | source_url = '$permalink_sql', | |
| 357 | created_at = NOW(), | |
| 358 | updated_at = NOW() | |
| 359 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 360 | ||
| 361 | $imported++; | |
| 362 | } | |
| 363 | ||
| 364 | $db->db_readwrite($dbh, qq~ | |
| 365 | UPDATE `${DB}`.marketplace_accounts | |
| 366 | SET last_used_at=NOW(), last_error=NULL | |
| 367 | WHERE id='$acct->{id}' | |
| 368 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 369 | ||
| 370 | return { | |
| 371 | ok => 1, | |
| 372 | imported => $imported, | |
| 373 | skipped => $skipped, | |
| 374 | errors => \@errors, | |
| 375 | }; | |
| 376 | } | |
| 377 | ||
| 378 | #------------------------------------------------------------------- | |
| 379 | # Public entry point. | |
| 380 | #------------------------------------------------------------------- | |
| 381 | sub import_for_user { | |
| 382 | my ($self, $db, $dbh, $DB, $uid, $slug) = @_; | |
| 383 | $uid = '' unless defined $uid; | |
| 384 | $uid =~ s/[^0-9]//g; | |
| 385 | return { ok => 0, error => 'bad_user' } unless length $uid; | |
| 386 | $slug = lc($slug || ''); $slug =~ s/[^a-z0-9]//g; | |
| 387 | return { ok => 0, error => 'bad_platform' } unless length $slug; | |
| 388 | ||
| 389 | return { ok => 0, error => 'no_accounts_table' } | |
| 390 | unless $self->_has_accounts_table($db, $dbh, $DB); | |
| 391 | return { ok => 0, error => 'no_source_columns' } | |
| 392 | unless $self->_has_source_columns($db, $dbh, $DB); | |
| 393 | ||
| 394 | my $adapter = $self->_adapter_for($slug); | |
| 395 | return { ok => 0, error => 'no_adapter' } unless $adapter; | |
| 396 | ||
| 397 | # Load the connected account row. | |
| 398 | my $acct = $db->db_readwrite($dbh, qq~ | |
| 399 | SELECT id, platform, access_token, account_handle, metadata, status | |
| 400 | FROM `${DB}`.marketplace_accounts | |
| 401 | WHERE user_id='$uid' AND platform='~ . _esc($slug) . qq~' | |
| 402 | LIMIT 1 | |
| 403 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 404 | return { ok => 0, error => 'not_connected' } | |
| 405 | unless $acct && $acct->{id} && ($acct->{status} || '') eq 'connected'; | |
| 406 | # NOTE: access_token presence is checked by the adapter's | |
| 407 | # is_configured() -- scrape-based adapters (Amazon) only need the | |
| 408 | # account_handle, while API-based adapters need both. | |
| 409 | return { ok => 0, error => 'not_configured_for_adapter' } | |
| 410 | unless $adapter->is_configured($acct); | |
| 411 | ||
| 412 | # Pull the creation list from the platform. | |
| 413 | my $result = eval { $adapter->fetch_creations({ account => $acct, ua => $self->{ua} }) }; | |
| 414 | if ($@) { return { ok => 0, error => "fetch_died: $@" }; } | |
| 415 | return $result if ref($result) eq 'HASH' && $result->{error}; | |
| 416 | ||
| 417 | my @items = ref($result) eq 'ARRAY' ? @$result : (); | |
| 418 | return { ok => 1, imported => 0, skipped => 0, total_available => 0, errors => [], note => 'no_creations_returned' } | |
| 419 | unless @items; | |
| 420 | my $total_available = scalar @items; | |
| 421 | ||
| 422 | my $sid = $self->_storefront_for($db, $dbh, $DB, $uid); | |
| 423 | ||
| 424 | my $imported = 0; | |
| 425 | my $skipped = 0; | |
| 426 | my @errors; | |
| 427 | ||
| 428 | # Per-call cap: each Pull only inserts up to this many NEW models | |
| 429 | # before stopping early. History: | |
| 430 | # 25 -> 15 (added detail-page enrichment, ~3x per-model cost) | |
| 431 | # 15 -> 5 (still tripped 504 on models with large galleries) | |
| 432 | # 5 -> 3 (still tripped 504 -- Amazon CDN can be slow enough | |
| 433 | # that 3 models with full galleries blow past 60s) | |
| 434 | # 3 -> 1 (one model per HTTP request -- bulletproof; the auto- | |
| 435 | # loop in the banner just runs more iterations. ~12s | |
| 436 | # per round trip × 60 models = ~12 min for a full | |
| 437 | # library, but it NEVER times out mid-flight.) | |
| 438 | my $MAX_PER_CALL = 1; | |
| 439 | my $more_available = 0; | |
| 440 | ||
| 441 | # Adapter-specific enrichment hook. Adapters that implement | |
| 442 | # enrich_one() get a callback per-creation right before insert, so | |
| 443 | # they can fetch detail-page data only for the models that survive | |
| 444 | # dedup (cheaper than enriching everything up front). | |
| 445 | my $can_enrich = $adapter->can('enrich_one') ? 1 : 0; | |
| 446 | ||
| 447 | foreach my $c (@items) { | |
| 448 | next unless $c && $c->{external_id}; | |
| 449 | ||
| 450 | if ($imported >= $MAX_PER_CALL) { | |
| 451 | $more_available = 1; | |
| 452 | last; | |
| 453 | } | |
| 454 | ||
| 455 | my $ext_id = _esc($c->{external_id}); | |
| 456 | # Dedup: skip if we already imported this exact creation AND it | |
| 457 | # still exists as an active model row. Trashed (status='removed'), | |
| 458 | # archived, or purged rows are treated as gone -- re-import | |
| 459 | # creates a fresh draft so "delete from RePricer, re-pull from | |
| 460 | # the platform" works the way users expect. _unique_slug below | |
| 461 | # finds a non-colliding slug if the old row's slug is still | |
| 462 | # taken in the unique index. | |
| 463 | my $dup = $db->db_readwrite($dbh, qq~ | |
| 464 | SELECT id FROM `${DB}`.models | |
| 465 | WHERE user_id='$uid' | |
| 466 | AND source_platform='~ . _esc($slug) . qq~' | |
| 467 | AND source_external_id='$ext_id' | |
| 468 | AND purged_at IS NULL | |
| 469 | AND status NOT IN ('removed','archived') | |
| 470 | LIMIT 1 | |
| 471 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 472 | if ($dup && $dup->{id}) { $skipped++; next; } | |
| 473 | ||
| 474 | # Enrich the creation with detail-page data (description, | |
| 475 | # hi-res hero image, gallery, tags). Only runs for models that | |
| 476 | # pass dedup -- no point fetching detail for the 50 we'd skip. | |
| 477 | # Failures are swallowed; the model still imports with the | |
| 478 | # listing-page data alone. | |
| 479 | if ($can_enrich) { | |
| 480 | eval { $adapter->enrich_one($c); 1 }; | |
| 481 | } | |
| 482 | ||
| 483 | my $title = $c->{title} || 'Imported model'; | |
| 484 | my $description = $c->{description} || ''; | |
| 485 | my $tagline = substr($description, 0, 180); # short version for cards | |
| 486 | my $category = $c->{category} || ''; | |
| 487 | my $price_cents = ($c->{price_cents} && $c->{price_cents} =~ /^\d+$/) ? $c->{price_cents} : 0; | |
| 488 | my $currency = ($c->{currency} && $c->{currency} =~ /^[A-Z]{3}$/) ? $c->{currency} : 'USD'; | |
| 489 | ||
| 490 | # We always store prices in USD on our side regardless of the | |
| 491 | # source platform's currency. Convert here so the rest of the | |
| 492 | # platform (storefront cards, listing detail, sales reports, | |
| 493 | # checkout) can assume USD without per-row currency logic. | |
| 494 | if ($currency ne 'USD' && $price_cents > 0) { | |
| 495 | my $usd_cents = _convert_to_usd_cents($price_cents, $currency); | |
| 496 | if ($usd_cents > 0) { | |
| 497 | $price_cents = $usd_cents; | |
| 498 | $currency = 'USD'; | |
| 499 | } | |
| 500 | } | |
| 501 | ||
| 502 | my $permalink = $c->{permalink} || ''; | |
| 503 | ||
| 504 | my $base_slug = _slug($c->{slug} || $title); | |
| 505 | $base_slug = 'imported' unless length $base_slug; | |
| 506 | my $slug_local = _unique_slug($db, $dbh, $DB, $uid, $base_slug); | |
| 507 | ||
| 508 | my $title_sql = _esc($title); | |
| 509 | my $description_sql = _esc($description); | |
| 510 | my $tagline_sql = _esc($tagline); | |
| 511 | my $slug_sql = _esc($slug_local); | |
| 512 | my $permalink_sql = _esc($permalink); | |
| 513 | my $category_sql = _esc(substr($category, 0, 80)); | |
| 514 | ||
| 515 | $db->db_readwrite($dbh, qq~ | |
| 516 | INSERT INTO `${DB}`.models SET | |
| 517 | user_id = '$uid', | |
| 518 | title = '$title_sql', | |
| 519 | slug = '$slug_sql', | |
| 520 | tagline = '$tagline_sql', | |
| 521 | description = '$description_sql', | |
| 522 | base_price_cents = '$price_cents', | |
| 523 | currency = '$currency', | |
| 524 | category = '$category_sql', | |
| 525 | status = 'draft', | |
| 526 | visibility = 'private', | |
| 527 | source_platform = '~ . _esc($slug) . qq~', | |
| 528 | source_external_id = '$ext_id', | |
| 529 | source_url = '$permalink_sql', | |
| 530 | created_at = NOW(), | |
| 531 | updated_at = NOW() | |
| 532 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 533 | ||
| 534 | my $row = $db->db_readwrite($dbh, qq~ | |
| 535 | SELECT id FROM `${DB}`.models | |
| 536 | WHERE user_id='$uid' AND slug='$slug_sql' | |
| 537 | ORDER BY id DESC LIMIT 1 | |
| 538 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 539 | my $model_id = ($row && $row->{id}) ? $row->{id} : 0; | |
| 540 | unless ($model_id) { | |
| 541 | push @errors, "insert failed for '$title'"; | |
| 542 | next; | |
| 543 | } | |
| 544 | ||
| 545 | # Filesystem layout matches upload.cgi save_uploaded_files so | |
| 546 | # img.cgi / models.cgi / the storefront keep finding them. | |
| 547 | my $store_dir = "$BASE_DIR/models/$sid"; | |
| 548 | my $dest_dir = "$store_dir/$model_id"; | |
| 549 | foreach my $d ("$BASE_DIR", "$BASE_DIR/models", $store_dir, $dest_dir) { | |
| 550 | unless (-d $d) { mkdir $d, 0755; } | |
| 551 | } | |
| 552 | ||
| 553 | # ---- Cover + gallery images ---- | |
| 554 | # Build a single ordered list: cover first (sort_order=0, | |
| 555 | # is_primary=1, type=hero), then any gallery images from the | |
| 556 | # detail page (sort_order=N, type=gallery). model_images is | |
| 557 | # the canonical store; we also set models.hero_image_url to | |
| 558 | # /img.cgi?m=<first image id> so cards and storefront render. | |
| 559 | my @image_urls; | |
| 560 | push @image_urls, $c->{hero_image_url} if $c->{hero_image_url}; | |
| 561 | if (ref($c->{gallery_image_urls}) eq 'ARRAY') { | |
| 562 | foreach my $g (@{ $c->{gallery_image_urls} }) { | |
| 563 | next unless $g && $g ne ($c->{hero_image_url} || ''); | |
| 564 | push @image_urls, $g; | |
| 565 | } | |
| 566 | } | |
| 567 | ||
| 568 | # Walk the image list, downloading each one. The FIRST SUCCESS- | |
| 569 | # FULLY downloaded image is promoted to hero (is_primary=1, | |
| 570 | # type=hero) and we set models.hero_image_url to point at it. | |
| 571 | # The old version used "first attempted" -- if the Amazon CDN | |
| 572 | # 404'd the cover but a gallery image succeeded, the model | |
| 573 | # ended up with downloaded images but a NULL hero_image_url, | |
| 574 | # so My Models / storefront cards rendered the "NO COVER YET" | |
| 575 | # placeholder. | |
| 576 | my $order = 0; | |
| 577 | my $promoted_to_hero = 0; | |
| 578 | foreach my $iurl (@image_urls) { | |
| 579 | my $img_ext = 'jpg'; | |
| 580 | $img_ext = lc($1) if $iurl =~ /\.(jpe?g|png|webp|gif)(?:\?|$)/i; | |
| 581 | $img_ext = 'jpg' if $img_ext eq 'jpeg'; | |
| 582 | my $id_part = substr(sha256_hex($iurl . $model_id . $order . time()), 0, 16); | |
| 583 | my $dest_name = "$id_part.$img_ext"; | |
| 584 | my $dest_path = "$dest_dir/$dest_name"; | |
| 585 | my $dl = $self->_download_to($iurl, $dest_path); | |
| 586 | unless ($dl->{ok}) { | |
| 587 | push @errors, "$title: image " . ($order + 1) . " -- " . $dl->{error}; | |
| 588 | $order++; | |
| 589 | next; | |
| 590 | } | |
| 591 | my $rel_key = "uploads/models/$sid/$model_id/$dest_name"; | |
| 592 | my $rel_sql = _esc($rel_key); | |
| 593 | my $is_first_success = $promoted_to_hero ? 0 : 1; | |
| 594 | my $itype = $is_first_success ? 'hero' : 'gallery'; | |
| 595 | my $is_primary = $is_first_success ? 1 : 0; | |
| 596 | $db->db_readwrite($dbh, qq~ | |
| 597 | INSERT INTO `${DB}`.model_images SET | |
| 598 | model_id = '$model_id', | |
| 599 | image_type = '$itype', | |
| 600 | storage_key = '$rel_sql', | |
| 601 | sort_order = '$order', | |
| 602 | is_primary = '$is_primary', | |
| 603 | created_at = NOW() | |
| 604 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 605 | if ($is_first_success) { | |
| 606 | my $ir = $db->db_readwrite($dbh, qq~ | |
| 607 | SELECT id FROM `${DB}`.model_images | |
| 608 | WHERE model_id='$model_id' AND storage_key='$rel_sql' | |
| 609 | ORDER BY id DESC LIMIT 1 | |
| 610 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 611 | if ($ir && $ir->{id}) { | |
| 612 | my $url = "/img.cgi?m=$ir->{id}"; | |
| 613 | $db->db_readwrite($dbh, qq~ | |
| 614 | UPDATE `${DB}`.models | |
| 615 | SET hero_image_url='$url' | |
| 616 | WHERE id='$model_id' LIMIT 1 | |
| 617 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 618 | $promoted_to_hero = 1; | |
| 619 | } | |
| 620 | } | |
| 621 | $order++; | |
| 622 | } | |
| 623 | ||
| 624 | # ---- Tags ---- | |
| 625 | # Detail-page enrichment populates $c->{tags} as a comma- | |
| 626 | # separated string (e.g. "gobot,gobots,toy,1980s"). Each one | |
| 627 | # becomes a model_tags row. INSERT IGNORE skips duplicates if | |
| 628 | # the platform sent the same tag twice. | |
| 629 | if ($c->{tags}) { | |
| 630 | foreach my $tag (split /,/, $c->{tags}) { | |
| 631 | $tag =~ s/^\s+|\s+$//g; | |
| 632 | next unless length $tag; | |
| 633 | next if length($tag) > 64; | |
| 634 | my $tag_sql = _esc($tag); | |
| 635 | $db->db_readwrite($dbh, qq~ | |
| 636 | INSERT IGNORE INTO `${DB}`.model_tags | |
| 637 | SET model_id='$model_id', tag='$tag_sql' | |
| 638 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 639 | } | |
| 640 | } | |
| 641 | ||
| 642 | # ---- Model files (best-effort) ---- | |
| 643 | # Platforms gate file downloads behind purchase tokens for paid | |
| 644 | # creations, so plenty of these will 403. Each failure becomes | |
| 645 | # one line in the errors report; the draft row still survives. | |
| 646 | my $files = $c->{file_urls}; | |
| 647 | if (ref($files) eq 'ARRAY') { | |
| 648 | foreach my $f (@$files) { | |
| 649 | next unless $f && $f->{url}; | |
| 650 | my $orig = $f->{name} || 'file.stl'; | |
| 651 | $orig =~ s/.*[\\\/]//; | |
| 652 | $orig =~ s/[^A-Za-z0-9._-]/_/g; | |
| 653 | my $ext = 'stl'; | |
| 654 | $ext = lc($1) if $orig =~ /\.(stl|obj|step|stp|3mf|zip|rar)$/i; | |
| 655 | my $id_part = substr(sha256_hex($f->{url} . $model_id . time() . rand()), 0, 16); | |
| 656 | my $dest_name = "$id_part.$ext"; | |
| 657 | my $dest_path = "$dest_dir/$dest_name"; | |
| 658 | my $dl = $self->_download_to($f->{url}, $dest_path); | |
| 659 | if ($dl->{ok}) { | |
| 660 | my $rel_key = "uploads/models/$sid/$model_id/$dest_name"; | |
| 661 | my $rel_sql = _esc($rel_key); | |
| 662 | my $orig_sql = _esc($orig); | |
| 663 | my $size_n = $dl->{size} + 0; | |
| 664 | $db->db_readwrite($dbh, qq~ | |
| 665 | INSERT INTO `${DB}`.model_files SET | |
| 666 | model_id = '$model_id', | |
| 667 | filename = '$orig_sql', | |
| 668 | file_type = '$ext', | |
| 669 | file_size_bytes = '$size_n', | |
| 670 | storage_provider = 'local', | |
| 671 | storage_key = '$rel_sql', | |
| 672 | checksum_sha256 = '~ . ('0' x 64) . qq~', | |
| 673 | scan_status = 'pending', | |
| 674 | uploaded_at = NOW() | |
| 675 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 676 | } else { | |
| 677 | push @errors, "$title: $orig -- " . $dl->{error}; | |
| 678 | } | |
| 679 | } | |
| 680 | } | |
| 681 | ||
| 682 | $imported++; | |
| 683 | } | |
| 684 | ||
| 685 | # Account bookkeeping (last_used_at / last_error on marketplace_accounts). | |
| 686 | $db->db_readwrite($dbh, qq~ | |
| 687 | UPDATE `${DB}`.marketplace_accounts | |
| 688 | SET last_used_at=NOW(), last_error=NULL | |
| 689 | WHERE id='$acct->{id}' | |
| 690 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 691 | ||
| 692 | return { | |
| 693 | ok => 1, | |
| 694 | imported => $imported, | |
| 695 | skipped => $skipped, | |
| 696 | total_available => $total_available, | |
| 697 | errors => \@errors, | |
| 698 | more_available => $more_available, | |
| 699 | }; | |
| 700 | } | |
| 701 | ||
| 702 | ||
| 703 | # ===================================================================== | |
| 704 | # Amazon adapter | |
| 705 | # ===================================================================== | |
| 706 | # This adapter scrapes the seller's PUBLIC profile page at | |
| 707 | # https://cults3d.com/en/users/<URL handle>/3d-models | |
| 708 | # rather than calling Amazon's GraphQL API. Reasons: | |
| 709 | # - Amazon's GraphQL credentials are not self-service; sellers have | |
| 710 | # to request them via the platform's Discord #api-help channel. | |
| 711 | # - The public profile lists every creation the seller has published, | |
| 712 | # which is exactly what "Pull in your models" needs. | |
| 713 | # - Amazon explicitly says the API does not allow direct file | |
| 714 | # downloads anyway ("files remain hosted on Cults for legal | |
| 715 | # reasons"), so the GraphQL path wouldn't have given us STLs. | |
| 716 | # | |
| 717 | # Auth: NONE. We only fetch the seller's own public profile pages, so | |
| 718 | # marketplace_accounts.access_token is ignored by this adapter (the | |
| 719 | # field is still stored against future push-side adapters that need | |
| 720 | # real Amazon API creds). | |
| 721 | # ===================================================================== | |
| 722 | package MODS::RePricer::ImportAdapters::Amazon; | |
| 723 | use strict; | |
| 724 | use warnings; | |
| 725 | use JSON::PP; | |
| 726 | use MIME::Base64 qw(encode_base64); | |
| 727 | ||
| 728 | my $BASE_URL = 'https://cults3d.com'; | |
| 729 | my $MAX_PAGES = 20; # safety stop -- 20 paginated GraphQL batches | |
| 730 | ||
| 731 | sub new { my $c = shift; return bless { ua => shift }, $c; } | |
| 732 | ||
| 733 | # Tiny HTML entity decoder for og:description / title content. Only | |
| 734 | # covers the common ones; Amazon's text is plain enough that this is | |
| 735 | # sufficient. | |
| 736 | sub _html_decode { | |
| 737 | my $s = shift; $s = '' unless defined $s; | |
| 738 | $s =~ s/&/&/g; | |
| 739 | $s =~ s/"/"/g; | |
| 740 | $s =~ s/'/'/g; | |
| 741 | $s =~ s/'/'/g; | |
| 742 | $s =~ s/</</g; | |
| 743 | $s =~ s/>/>/g; | |
| 744 | $s =~ s/ / /g; | |
| 745 | $s =~ s/&#(\d+);/chr($1)/ge; | |
| 746 | return $s; | |
| 747 | } | |
| 748 | ||
| 749 | # API mode. We need account_handle (= Amazon username, used as the | |
| 750 | # Basic-auth username) AND access_token (= API key from | |
| 751 | # cults3d.com/en/api/keys). The legacy HTML-scrape path required only | |
| 752 | # the handle; the GraphQL path needs both. | |
| 753 | sub is_configured { | |
| 754 | my ($self, $acct) = @_; | |
| 755 | return ($acct && $acct->{account_handle} && $acct->{access_token}) ? 1 : 0; | |
| 756 | } | |
| 757 | ||
| 758 | # Fetch one URL with a polite User-Agent. Returns body string or undef. | |
| 759 | # Kept around for any future need to download images by URL (the API | |
| 760 | # returns image URLs but doesn't pipe the bytes through). | |
| 761 | sub _get { | |
| 762 | my ($self, $url) = @_; | |
| 763 | my $res = $self->{ua}->request('GET', $url, { | |
| 764 | headers => { | |
| 765 | 'Accept' => 'text/html,application/xhtml+xml', | |
| 766 | 'Accept-Language' => 'en-US,en;q=0.9', | |
| 767 | }, | |
| 768 | }); | |
| 769 | return undef unless $res->{success}; | |
| 770 | return $res->{content}; | |
| 771 | } | |
| 772 | ||
| 773 | # POST a GraphQL query to the Amazon endpoint with HTTP Basic auth. | |
| 774 | # Returns ($data, undef) on success or (undef, $err_string) on failure. | |
| 775 | # The Amazon API returns 200 with `{"errors":[...]}` for query errors, | |
| 776 | # so we check both transport-level and GraphQL-level failures. | |
| 777 | sub _graphql { | |
| 778 | my ($self, $handle, $token, $query, $variables) = @_; | |
| 779 | my $payload = encode_json({ | |
| 780 | query => $query, | |
| 781 | variables => $variables || {}, | |
| 782 | }); | |
| 783 | my $basic = encode_base64("$handle:$token", ''); | |
| 784 | my $res = $self->{ua}->request('POST', "$BASE_URL/graphql", { | |
| 785 | headers => { | |
| 786 | 'Authorization' => "Basic $basic", | |
| 787 | 'Content-Type' => 'application/json', | |
| 788 | 'Accept' => 'application/json', | |
| 789 | }, | |
| 790 | content => $payload, | |
| 791 | }); | |
| 792 | unless ($res->{success}) { | |
| 793 | my $status = $res->{status} || '?'; | |
| 794 | my $reason = $res->{reason} || ''; | |
| 795 | my $body = $res->{content} || ''; | |
| 796 | # Surface 401/403 explicitly so the seller knows it's an auth | |
| 797 | # issue (wrong username / expired key) vs a connectivity blip. | |
| 798 | if ($status == 401 || $status == 403) { | |
| 799 | return (undef, "Amazon API rejected the credentials (HTTP $status). Re-check the username (Amazon URL handle, case-sensitive) and the API key from cults3d.com/en/api/keys."); | |
| 800 | } | |
| 801 | if ($status == 429) { | |
| 802 | return (undef, "Amazon API rate limit hit (HTTP 429). Their cap is roughly 60 requests / 30 seconds and 500 / day -- wait a moment and re-run."); | |
| 803 | } | |
| 804 | my $snippet = substr($body, 0, 200); | |
| 805 | return (undef, "Amazon API HTTP $status $reason. Body: $snippet"); | |
| 806 | } | |
| 807 | my $json; | |
| 808 | eval { $json = decode_json($res->{content} || '{}'); 1 } or do { | |
| 809 | return (undef, "Amazon API returned non-JSON response. Body: " . substr($res->{content} || '', 0, 200)); | |
| 810 | }; | |
| 811 | if (ref($json->{errors}) eq 'ARRAY' && @{ $json->{errors} }) { | |
| 812 | my @msgs = map { $_->{message} || 'unknown error' } @{ $json->{errors} }; | |
| 813 | return (undef, "Amazon GraphQL error: " . join(' | ', @msgs)); | |
| 814 | } | |
| 815 | return ($json->{data} || {}, undef); | |
| 816 | } | |
| 817 | ||
| 818 | # Pull every creation off the seller's public profile. Returns the | |
| 819 | # arrayref of normalized hashes the dispatcher in | |
| 820 | # MODS::RePricer::ImportAdapters expects, or { error => '...' } on a | |
| 821 | # fatal failure (e.g. handle 404s). | |
| 822 | sub fetch_creations { | |
| 823 | my ($self, $ctx) = @_; | |
| 824 | my $acct = $ctx->{account}; | |
| 825 | return { error => 'not_configured' } unless $self->is_configured($acct); | |
| 826 | ||
| 827 | my $handle = $acct->{account_handle} || ''; | |
| 828 | my $token = $acct->{access_token} || ''; | |
| 829 | return { error => 'no_handle' } unless length $handle; | |
| 830 | return { error => "Amazon API key missing. Generate one at cults3d.com/en/api/keys and paste it into the Amazon connection settings -- the GraphQL API requires it." } | |
| 831 | unless length $token; | |
| 832 | ||
| 833 | # Stash the account so enrich_one() (called per-model right before | |
| 834 | # insert) can reuse the same credentials without the dispatcher | |
| 835 | # threading them through. | |
| 836 | $self->{_last_acct} = $acct; | |
| 837 | ||
| 838 | # Amazon's GraphQL API exposes the authenticated user's creations | |
| 839 | # via myself.creationsBatch(limit, offset). We page in batches of | |
| 840 | # 50 and stop when results.length < limit (last page). | |
| 841 | my $per_page = 50; | |
| 842 | my $offset = 0; | |
| 843 | my %seen; | |
| 844 | my @out; | |
| 845 | for (my $i = 0; $i < $MAX_PAGES; $i++) { | |
| 846 | my $query = <<"GQL"; | |
| 847 | { | |
| 848 | myself { | |
| 849 | creationsBatch(limit: $per_page, offset: $offset) { | |
| 850 | total | |
| 851 | results { | |
| 852 | identifier | |
| 853 | name(locale: EN) | |
| 854 | url(locale: EN) | |
| 855 | illustrationImageUrl | |
| 856 | tags(locale: EN) | |
| 857 | visibility | |
| 858 | } | |
| 859 | } | |
| 860 | } | |
| 861 | } | |
| 862 | GQL | |
| 863 | my ($data, $err) = $self->_graphql($handle, $token, $query); | |
| 864 | return { error => $err } if $err; | |
| 865 | ||
| 866 | my $batch = ($data && $data->{myself} && $data->{myself}{creationsBatch}) | |
| 867 | || { results => [] }; | |
| 868 | my $results = $batch->{results} || []; | |
| 869 | last unless ref($results) eq 'ARRAY' && @$results; | |
| 870 | ||
| 871 | foreach my $c (@$results) { | |
| 872 | my $id = $c->{identifier}; | |
| 873 | next unless defined $id && length $id; | |
| 874 | next if $seen{$id}++; | |
| 875 | # Skip creations the seller hid on Amazon. Their | |
| 876 | # CreationVisibilityEnum has three values: | |
| 877 | # PUBLIC -- live on cults3d.com (we want these) | |
| 878 | # DEACTIVATED -- the "OFFLINE" tag in their UI; seller | |
| 879 | # pulled it from the marketplace | |
| 880 | # SECRET -- unlisted / private link only; seller | |
| 881 | # explicitly chose not to make it public | |
| 882 | # Importing DEACTIVATED or SECRET would silently re-surface | |
| 883 | # work the seller deliberately took down. | |
| 884 | my $vis = uc($c->{visibility} || ''); | |
| 885 | next if $vis eq 'DEACTIVATED' || $vis eq 'SECRET'; | |
| 886 | # Pull a category slug out of the URL for the draft. The | |
| 887 | # url field looks like https://cults3d.com/en/3d-model/<cat>/<slug> | |
| 888 | my $url = $c->{url} || ''; | |
| 889 | my $cat_slug = ''; | |
| 890 | my $slug = ''; | |
| 891 | if ($url =~ m{/3d-model/([^/]+)/([^/?#]+)}) { | |
| 892 | $cat_slug = $1; | |
| 893 | $slug = $2; | |
| 894 | } | |
| 895 | my $title = $c->{name} || $slug || 'Imported model'; | |
| 896 | $title =~ s/^\s+|\s+$//g; | |
| 897 | ||
| 898 | # Tags(locale: EN) returns an array of strings. | |
| 899 | my $tags = ''; | |
| 900 | if (ref($c->{tags}) eq 'ARRAY') { | |
| 901 | my %seen_tag; | |
| 902 | my @t; | |
| 903 | foreach my $name (@{ $c->{tags} }) { | |
| 904 | next unless defined $name && length $name; | |
| 905 | my $clean = $name; $clean =~ s/^\s+|\s+$//g; | |
| 906 | next if $seen_tag{lc $clean}++; | |
| 907 | push @t, $clean; | |
| 908 | last if @t >= 20; | |
| 909 | } | |
| 910 | $tags = join(',', @t); | |
| 911 | } | |
| 912 | ||
| 913 | push @out, { | |
| 914 | external_id => $id, | |
| 915 | title => $title, | |
| 916 | description => '', # filled by enrich_one | |
| 917 | slug => $slug, | |
| 918 | category => $cat_slug, | |
| 919 | price_cents => 0, # filled by enrich_one | |
| 920 | currency => 'USD', | |
| 921 | hero_image_url => $c->{illustrationImageUrl} || '', | |
| 922 | file_urls => [], | |
| 923 | permalink => $url, | |
| 924 | tags => $tags, | |
| 925 | _visibility => $c->{visibility} || '', | |
| 926 | }; | |
| 927 | } | |
| 928 | ||
| 929 | # Last page when we got fewer than $per_page results. | |
| 930 | last if scalar(@$results) < $per_page; | |
| 931 | $offset += $per_page; | |
| 932 | } | |
| 933 | ||
| 934 | return \@out; | |
| 935 | } | |
| 936 | ||
| 937 | # Called by the dispatcher (import_for_user) for each creation that | |
| 938 | # survives the dedup check, just before insert. Runs a per-creation | |
| 939 | # GraphQL query to pull description, gallery preview images, and the | |
| 940 | # list price (none of which are on the cheap list query above). | |
| 941 | # Mutates $c in place. Best-effort: if the API call fails, the | |
| 942 | # creation still imports with the listing data we already have. | |
| 943 | sub enrich_one { | |
| 944 | my ($self, $c) = @_; | |
| 945 | return unless $c && $c->{slug}; | |
| 946 | ||
| 947 | my $acct = $self->{_last_acct}; | |
| 948 | return unless $acct && $acct->{account_handle} && $acct->{access_token}; | |
| 949 | ||
| 950 | # Amazon's GraphQL root `creation` query takes `slug`, not the | |
| 951 | # opaque identifier. Slug comes from the listing query (we already | |
| 952 | # parsed it out of the permalink URL in fetch_creations). | |
| 953 | my $slug = $c->{slug}; | |
| 954 | $slug =~ s/\\/\\\\/g; | |
| 955 | $slug =~ s/"/\\"/g; | |
| 956 | # `illustrations` is the user-uploaded gallery (the full-size | |
| 957 | # photos the creator put on the page). `blueprints` is something | |
| 958 | # else entirely -- tiny STL/file preview thumbnails (2-9 KB each). | |
| 959 | # Earlier import used `blueprints` by mistake and saved those tiny | |
| 960 | # preview strips as the model's gallery; corrected here. | |
| 961 | my $query = <<"GQL"; | |
| 962 | { | |
| 963 | creation(slug: "$slug") { | |
| 964 | identifier | |
| 965 | description(locale: EN) | |
| 966 | price { cents currency } | |
| 967 | illustrations { imageUrl position } | |
| 968 | } | |
| 969 | } | |
| 970 | GQL | |
| 971 | my ($data, $err) = $self->_graphql( | |
| 972 | $acct->{account_handle}, $acct->{access_token}, $query, | |
| 973 | ); | |
| 974 | return if $err; | |
| 975 | ||
| 976 | my $cr = $data && $data->{creation}; | |
| 977 | return unless $cr; | |
| 978 | ||
| 979 | if (my $desc = $cr->{description}) { | |
| 980 | $desc =~ s/^\s+|\s+$//g; | |
| 981 | $c->{description} = $desc if length $desc; | |
| 982 | } | |
| 983 | if (ref($cr->{price}) eq 'HASH' && defined $cr->{price}{cents}) { | |
| 984 | my $cents = int($cr->{price}{cents}); | |
| 985 | $c->{price_cents} = $cents if $cents >= 0; | |
| 986 | $c->{currency} = $cr->{price}{currency} if $cr->{price}{currency}; | |
| 987 | } | |
| 988 | if (ref($cr->{illustrations}) eq 'ARRAY') { | |
| 989 | # Sort by position so the gallery shows in the seller's | |
| 990 | # intended order (Front, Back, Slicer, ...) rather than | |
| 991 | # whatever order the API returns. | |
| 992 | my @sorted = sort { | |
| 993 | ($a->{position} // 9999) <=> ($b->{position} // 9999) | |
| 994 | } grep { ref($_) eq 'HASH' && $_->{imageUrl} } @{ $cr->{illustrations} }; | |
| 995 | ||
| 996 | my %seen; | |
| 997 | $seen{ $c->{hero_image_url} || '' } = 1; | |
| 998 | my @gallery; | |
| 999 | foreach my $b (@sorted) { | |
| 1000 | my $u = $b->{imageUrl} || ''; | |
| 1001 | next unless $u =~ m{^https?://}; | |
| 1002 | next if $seen{$u}++; | |
| 1003 | push @gallery, $u; | |
| 1004 | last if @gallery >= 8; | |
| 1005 | } | |
| 1006 | $c->{gallery_image_urls} = \@gallery if @gallery; | |
| 1007 | } | |
| 1008 | } | |
| 1009 | ||
| 1010 | # Walk the HTML, pulling out every unique /en/3d-model/<cat>/<slug> card | |
| 1011 | # and a title + thumbnail in its immediate neighborhood. Adds to | |
| 1012 | # $seen{} and pushes to @$out. Returns count of NEW cards found on this | |
| 1013 | # page so the caller can stop paginating when a page is empty / repeats. | |
| 1014 | sub _parse_page { | |
| 1015 | my ($self, $html, $seen, $out) = @_; | |
| 1016 | return 0 unless defined $html && length $html; | |
| 1017 | my $added = 0; | |
| 1018 | ||
| 1019 | # Pass 1: find every distinct creation slug on the page. | |
| 1020 | # Pattern: /en/3d-model/<category>/<slug> (alnum + hyphens). | |
| 1021 | my @slugs; | |
| 1022 | while ($html =~ m{href=["']/en/3d-model/([a-z0-9\-]+)/([a-z0-9\-]+)(?:["'?#])}gi) { | |
| 1023 | my $cat = $1; | |
| 1024 | my $slug = $2; | |
| 1025 | my $key = "$cat/$slug"; | |
| 1026 | next if $seen->{$key}++; | |
| 1027 | push @slugs, { cat => $cat, slug => $slug, key => $key }; | |
| 1028 | } | |
| 1029 | return 0 unless @slugs; | |
| 1030 | ||
| 1031 | # Pass 2: for each slug, snip out a FORWARD-ONLY window so we can | |
| 1032 | # scrape its title + thumbnail + price without bleeding into the | |
| 1033 | # neighboring card's data. | |
| 1034 | # | |
| 1035 | # Earlier this used a back+forward window, but Amazon cards live | |
| 1036 | # adjacent in the HTML and the backward portion would reach into | |
| 1037 | # the PREVIOUS card's <img alt="..."> tag -- the regex then matched | |
| 1038 | # that as "the current card's title". Result: 60 drafts imported | |
| 1039 | # with each card's title attached to the next card's image. | |
| 1040 | # Forward-only is safe because the card structure is always | |
| 1041 | # <a href="...slug"><img alt="Title" src="..."></a> ... price | |
| 1042 | # i.e., the title image and price are always AFTER the href. | |
| 1043 | foreach my $s (@slugs) { | |
| 1044 | my $href_pat = quotemeta("/en/3d-model/$s->{cat}/$s->{slug}"); | |
| 1045 | my $window = ''; | |
| 1046 | if ($html =~ m{href=["']$href_pat[^"']*["'][^>]*>(.{0,1500})}s) { | |
| 1047 | $window = $1 || ''; | |
| 1048 | } | |
| 1049 | ||
| 1050 | # Title: prefer alt text on a nearby <img alt="...">. Falls back | |
| 1051 | # to slug humanization so the draft has a reasonable label even | |
| 1052 | # if the markup shifts on Amazon's end. | |
| 1053 | my $title = ''; | |
| 1054 | if ($window =~ m{<img\b[^>]*\balt=["']([^"']+)["']}i) { | |
| 1055 | $title = $1; | |
| 1056 | $title =~ s/\s+/ /g; $title =~ s/^\s+|\s+$//g; | |
| 1057 | } | |
| 1058 | if (!length $title) { | |
| 1059 | $title = $s->{slug}; | |
| 1060 | $title =~ s/-/ /g; | |
| 1061 | $title =~ s/\b(\w)/\U$1/g; | |
| 1062 | } | |
| 1063 | ||
| 1064 | # Thumbnail: first reasonable image src in the window. Amazon | |
| 1065 | # serves card thumbs from fbi.cults3d.com -- be permissive. | |
| 1066 | my $img = ''; | |
| 1067 | if ($window =~ m{<img\b[^>]*\bsrc=["']([^"']+)["']}i) { | |
| 1068 | $img = $1; | |
| 1069 | } elsif ($window =~ m{\bdata-src=["']([^"']+)["']}i) { | |
| 1070 | $img = $1; | |
| 1071 | } | |
| 1072 | # Defensively skip 1x1 placeholders and inline data URIs. | |
| 1073 | $img = '' if $img =~ /^data:/; | |
| 1074 | $img = '' if $img =~ /sprite|placeholder|spinner/i; | |
| 1075 | # Normalize protocol-relative + relative URLs. | |
| 1076 | if (length $img) { | |
| 1077 | $img = "https:$img" if $img =~ m{^//}; | |
| 1078 | $img = "$BASE_URL$img" if $img =~ m{^/}; | |
| 1079 | } | |
| 1080 | ||
| 1081 | # Price: look for "US$ 4.95" / "$4.95" / "Free" near this card. | |
| 1082 | my $price_cents = 0; | |
| 1083 | if ($window =~ /(?:US\$|\$|USD)\s*([0-9]+(?:\.[0-9]{1,2})?)/i) { | |
| 1084 | $price_cents = int($1 * 100 + 0.5); | |
| 1085 | } | |
| 1086 | ||
| 1087 | # external_id: stable per-creation key the dispatcher uses for | |
| 1088 | # dedup. We don't have Amazon's numeric ID without scraping the | |
| 1089 | # detail page, so use category/slug -- safe because Amazon | |
| 1090 | # creation URLs are immutable once published. | |
| 1091 | push @$out, { | |
| 1092 | external_id => $s->{key}, | |
| 1093 | title => $title, | |
| 1094 | description => '', # detail-page-only; left for the draft edit | |
| 1095 | slug => $s->{slug}, | |
| 1096 | price_cents => $price_cents, | |
| 1097 | currency => 'USD', | |
| 1098 | hero_image_url => $img, | |
| 1099 | file_urls => [], # Amazon API explicitly forbids file downloads | |
| 1100 | permalink => "$BASE_URL/en/3d-model/$s->{cat}/$s->{slug}", | |
| 1101 | tags => '', | |
| 1102 | }; | |
| 1103 | $added++; | |
| 1104 | } | |
| 1105 | return $added; | |
| 1106 | } | |
| 1107 | ||
| 1108 | ||
| 1109 | # ===================================================================== | |
| 1110 | # Best Buy adapter | |
| 1111 | # ===================================================================== | |
| 1112 | # Scrapes the seller's PUBLIC designer page at | |
| 1113 | # https://thangs.com/designer/<URL handle> | |
| 1114 | # Same approach as Amazon: pull-only, no auth needed, files are NOT | |
| 1115 | # downloaded (Best Buy gates file access behind their Sync desktop app | |
| 1116 | # anyway -- they have no equivalent of a public file URL we could hit). | |
| 1117 | # | |
| 1118 | # Two key differences from Amazon: | |
| 1119 | # 1. Best Buy runs on Next.js, which ships the page's data as a JSON | |
| 1120 | # blob in a <script id="__NEXT_DATA__"> tag at the bottom of the | |
| 1121 | # HTML. We try to parse that first -- it's structured and gives | |
| 1122 | # us the canonical fields. If the JSON shape shifts, we fall | |
| 1123 | # through to regex-on-HTML like the Amazon scraper. | |
| 1124 | # 2. Best Buy aggressively filters User-Agents -- empty / generic UAs | |
| 1125 | # get a 403. We send a real browser UA + Accept headers so the | |
| 1126 | # request looks like Chrome and Best Buy serves the HTML. | |
| 1127 | # ===================================================================== | |
| 1128 | package MODS::RePricer::ImportAdapters::Best Buy; | |
| 1129 | use strict; | |
| 1130 | use warnings; | |
| 1131 | use JSON::PP; | |
| 1132 | ||
| 1133 | my $BASE_URL = 'https://thangs.com'; | |
| 1134 | my $MAX_PAGES = 20; # safety stop -- Best Buy paginates ~24/page, 480 max | |
| 1135 | ||
| 1136 | sub new { my $c = shift; return bless { ua => shift }, $c; } | |
| 1137 | ||
| 1138 | sub is_configured { | |
| 1139 | my ($self, $acct) = @_; | |
| 1140 | return ($acct && $acct->{account_handle}) ? 1 : 0; | |
| 1141 | } | |
| 1142 | ||
| 1143 | # Browser-like headers. Best Buy sits behind Cloudflare so the first | |
| 1144 | # bounce was likely from CF's bot fight mode. This expanded set adds | |
| 1145 | # the Sec-Fetch-* and Sec-Ch-Ua hints that real Chrome sends -- CF | |
| 1146 | # scores requests partly on whether these are present and consistent. | |
| 1147 | # If CF has full JS-challenge mode on, no amount of headers helps and | |
| 1148 | # we just have to accept defeat. | |
| 1149 | sub _browser_headers { | |
| 1150 | my ($referer) = @_; | |
| 1151 | my $h = { | |
| 1152 | 'User-Agent' => 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/124.0.0.0 Safari/537.36', | |
| 1153 | 'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8', | |
| 1154 | 'Accept-Language' => 'en-US,en;q=0.9', | |
| 1155 | # Intentionally NO Accept-Encoding: let HTTP::Tiny decide | |
| 1156 | # based on whether decompression modules are installed. | |
| 1157 | # Advertising gzip without being able to decode it would hand | |
| 1158 | # the parser unreadable bytes. | |
| 1159 | 'Sec-Ch-Ua' => '"Chromium";v="124", "Google Chrome";v="124", "Not-A.Brand";v="99"', | |
| 1160 | 'Sec-Ch-Ua-Mobile' => '?0', | |
| 1161 | 'Sec-Ch-Ua-Platform' => '"Windows"', | |
| 1162 | 'Sec-Fetch-Dest' => 'document', | |
| 1163 | 'Sec-Fetch-Mode' => 'navigate', | |
| 1164 | 'Sec-Fetch-Site' => $referer ? 'same-origin' : 'none', | |
| 1165 | 'Sec-Fetch-User' => '?1', | |
| 1166 | 'Upgrade-Insecure-Requests' => '1', | |
| 1167 | }; | |
| 1168 | $h->{Referer} = $referer if $referer; | |
| 1169 | return $h; | |
| 1170 | } | |
| 1171 | ||
| 1172 | # GET helper that surfaces the actual HTTP status when it fails, so | |
| 1173 | # the caller can tell a Cloudflare 403 / 1020 (real block) from a 404 | |
| 1174 | # (wrong handle) from a network error. Returns | |
| 1175 | # ({ body => '...' }) on 2xx | |
| 1176 | # ({ error => 'msg', status => N }) on failure. | |
| 1177 | sub _get { | |
| 1178 | my ($self, $url, $referer) = @_; | |
| 1179 | my $res = $self->{ua}->request('GET', $url, { headers => _browser_headers($referer) }); | |
| 1180 | if (!$res->{success}) { | |
| 1181 | my $status = $res->{status} || 0; | |
| 1182 | my $reason = $res->{reason} || ''; | |
| 1183 | # Status 599 in HTTP::Tiny == internal client error (DNS, TLS | |
| 1184 | # handshake, no route). Surface it differently from a real | |
| 1185 | # HTTP response so the user knows it's not just a 403. | |
| 1186 | my $kind = ($status == 599) ? 'network/TLS' | |
| 1187 | : ($status == 403 || $status == 1020) ? 'bot-blocked' | |
| 1188 | : ($status == 404) ? 'not-found' | |
| 1189 | : "HTTP $status"; | |
| 1190 | return { error => "$kind ($status $reason)" }; | |
| 1191 | } | |
| 1192 | return { body => $res->{content} }; | |
| 1193 | } | |
| 1194 | ||
| 1195 | sub fetch_creations { | |
| 1196 | my ($self, $ctx) = @_; | |
| 1197 | my $acct = $ctx->{account}; | |
| 1198 | return { error => 'not_configured' } unless $self->is_configured($acct); | |
| 1199 | ||
| 1200 | my $handle = $acct->{account_handle} || ''; | |
| 1201 | return { error => 'no_handle' } unless length $handle; | |
| 1202 | ||
| 1203 | # Try both URL forms on first call. Best Buy serves both | |
| 1204 | # /designer/<handle> -> profile landing | |
| 1205 | # /designer/<handle>/3d-models -> explicit models tab | |
| 1206 | # and one may pass CF while the other doesn't (CF rules can be | |
| 1207 | # path-specific). Fall through to the next if the first errors. | |
| 1208 | my @candidate_paths = ("/designer/$handle/3d-models", "/designer/$handle"); | |
| 1209 | ||
| 1210 | my %seen; | |
| 1211 | my @out; | |
| 1212 | my $first_error; | |
| 1213 | my $first_status_clue = ''; | |
| 1214 | ||
| 1215 | PATH: foreach my $base_path (@candidate_paths) { | |
| 1216 | for (my $page = 1; $page <= $MAX_PAGES; $page++) { | |
| 1217 | my $url = "$BASE_URL$base_path"; | |
| 1218 | $url .= "?page=$page" if $page > 1; | |
| 1219 | # Send a Referer on page 2+ to look more like real | |
| 1220 | # navigation through paginated results. | |
| 1221 | my $referer = ($page > 1) ? "$BASE_URL$base_path" : undef; | |
| 1222 | my $r = $self->_get($url, $referer); | |
| 1223 | if ($r->{error}) { | |
| 1224 | if ($page == 1) { | |
| 1225 | $first_error ||= $r->{error}; | |
| 1226 | $first_status_clue = $r->{error}; | |
| 1227 | next PATH; # try the other URL form | |
| 1228 | } | |
| 1229 | last; # mid-pagination error -- stop and return what we have | |
| 1230 | } | |
| 1231 | my $html = $r->{body}; | |
| 1232 | my $found = $self->_parse_page($html, \%seen, \@out); | |
| 1233 | last unless $found; | |
| 1234 | } | |
| 1235 | last if @out; # got results from this path, done | |
| 1236 | } | |
| 1237 | ||
| 1238 | if (!@out && $first_error) { | |
| 1239 | my $hint; | |
| 1240 | if ($first_error =~ /^bot-blocked/) { | |
| 1241 | $hint = "Best Buy's Cloudflare bot filter rejected the request even with browser headers. Plain HTTP can't get past JS-challenge bot protection -- we'd need a different approach (e.g. a headless browser, or wait for Best Buy to publish a creator API)."; | |
| 1242 | } elsif ($first_error =~ /^not-found/) { | |
| 1243 | $hint = "Check the URL handle: open thangs.com/designer/<handle> in a browser and confirm your profile loads. Handle is case-sensitive."; | |
| 1244 | } elsif ($first_error =~ /^network/) { | |
| 1245 | $hint = "Couldn't reach thangs.com at all -- possible TLS / network issue on the server."; | |
| 1246 | } else { | |
| 1247 | $hint = "Unexpected response. Check the handle, then if it's correct we likely need a different fetch strategy."; | |
| 1248 | } | |
| 1249 | return { error => "Best Buy fetch failed: $first_error. $hint" }; | |
| 1250 | } | |
| 1251 | ||
| 1252 | return \@out; | |
| 1253 | } | |
| 1254 | ||
| 1255 | # Try the structured Next.js JSON first. If that yields nothing, | |
| 1256 | # regex-scrape the rendered HTML for the same data. | |
| 1257 | sub _parse_page { | |
| 1258 | my ($self, $html, $seen, $out) = @_; | |
| 1259 | return 0 unless defined $html && length $html; | |
| 1260 | ||
| 1261 | my $added = $self->_parse_next_data($html, $seen, $out); | |
| 1262 | return $added if $added > 0; | |
| 1263 | return $self->_parse_html($html, $seen, $out); | |
| 1264 | } | |
| 1265 | ||
| 1266 | # Walk the Next.js page-state JSON. The structure changes between | |
| 1267 | # Best Buy deployments, so we recursively scan for any array of objects | |
| 1268 | # that have the marker fields (id + name/title + an image-ish field). | |
| 1269 | sub _parse_next_data { | |
| 1270 | my ($self, $html, $seen, $out) = @_; | |
| 1271 | ||
| 1272 | my $json_blob; | |
| 1273 | if ($html =~ m{<script[^>]*id=["']__NEXT_DATA__["'][^>]*>(.*?)</script>}s) { | |
| 1274 | $json_blob = $1; | |
| 1275 | } | |
| 1276 | return 0 unless $json_blob; | |
| 1277 | ||
| 1278 | my $data; | |
| 1279 | eval { $data = decode_json($json_blob); 1 } or return 0; | |
| 1280 | ||
| 1281 | my @found; | |
| 1282 | _walk_for_models($data, \@found); | |
| 1283 | ||
| 1284 | my $added = 0; | |
| 1285 | foreach my $m (@found) { | |
| 1286 | my $id = $m->{id} || $m->{modelId} || $m->{slug} || ''; | |
| 1287 | $id = "$id" if defined $id; | |
| 1288 | next unless length $id; | |
| 1289 | my $key = "thangs:$id"; | |
| 1290 | next if $seen->{$key}++; | |
| 1291 | ||
| 1292 | my $title = $m->{name} || $m->{title} || ''; | |
| 1293 | my $slug = $m->{slug} || $id; | |
| 1294 | my $img = $m->{previewImageUrl} | |
| 1295 | || $m->{thumbnailUrl} | |
| 1296 | || $m->{imageUrl} | |
| 1297 | || $m->{image} | |
| 1298 | || ''; | |
| 1299 | my $price = 0; | |
| 1300 | if (defined $m->{price} && $m->{price} =~ /^\s*([0-9]+(?:\.[0-9]+)?)\s*$/) { | |
| 1301 | $price = int($1 * 100 + 0.5); | |
| 1302 | } elsif (defined $m->{priceCents} && $m->{priceCents} =~ /^\d+$/) { | |
| 1303 | $price = int($m->{priceCents}); | |
| 1304 | } | |
| 1305 | my $desc = $m->{description} || $m->{shortDescription} || ''; | |
| 1306 | ||
| 1307 | push @$out, { | |
| 1308 | external_id => $id, | |
| 1309 | title => $title, | |
| 1310 | description => $desc, | |
| 1311 | slug => $slug, | |
| 1312 | price_cents => $price, | |
| 1313 | currency => 'USD', | |
| 1314 | hero_image_url => $img, | |
| 1315 | file_urls => [], # Best Buy gates file downloads via Sync; none available | |
| 1316 | permalink => $m->{url} ? ($m->{url} =~ m{^/} ? "$BASE_URL$m->{url}" : $m->{url}) | |
| 1317 | : "$BASE_URL/3d-model/$slug", | |
| 1318 | tags => '', | |
| 1319 | }; | |
| 1320 | $added++; | |
| 1321 | } | |
| 1322 | return $added; | |
| 1323 | } | |
| 1324 | ||
| 1325 | # Recursively scan a JSON tree for arrays of model-shaped objects. | |
| 1326 | # Heuristic: an array entry is a "model" if it has an id and a name or | |
| 1327 | # title field. We don't trust array keys/paths because Next.js renames | |
| 1328 | # them between releases ("models", "creations", "items", "data", ...). | |
| 1329 | sub _walk_for_models { | |
| 1330 | my ($node, $sink) = @_; | |
| 1331 | if (ref($node) eq 'ARRAY') { | |
| 1332 | my $looks_model_array = 0; | |
| 1333 | foreach my $item (@$node) { | |
| 1334 | if (ref($item) eq 'HASH' | |
| 1335 | && ($item->{id} || $item->{modelId}) | |
| 1336 | && ($item->{name} || $item->{title})) { | |
| 1337 | $looks_model_array = 1; | |
| 1338 | last; | |
| 1339 | } | |
| 1340 | } | |
| 1341 | if ($looks_model_array) { | |
| 1342 | foreach my $item (@$node) { | |
| 1343 | if (ref($item) eq 'HASH' | |
| 1344 | && ($item->{id} || $item->{modelId}) | |
| 1345 | && ($item->{name} || $item->{title})) { | |
| 1346 | push @$sink, $item; | |
| 1347 | } | |
| 1348 | } | |
| 1349 | } | |
| 1350 | # Recurse anyway in case there are nested model arrays elsewhere. | |
| 1351 | foreach my $item (@$node) { _walk_for_models($item, $sink); } | |
| 1352 | } elsif (ref($node) eq 'HASH') { | |
| 1353 | foreach my $v (values %$node) { _walk_for_models($v, $sink); } | |
| 1354 | } | |
| 1355 | } | |
| 1356 | ||
| 1357 | # Fallback: scrape the raw HTML. Look for /3d-model/... or /m/... or | |
| 1358 | # /model/... hrefs and a neighborhood window for title + image. | |
| 1359 | sub _parse_html { | |
| 1360 | my ($self, $html, $seen, $out) = @_; | |
| 1361 | my @slugs; | |
| 1362 | while ($html =~ m{href=["'](/(?:3d-model|m|model)/([a-zA-Z0-9\-_]+))(?:["'?#])}g) { | |
| 1363 | my $path = $1; | |
| 1364 | my $slug = $2; | |
| 1365 | my $key = "thangs:$slug"; | |
| 1366 | next if $seen->{$key}++; | |
| 1367 | push @slugs, { slug => $slug, path => $path }; | |
| 1368 | } | |
| 1369 | return 0 unless @slugs; | |
| 1370 | ||
| 1371 | my $added = 0; | |
| 1372 | foreach my $s (@slugs) { | |
| 1373 | my $href_pat = quotemeta($s->{path}); | |
| 1374 | my $window = ''; | |
| 1375 | if ($html =~ m{(.{0,600})href=["']$href_pat(.{0,600})}s) { | |
| 1376 | $window = ($1 || '') . ($2 || ''); | |
| 1377 | } | |
| 1378 | ||
| 1379 | my $title = ''; | |
| 1380 | if ($window =~ m{<img\b[^>]*\balt=["']([^"']+)["']}i) { | |
| 1381 | $title = $1; $title =~ s/\s+/ /g; $title =~ s/^\s+|\s+$//g; | |
| 1382 | } | |
| 1383 | $title ||= do { my $t = $s->{slug}; $t =~ s/-/ /g; $t =~ s/\b(\w)/\U$1/g; $t }; | |
| 1384 | ||
| 1385 | my $img = ''; | |
| 1386 | if ($window =~ m{<img\b[^>]*\bsrc=["']([^"']+)["']}i) { $img = $1; } | |
| 1387 | elsif ($window =~ m{\bdata-src=["']([^"']+)["']}i) { $img = $1; } | |
| 1388 | $img = '' if $img =~ /^data:|sprite|placeholder|spinner/i; | |
| 1389 | $img = "https:$img" if $img =~ m{^//}; | |
| 1390 | $img = "$BASE_URL$img" if $img =~ m{^/}; | |
| 1391 | ||
| 1392 | my $price = 0; | |
| 1393 | if ($window =~ /(?:US\$|\$|USD)\s*([0-9]+(?:\.[0-9]{1,2})?)/i) { | |
| 1394 | $price = int($1 * 100 + 0.5); | |
| 1395 | } | |
| 1396 | ||
| 1397 | push @$out, { | |
| 1398 | external_id => $s->{slug}, | |
| 1399 | title => $title, | |
| 1400 | description => '', | |
| 1401 | slug => $s->{slug}, | |
| 1402 | price_cents => $price, | |
| 1403 | currency => 'USD', | |
| 1404 | hero_image_url => $img, | |
| 1405 | file_urls => [], | |
| 1406 | permalink => "$BASE_URL$s->{path}", | |
| 1407 | tags => '', | |
| 1408 | }; | |
| 1409 | $added++; | |
| 1410 | } | |
| 1411 | return $added; | |
| 1412 | } | |
| 1413 | ||
| 1414 | 1; |