#!/usr/bin/perl

# Copyright © 2006-2015 Jakub Wilk <jwilk@jwilk.net>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the “Software”), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use v5.10;

use strict;
use warnings (
    NONFATAL => qw(all),
    FATAL => qw(numeric)
);
use charnames ':full';
no encoding;

BEGIN { $::loading_modules = 1; }  ## no critic (PackageVars)

END {
    if ($::loading_modules) {  ## no critic (PackageVars)
        exit(-1);
    }
}

# cwd in @INC is harmful:
# http://www.nntp.perl.org/group/perl.perl5.porters/2010/08/msg162729.html
no lib '.';

# core modules:
use Encode ();
use English qw(-no_match_vars);
use File::Basename qw(dirname);
use File::Path ();
use FindBin ();
use Getopt::Long qw(:config gnu_compat permute no_getopt_compat no_ignore_case);
use Module::Loaded ();
use POSIX ();
use Symbol ();
use Text::ParseWords ();

# JSON:
BEGIN {
    eval {
        require JSON;
        JSON->import('encode_json');
        *_decode_json = \&JSON::decode_json;
    } or do {
        require JSON::PP;
        JSON::PP->import('encode_json');
        *_decode_json = \&JSON::PP::decode_json;
    }
}

# Work-around for HTTP::Cookies not catching write errors:
# https://bugs.debian.org/750850
BEGIN {
    *CORE::GLOBAL::close = sub(;*) {
        if (not @_) {
            return CORE::close();
        }
        my ($fh) = @_;
        $fh = Symbol::qualify_to_ref($fh, caller);
        my ($module) = caller;
        if (($module eq 'HTTP::Cookies') and not defined(wantarray)) {
            return (
                CORE::close($fh)
                or die $ERRNO  ## no critic (Carping)
            );
        } else {
            return CORE::close($fh);
        }
    };
}

# 3rd-party modules:
use Date::Format qw(time2str);
use Date::Parse qw(str2time);
use HTML::Form ();
use HTML::HeadParser ();
use HTML::TreeBuilder ();
use HTTP::Cookies ();
use HTTP::Message 5.802;
use HTTP::Request::Common qw(GET POST);
use IO::Socket::SSL 1.31;
use LWP::UserAgent ();
use LWP::Protocol::https ();
use Net::HTTPS ();  # must be loaded after IO::Socket::SSL
use Net::SSLeay ();

BEGIN { $::loading_modules = 0; }  ## no critic (PackageVars)

# ==========================
# logging and error handling
# ==========================

my $opt_verbose = 0;
my $opt_debug_dir = undef;
my $bugtracker = 'https://code.google.com/p/mbank‐cli/issues';
my $bugreport_request = "Please file a bug at <$bugtracker>.\n";

sub write_log
{
    my ($message) = @_;
    defined($opt_debug_dir) or return;
    my $path = "$opt_debug_dir/log";
    open(my $log, '>>', $path)
        or os_error("$path: $ERRNO");
    print {$log} "$message\n";
    close($log)
        or os_error("$path: $ERRNO");
    return;
}

sub debug
{
    my ($message) = @_;
    $message = "* $message";
    write_log($message);
    if ($opt_verbose) {
        print {*STDERR} "$message\n";
    }
    return;
}

sub user_error
{
    my ($message) = @_;
    if (defined($message)) {
        write_log($message);
        print {*STDERR} "mbank-cli: $message\n";
    }
    exit(1);
}

sub config_error
{
    my ($config, $message) = @_;
    my $config_path;
    if (ref $config) {
        $config_path = $config->{__path__};
    } else {
        $config_path = $config;
    }
    $message = "$config_path: $message";
    return user_error($message);
}

sub http_error
{
    my ($request, $response) = @_;
    my $message = sprintf(
        'HTTP error %d while processing request <%s %s>',
        $response->code,
        $request->method,
        $request->uri
    );
    if ($EVAL_ERROR) {
        my $extra = $EVAL_ERROR;
        $extra =~ s/\n+$//;
        $extra =~ s/\n+/\n/g;
        if ($extra !~ /[(]/ and $IO::Socket::SSL::SSL_ERROR) {
            # If IO::Socket::IP is installed, LWP produces unhelpful error
            # messages for certificate verification failures:
            # https://bugs.debian.org/746686
            # As a work-around, append $IO::Socket::SSL::SSL_ERROR to the error
            # message.
            $extra .= "\n$IO::Socket::SSL::SSL_ERROR";
        }
        $extra =~ s/\n+$//;
        $extra =~ s/^/| /gm;
        $message .= "\n$extra\n";
    }
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(2);
}

sub http_decoding_error
{
    my ($request) = @_;
    my $message = sprintf(
        'HTTP decoding error while processing request <%s %s>',
        $request->method,
        $request->uri,
    );
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(2);
}

sub scraping_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    $message = "Scraping error: $message";
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    print {*STDERR} $bugreport_request;
    exit(3);
}

sub scraping_count
{
    my ($array, $n, $message) = @_;
    ref($array) eq 'ARRAY'
        or internal_error('not an array');
    my $m = scalar(@{$array});
    $n == $m
        and return @{$array};
    my $s = $n == 1 ? '' : 's';
    return scraping_error("$message: expected $n instance$s, got $m");
}

sub os_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    my $caller_name = (caller(1))[3] // '';
    if ($caller_name eq 'main::write_log') {
        # avoid infinite recursion
    } else {
        write_log($message);
    }
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(4);
}

sub internal_error
{
    my ($message, $level) = @_;
    $level //= 0;
    $message = "Internal error: $message";
    write_log($message);
    local $Carp::CarpLevel = $level + 1;
    Carp::cluck($message);
    print {*STDERR} $bugreport_request;
    exit(-1);
}

sub check_for_unexpected_options
{
    my %options = @_;
    return if not %options;
    my $message;
    {
        local $LIST_SEPARATOR = ', ';
        my @option_keys = sort(keys(%options));
        $message = "unexpected options: @option_keys";
    }
    return internal_error($message, 1);
}

# ====================
# internationalization
# ====================

my $_locale_encoding;
eval {
    require Encode::Locale;
    $_locale_encoding = 'locale';
} or do {
    # Encode::Locale is a dependency of LWP (>= 6.0),
    # but it might be unavailable on older systems.
    require I18N::Langinfo;
    I18N::Langinfo->import(qw(langinfo CODESET));
    $_locale_encoding = langinfo(CODESET());
};

my %_encoding_fallback = (
    0x104 => 'A', 0x105 => 'a', # letter A with ogonek
    0x0c1 => 'A', 0x0e1 => 'a', # letter A with acute
    0x0c4 => 'A', 0x0e4 => 'a', # letter A with diaeresis
    0x106 => 'C', 0x107 => 'c', # letter C with acute
    0x10c => 'C', 0x10d => 'c', # letter C with caron
    0x10e => 'D', 0x10f => 'd', # letter D with caron
    0x118 => 'E', 0x119 => 'e', # letter E with ogonek
    0x0c9 => 'E', 0x0e9 => 'e', # letter E with acute
    0x11a => 'E', 0x11b => 'e', # letter E with caron
    0x0cd => 'I', 0x0ed => 'i', # letter I with acute
    0x141 => 'L', 0x142 => 'l', # letter L with stroke
    0x139 => 'L', 0x13a => 'l', # letter L with acute
    0x13d => 'L', 0x13e => 'l', # letter L with caron
    0x143 => 'N', 0x144 => 'n', # letter N with acute
    0x147 => 'N', 0x148 => 'n', # letter N with caron
    0x0d3 => 'O', 0x0f3 => 'o', # letter O with acute
    0x0d4 => 'O', 0x0f4 => 'o', # letter O with circumflex
    0x154 => 'R', 0x155 => 'r', # letter R with acute
    0x158 => 'R', 0x159 => 'r', # letter R with caron
    0x15a => 'S', 0x15b => 's', # letter S with acute
    0x160 => 'S', 0x161 => 's', # letter S with caron
    0x164 => 'T', 0x165 => 't', # letter T with caron
    0x0da => 'U', 0x0fa => 'u', # letter U with acute
    0x16e => 'U', 0x16f => 'u', # letter U with ring above
    0x0dd => 'Y', 0x0fd => 'y', # letter Y with acute
    0x179 => 'Z', 0x17a => 'z', # letter Z with acute
    0x17b => 'Z', 0x17c => 'z', # letter Z with dot above
    0x17d => 'Z', 0x17e => 'z', # letter Z with caron
);

sub _encoding_fallback
{
    my ($u) = @_;
    return
      $_encoding_fallback{$u}
      // sprintf('<U+%04X>', $u);
}

sub bytes_to_unicode
{
    my ($u, $encoding) = @_;
    $encoding //= $_locale_encoding;
    return Encode::decode($encoding, $u);
}

sub unicode_to_bytes
{
    my ($s, $encoding) = @_;
    $encoding //= $_locale_encoding;
    return Encode::encode($encoding, $s, \&_encoding_fallback);
}

my %country_to_language = (
    cz => 'cs',  # Czech Republic => Czech
    pl => 'pl',  # Poland => Polish
    sk => 'sk',  # Slovakia => Slovak
);

