[Catalyst-commits] r13403 - in Catalyst-Plugin-Server/trunk: . lib/Catalyst/Plugin lib/Catalyst/Plugin/Server lib/Catalyst/Plugin/Server/XMLRPC/DispatchType t t/lib/TestApp/Controller/RPC

jlmartin at dev.catalyst.perl.org jlmartin at dev.catalyst.perl.org
Thu Jul 8 21:43:20 GMT 2010


Author: jlmartin
Date: 2010-07-08 22:43:20 +0100 (Thu, 08 Jul 2010)
New Revision: 13403

Added:
   Catalyst-Plugin-Server/trunk/t/lib/TestApp/Controller/RPC/Regex.pm
Modified:
   Catalyst-Plugin-Server/trunk/Changes
   Catalyst-Plugin-Server/trunk/MANIFEST
   Catalyst-Plugin-Server/trunk/META.yml
   Catalyst-Plugin-Server/trunk/Makefile.PL
   Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server.pm
   Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC.pm
   Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm
   Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm
   Catalyst-Plugin-Server/trunk/t/002_live.t
   Catalyst-Plugin-Server/trunk/t/020_Dispatch_live.t
   Catalyst-Plugin-Server/trunk/t/030_Error_live.t
   Catalyst-Plugin-Server/trunk/t/040_faultcode.t
Log:
Catalyst::Plugin::Server adapted to Catalyst 5.8

History of changes can be found at  http://github.com/pplu/Catalyst-Plugin-Server/tree/master/Catalyst-Plugin-Server-0.26/

Modified: Catalyst-Plugin-Server/trunk/Changes
===================================================================
--- Catalyst-Plugin-Server/trunk/Changes	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/Changes	2010-07-08 21:43:20 UTC (rev 13403)
@@ -1,5 +1,17 @@
 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
 ===================================
 * Important notice: RPC::XML 0.69 introduced a backwards incompatible

Modified: Catalyst-Plugin-Server/trunk/MANIFEST
===================================================================
--- Catalyst-Plugin-Server/trunk/MANIFEST	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/MANIFEST	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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: Catalyst-Plugin-Server/trunk/META.yml
===================================================================
--- Catalyst-Plugin-Server/trunk/META.yml	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/META.yml	2010-07-08 21:43:20 UTC (rev 13403)
@@ -1,12 +1,25 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Catalyst-Plugin-XMLRPC
-version:      0.10
-version_from: lib/Catalyst/Plugin/XMLRPC.pm
-installdirs:  site
+--- #YAML:1.0
+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
-    RPC::XML:                      1
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+    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.4.html
+    version:  1.4

Modified: Catalyst-Plugin-Server/trunk/Makefile.PL
===================================================================
--- Catalyst-Plugin-Server/trunk/Makefile.PL	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/Makefile.PL	2010-07-08 21:43:20 UTC (rev 13403)
@@ -1,25 +1,5 @@
 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',
     'VERSION_FROM' => 'lib/Catalyst/Plugin/Server.pm',
@@ -28,5 +8,6 @@
                         'RPC::XML'          => '1.35',
                         'RPC::XML::Parser'  => '1.12',
                         'MRO::Compat'       => 0,
+			'Clone::Fast'       => 0,
                     }
 );

Modified: Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm
===================================================================
--- Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCPath.pm	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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: Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm
===================================================================
--- Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC/DispatchType/XMLRPCRegex.pm	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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: Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC.pm
===================================================================
--- Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC.pm	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server/XMLRPC.pm	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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;
+        
+        local $Clone::Fast::BREAK_REFS = 1;
 
-        my $res = RPC::XML::response->new($status);
-
+        my $res = RPC::XML::response->new(clone($status));
         $c->res->content_type('text/xml');
 
         return $self->result_as_string( $res->as_string );
@@ -864,10 +864,14 @@
 
 =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
 
 Please submit all bugs regarding C<Catalyst::Plugin::Server> to

Modified: Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server.pm
===================================================================
--- Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server.pm	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/lib/Catalyst/Plugin/Server.pm	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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,21 +109,19 @@
 
 =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
 
 Please submit all bugs regarding C<Catalyst::Plugin::Server> to
 C<bug-catalyst-plugin-server at rt.cpan.org>
 
-=head1 COPYRIGHT
-
-Copyright (c) 2005 - 2009
-the Catalyst::Plugin::Server L</AUTHORS>
-as listed above.
-
 =head1 LICENSE
 
 This library is free software, you can redistribute it and/or modify

Modified: Catalyst-Plugin-Server/trunk/t/002_live.t
===================================================================
--- Catalyst-Plugin-Server/trunk/t/002_live.t	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/t/002_live.t	2010-07-08 21:43:20 UTC (rev 13403)
@@ -19,8 +19,8 @@
 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 );
 my %RpcRv       = ( auto => 1, begin => 1, end => 1 );
@@ -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: Catalyst-Plugin-Server/trunk/t/020_Dispatch_live.t
===================================================================
--- Catalyst-Plugin-Server/trunk/t/020_Dispatch_live.t	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/t/020_Dispatch_live.t	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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: Catalyst-Plugin-Server/trunk/t/030_Error_live.t
===================================================================
--- Catalyst-Plugin-Server/trunk/t/030_Error_live.t	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/t/030_Error_live.t	2010-07-08 21:43:20 UTC (rev 13403)
@@ -20,6 +20,8 @@
 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: Catalyst-Plugin-Server/trunk/t/040_faultcode.t
===================================================================
--- Catalyst-Plugin-Server/trunk/t/040_faultcode.t	2010-07-08 20:48:24 UTC (rev 13402)
+++ Catalyst-Plugin-Server/trunk/t/040_faultcode.t	2010-07-08 21:43:20 UTC (rev 13403)
@@ -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: Catalyst-Plugin-Server/trunk/t/lib/TestApp/Controller/RPC/Regex.pm
===================================================================
--- Catalyst-Plugin-Server/trunk/t/lib/TestApp/Controller/RPC/Regex.pm	                        (rev 0)
+++ Catalyst-Plugin-Server/trunk/t/lib/TestApp/Controller/RPC/Regex.pm	2010-07-08 21:43:20 UTC (rev 13403)
@@ -0,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 Catalyst-commits mailing list