File Coverage

blib/lib/Object/Exercise.pm

Criterion	Covered	Total	%
statement	26	31	83.8
branch	8	18	44.4
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	38	53	71.7

# $Id: Exercise.pm 266 2009-06-04 13:48:25Z lembark $
#######################################################################
# housekeeping
#######################################################################

package Object::Exercise;

require 5.6.2; # I'm running 5.8.8; hopefully this is reasonable...

use strict;

use Symbol qw( qualify_to_ref );

use Object::Exercise::Common qw( log_message continue verbose );

########################################################################
# package variables
########################################################################

our $VERSION = 1.02;

########################################################################
# subroutines
########################################################################

sub import
{
    my $package = __PACKAGE__;
    my $caller  = caller;

    # discard the class argument.

    shift if $_[0] eq $package;

    # arguments:
    # -k turns off fatal on error.
    # -v turns on  verbose.
    # -b uses benchmark instead of execution handler.
    # -e uses execution handler (default).
    # -n specifies the installed name (vs. 'execution' or 'benchmark'.
    # -p turns off plannng in the test loop.

    my %exportz = ();

    while( @_ )
    {
        my $arg = shift;

        if( $arg =~ /^-k/ )
        {
            $continue = 1;
        }
        elsif( $arg =~ /^-v/ )
        {
            $verbose = 1;
        }
        elsif( $arg =~ /^-b/ )
        {
            my $name = ( index $_[0], '-' ) ? 'benchmark' : shift ;

            $exportz{ benchmark } = $name;
        }
        elsif( $arg =~ /^-e/ )
        {
            my $name = ( index $_[0], '-' ) ? 'execute' : shift ;

            $exportz{ execute } = $name;
        }
        else
        {
            die "Bogus $package: unknown switch '$arg'";
        }
    }

    %exportz = qw( execute exercise ) unless %exportz;

    while( my($src,$dst) = each %exportz )
    {
        $log_message->( "$package installing '$src' into '$caller' as '$dst'" )
        if $verbose;

        my $module  = $package . '::' . ucfirst $src;

        my $handler = eval "require $module";

        my $ref     = qualify_to_ref $dst, $caller;

        *$ref       = \$handler;
    }

    return
}

# keep require happy

1

__END__