line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package VK::App;
|
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
26790
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
40
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
5
|
1
|
|
|
1
|
|
841
|
use LWP;
|
|
1
|
|
|
|
|
59922
|
|
|
1
|
|
|
|
|
34
|
|
6
|
1
|
|
|
1
|
|
890
|
use LWP::Protocol::https;
|
|
1
|
|
|
|
|
106244
|
|
|
1
|
|
|
|
|
42
|
|
7
|
1
|
|
|
1
|
|
1130
|
use JSON;
|
|
1
|
|
|
|
|
11696
|
|
|
1
|
|
|
|
|
5
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = 0.11;
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new {
|
12
|
0
|
|
|
0
|
1
|
|
my ($class, %args) = @_;
|
13
|
0
|
0
|
|
|
|
|
die "USAGE:\nVK::App->new(api_id => ... login => ... password => ...)\n",
|
14
|
|
|
|
|
|
|
"VK::App->new(api_id => ... cookie_file => ...)\n" unless _valid_new_args(\%args);
|
15
|
|
|
|
|
|
|
|
16
|
0
|
|
|
|
|
|
my $self;
|
17
|
0
|
0
|
|
|
|
|
$self->{api_id} = $args{api_id} if exists $args{api_id};
|
18
|
0
|
0
|
|
|
|
|
$self->{login} = $args{login} if exists $args{login};
|
19
|
0
|
0
|
|
|
|
|
$self->{password} = $args{password} if exists $args{password};
|
20
|
0
|
0
|
|
|
|
|
$self->{cookie_file} = $args{cookie_file} if exists $args{cookie_file};
|
21
|
0
|
0
|
|
|
|
|
(exists $args{scope})?($self->{scope} = $args{scope}):($self->{scope} = 'friends,photos,audio,video,wall,groups,messages,offline');
|
22
|
0
|
0
|
|
|
|
|
(exists $args{format})?($self->{format} = $args{format}):($self->{format} = 'Perl');
|
23
|
0
|
0
|
|
|
|
|
(exists $args{cookie_file})?($self->{ua} = _create_ua($args{cookie_file})):($self->{ua} = _create_ua());
|
24
|
|
|
|
|
|
|
|
25
|
0
|
|
|
|
|
|
bless $self, $class;
|
26
|
|
|
|
|
|
|
|
27
|
0
|
0
|
|
|
|
|
die 'ERROR: login failed' unless($self->_login());
|
28
|
0
|
0
|
|
|
|
|
die 'ERROR: authorize app failed' unless($self->_authorize_app());
|
29
|
|
|
|
|
|
|
|
30
|
0
|
0
|
|
|
|
|
$self->{ua}->cookie_jar()->save($self->{cookie_file}) if (exists $self->{cookie_file});
|
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
return $self;
|
33
|
|
|
|
|
|
|
}
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub _login {
|
36
|
0
|
|
|
0
|
|
|
my $self = shift;
|
37
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post('https://login.vk.com/?act=login', {
|
38
|
|
|
|
|
|
|
email => $self->{login},
|
39
|
|
|
|
|
|
|
pass => $self->{password},
|
40
|
|
|
|
|
|
|
});
|
41
|
0
|
|
|
|
|
|
print $res->header('location'),"\n",$res->content;
|
42
|
0
|
0
|
|
|
|
|
return 0 if $res->status_line ne "302 Found";
|
43
|
0
|
0
|
|
|
|
|
return 0 if $res->header('location') !~ /act=slogin&role=fast/; # bad login or password
|
44
|
0
|
|
|
|
|
|
$res = $self->{ua}->get($res->header('location'));
|
45
|
0
|
0
|
|
|
|
|
return 0 unless $res->is_success;
|
46
|
0
|
|
|
|
|
|
return $res->message;
|
47
|
|
|
|
|
|
|
}
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _authorize_app {
|
50
|
0
|
|
|
0
|
|
|
my $self = shift;
|
51
|
0
|
|
|
|
|
|
push @{ $self->{ua}->requests_redirectable }, 'POST';
|
|
0
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
my %authorize;
|
53
|
0
|
|
|
|
|
|
$authorize{request} = 'http://oauth.vk.com/authorize?'.
|
54
|
|
|
|
|
|
|
'client_id='.$self->{api_id}.
|
55
|
|
|
|
|
|
|
'&scope='.$self->{scope}.
|
56
|
|
|
|
|
|
|
'&redirect_uri=http://api.vk.com/blank.html'.
|
57
|
|
|
|
|
|
|
'&display=wap'.
|
58
|
|
|
|
|
|
|
'&response_type=token';
|
59
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post($authorize{request});
|
60
|
0
|
0
|
|
|
|
|
return 0 unless $res->is_success;
|
61
|
0
|
|
|
|
|
|
my $contect = $res->decoded_content;
|
62
|
0
|
0
|
|
|
|
|
$authorize{approve} = $1 if $contect =~ /action=\"(.+)\"/;
|
63
|
0
|
0
|
|
|
|
|
if (exists $authorize{approve}) {
|
64
|
0
|
|
|
|
|
|
$res = $self->{ua}->post($authorize{approve});
|
65
|
0
|
0
|
|
|
|
|
return 0 unless $res->is_success;
|
66
|
|
|
|
|
|
|
}
|
67
|
0
|
0
|
|
|
|
|
if ($res->request()->uri() =~ /access_token=(.+)&expires_in=0&user_id=(\d+)/) {
|
68
|
0
|
|
|
|
|
|
$self->{access_token} = $1;
|
69
|
0
|
|
|
|
|
|
$self->{uid} = $2;
|
70
|
|
|
|
|
|
|
}
|
71
|
0
|
|
|
|
|
|
return $res->message;
|
72
|
|
|
|
|
|
|
}
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _create_ua {
|
75
|
0
|
|
|
0
|
|
|
my $ua = LWP::UserAgent->new(agent => "VK::App $VERSION");
|
76
|
|
|
|
|
|
|
#push @{ $ua->requests_redirectable }, 'POST';
|
77
|
|
|
|
|
|
|
#$ua->ssl_opts(verify_hostname => 0);
|
78
|
0
|
0
|
|
|
|
|
($_[0])?($ua->cookie_jar( {file=>$_[0],autosave => 1} )):($ua->cookie_jar( { } ));
|
79
|
0
|
|
|
|
|
|
return $ua;
|
80
|
|
|
|
|
|
|
}
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub _clean_cookie {
|
83
|
0
|
|
|
0
|
|
|
my $self = shift;
|
84
|
0
|
|
|
|
|
|
$self->{ua}->cookie_jar()->clear();
|
85
|
0
|
|
|
|
|
|
return 1;
|
86
|
|
|
|
|
|
|
}
|
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub _valid_new_args {
|
89
|
0
|
|
|
0
|
|
|
my $args = shift;
|
90
|
0
|
0
|
|
|
|
|
return 0 unless ref($args) eq 'HASH';
|
91
|
0
|
0
|
0
|
|
|
|
if (!$args->{api_id} ||
|
|
|
|
0
|
|
|
|
|
92
|
|
|
|
|
|
|
((!$args->{login} || !$args->{password}) && !$args->{cookie_file}) ) {
|
93
|
0
|
|
|
|
|
|
return 0;
|
94
|
|
|
|
|
|
|
}
|
95
|
0
|
|
|
|
|
|
return 1;
|
96
|
|
|
|
|
|
|
}
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub ua {
|
99
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
100
|
0
|
0
|
|
|
|
|
die "Can't get UserAgent object" unless exists $self->{ua};
|
101
|
0
|
|
|
|
|
|
return $self->{ua};
|
102
|
|
|
|
|
|
|
}
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub access_token {
|
105
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
106
|
0
|
0
|
|
|
|
|
die "Can't get access token" unless exists $self->{access_token};
|
107
|
0
|
|
|
|
|
|
return $self->{access_token};
|
108
|
|
|
|
|
|
|
}
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub uid {
|
111
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
112
|
0
|
0
|
|
|
|
|
die "Can't get user id" unless exists $self->{uid};
|
113
|
0
|
|
|
|
|
|
return $self->{uid};
|
114
|
|
|
|
|
|
|
}
|
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub request {
|
117
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
118
|
0
|
|
|
|
|
|
my $method = shift;
|
119
|
0
|
0
|
|
|
|
|
$method .= '.xml' if $self->{format} eq "XML";
|
120
|
0
|
|
0
|
|
|
|
my $params = shift || {};
|
121
|
0
|
|
|
|
|
|
my $url = 'https://api.vk.com/method/'.$method;
|
122
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post($url, { %$params, access_token => $self->{access_token} });
|
123
|
0
|
0
|
|
|
|
|
return 0 unless $res->is_success;
|
124
|
0
|
|
|
|
|
|
my $content = $res->content;
|
125
|
0
|
0
|
|
|
|
|
return $content if ($self->{format} eq "XML");
|
126
|
0
|
0
|
|
|
|
|
return $content if ($self->{format} eq "JSON");
|
127
|
0
|
|
|
|
|
|
return decode_json($content);
|
128
|
|
|
|
|
|
|
}
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
1;
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
__END__
|