package Pcore::API::Whois v0.2.5;

use Pcore -dist, -class;
use Pcore::API::Whois::Server;
use Pcore::API::Whois::Response qw[:CONST];
use Net::Whois::Raw::Data qw[];

has cache => ( is => 'ro', isa => Str );                                             # path to whois cache db
has cache_timeout => ( is => 'ro', isa => PositiveInt, default => 60 * 60 * 24 );    # in seconds

has dbh => ( is => 'lazy', isa => Maybe [ InstanceOf ['Pcore::Handle::SQLite'] ], init_arg => undef );

our $DB = P->cfg->load( $ENV->share->get('/data/whois.perl') );

our $PUB_SUFFIX;

for my $pub_suffix ( keys %Net::Whois::Raw::Data::servers ) {
    $PUB_SUFFIX->{ lc $pub_suffix } = $Net::Whois::Raw::Data::servers{$pub_suffix};
}

for my $pub_suffix ( keys $DB->{pub_suffix_server}->%* ) {
    $PUB_SUFFIX->{ P->host($pub_suffix)->name } = $DB->{pub_suffix_server}->{$pub_suffix};
}

sub _build_dbh ($self) {
    return if !$self->cache;

    H->add(
        whois        => 'SQLite',
        addr         => 'file:' . $self->cache,
        journal_mode => 'WAL',
        synchronous  => 'OFF',
        cache_size   => 20_000,
    );

    # DDL
    my $ddl = H->whois->ddl;

    $ddl->add_changeset(
        id  => 1,
        sql => <<'SQL'
                CREATE TABLE IF NOT EXISTS `whois` (
                    `domain` TEXT PRIMARY KEY NOT NULL,
                    `last_checked` INTEGER NULL,
                    `status` INTEGER NOT NULL
                );

                CREATE INDEX IF NOT EXISTS `idx_whois_domain_last_checked` ON `whois` (`domain` ASC, `last_checked` ASC);
SQL
    );

    $ddl->upgrade;

    return H->whois;
}

sub search ( $self, $domain, $cb = undef ) {
    my $blocking_cv = defined wantarray ? AE::cv : undef;

    state $q1 = $self->cache ? $self->dbh->query('SELECT status FROM whois WHERE domain = ? AND last_checked > ?') : undef;

    my $server_host;

    my @label = split /[.]/sm, P->host($domain)->canon;

    my $query;    # domain ascii

    if ( @label > 2 ) {
        my $pub_suffix = "$label[-2].$label[-1]";

        $server_host = $PUB_SUFFIX->{$pub_suffix};

        $query = "$label[-3].$label[-2].$label[-1]" if $server_host;
    }

    if ( !$server_host ) {
        my $pub_suffix = $label[-1];

        $server_host = $server_host = $PUB_SUFFIX->{$pub_suffix};

        $query = @label == 1 ? $label[-1] : "$label[-2].$label[-1]" if $server_host;
    }

    if ( !$server_host ) {
        my $res = Pcore::API::Whois::Response->new(
            {   query => $query // $domain,
                status => $WHOIS_NOT_SUPPORTED,
                reason => $Pcore::API::Whois::Response::STATUS_REASON->{$WHOIS_NOT_SUPPORTED}
            }
        );

        $cb->($res) if $cb;

        $blocking_cv->($res) if $blocking_cv;
    }
    else {
        if ( $self->cache ) {

            # check cache and return cached response
            if ( my $status = $q1->selectval( bind => [ $query, time - $self->cache_timeout ] ) ) {
                my $res = Pcore::API::Whois::Response->new(
                    {   query     => $query,
                        is_cached => 1,
                        status    => $status->$*,
                        reason    => $Pcore::API::Whois::Response::STATUS_REASON->{ $status->$* }
                    }
                );

                $cb->($res) if $cb;

                $blocking_cv->($res) if $blocking_cv;

                return;
            }
        }

        Pcore::API::Whois::Server->new(
            {   host => $server_host,
                cb   => sub($server) {
                    if ( !$server || !$server->is_supported ) {
                        my $res = Pcore::API::Whois::Response->new(
                            {   query  => $query,
                                status => $WHOIS_NOT_SUPPORTED,
                                reason => $Pcore::API::Whois::Response::STATUS_REASON->{$WHOIS_NOT_SUPPORTED}
                            }
                        );

                        $cb->($res) if $cb;

                        $blocking_cv->($res) if $blocking_cv;
                    }
                    else {
                        $self->_request(
                            $server, $query,
                            sub ($res) {
                                $cb->($res) if $cb;

                                $blocking_cv->($res) if $blocking_cv;

                                return;
                            }
                        );
                    }

                    return;
                }
            }
        );
    }

    return $blocking_cv ? $blocking_cv->recv : ();
}