my %locale_aliases = (
    'polish' => 'pl',
    'czech' => 'cz',
    'slovak' => 'sk',
);

my @known_countries = keys(%country_to_language);

sub guess_country
{
    my %cc = ();
    my $locales = POSIX::setlocale(POSIX::LC_ALL);
    my @locales = $locales =~ m/(?:^|;)LC_[A-Z_]+=([^;\s]+)/g;  ## no critic (EnumeratedClasses)
    for my $locale (@locales) {
        $locale = $locale_aliases{$locale} // ${locale};
        (my $cc = $locale) =~ s/_.*//;
        $cc =~ m/\A[a-z]{2}\Z/ or next;  ## no critic (EnumeratedClasses)
        if (exists($country_to_language{$cc})) {
            $cc{$cc} = 1;
        }
    }
    my @cc = keys(%cc);
    if (scalar(@cc) == 1) {
        my ($cc) = @cc;
        return $cc;
    }
    return;
}

# =========
# HTTP, TLS
# =========

my $ua = undef;

my $http_product_name = 'Mozilla/5.0 (Windows NT 6.1; rv:17.0) Gecko/20100101 Firefox/17.0';
my $http_read_size_hint = 1 << 20;  # 1 MiB
my $http_timeout = 30;

sub http_init
{
    my %options = @_;
    my $cookie_jar_path = delete $options{cookie_jar}
        // internal_error('missing cookie_jar');
    my $ca_path = delete $options{ca}
        // internal_error('missing ca');
    check_for_unexpected_options(%options);
    if ($Net::HTTPS::SSL_SOCKET_CLASS ne 'IO::Socket::SSL') {
        # This should not happen, but better safe than sorry.
        # We absolutely do not want Net::SSL (from the Crypt-SSLeay
        # distribution) as the TLS backend.
        internal_error("\$Net::HTTPS::SSL_SOCKET_CLASS == $Net::HTTPS::SSL_SOCKET_CLASS")
    };
    for my $key (grep { m/^HTTPS_/ } keys(%ENV)) {
        # HTTPS_CA_DIR and HTTPS_CA_FILE environment variables may disable or
        # cripple certificate validation:
        # https://bugs.debian.org/746579
        delete $ENV{$key};
    }
    my $ssl_version;
    if ($IO::Socket::SSL::VERSION >= 1.70) {
        # TLS v1.0 or later
        $ssl_version = 'SSLv23:!SSLv2:!SSLv3';
    } else {
        # TLS v1.0
        $ssl_version = 'TLSv1';
    }
    my @ssl_options = (
        SSL_version => $ssl_version,
        SSL_cipher_list => 'HIGH:!aNULL:!eNULL',
        SSL_ca_file => $ca_path,
        SSL_ca_path => undef,
            # If SSL_ca_path is not set explicitly to undef,
            # IO::Socket::SSL::set_args_filter_hack('use_defaults') fails to
            # correctly restore SSL_ca_* settings:
            # https://bugs.debian.org/750642
        SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER,
        SSL_verifycn_scheme => {
            check_cn => 0,
            wildcards_in_alt => 0,
            wildcards_in_cn => 0,
            ip_in_cn => 0,
        },
    );
    # The most straight-forward way to set SSL options is to use
    # LWP::UserAgent::ssl_opts. But this is only supported by LWP (>= 6.0).
    # Use IO::Socket::SSL::set_ctx_defaults() instead.
    # [set_ctx_defaults() is a deprected alias for set_defaults().
    # The latter function is not available in IO::Socket::SSL (<< 1.81).]
    IO::Socket::SSL::set_ctx_defaults(@ssl_options);
    my @cookie_jar_options = (
        ignore_discard => 1,
        hide_cookie2 => 1,
        parse_head => 0,
    );
    if ($cookie_jar_path ne '/dev/null') {
        # TODO: implement auto-logout if cookie jar is /dev/null
        push(@cookie_jar_options,
            file => $cookie_jar_path,
            autosave => 0,
        );
    };
    my $cookie_jar = HTTP::Cookies->new(@cookie_jar_options);
    my $ua = LWP::UserAgent->new(  ## no critic (ReusedNames)
        agent => $http_product_name,
        cookie_jar => $cookie_jar,
        protocols_allowed => ['https'],
        timeout => $http_timeout,
        keep_alive => 1,
    );
    if ($IO::Socket::SSL::VERSION >= 1.969) {
        # LWP::protocol::https (>= 6.0) stomps on SSL_verifycn_scheme, and
        # possibly also other settings: https://bugs.debian.org/747225
        IO::Socket::SSL::set_args_filter_hack('use_defaults');
        # TODO: Work around the bug also for earlier versions of
        # IO::Socket::SSL, which don't support set_args_filter_hack().
    }
    if ($LWP::UserAgent::VERSION >= 6) {
        $ua->ssl_opts(
            @ssl_options,
        )
    };
    $ua->default_header(
        'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
        'Accept-Encoding' => 'gzip, deflate',
        'Accept-Language' => 'en-US,en;q=0.5',
    );
    return $ua;
}

