File Coverage

blib/lib/Test/Formats.pm

Criterion	Covered	Total	%
statement	20	26	76.9
branch	0	6	0.0
condition	0	3	0.0
subroutine	6	6	100.0
pod			n/a
total	26	41	63.4

###############################################################################
#
# This file copyright (c) 2008 by Randy J. Ray, all rights reserved.
#
# See LICENSE in the documentation for redistribution terms.
#
###############################################################################
#
#   $Id: Formats.pm 2 2008-10-20 09:56:47Z rjray $
#
#   Description:    This is an umbrella of sorts, that allows users to make
#                   use of multiple Test::Formats::* implementation classes
#                   at once, while also still getting all the benefits of
#                   being a subclass of Test::Builder::Module.
#
#   Functions:      import
#
#   Libraries:      Test::Builder::Module
#
#   Global Consts:  $VERSION
#
###############################################################################

package Test::Formats;

use 5.008;
use strict;
use warnings;
use subs qw(import);
use base 'Test::Builder::Module';

our $VERSION = '0.10';

###############################################################################
#
#   Sub Name:       import
#
#   Description:    Do some sleight-of-hand with @ISA during the import
#                   stage.
#
#   Arguments:      NAME        IN/OUT  TYPE    DESCRIPTION
#                   $class      in      scalar  Class we're called from
#                   @rest       in      array   Rest of the args-list
#
#   Globals:        @ISA
#
#   Returns:        threads through to SUPER::import()
#
###############################################################################
sub import
{
    my ($class, @rest) = @_;

    # Yes, this means we will be force-exporting other modules' export lists
    # into the namespace of whoever called us.
    my $caller = caller(0);

    # This is tricky. Anything that might be an import argument to
    # Test::Builder::Module has to stay. Things that look like they are
    # specializations of Test::Formats need to be handled here. For now, at
    # least until the first bugs appear on RT, assume any string that leads
    # with an upper-case letter is meant for us.
    my @pass = ();
    for my $opt (@rest)
    {
        if (ref($opt) || ($opt !~ /^[A-Z]/))
        {
            # Assume that this option is intended for the superclass
            push @pass, $opt;
            next;
        }

        # If the name doesn't begin with "Test::", then it is assumed to be
        # relative to this class. Prepend $class to it in that case. This
        # lets format-testing modules that aren't directly under
        # Test::Formats::* be covered by our umbrella.
        $opt = "${class}::$opt" unless $opt =~ /^Test::/;

        # Attempt to load it, importing what it offers into the namespace that
        # called us.
        eval "package $caller; use $opt;";
        die "$class: Error loading format-tester $opt: $@" if $@;
    }

    $class->SUPER::import(@pass);
}

1;

__END__