File Coverage

blib/lib/RPC/XML/ParserFactory.pm

Criterion	Covered	Total	%
statement	27	38	71.0
branch	4	12	33.3
condition	2	3	66.6
subroutine	7	7	100.0
pod			n/a
total	40	60	66.6

###############################################################################
#
# This file copyright (c) 2001-2011 Randy J. Ray, all rights reserved
#
# Copying and distribution are permitted under the terms of the Artistic
# License 2.0 (http://www.opensource.org/licenses/artistic-license-2.0.php) or
# the GNU LGPL (http://www.opensource.org/licenses/lgpl-2.1.php).
#
###############################################################################
#
#   Description:    This is the RPC::XML::ParserFactory class, a factory for
#                   classes that derive from the RPC::XML::Parser class.
#
#   Functions:      import
#                   new
#                   register
#
#   Libraries:      RPC::XML::Parser::XMLParser \
#                   RPC::XML::Parser::XMLLibXML  > One (or more) of these
#                   RPC::XML::Parser::XMLSAX    /
#
#   Global Consts:  $VERSION
#
#   Environment:    None.
#
###############################################################################

package RPC::XML::ParserFactory;

use 5.008008;
use strict;
use warnings;
use vars qw($VERSION %AVAILABLE $PARSER_CLASS);
use subs qw(import new register);

# Because this is a factory class, there are some eval's that violate this
# critic policy, but can't be worked around:
## no critic (RequireCheckingReturnValueOfEval)

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

# These are the known parsers supported, not including any that are specified
# by the user at import-time.
$PARSER_CLASS = 'XML::Parser';
%AVAILABLE    = (
    'XML::Parser' => 'RPC::XML::Parser::XMLParser',
    'XML::LibXML' => 'RPC::XML::Parser::XMLLibXML',
);

# "Normalize" the key-names to allow some simplicity (and sugar):
for (keys %AVAILABLE)
{
    my $key = lc $_;
    $AVAILABLE{$key} = $AVAILABLE{$_};
    $key =~ s/:://g;
    $AVAILABLE{$key} = $AVAILABLE{$_};
}

###############################################################################
#
#   Sub Name:       import
#
#   Description:    Method called when this module is use'd
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $class    in      scalar    Class name (not used)
#                   @args     in      list      Arguments to the import
#
#   Globals:        $PARSER_CLASS
#
#   Returns:        void
#
###############################################################################
sub import
{
    my (undef, @args) = @_;

    # As a special-case, this one parameter might be specified without the
    # key, if it is the ONLY thing passed:
    if (1 == @args)
    {
        @args = (class => @args);
    }

    # For now, the only arguments are key/value pairs so it's safe to coerce
    # this into a hash
    my %argz = @args;

    # In fact, for now, this is the only argument:
    if ($argz{class})
    {
        $PARSER_CLASS = $argz{class};
    }

    return;
}

###############################################################################
#
#   Sub Name:       new
#
#   Description:    Constructor. Save any important attributes, leave the
#                   heavy lifting for the parse() routine and XML::Parser.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $class    in      scalar    Class we're initializing
#                   %attr     in      hash      Any extras the caller wants
#
#   Globals:        $RPC::XML::ERROR
#
#   Returns:        Success:    object ref
#                   Failure:    undef
#
###############################################################################
sub new
{
    my ($class, %attrs) = @_;

    my $factory = delete $attrs{class} || $PARSER_CLASS;

    if ($class = $AVAILABLE{$factory})
    {
        eval "require $class;"; ## no critic (ProhibitStringyEval)
        if ($@)
        {
            $RPC::XML::ERROR = __PACKAGE__ . "::new: Error loading $class (" .
              "factory for '$factory'): $@";
            return;
        }
    }
    else
    {
        # This means that the class is not one of the built-in ones. Try to
        # load it, then make sure it's a sub-class of this one:
        $class = $factory;
        eval "require $class;"; ## no critic (ProhibitStringyEval)
        if ($@)
        {
            $RPC::XML::ERROR = __PACKAGE__ . "::new: Error loading $class: $@";
            return;
        }
        # Loaded OK... is it a descendent?
        if  (! $class->isa(__PACKAGE__))
        {
            $RPC::XML::ERROR = __PACKAGE__ . "::new: Class '$class' cannot " .
              'be used, as it is not a sub-class of ' . __PACKAGE__;
            return;
        }
    }

    return $class->new(%attrs);
}

1;

__END__