package session::AUTH::VKontakte;
use strict;
use warnings;
use LWP::UserAgent;
use JSON::XS;
use Data::Dumper;
use URI;
use URI::QueryParam;
use Encode;
use Contenido::Globals;
use vars qw($VERSION);
$VERSION = '4.1';
=for rem
vkontakte:
auto_create_user: 1
app_id: 122117614500563
app_secret: 656bd1369486b902e9bf831a9a08132b
authorize_url: http://api.vkontakte.ru/oauth/authorize
access_token_url: https://api.vkontakte.ru/oauth/access_token
user_info_url: https://api.vkontakte.ru/method/getProfiles
user_post_url: ~
=cut
our $JSON = JSON::XS->new->utf8;
=for rem SCHEMA
$m->redirect ( $fb_connect->fb_authorize_url( redirect_uri => ... ) );
=cut
sub new {
my ($class, %config) = @_;
my $self = bless {}, $class;
for (qw( vk_app_id vk_app_secret vk_authorize_url vk_access_token_url vk_user_info_url)) {
$self->{$_} = $config{$_} || $state->{session}->{$_} || return undef;
}
$self->{timeout} = $state->{session}->{connection_timeout} || 3;
for (qw(vk_user_post_url vk_redirect_uri)) {
$self->{$_} = $config{$_} || $state->{session}->{$_};
}
return $self;
}
sub authorize_url {
my $self = shift;
my (%args) = @_;
my $go = URI->new( $self->{vk_authorize_url} );
$go->query_param( client_id => $self->{vk_app_id} );
$go->query_param( scope => '' );
$go->query_param( response_type => 'code' );
$args{redirect_uri} ||= $self->{vk_redirect_uri};
for ( keys %args ) {
$go->query_param( $_ => $args{$_} );
}
$keeper->{session}->store_value( vk_redirect_url => $self->{vk_redirect_uri} );
return $go;
}
sub authenticate {
my ( $self, %authinfo ) = @_;
warn "VK.authenticate" if $DEBUG;
# TODO: we need callback url
#warn "user_session=".dumper( $c->user_session )." ";
my $local_session = $session || $keeper->{session}->get_session;
my $redirect_uri = $local_session->{vk_redirect_url};
my $access_token = $local_session->{vk_access_token};
my $vk_user_id = $local_session->{vk_user_id};
my $expires = $local_session->{vk_expires};
if ($access_token and $expires > time) {
warn "Already have access_token" if $DEBUG;
} else {
undef $access_token;
}
my $code = $authinfo{'code'};
unless ( $code ) {
warn "Call to authenticate without code\n";
return undef;
}
my $ua = LWP::UserAgent->new;
$ua->timeout($self->{timeout});
unless ($access_token) {
my $req = URI->new( $self->{vk_access_token_url});
$req->query_param( client_id => $self->{vk_app_id} );
$req->query_param( client_secret => $self->{vk_app_secret} );
$req->query_param( code => $code );
my $res = $ua->get($req);
unless ($res->code == 200) {
warn "VK: Access_token request failed: ".$res->status_line."\n";
return undef;
}
my $info = $JSON->decode($res->content);
unless ( ref $info eq 'HASH' && ($access_token = $info->{access_token}) ) {
warn "No access token in response: ".$res->content."\n";
return undef;
}
$keeper->{session}->store_value( vk_access_token => $access_token );
$local_session->{vk_access_token} = $access_token;
$keeper->{session}->store_value( vk_user_id => $info->{user_id} );
$local_session->{vk_user_id} = $info->{user_id};
if ( my $expires = $info->{expires_in} ) {
$local_session->{vk_expires} = time + $expires;
$keeper->{session}->store_value( vk_expires => $local_session->{vk_expires} );
} else {
#$c->user_session->{'expires'} = time + 3600*24;
}
warn "VK: requested access token";
} else {
warn "VK: have access token";
}
my $req = URI->new( $self->{vk_user_info_url} );
$req->query_param( uid => $local_session->{vk_user_id} );
$req->query_param( fields => 'uid,first_name,last_name,nickname,domain,sex,bdate,city,country,timezone,photo,photo_medium,photo_big' );
$req->query_param( access_token => $access_token );
warn "VK: Fetching user $req\n" if $DEBUG;
my $res = $ua->get($req);
unless ($res->code == 200) {
warn "VK: user request failed: ".$res->status_line."\n";
return undef;
}
my $info;
unless ( $info = eval { $JSON->decode($res->content) } ) {
warn "user '".$res->content."' decode failed: $@\n";
return undef;
}
warn Dumper($info) if $DEBUG;
return undef unless exists $info->{response} && ref $info->{response} eq 'ARRAY' && @{$info->{response}};
my $user_info = $info->{response}[0];
foreach my $key ( qw(nickname last_name first_name) ) {
$user_info->{$key} = Encode::encode('utf-8', $user_info->{$key});
Encode::from_to( $user_info->{$key}, 'utf-8', 'koi8-r' );
}
my @plugins = split (/[\ |\t]+/, $state->{plugins});
my $name = $user_info->{first_name}.' '.$user_info->{last_name};
if ( grep { $_ eq 'users' } @plugins ) {
my $user = $keeper->{users}->get_profile( login => 'vkontakte:'.$user_info->{uid} );
unless ( ref $user ) {
my $user_class = $state->{users}->profile_document_class;
$user = $user_class->new( $keeper );
$user->login( 'vkontakte:'.$user_info->{uid} );
$user->name( $user_info->{last_name}.', '.$user_info->{first_name} );
$user->nickname( $user_info->{nickname} );
$user->status( 1 );
$user->type( 0 );
$user->login_method('vkontakte');
$user->country( $user_info->{country} );
$user->email( undef );
my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
if ( ref $prop_ava ) {
my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' );
local $Data::Dumper::Indent = 0;
$user->avatar( Data::Dumper::Dumper($avatar) );
}
$user->store;
} else {
my ($prop_ava) = grep { $_->{attr} eq 'avatar' && $_->{type} eq 'image' } $user->structure;
if ( ref $prop_ava ) {
my $avatar = $user->get_image( 'avatar' );
unless ( ref $avatar && exists $avatar->{filename} ) {
my $avatar = $user->_store_image( $user_info->{photo_big}, attr => 'avatar' );
local $Data::Dumper::Indent = 0;
$user->avatar( Data::Dumper::Dumper($avatar) );
$user->store;
}
}
}
my %data = (
id => $user->id,
name => $name,
login => $user->login,
status => $user->status,
type => $user->type,
auth_by => 'vkontakte',
ltime => time,
);
if ( $user_info->{photo} ) {
$data{avatar} = $user_info->{photo};
}
$keeper->{session}->store_value ( %data );
while ( my ( $key, $value ) = each %data ) {
$local_session->{$key} = $value;
}
} else {
my %data = (
id => $user_info->{uid},
name => $name,
nick => $user_info->{nickname} || $name,
login => 'vkontakte:'.$user_info->{uid},
status => 1,
type => 0,
auth_by => 'vkontakte',
ltime => time,
);
if ( $user_info->{photo} ) {
$data{avatar} = $user_info->{photo};
}
$keeper->{session}->store_value ( %data );
while ( my ( $key, $value ) = each %data ) {
$local_session->{$key} = $value;
}
}
return $local_session;
}
1;
Небольшая справка по веткам
cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.
koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.
utf8 – актуальная ветка, заточенная под UTF-8.
Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.