File Coverage

blib/lib/VK/App.pm
Criterion Covered Total %
statement 15 85 17.6
branch 0 58 0.0
condition 0 8 0.0
subroutine 5 15 33.3
pod 5 5 100.0
total 25 171 14.6


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__