IO-EPP

 view release on metacpan or  search on metacpan

lib/IO/EPP/HosterKZ.pm  view on Meta::CPAN

    $self->{critical_error} = '';

    if ( $self->can( $action ) ) {
        ( $answ, $code, $msg ) = $self->$action( $params );
    }
    else {
        $msg = "undefined command <$action>, request cancelled";
        $code = 0;
    }


END_MR:

    $msg .= '; ' . $self->{critical_error} if $self->{critical_error};

    my $full_answ = "code: $code\nmsg: $msg";

    $answ = {} unless $answ && ref $answ;

    $answ->{code} = $code;
    $answ->{msg}  = $msg;

    return wantarray ? ( $answ, $full_answ, $self ) : $answ;
}


=head1 METHODS

=head2 req

Completely replaces IO::EPP::Base::req because it works via LWP

=cut


sub req {
    my ( $self, $out_data, $info ) = @_;

    $out_data =~ s/^\n//s;
    $out_data =~ s/\n<\/epp>//; # !!!

    $info ||= '';

    if ( $out_data ) {
        my $d = $out_data;
        # remove password, authinfo from log
        $d =~ s/<pw>[^<>]+<\/pw>/<pw>xxxxx<\/pw>/;

        $self->epp_log( "$info request:\n$d" );
    }

    my $THRESHOLD = 100000000;

    my $start_time = time;

    #my $cookie = HTTP::Cookies->new;

    my $ua = LWP::UserAgent->new(
        agent      => 'EppBot/7.02 (Perl; Linux i686; ru, en_US)',
        parse_head =>  0,
        #keep_alive => 30,
        #cookie_jar => $cookie,
        #%ua_params,
    );

    my $in_data;

    eval {
        local $SIG{ALRM} = sub { die "connection timeout\n" };

        alarm 120;

        my $req = POST $self->{url}, [
            login => $self->{user},
            psw   => $self->{pass},
            xml   => $out_data,
        ];

        my $res = $ua->request( $req );

        alarm 0;

        if ( $res->is_success ) {
            $in_data = $res->content;

            die "data length is zero\n" unless $in_data;

            my $data_size = length $in_data;

            die "data length is $data_size which exceeds $THRESHOLD\n" if $data_size > $THRESHOLD;
        }
        else {
            die "fail answer: " . $res->as_string . "\n";
        }

        1;
    }
    or do {
        my $err = $@;

        alarm 0;

        my $req_time = sprintf( '%0.4f', time - $start_time );
        $self->epp_log( "req_time: $req_time\n$info req error: $err" );

        $self->{critical_error} = "req error: $err";

        return;
    };

    my $req_time = sprintf( '%0.4f', time - $start_time );

    # "Authentication error" - work with normal code & msg
    # "User regikz_user already has more than.*active connections" - we did not see yet

    $self->epp_log( "req_time: $req_time\n$info answer:\n$in_data\n" );

    return $in_data;
}




( run in 1.500 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )