view release on metacpan or  search on metacpan

lib/JSON/RPC/Simple/Dispatcher.pm  view on Meta::CPAN

    my $h = HTTP::Headers->new();
    $h->header("Content-Type" => "application/json; charset=" . $self->charset);
    $h->header("Content-Length" => length $content);
    
    return HTTP::Response->new($code, $message, $h, $content);
}

sub errstr { 
    return shift->{errstr} || ""; 
}

sub errobj {
    return shift->{errobj};
}

sub handle {
    my ($self, $path, $request) = @_;
    
    $HTTP_ERROR_CODE = 500;
    
    # Clear any previous errors
    delete $self->{errstr};
    
    # Don't support GET or other methods
    unless ($request->method eq "POST") {
        $self->{errstr} = "I only do POST";
        return $self->_error($request, undef, 0, $self->errstr);
    }
    
    unless ($request->content_type =~ m{^application/json}) {
        $self->{errstr} = 
            "Invalid Content-Type, got '" . $request->content_type . "'";
        return $self->_error($request, undef, 0, $self->errstr);
    }

    # Some requests, like HTTP::Request lazy load content_length so we can't ->can("") it which is why the eval
    my $content_length = eval { $request->content_length };
    if ($@) {
        # Apache2::RequestReq
        $content_length = $request->headers_in->{'Content-Length'} if $request->can("headers_in");
        
        # Fallback
        $content_length = $request->headers->{'Content-Length'} if !defined $content_length && $request->can("headers");
    };
    
    unless (defined $content_length) {
        $self->{errstr} = 
            "JSON-RPC 1.1 requires header Content-Length to be specified";
        return $self->_error($request, undef, 0, $self->errstr);
    }
    
    # Find target
    my $target = $self->{target}->{$path};
    
    # Decode the call and trap errors because it might
    # be invalid JSON
    my $call;
    eval {
        my $content = $request->content;

        # Remove utf-8 BOM if present
        $content =~ s/^(?:\xef\xbb\xbf|\xfe\xff|\xff\xfe)//;
        
        $call = $self->json->decode($content);
    };
    if ($@) {
        $self->{errstr} = "$@";
        $self->{errobj} = $@;
        return $self->_error(
            $request, undef, 0, $self->errstr, undef, undef, $target
        );
    }
    
    my $id = $call->{id};
    my $version = $call->{version};
    unless (defined $version) {
        $self->{errstr} = "Missing 'version'";
        return $self->_error(
            $request, $id, 0, $self->errstr, undef, $call, $target
        );
    }
    unless ($version eq "1.1") {
        $self->{errstr} = "I only do JSON-RPC 1.1";
        return $self->_error(
            $request, $id, 0, $self->errstr, undef, $call, $target
        );
    }
    
    my $method = $call->{method};
    unless ($method) {
        $self->{errstr} = "Missing method";
        $self->_error($request, $id, 0, $self->errstr, undef, $call, $target);
    }
    
    
    my $params = $call->{params};
    unless ($params) {
        $self->_error($id, 0, $self->errstr, undef, $call, $target);
    }

    unless (ref $params eq "HASH" || ref $params eq "ARRAY") {
        $self->{errstr} = "Invalid params, expecting object or array";
        return $self->_error(
            $request, $id, 0, $self->errstr, undef, $call, $target
        );
    }    

    unless ($target) {
        $self->{errstr} = "No target for '${path}' exists";
        return $self->_error(
            $request, $id, 0, $self->errstr, undef, $call, $target
        );
    }
    
    my $cv = $target->can($method);
    my $check_attrs;
    if ($cv) {
        # Check that it's a JSONRpcMethod
        my @attrs = JSON::RPC::Simple->fetch_method_arguments($cv);
        unless (@attrs) {
            $self->{errstr} = "Procedure not found";

lib/JSON/RPC/Simple/Dispatcher.pm  view on Meta::CPAN

=back

=head2 INSTANCE METHODS

=over 4

=item json

=item json ( $json )
 
Gets/sets the json object to use for encoding/decoding

=item charset

=item charset ( $charset )

Gets/sets the charset to use when creating the HTTP::Response object.

=item error_handler ( \&handler )

Gets/sets the error handler to call when an error occurs.

=item dispatch_to ( \%targets )

Sets the dispatch table. The dispatch-table is a path to instance mapping where 
the key is a path and the value the instance of class for which to call the 
method on. For example

  $o->dispatch_to({
    "/API" => "MyApp::API",
    "/Other/API" => MyApp::OtherAPI->new(),
  });

=item handle ( $path, $request )

This method decodes the $request which should be a HTTP::Request look-a-like 
object and finds the appropriate target in the dispatch table for $path.

The $request object MUST provide the following methods:

=over 4

=item method

The HTTP method of the request such as GET, POST, HEAD, PUT in captial letters.

=item content_type

The Content-Type header from the request.

=item content_length

The Content-Length header from the request.

=item content

The content of the request as we only handle POST.

=back

The content is stripped from any unicode BOM before being passed to the JSON 
decoder. 

=back

=cut