File Coverage

blib/lib/Build/Hopen/Scope/Environment.pm

Criterion	Covered	Total	%
statement	34	35	97.1
branch	7	12	58.3
condition	3	8	37.5
subroutine	9	10	90.0
pod	1	1	100.0
total	54	66	81.8

# Build::Hopen::Scope::Environment - a hopen Scope for %ENV
package Build::Hopen::Scope::Environment;
use Build::Hopen::Base;
use Build::Hopen qw(hlog);

our $VERSION = '0.000007'; # TRIAL

use parent 'Build::Hopen::Scope';

use Build::Hopen::Arrrgs;
use Set::Scalar;

# Docs {{{1

=head1 NAME

Build::Hopen::Scope::Environment - a Build::Hopen::Scope of %ENV

=head1 SYNOPSIS

This is a thin wrapper around C<%ENV>, implemented as a
L.  It only supports one set of data
(L), which is named C<0> for consistency
with L.

=head1 METHODS

=cut

# }}}1

### Protected functions ###

# Don't support -set, but permit `-set=>0` for the sake of code calling
# through the Scope interface.  Call as `_set0($set)`.
# Returns truthy of OK, falsy if not.
# Better a readily-obvious crash than a subtle bug!
sub _set0 {
    $_[0] //= 0;    # Give the caller a default set
    my $set = shift;
    return false if defined($set) && $set ne '0' && $set ne '*';
    return true;
} #_set0()

=head2 _find_here

Find a named data item in C<%ENV> and return it.  Returns undef on
failure.

=cut

sub _find_here {
    my ($self, %args) = parameters('self', [qw(name ; set)], @_);
    _set0 $args{set} or croak 'I only support set 0';
    my $val = $ENV{$args{name}};
    return undef unless defined $val;
    return ($args{set} eq '*') ? { 0 => $val } : $val;
} #_find_here()

=head2 add

Updates the corresponding environment variables, in order, by setting C<$ENV{}>.
Returns the instance.

=cut

sub add {
    my $self = shift;
    croak "Got an odd number of parameters" if @_%2;
    while(@_) {
        my $k = shift;
        $ENV{$k} = shift;
    }
    return $self;
} #add()

=head2 _names_here

Add the names in C<%ENV> to the given L.

=cut

sub _names_here {
    my ($self, %args) = parameters('self', [qw(retval ; set)], @_);
    _set0 $args{set} or croak 'I only support set 0';
    $args{retval}->insert(keys %ENV);
    hlog { __PACKAGE__ . '::_names_here', Dumper $args{retval} };
} #_names_here()

1;
__END__