Cmd-Dwarf

 view release on metacpan or  search on metacpan

examples/helloworld/app/lib/App/Controller/ApiBase.pm  view on Meta::CPAN

			SNS_LIMIT_ERROR    => sub { shift->throw(2001, sprintf("SNS Limit Error: reset at %s", $_[0] || "")) },
			SNS_ERROR          => sub { shift->throw(2002, sprintf("SNS Error: %s", $_[0] || "SNS Error.")) },
			ERROR              => sub { shift->throw(9999, sprintf("%s", $_[0] || "Unknown Error.")) },
		},

		'CGI::SpeedyCGI' => {},
		'MouseX::Types::Common' => {},

		'CORS' => {
			origin      => c->base_url,
			credentials => 1,
			headers     => [qw/X-Requested-With Authorization Content-Type/],
			maxage      => 7200,
		},

		'JSON' => {
			pretty          => 1,
			convert_blessed => 1,
		},

		'XML::Simple' => {

examples/helloworld/app/lib/Dwarf/Module/SocialMedia/Twitter.pm  view on Meta::CPAN

	return $is_login;
}

sub show_user {
	my ($self, $id) = @_;
	$id ||= $self->{user_id};

	my $data;
	unless ($self->{user_id}) {
		$data = $self->call(
			'account/verify_credentials',
			'GET'
		);
	} else {
		# accout/verify_credentials を節約するために
		# users/lookup で代替出来るケースでは代替する
		$data = $self->call('users/lookup', 'POST', { user_id => $id });
		if (ref $data eq 'ARRAY') {
			$data = $data->[0];
		}
	}

	return $data;
}

examples/helloworld/app/lib/Dwarf/Plugin/CORS.pm  view on Meta::CPAN

use Dwarf::Util qw/add_method/;