sub download
{
    my ($request) = @_;
    my $message = sprintf(
        '%s %s',
        $request->method,
        $request->uri
    );
    debug($message);
    my $response = $ua->request($request, undef, $http_read_size_hint);
    $response->decode()
        // http_decoding_error($request);
    my $content = $response->content;
    $content =~ s/\r//g;
    if (defined($opt_debug_dir)) {
        my $is_json = $response->headers->content_type() eq 'application/json';
        my $default_ext = $is_json ? 'json' : 'html';
        my $path = $request->uri;
        $path =~ s{^\w+://.*?/}{};
        $path =~ s/[?].*//;
        $path =~ s/[^[:alnum:].]/_/g;
        $path =~ s/(?:[.]\w+)?$/.$default_ext/;
        if ($path eq '.html') {
            $path = 'index.html';
        }
        $path = "$opt_debug_dir/$path";
        open(my $fh, '>', "$path")
            or os_error("$path: $ERRNO");
        print {$fh} $content;
        close($fh)
            or os_error("$path: $ERRNO");
        my $rpath = "${path}.request";
        open($fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        print {$fh} $request->dump(maxlength => 1);
        close($fh)
            or os_error("$rpath: $ERRNO");
        $rpath = "${path}.headers";
        open($fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        print {$fh} $response->dump(maxlength => 1);
        close($fh)
            or os_error("$rpath: $ERRNO");
    }
    if (not $response->is_success) {
        http_error($request, $response);
    }
    $content = $response->decoded_content()
        // http_decoding_error($request);
    my $url = $response->request->uri;
    return {
        response => $response,
        content => $content,
        url => $url,
    };
}

sub simple_download
{
    my ($request) = @_;
    my $message = sprintf(
        'simple %s %s',
        $request->method,
        $request->uri
    );
    debug($message);
    my $response = $ua->simple_request($request, undef, $http_read_size_hint);
    if ($response->is_error) {
        http_error($request, $response);
    }
    $response->decode()
        // http_decoding_error($request);
    return $response;
}

sub get_default_ca_path
{
    my ($name, @hashes) = @_;
    my $filename = "$name.crt";
    $filename =~ y/ /_/;
    my $path = "/usr/share/ca-certificates/mozilla/$filename";
    if (-r $path) {
        return $path;
    }
    my $ssl_cert_dir = $ENV{SSL_CERT_DIR};
    if (not defined($ssl_cert_dir) and $Net::SSLeay::VERSION >= 1.43) {
        # https://www.openssl.org/docs/crypto/SSLeay_version.html
        # SSLEAY_DIR == 5
        my $openssl_info = Net::SSLeay::SSLeay_version(5);
        my ($openssl_dir) = $openssl_info =~ m/\AOPENSSLDIR: "(.*)"\Z/;
        if (defined($openssl_dir)) {
            $ssl_cert_dir = "$openssl_dir/certs";
        }
    }
    if (defined($ssl_cert_dir)) {
        for my $hash (@hashes) {
            $path = "$ssl_cert_dir/$hash.0";
            # TODO: actually check if this is the certificate we want
            # hash collisions are unlikely, but not impossible
            -r $path or next;
            my $rpath = readlink($path) or next;
            $rpath =~ m{\A/}
                or $rpath = "$ssl_cert_dir/$rpath";
            return $rpath;
        }
    }
    return "$FindBin::Bin/ca.crt";
}

# ===========================
# configuration file handling
# ===========================

sub read_config
{
    my ($path) = @_;
    open(my $fh, '<', $path)
        or os_error("$path: $ERRNO");
    my $config = _read_config($fh, $path);
    close($fh)
        or os_error("$path: $ERRNO");
    return $config;
}

sub _read_config
{
    my ($fh, $path) = @_;
    my $pgp = undef;
    my $config = {
        __pgp__ => [],
        __path__ => $path,
    };
    while (<$fh>) {
        chomp;
        if (defined($pgp)) {  ## no critic (CascadingIfElse)
            $pgp .= "$_\n";
            if ($_ eq '-----END PGP MESSAGE-----') {
                push(@{$config->{__pgp__}}, $pgp);
                $pgp = undef;
            }
        } elsif ($_ eq '-----BEGIN PGP MESSAGE-----') {
            $pgp = "$_\n";
        } elsif (m/^(?:#|\s*$)/) {
            next;
        } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
            my ($key, $value) = ($1, $2);
            $key = lc($key);
            ($value) = Text::ParseWords::parse_line('^$', 0, $value);
            $config->{$key} = $value;
        } else {
            config_error($path, "syntax error: $_");
        }
    }
    return $config;
}

sub _decrypt_config
{
    my ($config) = @_;
    my $pgp_chunks = delete $config->{__pgp__};
    scalar(@{$pgp_chunks}) > 0 or return;
    eval {
        require IPC::Run;
    } // user_error('IPC::Run is required to decrypt the configuration file');
    for my $encrypted_data (@{$pgp_chunks}) {
        my $decrypted_data;
        eval {
            IPC::Run::run(
                ['gpg', '-d'],
                '<', \$encrypted_data,
                '>', \$decrypted_data,
            ) or os_error('gpg -d failed');
        } // do {
            os_error($EVAL_ERROR);
        };
        my @decrypted_data = split(/\n/, $decrypted_data);
        for (@decrypted_data) {
            if (m/^(?:#|\s*)$/) {
                next;
            } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
                my ($key, $value) = ($1, $2);
                $key = lc($key);
                ($value) = Text::ParseWords::parse_line('^$', 0, $value);
                $config->{$key} = $value;
            } else {
                config_error($config, "syntax error in encrypted part: $_");
            }
        }
    }
    return $config;
}

sub get_config_var
{
    my ($config, $var, $default) = @_;
    if (exists($config->{$var}) or defined($default)) {
        if (ref($default)) {
            $default = ${$default};
        }
        return $config->{$var} // $default;
    }
    _decrypt_config($config);
    return $config->{$var};
}

# ============
# misc parsing
# ============

## no critic (ComplexRegexes)
my $account_number_re = qr{
  \d{2}(?:[ ]\d{4}){6}  # Polish IBAN (without the country code)
| CZ\d{2}(?:[ ]\d{4}){5}  # Czech IBAN: https://www.cnb.cz/en/payment_systems/iban/IBAN_international_account_number.html
| SK\d{2}(?:[ ]\d{4}){5}  # Slovak IBAN: http://www.nbs.sk/en/payment-systems/iban/iban-slovak-republic
| (?:\d{1,6}-)?\d{2,10}/\d{4}  # Slovak national format: http://www.nbs.sk/en/payment-systems/iban/iban-slovak-republic
}x;
## use critic

sub format_amount
{
    my ($s, %options) = @_;
    my $use_plus = delete($options{plus});
    my $currency = delete($options{currency});
    my $fp = delete($options{fp});
    check_for_unexpected_options(%options);
    if ($fp) {
        if (not defined($currency)) {
            internal_error('floting-point number, but no currency');
        }
        $s = format_number('%.2f', $s);
    }
    my $sign_re;
    $s =~ s/\s+(?=\d)//g;
    if ($use_plus) {
        $sign_re = qr/[+-]?/;
    } else {
        $sign_re = qr/-?/;
    }
    my $amount_re = qr/($sign_re\d+[.,]\d{2})/;
    my $currency_re;
    if (defined $currency) {
        $currency =~ m/\A[A-Z]{3}\z/  ## no critic (EnumeratedClasses)
            or return;
        $currency_re = qr//;
    } else {
        $currency_re = qr/\s+([A-Z]{3})/;  ## no critic (EnumeratedClasses)
    }
    my ($amount, $parsed_currency) = ($s =~ m/\A$amount_re$currency_re\z/)
        or return;
    $amount =~ y/,/./;
    $currency //= $parsed_currency;
    return sprintf('%10s %s', $amount, $currency);
}

sub format_number
{
    my ($format, $n) = @_;
    my $s;
    eval {
        $s = sprintf($format, $n);
    } // return;
    return $s;
}

sub parse_timestamp
{
    my ($timestamp, %options) = @_;
    my $discard_time = delete($options{discard_time});
    check_for_unexpected_options(%options);
    my ($date, $time) = ($timestamp =~ m/\A(\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d[.]\d+)\z/)
        or return;
    $discard_time or ($time =~ m/\A[0:.]+\Z/)
        or return;
    str2time("$date UTC")
        or return;
    return $date;
}

sub parse_le_date
{
    my ($date) = @_;
    my ($d, $m, $y) = ($date =~ m/\A(\d\d)-(\d\d)-(\d\d\d\d)\z/)
        or return;
    $date = "$y-$m-$d";
    str2time("$date UTC")
        or return;
    return $date;
}

sub shift_date
{
    my ($date, $offset) = @_;
    my $unix_ts = str2time("$date UTC");
    defined $unix_ts
        or return;
    my $seconds_in_day = 60 * 60 * 24;
    $unix_ts += $offset * $seconds_in_day;
    $date = time2str('%Y-%m-%d', $unix_ts, 'UTC');
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or return;
    return $date;
}

sub wildcards_to_regexp
{
    my (@wildcards) = @_;
    my $re = join('|',
        map { quotemeta } @wildcards
    );
    $re =~ s/\\[*]/.*/g;
    $re = qr{^(?i:($re))$};
    return $re;
}

sub html_class_regexp
{
    my ($class) = @_;
    return qr/(?:\A|\s)\Q$class\E(?:\s|\z)/;
}

sub find_html_class
{
    my ($element, $class) = @_;
    my $re = html_class_regexp($class);
    return $element->look_down('class', $re);
}

sub decode_json
{
    my ($json) = @_;
    return eval {
        _decode_json($json);
    } // return;
}

# =======================
# command implementations
# =======================

my $mbank_host = undef;
my $base_url = undef;
my $csite_url = undef;

my @json_headers = (
    'Accept' => 'application/json, text/javascript, */*; q=0.01',
    'Content-Type' => 'application/json; charset=UTF-8',
    'X-Requested-With' => 'XMLHttpRequest',
);

my @ajax_headers = (
    'Accept' => '*/*',
    'Content-Type' => 'application/x-www-form-urlencoded; charset=UTF-8',
    'X-Requested-With' => 'XMLHttpRequest',
);

my @ajax_html_headers = (
    'Accept' => 'text/html, */*; q=0.01',
    'Content-Type' => 'application/x-www-form-urlencoded; charset=UTF-8',
    'X-Requested-With' => 'XMLHttpRequest',
);

sub _extract_login_menu
{
    my ($html) = @_;
    my %menu = ();
    for my $e_script ($html->look_down(_tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($js) = ($content =~ m/\A\s*nmbMenu\s*=\s*([{].+[}])\s*\z/s)
            or next;
        $js =~ s/'/"/g;
        $js =~ s/(\w+):/"$1":/g;
        $js =~ s/,\s*}/}/g;
        my $json = decode_json($js)
            or scraping_error("login.menu.json: $EVAL_ERROR");
        while (my ($key, $value) = each %{$json}) {
            $key =~ m/\A\w+\z/
                or scraping_error("login.menu.key: $key");
            my $url = $value->{url} // '';
            $url =~ m{\A/\S+\z}
                or scraping_error("login.menu.url: $url");
            $menu{$key} = $url;
        }
        last;
    }
    return %menu;
}

sub _extract_login_profiles
{
    my ($html) = @_;
    my %profiles = (
        personal => [],
        business => [],
    );
    for my $e_script ($html->look_down(_tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($js) = ($content =~ m/^\s*Ebre[.]Venezia[.]ProfileData\s*=\s*([{].+[}]);\s*$/m)
            or next;
        $js = unicode_to_bytes($js, 'UTF-8');
        my $json = decode_json($js)
            or scraping_error("login.profiles.json: $EVAL_ERROR");
        while (my ($key, $value) = each %{$json}) {
            if ($key eq 'iProfiles') {
                $key = 'personal';
            } elsif ($key eq 'fProfiles') {
                $key = 'business';
            } else {
                scraping_error("login.profiles.key: $key");
            }
            my @js_profiles = @{$value->{profiles}};
            for my $js_profile (@js_profiles) {
                my $code = $js_profile->{profileCode};
                push(@{$profiles{$key}}, $code);
            }
        }
        last;
    }
    return %profiles;
}

sub do_login
{
    my %options = @_;
    my $cfg = delete($options{config});
    check_for_unexpected_options(%options);
    my $request = GET($base_url);
    my $doc = download($request);
    if ($doc->{url} =~ m{/Login$}) {
        if (not defined($cfg)) {
            debug('not logged in');
            return;
        }
        debug('logging in...');
        my ($seed) = ($doc->{content} =~ m/entrypoint[.]initialize[(]'([\w=-]+)'[,)]/)
            or scraping_error('login.seed');
        my $login_url = $doc->{url};
        my $login = get_config_var($cfg, 'login')
            // config_error($cfg, 'missing login');
        my $password = get_config_var($cfg, 'password')
            // config_error($cfg, 'missing password');
        $request = POST(
            "$base_url/LoginMain/Account/JsonLogin",
            @json_headers,
            'Referer' => $login_url,
            'Content' => encode_json({
                UserName => $login,
                Password => $password,
                Seed => $seed,
                Lang => '',
            }),
        );
        $doc = download($request);
        my $login_json = decode_json($doc->{content})
            // scraping_error("login.json: $EVAL_ERROR");
        if ($login_json->{successful}) {
            $request = GET($base_url);
            $doc = download($request);
        } else {
            my $message = $login_json->{errorMessageTitle} // 'unknown error';
            $message = unicode_to_bytes($message);
            user_error("login failed: $message");
        }
    }
    my $tabid = undef;
    $ua->cookie_jar->scan(
        sub {
            my ($version, $key, $value, $path, $domain) = @_;
            if (($domain eq $mbank_host) and ($key eq 'mBank_tabId')) {
                $tabid = $value;
            }
        }
    );
    defined($tabid)
        or scraping_error('login.tabid');
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my ($e_meta) = $html->look_down(
        _tag => 'meta',
        name => '__AjaxRequestVerificationToken'
    );
    defined($e_meta)
        or scraping_error('login.arvt');
    my $arvt = $e_meta->attr('content') // '';
    $arvt =~ m{\A[\w/+=]{100,}\z}
        or scraping_error("login.arvt: $arvt");
    my %menu = _extract_login_menu($html);
    my %profiles = _extract_login_profiles($html);
    debug('logged in');
    return {
        tabid => $tabid,
        arvt => $arvt,
        menu => \%menu,
        profiles => \%profiles,
        url => $doc->{url},
    };
}

sub do_list
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $quiet = delete($options{quiet}) // 0;
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/MyDesktop/Desktop/GetAccountsList",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '{}',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("list.json: $EVAL_ERROR");
    my @accounts = @{$json->{accountDetailsList}};
    my @result;
    for my $account (@accounts) {
        my $name = $account->{ProductName}
            // scraping_error('list.product-name');
        my $subtitle = $account->{SubTitle} // '';
        if ($subtitle ne '') {
            $name .= " - $subtitle";
        }
        my $number = $account->{AccountNumber} // '';
        $number =~ m/\A$account_number_re\z/
            or scraping_error("list.account-number: $number");
        push(@result, {
            name => $name,
            number => $number,
        });
        next if $quiet;
        my $balance = $account->{Balance}
            // scraping_error('list.balance');
        my $available = $account->{AvailableBalance}
            // scraping_error('list.available');
        my $currency = $account->{Currency}
            // scraping_error('list.currency');
        $balance = format_amount($balance, currency => $currency)
            // scraping_error("list.balance: $balance $currency");
        $available = format_amount($available, currency => $currency)
            // scraping_error("list.available: $available $currency");
        $name = unicode_to_bytes($name);
        print("$name\t$number\t$balance\t$available\n");
    }
    return [@result];
}

sub select_accounts
{
    my ($account_info, @selection) = @_;
    my $regexp = wildcards_to_regexp(
        map { bytes_to_unicode $_ } @selection
    );
    my %result = ();
    for my $account (@{$account_info}) {
        my $name = $account->{name};
        my $number = $account->{number};
        if ($name =~ $regexp) {
            debug("selected account: $number");
            $result{$number} = $name;
        } else {
            debug("deselected account: $number");
        }
    }
    return %result;
}

sub _clean_history_form
{
    my ($form, %options) = @_;
    my $parameters = delete($options{'params'});
    my $reset = delete($options{'reset'});
    check_for_unexpected_options(%options);
    for my $input ($form->inputs) {
        my $name = $input->name // '';
        if ($name =~ m/\Alastdays_\w+\z/) {
            $input->disabled(1);
        }
        if ($reset and $name !~ m/\A__/) {
            $input->disabled(1);
        }
    }
    if (defined($parameters)) {
        my $input = $form->find_input('__PARAMETERS')
            // scraping_error('history.form.params');
        $input->readonly
            or scraping_error('history.form.params.ro');
        $input->readonly(0);
        $input->value($parameters);
        $input->readonly(1);
    }
    return;
}

sub _prepare_history
{
    my ($login_info) = @_;
    my $module = 'account_oper_list';
    my $frameset_url = "frames.aspx?module=$module";
    my $menu_url = $login_info->{menu}->{hosthistory} // '';
    $menu_url eq "/csite/$frameset_url"  # sanity check
        or scraping_error("history.menu: $menu_url");
    my $request = GET(
        "$csite_url/$frameset_url",
        'Referer' => $login_info->{url},
    );
    my $doc = download($request);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my ($e_frame) = $html->look_down(
        _tag => 'frame',
        name => 'MainFrame',
    );
    defined($e_frame)
        or scraping_error('history.frame');
    my $frame_url = $e_frame->attr('src') // '';
    $frame_url =~ s/\A\s+|\s+\z//g;
    $frame_url eq "$module.aspx"  # sanity check
        or scraping_error("history.frame.url: $frame_url");
    $request = GET(
        "$csite_url/$frame_url",
        'Referer' => $doc->{url},
    );
    $doc = download($request);
    return $doc;
}

sub do_history
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $account_info = delete($options{accounts})
        // internal_error('missing account info');
    my $selection = delete($options{selection})
        // internal_error('missing selection');
    my @selection = @{$selection};
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    my $start_date = delete($options{start_date});
    my $end_date = delete($options{end_date});
    my $export = delete($options{export});
    check_for_unexpected_options(%options);
    my $doc = _prepare_history($login_info);
    my %selected_accounts = select_accounts($account_info, @selection)
        or user_error('history: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    if (defined($export)) {
        if (scalar(keys(%selected_accounts)) != 1) {
            user_error('history: exactly one account required for --export');
        }
    }
    for my $number (sort keys %selected_accounts) {
        $doc = _do_history_account(
            document => $doc,
            number => $number,
            name => $selected_accounts{$number},
            display_name => $display_name,
            start_date => $start_date,
            end_date => $end_date,
            export => $export,
        );
        defined($doc)
            or internal_error('missing document');
    }
    return;
}

