[Catalyst-dev] Catalyst::Plugin::Server::XMLRPC fault code patch

[Alex Pavlovic]

Hi,

Here is a test script "040_faultcode.t" which you can add to t, 
and patch for t/lib/TestApp/Controller/RPC/Functions.pm, which
adds an extra "echo_fault" method to be used with the test script.

Just ran everything and it works ok.

Cheers.

On Sunday 16 July 2006 09:53, Matt S Trout wrote:
> Alex Pavlovic wrote:
> > Hi,
> >
> > Here is xmlrpc server patch which allows you to set fault code and fault
> > message. It adds extra error sub to Request class. The code was tested.
> > The patch also fixes a minor error in docs.
> >
> > For example:
> >
> > sub authenticate : XMLRPC {
> > 	#...
> > 	if ( $failed ) {
> > 		$c->req->xmlrpc->error( 100, 'Failed to authenticate!' );
> > 	}
> > }
> >
> > Error codes are a big one for me, so I thought this would be useful.
>
> I like the syntax but your patch doesn't seem to have tests to go with it -
> any chance you could fix that? :)
-------------- next part --------------
#!perl

use strict;
use warnings;

BEGIN {
    use FindBin;
    use lib "$FindBin::Bin/lib";
    
    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use RPC::XML;
use HTTP::Request;
use Data::Dumper;

my %RpcArgs     = ( 1 => "b" );
my %RpcRv       = ( auto => 1, begin => 1, end => 1 );
my $EntryPoint  = 'http://localhost/rpc';
my $Prefix      = 'rpc.functions.';
my %Methods     = (
    'echo_fault'        => [ 101, 'echo_fault' ]
);

# init -- mention var twice due to warnings;
$RPC::XML::ENCODING = $RPC::XML::ENCODING = 'UTF-8';

while ( my($meth,$rv) = each %Methods ) {

    my $str = RPC::XML::request->new( 
                    $Prefix . $meth, 
                    input => \%RpcArgs 
                )->as_string;

    my $req = HTTP::Request->new( POST => $EntryPoint );
    $req->header( 'Content-Length'  => length($str) );
    $req->header( 'Content-Type'    => 'text/xml' );
    $req->content( $str );
    my $res = request( $req );

    ok( $res,                   "Got response on '$meth'" );
    ok( $res->is_success,       "   Response successfull 2XX" );
    is( $res->code, 200,        "   Reponse code 200" );

    my $data = RPC::XML::Parser->new->parse( $res->content )->value->value;
    my ($rv_code,$rv_msg) = @$rv; 
    is_deeply( $data->{faultCode}, $rv_code,     "   Return value of faultCode as expected" );
    is_deeply( $data->{faultString}, $rv_msg,     "   Return value of faultString as expected" );

    if( ref $data and UNIVERSAL::isa( $data, 'HASH' ) ) {
        ok( (exists($data->{faultString})),
                                "   Faultstring present" );
        ok( (exists($data->{faultCode})),
                                "   Faultcode present" );

        diag( $data->{faultCode} . ' ' . $data->{faultString} )
            if $data->{faultString};
    }
}

-------------- next part --------------
A non-text attachment was scrubbed...
Name: Functions.pm.patch
Type: text/x-diff
Size: 867 bytes
Desc: not available
Url : http://lists.rawmode.org/pipermail/catalyst-dev/attachments/20060716/ba2d6084/attachment.bin