sub _request ( $self, $server, $query, $cb ) {
    state $q1 = $self->cache ? $self->dbh->query('INSERT OR IGNORE INTO whois (last_checked, status, domain) VALUES (?, ?, ?)') : undef;

    state $q2 = $self->cache ? $self->dbh->query('UPDATE whois SET last_checked = ?, status = ? WHERE domain = ?') : undef;

    state $pool = {};

    push $pool->{$query}->@*, $cb;

    return if $pool->{$query}->@* > 1;

    $server->request(
        $query,
        sub ($res) {
            if ( $res->status == 200 ) {
                my $recognized;

                if ( $server->exceed_re ) {
                    for my $re ( $server->{exceed_re}->@* ) {
                        if ( $res->content->$* =~ $re ) {
                            $recognized = 1;

                            $res->set_status( $WHOIS_BANNED, $Pcore::API::Whois::Response::STATUS_REASON->{$WHOIS_BANNED} );

                            last;
                        }
                    }
                }

                if ( !$recognized && $server->notfound_re ) {
                    for my $re ( $server->{notfound_re}->@* ) {
                        if ( $res->content->$* =~ $re ) {
                            $recognized = 1;

                            $res->set_status( $WHOIS_NOT_FOUND, $Pcore::API::Whois::Response::STATUS_REASON->{$WHOIS_NOT_FOUND} );

                            last;
                        }
                    }
                }

                # cache results for successful query
                $q1->do( bind => [ time, $res->status, $query ] ) || $q2->do( bind => [ time, $res->status, $query ] ) if $self->cache && $res->is_success;
            }

            while ( my $cb = shift $pool->{$query}->@* ) {
                $cb->($res);
            }

            delete $pool->{$query};

            return;
        }
    );

    return;
}

sub export_supported_pub_suffixes ($self) {
    my $pub_suffix;

    my $server;

    for ( keys $PUB_SUFFIX->%* ) {
        my $ps = P->host($_)->name_utf8;

        my $host = $PUB_SUFFIX->{$_};

        if ($host) {
            $server->{$host} = bless { host => $host }, 'Pcore::API::Whois::Server' if !$server->{$host};

            if ( $server->{$host}->is_supported ) {
                $pub_suffix->{$ps} = undef;
            }
            else {
                $pub_suffix->{$ps} = $server->{$host}->host;
            }
        }
    }

    for ( sort grep { $pub_suffix->{$_} } keys $pub_suffix->%* ) {
        say "$_;$pub_suffix->{$_}";
    }

    for ( sort grep { !defined $pub_suffix->{$_} } keys $pub_suffix->%* ) {
        say "$_";
    }

    return;
}

1;
## -----SOURCE FILTER LOG BEGIN-----
##
## PerlCritic profile "pcore-script" policy violations:
## +------+----------------------+----------------------------------------------------------------------------------------------------------------+
## | Sev. | Lines                | Policy                                                                                                         |
## |======+======================+================================================================================================================|
## |    3 | 21, 217, 234, 238    | References::ProhibitDoubleSigils - Double-sigil dereference                                                    |
## |------+----------------------+----------------------------------------------------------------------------------------------------------------|
## |    3 | 57                   | Subroutines::ProhibitExcessComplexity - Subroutine "search" with high complexity score (24)                    |
## +------+----------------------+----------------------------------------------------------------------------------------------------------------+
##
## -----SOURCE FILTER LOG END-----
__END__
=pod

=encoding utf8

=head1 NAME

Pcore::API::Whois

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 ATTRIBUTES

=head1 METHODS

=head1 SEE ALSO

=head1 AUTHOR

zdm <zdm@softvisio.net>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by zdm.

=cut
