view release on metacpan or  search on metacpan

lib/App/Env.pm  view on Meta::CPAN

sub module   { $_[0]->_app->module }
sub cacheid  { $_[0]->_app->cacheid }
sub _cacheid { my $self = shift; $self->app->cacheid( @_ ) }
sub _opt {
    my $self = shift;
    $self->_app->opt( @_ );
}
sub _app     { $_[0]->_var( 'app' ) }
sub _envhash { $_[0]->_app->{ENV} }

# would rather use Object::ID but it uses Hash::FieldHash which
# (through no fault of its own:
# http://rt.cpan.org/Ticket/Display.html?id=58030 ) stringify's the
# passed reference on pre 5.10 perls, which causes problems.

# stolen as much as possible from Object::ID to keep the interface the same
{
    my $Last_ID = 'a';

    sub lobject_id {
        my $self = shift;

        return $self->_var( 'id' ) if defined $self->_var( 'id' );
        return $self->_var( 'id', ++$Last_ID );
    }
}

#-------------------------------------------------------

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

    defined $cache
      or App::Env::_Util::croak( "missing or undefined cache argument\n" );

    if ( $cache ) {
        $self->_app->cache;
    }
    else {
        $self->_app->uncache;
    }
}

sub uncache {
    goto \&App::Env::_Util::uncache;
}


#-------------------------------------------------------

sub env {
    my $self = shift;
    my @opts = ( 'HASH' eq ref $_[-1] ? pop : {} );

    # mostly a duplicate of what's in str(). ick.
    my %opt = Params::Validate::validate(
        @opts,
        {
            Exclude => {
                callbacks => { 'type' => \&App::Env::_Util::exclude_param_check },
                default   => undef,
            },
            AllowIllegalVariableNames => {
                optional => 1,
                default  => !!1,
            },
        } );

    # Exclude is only allowed in scalar calling context where
    # @_ is empty, has more than one element, or the first element
    # is not a scalar.
    App::Env::_Util::croak( "Cannot use Exclude in this calling context\n" )
      if $opt{Exclude} && ( wantarray() || ( @_ == 1 && !ref $_[0] ) );    ## no critic (Community::Wantarray)

    my $include = [ @_ ? @_ : qr/.*/ ];
    my $env     = $self->_envhash;

    my @exclude
      = defined( $opt{Exclude} )
      ? ( 'ARRAY' eq ref $opt{Exclude} ? @{ $opt{Exclude} } : ( $opt{Exclude} ) )
      : ();

    # exclude any variables with non-word characters
    push @exclude, qr/\W/
      unless $opt{AllowIllegalVariableNames};

    my @vars = $self->_filter_env( $include, \@exclude );

    if ( wantarray() ) {    ## no critic (Community::Wantarray)
        return map { exists $env->{$_} ? $env->{$_} : undef } @vars;
    }
    elsif ( @_ == 1 && !ref $_[0] ) {
        return @vars && exists $env->{ $vars[0] } ? $env->{ $vars[0] } : undef;
    }
    else {
        my %env;
        @env{@vars} = map { exists $env->{$_} ? $env->{$_} : undef } @vars;
        return \%env;
    }
}

#-------------------------------------------------------

sub setenv {
    my $self = shift;
    my $var  = shift;

    defined $var
      or App::Env::_Util::croak( "missing variable name argument\n" );

    if ( @_ ) {
        $self->_envhash->{$var} = $_[0];
    }
    else {
        delete $self->_envhash->{$var};
    }
}

#-------------------------------------------------------

# return an env compatible string
sub str {
    my $self = shift;
    my @opts = ( 'HASH' eq ref $_[-1] ? pop : {} );

    # validate type.  Params::Validate doesn't do Regexp, so
    # this is a bit messy.
    my %opt = Params::Validate::validate(
        @opts,
        {
            Exclude => {
                callbacks => { 'type' => \&App::Env::_Util::exclude_param_check },
                optional  => 1,
            },
            AllowIllegalVariableNames => {
                optional => 1,
                default  => !!0,
            },
        } );

    my $include = [ @_ ? @_ : qr/.*/ ];
    my @exclude
      = defined( $opt{Exclude} )
      ? ( 'ARRAY' eq ref $opt{Exclude} ? @{ $opt{Exclude} } : ( $opt{Exclude} ) )
      : ();

    push @exclude, 'TERMCAP'
      if List::Util::none { $_ eq 'TERMCAP' } @$include;

    # exclude any variables with non-word characters
    push @exclude, qr/\W/
      unless $opt{AllowIllegalVariableNames};

    my $env  = $self->_envhash;
    my @vars = grep { exists $env->{$_} } $self->_filter_env( $include, \@exclude );
    return join( q{ }, map { "$_=" . App::Env::_Util::shell_escape( $env->{$_} ) } @vars );
}

#-------------------------------------------------------

# return a list of included variables, in the requested
# order, based upon a list of include and exclude specs.
# variable names  passed as plain strings are not checked
# for existance in the environment.
sub _filter_env {
    my ( $self, $included, $excluded ) = @_;

    my @exclude = $self->_match_var( $excluded );

    my %exclude = map { $_ => 1 } @exclude;
    return grep { !$exclude{$_} } $self->_match_var( $included );
}

#-------------------------------------------------------

# return a list of variables which matched the specifications.
# this takes a list of scalars, coderefs, or regular expressions.
# variable names  passed as plain strings are not checked
# for existance in the environment.
sub _match_var {
    my ( $self, $match ) = @_;

    my $env = $self->_envhash;

    $match = [$match] unless 'ARRAY' eq ref $match;

    my @keys;
    for my $spec ( @$match ) {
        next unless defined $spec;

        ## no critic( ControlStructures::ProhibitCascadingIfElse)
        if ( !ref $spec ) {