r62895 - in /branches/upstream/libcatalyst-plugin-server-perl/current: ./ lib/Catalyst/Plugin/ lib/Catalyst/Plugin/Server/ lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/ t/ t/lib/TestApp/Controller/RPC/

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Sat Sep 25 13:28:37 UTC 2010


Author: gregoa
Date: Sat Sep 25 13:27:49 2010
New Revision: 62895

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62895
Log:
[svn-upgrade] new version libcatalyst-plugin-server-perl (0.28)

Added:
    branches/upstream/libcatalyst-plugin-server-perl/current/t/lib/TestApp/Controller/RPC/Regex.pm
Modified:
    branches/upstream/libcatalyst-plugin-server-perl/current/Changes
    branches/upstream/libcatalyst-plugin-server-perl/current/MANIFEST
    branches/upstream/libcatalyst-plugin-server-perl/current/META.yml
    branches/upstream/libcatalyst-plugin-server-perl/current/Makefile.PL
    branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server.pm
    branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC.pm
    branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm
    branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm
    branches/upstream/libcatalyst-plugin-server-perl/current/t/002_live.t
    branches/upstream/libcatalyst-plugin-server-perl/current/t/020_Dispatch_live.t
    branches/upstream/libcatalyst-plugin-server-perl/current/t/030_Error_live.t
    branches/upstream/libcatalyst-plugin-server-perl/current/t/040_faultcode.t

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/Changes?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/Changes (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/Changes Sat Sep 25 13:27:49 2010
@@ -1,4 +1,16 @@
 Revision history for Perl extension Catalyst::Plugin::XMLRPC
+
+0.28  Thu Jul 08 20:30:00 CEST 2010 
+===================================
+* Upgrade the plugin for Catalyt 5.8 series
+* Changes for adopting MRO::compat where not complete. Calls to next::method
+  instead of NEXT::...()
+* Change name of paths and compiled base class properties in Cat 5.8
+* Clone the result before serializing, as RPC::XML won't clone already seen
+  refs (thanks t0m)
+* Fix the test suite (some tests were lost from 0.24->0.26)
+* Don't warn about the breakage of XML::RPC, as the author has already
+  fixed the backcompat breakage
 
 0.26  Fri Sep 25 13:50:41 CEST 2009
 ===================================

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/MANIFEST?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/MANIFEST (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/MANIFEST Sat Sep 25 13:27:49 2010
@@ -26,4 +26,5 @@
 t/lib/TestApp/Controller/RPC/Attributes.pm
 t/lib/TestApp/Controller/RPC/Errors.pm
 t/lib/TestApp/Controller/RPC/Functions.pm
+t/lib/TestApp/Controller/RPC/Regex.pm
 t/lib/TestApp/Controller/RPC/Settings.pm

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/META.yml?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/META.yml (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/META.yml Sat Sep 25 13:27:49 2010
@@ -1,16 +1,25 @@
 --- #YAML:1.0
-name:                Catalyst-Plugin-Server
-version:             0.26
-abstract:            ~
-license:             ~
-author:              ~
-generated_by:        ExtUtils::MakeMaker version 6.42
-distribution_type:   module
-requires:     
-    Catalyst:                      5.66
-    MRO::Compat:                   0
-    RPC::XML:                      1.35
-    RPC::XML::Parser:              1.12
+name:               Catalyst-Plugin-Server
+version:            0.28
+abstract:           ~
+author:  []
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    Catalyst:          5.66
+    Clone::Fast:       0
+    MRO::Compat:       0
+    RPC::XML:          1.35
+    RPC::XML::Parser:  1.12
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.55_02
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
-    version: 1.3
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/Makefile.PL?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/Makefile.PL (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/Makefile.PL Sat Sep 25 13:27:49 2010
@@ -1,24 +1,4 @@
 use ExtUtils::MakeMaker;
-
-print qq[
-
-**** IMPORTANT *****
-
-RPC::XML 0.69 has introduced a backwards incompatible change!!!
-
-This module will currently only work with RPC::XML 0.67 or before.
-
-I repeat, you ***MUST**** install RPC::XML 0.67 or before for this
-module to work.
-
-See this bug report for details:
-
-  https://rt.cpan.org/Ticket/Display.html?id=50013
-  
-********************  
-    \n];
-    
-sleep 3;    
 
 WriteMakefile(
     'NAME'         => 'Catalyst::Plugin::Server',
@@ -28,5 +8,6 @@
                         'RPC::XML'          => '1.35',
                         'RPC::XML::Parser'  => '1.12',
                         'MRO::Compat'       => 0,
+			'Clone::Fast'       => 0,
                     }
 );

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server.pm?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server.pm (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server.pm Sat Sep 25 13:27:49 2010
@@ -6,7 +6,7 @@
     use base qw/Class::Data::Inheritable/;
     use MRO::Compat;
 
-    our $VERSION = '0.26';
+    our $VERSION = '0.28';
 
     my $ReqClass = 'Catalyst::Plugin::Server::Request';
 
@@ -14,7 +14,7 @@
 
     sub setup_dispatcher {
         my $class = shift;
-        $class->NEXT::setup_dispatcher(@_);
+        $class->next::method(@_);
 
         ### Load Server class
         $class->server(Catalyst::Plugin::Server::Backend->new($class));
@@ -28,11 +28,11 @@
 
         ### since we have a custom request class now, we have to
         ### be sure no one changed it from underneath us!
-        unless( UNIVERSAL::isa( $c->req, $ReqClass ) ) {
+        unless( $c->req->isa($ReqClass) ) {
             $c->log->warn(  "Request class no longer inherits from " .
                             "$ReqClass -- this may break things!" );
         }
-        $c->NEXT::prepare_action( @_ );
+        $c->next::method( @_ );
     }
 }
 
@@ -46,7 +46,7 @@
     sub new {
         my $class = shift;
         my $c = shift;
-        my $self = $class->SUPER::new( @_ );
+        my $self = $class->next::method( @_ );
     }
 
     sub register_server {
@@ -109,9 +109,13 @@
 
 =head1 AUTHORS
 
-Jos Boumans (kane at cpan.org)
+Original Authors: Jos Boumans (kane at cpan.org) and Michiel Ootjers (michiel at cpan.org)
 
-Michiel Ootjers (michiel at cpan.org)
+Actually maintained by Jose Luis Martinez Torres JLMARTIN (jlmartinez at capside.com)
+
+=head1 THANKS
+
+Tomas Doran (BOBTFISH) for helping out with the debugging
 
 =head1 BUG REPORTS
 

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC.pm?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC.pm (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC.pm Sat Sep 25 13:27:49 2010
@@ -268,7 +268,7 @@
         $class->server->register_server(
                     'xmlrpc' => $ServerClass->new($class)
                 );
-        $class->NEXT::setup_engine(@_);
+        $class->next::method(@_);
     }
 
     ### Will load our customized DispatchTypes into Catalyst
@@ -276,7 +276,7 @@
         my $class = shift;
 
         ### Load custom DispatchTypes
-        $class->NEXT::setup_dispatcher( @_ );
+        $class->next::method( @_ );
         $class->dispatcher->preload_dispatch_types(
             @{$class->dispatcher->preload_dispatch_types},
             qw/ +Catalyst::Plugin::Server::XMLRPC::DispatchType::XMLRPCPath
@@ -324,19 +324,16 @@
 
                     $c->dispatcher->dispatch_types(
                         [ grep {
-                            UNIVERSAL::isa(
-                                    $_, $dp_ns . 'XMLRPCPath'
-                                ) or
-                            UNIVERSAL::isa(
-                                    $_, $dp_ns . 'XMLRPCRegex'
-                                )
+                                $_->isa($dp_ns . 'XMLRPCPath')
+                                or
+                                $_->isa($dp_ns . 'XMLRPCRegex')
                             } @$saved_dt
                         ]
                     );
 
                     ### run the rest of the prepare actions, we should have
                     ### an action object now
-                    $c->NEXT::prepare_action( @_ );
+                    $c->next::method( @_ );
 
                     ### restore the saved dispatchtypes
                     $c->dispatcher->dispatch_types( $saved_dt );
@@ -367,7 +364,7 @@
 
         ### we're no xmlrpc request, so just let others handle it
         } else {
-            $c->NEXT::prepare_action( @_ );
+            $c->next::method( @_ );
         }
     }
 
@@ -386,7 +383,7 @@
         ) {
                 $c->req->xmlrpc->run_method($c);
         } else {
-            $c->NEXT::dispatch( @_ );
+            $c->next::method( @_ );
         }
     }
 
@@ -444,7 +441,7 @@
 
         ### always call finalize at the end, so Catalyst's final handler
         ### gets called as well
-        $c->NEXT::finalize( @_ );
+        $c->next::method( @_ );
     }
 }
 
