Skip to content

Commit

Permalink
Last round of RPC::XML::Procedure test coverage.
Browse files Browse the repository at this point in the history 
This is mostly in t/40_server.t, though some bugs were found and addressed
in the modules and in t/30_method.t.
  • Loading branch information
@rjray
rjray committed Jul 18, 2011
1 parent ffb4ccf commit 105d7d2
Show file tree
Hide file tree
Showing 4 changed files with 266 additions and 60 deletions.
111 changes: 57 additions & 54 deletions lib/RPC/XML/Procedure.pm
View file
Expand Up @@ -50,7 +50,7 @@ package RPC::XML::Procedure;
use 5.008008;
use strict;
use warnings;
use vars qw($VERSION);
use vars qw($VERSION %VALID_TYPES);
use subs qw(
new name code signature help version hidden add_signature
delete_signature make_sig_table match_signature reload load_xpl_file
Expand All @@ -64,9 +64,16 @@ use RPC::XML 'smart_encode';
# This module also provides RPC::XML::Method
## no critic (ProhibitMultiplePackages)

$VERSION = '1.27';
$VERSION = '1.28';
$VERSION = eval $VERSION; ## no critic (ProhibitStringyEval)

# This should match the set of type-classes defined in RPC::XML.pm. Note that
# we use "datetime_iso8601" instead of "dateTime.iso8601", because that is how
# it has to be in the signature.
%VALID_TYPES = map { $_ => 1 }
(qw(int i4 i8 double string boolean datetime_iso8601 nil array struct
base64));

###############################################################################
#
# Sub Name: new
Expand Down Expand Up @@ -98,13 +105,15 @@ sub new
if (ref $argz[0])
{
# 1. A hashref containing all the relevant keys

# Start wtih the defaults for the optional keys
$data = {
namespace => q{},
version => 0,
hidden => 0,
help => q{},
signature => [],
};
# Copy everything from the hash, don't try to use it directly
for (keys %{$argz[0]}) { $data->{$_} = $argz[0]->{$_} }
}
elsif (@argz == 1)
Expand Down Expand Up @@ -189,6 +198,8 @@ sub new
# Arguments: NAME IN/OUT TYPE DESCRIPTION
# $self in ref Object of this class
#
# Globals: %VALID_TYPES
#
# Returns: Success: $self
# Failure: error message
#
Expand All @@ -197,23 +208,36 @@ sub make_sig_table
{
my $self = shift;

my ($return, $rest);
my ($return, $rest, @rest);
my $me = ref($self) . '::make_sig_table';

delete $self->{sig_table};
for my $sig (@{$self->{signature}})
{
($return, $rest) = split / /, $sig, 2;
if (! $rest)
($return, @rest) = split / /, $sig;
if (! $return)
{
$rest = q{};
return "$me: Invalid signature, cannot be null";
}
if (! $VALID_TYPES{$return})
{
return "$me: Unknown return type '$return'";
}
# Not going to add List::MoreUtils to my dependencies list, so suppress
# this ciritic flag:
## no critic (ProhibitBooleanGrep)
if (grep { ! $VALID_TYPES{$_} } @rest)
{
return "$me: One or more invalid types in signature";
}

$rest = join q{ } => @rest;
# If the key $rest already exists, then this is a collision
if ($self->{sig_table}->{$rest})
{
return
ref($self) . '::make_sig_table: Cannot have two different ' .
"return values for one set of params ($return vs. " .
"$self->{sig_table}->{$rest})";
"$me: Cannot have two different return values for one set " .
"of params ($return vs. $self->{sig_table}->{$rest})";
}

$self->{sig_table}->{$rest} = $return;
Expand Down Expand Up @@ -615,14 +639,14 @@ sub load_xpl_file
# Environment: None.
#
# Returns: Success: value
# Failure: dies with RPC::XML::Fault object as message
# Failure: RPC::XML::fault object
#
###############################################################################
sub call
{
my ($self, $srv, @data) = @_;

my (@paramtypes, @params, $signature, $resptype, $response, $name, $noinc);
my (@paramtypes, @params, $signature, $resptype, $response, $name);

$name = $self->name;
# Create the param list.
Expand All @@ -642,25 +666,10 @@ sub call
);
}

# Make sure that the response-type is a valid XML-RPC type
if (($resptype ne 'scalar') && (! "RPC::XML::$resptype"->can('new')))
{
return $srv->server_fault(badsignature =>
"Signature [$signature] for method $name has unknown " .
"return-type '$resptype'");
}

# Set these in case the server object is part of the param list
local $srv->{signature} = ## no critic (ProhibitLocalVars)
[ $resptype, @paramtypes ];
local $srv->{method_name} = $name; ## no critic (ProhibitLocalVars)
# If the method being called is "system.status", check to see if we should
# increment the server call-count.
$noinc =
(($name eq 'system.status') &&
@data &&
($paramtypes[0] eq 'boolean') &&
$params[0]) ? 1 : 0;
# For RPC::XML::Method (and derivatives), pass the server object
if ($self->isa('RPC::XML::Method'))
{
Expand All @@ -672,15 +681,24 @@ sub call
{
# On failure, propagate user-generated RPC::XML::fault exceptions, or
# transform Perl-level error/failure into such an object
if ($@)
if (blessed $@ and $@->isa('RPC::XML::fault'))
{
return $@;
}
else
{
return (blessed $@ and $@->isa('RPC::XML::fault')) ?
$@ : $srv->server_fault(execerror =>
"Method $name returned error: $@");
return $srv->server_fault(
execerror => "Method $name returned error: $@"
);
}
}

if (! $noinc)
# Increment the 'called' key on the proc UNLESS the proc is named
# 'system.status' and has a boolean-true as the first param.
if (! (($name eq 'system.status') &&
@data &&
($paramtypes[0] eq 'boolean') &&
$params[0]))
{
$self->{called}++;
}
Expand Down Expand Up @@ -744,35 +762,20 @@ package RPC::XML::Function;
use strict;
use warnings;
use vars qw(@ISA);
use subs qw(new signature make_sig_table clone match_signature);
use subs qw(
signature make_sig_table add_signature delete_signature match_signature
);

@ISA = qw(RPC::XML::Procedure);

# These two are only implemented here at all, because some of the logic in
# other places call them
# These are the bits that have to be different for RPC::XML::Function versus
# the other procedure types. They are simple-enough that they don't need
# dedicated comment-blocks for them.
sub signature { return [ 'scalar' ]; }
sub make_sig_table { return shift; }
sub add_signature { return shift; }
sub delete_signature { return shift; }

###############################################################################
#
# Sub Name: match_signature
#
# Description: Noop. Needed for RPC::XML::Server.
#
# Arguments: NAME IN/OUT TYPE DESCRIPTION
# $self in ref Object of this class
# $sig in scalar Signature to check for
#
# Returns: Success: return type as a string
# Failure: 0
#
###############################################################################
sub match_signature
{
return 'scalar';
}
sub match_signature { return 'scalar'; }

1;

Expand Down
11 changes: 8 additions & 3 deletions lib/RPC/XML/Server.pm
View file
Expand Up @@ -111,7 +111,7 @@ BEGIN
);
}

$VERSION = '1.62';
$VERSION = '1.63';
$VERSION = eval $VERSION; ## no critic (ProhibitStringyEval)

###############################################################################
Expand Down Expand Up @@ -419,7 +419,10 @@ sub add_method
}
elsif (ref $meth eq 'HASH')
{
my $class = 'RPC::XML::' . ucfirst($meth->{type} || 'method');
# If the type of this method is not set, default to "method". The
# add_procedure and add_function calls should set this as needed.
$meth->{type} ||= 'method';
my $class = 'RPC::XML::' . ucfirst $meth->{type};
$meth = $class->new($meth);
}
elsif (! (blessed $meth and $meth->isa('RPC::XML::Procedure')))
Expand Down Expand Up @@ -2106,7 +2109,9 @@ sub dispatch
}
else
{
$response = $self->server_fault(badmethod => $meth);
$response = $self->server_fault(
badmethod => "No method '$meth' on server"
);
}
# All the eval'ing and error-trapping happened within the method class
Expand Down
34 changes: 32 additions & 2 deletions t/30_method.t
View file
Expand Up @@ -12,7 +12,7 @@ use Test::More;
use RPC::XML qw($ALLOW_NIL RPC_INT);
use RPC::XML::Procedure;

