File Coverage

blib/lib/Net/VKontakte/Standalone.pm

Criterion	Covered	Total	%
statement	21	95	22.1
branch	0	44	0.0
condition	0	12	0.0
subroutine	7	16	43.7
pod	8	8	100.0
total	36	175	20.5

package Net::VKontakte::Standalone;

use 5.008000;
use strict;
use warnings;

use URI;
use WWW::Mechanize;
use JSON;
use Carp;

our $VERSION = '0.11';

sub new {
	my $class = shift;
	my $self = bless {},$class;
	$self->{browser} =  WWW::Mechanize::->new(
		agent => __PACKAGE__.$VERSION,
		autocheck => 1,
	);
	if (@_ == 1) {
		$self->{api_id} = $_[0];
	} elsif (@_ % 2 == 0) { # smells like hash
		my %opt = @_;
		for my $key (qw/api_id errors_noauto captcha_handler/) {
			$self->{$key} = $opt{$key} if defined $opt{$key};
		}
	} else {
		croak "wrong number of arguments to constructor";
	}
	croak "api_id is required" unless $self->{api_id};
	return $self;
}

sub _request {
	my ($self, $params, $base) = @_;
	(my $uri = URI::->new($base))->query_form($params);
	return $self->{browser}->get($uri);
}

sub auth { # dirty hack
	my ($self,$login,$password,$scope) = @_;
	@{$self}{"login","password","scope"} = ($login, $password, $scope); # reuse in case of reauth
	$self->{browser}->get($self->auth_uri($scope));
	$self->{browser}->submit_form(
		with_fields => {
			email => $login,
			pass => $password,
		},
	); # log in
	$self->{browser}->submit unless $self->{browser}->uri =~ m|^https://oauth.vk.com/blank.html|; # allow access if requested to
	return $self->redirected($self->{browser}->uri);
}

sub auth_uri {
	my ($self, $scope, $display) = @_;
	(my $uri = URI::->new("https://api.vkontakte.ru/oauth/authorize"))->query_form(
		{
			client_id => $self->{api_id},
			redirect_uri => "blank.html",
			scope => $scope,
			response_type => "token",
			display => $display,
		}
	);
	return $uri->canonical;
}

sub redirected {
	my ($self, $uri) = @_;
	my %params = map { split /=/,$_,2 } split /&/,$1 if $uri =~ m|https://oauth.vk.com/blank.html#(.*)|;
	croak "No access_token returned (wrong login/password?)" unless defined $params{access_token};
	$self->{access_token} = $params{access_token};
	croak "No token expiration time returned" unless $params{expires_in};
	$self->{auth_time} = time;
	$self->{expires_in} = $params{expires_in};
	return $self;
}


sub api {
	my ($self,$method,$params) = @_;
	croak "Cannot make API calls unless authentificated" unless defined $self->{access_token};
	if (time - $self->{auth_time} > $self->{expires_in}) {
		if ($self->{login} && $self->{password} && $self->{scope}) {
			$self->auth($self->{"login","password","scope"});
		} else {
			if ($self->{errors_noauto}) {
				$self->{error} = "access_token expired";
					if (ref $self->{errors_noauto} and ref $self->{errors_noauto} eq "CODE") {
						$self->{errors_noauto}->({error_code => "none", error_msg => "access_token expired"});
					}
				return;
			} else {
				croak "access_token expired";
			}
		}
	}
	$params->{access_token} = $self->{access_token};
	REQUEST: {
		my $response = decode_json $self->_request($params,"https://api.vk.com/method/$method")->decoded_content;
		if ($response->{response}) {
			return $response->{response};
		} elsif ($response->{error}) {
			if ($self->{errors_noauto}) {
				$self->{error} = $response->{error};
				if (ref $self->{errors_noauto} and ref $self->{errors_noauto} eq "CODE") {
					$self->{errors_noauto}->($response->{error});
				}
				return;
			} else {
				if (6 == $response->{error}{error_code}) { # Too many requests per second.
					sleep 1;
					redo REQUEST;
				} elsif (14 == $response->{error}{error_code}) { # Captcha is needed
					if ($self->{captcha_handler}) {
						$params->{captcha_key} = $self->{captcha_handler}->($response->{error}{captcha_img});
						$params->{captcha_sid} = $response->{error}{captcha_sid};
						redo REQUEST;
					} else {
						croak "Captcha is needed and no captcha handler specified";
					}
				} else {
					croak "API call returned error ".$response->{error}{error_msg};
				}
			}
		} else {
			croak "API call didn't return response or error".
				$Carp::Verbose ? eval { require Data::Dumper; Data::Dumper::Dumper($response) }
				: "";
		}
	}
}

sub captcha_handler {
	my ($self, $handler) = @_;
	croak "\$handler is not a subroutine reference" unless ref $handler eq "CODE";
	$self->{captcha_handler} = $handler;
	return $self;
}

sub error {
	return shift->{error};
}

sub errors_noauto {
	my ($self, $noauto) = @_;
	$self->{errors_noauto} = $noauto; # whatever this means
	return $self;
}

1;
__END__