1#!/usr/bin/env perl 2 3# Test the RPC::XML::ParserFactory class 4 5## no critic(RequireInterpolationOfMetachars) 6## no critic(ProhibitStringyEval) 7## no critic(RequireCheckingReturnValueOfEval) 8 9use strict; 10use warnings; 11 12use Module::Load; 13use Test::More; 14use File::Spec; 15 16use RPC::XML ':all'; 17use RPC::XML::ParserFactory; 18 19plan tests => 38; 20 21my ($req, $res, $ret, $ns, $dir, $vol, %aliases, %parsers); 22# This one will be referenced from outside of main::, so it has to be visible: 23our $p; ## no critic(ProhibitPackageVars) 24 25($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0)); 26$dir = File::Spec->catpath($vol, $dir, q{}); 27unshift @INC, $dir; 28 29%parsers = ( 30 'XML::Parser' => 1, 31); 32 33# See if we should run tests dependent on XML::LibXML 34if (eval { load XML::LibXML; 1; }) 35{ 36 $parsers{'XML::LibXML'} = 1; 37} 38 39# The organization of the test suites is such that we assume anything that 40# runs before the current suite is 100%. Thus, no consistency checks on 41# RPC::XML::* classes, RPC::XML::Parser::XMLParser or any of the other 42# parser-instance classes that are currently part of the distro. 43 44# First let's squeeze in a negative test, to see what happens when an attempt 45# to load a valid parser fails 46unshift @INC, sub { 47 die "Force-failing RPC::XML::Parser::XMLParser\n" 48 if ($_[1] eq 'RPC/XML/Parser/XMLParser.pm'); 49 return; 50}; 51$p = RPC::XML::ParserFactory->new(class => 'XML::Parser'); 52ok(! $p, 'Factory correctly failed when it could not load parser class'); 53like($RPC::XML::ERROR, qr/loading RPC::XML::Parser::XMLParser/, 54 'Correct error message'); 55# Now clear out that pesky closure so the rest of the tests succeed 56shift @INC; 57 58# Now start by testing with the XML::Parser wrapper, since that is the only one 59# that is "required" (for now). 60$p = RPC::XML::ParserFactory->new(); 61isa_ok($p, 'RPC::XML::Parser', '$p'); 62isa_ok($p, 'RPC::XML::Parser::XMLParser', '$p'); 63 64$req = RPC::XML::request->new('test.method'); 65$ret = $p->parse($req->as_string); 66isa_ok($ret, 'RPC::XML::request', '$ret'); 67is($ret->name, 'test.method', 'Correct request method name'); 68 69$res = RPC::XML::response->new(RPC::XML::string->new('test response')); 70$ret = $p->parse($res->as_string); 71isa_ok($ret, 'RPC::XML::response', '$ret'); 72is($ret->value->value, 'test response', 'Response value'); 73 74# Test some badly-formed data 75my $tmp = $res->as_string; 76$tmp =~ s/methodResponse/mR/g; 77$ret = $p->parse($tmp); 78ok(!ref($ret), 'Bad XML did not parse'); 79like($ret, qr/Unknown tag/, 'Parse failure returned error'); 80 81# For all the evals, to avoid namespace pollution, we'll keep incrementing 82# this... 83$ns = 'namespace0000'; 84%aliases = ( 85 'XML::Parser' => [ qw(XML::Parser xml::parser xmlparser) ], 86 'XML::LibXML' => [ qw(XML::LibXML xml::libxml xmllibxml) ], 87); 88 89# Test with the various aliases for XML::Parser 90for my $alias (@{$aliases{'XML::Parser'}}) 91{ 92 $ns++; 93 undef $p; 94 95 eval <<"END_OF_EVAL"; 96{ 97 package $ns; 98 use RPC::XML::ParserFactory (class => '$alias'); 99 100 \$main::p = RPC::XML::ParserFactory->new(); 101} 102END_OF_EVAL 103 104 isa_ok($p, 'RPC::XML::Parser', "Alias $alias: \$p"); 105 isa_ok($p, 'RPC::XML::Parser::XMLParser', "Alias $alias: \$p"); 106} 107 108# The non-xmlparser parsers are all optional, so skip their sets if the 109# parser isn't in the config: 110for my $parser (qw(XML::LibXML)) 111{ 112 (my $factory_class = $parser) =~ s/:://g; 113 $factory_class = "RPC::XML::Parser::$factory_class"; 114 SKIP: 115 { 116 if (! $parsers{$parser}) 117 { 118 skip "$parser not detected, tests skipped", 6; 119 } 120 121 for my $alias (@{$aliases{$parser}}) 122 { 123 $ns++; 124 undef $p; 125 126 eval <<"END_OF_EVAL"; 127{ 128 package $ns; 129 use RPC::XML::ParserFactory qw($alias); 130 131 \$main::p = RPC::XML::ParserFactory->new(); 132} 133END_OF_EVAL 134 135 isa_ok($p, 'RPC::XML::Parser', "Alias $alias: \$p"); 136 isa_ok($p, $factory_class, "Alias $alias: \$p"); 137 } 138 } 139} 140 141# This block makes sure that we can new() a parser with a specific alias 142for my $parser (qw(XML::Parser XML::LibXML)) 143{ 144 (my $factory_class = $parser) =~ s/:://g; 145 $factory_class = "RPC::XML::Parser::$factory_class"; 146 SKIP: 147 { 148 if (! $parsers{$parser}) 149 { 150 skip "$parser not detected, tests skipped", 6; 151 } 152 153 for my $alias (@{$aliases{$parser}}) 154 { 155 $p = RPC::XML::ParserFactory->new(class => $alias); 156 157 isa_ok($p, 'RPC::XML::Parser', "New'ing $alias: \$p"); 158 isa_ok($p, $factory_class, "New'ing $alias: \$p"); 159 } 160 } 161} 162 163# Some negative tests 164$p = RPC::XML::ParserFactory->new(class => 'DoesNotExist'); 165ok(! $p, 'Factory-new fails with bad class argument'); 166like($RPC::XML::ERROR, qr/Error loading DoesNotExist/, 167 'Correct error message'); 168$p = RPC::XML::ParserFactory->new(class => 'BadParserClass'); 169ok(! $p, 'Factory-new fails with a bad parser class'); 170like($RPC::XML::ERROR, qr/is not a sub-class of/, 'Correct error message'); 171 172exit 0; 173