Skip to content

Commit

Permalink
Make uri optional, add helper methods request_{tcp,unix,pipe}, add tests
Browse files Browse the repository at this point in the history
  • Loading branch information
sharyanto committed Apr 2, 2013
1 parent ef8c05b commit 6527946
Show file tree
Hide file tree
Showing 3 changed files with 198 additions and 16 deletions.
2 changes: 1 addition & 1 deletion dist.ini
Expand Up @@ -12,7 +12,7 @@ repository=http://github.com/sharyanto/perl-Perinci-Access-Simple-Client
[@SHARYANTO]

[Prereqs / TestRequires]
;Test::More=0.96
Test::More=0.98

[Prereqs]
;!lint-prereqs assume-used # spec
Expand Down
113 changes: 98 additions & 15 deletions lib/Perinci/Access/Simple/Client.pm
Expand Up @@ -52,9 +52,19 @@ sub DESTROY {
}

sub request {
my $self = shift;
$self->_parse_or_request('request', @_);
}

sub _parse {
my $self = shift;
$self->_parse_or_request('parse', @_);
}

sub _parse_or_request {
require JSON;

my ($self, $action, $server_url, $extra) = @_;
my ($self, $which, $action, $server_url, $extra) = @_;
$log->tracef("=> %s\::request(action=%s, server_url=%s, extra=%s)",
__PACKAGE__, $action, $server_url, $extra);
return [400, "Please specify server_url"] unless $server_url;
Expand All @@ -74,41 +84,62 @@ sub request {
unless $scheme =~ /\Ariap\+(tcp|unix|pipe)\z/;
my $opaque = $server_url->opaque;
if ($scheme eq 'riap+tcp') {
if ($opaque =~ m!^//([^:/]+):(\d+)(/.*)!) {
if ($opaque =~ m!^//([^:/]+):(\d+)(/.*)?!) {
($host, $port, $uri) = ($1, $2, $3);
$cache_key = "tcp:".lc($host).":$port";
} else {
return [400, "Invalid URL, please supply host : port / entity uri".
", e.g.: riap+tcp://localhost:5000/Foo/Bar/func"];
return [400, "Invalid riap+tcp URL, please use this format: ".
"riap+tcp://host:1234 or riap+tcp://host:1234/uri"];
}
} elsif ($scheme eq 'riap+unix') {
if ($opaque =~ m!(.+?)/(/.*)!) {
if ($opaque =~ m!(.+)/(/.*)!) {
($path, $uri) = (uri_unescape($1), $2);
} elsif ($opaque =~ m!(.+)!) {
$path = uri_unescape($1);
}
if (defined($path)) {
my $apath = abs_path($path) or
return [500, "Can't find absolute path for $path"];
$cache_key = "unix:$apath";
} else {
return [400, "Invalid URL, please supply path // entity uri".
", e.g.: riap+unix:/path/to/unix/socket//Foo/Bar/func"];
return [400, "Invalid riap+unix URL, please use this format: ".
", e.g.: riap+unix:/path/to/unix/socket or ".
"riap+unix:/path/to/unix/socket//uri"];
}
} elsif ($scheme eq 'riap+pipe') {
if ($opaque =~ m!(.+?)//(.*?)/(/.*)!) {
($path, $args, $uri) = (uri_unescape($1), $2, $3);
} elsif ($opaque =~ m!(.+?)//(.*)!) {
($path, $args) = (uri_unescape($1), $2);
} elsif ($opaque =~ m!(.+)!) {
$path = uri_unescape($1);
$args = '';
}
if (defined($path)) {
my $apath = abs_path($path) or
return [500, "Can't find absolute path for $path"];
$args = [map {uri_unescape($_)} split m!/!, $args];
$cache_key = "pipe:$apath ".join(" ", @$args);
} else {
return [
400,
"Invalid URL, please supply path // args // entity uri, e.g: ".
"riap+pipe:/path/to/prog//arg1/arg2//Foo/Bar/func"];
return [400, "Invalid riap+pipe URL, please use this format: ".
"riap+pipe:/path/to/prog or ".
"riap+pipe:/path/to/prog//arg1/arg2 or ".
"riap+pipe:/path/to/prog//arg1/arg2//uri"];
}
}
$uri //= $req->{uri};
return [400, "Please specify request key 'uri'"] unless $uri;
$log->tracef("Parsed URI, scheme=%s, host=%s, port=%s, path=%s, args=%s, ".
"ceuri=%s", $scheme, $host, $port, $path, $args, $uri);
$req->{uri} = $uri;

if ($which eq 'parse') {
return [200, "OK", {
args=>$args, host=>$host, path=>$path, port=>$port,
scheme=>$scheme, uri=>$uri,
}];
}

state $json = JSON->new->allow_nonref;

my $attempts = 0;
Expand Down Expand Up @@ -246,6 +277,23 @@ sub request {
return [500, "$e (retried)"];
}

sub request_tcp {
my ($self, $action, $hostport, $extra) = @_;
$self->request($action, "riap+tcp://$hostport->[0]:$hostport->[1]", $extra);
}

sub request_unix {
my ($self, $action, $sockpath, $extra) = @_;
$self->request($action => "riap+unix:" . uri_escape($sockpath), $extra);
}

sub request_pipe {
my ($self, $action, $cmd, $extra) = @_;
$self->request($action => "riap+pipe:" . uri_escape($cmd->[0]) . "//" .
join("/", map {uri_escape($_)} @$cmd[1..@$cmd-1]),
$extra);
}

1;
# ABSTRACT: Riap::Simple client

Expand Down Expand Up @@ -283,6 +331,16 @@ sub request {
$uri,
{args => {a1=>1, a2=>2}});
# helper for riap+tcp
$res = $pa->request_tcp(call => [$host, $port], \%extra);
# helper for riap+unix
$res = $pa->request_unix(call => $sockpath, \%extra);
# helper for riap+pipe
my @cmd = ('/path/to/program', 'first arg', '2nd');
$res = $pa->request_pipe(call => \@cmd, \%extra);
=head1 DESCRIPTION
Expand Down Expand Up @@ -316,16 +374,41 @@ Number of seconds to wait between retries.
=head2 $pa->request($action => $server_url, \%extra) => $res
Send Riap request to $server_url.
Send Riap request to C<$server_url>.
=head2 $pa->request_tcp($action => [$host, $port], \%extra) => $res
Helper/wrapper for request(), it forms C<$server_url> using:
"riap+tcp://$host:$port"
You need to specify Riap request key 'uri' in C<%extra>.
=head2 $pa->request_unix($action => $sockpath, \%extra) => $res
Helper/wrapper for request(), it forms C<$server_url> using:
"riap+unix:" . uri_escape($sockpath)
You need to specify Riap request key 'uri' in C<%extra>.
=head2 $pa->request_pipe($action => \@cmd, \%extra) => $res
Helper/wrapper for request(), it forms C<$server_url> using:
"riap+pipe:" . uri_escape($cmd[0]) . "//" .
join("/", map {uri_escape($_)} @cmd[1..@cmd-1])
You need to specify Riap request key 'uri' in C<%extra>.
=head1 FAQ
=head2 When I use riap+pipe, is the program executed for each Riap request?
No, this module does some caching per $server_url, so if you call the same
$server_url 10 times, the same program will be used and it will receive 10 Riap
requests using the L<Riap::Simple> protocol.
No, this module does some caching, so if you call the same program (with the
same arguments) 10 times, the same program will be used and it will receive 10
Riap requests using the L<Riap::Simple> protocol.
=head1 SEE ALSO
Expand Down
99 changes: 99 additions & 0 deletions t/01-basics.t
@@ -0,0 +1,99 @@
#!perl -T

use 5.010;
use strict;
use warnings;

use Perinci::Access::Simple::Client;
use Test::More 0.98;

my $pa = Perinci::Access::Simple::Client->new;

test_parse(
name => 'unknown scheme = 400',
args => [call => "riap+foo://localhost:1234/"],
status => 400,
);
test_parse(
name => 'invalid riap+tcp 1',
args => [call => "riap+tcp:xxx"],
status => 400,
);
test_parse(
name => 'riap+tcp requires port',
args => [call => "riap+tcp://localhost/"],
status => 400,
);
test_parse(
name => 'riap+tcp requires uri',
args => [call => "riap+tcp://localhost:1234"],
status => 400,
);
test_parse(
name => 'riap+tcp ok 1',
args => [call => "riap+tcp://localhost:1234/Foo/Bar"],
result => {args=>undef, host=>'localhost', path=>undef, port=>1234, scheme=>'riap+tcp', uri=>'/Foo/Bar'},
);
test_parse(
name => 'riap+tcp ok 2 (uri via extra)',
args => [call => "riap+tcp://localhost:1234", {uri=>'/Foo/Bar'}],
result => {args=>undef, host=>'localhost', path=>undef, port=>1234, scheme=>'riap+tcp', uri=>'/Foo/Bar'},
);

test_parse(
name => 'invalid riap+unix 1',
args => [call => "riap+unix:"],
status => 400,
);
test_parse(
name => 'riap+unix ok 1',
args => [call => "riap+unix:relpath//Foo/Bar"],
result => {args=>undef, host=>undef, path=>'relpath', port=>undef, scheme=>'riap+unix', uri=>'/Foo/Bar'},
);
test_parse(
name => 'riap+unix ok 2 (uri via extra, path is unescaped)',
args => [call => "riap+unix:/tmp/abs%20path", {uri=>'/Foo/Bar'}],
result => {args=>undef, host=>undef, path=>'/tmp/abs path', port=>undef, scheme=>'riap+unix', uri=>'/Foo/Bar'},
);

test_parse(
name => 'invalid riap+pipe 1',
args => [call => "riap+pipe:"],
status => 400,
);
test_parse(
name => 'riap+pipe ok 1',
args => [call => "riap+pipe:/tmp/program%201//arg1/arg%202//Foo/Bar"],
result => {args=>['arg1', 'arg 2'], host=>undef, path=>'/tmp/program 1', port=>undef, scheme=>'riap+pipe', uri=>'/Foo/Bar'},
);
test_parse(
name => 'riap+pipe ok 2 (uri via extra)',
args => [call => "riap+pipe:/tmp/program%201//arg1/arg%202", {uri=>'/Foo/Bar'}],
result => {args=>['arg1', 'arg 2'], host=>undef, path=>'/tmp/program 1', port=>undef, scheme=>'riap+pipe', uri=>'/Foo/Bar'},
);
test_parse(
name => 'riap+pipe ok 2 (uri via extra, no args)',
args => [call => "riap+pipe:/tmp/program%201", {uri=>'/Foo/Bar'}],
result => {args=>[], host=>undef, path=>'/tmp/program 1', port=>undef, scheme=>'riap+pipe', uri=>'/Foo/Bar'},
);

DONE_TESTING:
done_testing();

sub test_parse {
my %args = @_;

my $name = $args{name} // "parse $args{args}[1]";
subtest $name => sub {
my $res = $pa->_parse(@{ $args{args} });

my $status = $args{status} // 200;
is($res->[0], $status, "status") or diag explain $res;

if ($args{result}) {
is_deeply($res->[2], $args{result}, "result") or
diag explain $res->[2];
}
};
}

0 comments on commit 6527946

Please sign in to comment.