line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::VKontakte::Standalone; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
24694
|
use 5.006000; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
46
|
|
4
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
54
|
|
5
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
39
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
1160
|
use URI; |
|
1
|
|
|
|
|
9200
|
|
|
1
|
|
|
|
|
32
|
|
8
|
1
|
|
|
1
|
|
1646
|
use WWW::Mechanize; |
|
1
|
|
|
|
|
306178
|
|
|
1
|
|
|
|
|
45
|
|
9
|
1
|
|
|
1
|
|
1656
|
use JSON; |
|
1
|
|
|
|
|
31104
|
|
|
1
|
|
|
|
|
5
|
|
10
|
1
|
|
|
1
|
|
158
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
155
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.18_95'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub import { |
15
|
1
|
|
|
1
|
|
14
|
my $class = shift; |
16
|
1
|
50
|
|
|
|
20
|
return unless @_; |
17
|
0
|
|
|
|
|
|
my %opts = @_; |
18
|
0
|
0
|
|
|
|
|
my @import = exists $opts{import} ? @{delete $opts{import}} : (qw/ |
|
0
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
auth auth_uri redirected permament_token api post captcha_handler error errors_noauto access_token AUTOLOAD |
20
|
|
|
|
|
|
|
/); |
21
|
0
|
|
|
|
|
|
my $vk = $class->new(%opts); |
22
|
0
|
|
|
|
|
|
my $caller = caller; |
23
|
1
|
|
|
1
|
|
6
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1391
|
|
24
|
0
|
|
|
|
|
|
for my $method (@import) { |
25
|
0
|
|
|
0
|
|
|
*{$caller."::".$method} = sub { $vk->$method(@_) }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
}; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub new { |
30
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
31
|
0
|
|
|
|
|
|
my $self = bless {},$class; |
32
|
0
|
|
|
|
|
|
$self->{browser} = WWW::Mechanize::->new( |
33
|
|
|
|
|
|
|
agent => __PACKAGE__.$VERSION, |
34
|
|
|
|
|
|
|
autocheck => 1, |
35
|
|
|
|
|
|
|
); |
36
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
|
|
0
|
|
|
|
|
|
37
|
0
|
|
|
|
|
|
$self->{api_id} = $_[0]; |
38
|
|
|
|
|
|
|
} elsif (@_ % 2 == 0) { # smells like hash |
39
|
0
|
|
|
|
|
|
my %opt = @_; |
40
|
0
|
|
|
|
|
|
for my $key (qw/api_id errors_noauto captcha_handler access_token/) { |
41
|
0
|
0
|
|
|
|
|
$self->{$key} = $opt{$key} if defined $opt{$key}; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} else { |
44
|
0
|
|
|
|
|
|
croak "wrong number of arguments to constructor"; |
45
|
|
|
|
|
|
|
} |
46
|
0
|
0
|
0
|
|
|
|
croak "api_id or access_token is required" unless $self->{api_id} or $self->{access_token}; |
47
|
0
|
|
|
|
|
|
return $self; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub _request { |
51
|
0
|
|
|
0
|
|
|
my ($self, $params, $base) = @_; |
52
|
0
|
|
|
|
|
|
(my $uri = URI::->new($base))->query_form($params); |
53
|
0
|
|
|
|
|
|
return $self->{browser}->get($uri); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub auth { # dirty hack |
57
|
0
|
|
|
0
|
1
|
|
my ($self,$login,$password,$scope) = @_; |
58
|
0
|
|
|
|
|
|
@{$self}{"login","password","scope"} = ($login, $password, $scope); # reuse in case of reauth |
|
0
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
$self->{browser}->cookie_jar->clear; # VK won't give us the fields if we have authentificated cookies |
60
|
0
|
|
|
|
|
|
$self->{browser}->get($self->auth_uri($scope)); |
61
|
0
|
|
|
|
|
|
$self->{browser}->submit_form( |
62
|
|
|
|
|
|
|
with_fields => { |
63
|
|
|
|
|
|
|
email => $login, |
64
|
|
|
|
|
|
|
pass => $password, |
65
|
|
|
|
|
|
|
}, |
66
|
|
|
|
|
|
|
); # log in |
67
|
0
|
0
|
|
|
|
|
$self->{browser}->submit unless $self->{browser}->uri =~ m|^https://oauth.vk.com/blank.html|; # allow access if requested to |
68
|
0
|
|
|
|
|
|
return $self->redirected($self->{browser}->uri); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub auth_uri { |
72
|
0
|
|
|
0
|
1
|
|
my ($self, $scope, $display) = @_; |
73
|
0
|
|
|
|
|
|
(my $uri = URI::->new("https://api.vkontakte.ru/oauth/authorize"))->query_form( |
74
|
|
|
|
|
|
|
{ |
75
|
|
|
|
|
|
|
client_id => $self->{api_id}, |
76
|
|
|
|
|
|
|
redirect_uri => "blank.html", |
77
|
|
|
|
|
|
|
scope => $scope, |
78
|
|
|
|
|
|
|
response_type => "token", |
79
|
|
|
|
|
|
|
display => $display, |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
); |
82
|
0
|
|
|
|
|
|
return $uri->canonical; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub redirected { |
86
|
0
|
|
|
0
|
1
|
|
my ($self, $uri) = @_; |
87
|
0
|
0
|
|
|
|
|
my %params = map { split /=/,$_,2 } split /&/,$1 if $uri =~ m|https://oauth.vk.com/blank.html#(.*)|; |
|
0
|
|
|
|
|
|
|
88
|
0
|
0
|
|
|
|
|
croak "No access_token returned (wrong login/password?)" unless defined $params{access_token}; |
89
|
0
|
|
|
|
|
|
$self->{access_token} = $params{access_token}; |
90
|
0
|
0
|
|
|
|
|
croak "No token expiration time returned" unless $params{expires_in}; |
91
|
0
|
|
|
|
|
|
$self->{auth_time} = time; |
92
|
0
|
|
|
|
|
|
$self->{expires_in} = $params{expires_in}; |
93
|
0
|
|
|
|
|
|
return $self; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub permament_token { |
97
|
0
|
|
|
0
|
1
|
|
my ($self, %params) = @_; |
98
|
0
|
|
|
|
|
|
$params{grant_type} = "password"; |
99
|
0
|
|
|
|
|
|
$params{client_id} = $self->{api_id}; |
100
|
0
|
|
|
|
|
|
REDO: { # for CAPTCHA |
101
|
0
|
|
|
|
|
|
my $result = decode_json $self->_request(\%params, "https://oauth.vk.com/token")->decoded_content; |
102
|
0
|
0
|
|
|
|
|
if ($result->{access_token}) { |
|
|
0
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
$self->{access_token} = $result->{access_token}; |
104
|
0
|
|
|
|
|
|
return 1; |
105
|
|
|
|
|
|
|
} elsif ($result->{error}) { |
106
|
0
|
0
|
0
|
|
|
|
if ($result->{error} eq "need_captcha" and $self->{captcha_handler}) { |
|
|
0
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
$params{captcha_key} = $self->{captcha_handler}->($result->{error}{captcha_img}); |
108
|
0
|
|
|
|
|
|
$params{captcha_sid} = $result->{error}{captcha_sid}; |
109
|
0
|
|
|
|
|
|
redo REDO; |
110
|
|
|
|
|
|
|
} elsif ($self->errors_noauto) { |
111
|
0
|
|
|
|
|
|
$self->{error} = $result; |
112
|
0
|
0
|
0
|
|
|
|
if (ref $self->{errors_noauto} and ref $self->{errors_noauto} eq 'CODE') { |
113
|
0
|
|
|
|
|
|
$self->{errors_noauto}->($result); |
114
|
|
|
|
|
|
|
} |
115
|
0
|
|
|
|
|
|
return; |
116
|
|
|
|
|
|
|
} else { |
117
|
0
|
|
|
|
|
|
croak "Permament token call returned error ".$result->{error_description}; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
} else { |
120
|
|
|
|
|
|
|
croak "Permament token call didn't return response or error\n". |
121
|
0
|
0
|
|
|
|
|
$Carp::Verbose ? eval { require Data::Dumper; Data::Dumper::Dumper($result) } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
: ""; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub api { |
128
|
0
|
|
|
0
|
1
|
|
my ($self,$method,$params) = @_; |
129
|
0
|
0
|
|
|
|
|
croak "Cannot make API calls unless authentificated" unless defined $self->{access_token}; |
130
|
0
|
0
|
0
|
|
|
|
if (time - $self->{auth_time} > $self->{expires_in} and $self->{login} && $self->{password} && $self->{scope}) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
131
|
0
|
|
|
|
|
|
$self->auth($self->{"login","password","scope"}); |
132
|
|
|
|
|
|
|
} |
133
|
0
|
|
|
|
|
|
$params->{access_token} = $self->{access_token}; |
134
|
0
|
|
|
|
|
|
REQUEST: { |
135
|
0
|
|
|
|
|
|
my $response = decode_json $self->_request($params,"https://api.vk.com/method/$method")->decoded_content; |
136
|
0
|
0
|
|
|
|
|
if ($response->{response}) { |
|
|
0
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
return $response->{response}; |
138
|
|
|
|
|
|
|
} elsif ($response->{error}) { |
139
|
0
|
0
|
0
|
|
|
|
if (14 == $response->{error}{error_code} and $self->{captcha_handler}) { # it's a CAPTCHA request, user wants to handle it specially |
|
|
0
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
$params->{captcha_key} = $self->{captcha_handler}->($response->{error}{captcha_img}); |
141
|
0
|
|
|
|
|
|
$params->{captcha_sid} = $response->{error}{captcha_sid}; |
142
|
0
|
|
|
|
|
|
redo REQUEST; |
143
|
|
|
|
|
|
|
} elsif ($self->{errors_noauto}) { # user ignores or handles errors by him(her)self, it's not a CAPTCHA or no captcha_handler |
144
|
0
|
|
|
|
|
|
$self->{error} = $response->{error}; |
145
|
0
|
0
|
0
|
|
|
|
if (ref $self->{errors_noauto} and ref $self->{errors_noauto} eq "CODE") { |
146
|
0
|
|
|
|
|
|
$self->{errors_noauto}->($response->{error}); |
147
|
|
|
|
|
|
|
} |
148
|
0
|
|
|
|
|
|
return; |
149
|
|
|
|
|
|
|
} else { |
150
|
0
|
0
|
|
|
|
|
if (6 == $response->{error}{error_code}) { # Too many requests per second. |
151
|
0
|
|
|
|
|
|
sleep 1; |
152
|
0
|
|
|
|
|
|
redo REQUEST; |
153
|
|
|
|
|
|
|
} else { # other special cases which can be handled automatically? |
154
|
0
|
|
|
|
|
|
croak "API call returned error: ".$response->{error}{error_msg}; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
# 5 == user authorisation failed, invalid access token of any kind |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} else { |
159
|
|
|
|
|
|
|
croak "API call didn't return response or error\n". |
160
|
0
|
0
|
|
|
|
|
$Carp::Verbose ? eval { require Data::Dumper; Data::Dumper::Dumper($response) } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
: ""; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub post { |
167
|
0
|
|
|
0
|
1
|
|
my ($self, $url, %fields) = @_; |
168
|
0
|
|
|
|
|
|
return decode_json $self->{browser}->post($url, Content_Type => 'form_data', Content => [ %fields ]); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
sub captcha_handler { |
172
|
0
|
|
|
0
|
1
|
|
my ($self, $handler) = @_; |
173
|
0
|
0
|
|
|
|
|
croak "\$handler is not a subroutine reference" unless ref $handler eq "CODE"; |
174
|
0
|
|
|
|
|
|
$self->{captcha_handler} = $handler; |
175
|
0
|
|
|
|
|
|
return $self; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
sub error { |
179
|
0
|
|
|
0
|
1
|
|
return shift->{error}; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub errors_noauto { |
183
|
0
|
|
|
0
|
1
|
|
my ($self, $noauto) = @_; |
184
|
0
|
|
|
|
|
|
$self->{errors_noauto} = $noauto; # whatever this means |
185
|
0
|
|
|
|
|
|
return $self; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub access_token { |
189
|
0
|
|
|
0
|
1
|
|
my ($self, $token) = @_; |
190
|
0
|
0
|
|
|
|
|
return defined $token ? do { $self->{access_token} = $token } : $self->{access_token}; |
|
0
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
0
|
|
|
0
|
|
|
sub DESTROY {} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub AUTOLOAD { |
196
|
0
|
|
|
0
|
|
|
our $AUTOLOAD; |
197
|
0
|
|
|
|
|
|
$AUTOLOAD =~ s/.*:://; |
198
|
0
|
|
|
|
|
|
$AUTOLOAD =~ tr/_/./; |
199
|
0
|
|
|
|
|
|
my ($self, $params) = @_; |
200
|
0
|
|
|
|
|
|
$self->api($AUTOLOAD,$params); |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
1; |
204
|
|
|
|
|
|
|
__END__ |