@@ -453,6 +450,7 @@
 
     use base qw/Class::Accessor::Fast/;
     use Data::Dumper;
+    use Scalar::Util 'reftype';
 
     __PACKAGE__->mk_accessors( qw/
                                     dispatcher
@@ -465,7 +463,7 @@
     sub new {
         my $class = shift;
         my $c = shift;
-        my $self = $class->SUPER::new( @_ );
+        my $self = $class->next::method( @_ );
 
         $self->c($c);
         $self->config( Catalyst::Plugin::Server::XMLRPC::Config->new( $c ) );
@@ -488,7 +486,7 @@
     sub add_private_method {
         my ($self, $name, $sub) = @_;
 
-        return unless ($name && UNIVERSAL::isa($sub,'CODE'));
+        return unless ($name && (reftype($sub) eq 'CODE'));
         $self->private_methods->{$name} = $sub;
         return 1;
     }
@@ -525,7 +523,7 @@
 
         my $class = shift;
         my $c     = shift;
-        my $self  = $class->SUPER::new;
+        my $self  = $class->next::method;
 
         $self->prefix(   $c->config->{xmlrpc}->{prefix}    || $DefaultPrefix);
         $self->separator($c->config->{xmlrpc}->{separator} || $DefaultSep);
@@ -550,6 +548,8 @@
 
     use RPC::XML;
     use RPC::XML::Parser;
+    use Scalar::Util 'reftype';
+    use Clone::Fast qw/clone/;
 
     use Data::Dumper;
     use Text::SimpleTable;
@@ -614,11 +614,10 @@
             ### then we can assume it's key => value pairs in there
             ### and we will map them to $c->req->params
             $self->params(
-                @args == 1 && UNIVERSAL::isa($args[0], 'HASH')
+                (@args == 1 && (reftype($args[0]) eq 'HASH'))
                     ? $args[0]
                     : {}
             );
-
             ### build the relevant namespace, action and path 
             {   ### construct the forward path -- this allows catalyst to
                 ### do the hard work of dispatching for us
@@ -634,7 +633,7 @@
                                 ) if $c->debug;
                 }
 
-                unless( UNIVERSAL::isa( $sep, 'Regexp' ) ) {
+                unless( ref($sep) eq 'Regexp' ) {
                     $c->log->debug( __PACKAGE__ . ": Your separator is not a ".
                                     "Regexp object -- This is not recommended"
                                 ) if $c->debug;
@@ -690,9 +689,10 @@
 
         local $RPC::XML::ENCODING = $c->server->xmlrpc->config->xml_encoding
                 if $c->server->xmlrpc->config->xml_encoding;
-
-        my $res = RPC::XML::response->new($status);
-
+        
+        local $Clone::Fast::BREAK_REFS = 1;
+
+        my $res = RPC::XML::response->new(clone($status));
         $c->res->content_type('text/xml');
 
         return $self->result_as_string( $res->as_string );
@@ -864,9 +864,13 @@
 
 =head1 AUTHORS
 
-Jos Boumans (kane at cpan.org)
-
-Michiel Ootjers (michiel at cpan.org)
+Original Authors: Jos Boumans (kane at cpan.org) and Michiel Ootjers (michiel at cpan.org)
+
+Actually maintained by Jose Luis Martinez Torres JLMARTIN (jlmartinez at capside.com)
+
+=head1 THANKS
+
+Tomas Doran (BOBTFISH) for helping out with the debugging
 
 =head1 BUG REPORTS
 

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm Sat Sep 25 13:27:49 2010
@@ -4,9 +4,9 @@
 use base qw/Catalyst::DispatchType::Path/;
 use Text::SimpleTable;
 use Data::Dumper;
+use Scalar::Util 'reftype';
 
 __PACKAGE__->mk_accessors(qw/config/);
-__PACKAGE__->mk_ro_accessors(qw/paths/);
 
 =head1 NAME
 
@@ -71,9 +71,9 @@
     $self->config( $c->server->xmlrpc->config)
             unless $self->config;
 
-    for my $path ( sort keys %{ $self->{paths} } ) {
-        my $action = UNIVERSAL::isa($self->{paths}->{$path}, 'ARRAY') ?
-                $self->{paths}->{$path}->[0] : $self->{paths}->{$path};
+    for my $path ( sort keys %{ $self->{_paths} } ) {
+        my $action = (reftype($self->{_paths}->{$path}) eq 'ARRAY') ?
+                $self->{_paths}->{$path}->[0] : $self->{_paths}->{$path};
         $path = "/$path" unless $path eq '/';
         my ($method) = $path =~ m|^/?(.*)$|;
         my $separator= $self->config->separator;
@@ -136,7 +136,7 @@
     ### a default action
     return unless $c->req->path eq $name;
 
-    $self->SUPER::match( @_ );
+    $self->next::method( @_ );
 }
 
 

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm Sat Sep 25 13:27:49 2010
@@ -25,12 +25,12 @@
 sub list {
     my ( $self, $c ) = @_;
     my $re = Text::SimpleTable->new( [ 36, 'XMLRPCRegex' ], [ 37, 'Private' ] );
-    for my $regex ( @{ $self->{compiled} } ) {
+    for my $regex ( @{ $self->{_compiled} } ) {
         my $action = $regex->{action};
         $re->row( $regex->{path}, "/$action" );
     }
     $c->log->debug( "Loaded XMLRPCRegex actions:\n" . $re->draw )
-      if ( @{ $self->{compiled} } );
+      if ( @{ $self->{_compiled} } );
 }
 
 =head2 $self->register( $c, $action )

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/t/002_live.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/t/002_live.t?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/t/002_live.t (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/t/002_live.t Sat Sep 25 13:27:49 2010
@@ -19,7 +19,7 @@
 use RPC::XML;
 use HTTP::Request;
 use Data::Dumper;
-
+use Scalar::Util 'reftype';
 
 my %RpcArgs     = ( 1 => "b" );
 #my %RpcRv       = ( auto => 1, begin => 1, end => 1, input => \%RpcArgs );
@@ -63,7 +63,7 @@
     my $data = RPC::XML::Parser->new->parse( $res->content )->value->value;
     is_deeply( $data, $rv,     "   Return value as expected" );
 
-    if( ref $data and UNIVERSAL::isa( $data, 'HASH' ) ) {
+    if( ref $data and ( reftype($data) eq 'HASH' ) ) {
         ok( not(exists($data->{faultString})),
                                 "   No faultstring" );
         ok( not(exists($data->{faultCode})),

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/t/020_Dispatch_live.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/t/020_Dispatch_live.t?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/t/020_Dispatch_live.t (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/t/020_Dispatch_live.t Sat Sep 25 13:27:49 2010
@@ -5,7 +5,7 @@
 
 BEGIN {
     use FindBin;
-    use lib "$FindBin::Bin/dispatch/lib";
+    use lib "$FindBin::Bin/lib";
     
     chdir 't' if -d 't';
     use lib qw[../lib inc];
@@ -19,6 +19,7 @@
 use RPC::XML;
 use HTTP::Request;
 use Data::Dumper;
+use Scalar::Util 'reftype';
 
 my $EntryPoint  = 'http://localhost/rpc';
 my @Methods     = qw[a 1];
@@ -34,7 +35,7 @@
     $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" );
@@ -42,7 +43,7 @@
     my $data = RPC::XML::Parser->new->parse( $res->content )->value->value;
     is_deeply( $data, $meth,    "   Return value as expected" );
 
-    if( ref $data and UNIVERSAL::isa( $data, 'HASH' ) ) {
+    if( ref $data and ( reftype( $data ) eq 'HASH' ) ) {
         ok( not(exists($data->{faultString})),
                                 "   No faultstring" );
         ok( not(exists($data->{faultCode})),

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/t/030_Error_live.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/t/030_Error_live.t?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/t/030_Error_live.t (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/t/030_Error_live.t Sat Sep 25 13:27:49 2010
@@ -19,6 +19,8 @@
 use RPC::XML;
 use HTTP::Request;
 use Data::Dumper;
+
+use Scalar::Util 'reftype';
 
 ### Change config to show errors
 TestApp->server->xmlrpc->config->show_errors(1);
@@ -81,7 +83,7 @@
     my $res = shoot((keys %Methods)[0], 'bLegH');
     my $data = RPC::XML::Parser->new->parse( $res->content )->value->value;
 
-    if (UNIVERSAL::isa($data, 'HASH') && $data->{faultString}) {
+    if ((reftype($data) eq 'HASH') && $data->{faultString}) {
         like($data->{faultString}, qr/Invalid XMLRPC request.*syntax error/s,'Got faultString "syntax error"');
     }
 }

Modified: branches/upstream/libcatalyst-plugin-server-perl/current/t/040_faultcode.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/t/040_faultcode.t?rev=62895&op=diff
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/t/040_faultcode.t (original)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/t/040_faultcode.t Sat Sep 25 13:27:49 2010
@@ -19,6 +19,7 @@
 use RPC::XML;
 use HTTP::Request;
 use Data::Dumper;
+use Scalar::Util 'reftype';
 
 my %RpcArgs     = ( 1 => "b" );
 my %RpcRv       = ( auto => 1, begin => 1, end => 1 );
@@ -53,7 +54,7 @@
     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' ) ) {
+    if( ref $data and ( reftype($data) eq 'HASH' ) ) {
         ok( (exists($data->{faultString})),
                                 "   Faultstring present" );
         ok( (exists($data->{faultCode})),

Added: branches/upstream/libcatalyst-plugin-server-perl/current/t/lib/TestApp/Controller/RPC/Regex.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-plugin-server-perl/current/t/lib/TestApp/Controller/RPC/Regex.pm?rev=62895&op=file
==============================================================================
--- branches/upstream/libcatalyst-plugin-server-perl/current/t/lib/TestApp/Controller/RPC/Regex.pm (added)
+++ branches/upstream/libcatalyst-plugin-server-perl/current/t/lib/TestApp/Controller/RPC/Regex.pm Sat Sep 25 13:27:49 2010
@@ -1,0 +1,14 @@
+package TestApp::Controller::RPC::Regex;
+
+use strict;
+use base 'Catalyst::Controller';
+
+### accept every xmlrpc request here
+sub my_dispatcher : XMLRPCRegex('^.$') {
+     my( $self, $c ) = @_;
+
+     ### return the name of the method you called
+     $c->stash->{'xmlrpc'} = $c->request->xmlrpc->method;
+}
+
+1;




More information about the Pkg-perl-cvs-commits mailing list