File Coverage

blib/lib/Net/Pface.pm

Criterion	Covered	Total	%
statement	91	105	86.6
branch	24	44	54.5
condition			n/a
subroutine	12	12	100.0
pod	0	3	0.0
total	127	164	77.4

package Net::Pface;

use strict;
use warnings;
use JSON::XS;
use utf8;
use HTTP::Request;
use LWP::UserAgent;
use Encode;

our $VERSION = '1.02';

my %def = (
              server     => 'https://s.pface.ru/',
              timeout    => 10,
              agent      => 'Net-Pface-' . $VERSION,
              type       => 'application/json',
              cache_time => 300
);

sub new {
    my $class = shift;
    my $self  = {@_};

    bless $self, $class;

    # check param
    warn "Don't defined 'id'"  unless defined $self->{'id'};
    warn "Don't defined 'key'" unless defined $self->{'key'};
    unless ( defined $self->{'server'} )     {$self->{'server'}     = $def{'server'};}
    unless ( defined $self->{'timeout'} )    {$self->{'timeout'}    = $def{'timeout'}}
    unless ( defined $self->{'agent'} )      {$self->{'agent'}      = $def{'agent'}}
    unless ( defined $self->{'type'} )       {$self->{'type'}       = $def{'type'}}
    unless ( defined $self->{'cache_time'} ) {$self->{'cache_time'} = $def{'cache_time'}}

    # init browser
    $self->{'browser'} = LWP::UserAgent->new( agent => $self->{'agent'}, ssl_opts => { verify_hostname => 0 } );
    $self->{'browser'}->timeout( $self->{'timeout'} );

    # init json::xs
    $self->{'json_xs'} = JSON::XS->new();

    #init cache data
    $self->{'cache_data'} = {};

    return $self;
}

# get data from users.get.json
sub get {
    my ( $self, $user_id, @fields ) = @_;
    my $result = {};

    # check params
    unless ( defined $user_id ) {$$result{'error'} = "Don't defined user id";}
    unless (@fields)             {$$result{'error'} = "Don't defined fileds list"};
    return $result
        if exists $$result{'error'};

    # check cache
    my $memkey = $user_id . '_' . join "_", @fields;
    my $cache  = $self->_check_cache($memkey);
    return $cache
        if $cache;

    # prepare request
    my $json = {
                   s      => $self->{'id'},
                   p      => $self->{'key'},
                   id     => $user_id,
                   fields => join ",", @fields
    };

    # request to server
    my $request = HTTP::Request->new( 'POST', $self->{'server'} . 'users.get.json/' );
    $request->header( 'Content-Type' => $self->{'type'} );
    $request->content( encode( "utf8", $self->{'json_xs'}->encode($json) ) );
    my $response = $self->{'browser'}->request($request);

    # parse answer by server
    $self->_parse( $result, $response );

    # set to cache
    $$result{'is_cache'} = 0;
    $self->{'cache_data'}{$memkey}{'time'} = time() + $self->{'cache_time'};
    $self->{'cache_data'}{$memkey}{'data'} = $result;

    return $result;
}

# auth from users.auth.json
sub auth {
    my ( $self, $s1, $s2, $ip ) = @_;
    my $result = {};

    # check params
    unless ( defined $ip ) {$$result{'error'} = "Don't defined ip address";}
    unless ( defined $s2 ) {$$result{'error'} = "Don't defined second sess";}
    unless ( defined $s1 ) {$$result{'error'} = "Don't defined first sess";}
    return $result
        if exists $$result{'error'};

    # check cache
    my $memkey = $s1 . '_' . $s2 . '_' . $ip;
    my $cache  = $self->_check_cache($memkey);
    return $cache
        if $cache;

    # prepare request
    my $json = {
                   s  => $self->{'id'},
                   p  => $self->{'key'},
                   s1 => $s1,
                   s2 => $s2,
                   ip => $ip
    };

    # request to server
    my $request = HTTP::Request->new( 'POST', $self->{'server'} . 'users.auth.json/' );
    $request->header( 'Content-Type' => $self->{'type'} );
    $request->content( encode( "utf8", $self->{'json_xs'}->encode($json) ) );
    my $response = $self->{'browser'}->request($request);

    # parse answer by server
    $self->_parse( $result, $response );

    # set to cache
    $$result{'is_cache'} = 0;
    $self->{'cache_data'}{$memkey}{'time'} = time() + $self->{'cache_time'};
    $self->{'cache_data'}{$memkey}{'data'} = $result;

    return $result;
}

# parsing answer by server
sub _parse {
    my $self = shift;

    # check pface answer
    unless ($_[1]->is_success) {${$_[0]}{'error'} = $_[1]->status_line;}
    return
        if exists ${$_[0]}{'error'};

    # parse json from server
    my $content = decode( "utf8", $_[1]->decoded_content );
    unless ( eval { $_[0] = $self->{'json_xs'}->decode($content) } ) {
        ${$_[0]}{'error'} = "don't parse json";
    }

    # save source answer
    ${$_[0]}{'answer'} = $content;
    return;
}

# get data from cache
sub _check_cache {
    my ( $self, $memkey ) = @_;

    if ( defined $self->{'cache_data'}{$memkey} ) {
        if ( $self->{'cache_data'}{$memkey}{'time'} > time() ) {
            # get data from cache
            my $result = $self->{'cache_data'}{$memkey}{'data'};
            unless ($$result{'is_cache'}) {
                $$result{'is_cache'} = 1;
            }
            return $result;
        }
    }

    return;
}

1;
__END__