sub _switch_history_account
{
    my %options = @_;
    my $doc = delete($options{document})
        // internal_error('missing document');
    my $number = delete($options{'number'})
        // internal_error('missing account number');
    check_for_unexpected_options(%options);
    my $parameters = undef;
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my ($e_account_menu) = $html->look_down(id => 'MenuAccountsCombo');
    defined($e_account_menu)
        or scraping_error('history.account-menu');
    my @e_accounts = $e_account_menu->content_list();
    for my $e_account (@e_accounts) {
        my $o_name = $e_account->as_trimmed_text();
        my ($o_number) = ($o_name =~ m/- ($account_number_re)\z/)
            or scraping_error("history.account.number: $o_name");
        if ($number eq $o_number) {
            if ($e_account->attr('selected')) {
                $parameters = ''
            } else {
                $parameters = $e_account->attr('value');
            }
            last;
        }
    }
    defined($parameters)
        or scraping_error("history.account.phantom: $number");
    if (length($parameters) > 0) {
        my @forms = HTML::Form->parse(
            $doc->{response},
            strict => 1,
        );
        my ($form) = scraping_count(\@forms, 1, 'history.form#');
        _clean_history_form($form, params => $parameters);
        $doc = download($form->click());
    }
    return $doc;
}

sub _do_history_account
{
    my %options = @_;
    my $doc = delete($options{document})
        // internal_error('missing document');
    my $name = delete($options{'name'})
        // internal_error('missing account name');
    my $number = delete($options{'number'})
        // internal_error('missing account number');
    my $start_date = delete($options{start_date});
    my $end_date = delete($options{end_date});
    my $export = delete($options{export});
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    $doc = _switch_history_account(
        document => $doc,
        number => $number,
    );
    my @forms = HTML::Form->parse(
        $doc->{response},
        strict => 1,
    );
    my ($form) = scraping_count(\@forms, 1, 'history.form#');
    if (defined($start_date) or defined($end_date)) {
        my $min_date = '1901-01-01';
        my $get_limit = sub {
            my ($var) = @_;
            my $min_date_nh = $min_date;
            $min_date_nh =~ s/-//g;
            my $regexp_template =
                "DateValidator(theform.daterange_${var}_day, '$min_date_nh', '<YYYY><MM><DD>', '', '')";
            # Replace <YYYYY> with (\d\d\d\d), <MM> with (\d\d), and so on;
            # treat everything else literally:
            my $regexp = "\\b\Q$regexp_template\E";
            $regexp =~ s/\\<([YMD]+)\\>/'(' . ('\d' x length($1)) . ')'/eg;
            my @limit = ($doc->{content} =~ $regexp)
                or return;
            return join('-', @limit);
        };
        my $set_date = sub {
            my ($var, $date) = @_;
            $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
                or internal_error("invalid date: $date");
            my ($y, $m, $d) = split(m/-/, $date);
            $m =~ s/\A0//;
            $d =~ s/\A0//;
            $form->value("daterange_${var}_day", $d);
            $form->value("daterange_${var}_month", $m);
            $form->value("daterange_${var}_year", $y);
            $form->value('rangepanel_group', 'daterange_radio');
            return;
        };
        my $now = my $start_limit = $get_limit->('from')
            // scraping_error('history.limit.start');
        my $end_limit = $get_limit->('to')
            // scraping_error('history.limit.end');
        # start date:
        $start_date //= $now;
        $min_date le $start_date
            or user_error('--from date too far in the past');
        $start_date le $start_limit
            or user_error('--from date in the future');
        $set_date->('from', $start_date);
        # end date:
        $end_date //= $now;
        $min_date le $end_date
            or user_error('--to date too far in the past');
        $end_date le $end_limit
            or user_error('--to date too far in the future');
        $start_date le $end_date
            or user_error('--to date before --from date');
        $set_date->('to', $end_date);
    }
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my $e_submit = $html->look_down(
        _tag => 'button',
        id => 'Submit'
    ) // scraping_error('history.submit');
    my $onclick = $e_submit->attr('onclick') // '';
    my $default_module = 'account_oper_list';
    my $export_module = 'printout_oper_list';
    $onclick eq "return OperationHistoryExport(export_oper_history_check, '/csite/$export_module.aspx', '/csite/$default_module.aspx')"
        or scraping_error("history.submit.onclick: $onclick");
    my $i_export = $form->find_input('export_oper_history_check')
        // scraping_error('history.form.export');
    if (defined($export)) {
        $i_export->check();
        my $i_export_format = $form->find_input('export_oper_history_format')
            // scraping_error('history.form.export-format');
        $i_export_format->value($export);
        $form->action("$csite_url/$export_module.aspx");
    } else {
        $i_export->value(undef);
        $form->action("$csite_url/$default_module.aspx");
    }
    _clean_history_form($form);
    if (defined($export)) {
        my $response = simple_download($form->click());
        # FIXME: The whole file is loaded into memory.
        # Istead, we should read and write it in chunks.
        print {*STDOUT} $response->content;
        return 1;
    }
    $doc = download($form->click());
    PAGE: while (1) {
        $html = HTML::TreeBuilder->new_from_content($doc->{content});
        _do_history_page(
            html => $html,
            name => $name,
            display_name => $display_name,
        );
        my ($e_prevpage) = $html->look_down(
            _tag => 'button',
            id => 'PrevPage',
        );
        if (defined($e_prevpage)) {
            $onclick = $e_prevpage->attr('onclick') // '';
            my $url = $doc->{response}->base;
            $url =~ s{\A.*?(?=/csite/)}{};
            my $regexp_template =
                "doSubmit('$url','','POST','<params>',true,false,true,null);";
            # Replace <params> with ([^']*); treat everything else literally:
            my $regexp = "\\A\Q$regexp_template\E";
            $regexp =~ s/\\<params\\>/([^']*)/g;
            $regexp !~ m/</
                or internal_error("unexpected character in regexp: $regexp");
            my ($parameters) = ($onclick =~ $regexp)
                or scraping_error("history.prev.onclick: $onclick");
            @forms = HTML::Form->parse(
                $doc->{response},
                strict => 1,
            );
            ($form) = scraping_count(\@forms, 1, 'history.prev.form#');
            _clean_history_form($form, params => $parameters);
            $doc = download($form->click());
            next PAGE;
        } else {
            last PAGE;
        }
    }
    return $doc;
}

sub _do_history_page {
    my %options = @_;
    my $html = delete($options{html})
        // internal_error('missing html');
    my $name = delete($options{name})
        // internal_error('missing name');
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    my @e_op_descs = find_html_class($html, 'OperationDescription');
    if (not @e_op_descs) {
        $html->look_down(id => 'account_operations_NoData')
            or scraping_error('history.empty');
        return;
    }
    for my $e_op_desc (@e_op_descs) {
        my $e_op = $e_op_desc->parent;
        $e_op->tag eq 'li'
            or scraping_error('history.table');
        my $class = $e_op->attr('class') // '';
        $class !~ html_class_regexp('header')
            or next;
        # dates:
        my @e_dates = find_html_class($e_op, 'Date');
        my ($e_dates) = scraping_count(\@e_dates, 1, 'history.date.1#');
        @e_dates = $e_dates->content_list();
        scraping_count(\@e_dates, 2, 'history.date.2#');
        my @dates = ();
        for my $e_date (@e_dates) {
            my $date = $e_date->as_trimmed_text();
            $date = parse_le_date($date)
                // scraping_error("history.date: $date");
            push(@dates, $date);
        }
        # amounts:
        my @e_amounts = find_html_class($e_op, 'Amount');
        scraping_count(\@e_amounts, 2, 'history.amount#');
        my @amounts;
        for my $e_amount (@e_amounts) {
            my $amount = $e_amount->as_trimmed_text();
            $amount = format_amount($amount)
                // scraping_error("history.amount: $amount");
            push(@amounts, $amount);
        }
        # details:
        my @e_details = $e_op_desc->content_list();
        my $n_details = scalar(@e_details);
        $n_details >= 3
            or scraping_error("history.details#: expected >= 3 instances, got $n_details");
        my @details;
        for my $e_detail (@e_details) {
            $class = $e_detail->attr('class') // '';
            if ($class =~ html_class_regexp('FilterType')) {
                next;
            }
            my $detail = $e_detail->as_trimmed_text();
            $detail =~ s/\N{SOFT HYPHEN}//g;
            $detail = unicode_to_bytes($detail);
            push(@details, $detail);
        }
        # print:
        {
            local $LIST_SEPARATOR = "\t";
            if ($display_name) {
                print("$name\t");
            }
            print("@dates\t@amounts\t@details\n");
        }
    }
    return;
}

sub _prepare_blocked
{
    my ($login_info) = @_;
    my $doc = _prepare_history($login_info);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my $module = 'witholdings_list';
    my $url = "/csite/$module.aspx";
    $html->look_down(
        _tag => 'a',
        onclick => qr/\A\QdoSubmit('$url','','POST','',false,true,false,null);\E/,
    )
        or scraping_error('blocked.module');
    my @forms = HTML::Form->parse(
        $doc->{response},
        strict => 1,
    );
    my ($form) = scraping_count(\@forms, 1, 'blocked.form#');
    _clean_history_form($form,
        params => '',
        reset => 1
    );
    $form->action("$csite_url/$module.aspx");
    $doc = download($form->click);
    return $doc;
}

sub do_blocked
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $account_info = delete($options{accounts})
        // internal_error('missing account info');
    my $selection = delete($options{selection})
        // internal_error('missing selection');
    my @selection = @{$selection};
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    my $doc = _prepare_blocked($login_info);
    my %selected_accounts = select_accounts($account_info, @selection)
        or user_error('blocked: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    for my $number (sort keys %selected_accounts) {
        $doc = _do_blocked_account(
            document => $doc,
            number => $number,
            name => $selected_accounts{$number},
            display_name => $display_name,
        );
        defined($doc)
            or internal_error('missing document');
    }
    return;
}

sub _do_blocked_account
{
    my %options = @_;
    my $doc = delete($options{document})
        // internal_error('missing document');
    my $name = delete($options{'name'})
        // internal_error('missing account name');
    my $number = delete($options{'number'})
        // internal_error('missing account number');
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    $doc = _switch_history_account(
        document => $doc,
        number => $number,
    );
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my $nothing_blocked = $html->look_down(
        _tag => 'div',
        id => 'witholdingsListHoldings_NoData',
    );
    if ($nothing_blocked) {
        return $doc;
    }
    my $e_blocked = $html->look_down(
        _tag => 'div',
        id => 'witholdingsListHoldings',
    );
    $e_blocked
        or scraping_error('blocked.table');
    my @e_ops = $e_blocked->look_down(_tag => 'li');
    @e_ops
        or scraping_error('blocked.table.items');
    for my $e_op (@e_ops) {
        my $class = $e_op->attr('class') // '';
        $class !~ html_class_regexp('header')
            or next;
        # dates:
        my @e_dates = find_html_class($e_op, 'Date');
        scraping_count(\@e_dates, 2, 'blocked.date#');
        my @dates = ();
        for my $e_date (@e_dates) {
            my $date = $e_date->as_trimmed_text();
            $date = parse_le_date($date)
                // scraping_error("blocked.date: $date");
            push(@dates, $date);
        }
        # amount:
        my @e_amounts = find_html_class($e_op, 'Amount');
        my ($e_amount) = scraping_count(\@e_amounts, 1, 'blocked.amount#');
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            // scraping_error("blocked.amount: $amount");
        # description:
        my @e_descriptions = find_html_class($e_op, 'WitholdingDescription');
        my ($e_description) = scraping_count(\@e_descriptions, 1, 'blocked.description#');
        my $description = $e_description->as_trimmed_text();
        # type:
        my @e_types = find_html_class($e_op, 'WitholdingType');
        my ($e_type) = scraping_count(\@e_types, 1, 'blocked.type#');
        my $type = $e_type->as_trimmed_text();
        # print:
        {
            local $LIST_SEPARATOR = "\t";
            if ($display_name) {
                print("$name\t");
            }
            print("@dates\t$amount\t$description\t$type\n");
        }
    }
    return $doc;
}

sub do_future
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my $account_info = delete($options{accounts})
        // internal_error('missing account info');
    my $selection = delete($options{selection})
        // internal_error('missing selection');
    my @selection = @{$selection};
    my $display_name = delete($options{display_name})
        // internal_error('missing display_name');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/FutureOperations/Calendar/OPER_GetFutureTransfers",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '{"getFilter":true}',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("future.json: $EVAL_ERROR");
    my %selected_accounts = select_accounts($account_info, @selection)
        or user_error('future: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    my $transfer_info = $json->{transferInfos}
        // scraping_error('future.transfer');
    for my $transfer (@{$transfer_info}) {
        my $number = $transfer->{accountNumber} // '';
        $number =~ m/\A$account_number_re\z/
            or scraping_error("future.transfer.account-number: $number");
        my $name = $selected_accounts{$number};
        defined($name) or next;
        if ($display_name) {
            print("$name\t");
        }
        my $timestamp = $transfer->{date} // '';
        my $date = parse_timestamp($timestamp)
            // scraping_error("future.transfer.date: $timestamp");
        my $recipient = $transfer->{benef}
            // scraping_error('future.transfer.recipient');
        for my $key (qw(benefAddress benefCity)) {
            my $recipient_loc = $transfer->{$key} // '';
            if (length($recipient_loc) > 0) {
                $recipient .= "; $recipient_loc";
            }
        }
        my $description = $transfer->{description}
            // scraping_error('future.transfer.description');
        $description = unicode_to_bytes($description);
        my $amount = $transfer->{amount}
            // scraping_error('future.transfer.amount');
        my $currency = $transfer->{currency}
            // scraping_error('future.transfer.currency');
        $amount = format_amount($amount, fp => 1, currency => $currency)
            // scraping_error("future.transfer.amount: $amount $currency");
        my $status = $transfer->{transferType}
            // scraping_error('future.transfer.type');
        print("$date\t$recipient\t$description\t$amount\t$status\n");
    }
    return;
}

sub do_deposits
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/Savings/Deposits/getDepositsList",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("deposits.json: $EVAL_ERROR");
    $json = $json->{properties}
        // scraping_error('deposits.properties');
    $json->{footer}->{isListComplete}
        or scraping_error('deposits.incomplete');
    my $deposits = $json->{deposits};
    for my $deposit (@{$deposits}) {
        my $title = $deposit->{title}
            // scraping_error('deposits.title');
        $title = unicode_to_bytes($title);
        my $type = $deposit->{type}
            // scraping_error('deposits.type');
        $type = unicode_to_bytes($type);
        my $end_date = $deposit->{endDate} // '';
        $end_date = parse_timestamp($end_date)
            // scraping_error("deposits.end-date: $end_date");
        my $length = $deposit->{depositLength} // '';
        $length =~ m/\A\d+\z/
            or scraping_error("deposits.length: $length");
        my $start_date = shift_date($end_date, -$length)
            or internal_error("could not shift $end_date by -$length days");
        my $duration = $deposit->{period}
            // scraping_error('deposits.duration');
        $duration = unicode_to_bytes($duration);
        my $interest = $deposit->{interestRate} // '';
        $interest = format_number('%.2f', $interest)
            // scraping_error("deposits.interest: $interest");
        my $amount = $deposit->{startValue} // '';
        my $currency = $deposit->{currency} // '';
        $amount = format_amount($amount, fp => 1, currency => $currency)
            // scraping_error("deposits.amount: $amount $currency");
        # FIXME: the legacy interface has also “status”
        print("$title\t$type\t$start_date\t$end_date\t$duration\t$interest%\t$amount\n");
    }
    return;
}

