Начальный коммит
This commit is contained in:
eleksir
197
lib/YadProxy.pm
Normal file
197
lib/YadProxy.pm
Normal file
@@ -0,0 +1,197 @@
|
||||
package YadProxy;
|
||||
# Выдаёт листинг каталогов в стиле nginx и редиректы для файлов
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use CHI;
|
||||
use CHI::Driver::BerkeleyDB;
|
||||
use File::Basename qw (basename dirname);
|
||||
use List::SomeUtils qw (any);
|
||||
use YadProxy::Conf qw (LoadConf);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (DirList);
|
||||
|
||||
my $c = LoadConf ();
|
||||
my $index_dir = $c->{index_dir};
|
||||
my $url_prefix = $c->{url_prefix};
|
||||
|
||||
|
||||
sub DirList {
|
||||
my $requested_path = shift;
|
||||
|
||||
if ((! defined $requested_path) || $requested_path eq '') {
|
||||
$requested_path = '/';
|
||||
} else {
|
||||
while (substr ($requested_path, -1) eq '/') {
|
||||
chop $requested_path;
|
||||
}
|
||||
|
||||
if ((! defined $requested_path) || $requested_path eq '') {
|
||||
$requested_path = '/';
|
||||
}
|
||||
}
|
||||
|
||||
my @output;
|
||||
my @found;
|
||||
my $status = '200';
|
||||
my $content_type = 'text/plain';
|
||||
|
||||
my $index_url = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $index_dir,
|
||||
namespace => 'url'
|
||||
);
|
||||
|
||||
# прежде чем строить индекс, проверим-ка мы запрос на вшивость, вдруг, с нас запрашивают файл?
|
||||
# в этом случае нам надо отдать 302
|
||||
if (my $url = $index_url->get ($requested_path)) {
|
||||
return ('302', 'text/plain', $url);
|
||||
}
|
||||
|
||||
my $index_size = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $index_dir,
|
||||
namespace => 'size'
|
||||
);
|
||||
|
||||
my $index_md5 = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $index_dir,
|
||||
namespace => 'md5'
|
||||
);
|
||||
|
||||
my $index_sha256 = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $index_dir,
|
||||
namespace => 'sha256'
|
||||
);
|
||||
|
||||
my $index_dirs = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $index_dir,
|
||||
namespace => 'dirs'
|
||||
);
|
||||
|
||||
my $index_mtime = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $index_dir,
|
||||
namespace => 'mtime'
|
||||
);
|
||||
|
||||
my $index_of;
|
||||
|
||||
if ($requested_path eq '/') {
|
||||
$index_of = $url_prefix;
|
||||
} else {
|
||||
$index_of = $url_prefix . '/' . $requested_path;
|
||||
}
|
||||
|
||||
if (substr ($url_prefix, 0, 1) ne '/') {
|
||||
$index_of = '/' . $index_of;
|
||||
}
|
||||
|
||||
push @output, "<html>";
|
||||
push @output, sprintf '<head><title>Index of %s/</title></head>', $index_of;
|
||||
push @output, "<body>";
|
||||
push @output, sprintf '<h1>Index of %s/</h1><hr><pre><a href="../">../</a>', $index_of;
|
||||
|
||||
# попробуем отловить все каталоги, начинающиеся с запрошенного пути
|
||||
foreach my $key (sort ($index_dirs->get_keys ())) {
|
||||
if (
|
||||
(
|
||||
(defined $key) &&
|
||||
(length ($key) > length ($requested_path)) &&
|
||||
(substr ($key, 0, length ($requested_path)) eq $requested_path)
|
||||
) ||
|
||||
$requested_path eq '/'
|
||||
) {
|
||||
my @dirs;
|
||||
|
||||
if ($requested_path eq '/') {
|
||||
@dirs = split /\//, $key;
|
||||
} else {
|
||||
@dirs = split /\//, substr ($key, 1 + length ($requested_path));
|
||||
}
|
||||
|
||||
if (defined $dirs[0] && (! any {$_ eq $dirs[0]} @found)) {
|
||||
# у каталогов нету ctime или mtime, так что поставим 01-Jan-1970 00:00
|
||||
push @found, $dirs[0];
|
||||
my $str = $dirs[0];
|
||||
my $len = 50 - (1 + length ($str));
|
||||
|
||||
if ($len < 0) {
|
||||
$str = substr ($str, 0, 47);
|
||||
$str .= '...';
|
||||
$len = 0;
|
||||
}
|
||||
|
||||
# there is no way to get dir mtime from yandex.disk
|
||||
push @output, sprintf (
|
||||
"<a href=\"%s/\">%s/</a>% ${len}s 01-Jan-1970 00:00 -",
|
||||
$dirs[0],
|
||||
$str,
|
||||
''
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# попробуем отловить все файлы, начинающиеся с запрошенного пути
|
||||
foreach my $key (sort ($index_url->get_keys())) {
|
||||
if (
|
||||
(
|
||||
(defined $key) &&
|
||||
(length ($key) > length ($requested_path)) &&
|
||||
(substr ($key, 0, length ($requested_path)) eq $requested_path)
|
||||
) ||
|
||||
$requested_path eq '/'
|
||||
) {
|
||||
my $str;
|
||||
my @urls;
|
||||
|
||||
if ($requested_path eq '/') {
|
||||
@urls = split /\//, $key;
|
||||
} else {
|
||||
@urls = split /\//, substr ($key, 1 + length ($requested_path));
|
||||
}
|
||||
|
||||
if (defined $urls[0] && (! any {$_ eq $urls[0]} @found)) {
|
||||
push @found, $urls[0];
|
||||
$str = $urls[0];
|
||||
}
|
||||
|
||||
if ($#urls < 1) {
|
||||
my $len = 50 - length ($str);
|
||||
|
||||
if ($len < 0) {
|
||||
$str = substr ($str, 0, 47);
|
||||
$str .= '...';
|
||||
$len = 0;
|
||||
}
|
||||
|
||||
push @output, sprintf (
|
||||
"<a href=\"%s/\">%s</a>% ${len}s %s % 19s",
|
||||
$index_url->get ($key),
|
||||
$str,
|
||||
'',
|
||||
$index_mtime->get ($key),
|
||||
$index_size->get ($key)
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
push @output, "</pre><hr></body>";
|
||||
push @output, "</html>";
|
||||
return ('200', 'text/html', join "\n", @output);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
41
lib/YadProxy/Conf.pm
Normal file
41
lib/YadProxy/Conf.pm
Normal file
@@ -0,0 +1,41 @@
|
||||
package YadProxy::Conf;
|
||||
# loads config
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
use JSON::XS;
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (LoadConf);
|
||||
|
||||
sub LoadConf {
|
||||
my $c = 'data/config.json';
|
||||
open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
|
||||
binmode $CH;
|
||||
my $len = (stat $c) [7];
|
||||
my $json;
|
||||
my $readlen = read $CH, $json, $len;
|
||||
|
||||
unless ($readlen) {
|
||||
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
|
||||
die "[FATAL] Unable to read $c: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
if ($readlen != $len) {
|
||||
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
|
||||
die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
|
||||
}
|
||||
|
||||
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
|
||||
my $j = JSON::XS->new->utf8->relaxed;
|
||||
return $j->decode ($json);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
76
lib/YadProxy/Lib.pm
Normal file
76
lib/YadProxy/Lib.pm
Normal file
@@ -0,0 +1,76 @@
|
||||
package YadProxy::Lib;
|
||||
# Утилитарные функции для работы с ya.disk
|
||||
|
||||
use 5.018;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
|
||||
use CHI;
|
||||
use CHI::Driver::BerkeleyDB;
|
||||
use Log::Any qw ($log);
|
||||
use YadProxy::Conf qw (LoadConf);
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
use Exporter qw (import);
|
||||
our @EXPORT_OK = qw (GetAccessToken RefreshAccessToken);
|
||||
|
||||
|
||||
my $c = LoadConf ();
|
||||
|
||||
sub GetAccessToken {
|
||||
my $cache = CHI->new (
|
||||
driver => 'BerkeleyDB',
|
||||
root_dir => $c->{oauth_dir},
|
||||
namespace => 'yad_auth'
|
||||
);
|
||||
|
||||
my $access_token = $cache->get ('access_token');
|
||||
|
||||
unless (defined $access_token) {
|
||||
my $refresh_token = $cache->get ('refresh_token');
|
||||
|
||||
unless (defined $refresh_token) {
|
||||
$log->fatal ("No refresh_token found in base, please, register yaproxy application");
|
||||
exit 1;
|
||||
}
|
||||
|
||||
my $token = RefreshAccessToken ($refresh_token);
|
||||
# yad обычно выдаёт токен на год, скинем с этого 1 минуту :) чтобы уж точно
|
||||
$cache->set ('refresh_token', $token->{refresh_token}, 'never');
|
||||
$cache->set ('access_token', $token->{access_token}, $token->{expires_in} - 60);
|
||||
$access_token = $token->{access_token};
|
||||
}
|
||||
|
||||
return $access_token;
|
||||
}
|
||||
|
||||
sub RefreshAccessToken {
|
||||
my $refresh_token = shift;
|
||||
|
||||
my $oauth = Yandex::OAuth->new (
|
||||
client_id => $c->{ID},
|
||||
client_secret => $c->{'Пароль'},
|
||||
);
|
||||
|
||||
my $token;
|
||||
my $counter = 0;
|
||||
|
||||
while ((! defined $token->{access_token}) || ($counter < 3)) {
|
||||
$token = $oauth->refresh_token ( refresh_token => $refresh_token );
|
||||
$counter++;
|
||||
}
|
||||
|
||||
if (defined $token->{access_token}) {
|
||||
return $token;
|
||||
} else {
|
||||
$log->fatal ("[FATAL] Unable to refresh access_token");
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
631
lib/Yandex/Disk.pm
Normal file
631
lib/Yandex/Disk.pm
Normal file
@@ -0,0 +1,631 @@
|
||||
package Yandex::Disk;
|
||||
|
||||
use 5.008001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use Yandex::Disk::Public;
|
||||
use Carp qw/croak carp/;
|
||||
use LWP::UserAgent;
|
||||
use JSON::XS;
|
||||
use File::Basename;
|
||||
use URI::Escape;
|
||||
use Encode;
|
||||
use IO::Socket::SSL;
|
||||
use Term::Sk;
|
||||
|
||||
our $VERSION = '0.06';
|
||||
|
||||
my $WAIT_RETRY = 20;
|
||||
my $BUFF_SIZE = 2777216;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %opt = @_;
|
||||
my $self = {};
|
||||
$self->{token} = $opt{-token} || croak "Specify -token param";
|
||||
|
||||
my $ua = LWP::UserAgent->new(timeout => 10);
|
||||
$ua->agent("Yandex::Disk perl module");
|
||||
$ua->default_header('Accept' => 'application/json');
|
||||
$ua->default_header('Content-Type' => 'application/json');
|
||||
$ua->default_header('Connection' => 'keep-alive');
|
||||
$ua->default_header('Authorization' => 'OAuth ' . $self->{token});
|
||||
$self->{ua} = $ua;
|
||||
$self->{public_info} = {};
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
|
||||
sub getDiskInfo {
|
||||
my $self = shift;
|
||||
my $url = 'https://cloud-api.yandex.net/v1/disk/';
|
||||
my $res = $self->__request($url, "GET");
|
||||
if ($res->is_success) {
|
||||
return __fromJson($res->decoded_content);
|
||||
}
|
||||
else {
|
||||
croak "Cant execute request to $url: " . $res->status_line;
|
||||
}
|
||||
}
|
||||
|
||||
sub uploadFile {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $overwrite = $opt{-overwrite};
|
||||
my $file = $opt{-file} || croak "Specify -file param";
|
||||
my $remote_path = $opt{-remote_path} || croak "Specify -remote_path param";
|
||||
my $show_progress_bar = $opt{-show_progress_bar};
|
||||
|
||||
$overwrite = 1 if not defined $overwrite;
|
||||
|
||||
if (not -f $file) {
|
||||
croak "File $file not exists";
|
||||
}
|
||||
|
||||
$overwrite = $overwrite ? 'true' : 'false';
|
||||
|
||||
#Delete end slash
|
||||
$remote_path =~ s/^\/|\/$//g;
|
||||
$remote_path = sprintf("/%s/%s", $remote_path, basename($file));
|
||||
|
||||
my $param = "?path=" . uri_escape($remote_path) . "&overwrite=$overwrite";
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/upload' . $param, "GET");
|
||||
my $url_to_upload;
|
||||
my $code = $res->code;
|
||||
if ($code eq '409') {
|
||||
croak "Folder $remote_path not exists";
|
||||
}
|
||||
elsif ($code eq '200') {
|
||||
$url_to_upload = __fromJson($res->decoded_content)->{href};
|
||||
}
|
||||
else {
|
||||
croak "Cant uploadFile: " . $res->status_line;
|
||||
}
|
||||
|
||||
# Progress bar if need
|
||||
my $term;
|
||||
if ($show_progress_bar) {
|
||||
$term = __prepareProgressBar(-s $file);
|
||||
}
|
||||
|
||||
my $upl_code = __upload_file($url_to_upload, $file, $term);
|
||||
|
||||
if ($upl_code ne '201') {
|
||||
croak "Cant upload file. Code: $code";
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub createFolder {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
my $recursive = $opt{-recursive};
|
||||
|
||||
if ($recursive) {
|
||||
my @half_path;
|
||||
for my $l_path (split /\//, $path) {
|
||||
push @half_path, $l_path;
|
||||
$self->createFolder( -path => join('/', @half_path) );
|
||||
}
|
||||
}
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/?path=' . uri_escape($path), "PUT");
|
||||
my $code = $res->code;
|
||||
if ($code eq '409') {
|
||||
#Папка или существует или не создана родительская папка
|
||||
my $json_res = __fromJson($res->decoded_content);
|
||||
if ($json_res->{error} eq 'DiskPathPointsToExistentDirectoryError') {
|
||||
return 1;
|
||||
}
|
||||
croak $json_res->{description};
|
||||
}
|
||||
elsif ($code ne '201') {
|
||||
croak "Cant create folder $path. Error: " . $res->status_line;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub deleteResource {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
my $wait = $opt{-wait};
|
||||
my $permanently = $opt{-permanently};
|
||||
|
||||
$permanently = $permanently ? 'true' : 'false';
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources?path=' . uri_escape($path) . "&permanently=$permanently", "DELETE");
|
||||
my $code = $res->code;
|
||||
if ($code eq '204') {
|
||||
#Free folder
|
||||
return 1;
|
||||
}
|
||||
elsif ($code eq '202') {
|
||||
if ($wait) {
|
||||
my $href = __fromJson($res->decoded_content)->{href};
|
||||
$self->__waitResponse($href, $WAIT_RETRY) or croak "Timeout to wait response. Try increase $WAIT_RETRY variable";
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
croak "Cant delete $path. Error: " . $res->status_line;
|
||||
}
|
||||
}
|
||||
|
||||
sub downloadFile {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
my $file = $opt{-file} || croak "Specify -file param";
|
||||
my $show_progress_bar = $opt{-show_progress_bar};
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/download?path=' . uri_escape($path), "GET");
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Error on request file $path: " . $res->status_line;
|
||||
}
|
||||
|
||||
my $download_url = __fromJson($res->decoded_content)->{href};
|
||||
|
||||
my $term;
|
||||
if ($show_progress_bar) {
|
||||
if ($download_url =~ /[&?]fsize=(\d+)/) {
|
||||
$term = __prepareProgressBar($1);
|
||||
}
|
||||
else {
|
||||
carp "Can't get size of downloaded file. Progress bar will disabled.";
|
||||
}
|
||||
}
|
||||
|
||||
$self->__download($download_url, $file, $term);
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub emptyTrash {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || '';
|
||||
my $wait = $opt{-wait};
|
||||
|
||||
my $param = $path ? '?path=' . uri_escape($path) : '';
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/trash/resources/' . $path, 'DELETE');
|
||||
my $code = $res->code;
|
||||
if ($code eq '204') {
|
||||
return 1;
|
||||
}
|
||||
elsif ($code eq '202') {
|
||||
if ($wait) {
|
||||
my $href = __fromJson($res->decoded_content)->{href};
|
||||
$self->__waitResponse($href, $WAIT_RETRY) or croak "Timeout to wait response. Try increase $WAIT_RETRY variable";
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
$path = "by path $path" if $path;
|
||||
croak "Cant empty trash$path. Error: " . $res->status_line;
|
||||
}
|
||||
}
|
||||
|
||||
sub fileInfo {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
|
||||
my $param = '?path=' . uri_escape($path);
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources' . $param, 'GET');
|
||||
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Error on fileInfo. Error: " . $res->status_line;
|
||||
}
|
||||
my $json_res = __fromJson($res->{_content});
|
||||
return $json_res;
|
||||
}
|
||||
|
||||
sub listFiles {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
my $limit = $opt{-limit} || 999999;
|
||||
my $offset = $opt{-offset};
|
||||
$offset = 0 if not $offset;
|
||||
|
||||
my $param = '?path=' . uri_escape($path) . "&limit=$limit&offset=$offset&fields=_embedded.items";
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources' . $param, 'GET');
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Error on listFiles. Error: " . $res->status_line;
|
||||
}
|
||||
my $json_res = __fromJson($res->decoded_content);
|
||||
|
||||
return $json_res->{_embedded}->{items};
|
||||
}
|
||||
|
||||
sub listAllFiles {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $limit = $opt{-limit} || 999999;
|
||||
my $media_type = $opt{-media_type};
|
||||
my $offset = $opt{-offset};
|
||||
$offset = 0 if not $offset;
|
||||
|
||||
my $param = "?limit=$limit&offset=$offset";
|
||||
$param .= '&media_type=' . $media_type if $media_type;
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/files' . $param, 'GET');
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Error on listFiles. Error: " . $res->status_line;
|
||||
}
|
||||
my $json_res = __fromJson($res->decoded_content);
|
||||
|
||||
return $json_res->{items};
|
||||
}
|
||||
|
||||
sub lastUploadedFiles {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $limit = $opt{-limit} || 999999;
|
||||
my $media_type = $opt{-media_type};
|
||||
|
||||
my $param = "?limit=$limit";
|
||||
$param .= '&media_type=' . $media_type if $media_type;
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/last-uploaded' . $param, 'GET');
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Error on listFiles. Error: " . $res->status_line;
|
||||
}
|
||||
my $json_res = __fromJson($res->decoded_content);
|
||||
|
||||
return $json_res->{items};
|
||||
}
|
||||
|
||||
|
||||
sub public {
|
||||
my $self = shift;
|
||||
return Yandex::Disk::Public->new( -token => $self->{token} );
|
||||
}
|
||||
|
||||
sub __download {
|
||||
my ($self, $url, $fname, $term) = @_;
|
||||
my $ua = $self->{ua};
|
||||
|
||||
open my $FL, ">$fname" or croak "Cant open $fname to write $!";
|
||||
binmode $FL;
|
||||
my $res = $ua->get($url, ':read_size_hint' => $BUFF_SIZE, ':content_cb' =>
|
||||
sub {
|
||||
print $FL $_[0];
|
||||
$term->up($BUFF_SIZE) if $term;
|
||||
}
|
||||
);
|
||||
close $FL;
|
||||
$term->close if $term;
|
||||
|
||||
if ($res->code eq '200') {
|
||||
return 1;
|
||||
}
|
||||
croak "Cant download file $url to $fname. Error: " . $res->status_line;
|
||||
}
|
||||
|
||||
sub __waitResponse {
|
||||
#Дожидается ответа о статусе операции
|
||||
my ($self, $url, $retry) = @_;
|
||||
|
||||
while ($retry > 0) {
|
||||
my $res = $self->__request($url, "GET");
|
||||
my $code = $res->code;
|
||||
if ($code eq '200' && __fromJson($res->decoded_content)->{status} eq 'success') {
|
||||
return 1;
|
||||
}
|
||||
sleep 1;
|
||||
$retry--;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub __upload_file {
|
||||
#Buffered chunked upload file
|
||||
my ($url, $file, $term) = @_;
|
||||
|
||||
my $u1 = URI->new($url);
|
||||
|
||||
# $IO::Socket::SSL::DEBUG = 3;
|
||||
my $host = $u1->host;
|
||||
my $port = $u1->port;
|
||||
my $path = $u1->path;
|
||||
|
||||
my $sock = IO::Socket::SSL->new(
|
||||
PeerAddr => $host,
|
||||
PeerPort => $port,
|
||||
Proto => 'tcp',
|
||||
) or croak "Cant connect to $host:$port";
|
||||
binmode $sock;
|
||||
$sock->autoflush(1);
|
||||
|
||||
$sock->print("PUT $path HTTP/1.1\n");
|
||||
$sock->print("HOST: $host\n");
|
||||
$sock->print("Connection: close\n");
|
||||
$sock->print("Content-Type: application/json\n");
|
||||
$sock->print("Transfer-Encoding: chunked\n");
|
||||
$sock->print("\n");
|
||||
|
||||
open my $FH, "<$file" or croak "Cant open $file $!";
|
||||
binmode $FH;
|
||||
my $filebuf;
|
||||
while (my $bytes = read($FH, $filebuf, $BUFF_SIZE)) {
|
||||
my $hex = sprintf("%X", $bytes);
|
||||
$sock->print($hex) or croak "Cant print to socket";
|
||||
$sock->print("\r\n") or croak "Cant print to socket";
|
||||
|
||||
$sock->print($filebuf) or croak "Cant print to socket";
|
||||
$sock->print("\r\n") or croak "Cant print to socket";
|
||||
|
||||
$term->up($BUFF_SIZE) if $term;
|
||||
}
|
||||
close $FH;
|
||||
|
||||
$sock->print("0\r\n") or croak "Cant print to socket";
|
||||
$sock->print("\r\n") or croak "Cant print to socket";
|
||||
|
||||
my @answer = $sock->getlines();
|
||||
$sock->close();
|
||||
|
||||
$term->close if $term;
|
||||
|
||||
my ($code) = $answer[0] =~ /(\d{3})/;
|
||||
|
||||
return $code;
|
||||
}
|
||||
|
||||
|
||||
sub __request {
|
||||
my ($self, $url, $type) = @_;
|
||||
|
||||
my $ua = $self->{ua};
|
||||
my $req = HTTP::Request->new($type => $url);
|
||||
my $res = $ua->request($req);
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub __fromJson {
|
||||
my $string = ref($_[0]) ? $_[1] : $_[0];
|
||||
my $res = JSON::XS::decode_json($string);
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub __prepareProgressBar {
|
||||
my ($file_size) = @_;
|
||||
my $format = '%2d Elapsed: %8t %21b %4p %2d (%8c of %11m bytes)';
|
||||
my $target = $file_size;
|
||||
my $term = Term::Sk->new($format, {
|
||||
freq => 'd',
|
||||
base => 0,
|
||||
target => $target,
|
||||
pdisp => '!',
|
||||
}
|
||||
);
|
||||
return $term;
|
||||
}
|
||||
|
||||
|
||||
sub errstr {
|
||||
return shift->{errstr};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
B<Yandex::Disk> - a simple API for Yandex Disk
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.06
|
||||
|
||||
=head1 SYNOPSYS
|
||||
|
||||
use Yandex::Disk;
|
||||
|
||||
my $TOKEN = 'aaaabbbbccc'; #Auth token. You can get token from module L<Yandex::OAuth>
|
||||
my $disk = Yandex::Disk->new( -token => $TOKEN );
|
||||
|
||||
#Get info about disk and print
|
||||
my $diskinfo = $disk->getDiskInfo();
|
||||
p $diskinfo;
|
||||
|
||||
#Upload file from local disk to Yandex disk
|
||||
$disk->uploadFile(
|
||||
-overwrite => 1,
|
||||
-file => 'my_test_upload_file', # Path to file on local disk
|
||||
-remote_path => "/Upload", # Folder on Yandex Disk
|
||||
) or die "Cant upload file";
|
||||
|
||||
#Download file form Yandex Disk to local disk
|
||||
$disk->downloadFile(
|
||||
-path => "/Upload/my_test_upload_file", # Path to file on Yandex Disk
|
||||
-file => 'my_test_upload_file', # Path to save file on local disk
|
||||
) or die "Cant download file";
|
||||
|
||||
#Create folder on Yandex Disk
|
||||
$disk->createFolder(
|
||||
-path => '/Temp/new_folder', # Path to new folder on Yandex Disk
|
||||
-recursive => 1, # Recursive create folder
|
||||
|
||||
#Share file and get public link
|
||||
my $public = $disk->public();
|
||||
$public->publicFile(
|
||||
-path => "/Upload/my_test_upload_file", # Path to file, which need share
|
||||
) or die "Cant public file";
|
||||
my $publicUrl = $public->publicUrl() or die "Cant get public url";
|
||||
|
||||
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 getDiskInfo()
|
||||
|
||||
Return disk info data as hashref
|
||||
|
||||
my $info = $disk->getDiskInfo();
|
||||
|
||||
$info:
|
||||
Example output:
|
||||
{
|
||||
max_file_size 1073741824,
|
||||
revision 14987326771107,
|
||||
system_folders {
|
||||
applications "disk:/Приложения",
|
||||
downloads "disk:/Загрузки/",
|
||||
facebook "disk:/Социальные сети/Facebook",
|
||||
google "disk:/Социальные сети/Google+",
|
||||
instagram "disk:/Социальные сети/Instagram",
|
||||
mailru "disk:/Социальные сети/Мой Мир",
|
||||
odnoklassniki "disk:/Социальные сети/Одноклассники",
|
||||
photostream "disk:/Фотокамера/",
|
||||
screenshots "disk:/Скриншоты/",
|
||||
social "disk:/Социальные сети/",
|
||||
vkontakte "disk:/Социальные сети/ВКонтакте"
|
||||
},
|
||||
total_space 67645734912,
|
||||
trash_size 0,
|
||||
used_space 19942927435,
|
||||
user {
|
||||
login "login",
|
||||
uid 123456
|
||||
}
|
||||
}
|
||||
|
||||
=head2 uploadFile(%opt)
|
||||
|
||||
Upload file (-file) to Yandex Disk in folder (-remote_path). Return 1 if success
|
||||
|
||||
$disk->uploadFile(-file => '/root/upload', -remote_path => 'Temp', -overwrite => 0);
|
||||
Options:
|
||||
-overwrite => Owervrite file if exists (default: 1)
|
||||
-remote_path => Path to upload file on disk
|
||||
-file => Path to local file
|
||||
-show_progress_bar => Show progress bar upload file
|
||||
|
||||
=head2 createFolder(%opt)
|
||||
|
||||
Create folder on disk
|
||||
|
||||
$disk->createFolder(-path => 'Temp/test', -recursive => 1);
|
||||
Options:
|
||||
-path => Path to folder,
|
||||
-recursive => Recursive create folder (default: 0)
|
||||
|
||||
=head2 deleteResource(%opt)
|
||||
|
||||
Delete file or folder from disk. Return 1 if success
|
||||
|
||||
$disk->deleteResource(-path => 'Temp/test');
|
||||
Options:
|
||||
-path => Path to delete file or folder
|
||||
-permanently => Do not move to trash, delete permanently (default: 0(moving file to trash))
|
||||
-wait => Wait delete resource (defailt: 0)
|
||||
|
||||
=head2 downloadFile(%opt)
|
||||
|
||||
Download file from Yandex Disk to local file. Method overwrites local file if exists. Return 1 if success
|
||||
|
||||
$disk->downloadFile(-path => 'Temp/test', -file => 'test');
|
||||
Options:
|
||||
-path => Path to file on Yandex Disk
|
||||
-file => Path to local destination
|
||||
-show_progress_bar => Show progress bar download file
|
||||
|
||||
=head2 emptyTrash(%opt)
|
||||
|
||||
Empty trash. If -path specified, delete -path resource, otherwise - empty all trash. Return 1 if success
|
||||
|
||||
$disk->emptyTrash(-path => 'Temp/test'); #Delete '/Temp/test' from trash
|
||||
Options:
|
||||
-path => Path to resource on Yandex Disk to delete from trash
|
||||
-wait => Wait empty trash (defailt: 0)
|
||||
|
||||
$disk->emptyTrash; #Full empty trash
|
||||
|
||||
=head2 fileInfo(%opt)
|
||||
|
||||
List properties of selected file. Return hashref(keys: "path", "type", "name", "preview", "created", "modified", "md5", "mime_type", "size")
|
||||
|
||||
$disk->fileInfo(-path => 'Temp/test');
|
||||
Options:
|
||||
-path => Path to file on Yandex Disk for which need get info
|
||||
|
||||
=head2 listFiles(%opt)
|
||||
|
||||
List files in folder. Return arrayref to hashref(keys: "path", "type", "name", "preview", "created", "modified", "md5", "mime_type", "size")
|
||||
|
||||
$disk->listFiles(-path => 'Temp/test');
|
||||
Options:
|
||||
-path => Path to resource (folder) on Yandex Disk for which need get info
|
||||
-limit => Limit max files to output (default: unlimited)
|
||||
-offset => Offset records from start (default: 0)
|
||||
|
||||
=head2 listAllFiles(%opt)
|
||||
|
||||
List all files on YandexDisk. Return arrayref to hashref(keys: "path", "type", "name", "preview", "created", "modified", "md5", "mime_type", "size")
|
||||
|
||||
$disk->listAllFiles();
|
||||
Options:
|
||||
-media_type => Type of file to return. Afaible types listed below. Multiple types can be specified by using a comma. (default: all types)
|
||||
-limit => Limit max files to output (default: unlimited)
|
||||
-offset => Offset records from start (default: 0)
|
||||
|
||||
Media types:
|
||||
audio, backup, book, compressed, data, development, diskimage, document, encoded, executable, flash, font, image, settings, spreadsheet, text, unknown, video, web
|
||||
|
||||
=head2 lastUploadedFiles(%opt)
|
||||
|
||||
List last uploaded files. Return arrayref to hashref(keys: "path", "type", "name", "preview", "created", "modified", "md5", "mime_type", "size")
|
||||
|
||||
$disk->lastUploadedFiles();
|
||||
Options:
|
||||
-media_type => Type of file to return. Afaible types same as listAllFiles. Multiple types can be specified by using a comma. (default: all types)
|
||||
-limit => Limit max files to output (default: unlimited)
|
||||
|
||||
|
||||
|
||||
=head2 Public files
|
||||
|
||||
my $public = $disk->public(); #Create L<Yandex::Disk::Public> object
|
||||
|
||||
=head1 CLI/API
|
||||
Sparrow plugin https://sparrowhub.org/info/yandex-disk
|
||||
|
||||
=head1 DEPENDENCE
|
||||
|
||||
L<LWP::UserAgent>, L<JSON::XS>, L<URI::Escape>, L<IO::Socket::SSL>
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Pavel Andryushin <vrag867@gmail.com>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2017 by Pavel Andryushin.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
164
lib/Yandex/Disk/Public.pm
Normal file
164
lib/Yandex/Disk/Public.pm
Normal file
@@ -0,0 +1,164 @@
|
||||
#
|
||||
#===============================================================================
|
||||
#
|
||||
# FILE: Public.pm
|
||||
#
|
||||
# DESCRIPTION:
|
||||
#
|
||||
# FILES: ---
|
||||
# BUGS: ---
|
||||
# NOTES: ---
|
||||
# AUTHOR: YOUR NAME (),
|
||||
# ORGANIZATION:
|
||||
# VERSION: 1.0
|
||||
# CREATED: 01.10.2017 12:34:59
|
||||
# REVISION: ---
|
||||
#===============================================================================
|
||||
package Yandex::Disk::Public;
|
||||
|
||||
use 5.008001;
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use URI::Escape;
|
||||
use Carp 'croak';
|
||||
|
||||
use base 'Yandex::Disk';
|
||||
|
||||
#Class for Public actions under Yandex Disk files and folders
|
||||
|
||||
our $VERSION = '0.06';
|
||||
|
||||
sub publicFile {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/publish?path=' . uri_escape($path), "PUT");
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Cant public file $path. Error: " . $res->status_line;
|
||||
}
|
||||
my $metainfo_href = $self->__fromJson($res->decoded_content)->{href};
|
||||
my $res_get_metainfo = $self->__getPublicUrl($metainfo_href);
|
||||
return $res_get_metainfo;
|
||||
}
|
||||
|
||||
sub unpublicFile {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
$self->{public_info} = {};
|
||||
my $path = $opt{-path} || croak "Specify -path param";
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/unpublish?path=' . uri_escape($path), "PUT");
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Cant unpublic file $path. Error: " . $res->status_line;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub listPublished {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
my $limit = $opt{-limit};
|
||||
my $offset = $opt{-offset} || 0;
|
||||
my $type = $opt{-type};
|
||||
|
||||
$limit = 999999 if not defined $limit;
|
||||
|
||||
if ($type && ($type ne 'dir' && $type ne 'file')) {
|
||||
croak "Wrong -type value (dir/file)";
|
||||
}
|
||||
|
||||
my $param = "limit=$limit&offset=$offset";
|
||||
$param .= "&type=$type" if $type;
|
||||
|
||||
my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/public?' . $param, "GET");
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Cant get listPublished. Error: " . $res->status_line;
|
||||
}
|
||||
my $items = $self->__fromJson($res->decoded_content)->{items};
|
||||
return $items;
|
||||
}
|
||||
|
||||
sub __getPublicUrl {
|
||||
my ($self, $href) = @_;
|
||||
my $res = $self->__request($href, "GET");
|
||||
my $code = $res->code;
|
||||
if ($code ne '200') {
|
||||
croak "Cant get public url by href: $href. Error: " . $res->status_line;
|
||||
}
|
||||
$self->{public_info} = $self->__fromJson($res->decoded_content);
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub publicUrl {
|
||||
return shift->{public_info}->{public_url};
|
||||
}
|
||||
|
||||
sub publicType {
|
||||
return shift->{public_info}->{type};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
B<Yandex::Disk::Public> - public and unpublic yandex disk resources(files and folders)
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.06
|
||||
|
||||
=head1 SYNOPSIS
|
||||
use Yandex::Disk;
|
||||
|
||||
my $token = "my token";
|
||||
my $disk = Yandex::Disk( -token => $token); #Create Yandex::Disk object
|
||||
my $public = $disk->public; #Create Yandex::Disk::Public object
|
||||
|
||||
#Public file '/Temp/small_file'
|
||||
$public->publicFile (-path => '/Temp/small_file');
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 publicFile(%opt)
|
||||
|
||||
Make file or folder as public
|
||||
$public->publicFile ( -path => '/Temp/small_file' ) or die "Cant public file"; #Make file '/Temp/small_file' as public
|
||||
Options:
|
||||
-path => Path to resource on yandex disk, where need public
|
||||
|
||||
=head2 unpublicFile(%opt)
|
||||
|
||||
Remove public access to resources
|
||||
$public->unpublicFile( -path => '/Temp/small_file' ) or die "Cant unpublic file";
|
||||
Options:
|
||||
-path => Path to resource on yandex disk, where need public
|
||||
|
||||
=head2 listPublished(%opt)
|
||||
|
||||
Return array hashref with published files
|
||||
my $list = $public->listPublished();
|
||||
Options:
|
||||
-limit => Limit max files to output (default: unlimited)
|
||||
-offset => Offset records from start (default: 0)
|
||||
-type => dir/file (default: undef (display dirs and files)
|
||||
|
||||
=head2 publicUrl()
|
||||
|
||||
Get public url from published file. Return undef if error
|
||||
|
||||
=head2 publicType()
|
||||
|
||||
Get type of published resource. Retutn undef if error
|
||||
|
||||
|
||||
=cut
|
||||
162
lib/Yandex/OAuth.pm
Normal file
162
lib/Yandex/OAuth.pm
Normal file
@@ -0,0 +1,162 @@
|
||||
=encoding utf-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Yandex::OAuth - module for get access token to Yandex.API
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Yandex::OAuth;
|
||||
|
||||
my $oauth = Yandex::OAuth->new(
|
||||
client_id => '76df1cf****************fb31d0289',
|
||||
client_secret => 'e3a2855****************4de3c2afc',
|
||||
);
|
||||
|
||||
# return link for open in browser
|
||||
say $oauth->get_code();
|
||||
|
||||
# return JSON with access_token
|
||||
say Dumper $oauth->get_token( code => 3557461 );
|
||||
|
||||
# return JSON with access_token
|
||||
say Dumper $oauth->refresh_token( refresh_token => 3557461 );
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Yandex::OAuth is a module for get access token for Yandex.API
|
||||
See more at https://tech.yandex.ru/oauth/doc/dg/concepts/ya-oauth-intro-docpage/
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
package Yandex::OAuth;
|
||||
use 5.008001;
|
||||
use utf8;
|
||||
use Modern::Perl;
|
||||
use JSON::XS;
|
||||
use URI::Escape;
|
||||
|
||||
use LWP::UserAgent;
|
||||
|
||||
use Moo;
|
||||
|
||||
our $VERSION = "0.07";
|
||||
|
||||
has 'ua' => (
|
||||
is => 'ro',
|
||||
default => sub {
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent( 'Yandex::OAuth Perl API Client' );
|
||||
$ua->timeout( 120 );
|
||||
return $ua;
|
||||
}
|
||||
);
|
||||
|
||||
has 'auth_url' => (
|
||||
is => 'ro',
|
||||
default => 'https://oauth.yandex.ru/authorize',
|
||||
|
||||
);
|
||||
|
||||
has 'token_url' => (
|
||||
is => 'ro',
|
||||
default => 'https://oauth.yandex.ru/token',
|
||||
);
|
||||
|
||||
has 'client_id' => (
|
||||
is => 'rw',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'client_secret' => (
|
||||
is => 'rw',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'demo' => (
|
||||
is => 'rw'
|
||||
);
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item B<get_code()>
|
||||
|
||||
return a link for open in browser
|
||||
|
||||
$oauth->get_code();
|
||||
|
||||
=cut
|
||||
|
||||
sub get_code {
|
||||
my ( $self, %params ) = @_;
|
||||
|
||||
return $self->auth_url . "?response_type=code&client_id=".$self->client_id .
|
||||
( ( defined $params{state} ) ? "&state=" . uri_escape( $params{state} ) : '' );
|
||||
}
|
||||
|
||||
=item B<get_token()>
|
||||
|
||||
return a json with access_token or error if code has expired
|
||||
|
||||
$oauth->get_token( code => XXXXXX );
|
||||
|
||||
=cut
|
||||
|
||||
sub get_token {
|
||||
my ( $self, %params ) = @_;
|
||||
|
||||
return JSON::XS::decode_json( $self->demo ) if $self->demo;
|
||||
|
||||
my $res = $self->ua->post($self->token_url, {
|
||||
code => $params{code},
|
||||
client_id => $self->client_id,
|
||||
client_secret => $self->client_secret,
|
||||
grant_type => 'authorization_code',
|
||||
});
|
||||
|
||||
return JSON::XS::decode_json( $res->content );
|
||||
}
|
||||
|
||||
=item B<refresh_token()>
|
||||
|
||||
return a json with access_token or error if refresh_token has already been used
|
||||
|
||||
$oauth->refresh_token( refresh_token => XXXXXX );
|
||||
|
||||
=cut
|
||||
|
||||
sub refresh_token {
|
||||
my ( $self, %params ) = @_;
|
||||
|
||||
return JSON::XS::decode_json( $self->demo ) if $self->demo;
|
||||
|
||||
my $res = $self->ua->post($self->token_url, {
|
||||
refresh_token => $params{refresh_token},
|
||||
client_id => $self->client_id,
|
||||
client_secret => $self->client_secret,
|
||||
grant_type => 'refresh_token',
|
||||
});
|
||||
|
||||
return JSON::XS::decode_json( $res->content );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright (C) Andrey Kuzmin.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Andrey Kuzmin E<lt>chipsoid@cpan.orgE<gt>
|
||||
|
||||
=cut
|
||||
253
lib/Yandex/OAuth/Client.pm
Normal file
253
lib/Yandex/OAuth/Client.pm
Normal file
@@ -0,0 +1,253 @@
|
||||
=encoding utf-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Yandex::OAuth::Client - base class for any Yandex.API modules
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Yandex::OAuth::Client;
|
||||
|
||||
my $client = Yandex::OAuth::Client->new(token => '************', endpoint => 'https://api-metrika.yandex.ru/');
|
||||
|
||||
my $client->get(['stat','user_vars'], {
|
||||
pretty => 1,
|
||||
# other params specified for resource
|
||||
});
|
||||
# url converting to https://api-metrika.yandex.ru/stat/user_vars/?pretty=1
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Yandex::OAuth::Client is base class for any Yandex.API modules
|
||||
Contains get, post, put, delete methods for queries to any APIs Yandex.
|
||||
|
||||
Looking for contributors for this and other Yandex.APIs
|
||||
|
||||
=cut
|
||||
|
||||
package Yandex::OAuth::Client;
|
||||
use 5.008001;
|
||||
use utf8;
|
||||
use Modern::Perl;
|
||||
use Data::Dumper;
|
||||
|
||||
use LWP::UserAgent;
|
||||
use Storable qw/ dclone /;
|
||||
use JSON::XS;
|
||||
use Moo;
|
||||
|
||||
has 'ua' => (
|
||||
is => 'ro',
|
||||
default => sub {
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent( 'Yandex::OAuth Perl API Client' );
|
||||
$ua->timeout( 120 );
|
||||
return $ua;
|
||||
}
|
||||
);
|
||||
|
||||
has 'token' => (
|
||||
is => 'rw',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'endpoint' => (
|
||||
is => 'rw',
|
||||
required => 1,
|
||||
);
|
||||
|
||||
has 'next_url' => (
|
||||
is => 'rw',
|
||||
default => '',
|
||||
writer => 'set_next_url',
|
||||
);
|
||||
|
||||
has 'demo' => (
|
||||
is => 'rw'
|
||||
);
|
||||
|
||||
=head1 CONSTRUCTOR
|
||||
|
||||
=over
|
||||
|
||||
=item B<new()>
|
||||
|
||||
Require two arguments: token and endpoint. For module based on Yandex::OAuth::Client
|
||||
you can override atribute 'endpoint'
|
||||
|
||||
extends 'Yandex::OAuth::Client';
|
||||
has '+endpoint' => (
|
||||
is => 'ro',
|
||||
default => 'https://api-metrika.yandex.ru/',
|
||||
);
|
||||
|
||||
=back
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over
|
||||
|
||||
=item B<get()>
|
||||
|
||||
Send GET request.
|
||||
|
||||
$client->get(['stat','load']);
|
||||
|
||||
# or full link. for example, when using "next" link from previous response
|
||||
|
||||
$client->get('https://api-metrika.yandex.ru/stat/load/?pretty=1');
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my ($self, $url, $query) = @_;
|
||||
|
||||
return $self->request( 'get', $url, $query );
|
||||
}
|
||||
|
||||
=item B<post()>
|
||||
|
||||
Send POST request.
|
||||
|
||||
$client->post(['counters'], {
|
||||
# query params
|
||||
}, {
|
||||
# body params
|
||||
});
|
||||
|
||||
=cut
|
||||
|
||||
sub post {
|
||||
my ($self, $url, $query, $body) = @_;
|
||||
|
||||
return $self->request( 'post', $url, $query, $body );
|
||||
}
|
||||
|
||||
=item B<put()>
|
||||
|
||||
Send PUT request.
|
||||
|
||||
$client->put(['counter', $counter_id], {
|
||||
# query params
|
||||
}, {
|
||||
# body params
|
||||
});
|
||||
|
||||
=cut
|
||||
|
||||
sub put {
|
||||
my ($self, $url, $query, $body) = @_;
|
||||
|
||||
return $self->request( 'put', $url, $query, $body );
|
||||
}
|
||||
|
||||
=item B<delete()>
|
||||
|
||||
Send DELETE request.
|
||||
|
||||
$client->delete(['counter', $counter_id]);
|
||||
|
||||
=cut
|
||||
|
||||
sub delete {
|
||||
my ($self, $url, $query) = @_;
|
||||
|
||||
return $self->request( 'delete', $url, $query );
|
||||
}
|
||||
|
||||
sub request {
|
||||
my ( $self, $method, $url, $query, $body ) = @_;
|
||||
|
||||
my $req = HTTP::Request->new( uc $method => $self->make_url( $url, $query ) );
|
||||
|
||||
$self->prepare_request( $req, $body );
|
||||
|
||||
my $resp = $self->parse_response( $self->ua->request( $req )->content );
|
||||
|
||||
return $resp;
|
||||
}
|
||||
|
||||
sub make_url {
|
||||
my ( $self, $resource, $params ) = @_;
|
||||
|
||||
my @resources = ref $resource ? @$resource : ( $resource );
|
||||
|
||||
my $url = '';
|
||||
if ( $resource =~ /^http/i ) {
|
||||
$url = $resource;
|
||||
}
|
||||
else {
|
||||
$url = $self->endpoint;
|
||||
$url =~ s/[\\\/]+$//;
|
||||
$url .= '/';
|
||||
$url .= join '/', @resources;
|
||||
}
|
||||
|
||||
if ( $params ) {
|
||||
my $uri = URI->new( $url );
|
||||
$uri->query_form( %$params );
|
||||
$url = $uri->as_string;
|
||||
}
|
||||
|
||||
return $url;
|
||||
}
|
||||
|
||||
sub prepare_request {
|
||||
my ( $self, $request, $body_param ) = @_;
|
||||
|
||||
my $body = '';
|
||||
if ( $body_param ) {
|
||||
my $params = dclone( $body_param );
|
||||
|
||||
state $json = JSON::XS->new->utf8;
|
||||
|
||||
$body = $json->encode( $params );
|
||||
|
||||
$request->content( $body );
|
||||
}
|
||||
$request->header( 'content-type' => 'application/json; charset=UTF-8' );
|
||||
$request->header( 'content-length' => length( $body ) );
|
||||
|
||||
$request->header( 'Authorization' => 'Bearer ' . $self->token );
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub parse_response {
|
||||
my ( $self, $response ) = @_;
|
||||
|
||||
return unless $response;
|
||||
|
||||
my $json = JSON::XS::decode_json( $response );
|
||||
|
||||
my $next = '';
|
||||
|
||||
if ( defined $json->{links} && defined $json->{links}->{next} ) {
|
||||
$next = $json->{links}->{next};
|
||||
$next =~ s/^http:/https:/i;
|
||||
|
||||
$self->set_next_url( $next );
|
||||
}
|
||||
|
||||
return $json;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=back
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright (C) Andrey Kuzmin.
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Andrey Kuzmin E<lt>chipsoid@cpan.orgE<gt>
|
||||
|
||||
=cut
|
||||
|
||||
Reference in New Issue
Block a user