File Coverage

blib/lib/WebService/Hexonet/Connector/APIClient.pm

Criterion	Covered	Total	%
statement	296	304	97.3
branch	58	70	82.8
condition	7	14	50.0
subroutine	51	52	98.0
pod	32	35	91.4
total	444	475	93.4

package WebService::Hexonet::Connector::APIClient;

use 5.026_000;
use strict;
use warnings;
use utf8;
use WebService::Hexonet::Connector::Logger;
use WebService::Hexonet::Connector::Response;
use WebService::Hexonet::Connector::ResponseTemplateManager;
use WebService::Hexonet::Connector::SocketConfig;
use LWP::UserAgent;
use Carp;
use Readonly;
use Data::Dumper;
use Config;
use POSIX;

Readonly my $SOCKETTIMEOUT                => 300;                                      # 300s or 5 min
Readonly my $IDX4                         => 4;                                        # Index 4 constant
Readonly our $ISPAPI_CONNECTION_URL       => 'https://api.ispapi.net/api/call.cgi';    # Default Connection Setup URL
Readonly our $ISPAPI_CONNECTION_URL_PROXY => 'http://127.0.0.1/api/call.cgi';          # High Speed Connection Setup URL

use version 0.9917; our $VERSION = version->declare('v2.9.2');

my $rtm = WebService::Hexonet::Connector::ResponseTemplateManager->getInstance();


sub new {
    my $class = shift;
    my $self  = bless {
        socketURL    => $ISPAPI_CONNECTION_URL,
        debugMode    => 0,
        socketConfig => WebService::Hexonet::Connector::SocketConfig->new(),
        ua           => q{},
        curlopts     => {},
        logger       => WebService::Hexonet::Connector::Logger->new()
    }, $class;
    $self->setURL($ISPAPI_CONNECTION_URL);
    $self->useLIVESystem();
    $self->setDefaultLogger();
    return $self;
}


sub setDefaultLogger {
    my $self = shift;
    $self->{logger} = WebService::Hexonet::Connector::Logger->new();
    return $self;
}


sub setCustomLogger {
    my ( $self, $logger ) = shift;
    if ( defined($logger) && $logger->can('log') ) {
        $self->{logger} = $logger;
    }
    return $self;
}


sub enableDebugMode {
    my $self = shift;
    $self->{debugMode} = 1;
    return $self;
}


sub disableDebugMode {
    my $self = shift;
    $self->{debugMode} = 0;
    return $self;
}


sub getPOSTData {
    my ( $self, $cmd, $secured ) = @_;
    my $post = $self->{socketConfig}->getPOSTData();
    if ( defined($secured) && $secured == 1 ) {
        $post->{s_pw} = '***';
    }
    my $tmp = q{};
    if ( ( ref $cmd ) eq 'HASH' ) {
        foreach my $key ( sort keys %{$cmd} ) {
            if ( defined $cmd->{$key} ) {
                my $val = $cmd->{$key};
                $val =~ s/[\r\n]//msx;
                $tmp .= "${key}=${val}\n";
            }
        }
    } else {
        $tmp = $cmd;
    }
    if ( defined($secured) && $secured == 1 ) {
        $tmp =~ s/PASSWORD\=[^\n]+/PASSWORD=***/gmsx;
    }
    $tmp =~ s/\n$//msx;
    if ( utf8::is_utf8($tmp) ) {
        utf8::encode($tmp);
    }
    $post->{'s_command'} = $tmp;
    return $post;
}


sub getSession {
    my $self   = shift;
    my $sessid = $self->{socketConfig}->getSession();
    if ( length $sessid ) {
        return $sessid;
    }
    return;
}


sub getURL {
    my $self = shift;
    return $self->{socketURL};
}


sub getUserAgent {
    my $self = shift;
    if ( !( length $self->{ua} ) ) {
        my $arch = (POSIX::uname)[ $IDX4 ];
        my $os   = (POSIX::uname)[ 0 ];
        my $rv   = $self->getVersion();
        $self->{ua} = "PERL-SDK ($os; $arch; rv:$rv) perl/$Config{version}";
    }
    return $self->{ua};
}


sub setUserAgent {
    my ( $self, $str, $rv, $modules ) = @_;
    my $arch = (POSIX::uname)[ $IDX4 ];
    my $os   = (POSIX::uname)[ 0 ];
    my $rv2  = $self->getVersion();
    my $mods = q{};
    if ( defined $modules && length($modules) > 0 ) {
        $mods = q{ } . join q{ }, @{$modules};
    }
    $self->{ua} = "$str ($os; $arch; rv:$rv)$mods perl-sdk/$rv2 perl/$Config{version}";
    return $self;
}


