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


line stmt bran cond sub pod time code
1             package Net::Pface;
2            
3 1     1   53087 use strict;
  1         4  
  1         38  
4 1     1   4 use warnings;
  1         1  
  1         20  
5 1     1   545 use JSON::XS;
  1         5720  
  1         43  
6 1     1   460 use utf8;
  1         12  
  1         4  
7 1     1   398 use HTTP::Request;
  1         16635  
  1         25  
8 1     1   618 use LWP::UserAgent;
  1         20466  
  1         28  
9 1     1   500 use Encode;
  1         8090  
  1         818  
10            
11             our $VERSION = '1.02';
12            
13             my %def = (
14             server => 'https://s.pface.ru/',
15             timeout => 10,
16             agent => 'Net-Pface-' . $VERSION,
17             type => 'application/json',
18             cache_time => 300
19             );
20            
21             sub new {
22 1     1 0 79 my $class = shift;
23 1         5 my $self = {@_};
24            
25 1         2 bless $self, $class;
26            
27             # check param
28 1 50       6 warn "Don't defined 'id'" unless defined $self->{'id'};
29 1 50       3 warn "Don't defined 'key'" unless defined $self->{'key'};
30 1 50       2 unless ( defined $self->{'server'} ) {$self->{'server'} = $def{'server'};}
  1         3  
31 1 50       3 unless ( defined $self->{'timeout'} ) {$self->{'timeout'} = $def{'timeout'}}
  1         2  
32 1 50       3 unless ( defined $self->{'agent'} ) {$self->{'agent'} = $def{'agent'}}
  1         2  
33 1 50       3 unless ( defined $self->{'type'} ) {$self->{'type'} = $def{'type'}}
  1         2  
34 1 50       3 unless ( defined $self->{'cache_time'} ) {$self->{'cache_time'} = $def{'cache_time'}}
  0         0  
35            
36             # init browser
37 1         7 $self->{'browser'} = LWP::UserAgent->new( agent => $self->{'agent'}, ssl_opts => { verify_hostname => 0 } );
38 1         2273 $self->{'browser'}->timeout( $self->{'timeout'} );
39            
40             # init json::xs
41 1         18 $self->{'json_xs'} = JSON::XS->new();
42            
43             #init cache data
44 1         2 $self->{'cache_data'} = {};
45            
46 1         3 return $self;
47             }
48            
49             # get data from users.get.json
50             sub get {
51 2     2 0 482 my ( $self, $user_id, @fields ) = @_;
52 2         4 my $result = {};
53            
54             # check params
55 2 50       6 unless ( defined $user_id ) {$$result{'error'} = "Don't defined user id";}
  0         0  
56 2 50       5 unless (@fields) {$$result{'error'} = "Don't defined fileds list"};
  0         0  
57             return $result
58 2 50       4 if exists $$result{'error'};
59            
60             # check cache
61 2         8 my $memkey = $user_id . '_' . join "_", @fields;
62 2         3 my $cache = $self->_check_cache($memkey);
63 2 100       5 return $cache
64             if $cache;
65            
66             # prepare request
67             my $json = {
68             s => $self->{'id'},
69 1         6 p => $self->{'key'},
70             id => $user_id,
71             fields => join ",", @fields
72             };
73            
74             # request to server
75 1         5 my $request = HTTP::Request->new( 'POST', $self->{'server'} . 'users.get.json/' );
76 1         160 $request->header( 'Content-Type' => $self->{'type'} );
77 1         66 $request->content( encode( "utf8", $self->{'json_xs'}->encode($json) ) );
78 1         42 my $response = $self->{'browser'}->request($request);
79            
80             # parse answer by server
81 1         986 $self->_parse( $result, $response );
82            
83             # set to cache
84 1         11 $$result{'is_cache'} = 0;
85 1         4 $self->{'cache_data'}{$memkey}{'time'} = time() + $self->{'cache_time'};
86 1         3 $self->{'cache_data'}{$memkey}{'data'} = $result;
87            
88 1         8 return $result;
89             }
90            
91             # auth from users.auth.json
92             sub auth {
93 2     2 0 660 my ( $self, $s1, $s2, $ip ) = @_;
94 2         4 my $result = {};
95            
96             # check params
97 2 50       13 unless ( defined $ip ) {$$result{'error'} = "Don't defined ip address";}
  0         0  
98 2 50       16 unless ( defined $s2 ) {$$result{'error'} = "Don't defined second sess";}
  0         0  
99 2 50       6 unless ( defined $s1 ) {$$result{'error'} = "Don't defined first sess";}
  0         0  
100             return $result
101 2 50       5 if exists $$result{'error'};
102            
103             # check cache
104 2         7 my $memkey = $s1 . '_' . $s2 . '_' . $ip;
105 2         7 my $cache = $self->_check_cache($memkey);
106 2 100       7 return $cache
107             if $cache;
108            
109             # prepare request
110             my $json = {
111             s => $self->{'id'},
112 1         5 p => $self->{'key'},
113             s1 => $s1,
114             s2 => $s2,
115             ip => $ip
116             };
117            
118             # request to server
119 1         9 my $request = HTTP::Request->new( 'POST', $self->{'server'} . 'users.auth.json/' );
120 1         6427 $request->header( 'Content-Type' => $self->{'type'} );
121 1         82 $request->content( encode( "utf8", $self->{'json_xs'}->encode($json) ) );
122 1         70 my $response = $self->{'browser'}->request($request);
123            
124             # parse answer by server
125 1         1360 $self->_parse( $result, $response );
126            
127             # set to cache
128 1         3 $$result{'is_cache'} = 0;
129 1         4 $self->{'cache_data'}{$memkey}{'time'} = time() + $self->{'cache_time'};
130 1         2 $self->{'cache_data'}{$memkey}{'data'} = $result;
131            
132 1         14 return $result;
133             }
134            
135             # parsing answer by server
136             sub _parse {
137 2     2   4 my $self = shift;
138            
139             # check pface answer
140 2 50       6 unless ($_[1]->is_success) {${$_[0]}{'error'} = $_[1]->status_line;}
  2         17  
  2         19  
141             return
142 2 50       3 if exists ${$_[0]}{'error'};
  2         5  
143            
144             # parse json from server
145 0         0 my $content = decode( "utf8", $_[1]->decoded_content );
146 0 0       0 unless ( eval { $_[0] = $self->{'json_xs'}->decode($content) } ) {
  0         0  
147 0         0 ${$_[0]}{'error'} = "don't parse json";
  0         0  
148             }
149            
150             # save source answer
151 0         0 ${$_[0]}{'answer'} = $content;
  0         0  
152 0         0 return;
153             }
154            
155             # get data from cache
156             sub _check_cache {
157 4     4   9 my ( $self, $memkey ) = @_;
158            
159 4 100       9 if ( defined $self->{'cache_data'}{$memkey} ) {
160 2 50       6 if ( $self->{'cache_data'}{$memkey}{'time'} > time() ) {
161             # get data from cache
162 2         5 my $result = $self->{'cache_data'}{$memkey}{'data'};
163 2 50       4 unless ($$result{'is_cache'}) {
164 2         3 $$result{'is_cache'} = 1;
165             }
166 2         4 return $result;
167             }
168             }
169            
170 2         4 return;
171             }
172            
173             1;
174             __END__