#!/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{<script\b[^>]*type\s*=\s*(["'])application/ld\+json\1[^>]*>(.*?)</script>}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{<meta\b[^>]*>}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&quotes=$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;
}