File Coverage

blib/lib/Resource/Loader.pm

Criterion	Covered	Total	%
statement	77	80	96.2
branch	40	48	83.3
condition	10	21	47.6
subroutine	13	14	92.8
pod	9	9	100.0
total	149	172	86.6

# -*- perl -*- --------------------------------------------------
#
# Resource::Loader - load different resources depending...
#
# Joshua Keroes
#
# This number is *not* the $VERSION (see below):
# $Id: Loader.pm,v 1.10 2003/04/28 23:28:19 jkeroes Exp $

package Resource::Loader;

use strict;
use warnings;
use Carp;
use vars qw/$VERSION/;

$VERSION = '0.03';

# In:  hash-style args. See docs.
# Out: object
sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my $self  = {};

    bless $self, $class;

    $self->_init( @_ );
}

# In:  hash-style args. See docs for new()
# Out: object
sub _init {
    my $self = shift;
    my %args = @_;

    while ( my ( $method, $args ) = each %args ) {
	$self->$method( $args );
    }

    return $self;
}


# In:  array or arrayref. See docs.
# Out: array or arrayref of resources.
sub resources {
    my $self = shift;

    if ( @_ ) {
	undef $self->{resources};

	for ( ref $_[0] eq 'ARRAY' ? @{ $_[0] } : $_[0] ) {
	    croak "Malformed resource. Needs 'name', 'when', and 'what' args"
		unless defined $_->{name}
		    && defined $_->{when}
	            && defined $_->{what};

	    croak "Malformed resource. 'when' and 'what' need to be coderefs."
		unless ref $_->{what} eq "CODE"
		    && ref $_->{when} eq "CODE";

	    croak "Malformed resource. 'whatargs' needs to be an arrayref."
		if $_->{whatargs}
		    && ref $_->{whatargs} ne "ARRAY";

	    croak "Malformed resource. 'whenargs' needs to be an arrayref."
		if $_->{whenargs}
		    && ref $_->{whenargs} ne "ARRAY";

	    push @{ $self->{resources} }, $_;
	}
    }

    return wantarray ? @{ $self->{resources} } : $self->{resources};
}

# In:  optional new value
# Out: current value
sub testing {
    my $self = shift;
    $self->{testing} = shift if @_;
    return defined $ENV{RMTESTING} ? $ENV{RMTESTING} : $self->{testing};
}

# In:  optional new value
# Out: current value
sub verbose {
    my $self = shift;
    $self->{verbose} = shift if @_;
    return defined $ENV{RMVERBOSE} ? $ENV{RMVERBOSE} :  $self->{verbose};
}

# In:  optional new value
# Out: current value
sub cont {
    my $self = shift;
    $self->{cont} = shift if @_;
    return defined $ENV{RMCONT} ? $ENV{RMCONT} : $self->{cont};
}

# In:  n/a
# Out: hashref of our environment variables
sub env {
    my $self = shift;
    return { RMTESTING => $ENV{RMTESTING},
	     RMVERBOSE => $ENV{RMVERBOSE},
	     RMSTATES  => $ENV{RMSTATES},
	     RMCONT    => $ENV{RMCONT},
	   };
}

# In:  n/a
# Out: hashref of loaded states and their returns values.
sub loaded {
    my $self = shift;
    return $self->{loaded};
}

# In:  n/a
# Out: status report
#
# Runs the appropriate resources()
sub load {
    my $self = shift;

    # clear out loaded() and status() tables.
    undef $self->{loaded};
    undef $self->{status};
    $self->{status} = { map { $_->{name} => 'inactive' } @{ $self->{resources} } };

    for( @{ $self->{resources} } ) {
	my $name = $_->{name};


	if ( defined $ENV{RMSTATES} ) {
	    if ( grep { $_ eq $name } split /:/, $ENV{RMSTATES} ) {
		print __PACKAGE__ . " state '$name' present in RMSTATES environment var\n";
	    } else {
		print __PACKAGE__ . " state '$name' skipped due to RMSTATES environment var\n";
		$self->{status}{$name} = 'skipped';
		next;
	    }
	}

	if ( $_->{when}->( ref $_->{whenargs} eq "ARRAY"
			   ? @{ $_->{whenargs} }
			   : () ) ) {
	    print __PACKAGE__ . " state '$name' active\n" if $self->verbose;

	    if ( $self->testing ) {
		print __PACKAGE__ . " in testing: won't run code for state '$name'\n" if $self->verbose;
		$self->{status}{$name} = 'notrun';
	    } else {
		$self->{loaded}{$name} = $_->{what}->( ref $_->{whatargs} eq "ARRAY"
						       ? @{ $_->{whatargs} }
						       : () );
		$self->{status}{$name} = 'loaded';
	    }

	    last unless $self->cont;
	} else {
	    print __PACKAGE__ . " state '$name' inactive\n" if $self->verbose;
	    $self->{status}{$name} = 'inactive';
	}
    }

    return $self->loaded;
}

# In:  n/a
# Out: status report, e.g. { name => status, ... }
sub status {
    my $self = shift;

    return unless $self->{status}
	&& ref    $self->{status} eq "HASH";

    return $self->{status};
}

1;

__END__