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