sub getProxy {
    my ($self) = @_;
    if ( exists $self->{curlopts}->{'PROXY'} ) {
        return $self->{curlopts}->{'PROXY'};
    }
    return;
}


sub setProxy {
    my ( $self, $proxy ) = @_;
    if ( length($proxy) == 0 ) {
        delete $self->{curlopts}->{'PROXY'};
    } else {
        $self->{curlopts}->{'PROXY'} = $proxy;
    }
    return $self;
}


sub getReferer {
    my ($self) = @_;
    if ( exists $self->{curlopts}->{'REFERER'} ) {
        return $self->{curlopts}->{'REFERER'};
    }
    return;
}


sub setReferer {
    my ( $self, $referer ) = @_;
    if ( length($referer) == 0 ) {
        delete $self->{curlopts}->{'REFERER'};
    } else {
        $self->{curlopts}->{'REFERER'} = $referer;
    }
    return $self;
}


sub getVersion {
    my $self = shift;
    return $VERSION;
}


sub saveSession {
    my ( $self, $session ) = @_;
    $session->{socketcfg} = {
        entity  => $self->{socketConfig}->getSystemEntity(),
        session => $self->{socketConfig}->getSession()
    };
    return $self;
}


sub reuseSession {
    my ( $self, $session ) = @_;
    $self->{socketConfig}->setSystemEntity( $session->{socketcfg}->{entity} );
    $self->setSession( $session->{socketcfg}->{session} );
    return $self;
}


sub setURL {
    my ( $self, $value ) = @_;
    $self->{socketURL} = $value;
    return $self;
}


sub setOTP {
    my ( $self, $value ) = @_;
    $self->{socketConfig}->setOTP($value);
    return $self;
}


sub setSession {
    my ( $self, $value ) = @_;
    $self->{socketConfig}->setSession($value);
    return $self;
}


sub setRemoteIPAddress {
    my ( $self, $value ) = @_;
    $self->{socketConfig}->setRemoteAddress($value);
    return $self;
}


sub setCredentials {
    my ( $self, $uid, $pw ) = @_;
    $self->{socketConfig}->setLogin($uid);
    $self->{socketConfig}->setPassword($pw);
    return $self;
}


sub setRoleCredentials {
    my ( $self, $uid, $role, $pw ) = @_;
    my $myuid = "${uid}!${role}";
    $myuid =~ s/^\!$//msx;
    return $self->setCredentials( $myuid, $pw );
}


sub login {
    my $self = shift;
    my $otp  = shift;
    $self->setOTP( $otp || q{} );
    my $rr = $self->request( { COMMAND => 'StartSession' } );
    if ( $rr->isSuccess() ) {
        my $col    = $rr->getColumn('SESSION');
        my $sessid = q{};
        if ( defined $col ) {
            my @d = $col->getData();
            $sessid = $d[ 0 ];
        }
        $self->setSession($sessid);
    }
    return $rr;
}


sub loginExtended {
    my $self   = shift;
    my $params = shift;
    my $otpc   = shift;
    if ( !defined $otpc ) {
        $otpc = q{};
    }
    $self->setOTP($otpc);
    my $cmd = { COMMAND => 'StartSession' };
    foreach my $key ( keys %{$params} ) {
        $cmd->{$key} = $params->{$key};
    }
    my $rr = $self->request($cmd);
    if ( $rr->isSuccess() ) {
        my $col    = $rr->getColumn('SESSION');
        my $sessid = q{};
        if ( defined $col ) {
            my @d = $col->getData();
            $sessid = $d[ 0 ];
        }
        $self->setSession($sessid);
    }
    return $rr;
}


sub logout {
    my $self = shift;
    my $rr = $self->request( { COMMAND => 'EndSession' } );
    if ( $rr->isSuccess() ) {
        $self->setSession(q{});
    }
    return $rr;
}


sub request {
    my ( $self, $cmd ) = @_;
    # flatten nested api command bulk parameters
    my $newcmd = $self->_flattenCommand($cmd);
    # auto convert umlaut names to punycode
    $newcmd = $self->_autoIDNConvert($newcmd);

    # request command to API
    my $cfg     = { CONNECTION_URL => $self->{socketURL} };
    my $post    = $self->getPOSTData($newcmd);
    my $secured = $self->getPOSTData( $newcmd, 1 );

    my $ua = LWP::UserAgent->new();
    $ua->agent( $self->getUserAgent() );
    $ua->default_header( 'Expect', q{} );
    $ua->timeout($SOCKETTIMEOUT);
    my $referer = $self->getReferer();
    if ($referer) {
        $ua->default_header( 'Referer', $referer );
    }
    my $proxy = $self->getProxy();
    if ($proxy) {
        $ua->proxy( [ 'http', 'https' ], $proxy );
    }

    my $r = $ua->post( $cfg->{CONNECTION_URL}, $post );
    if ( $r->is_success ) {
        $r = WebService::Hexonet::Connector::Response->new( $r->decoded_content, $newcmd, $cfg );
        if ( $self->{debugMode} ) {
            $self->{logger}->log( $secured, $r );
        }
    } else {
        $r = WebService::Hexonet::Connector::Response->new( $rtm->getTemplate('httperror')->getPlain(), $newcmd, $cfg );
        if ( $self->{debugMode} ) {
            $self->{logger}->log( $secured, $r, $r->status_line );
        }
    }
    return $r;
}


