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__
|