sub do_cards
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/Cards/Cards/IndexData",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @ajax_html_headers,
        'Referer' => $login_info->{url},
        Content => '',
    );
    my $doc = download($request);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_cards = find_html_class($html, 'card-properties');
    for my $e_card (@e_cards) {
        my $e_name = find_html_class($e_card, 'card-name')
            // scraping_error('cards.name');
        my $name = $e_name->as_trimmed_text();
        my $e_number = find_html_class($e_card, 'card-number')
            // scraping_error('cards.number');
        my $number = $e_number->as_trimmed_text();
        my $e_owner = find_html_class($e_card, 'card-owner')
            // scraping_error('cards.owner');
        my $owner = $e_owner->as_trimmed_text();
        my $e_amount = find_html_class($e_card, 'card-amount')
            // scraping_error('cards.amount');
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            or scraping_error("cards.amount: $amount");
        print("$name\t$number\t$owner\t$amount\n");
    }
    return;
}

sub do_funds
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/InvestmentFunds/Dashboard/Dashboard",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @ajax_html_headers,
        'Referer' => $login_info->{url},
        Content => 'type=Normal',
    );
    my $doc = download($request);
    my $html = HTML::TreeBuilder->new_from_content($doc->{content});
    my @e_funds = find_html_class($html, 'investment-properties');
    for my $e_fund (@e_funds) {
        my $class = $e_fund->attr('class') // '';
        if ($class =~ html_class_regexp('wallet-properties')) {
            next;
        }
        my $e_name = find_html_class($e_fund, 'investment-name-group')
            // scraping_error('funds.name');
        my $name = $e_name->as_trimmed_text();
        $name = unicode_to_bytes($name);
        my $e_amounts = find_html_class($e_fund, 'investment-actual')
            // scraping_error('funds.amount');
        my @e_amounts = $e_amounts->look_down(_tag => 'span');
        my $n_amounts = scalar(@e_amounts);
        ($n_amounts == 1) or ($n_amounts == 2)
            or scraping_error("funds.amount#: expected 1 or 2 instances, got $n_amounts");
        my ($e_current_amount, $e_planned_amount) = @e_amounts;
        my $current_amount = $e_current_amount->as_trimmed_text();
        $current_amount = format_amount($current_amount)
            or scraping_error("funds.amount.current: $current_amount");
        my $planned_amount = undef;
        if (defined($e_planned_amount)) {
            $class = $e_planned_amount->attr('class') // '';
            $class =~ html_class_regexp('gray')
                or scraping_error('funds.amount.planned.gray');
            $planned_amount = $e_planned_amount->as_trimmed_text();
            $planned_amount = format_amount($planned_amount, plus => 1)
                or scraping_error("funds.amount.planned: $planned_amount");
        }
        my $line = "$name\t$current_amount";
        if (defined($planned_amount)) {
            $line .= "\t$planned_amount";
        }
        print("$line\n");
    }
    return;
}