sub requestNextResponsePage {
    my ( $self, $rr ) = @_;
    my $mycmd = $rr->getCommand();
    if ( defined $mycmd->{LAST} ) {
        croak 'Parameter LAST in use! Please remove it to avoid issues in requestNextPage.';
    }
    my $first = 0;
    if ( defined $mycmd->{FIRST} ) {
        $first = $mycmd->{FIRST};
    }
    my $total = $rr->getRecordsTotalCount();
    my $limit = $rr->getRecordsLimitation();
    $first += $limit;
    if ( $first < $total ) {
        $mycmd->{FIRST} = $first;
        $mycmd->{LIMIT} = $limit;
        return $self->request($mycmd);
    }
    return;
}


sub requestAllResponsePages {
    my ( $self, $cmd ) = @_;
    my @responses = ();
    my $command   = {};
    foreach my $key ( keys %{$cmd} ) {
        $command->{$key} = $cmd->{$key};
    }
    $command->{FIRST} = 0;
    my $rr  = $self->request($command);
    my $tmp = $rr;
    my $idx = 0;
    while ( defined $tmp ) {
        push @responses, $tmp;
        $tmp = $self->requestNextResponsePage($tmp);
    }
    return \@responses;
}


sub setUserView {
    my ( $self, $uid ) = @_;
    $self->{socketConfig}->setUser($uid);
    return $self;
}


sub resetUserView {
    my $self = shift;
    $self->{socketConfig}->setUser(q{});
    return $self;
}


sub useDefaultConnectionSetup {
    my $self = shift;
    return $self->setURL($ISPAPI_CONNECTION_URL);
}


sub useHighPerformanceConnectionSetup {
    my $self = shift;
    return $self->setURL($ISPAPI_CONNECTION_URL_PROXY);
}


sub useOTESystem {
    my $self = shift;
    $self->{socketConfig}->setSystemEntity('1234');
    return $self;
}


sub useLIVESystem {
    my $self = shift;
    $self->{socketConfig}->setSystemEntity('54cd');
    return $self;
}


sub _flattenCommand {
    my ( $self, $cmd ) = @_;
    for my $key ( keys %{$cmd} ) {
        my $newkey = uc $key;
        if ( $newkey ne $key ) {
            $cmd->{$newkey} = delete $cmd->{$key};
        }
        if ( ref( $cmd->{$newkey} ) eq 'ARRAY' ) {
            my @val = @{ $cmd->{$newkey} };
            my $idx = 0;
            for my $str (@val) {
                $str =~ s/[\r\n]//gmsx;
                $cmd->{"${key}${idx}"} = $str;
                $idx++;
            }
            delete $cmd->{$newkey};
        }
    }
    return $cmd;
}


sub _autoIDNConvert {
    my ( $self, $cmd ) = @_;
    if ( $cmd->{'COMMAND'} =~ /^CONVERTIDN$/imsx ) {
        return $cmd;
    }
    my @keys = grep {/^(DOMAIN|NAMESERVER|DNSZONE)(\d*)$/imsx} keys %{$cmd};
    if ( scalar @keys == 0 ) {
        return $cmd;
    }
    my @toconvert = ();
    my @idxs      = ();
    foreach my $key (@keys) {
        my $val = $cmd->{$key};
        if ( $val =~ /[^[:lower:]\d. -]/imsx ) {
            push @toconvert, $val;
            push @idxs,      $key;
        }
    }
    if ( scalar @toconvert == 0 ) {
        return $cmd;
    }
    my $r = $self->request(
        {   COMMAND => 'ConvertIDN',
            DOMAIN  => \@toconvert
        }
    );
    if ( $r->isSuccess() ) {
        my $col = $r->getColumn('ACE');
        if ($col) {
            my $data = $col->getData();
            my $idx  = 0;
            foreach my $pc ( @{$data} ) {
                $cmd->{ $idxs[ $idx ] } = $pc;
                $idx++;
            }
        }
    }
    return $cmd;
}

1;

__END__