File Coverage

blib/lib/Net/VKontakte/Standalone.pm

Criterion	Covered	Total	%
statement	26	132	19.7
branch	1	54	1.8
condition	0	24	0.0
subroutine	9	24	37.5
pod	11	11	100.0
total	47	245	19.1

package Net::VKontakte::Standalone;

use 5.006000;
use strict;
use warnings;

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

our $VERSION = '0.18_95';

sub import {
	my $class = shift;
	return unless @_;
	my %opts = @_;
	my @import = exists $opts{import} ? @{delete $opts{import}} : (qw/
		auth auth_uri redirected permament_token api post captcha_handler error errors_noauto access_token AUTOLOAD
	/);
	my $vk = $class->new(%opts);
	my $caller = caller;
	no strict 'refs';
	for my $method (@import) {
		*{$caller."::".$method} = sub { $vk->$method(@_) };
	};
}

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 access_token/) {
			$self->{$key} = $opt{$key} if defined $opt{$key};
		}
	} else {
		croak "wrong number of arguments to constructor";
	}
	croak "api_id or access_token is required" unless $self->{api_id} or $self->{access_token};
	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}->cookie_jar->clear; # VK won't give us the fields if we have authentificated cookies
	$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 permament_token {
	my ($self, %params) = @_;
	$params{grant_type} = "password";
	$params{client_id} = $self->{api_id};
	REDO: { # for CAPTCHA
		my $result = decode_json $self->_request(\%params, "https://oauth.vk.com/token")->decoded_content;
		if ($result->{access_token}) {
			$self->{access_token} = $result->{access_token};
			return 1;
		} elsif ($result->{error}) {
			if ($result->{error} eq "need_captcha" and $self->{captcha_handler}) {
				$params{captcha_key} = $self->{captcha_handler}->($result->{error}{captcha_img});
				$params{captcha_sid} = $result->{error}{captcha_sid};
				redo REDO;
			} elsif ($self->errors_noauto) {
				$self->{error} = $result;
				if (ref $self->{errors_noauto} and ref $self->{errors_noauto} eq 'CODE') {
					$self->{errors_noauto}->($result);
				}
				return;
			} else {
				croak "Permament token call returned error ".$result->{error_description};
			}
		} else {
			croak "Permament token call didn't return response or error\n".
				$Carp::Verbose ? eval { require Data::Dumper; Data::Dumper::Dumper($result) }
				: "";
		}
	}
}

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} and $self->{login} && $self->{password} && $self->{scope}) {
		$self->auth($self->{"login","password","scope"});
	}
	$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 (14 == $response->{error}{error_code} and $self->{captcha_handler}) { # it's a CAPTCHA request, user wants to handle it specially
				$params->{captcha_key} = $self->{captcha_handler}->($response->{error}{captcha_img});
				$params->{captcha_sid} = $response->{error}{captcha_sid};
				redo REQUEST;
			} elsif ($self->{errors_noauto}) { # user ignores or handles errors by him(her)self, it's not a CAPTCHA or no captcha_handler
				$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;
				} else { # other special cases which can be handled automatically?
					croak "API call returned error: ".$response->{error}{error_msg};
				}
				# 5 == user authorisation failed, invalid access token of any kind
			}
		} else {
			croak "API call didn't return response or error\n".
				$Carp::Verbose ? eval { require Data::Dumper; Data::Dumper::Dumper($response) }
				: "";
		}
	}
}

sub post {
	my ($self, $url, %fields) = @_;
	return decode_json $self->{browser}->post($url, Content_Type => 'form_data', Content => [ %fields ]);
}

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;
}

sub access_token {
	my ($self, $token) = @_;
	return defined $token ? do { $self->{access_token} = $token } : $self->{access_token};
}

sub DESTROY {}

sub AUTOLOAD {
	our $AUTOLOAD;
	$AUTOLOAD =~ s/.*:://;
	$AUTOLOAD =~ tr/_/./;
	my ($self, $params) = @_;
	$self->api($AUTOLOAD,$params);
}

1;
__END__