sub do_notices
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/WhirlWind/AdvPlaceholder/GetUpdates",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
        Content => '{"placeholderIdList":null,"timestamp":-1}',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("notices.json: $EVAL_ERROR");
    my $elements = $json->{Elements}
        // scraping_error('notices.elements');
    for my $element (@{$elements}) {
        my $template_path = $element->{TemplatePath}
            // scraping_error('notices.template-path');
        my $message = $element->{Message}
            // scraping_error('notices.message');
        my $is_hidden = $message->{IsHidden}
            // scraping_error('notices.is-hidden');
        my $is_visible = (
            $template_path =~ m{/MessageBox/|/TopAdmin/}
            and not $is_hidden
        );
        $is_visible or next;
        my $is_read = $message->{IsRead}
            // scraping_error('notices.is-read');
        my $new_flag = $is_read ? '' : 'N';
        my $timestamp = $message->{StartDate};
        my $date = parse_timestamp($timestamp, discard_time => 1)
            // scraping_error("notices.date: $timestamp");
        my $title = $message->{Title}
            // scraping_error('notices.title');
        $title = unicode_to_bytes($title);
        print("$new_flag\t$date\t$title\n");
    }
    return;
}

sub do_activate_profile
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    my @args = @{delete($options{args})};
    check_for_unexpected_options(%options);
    scalar(@args) > 0
        or user_error('activate-profile: no profile selected');
    scalar(@args) <= 1
        or user_error('activate-profile: too many arguments');
    my ($name) = @args;
    my %profiles = %{$login_info->{profiles}};
    if (not exists($profiles{$name})) {
        my $profiles = join(', or ', map { "\"$_\"" } sort(keys(%profiles)));
        user_error("activate-profile: invalid profile name (should be $profiles)");
    }
    my @codes = @{$profiles{$name}};
    if (scalar @codes == 0) {
        user_error("activate-profile: $name profile not available");
    } elsif (scalar @codes > 1) {
        internal_error('activate-profile: support for multiple profiles of the same type is not implemented yet');
    };
    my ($code) = @codes;
    if ($code eq 'T') {
        # ‘I’ (“individual profile”) is a superset of ‘T’ ("own products"),
        # so let's use the latter:
        $code = 'I';
    }
    debug("activating profile $code...");
    my $request = POST(
        "$base_url/LoginMain/Account/JsonActivateProfile",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @ajax_headers,
        'Referer' => $login_info->{url},
        'Content' => "profileCode=$code",
    );
    my $doc = download($request);
    # It's tempting to do decode_json() here, but actually,
    # despite the Content-Type, the response is not valid JSON.
    # Yay...
    _do_lazy_logout(login => $login_info);
    return;
}

