File Coverage

blib/lib/EnvDir.pm

Criterion	Covered	Total	%
statement	106	115	92.1
branch	24	38	63.1
condition	8	15	53.3
subroutine	21	22	95.4
pod	0	2	0.0
total	159	192	82.8

package EnvDir;
use 5.008005;
use strict;
use warnings;
use Carp ();
use File::Spec;
use Storable ();

our $VERSION = "0.08";
our $DEFAULT_ENVDIR = File::Spec->catdir( File::Spec->curdir, 'env' );

use constant MARK_DELETE => '__MARK_DELETE__';

sub new {
    my $class = shift;
    my %args  = @_;
    bless {
        clean => 0,
        depth => 0,
        cache => [],
        stack => [],
        map { $_ => $args{$_} } qw(clean)
    }, $class;
}

my $GLOBAL_INSTANCE;
my @GLOBAL_GUARD;
sub _instance {
    my $class = shift;
    $GLOBAL_INSTANCE ||= $class->new;
    $GLOBAL_INSTANCE;
}

sub import {
    my $class = shift;
    my @args  = @_;

    my $autoload = 0;
    my $dir      = 0;
    my $clean    = 0;
    my $self;

    while ( defined( my $arg = shift @args ) ) {
        if ( $arg eq '-autoload' ) {
            $self = $class->_instance;
            $autoload = 1;

            $dir = shift @args;
            if ( $dir and $dir eq '-clean' ) {
                push @_, $dir;
                $dir = $DEFAULT_ENVDIR;
            }
        }
        elsif ( $arg eq 'envdir' ) {
            my $package = (caller)[0];
            no strict 'refs';
            *{"$package\::envdir"} = \&envdir;
        }
        elsif ( $arg eq '-clean' ) {
            $self = $class->_instance;
            $self->{clean} = 1;
        }
    }

    if ($autoload) {
        push @GLOBAL_GUARD, $self->envdir($dir);
    }
}

sub envdir {
    my ( $self, $envdir ) = @_;

    unless ( ref $self and ref $self eq 'EnvDir' ) {
        $envdir = $self;
        $self = EnvDir->_instance;
    }

    $self->{depth} = scalar @{ $self->{stack} };
    $envdir ||= $DEFAULT_ENVDIR;

    my $depth = $self->{depth};

    # from cache
    my @keys = keys %{ $self->{cache}->[$depth] };
    if ( scalar @keys ) {
        $self->_push_stack;
        $self->_clean_env if $self->{clean};
        $self->_update_env;

        return EnvDir::Guard->new( sub { $self->_revert if $self } );
    }

    # from dir
    opendir my $dh, $envdir or Carp::croak "Cannot open $envdir: $!";

    for my $key ( grep !/^\./, readdir($dh) ) {
        my $path = File::Spec->catfile( $envdir, $key );
        next if -d $path;
        if ( -s $path == 0 ) {
            $self->{cache}->[$depth]->{ uc $key } = MARK_DELETE;
        }
        else {
            my $value = $self->_slurp($path);
            $self->{cache}->[$depth]->{ uc $key } = $value;
        }
    }

    $self->_push_stack;
    $self->_clean_env if $self->{clean};
    $self->_update_env;

    closedir $dh or Carp::carp "Cannot close $envdir: $!";

    return EnvDir::Guard->new( sub { $self->_revert if $self } );
}

sub _push_stack {
    my $self = shift;
    push @{ $self->{stack} }, Storable::freeze( \%ENV );
}

sub _pop_stack {
    my $self = shift;
    my $ENV = pop @{ $self->{stack} };
    %{ Storable::thaw($ENV) };
}

sub _revert {
    my $self = shift;
    %ENV = $self->_pop_stack;
}

sub _clean_env {
    my $self = shift;
    %ENV = ();
    $ENV{PATH} = '/bin:/usr/bin'; # the same as envdir(8)
}

sub _update_env {
    my $self    = shift;
    my $new_env = $self->{cache}->[ $self->{depth} ];
    for ( keys %$new_env ) {
        my $value = $new_env->{$_};
        if ( $value and $value eq MARK_DELETE ) {
            delete $ENV{$_};
        }
        else {
            $ENV{$_} = $value;
        }
    }
}

sub _slurp {
    my $self = shift;
    my $path = shift;
    if ( open my $fh, '<', $path ) {
        my $value = <$fh>;    # read first line only.
        chomp $value if defined $value;
        close $fh or Carp::carp "Cannot close $path: $!";
        return $value;
    }
    else {
        Carp::carp "Cannot open $path: $!";
        return;
    }
}

package EnvDir::Guard;

sub new {
    my ( $class, $handler ) = @_;
    bless $handler, $class;
}

sub DESTROY {
    my $self = shift;
    $self->();
}

1;
__END__