From ec030c6179214aca2f49ee5475a2e78a43546e69 Mon Sep 17 00:00:00 2001 From: xocko Date: Tue, 21 Jul 2026 17:36:59 +0000 Subject: [PATCH] Upload files to "/" --- kobocompare | 449 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 449 insertions(+) create mode 100644 kobocompare diff --git a/kobocompare b/kobocompare new file mode 100644 index 0000000..d36dfb6 --- /dev/null +++ b/kobocompare @@ -0,0 +1,449 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use utf8; +use feature qw(say); + +use Getopt::Long qw(GetOptions); +use HTTP::Cookies; +use JSON::PP qw(decode_json); +use LWP::UserAgent; +use Scalar::Util qw(looks_like_number); +use Time::HiRes qw(sleep); + +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; + +my %stores = ( + 'Australia' => 'https://www.kobo.com/au/en/ebook/', + 'Austria' => 'https://www.kobo.com/at/de/ebook/', + 'Belgium (Dutch)' => 'https://www.kobo.com/be/nl/ebook/', + 'Belgium (French)' => 'https://www.kobo.com/be/fr/ebook/', + 'Brazil' => 'https://www.kobo.com/br/pt/ebook/', + 'Canada (English)' => 'https://www.kobo.com/ca/en/ebook/', + 'Canada (French)' => 'https://www.kobo.com/ca/fr/ebook/', + 'Cyprus' => 'https://www.kobo.com/cy/en/ebook/', + 'Czech Republic' => 'https://www.kobo.com/cz/cs/ebook/', + 'Denmark' => 'https://www.kobo.com/dk/da/ebook/', + 'Eire' => 'https://www.kobo.com/ie/en/ebook/', + 'Estonia' => 'https://www.kobo.com/ee/en/ebook/', + 'Finland' => 'https://www.kobo.com/fi/fi/ebook/', + 'France' => 'https://www.kobo.com/fr/fr/ebook/', + 'Germany' => 'https://www.kobo.com/de/de/ebook/', + 'Greece' => 'https://www.kobo.com/gr/en/ebook/', + 'Hong Kong (Chinese)' => 'https://www.kobo.com/hk/zh/ebook/', + 'Hong Kong (English)' => 'https://www.kobo.com/hk/en/ebook/', + 'India' => 'https://www.kobo.com/in/en/ebook/', + 'Italy' => 'https://www.kobo.com/it/it/ebook/', + 'Japan' => 'https://www.kobo.com/jp/ja/ebook/', + 'Lithuania' => 'https://www.kobo.com/lt/en/ebook/', + 'Luxembourg' => 'https://www.kobo.com/lu/fr/ebook/', + 'Malaysia' => 'https://www.kobo.com/my/en/ebook/', + 'Malta' => 'https://www.kobo.com/mt/en/ebook/', + 'Mexico' => 'https://www.kobo.com/mx/es/ebook/', + 'Netherlands' => 'https://www.kobo.com/nl/nl/ebook/', + 'New Zealand' => 'https://www.kobo.com/nz/en/ebook/', + 'Norway' => 'https://www.kobo.com/no/nb/ebook/', + 'Philippines' => 'https://www.kobo.com/ph/en/ebook/', + 'Poland' => 'https://www.kobo.com/pl/pl/ebook/', + 'Portugal' => 'https://www.kobo.com/pt/pt/ebook/', + 'Romania' => 'https://www.kobo.com/ro/ro/ebook/', + 'Singapore' => 'https://www.kobo.com/sg/en/ebook/', + 'Slovak Republic' => 'https://www.kobo.com/sk/en/ebook/', + 'Slovenia' => 'https://www.kobo.com/si/en/ebook/', + 'South Africa' => 'https://www.kobo.com/za/en/ebook/', + 'Spain' => 'https://www.kobo.com/es/es/ebook/', + 'Sweden' => 'https://www.kobo.com/se/sv/ebook/', + 'Switzerland (French)' => 'https://www.kobo.com/ch/fr/ebook/', + 'Taiwan' => 'https://www.kobo.com/tw/zh/ebook/', + 'Thailand' => 'https://www.kobo.com/th/en/ebook/', + 'Turkey' => 'https://www.kobo.com/tr/tr/ebook/', + 'UK' => 'https://www.kobo.com/gb/en/ebook/', + 'USA' => 'https://www.kobo.com/us/en/ebook/', + 'World-wide' => 'https://www.kobo.com/ww/en/ebook/', +); + +my $delay = 1.5; +my $retries = 3; +my $timeout = 30; +my $show_failed = 0; +my $help = 0; + +GetOptions( + 'delay=f' => \$delay, + 'retries=i' => \$retries, + 'timeout=i' => \$timeout, + 'show-failed!' => \$show_failed, + 'help|h' => \$help, +) or usage(2); + +usage(0) if $help; + +my $input = shift @ARGV; +usage(2) unless defined $input && length $input; + +$delay = 0 if $delay < 0; +$retries = 0 if $retries < 0; +$timeout = 5 if $timeout < 5; + +my $book = clean_book_slug($input); +die "Could not determine the Kobo book slug from: $input\n" unless length $book; +die "Invalid Kobo book slug: $book\n" unless $book =~ /\A[[:alnum:]_%+.,'()!-]+\z/; + +my $jar = HTTP::Cookies->new; +my $ua = LWP::UserAgent->new( + timeout => $timeout, + max_redirect => 8, + cookie_jar => $jar, + protocols_allowed => [qw(http https)], + ssl_opts => { verify_hostname => 1 }, +); + +# A normal desktop browser identity. The old script used libwww-perl's default +# identity and launched every request at once, which commonly triggers 403s. +$ua->agent( + 'Mozilla/5.0 (X11; Linux x86_64) ' + . 'AppleWebKit/537.36 (KHTML, like Gecko) ' + . 'Chrome/124.0 Safari/537.36' +); +$ua->default_header('Accept' => + 'text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8'); +$ua->default_header('Accept-Language' => 'en-GB,en;q=0.9'); +$ua->default_header('DNT' => '1'); +$ua->default_header('Upgrade-Insecure-Requests' => '1'); + +my @results; +my @failures; +my $index = 0; +my $total = scalar keys %stores; + +for my $country (sort keys %stores) { + ++$index; + my $url = $stores{$country} . $book; + print STDERR sprintf("[%02d/%02d] %-22s ", $index, $total, $country); + + my ($response, $attempts) = fetch_with_retries($ua, $url, $retries); + + if (!$response->is_success) { + my $status = $response->code . ' ' . $response->message; + say STDERR "failed ($status)"; + push @failures, [$country, $status, $url]; + polite_pause($delay); + next; + } + + my $html = $response->decoded_content(charset => 'none'); + my ($price, $currency) = extract_price($html); + + if (!defined $price || !defined $currency) { + say STDERR 'no price found'; + push @failures, [$country, 'page loaded but price was not found', $url]; + polite_pause($delay); + next; + } + + say STDERR sprintf('ok (%s %.2f)', $currency, $price); + push @results, { + country => $country, + currency => $currency, + price => $price + 0, + url => $url, + }; + + polite_pause($delay); +} + +die "\nNo prices were retrieved. Try a larger delay, for example --delay 3.\n" + unless @results; + +my %rates_to_eur = fetch_rates_to_eur($ua, [map { $_->{currency} } @results]); + +for my $row (@results) { + my $currency = $row->{currency}; + $row->{eur} = $row->{price} * $rates_to_eur{$currency} + if exists $rates_to_eur{$currency}; +} + +my $country_width = 0; +for my $row (@results) { + my $length = length $row->{country}; + $country_width = $length if $length > $country_width; +} + +say ''; +for my $row (sort_results(@results)) { + if (defined $row->{eur}) { + printf "%-*s €%7.2f %3s %10.2f\n", + $country_width, $row->{country}, $row->{eur}, + $row->{currency}, $row->{price}; + } else { + printf "%-*s %-9s %3s %10.2f\n", + $country_width, $row->{country}, '(no FX)', + $row->{currency}, $row->{price}; + } +} + +my @converted = grep { defined $_->{eur} } @results; +if (@converted) { + my $minimum = (sort { $a->{eur} <=> $b->{eur} } @converted)[0]{eur}; + my @cheapest = grep { abs($_->{eur} - $minimum) < 0.005 } @converted; + + printf "\nCheapest price: €%.2f\n", $minimum; + if (@cheapest == 1) { + printf "Country: %s\n", $cheapest[0]{country}; + printf "Original price: %s %.2f\n", + $cheapest[0]{currency}, $cheapest[0]{price}; + printf "URL: %s\n", $cheapest[0]{url}; + } else { + say "Countries tied for cheapest price:"; + for my $row (@cheapest) { + printf " %s — %s %.2f — %s\n", + $row->{country}, $row->{currency}, $row->{price}, $row->{url}; + } + } +} else { + say "\nNo exchange rates were available, so no converted cheapest price was calculated."; +} + +printf STDERR "\nRetrieved %d of %d stores; %d failed.\n", + scalar(@results), $total, scalar(@failures); + +if ($show_failed && @failures) { + say STDERR "\nFailed stores:"; + for my $failure (@failures) { + printf STDERR " %-22s %s\n", $failure->[0], $failure->[1]; + } +} + +exit 0; + +sub usage { + my ($exit_code) = @_; + print <<'USAGE'; +Usage: + kobocompare-updated [options] KOBO_URL_OR_SLUG + +Options: + --delay SECONDS Pause between countries (default: 1.5) + --retries NUMBER Retries for 403, 429 and server errors (default: 3) + --timeout SECONDS Per-request timeout (default: 30) + --show-failed Print a final list of failed stores + --help Show this help + +Examples: + ./kobocompare-updated wings-the-story-of-a-band-on-the-run + ./kobocompare-updated --delay 3 'https://www.kobo.com/es/es/ebook/wings-the-story-of-a-band-on-the-run' +USAGE + exit $exit_code; +} + +sub clean_book_slug { + my ($value) = @_; + $value =~ s/^\s+|\s+$//g; + $value =~ s/[?#].*\z//; # Drop Kobo search/tracking parameters. + $value =~ s{/+\z}{}; + $value =~ s{.*/}{}; + return $value; +} + +sub polite_pause { + my ($seconds) = @_; + return if $seconds <= 0; + sleep($seconds + rand(0.45)); +} + +sub fetch_with_retries { + my ($agent, $url, $max_retries) = @_; + my $response; + + for my $attempt (0 .. $max_retries) { + $response = $agent->get( + $url, + 'Referer' => 'https://www.kobo.com/', + 'Cache-Control' => 'no-cache', + 'Pragma' => 'no-cache', + 'Sec-Fetch-Dest' => 'document', + 'Sec-Fetch-Mode' => 'navigate', + 'Sec-Fetch-Site' => 'same-origin', + 'Sec-Fetch-User' => '?1', + ); + + return ($response, $attempt + 1) if $response->is_success; + + my $code = $response->code || 0; + last unless $code == 403 || $code == 429 || $code >= 500 || $code == 0; + last if $attempt == $max_retries; + + my $retry_after = $response->header('Retry-After'); + my $backoff = (defined $retry_after && $retry_after =~ /^\d+(?:\.\d+)?$/) + ? $retry_after + : (2 ** $attempt) + 1 + rand(1.0); + sleep($backoff); + } + + return ($response, $max_retries + 1); +} + +sub extract_price { + my ($html) = @_; + + my $meta_price = extract_meta($html, 'og:price'); + my $meta_currency = extract_meta($html, 'og:currency_code'); + if (defined $meta_price && defined $meta_currency) { + my $price = normalise_price($meta_price); + return ($price, uc $meta_currency) if defined $price; + } + + while ($html =~ m{]*type\s*=\s*(["'])application/ld\+json\1[^>]*>(.*?)}gis) { + my $json_text = $2; + $json_text =~ s/^\s+|\s+$//g; + next unless length $json_text; + + my $data = eval { decode_json($json_text) }; + next if $@ || !defined $data; + + my ($price, $currency) = find_price_in_json($data); + return ($price, $currency) if defined $price && defined $currency; + } + + # Last-resort fallback for embedded JSON that is not valid JSON-LD. + if ($html =~ /["']priceCurrency["']\s*:\s*["']([A-Z]{3})["']/i) { + my $currency = uc $1; + if ($html =~ /["'](?:salePrice|price)["']\s*:\s*["']?([0-9][0-9.,]*)/i) { + my $price = normalise_price($1); + return ($price, $currency) if defined $price; + } + } + + return; +} + +sub extract_meta { + my ($html, $wanted) = @_; + + while ($html =~ m{]*>}gi) { + my $tag = $&; + my $property = attribute_value($tag, 'property'); + $property = attribute_value($tag, 'name') unless defined $property; + next unless defined $property && lc($property) eq lc($wanted); + + my $content = attribute_value($tag, 'content'); + return $content if defined $content; + } + + return; +} + +sub attribute_value { + my ($tag, $name) = @_; + return $2 if $tag =~ /\b\Q$name\E\s*=\s*(["'])(.*?)\1/is; + return $1 if $tag =~ /\b\Q$name\E\s*=\s*([^\s>]+)/is; + return; +} + +sub find_price_in_json { + my ($node) = @_; + + if (ref $node eq 'ARRAY') { + for my $item (@$node) { + my ($price, $currency) = find_price_in_json($item); + return ($price, $currency) if defined $price && defined $currency; + } + return; + } + + return unless ref $node eq 'HASH'; + + my $raw_price = exists $node->{price} ? $node->{price} + : exists $node->{lowPrice} ? $node->{lowPrice} + : undef; + my $currency = $node->{priceCurrency}; + + if (defined $raw_price && defined $currency) { + my $price = normalise_price($raw_price); + return ($price, uc $currency) if defined $price; + } + + for my $key (keys %$node) { + my ($price, $found_currency) = find_price_in_json($node->{$key}); + return ($price, $found_currency) + if defined $price && defined $found_currency; + } + + return; +} + +sub normalise_price { + my ($raw) = @_; + return unless defined $raw; + + my $value = "$raw"; + $value =~ s/[\s\x{00A0}]//g; + $value =~ s/[^0-9,.-]//g; + return unless $value =~ /\d/; + + if ($value =~ /,/ && $value =~ /\./) { + my $last_comma = rindex($value, ','); + my $last_dot = rindex($value, '.'); + if ($last_comma > $last_dot) { + $value =~ s/\.//g; + $value =~ tr/,/./; + } else { + $value =~ s/,//g; + } + } elsif ($value =~ /,/) { + $value =~ tr/,/./; + } + + return unless looks_like_number($value); + return $value + 0; +} + +sub fetch_rates_to_eur { + my ($agent, $currencies) = @_; + + my %wanted = map { uc($_) => 1 } grep { defined && /^[A-Za-z]{3}$/ } @$currencies; + my %to_eur = (EUR => 1); + delete $wanted{EUR}; + return %to_eur unless keys %wanted; + + my $quotes = join ',', sort keys %wanted; + my $url = "https://api.frankfurter.dev/v2/rates?base=EUR"es=$quotes"; + my $response = $agent->get($url, 'Accept' => 'application/json'); + + if (!$response->is_success) { + warn "Could not retrieve current exchange rates: " + . $response->status_line . "\n"; + return %to_eur; + } + + my $data = eval { decode_json($response->decoded_content) }; + if ($@ || ref $data ne 'ARRAY') { + warn "Could not parse the exchange-rate response.\n"; + return %to_eur; + } + + # API rows are expressed as: 1 EUR = RATE quote-currency units. + # Therefore 1 quote-currency unit = 1 / RATE EUR. + for my $row (@$data) { + next unless ref $row eq 'HASH'; + my $quote = uc($row->{quote} // ''); + my $rate = $row->{rate}; + next unless $quote =~ /^[A-Z]{3}$/; + next unless defined $rate && looks_like_number($rate) && $rate > 0; + $to_eur{$quote} = 1 / $rate; + } + + return %to_eur; +} + +sub sort_results { + my @rows = @_; + return sort { + defined($a->{eur}) && defined($b->{eur}) ? $a->{eur} <=> $b->{eur} + : defined($a->{eur}) ? -1 + : defined($b->{eur}) ? 1 + : $a->{country} cmp $b->{country} + } @rows; +}