plan tests => 75;
plan tests => 81;

($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0));
$dir = File::Spec->catpath($vol, $dir, '');
Expand Down Expand Up @@ -145,6 +145,27 @@ $obj = RPC::XML::Method->new({ name => 'test.test2',
like($obj, qr/two different return values for one set of params/,
'Correct constructor failure [4]');

# Fails because of a null signature
$obj = RPC::XML::Method->new({ name => 'test.test2',
signature => [ '' ],
code => sub { $flag = 2; } });
like($obj, qr/Invalid signature, cannot be null/,
'Correct constructor failure [5]');

# Fails because of an unknown type in the return value slot
$obj = RPC::XML::Method->new({ name => 'test.test2',
signature => [ 'frob int' ],
code => sub { $flag = 2; } });
like($obj, qr/Unknown return type 'frob'/,
'Correct constructor failure [6]');

# Fails because of an unknown type in the args-list
$obj = RPC::XML::Method->new({ name => 'test.test2',
signature => [ 'int string frob int' ],
code => sub { $flag = 2; } });
like($obj, qr/One or more invalid types in signature/,
'Correct constructor failure [7]');

# This file will not load due to missing required information
$obj = RPC::XML::Method->new(File::Spec->catfile($dir, 'meth_bad_1.xpl'));
like($obj, qr/missing/i, 'Bad XPL [1] not loaded');
Expand Down Expand Up @@ -259,7 +280,7 @@ isa_ok($obj, 'RPC::XML::Function', '$obj');
# With this later object, test some of the routines that are overridden in
# RPC::XML::Function:
SKIP: {
skip 'Cannot test without RPC::XML::Function object', 5
skip 'Cannot test without RPC::XML::Function object', 8
if (ref($obj) ne 'RPC::XML::Function');

ok((ref($obj->signature) eq 'ARRAY' && (@{$obj->signature} == 1)),
Expand All @@ -274,6 +295,15 @@ SKIP: {
'RPC::XML::Function valid delete_signature');
ok((ref($obj->signature) eq 'ARRAY' && (@{$obj->signature} == 1)),
'RPC::XML::Function valid return from signature() <3>');
# Can we clone it?
$obj2 = $obj->clone();
isa_ok($obj2, ref($obj), '$obj2');
ok(($obj->name() eq $obj2->name()) &&
($obj->version() eq $obj2->version()) &&
($obj->help() eq $obj2->help()),
'Compare accessors of clone and source');
is($obj->code(), $obj2->code(),
'Clone code() ref value is same as source');
}

# But this should fail, as only RPC::XML::Procedure is allowed to act as a
Expand Down

0 comments on commit 105d7d2

Please sign in to comment.