Cmd-Dwarf
30 results

 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[]');



( run in 0.369 second using v1.01-cache-2.11-cpan-eab888a1d7d )