view release on metacpan or search on metacpan
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Amazon.pm view on Meta::CPAN
#
# my $res = $self->ua->post($uri);
my $res = $self->ua->post($self->urls->{access_token}, \%params);
if ($res->code !~ /^2/) {
$self->on_error->('Amazon OAuth Error: Could not get access token.');
return;
}
my $decoded = decode_json $res->{_content};
my $access_token = $decoded->{access_token};
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
my $uri = URI->new($self->urls->{api} . '/' . $command);
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Amazon.pm view on Meta::CPAN
sub call {
my ($self, $command, $method, $params) = @_;
$self->authorized;
my $req = $self->_make_request($command, $method, $params);
my $res = $self->ua->request($req);
return $self->validate($res);
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
# [todo]
# check error status codes
return $content;
}
1;
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Facebook.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->get($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Facebook OAuth Error: Could not get access token.');
return;
}
my $access_token = $res->decoded_content;
$access_token =~ s/^access_token=//;
$access_token =~ s/&expires=[0-9]+$//;
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Facebook.pm view on Meta::CPAN
my @contents;
for my $res (@responses) {
push @contents, $self->validate($res);
}
return @contents;
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
if ($res->code !~ /^2/) {
if ($content) {
if (ref $content) {
my $error_code = $content->{error}->{code} // '';
# 506 = äºéæç¨¿
if ($error_code eq '506') {
warn 'Facebook API Error: ', $content->{error}->{message};
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Line.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Line OAuth Error: Could not get access token.');
return;
}
my $decoded = decode_json $res->{_content};
my $access_token = $decoded->{access_token};
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
my $uri = URI->new($self->urls->{api} . '/' . $command);
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Line.pm view on Meta::CPAN
sub call {
my ($self, $command, $method, $params) = @_;
$self->authorized;
my $req = $self->_make_request($command, $method, $params);
my $res = $self->ua->request($req);
return $self->validate($res);
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
# [todo]
# check error status codes
return $content;
}
1;
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
die 'access token must be specified.' unless defined $self->access_token;
my $params = {};
$params->{access_token} = $self->access_token;
my $uri = URI->new($self->urls->{api});
$uri->query_form(%$params);
my $res = $self->ua->post($uri);
my $content = eval { safe_decode_json(encode_utf8 $res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
return $content;
}
sub request_access_token {
my ($self, %params) = @_;
die 'key must be specified.' unless defined $self->key;
die 'secret must be specified.' unless defined $self->secret;
examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Rakuten OAuth Error: Could not get access token.');
return;
}
my $content = eval { decode_json $res->decoded_content };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
$self->_validate_id_token($content->{id_token});
my $access_token = $content->{access_token};
$self->access_token($access_token);
}
sub _validate_id_token {
examples/helloworld/app/lib/Dwarf/Plugin/JSON.pm view on Meta::CPAN
add_method($c, json => sub {
my $self = shift;
if (@_ == 1) {
$self->{'dwarf.json'} = $_[0];
}
return $self->{'dwarf.json'};
});
add_method($c, decode_json => sub {
my ($self, $data) = @_;
my $decoded = eval { $self->{'dwarf.json'}->decode($data) };
if ($@) {
$@ = undef;
return $data;
}
return $decoded;
});
add_method($c, encode_json => sub {
my ($self, $data) = @_;
my $encoded = eval { $self->{'dwarf.json'}->encode($data) };
if ($@) {
$@ = undef;
return $data;
}
examples/helloworld/app/lib/Dwarf/Plugin/MouseX/Types/Common.pm view on Meta::CPAN
return 0;
}
return 1;
}
sub _base64_type {
my ($value, $expected) = @_;
my $filetype = '';
my $decoded = decode_base64($value);
my $type = image_type(\$decoded);
if (my $error = $type->{error}) {
return 0;
}
$filetype = lc $type->{file_type};
return $filetype =~ /^$expected$/i;
};
sub _delsp {
examples/helloworld/app/lib/Dwarf/Request.pm view on Meta::CPAN
sub _build_encoding { 'utf-8' }
sub new {
my ($class, $env) = @_;
my $self = $class->SUPER::new($env);
return $self;
}
# -------------------------------------------------------------------------
# This object returns decoded parameter values by default
sub body_parameters {
my ($self) = @_;
$self->{'dwarf.body_parameters'} ||= $self->_decode_parameters($self->SUPER::body_parameters());
}
sub query_parameters {
my ($self) = @_;
$self->{'dwarf.query_parameters'} ||= $self->_decode_parameters($self->SUPER::query_parameters());
}
sub _decode_parameters {
my ($self, $stuff) = @_;
$stuff = $self->_decode_array_parameters($stuff);
my $encoding = $self->encoding;
my @flatten = $stuff->flatten();
my @decoded;
while ( my ($k, $v) = splice @flatten, 0, 2 ) {
push @decoded, Encode::decode($encoding, $k), Encode::decode($encoding, $v);
}
return Hash::MultiValue->new(@decoded);
}
sub _decode_array_parameters {
my ($self, $stuff) = @_;
my @flatten = $stuff->flatten();
my @decoded;
while ( my ($k, $v) = splice @flatten, 0, 2 ) {
if ($k =~ /^(.+)\[\d+\]$/) {
my $name = $1;
$k = "${name}[]";
}
push @decoded, $k, $v;
}
return Hash::MultiValue->new(@decoded);
}
sub param {
my $self = shift;
return keys %{ $self->parameters } if @_ == 0;
my $key = shift;
#return $self->parameters->get_all($key) if wantarray; # list ã³ã³ããã¹ãã§é
åãè¿ãæ©è½ãåé¤
return [$self->parameters->get_all($key)] if $key =~ /^.+\[\]$/;
return $self->parameters->{$key};
examples/helloworld/app/lib/Dwarf/Validator/Constraint/Default.pm view on Meta::CPAN
package Dwarf::Validator::Constraint::Default;
use Dwarf::Validator::Constraint;
use Dwarf::Validator::NullValue;
use Email::Valid;
use Email::Valid::Loose;
use Dwarf::Util qw/encode_utf8 decode_utf8/;
use Image::Info qw/image_type/;
use JSON;
use MIME::Base64 qw(decode_base64 decoded_base64_length);
use Scalar::Util qw/looks_like_number/;
rule NOT_NULL => sub {
return 0 if not defined($_);
return 0 if ref $_ eq 'ARRAY' && @$_ == 0;
return 1;
};
alias NOT_NULL => 'REQUIRED';
examples/helloworld/app/lib/Dwarf/Validator/Constraint/Default.pm view on Meta::CPAN
rule CREDITCARD_NUMBER => sub { $_ =~ /\A[0-9]{14,16}\z/ };
rule CREDITCARD_EXPIRE => sub { $_ =~ /^\d{2}\/\d{2}$/ };
rule CREDITCARD_SECURITY => sub { $_ =~ /\A[0-9]{3,4}\z/ };
rule BASE64_TYPE => sub {
Carp::croak('missing args. usage: ["BASE64_TYPE", "(jpeg|png|gif)"]') unless @_;
my $expected = $_[0];
my $filetype = '';
my $decoded = decode_base64($_);
my $type = image_type(\$decoded);
if (my $error = $type->{error}) {
return 0;
}
$filetype = lc $type->{file_type};
return $filetype =~ /^$expected$/i;
};
rule BASE64_SIZE => sub {
Carp::croak('missing args. usage: ["BASE64_SIZE", "10000"]') unless @_;
my $expected = $_[0];
my $length = decoded_base64_length($_);
return $length < $expected;
};
file_rule FILE_NOT_NULL => sub {
return 0 if not defined($_);
return 0 if $_ eq "";
return 0 if ref($_) eq 'ARRAY' && @$_ == 0;
return 1;
};
examples/helloworld/app/t/00_dwarf/03_pragma.t view on Meta::CPAN
use Test::More 0.88;
subtest "boolean" => sub {
ok true;
ok !false;
ok (1 == 1);
ok !(1 == 0);
my $json = JSON->new->convert_blessed;
my $encoded = $json->encode({ false => false, true => true });
my $decoded = $json->decode($encoded);
#is $encoded, '{"false":false,"true":true}';
};
done_testing();
examples/helloworld/app/t/00_dwarf/05_request.t view on Meta::CPAN
$c->request_handler_prefix('');
return $c;
}
subtest "Decode parameters" => sub {
my $c = c(
);
my $hoge = $c->param('hoge');
ok Encode::is_utf8($hoge), 'parameters are decoded';
};
subtest "ARRAY parameters" => sub {
my $c = c(
);
my $name = $c->param('name[]');
is ref $name, 'ARRAY', 'name[] param is ARRAY REF';
is @$name, 2, 'name[] param have 2 values in scalar context';
my @name_arr = $c->param('name[]');
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Amazon.pm view on Meta::CPAN
#
# my $res = $self->ua->post($uri);
my $res = $self->ua->post($self->urls->{access_token}, \%params);
if ($res->code !~ /^2/) {
$self->on_error->('Amazon OAuth Error: Could not get access token.');
return;
}
my $decoded = decode_json $res->{_content};
my $access_token = $decoded->{access_token};
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
my $uri = URI->new($self->urls->{api} . '/' . $command);
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Amazon.pm view on Meta::CPAN
sub call {
my ($self, $command, $method, $params) = @_;
$self->authorized;
my $req = $self->_make_request($command, $method, $params);
my $res = $self->ua->request($req);
return $self->validate($res);
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
# [todo]
# check error status codes
return $content;
}
1;
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Facebook.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->get($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Facebook OAuth Error: Could not get access token.');
return;
}
my $access_token = $res->decoded_content;
$access_token =~ s/^access_token=//;
$access_token =~ s/&expires=[0-9]+$//;
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Facebook.pm view on Meta::CPAN
my @contents;
for my $res (@responses) {
push @contents, $self->validate($res);
}
return @contents;
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
if ($res->code !~ /^2/) {
if ($content) {
if (ref $content) {
my $error_code = $content->{error}->{code} // '';
# 506 = äºéæç¨¿
if ($error_code eq '506') {
warn 'Facebook API Error: ', $content->{error}->{message};
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Line.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Line OAuth Error: Could not get access token.');
return;
}
my $decoded = decode_json $res->{_content};
my $access_token = $decoded->{access_token};
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
my $uri = URI->new($self->urls->{api} . '/' . $command);
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Line.pm view on Meta::CPAN
sub call {
my ($self, $command, $method, $params) = @_;
$self->authorized;
my $req = $self->_make_request($command, $method, $params);
my $res = $self->ua->request($req);
return $self->validate($res);
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
# [todo]
# check error status codes
return $content;
}
1;
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
die 'access token must be specified.' unless defined $self->access_token;
my $params = {};
$params->{access_token} = $self->access_token;
my $uri = URI->new($self->urls->{api});
$uri->query_form(%$params);
my $res = $self->ua->post($uri);
my $content = eval { safe_decode_json(encode_utf8 $res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
return $content;
}
sub request_access_token {
my ($self, %params) = @_;
die 'key must be specified.' unless defined $self->key;
die 'secret must be specified.' unless defined $self->secret;
examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Rakuten OAuth Error: Could not get access token.');
return;
}
my $content = eval { decode_json $res->decoded_content };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
$self->_validate_id_token($content->{id_token});
my $access_token = $content->{access_token};
$self->access_token($access_token);
}
sub _validate_id_token {
examples/test-validate-json-body/app/lib/Dwarf/Plugin/JSON.pm view on Meta::CPAN
add_method($c, json => sub {
my $self = shift;
if (@_ == 1) {
$self->{'dwarf.json'} = $_[0];
}
return $self->{'dwarf.json'};
});
add_method($c, decode_json => sub {
my ($self, $data) = @_;
my $decoded = eval { $self->{'dwarf.json'}->decode($data) };
if ($@) {
$@ = undef;
return $data;
}
return $decoded;
});
add_method($c, encode_json => sub {
my ($self, $data) = @_;
my $encoded = eval { $self->{'dwarf.json'}->encode($data) };
if ($@) {
$@ = undef;
return $data;
}
examples/test-validate-json-body/app/lib/Dwarf/Plugin/MouseX/Types/Common.pm view on Meta::CPAN
return 0;
}
return 1;
}
sub _base64_type {
my ($value, $expected) = @_;
my $filetype = '';
my $decoded = decode_base64($value);
my $type = image_type(\$decoded);
if (my $error = $type->{error}) {
return 0;
}
$filetype = lc $type->{file_type};
return $filetype =~ /^$expected$/i;
};
sub _delsp {
examples/test-validate-json-body/app/lib/Dwarf/Request.pm view on Meta::CPAN
sub _build_encoding { 'utf-8' }
sub new {
my ($class, $env) = @_;
my $self = $class->SUPER::new($env);
return $self;
}
# -------------------------------------------------------------------------
# This object returns decoded parameter values by default
sub body_parameters {
my ($self) = @_;
$self->{'dwarf.body_parameters'} ||= $self->_decode_parameters($self->SUPER::body_parameters());
}
sub query_parameters {
my ($self) = @_;
$self->{'dwarf.query_parameters'} ||= $self->_decode_parameters($self->SUPER::query_parameters());
}
sub _decode_parameters {
my ($self, $stuff) = @_;
$stuff = $self->_decode_array_parameters($stuff);
my $encoding = $self->encoding;
my @flatten = $stuff->flatten();
my @decoded;
while ( my ($k, $v) = splice @flatten, 0, 2 ) {
push @decoded, Encode::decode($encoding, $k), Encode::decode($encoding, $v);
}
return Hash::MultiValue->new(@decoded);
}
sub _decode_array_parameters {
my ($self, $stuff) = @_;
my @flatten = $stuff->flatten();
my @decoded;
while ( my ($k, $v) = splice @flatten, 0, 2 ) {
if ($k =~ /^(.+)\[\d+\]$/) {
my $name = $1;
$k = "${name}[]";
}
push @decoded, $k, $v;
}
return Hash::MultiValue->new(@decoded);
}
sub param {
my $self = shift;
return keys %{ $self->parameters } if @_ == 0;
my $key = shift;
#return $self->parameters->get_all($key) if wantarray; # list ã³ã³ããã¹ãã§é
åãè¿ãæ©è½ãåé¤
return [$self->parameters->get_all($key)] if $key =~ /^.+\[\]$/;
return $self->parameters->{$key};
examples/test-validate-json-body/app/lib/Dwarf/Validator/Constraint/Default.pm view on Meta::CPAN
package Dwarf::Validator::Constraint::Default;
use Dwarf::Validator::Constraint;
use Dwarf::Validator::NullValue;
use Email::Valid;
use Email::Valid::Loose;
use Dwarf::Util qw/encode_utf8 decode_utf8/;
use Image::Info qw/image_type/;
use JSON;
use MIME::Base64 qw(decode_base64 decoded_base64_length);
use Scalar::Util qw/looks_like_number/;
rule NOT_NULL => sub {
return 0 if not defined($_);
return 0 if ref $_ eq 'ARRAY' && @$_ == 0;
return 1;
};
alias NOT_NULL => 'REQUIRED';
examples/test-validate-json-body/app/lib/Dwarf/Validator/Constraint/Default.pm view on Meta::CPAN
rule CREDITCARD_NUMBER => sub { $_ =~ /\A[0-9]{14,16}\z/ };
rule CREDITCARD_EXPIRE => sub { $_ =~ /^\d{2}\/\d{2}$/ };
rule CREDITCARD_SECURITY => sub { $_ =~ /\A[0-9]{3,4}\z/ };
rule BASE64_TYPE => sub {
Carp::croak('missing args. usage: ["BASE64_TYPE", "(jpeg|png|gif)"]') unless @_;
my $expected = $_[0];
my $filetype = '';
my $decoded = decode_base64($_);
my $type = image_type(\$decoded);
if (my $error = $type->{error}) {
return 0;
}
$filetype = lc $type->{file_type};
return $filetype =~ /^$expected$/i;
};
rule BASE64_SIZE => sub {
Carp::croak('missing args. usage: ["BASE64_SIZE", "10000"]') unless @_;
my $expected = $_[0];
my $length = decoded_base64_length($_);
return $length < $expected;
};
file_rule FILE_NOT_NULL => sub {
return 0 if not defined($_);
return 0 if $_ eq "";
return 0 if ref($_) eq 'ARRAY' && @$_ == 0;
return 1;
};
examples/test-validate-json-body/app/t/00_dwarf/03_pragma.t view on Meta::CPAN
use Test::More 0.88;
subtest "boolean" => sub {
ok true;
ok !false;
ok (1 == 1);
ok !(1 == 0);
my $json = JSON->new->convert_blessed;
my $encoded = $json->encode({ false => false, true => true });
my $decoded = $json->decode($encoded);
#is $encoded, '{"false":false,"true":true}';
};
done_testing();
examples/test-validate-json-body/app/t/00_dwarf/05_request.t view on Meta::CPAN
$c->request_handler_prefix('');
return $c;
}
subtest "Decode parameters" => sub {
my $c = c(
);
my $hoge = $c->param('hoge');
ok Encode::is_utf8($hoge), 'parameters are decoded';
};
subtest "ARRAY parameters" => sub {
my $c = c(
);
my $name = $c->param('name[]');
is ref $name, 'ARRAY', 'name[] param is ARRAY REF';
is @$name, 2, 'name[] param have 2 values in scalar context';
my @name_arr = $c->param('name[]');
share/app/lib/Dwarf/Module/SocialMedia/Amazon.pm view on Meta::CPAN
#
# my $res = $self->ua->post($uri);
my $res = $self->ua->post($self->urls->{access_token}, \%params);
if ($res->code !~ /^2/) {
$self->on_error->('Amazon OAuth Error: Could not get access token.');
return;
}
my $decoded = decode_json $res->{_content};
my $access_token = $decoded->{access_token};
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
my $uri = URI->new($self->urls->{api} . '/' . $command);
share/app/lib/Dwarf/Module/SocialMedia/Amazon.pm view on Meta::CPAN
sub call {
my ($self, $command, $method, $params) = @_;
$self->authorized;
my $req = $self->_make_request($command, $method, $params);
my $res = $self->ua->request($req);
return $self->validate($res);
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
# [todo]
# check error status codes
return $content;
}
1;
share/app/lib/Dwarf/Module/SocialMedia/Facebook.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->get($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Facebook OAuth Error: Could not get access token.');
return;
}
my $access_token = $res->decoded_content;
$access_token =~ s/^access_token=//;
$access_token =~ s/&expires=[0-9]+$//;
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
share/app/lib/Dwarf/Module/SocialMedia/Facebook.pm view on Meta::CPAN
my @contents;
for my $res (@responses) {
push @contents, $self->validate($res);
}
return @contents;
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
if ($res->code !~ /^2/) {
if ($content) {
if (ref $content) {
my $error_code = $content->{error}->{code} // '';
# 506 = äºéæç¨¿
if ($error_code eq '506') {
warn 'Facebook API Error: ', $content->{error}->{message};
share/app/lib/Dwarf/Module/SocialMedia/Line.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Line OAuth Error: Could not get access token.');
return;
}
my $decoded = decode_json $res->{_content};
my $access_token = $decoded->{access_token};
$self->access_token($access_token);
}
sub _make_request {
my ($self, $command, $method, $params) = @_;
$method = uc $method;
my $uri = URI->new($self->urls->{api} . '/' . $command);
share/app/lib/Dwarf/Module/SocialMedia/Line.pm view on Meta::CPAN
sub call {
my ($self, $command, $method, $params) = @_;
$self->authorized;
my $req = $self->_make_request($command, $method, $params);
my $res = $self->ua->request($req);
return $self->validate($res);
}
sub validate {
my ($self, $res) = @_;
my $content = eval { decode_json($res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
# [todo]
# check error status codes
return $content;
}
1;
share/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
die 'access token must be specified.' unless defined $self->access_token;
my $params = {};
$params->{access_token} = $self->access_token;
my $uri = URI->new($self->urls->{api});
$uri->query_form(%$params);
my $res = $self->ua->post($uri);
my $content = eval { safe_decode_json(encode_utf8 $res->decoded_content) };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
return $content;
}
sub request_access_token {
my ($self, %params) = @_;
die 'key must be specified.' unless defined $self->key;
die 'secret must be specified.' unless defined $self->secret;
share/app/lib/Dwarf/Module/SocialMedia/Rakuten.pm view on Meta::CPAN
my $uri = URI->new($self->urls->{access_token});
$uri->query_form(%params);
my $res = $self->ua->post($uri);
if ($res->code !~ /^2/) {
$self->on_error->('Rakuten OAuth Error: Could not get access token.');
return;
}
my $content = eval { decode_json $res->decoded_content };
if ($@) {
warn "Couldn't decode JSON: $@";
$content = $res->decoded_content;
}
$self->_validate_id_token($content->{id_token});
my $access_token = $content->{access_token};
$self->access_token($access_token);
}
sub _validate_id_token {
share/app/lib/Dwarf/Plugin/JSON.pm view on Meta::CPAN
add_method($c, json => sub {
my $self = shift;
if (@_ == 1) {
$self->{'dwarf.json'} = $_[0];
}
return $self->{'dwarf.json'};
});
add_method($c, decode_json => sub {
my ($self, $data) = @_;
my $decoded = eval { $self->{'dwarf.json'}->decode($data) };
if ($@) {
$@ = undef;
return $data;
}
return $decoded;
});
add_method($c, encode_json => sub {
my ($self, $data) = @_;
my $encoded = eval { $self->{'dwarf.json'}->encode($data) };
if ($@) {
$@ = undef;
return $data;
}
share/app/lib/Dwarf/Plugin/MouseX/Types/Common.pm view on Meta::CPAN
return 0;
}
return 1;
}
sub _base64_type {
my ($value, $expected) = @_;
my $filetype = '';
my $decoded = decode_base64($value);
my $type = image_type(\$decoded);
if (my $error = $type->{error}) {
return 0;
}
$filetype = lc $type->{file_type};
return $filetype =~ /^$expected$/i;
};
sub _delsp {
share/app/lib/Dwarf/Request.pm view on Meta::CPAN
sub _build_encoding { 'utf-8' }
sub new {
my ($class, $env) = @_;
my $self = $class->SUPER::new($env);
return $self;
}
# -------------------------------------------------------------------------
# This object returns decoded parameter values by default
sub body_parameters {
my ($self) = @_;
$self->{'dwarf.body_parameters'} ||= $self->_decode_parameters($self->SUPER::body_parameters());
}
sub query_parameters {
my ($self) = @_;
$self->{'dwarf.query_parameters'} ||= $self->_decode_parameters($self->SUPER::query_parameters());
}
sub _decode_parameters {
my ($self, $stuff) = @_;
$stuff = $self->_decode_array_parameters($stuff);
my $encoding = $self->encoding;
my @flatten = $stuff->flatten();
my @decoded;
while ( my ($k, $v) = splice @flatten, 0, 2 ) {
push @decoded, Encode::decode($encoding, $k), Encode::decode($encoding, $v);
}
return Hash::MultiValue->new(@decoded);
}
sub _decode_array_parameters {
my ($self, $stuff) = @_;
my @flatten = $stuff->flatten();
my @decoded;
while ( my ($k, $v) = splice @flatten, 0, 2 ) {
if ($k =~ /^(.+)\[\d+\]$/) {
my $name = $1;
$k = "${name}[]";
}
push @decoded, $k, $v;
}
return Hash::MultiValue->new(@decoded);
}
sub param {
my $self = shift;
return keys %{ $self->parameters } if @_ == 0;
my $key = shift;
#return $self->parameters->get_all($key) if wantarray; # list ã³ã³ããã¹ãã§é
åãè¿ãæ©è½ãåé¤
return [$self->parameters->get_all($key)] if $key =~ /^.+\[\]$/;
return $self->parameters->{$key};
share/app/lib/Dwarf/Validator/Constraint/Default.pm view on Meta::CPAN
package Dwarf::Validator::Constraint::Default;
use Dwarf::Validator::Constraint;
use Dwarf::Validator::NullValue;
use Email::Valid;
use Email::Valid::Loose;
use Dwarf::Util qw/encode_utf8 decode_utf8/;
use Image::Info qw/image_type/;
use JSON;
use MIME::Base64 qw(decode_base64 decoded_base64_length);
use Scalar::Util qw/looks_like_number/;
use UNIVERSAL::require;
rule NOT_NULL => sub {
return 0 if not defined($_);
return 0 if ref $_ eq 'ARRAY' && @$_ == 0;
return 1;
};
alias NOT_NULL => 'REQUIRED';
share/app/lib/Dwarf/Validator/Constraint/Default.pm view on Meta::CPAN
rule CREDITCARD_NUMBER => sub { $_ =~ /\A[0-9]{14,16}\z/ };
rule CREDITCARD_EXPIRE => sub { $_ =~ /^\d{2}\/\d{2}$/ };
rule CREDITCARD_SECURITY => sub { $_ =~ /\A[0-9]{3,4}\z/ };
rule BASE64_TYPE => sub {
Carp::croak('missing args. usage: ["BASE64_TYPE", "(jpeg|png|gif)"]') unless @_;
my $expected = $_[0];
my $filetype = '';
my $decoded = decode_base64($_);
my $type = image_type(\$decoded);
if (my $error = $type->{error}) {
return 0;
}
$filetype = lc $type->{file_type};
return $filetype =~ /^$expected$/i;
};
rule BASE64_SIZE => sub {
Carp::croak('missing args. usage: ["BASE64_SIZE", "10000"]') unless @_;
my $expected = $_[0];
my $length = decoded_base64_length($_);
return $length < $expected;
};
file_rule FILE_NOT_NULL => sub {
return 0 if not defined($_);
return 0 if $_ eq "";
return 0 if ref($_) eq 'ARRAY' && @$_ == 0;
return 1;
};
share/app/t/00_dwarf/03_pragma.t view on Meta::CPAN
use Test::More 0.88;
subtest "boolean" => sub {
ok true;
ok !false;
ok (1 == 1);
ok !(1 == 0);
my $json = JSON->new->convert_blessed;
my $encoded = $json->encode({ false => false, true => true });
my $decoded = $json->decode($encoded);
#is $encoded, '{"false":false,"true":true}';
};
done_testing();
share/app/t/00_dwarf/05_request.t view on Meta::CPAN
$c->request_handler_prefix('');
return $c;
}
subtest "Decode parameters" => sub {
my $c = c(
);
my $hoge = $c->param('hoge');
ok Encode::is_utf8($hoge), 'parameters are decoded';
};
subtest "ARRAY parameters" => sub {
my $c = c(
);
my $name = $c->param('name[]');
is ref $name, 'ARRAY', 'name[] param is ARRAY REF';
is @$name, 2, 'name[] param have 2 values in scalar context';
my @name_arr = $c->param('name[]');