Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added PSGI dispatcher that maps paths to modules and loads them at ru…

…ntime
  • Loading branch information...
commit 70a1c90d2d7c39fc351d0231c344cca6558fd7d4 1 parent 40e64a2
@claesjac authored
View
3  Changes
@@ -1,5 +1,8 @@
Revision history for Perl extension JSON::RPC::Simple.
+0.05 ...
+ - Added a sample PSGI handler which loads service based on URI and dispatches them
+
0.04 Wed Dec 7 2011
- Support for calls via HTTP GET
- t/03-client.t now doesn't fail because of faulty URL
View
2  MANIFEST
@@ -1,5 +1,7 @@
bin/jsonrpc-simple
Changes
+eg/MyService.pm
+eg/json-rpc-simple.psgi
lib/JSON/RPC/Simple.pm
lib/JSON/RPC/Simple/Client.pm
lib/JSON/RPC/Simple/Dispatcher.pm
View
13 eg/MyService.pm
@@ -0,0 +1,13 @@
+package MyService;
+
+use strict;
+use warnings;
+
+use base qw(JSON::RPC::Simple);
+
+sub echo : JSONRpcMethod(text) {
+ my ($self, $request, $args) = @_;
+ return reverse $args->{text};
+}
+
+1;
View
38 eg/json-rpc-simple.psgi
@@ -0,0 +1,38 @@
+# json-rpc-simple.psgi
+
+use strict;
+use warnings;
+
+use Class::Load qw(try_load_class);
+use JSON::RPC::Simple;
+use Plack::Request;
+
+# start with empty dispatcher as we'll populate this as we go
+my $dispatcher = JSON::RPC::Simple->dispatch_to({});
+
+my $app = sub {
+ my $env = shift;
+ my $request = Plack::Request->new($env);
+
+ my $path = $request->path_info;
+ $path =~ s{::}{/}g;
+
+ unless ($dispatcher->target($path)) {
+ my $pkg = substr($path, 1);
+ $pkg =~ s{/}{::}g;
+
+ unless (my @ok = try_load_class($pkg)) {
+ my $response = $request->new_response(500, {}, "Can't load ${pkg} because of $ok[1]");
+ return $response->finalize;
+ }
+
+ my $target = $pkg->can("new") ? $pkg->new() : $pkg;
+ $dispatcher->dispatch_to({ $path => $target });
+ }
+
+ my $r = $dispatcher->handle($path, $request);
+
+ my $response = $request->new_response($r->code, $r->headers, $r->content);
+ return $response->finalize;
+};
+
View
5 lib/JSON/RPC/Simple/Dispatcher.pm
@@ -286,6 +286,11 @@ sub handle {
return $response;
}
+sub target {
+ my ($self, $target) = @_;
+ return $self->{target}->{$target};
+}
+
1;
=head1 NAME
Please sign in to comment.
Something went wrong with that request. Please try again.