sub init {
	my ($class, $c, $conf) = @_;
	$conf ||= {};
	die "conf must be HASH" unless ref $conf eq 'HASH';

	$conf->{origin}      ||= '*';
	$conf->{methods}     ||= [qw/GET PUT POST DELETE HEAD OPTIONS PATCH/];
	$conf->{headers}     ||= [qw/X-Requested-With/];
	$conf->{credentials} ||= 0;
	$conf->{maxage}      ||= 7200;

	$c->add_trigger(AFTER_DISPATCH => sub {
		my ($self, $res) = @_;
		
		$self->header('Access-Control-Allow-Origin' => $conf->{origin});
		$self->header('Access-Control-Allow-Methods' => join ',', @{ $conf->{methods} });
		$self->header('Access-Control-Allow-Headers' => join ',', @{ $conf->{headers} });

		if ($conf->{credentials}) {
			$self->header('Access-Control-Allow-Credentials' => 'true');
		}

		if ($self->method eq 'OPTIONS' and $conf->{maxage}) {
			# preflight なリクエストには 200 を返してしまう
			$self->response->status(200);
			$self->response->body("");
			$self->header('Access-Control-Max-Age' => $conf->{maxage});
		}
	});

examples/helloworld/app/t/00_dwarf/plugin/cors.t  view on Meta::CPAN

subtest "Preflight Request" => sub {
	my $c = c(
		REQUEST_METHOD => 'OPTIONS',
		CONTENT_TYPE   => 'application/json',
		QUERY_STRING   => '{ "hoge": 1 }',
	);

	$c->load_plugins(
		'CORS' => {
			origin      => 'http://127.0.0.1',
			credentials => 1,
			headers     => [qw/X-Requested-With Content-Type/],
			maxage      => 7200,
		},
	);

	my $res = $c->to_psgi;
	my %headers = @{ $res->[1] };

	is $res->[0], 200;
	is $headers{'Access-Control-Allow-Origin'}, 'http://127.0.0.1';

examples/helloworld/app/t/00_dwarf/plugin/cors.t  view on Meta::CPAN

	is $headers{'Access-Control-Max-Age'}, 7200; 
};

subtest "CORS Request" => sub {
	my $c = c(
	);

	$c->load_plugins(
		'CORS' => {
			origin      => 'http://127.0.0.1',
			credentials => 1,
			headers     => [qw/X-Requested-With Content-Type/],
			maxage      => 7200,
		},
	);

	my $res = $c->to_psgi;
	my %headers = @{ $res->[1] };

	is $res->[0], 200;
	is $headers{'Access-Control-Allow-Origin'}, 'http://127.0.0.1';

examples/test-validate-json-body/app/lib/App/Controller/ApiBase.pm  view on Meta::CPAN

			SNS_LIMIT_ERROR    => sub { shift->throw(2001, sprintf("SNS Limit Error: reset at %s", $_[0] || "")) },
			SNS_ERROR          => sub { shift->throw(2002, sprintf("SNS Error: %s", $_[0] || "SNS Error.")) },
			ERROR              => sub { shift->throw(9999, sprintf("%s", $_[0] || "Unknown Error.")) },
		},

		'CGI::SpeedyCGI' => {},
		'MouseX::Types::Common' => {},

		'CORS' => {
			origin      => c->base_url,
			credentials => 1,
			headers     => [qw/X-Requested-With Authorization Content-Type/],
			maxage      => 7200,
		},

		'JSON' => {
			pretty          => 1,
			convert_blessed => 1,
		},

		'XML::Simple' => {

examples/test-validate-json-body/app/lib/Dwarf/Module/SocialMedia/Twitter.pm  view on Meta::CPAN

	return $is_login;
}

sub show_user {
	my ($self, $id) = @_;
	$id ||= $self->{user_id};

	my $data;
	unless ($self->{user_id}) {
		$data = $self->call(
			'account/verify_credentials',
			'GET'
		);
	} else {
		# accout/verify_credentials を節約するために
		# users/lookup で代替出来るケースでは代替する
		$data = $self->call('users/lookup', 'POST', { user_id => $id });
		if (ref $data eq 'ARRAY') {
			$data = $data->[0];
		}
	}

	return $data;
}

examples/test-validate-json-body/app/lib/Dwarf/Plugin/CORS.pm  view on Meta::CPAN

use Dwarf::Util qw/add_method/;

sub init {
	my ($class, $c, $conf) = @_;
	$conf ||= {};
	die "conf must be HASH" unless ref $conf eq 'HASH';

	$conf->{origin}      ||= '*';
	$conf->{methods}     ||= [qw/GET PUT POST DELETE HEAD OPTIONS PATCH/];
	$conf->{headers}     ||= [qw/X-Requested-With/];
	$conf->{credentials} ||= 0;
	$conf->{maxage}      ||= 7200;

	$c->add_trigger(AFTER_DISPATCH => sub {
		my ($self, $res) = @_;
		
		$self->header('Access-Control-Allow-Origin' => $conf->{origin});
		$self->header('Access-Control-Allow-Methods' => join ',', @{ $conf->{methods} });
		$self->header('Access-Control-Allow-Headers' => join ',', @{ $conf->{headers} });

		if ($conf->{credentials}) {
			$self->header('Access-Control-Allow-Credentials' => 'true');
		}

		if ($self->method eq 'OPTIONS' and $conf->{maxage}) {
			# preflight なリクエストには 200 を返してしまう
			$self->response->status(200);
			$self->response->body("");
			$self->header('Access-Control-Max-Age' => $conf->{maxage});
		}
	});

examples/test-validate-json-body/app/t/00_dwarf/plugin/cors.t  view on Meta::CPAN

subtest "Preflight Request" => sub {
	my $c = c(
		REQUEST_METHOD => 'OPTIONS',
		CONTENT_TYPE   => 'application/json',
		QUERY_STRING   => '{ "hoge": 1 }',
	);

	$c->load_plugins(
		'CORS' => {
			origin      => 'http://127.0.0.1',
			credentials => 1,
			headers     => [qw/X-Requested-With Content-Type/],
			maxage      => 7200,
		},
	);

	my $res = $c->to_psgi;
	my %headers = @{ $res->[1] };

	is $res->[0], 200;
	is $headers{'Access-Control-Allow-Origin'}, 'http://127.0.0.1';

examples/test-validate-json-body/app/t/00_dwarf/plugin/cors.t  view on Meta::CPAN

	is $headers{'Access-Control-Max-Age'}, 7200; 
};

subtest "CORS Request" => sub {
	my $c = c(
	);

	$c->load_plugins(
		'CORS' => {
			origin      => 'http://127.0.0.1',
			credentials => 1,
			headers     => [qw/X-Requested-With Content-Type/],
			maxage      => 7200,
		},
	);

	my $res = $c->to_psgi;
	my %headers = @{ $res->[1] };

	is $res->[0], 200;
	is $headers{'Access-Control-Allow-Origin'}, 'http://127.0.0.1';

share/app/lib/App/Controller/ApiBase.pm  view on Meta::CPAN

			SNS_LIMIT_ERROR    => sub { shift->throw(2001, sprintf("SNS Limit Error: reset at %s", $_[0] || "")) },
			SNS_ERROR          => sub { shift->throw(2002, sprintf("SNS Error: %s", $_[0] || "SNS Error.")) },
			ERROR              => sub { shift->throw(9999, sprintf("%s", $_[0] || "Unknown Error.")) },
		},

		'CGI::SpeedyCGI' => {},
		'MouseX::Types::Common' => {},

		'CORS' => {
			origin      => c->base_url,
			credentials => 1,
			headers     => [qw/X-Requested-With Authorization Content-Type/],
			maxage      => 7200,
		},

		'JSON' => {
			pretty          => 1,
			convert_blessed => 1,
		},

		'XML::Simple' => {

share/app/lib/Dwarf/Module/SocialMedia/Twitter.pm  view on Meta::CPAN

	return $is_login;
}

sub show_user {
	my ($self, $id) = @_;
	$id ||= $self->{user_id};

	my $data;
	unless ($self->{user_id}) {
		$data = $self->call(
			'account/verify_credentials',
			'GET'
		);
	} else {
		# accout/verify_credentials を節約するために
		# users/lookup で代替出来るケースでは代替する
		$data = $self->call('users/lookup', 'POST', { user_id => $id });
		if (ref $data eq 'ARRAY') {
			$data = $data->[0];
		}
	}

	return $data;
}

share/app/lib/Dwarf/Plugin/CORS.pm  view on Meta::CPAN

use Dwarf::Util qw/add_method/;

sub init {
	my ($class, $c, $conf) = @_;
	$conf ||= {};
	die "conf must be HASH" unless ref $conf eq 'HASH';

	$conf->{origin}      ||= '*';
	$conf->{methods}     ||= [qw/GET PUT POST DELETE HEAD OPTIONS PATCH/];
	$conf->{headers}     ||= [qw/X-Requested-With/];
	$conf->{credentials} ||= 0;
	$conf->{maxage}      ||= 7200;

	$c->add_trigger(AFTER_DISPATCH => sub {
		my ($self, $res) = @_;
		
		$self->header('Access-Control-Allow-Origin' => $conf->{origin});
		$self->header('Access-Control-Allow-Methods' => join ',', @{ $conf->{methods} });
		$self->header('Access-Control-Allow-Headers' => join ',', @{ $conf->{headers} });

		if ($conf->{credentials}) {
			$self->header('Access-Control-Allow-Credentials' => 'true');
		}

		if ($self->method eq 'OPTIONS' and $conf->{maxage}) {
			# preflight なリクエストには 200 を返してしまう
			$self->response->status(200);
			$self->response->body("");
			$self->header('Access-Control-Max-Age' => $conf->{maxage});
		}
	});

share/app/t/00_dwarf/plugin/cors.t  view on Meta::CPAN

subtest "Preflight Request" => sub {
	my $c = c(
		REQUEST_METHOD => 'OPTIONS',
		CONTENT_TYPE   => 'application/json',
		QUERY_STRING   => '{ "hoge": 1 }',
	);

	$c->load_plugins(
		'CORS' => {
			origin      => 'http://127.0.0.1',
			credentials => 1,
			headers     => [qw/X-Requested-With Content-Type/],
			maxage      => 7200,
		},
	);

	my $res = $c->to_psgi;
	my %headers = @{ $res->[1] };

	is $res->[0], 200;
	is $headers{'Access-Control-Allow-Origin'}, 'http://127.0.0.1';

share/app/t/00_dwarf/plugin/cors.t  view on Meta::CPAN

	is $headers{'Access-Control-Max-Age'}, 7200; 
};

subtest "CORS Request" => sub {
	my $c = c(
	);

	$c->load_plugins(
		'CORS' => {
			origin      => 'http://127.0.0.1',
			credentials => 1,
			headers     => [qw/X-Requested-With Content-Type/],
			maxage      => 7200,
		},
	);

	my $res = $c->to_psgi;
	my %headers = @{ $res->[1] };

	is $res->[0], 200;
	is $headers{'Access-Control-Allow-Origin'}, 'http://127.0.0.1';



( run in 0.595 second using v1.01-cache-2.11-cpan-4d50c553e7e )