sub _do_lazy_logout
{
    my %options = @_;
    my $login_info = delete($options{login})
        // internal_error('missing login info');
    check_for_unexpected_options(%options);
    my $request = POST(
        "$base_url/LoginMain/Account/LazyLogout",
        'X-Tab-Id' => $login_info->{tabid},
        'X-Request-Verification-Token' => $login_info->{arvt},
        @json_headers,
        'Referer' => $login_info->{url},
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content})
        // scraping_error("logout.json: $EVAL_ERROR");
    $json->{lazy}
        or scraping_error('logout.lazy');
    return;
}

sub do_logout
{
    my %options = @_;
    my $login_info = do_login();
    if (not defined($login_info)) {
        $ua->cookie_jar->clear();
        debug('cookies have been wiped out');
        user_error('logout: the user was not logged in')
    } else {
        debug('logging out...');
        _do_lazy_logout(login => $login_info);
        my $request = GET(
            "$base_url/LoginMain/Account/Logout",
            'Referer' => $login_info->{url},
        );
        my $response = simple_download($request);
        $response->is_redirect
            or scraping_error('logout.redirect');
        debug('successful logout');
    }
    $ua->cookie_jar->clear();
    debug('cookies have been wiped out');
    return;
}

sub do_debug_noop
{
    # Nothing to do!
}

sub do_debug_https_get
{
    my %options = @_;
    my $urls = delete($options{args});
    check_for_unexpected_options(%options);
    my @urls = @{$urls};
    if (not @urls) {
        push(@urls, $base_url);
    }
    for my $url (@urls) {
        my $request = GET($url);
        my $doc = simple_download($request);
        print($doc->content());
    }
    return;
}

