File Coverage

blib/lib/VK/App.pm

Criterion	Covered	Total	%
statement	15	88	17.0
branch	0	64	0.0
condition	0	8	0.0
subroutine	5	15	33.3
pod	5	5	100.0
total	25	180	13.8

package VK::App;

use strict;
use warnings;
use LWP;
use LWP::Protocol::https;
use JSON;

our $VERSION = 0.12;

sub new {
  my ($class, %args) = @_;
  die "USAGE:\nVK::App->new(api_id => ... login => ... password => ...)\n",
  "VK::App->new(api_id => ... cookie_file => ...)\n" unless _valid_new_args(\%args);

  my $self;
  $self->{api_id}      = $args{api_id}       if exists $args{api_id};
  $self->{login}       = $args{login}        if exists $args{login};
  $self->{password}    = $args{password}     if exists $args{password};
  $self->{cookie_file} = $args{cookie_file}  if exists $args{cookie_file};
  (exists $args{scope})?($self->{scope} = $args{scope}):($self->{scope} = 'friends,photos,audio,video,wall,groups,messages,offline');
  (exists $args{format})?($self->{format} = $args{format}):($self->{format} = 'Perl');
  (exists $args{cookie_file})?($self->{ua} = _create_ua($args{cookie_file})):($self->{ua} = _create_ua());

  bless $self, $class;

  die 'ERROR: login failed' unless($self->_login());
  die 'ERROR: authorize app failed' unless($self->_authorize_app());

  $self->{ua}->cookie_jar()->save($self->{cookie_file}) if (exists $self->{cookie_file});

  return $self;
}

sub _login {
  my $self = shift;
  my $lpage = $self->{ua}->get('http://vk.com/login.php');
  return 0 unless ($lpage->is_success); # network problem?
  my $action = $1 if $lpage->content =~ /action=\"(.+?)\"/;
  return 1 unless $action; # log in already? go to the next step
  my $res = $self->{ua}->post($action, {
  #my $res = $self->{ua}->post('https://login.vk.com/?act=login', {
      email => $self->{login},
      pass => $self->{password},
    });
  return 0 if $res->status_line ne "302 Found";
  return 0 if $res->header('location') !~ /__q_hash/;
  $res = $self->{ua}->get($res->header('location'));
  return 0 unless $res->is_success;
  return $res->message;
}

sub _authorize_app {
  my $self = shift;
  push @{ $self->{ua}->requests_redirectable }, 'POST';
  my %authorize;
  $authorize{request} = 'http://oauth.vk.com/authorize?'.
  'client_id='.$self->{api_id}.
  '&scope='.$self->{scope}.
  '&redirect_uri=http://api.vk.com/blank.html'.
  '&display=wap'.
  '&response_type=token';
  my $res = $self->{ua}->post($authorize{request});
  return 0 unless $res->is_success;
  my $contect = $res->decoded_content;
  $authorize{approve} = $1 if $contect =~ /action=\"(.+)\"/;
  if (exists $authorize{approve}) {
    $res = $self->{ua}->post($authorize{approve});
    return 0 unless $res->is_success;
  }
  if ($res->request()->uri() =~ /access_token=(.+)&expires_in=0&user_id=(\d+)/) {
    $self->{access_token} = $1;
    $self->{uid} = $2;
  }
  return $res->message;
}

sub _create_ua {
  my $ua = LWP::UserAgent->new(agent => "VK::App $VERSION");
  #push @{ $ua->requests_redirectable }, 'POST';
  #$ua->ssl_opts(verify_hostname => 0);
  ($_[0])?($ua->cookie_jar( {file=>$_[0],autosave => 1} )):($ua->cookie_jar( { } ));
  return $ua;
}

sub _clean_cookie {
  my $self = shift;
  $self->{ua}->cookie_jar()->clear();
  return 1;
}

sub _valid_new_args {
  my $args = shift;
  return 0 unless ref($args) eq 'HASH';
  if (!$args->{api_id} ||
     ((!$args->{login} || !$args->{password}) && !$args->{cookie_file}) ) {
       return 0;
  }
  return 1;
}

sub ua {
  my $self = shift;
  die "Can't get UserAgent object" unless exists $self->{ua};
  return $self->{ua};
}

sub access_token {
  my $self = shift;
  die "Can't get access token" unless exists $self->{access_token};
  return $self->{access_token};
}

sub uid {
  my $self = shift;
  die "Can't get user id" unless exists $self->{uid};
  return $self->{uid};
}

sub request {
  my $self   = shift;
  my $method = shift;
  $method .= '.xml' if $self->{format} eq "XML";
  my $params = shift || {};
  my $url = 'https://api.vk.com/method/'.$method;
  my $res = $self->{ua}->post($url, { %$params, access_token => $self->{access_token} });
  return 0 unless $res->is_success;
  my $content = $res->content;
  return $content if ($self->{format} eq "XML");
  return $content if ($self->{format} eq "JSON");
  return decode_json($content);
}

1;

__END__