Test::Stream::Plugin::OO

OO.pm

package Test::Stream::Plugin::OO;
use strict;
use warnings;

use Carp qw/confess croak/;

use Test::Stream::Plugin;
use Test::Stream::Plugin::OO::Base;
use Test::Stream::Util qw/pkg_to_file/;

my %TAKES_VAL = ( base => 1 );
my %INSTANCES;

sub load_ts_plugin {
    my $class = shift;
    my $caller = shift;
    my $test_class = $caller->[0];

    my (%args, @syms);
    while(my $arg = shift @_) {
        if ($arg =~ m/^-(.*)$/) {
            $args{$1} = $TAKES_VAL{$1} ? shift(@_) : 1;
        }   
        elsif($arg =~ m/^\$(.*)$/) {
            push @syms => $1; 
        }   
        else {
            croak "Invalid import argument: '$arg'";
        }   
    }   

    $class->hide_test_class if delete $args{hide_test_class};

    my $base = delete($args{base}) || 'Test::Stream::Plugin::OO::Base';
    my $file = pkg_to_file($base);
    require $file unless $INC{$file};

    {   
        no strict 'refs';
        push @{"$test_class\::ISA"} => $base;
    }   

    my $self = $class->get_instance($test_class);

    for my $sym (@syms) {
        no strict 'refs';
        *{"$test_class\::$sym"} = \$self;
    }   

    return unless keys %args;
    croak "Invalid arguments: " . join(', ', map { "'-$_'" } keys %args);
}

sub get_instance {
    my $class = shift;
    my ($test_class) = @_; 

    confess "'$test_class' is not a 'Test::Stream::Plugin::OO::Base'"
        unless $test_class->isa('Test::Stream::Plugin::OO::Base');

    return $INSTANCES{$test_class} ||= $test_class->new($test_class->new_args);
}

my $HIDDEN = 0;
sub hide_test_class {
    return if $HIDDEN++;

    confess "Test::Class is already loaded, cannot prevent it from being loaded"
        if $INC{'Test/Class.pm'};

    $INC{'Test/Class.pm'} = __FILE__;
    *Test::Class:: = *Test::Stream::Plugin::OO::Base::;
}

1;