sub _make_config_line
{
    my ($key, $value) = @_;
    my $escaped_value = $value;
    if ($value !~ m{\A[/\w.~-]+\z}) {
        $value =~ s/["\\]/\\$1/;
        $value = qq("$value");
    }
    return "$key $value\n";
}

sub _configure_overwrite
{
    my ($term, $config_path) = @_;
    if (-e $config_path) {
        my $overwrite = '';
        until ($overwrite =~ m/\A[yYnN]\z/) {  ## no critic (Until)
            $overwrite = $term->readline(
                unexpand_tilde($config_path) . ' already exists. Overwrite (y/n)? '
            );
            $overwrite //= '';
        }
        if ($overwrite =~ m/[nN]/) {
            user_error();
        }
    }
    return;
}

sub _configure_country
{
    my ($term) = @_;
    my $guessed_cc = guess_country() // '';
    my $cc = '';
    until (exists($country_to_language{$cc})) {  ## no critic (Until)
        $cc = $term->readline('Country (CZ, or SK, or PL): ', uc($guessed_cc));
        $cc = lc($cc // '');
    }
    return $cc;
}

sub _configure_login
{
    my ($term) = @_;
    my $login = '';
    until (length($login) > 0) {  ## no critic (Until)
        $login = $term->readline('Login: ');
        $login //= '';
    }
    return $login;
}

sub _configure_password
{
    my ($term) = @_;
    my $readline_gnu = Module::Loaded::is_loaded('Term::ReadLine::Gnu');
    if ($readline_gnu) {
        defined($term->Attribs->{shadow_redisplay})
            or internal_error('shadow_redisplay not defined');
    }
    my $password = '';
    until (length($password) > 0) {  ## no critic (Until)
        local $term->Attribs->{redisplay_function} =  ## no critic (LocalVars)
            $term->Attribs->{shadow_redisplay};
        $password = $term->readline('Password: ');
        $password //= '';
    }
    my $use_gpg = '';
    until ($use_gpg =~ m/\A[yYnN]\z/) {  ## no critic (Until)
        $use_gpg = $term->readline('Encrypt password with GnuPG (y/n)? ', 'y');
        $use_gpg //= '';
    }
    $use_gpg = ($use_gpg =~ m/[yY]/);
    my $encrypted_password;
    ENCRYPT: while ($use_gpg) {
        my $password_line = _make_config_line('Password', $password);
        eval {
            require IPC::Run;
            my $secret_keys;
	        IPC::Run::run(
                [qw(gpg --batch --list-secret-keys)],
                '>', \$secret_keys,
            );
            if (not scalar($secret_keys)) {
                die(  ## no critic (Carping)
                    "No secret keys in the GnuPG keyring.\n" .
                    'Use "gpg --gen-key" to generate a key pair.'
                );
            }
            IPC::Run::run(
                [qw(gpg --armor --encrypt --default-recipient-self)],
                '<', \$password_line,
                '>', \$encrypted_password,
            )
        } or do {
            if ($EVAL_ERROR) {
                my $message = $EVAL_ERROR;
                my $file = __FILE__;
                $message =~ s/ at \Q$file\E line \d+[.]\n+//;
                print {*STDERR} "$message\n";
            }
            my $retry = '';
            until ($retry =~ m/\A[yYnN]\z/) {  ## no critic (Until)
                $retry = $term->readline('GnuPG encryption failed. Retry (y/n)? ');
                $retry //= '';
            }
            if ($retry =~ m/[yY]/) {
                next ENCRYPT;
            } else {
                user_error();
            }
        };
        last ENCRYPT;
    }
    return ($password, $encrypted_password);
}

sub _configure_cookie_jar
{
    my ($term, $login, $default_cookie_jar_path) = @_;
    (my $sanitized_login = $login) =~ s/\W/_/g;
    my $xdg_data_home = xdg_data_home();
    my $cookie_home = unexpand_tilde($xdg_data_home) . '/mbank-cli';
    $default_cookie_jar_path //= "$cookie_home/$sanitized_login.cookies";
    my $cookie_jar_path = '';
    until (length($cookie_jar_path) > 1) {  ## no critic (Until)
        $cookie_jar_path = $term->readline(
            'Session cookie store: ',
            $default_cookie_jar_path
        );
        $cookie_jar_path //= '';
    }
    return $cookie_jar_path;
}

sub do_configure
{
    my %options = @_;
    my $config_path = delete($options{config_path});
    my $cookie_jar_path = delete($options{cookie_jar_path});
    check_for_unexpected_options(%options);
    eval {
        require Term::ReadLine;
        if ($OSNAME ne 'MSWin32') {
            # We normally require Term::ReadLine::Gnu, so that it's possible to
            # ask for password without displaying it on the screen. But this
            # module is difficult to port to Windows. Oh well.
            require Term::ReadLine::Gnu;
        }
    } // user_error('Term::ReadLine::Gnu is required to run configure');
    my $term = Term::ReadLine->new('mbank-cli');
    _configure_overwrite($term, $config_path);
    my $cc = _configure_country($term);
    my $login = _configure_login($term);
    my ($password, $encrypted_password) = _configure_password($term);
    $cookie_jar_path = _configure_cookie_jar($term, $login, $cookie_jar_path);
    my $cookie_dir = dirname(expand_tilde($cookie_jar_path));
    if (not -d $cookie_dir) {
        eval {
            File::Path::make_path($cookie_dir);
        } // os_error($EVAL_ERROR);
        print(
            'Created directory for session cookie store: ',
            unexpand_tilde($cookie_dir),
            "\n"
        );
    }
    my $config_dir = dirname($config_path);
    eval {
        File::Path::make_path($config_dir);
    } // os_error($EVAL_ERROR);
    open(my $fh, '>', "$config_path.new")  ## no critic (BriefOpen)
        or os_error("$config_path.new: $ERRNO");
    print {$fh} _make_config_line('CookieJar', $cookie_jar_path);
    print {$fh} _make_config_line('Country', uc($cc));
    print {$fh} _make_config_line('Login', $login);
    if ($encrypted_password) {
        print {$fh} "# Password (encrypted):\n";
        print {$fh} $encrypted_password;
    } else {
        print {$fh} _make_config_line('Password', $password);
    }
    close($fh)
        or os_error("$config_path.new: $ERRNO");
    if (rename($config_path, "$config_path.bak")) {
        print(
            'Backup copy: ',
            unexpand_tilde("$config_path.bak"),
            "\n"
        );
    } elsif ($ERRNO{ENOENT}) {
        # okay
    } else {
        os_error("$config_path: $ERRNO");
    };
    rename("$config_path.new", $config_path)
        or os_error("$config_path: $ERRNO");
    print(
        'Created configuration file: ',
        unexpand_tilde($config_path),
        "\n"
    );
    return;
}

# ============================================
# filesystem; XDG Base Directory Specification
# ============================================

sub expand_tilde
{
    my ($path) = @_;
    $path =~ s{\A(~[^/]*)}{glob($1)}e;
    return $path;
}

sub unexpand_tilde
{
    my ($path) = @_;
    $path =~ s{\A\Q$ENV{HOME}\E/}{~/};
    return $path;
}

sub _xdg_home
{
    my ($key, $default) = @_;
    my $home = $ENV{"XDG_$key\_HOME"} // '';
    if ($home !~ m{\A/}) {
        # “All paths […] must be absolute.
        # If an implementation encounters a relative path […]
        # it should consider the path invalid and ignore it.
        $home = "$ENV{HOME}/$default";
    }
    $home =~ s{[^/]\K/+\z}{};  # strip trailing slashes
    return $home;
}

sub xdg_config_home
{
    return _xdg_home('CONFIG', '.config');
}

sub xdg_data_home
{
    my @args = @_;
    return _xdg_home('DATA', '.local/share');
}

# ============
# main program
# ============

our $VERSION = '1.3';

umask(
    umask() | oct('077')
);

my $xdg_config_home = xdg_config_home();
my $opt_config = "$xdg_config_home/mbank-cli/config";
my $opt_cookie_jar = undef;
my $opt_start_date = undef;
my $opt_end_date = undef;
my $opt_all = 0;
my $opt_multi = 0;
my $opt_export = undef;
my $cfg;

sub show_help
{
    print <<'EOF' ;
Usage:
  mbank-cli [list]
  mbank-cli history [--from <start-date> [--to <end-date>]] [--export <format>] {<account> | -M <account>... | -A}
  mbank-cli future {<account> | -M <account>... | -A}
  mbank-cli blocked {<account> | -M <account>... | -A}
  mbank-cli deposits
  mbank-cli funds
  mbank-cli cards
  mbank-cli notices
  mbank-cli logout
  mbank-cli activate-profile {personal | business}
  mbank-cli configure

Common options:
  --verbose
  --debug <debug-directory>
  --config <config-file>
  --cookie-jar <cookie-jar-file>
  --help
EOF
    exit();
}

sub show_version
{
    print "mbank-cli $VERSION\n";
    for my $module (qw(LWP::UserAgent LWP::Protocol::https IO::Socket::SSL Net::SSLeay)) {
        Module::Loaded::is_loaded($module)
            // internal_error("$module not loaded");
        my $version = $module->VERSION // '(no version information)';
        print("+ $module $version\n");
    }
    if ($Net::SSLeay::VERSION >= 1.43) {
        my $openssl = Net::SSLeay::SSLeay_version();
        $openssl =~ s/ xx XXX xxxx\z//;
        print("  * $openssl\n");
    }
    exit();
}

sub check_user_date
{
    my ($option, $date) = @_;
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or user_error("--$option date not in the YYYY-MM-DD format: $date");
    str2time($date)
        // user_error("invalid --$option date: $date");
    return $date;
}

sub check_export_format
{
    my ($option, $format) = @_;
    $format = uc($format);
    my @valid_formats = qw(CSV HTML PDF);
    if (not grep { $format eq $_ } @valid_formats) {  ## no critic (BooleanGrep)
        local $LIST_SEPARATOR = ', ';
        user_error("--$option format not in {@valid_formats}")
    }
    return $format;
}

sub initialize
{
    if (not -e $opt_config) {
        user_error(
            "missing configuration file: $opt_config\n" .
            'Run "mbank-cli configure" or create the configuration file manually.'
        );
    }
    $cfg = read_config($opt_config);
    my $cookie_jar_path;
    if (defined($opt_cookie_jar)) {
        $cookie_jar_path = $opt_cookie_jar;
    } else {
        $cookie_jar_path = get_config_var($cfg, 'cookiejar')
            // config_error($cfg, 'missing cookiejar');
        $cookie_jar_path = expand_tilde($cookie_jar_path);
    }
    debug("cookiejar = $cookie_jar_path");
    my $ca_path = get_config_var($cfg, 'cafile', \undef);
    if (defined($ca_path)) {
        $ca_path = expand_tilde($ca_path);
    } else {
        $ca_path = get_default_ca_path(
            'VeriSign Class 3 Public Primary Certification Authority - G5',
            # openssl x509 -subject_hash -noout
            'b204d74a',
            # openssl x509 -subject_hash_old -noout
            'facacbc6',
        );
    }
    if (not -r $ca_path) {
        os_error("$ca_path: $ERRNO");
    }
    debug("cafile = $ca_path");
    my $tld = get_config_var($cfg, 'country')
        // config_error($cfg, 'missing country');
    $tld = lc $tld;
    my $lang = $country_to_language{$tld};
    if (not defined($lang)) {
        local $LIST_SEPARATOR = ', ';
        my $known_countries = "{@known_countries}";
        config_error($cfg, "unknown country \U$tld\E, not in \U$known_countries\E");
    }
    $mbank_host = "online.mbank.$tld";
    $base_url = "https://$mbank_host/$lang";
    $csite_url = "https://$mbank_host/csite";
    $ua = http_init(
        cookie_jar => $cookie_jar_path,
        ca => $ca_path,
    );
    my @legacy_domains = (
        'mbank-cli.invalid',
        'www.mbank.com.pl',
        'cz.mbank.eu',
        'sk.mbank.eu',
    );
    my $legacy_domain;
    $ua->cookie_jar->scan(
        # sanity check
        sub {
            my ($version, $key, $value, $path, $domain) = @_;
            if (grep { $domain eq $_ } @legacy_domains) {  ## no critic (BooleanGrep)
                $legacy_domain ||= ($domain =~ m/[.]invalid$/) ? 0 : $domain;
            } elsif ($domain ne $mbank_host) {
                user_error("$cookie_jar_path: found cookies for unexpected domain: $domain (!= $mbank_host)")
            }
        }
    );
    if (defined($legacy_domain)) {
        my $message = "$cookie_jar_path: found cookies for legacy mbank-cli";
        if ($legacy_domain) {
            $message .= ": $legacy_domain";
        }
        user_error($message);
    }
    return;
}

{
    local $SIG{__WARN__} = sub {
        my ($message) = @_;
        $message =~ s/\A([[:upper:]])/lc($1)/e;
        $message =~ s/\n+\z//;
        user_error($message);
    };
    GetOptions(
        'verbose' => \$opt_verbose,
        'debug=s' => \$opt_debug_dir,
        'config=s' => \$opt_config,
        'cookie-jar=s' => \$opt_cookie_jar,
        'from=s' => sub {
            my ($option, $date) = @_;
            $opt_start_date = check_user_date($option, $date);
        },
        'to=s' => sub {
            my ($option, $date) = @_;
            $opt_end_date = check_user_date($option, $date);
        },
        'export=s' => sub {
            my ($option, $format) = @_;
            $opt_export = check_export_format($option, $format);
        },
        'M|multiple-accounts' => \$opt_multi,
        'A|all-accounts' => \$opt_all,
        'h|help' => \&show_help,
        'version' => \&show_version,
    ) or user_error();
}

if (defined($opt_export) and -t STDOUT) {  ## no critic (InteractiveTest)
    user_error('export data cannot be written to a terminal; please redirect stdout to a file');
}

my ($command_name, @args) = @ARGV;
$command_name //= 'list';
debug("selected command: $command_name");

my %commands = (
    'debug-noop' => {},
    'debug-https-get' => { args => 1 },
    'list' => {},
    'history' => { accounts => 1, dates => 1, export => 1 },
    'future' => { accounts => 1 },
    'blocked' => { accounts => 1 },
    'deposits' => {},
    'cards' => {},
    'funds' => {},
    'notices' => {},
    'logout' => { login => 0 },
    'activate-profile' => { args => 1 },
    'configure' => { login => 0, config => 0 },
);

my $command_info = $commands{$command_name};
if (not defined $command_info) {
    user_error("$command_name: invalid command");
}
my $command;
{
    no strict 'refs';  ## no critic (NoStrict)
    my $sub_name = "do_$command_name";
    $sub_name =~ y/-/_/;
    $command = *{$sub_name};
}
my $need_login = $command_info->{login} // 1;
my @cmd_options;
if ($command_name =~ m/^debug-/) {
    $need_login = 0;
}
if ($command_info->{config} // 1) {
    initialize();
} else {
    push(@cmd_options,
        config_path => $opt_config,
        cookie_jar_path => $opt_cookie_jar,
    );
}
if ($command_info->{todo} ) {
    user_error("$command_name: command not implemented");
}
if ($command_info->{accounts}) {
    my @selection = @args;
    if ($opt_all) {
        @selection = '*';
    }
    if (scalar(@selection) < 1) {
        user_error("$command_name: no account selected");
    }
    push(@cmd_options,
        selection => [@selection],
        display_name => $opt_all || $opt_multi,
    );
}
if ($command_info->{args}) {
    push(@cmd_options,
        args => [@args],
    );
}
if ($need_login) {
    my $login_info = do_login(config => $cfg);
    push(@cmd_options, login => $login_info);
    if ($command_info->{accounts}) {
        my $account_info = do_list(
            login => $login_info,
            quiet => 1,
        );
        push(@cmd_options, accounts => $account_info);
    }
}
if ($command_info->{dates}) {
    push(@cmd_options,
        start_date => $opt_start_date,
        end_date => $opt_end_date,
    );
}
if ($command_info->{export}) {
    push(@cmd_options, export => $opt_export);
}
$command->(@cmd_options);

END {
    # save cookies:
    if (defined($ua)) {
        my $cookie_jar_path = $ua->cookie_jar->{file};
        eval {
            $ua->cookie_jar->save();
            1;
        } // os_error("$cookie_jar_path: $ERRNO");
    }
}

END {
    # catch write errors:
    local $ERRNO = 0;
    close(STDOUT) or os_error("stdout: $ERRNO");
    close(STDERR) or os_error("stderr: $ERRNO");
}

# vim:ts=4 sts=4 sw=4 et
