File Coverage

blib/lib/App/Env.pm

Criterion	Covered	Total	%
statement	366	376	97.3
branch	162	192	84.3
condition	48	59	81.3
subroutine	55	58	94.8
pod	17	17	100.0
total	648	702	92.3

package App::Env;

# ABSTRACT: manage application specific environments

use 5.00800;
use strict;
use warnings;

use Scalar::Util;
use Storable ();

use Params::Validate ();

# need to distinguish between a non-existent module
# and one which has compile errors.
use Module::Find qw( );

our $VERSION = '1.01';

use overload
  '%{}'    => '_envhash',
  '""'     => 'str',
  fallback => 1;

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

sub _croak {
    require Carp;
    goto &Carp::croak;
}

my %existsModule;

sub _loadModuleList {
    %existsModule = ();

    for my $path ( Module::Find::findallmod( 'App::Env' ) ) {
        # greedy match picks up full part of path
        my ( $base, $app ) = $path =~ /^(.*)::(.*)/;

        # store lowercased module
        $existsModule{ $base . '::' . lc $app } = $path;
    }

    return;
}

sub _existsModule {
    my ( $path ) = @_;

    # reconstruct path with lowercased application name.
    # greedy match picks up full part of path
    my ( $base, $app ) = $path =~ /^(.*)::(.*)/;
    $path = $base . '::' . lc $app;

    # (re)load cache if we can't find the module in the list
    _loadModuleList
      unless $existsModule{$path};

    # really check
    return $existsModule{$path};
}

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

# allow site specific site definition
use constant APP_ENV_SITE => do {
    if ( !exists $ENV{APP_ENV_SITE} && _existsModule( 'App::Env::Site' ) ) {
        eval { require App::Env::Site };
        _croak( ref $@ ? $@ : "Error loading App::Env::Site: $@\n" ) if $@;
    }

    # only use the environment variable if defined and not empty.
    defined $ENV{APP_ENV_SITE}
      && length $ENV{APP_ENV_SITE} ? $ENV{APP_ENV_SITE} : undef;
};

# _App_Env_Site ( [$alt_site] );
# if $alt_site is non-empty, return it.
# if $alt_site is empty or undefined return ().
# otherwise return APP_ENV_SITE
sub _App_Env_Site {

    @_ || return APP_ENV_SITE;

    my $site = shift;

    return () if !defined $site || $site eq '';
    return $site;

# _croak( "Environment variable APP_ENV_SITE is only obeyed at the time that ${ \__PACKAGE__ } is loaded" )
#   if ( defined( APP_ENV_SITE ) xor defined $ENV{APP_ENV_SITE} )
#   || ( defined( APP_ENV_SITE ) && defined $ENV{APP_ENV_SITE} && APP_ENV_SITE ne $ENV{APP_ENV_SITE} );
}

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

# Options
my %SharedOptions = (
    Force    => { default  => 0 },
    Cache    => { default  => 1 },
    Site     => { optional => 1 },
    CacheID  => { default  => undef },
    Temp     => { default  => 0 },
    SysFatal => { default  => 0, type => Params::Validate::BOOLEAN },
);

my %ApplicationOptions = (
    AppOpts => { default => {}, type => Params::Validate::HASHREF },
    %SharedOptions,
);

my %CloneOptions = %{
    Storable::dclone(
        { map { $_ => $SharedOptions{$_} } qw[ CacheID Cache SysFatal ] } ) };
$CloneOptions{Cache}{default} = 0;

my %TempOptions = %{
    Storable::dclone(
        { map { $_ => $SharedOptions{$_} } qw[ SysFatal Temp ] } ) };

# options for whom defaults may be changed.  The values
# in %OptionDefaults are references to the same hashes as in
# ApplicationOptions & SharedOptions, so modifying them will
# modify the others.
my @OptionDefaults = qw( Force Cache Site SysFatal );
my %OptionDefaults;
@OptionDefaults{@OptionDefaults} = @ApplicationOptions{@OptionDefaults};

# environment cache
our %EnvCache;

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


# import one or more environments.  this may be called in the following
# contexts:
#
#    * as a class method, i.e.
#       use App:Env qw( application )
#       App:Env->import( $application )
#
#    * as a class function (just so as not to confuse folks
#       App::Env::import( $application )
#
#    * as an object method
#       $env->import

sub import {

    my $this = $_[0];

    # object method?
    if ( Scalar::Util::blessed $this && $this->isa( __PACKAGE__ ) ) {
        my $self = shift;
        _croak( __PACKAGE__, "->import: too many arguments\n" )
          if @_;

        while ( my ( $key, $value ) = each %{$self} ) {
            $ENV{$key} = $value;
        }
    }

    else {

        # if class method, get rid of class in argument list
        shift if !ref $this && $this eq __PACKAGE__;

        # if no arguments, nothing to do.  "use App::Env;" will cause this.
        return unless @_;

        # if the only argument is a hash, it sets defaults
        if ( @_ == 1 && 'HASH' eq ref $_[0] ) {
            config( @_ );
            return;
        }

        App::Env->new( @_ )->import;
    }
}


# class method
# retrieve a cached environment.
sub retrieve {

    my ( $cacheid ) = @_;
    my $self;

    if ( defined $EnvCache{$cacheid} ) {
        $self = __PACKAGE__->new();
        $self->_var( app => $EnvCache{$cacheid} );
    }

    return $self;
}

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

sub config {
    my %default = Params::Validate::validate( @_, \%OptionDefaults );
    $OptionDefaults{$_}{default} = $default{$_} for keys %default;
    return;
}

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

sub new {
    my $class = shift;

    my $opts = 'HASH' eq ref $_[-1] ? pop : {};

    # %{} is overloaded, so an extra reference is required to avoid
    # an infinite loop when doing things like $self->{}.  instead,
    # use $$self->{}
    my $self = bless \{}, $class;

    $self->_load_envs( @_, $opts ) if @_;

    return $self;
}

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

sub clone {
    my $self = shift;

    my %nopt = Params::Validate::validate( @_, \%CloneOptions );

    my $clone = Storable::dclone( $self );
    delete ${$clone}->{id};

    # create new cache id
    $clone->_app->mk_cacheid(
        CacheID => defined $nopt{CacheID}
        ? $nopt{CacheID}
        : $self->lobject_id
    );

    my %opt = ( %{ $clone->_opt }, %nopt );
    $clone->_opt( \%opt );

    $clone->cache( $opt{Cache} );

    return $clone;
}

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

sub _load_envs {
    my $self = shift;
    my @opts = ( pop );
    my @apps = @_;

    # most of the following logic is for the case where multiple applications
    # are being loaded in one call.  Checking caching requires that we generate
    # a cacheid from the applications' cacheids.

    # if import is called as import( [$app, \%opts], \%shared_opts ),
    # this is equivalent to import( $app, { %shared_opts, %opts } ),
    # but we still validate %shared_opts as SharedOptions, just to be
    # precise.

    # if there's a single application passed as a scalar (rather than
    # an array containing the app name and options), treat @opts as
    # ApplicationOptions, else SharedOptions

    my %opts = Params::Validate::validate( @opts,
        @apps == 1 && !ref( $apps[0] )
        ? \%ApplicationOptions
        : \%SharedOptions );


    $opts{Cache} = 0 if $opts{Temp};

    # iterate through the applications to ensure that any application specific
    # options are valid and to form a basis for a multi-application
    # cacheid to check for cacheing.
    my @cacheids;
    my @Apps;
    for my $app ( @apps ) {
        # initialize the application specific opts from the shared opts
        my %app_opt = %opts;

        # special filtering of options if this is part of a multi-app
        # merge
        if ( @apps > 1 ) {
            # don't use the shared CacheID option
            delete $app_opt{CacheID};

            # don't cache individual apps in a merged environment,
            # as the cached environments will be polluted.
            delete $app_opt{Cache};

            # ignore a Force option.  This will be turned on later;
            # if set now it will prevent proper error checking
            delete $app_opt{Force};
        }

        # handle application specific options.
        if ( 'ARRAY' eq ref( $app ) ) {
            ( $app, my $opts ) = @$app;
            _croak( "$app: application options must be a hashref\n" )
              unless 'HASH' eq ref $opts;

            %app_opt = ( %app_opt, %$opts );

            if ( @apps > 1 ) {
                for my $iopt ( qw( Cache Force ) ) {
                    if ( exists $app_opt{$iopt} ) {
                        _croak(
                            "$app: do not specify the $iopt option for individual applications in a merge\n"
                        );
                        delete $app_opt{$iopt};
                    }
                }
            }
        }

        # set forced options for apps in multi-app merges, otherwise
        # the defaults will be set by the call to validate below.
        if ( @apps > 1 ) {
            $app_opt{Force} = 1;
            $app_opt{Cache} = 0;
        }

        # validate possible application options and get default
        # values. Params::Validate wants a real array
        my ( @opts ) = %app_opt;

        # return an environment object, but don't load it. we need the
        # module name to create a cacheid for the merged environment.
        # don't load now to prevent unnecessary loading of uncached
        # environments if later it turns out this is a cached
        # multi-application environment
        %app_opt
          = ( Params::Validate::validate( @opts, \%ApplicationOptions ) );
        my $appo = App::Env::_app->new(
            pid    => $self->lobject_id,
            app    => $app,
            NoLoad => 1,
            opt    => \%app_opt
        );
        push @cacheids, $appo->cacheid;
        push @Apps,     $appo;
    }


    # create a cacheid for the multi-app environment
    my $cacheid = $opts{CacheId} || join( $;, @cacheids );
    my $App;

    # use cache if possible
    if ( !$opts{Force} && exists $EnvCache{$cacheid} ) {
        # if this is a temporary object and a cached version exists,
        # clone it and assign a new cache id.
        if ( $opts{Temp} ) {
            $App = Storable::dclone( $EnvCache{$cacheid} );

            # should really call $self->cacheid here, but $self
            # doesn't have an app attached to it yet so that'll fail.
            $App->cacheid( $self->lobject_id );

            # update Temp compatible options
            $App->_opt(
                { %{ $App->_opt }, map { $_ => $opts{$_} } keys %TempOptions }
            );
        }

        else {
            $App = $EnvCache{$cacheid};
        }
    }

    # not cached; is this really just a single application?
    elsif ( @Apps == 1 ) {
        $App = shift @Apps;
        $App->load;
    }

    # ok, create new environment by iteration through the apps
    else {
        # we don't want to merge environments, as apps may
        # modify a variable that we don't know how to merge.
        # PATH is easy, but we have no idea what might be in
        # others.  so, let the apps handle it.

        # apps get loaded in the current environment.
        local %ENV = %ENV;

        my @modules;
        foreach my $app ( @Apps ) {
            push @modules, $app->module;

            # embrace new merged environment
            %ENV = %{ $app->load };
        }

        $App = App::Env::_app->new(
            ref     => $self,
            env     => {%ENV},
            module  => join( $;, @modules ),
            cacheid => $cacheid,
            opt     => \%opts,
        );

        if ( $opts{Cache} ) { $App->cache; }
    }

    # record the final things we need to know.
    $self->_var( app => $App );
}


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

# simple accessors to reduce confusion because of double reference in $self

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

    ${$self}->{$var} = shift if @_;

    return ${$self}->{$var};
}

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 _croak( "missing or undefined cache argument\n" );

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

sub uncache {
    my %opt = Params::Validate::validate(
        @_,
        {
            All     => { default  => undef, type => Params::Validate::SCALAR },
            App     => { default  => undef, type => Params::Validate::SCALAR },
            Site    => { optional => 1,     type => Params::Validate::SCALAR },
            CacheID => { default  => undef, type => Params::Validate::SCALAR },
        } );

    if ( $opt{All} ) {
        delete $opt{All};
        _croak( "can't specify All option with other options\n" )
          if grep { defined $_ } values %opt;

        delete $EnvCache{$_} foreach keys %EnvCache;
    }

    elsif ( defined $opt{CacheID} ) {
        my $cacheid = delete $opt{CacheID};
        _croak( "can't specify CacheID option with other options\n" )
          if grep { defined $_ } values %opt;

        delete $EnvCache{$cacheid};
    }
    else {
        _croak( "must specify App or CacheID options\n" )
          unless defined $opt{App};

        # don't use normal rules for Site specification as we're trying
        # to delete a specific one.
        delete $EnvCache{
            _modulename(
                _App_Env_Site( exists $opt{Site} ? ( $opt{Site} ) : () ),
                $opt{App} ) };
    }

    return;
}

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

sub _modulename {
    return join( '::', 'App::Env', grep { defined $_ } @_ );
}


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

# construct a module name based upon the current or requested site.
# requires the module if found.  returns the module name if module is
# found, false if not, die's if require fails

sub _require_module {
    my ( $app, %par ) = @_;

    my $app_opts = $par{app_opts} ||= {};
    my $loop     = $par{loop}     ||= 1;

    _croak( "too many alias loops for $app\n" )
      if $loop == 10;

    my @sites = _App_Env_Site( exists $par{site} ? $par{site} : () );

    # check possible sites, in turn.
    my ( $module )
      = grep { defined $_ }
      ( map { _existsModule( _modulename( $_, $app ) ) } @sites ),
      _existsModule( _modulename( $app ) );

    if ( defined $module ) {
        ## no critic ( ProhibitStringyEval );
        eval "require $module"
          or _croak $@;

        # see if this is an alias
        if ( my $alias = $module->can( 'alias' ) ) {
            ( $app, my $napp_opts ) = $alias->();
            @{$app_opts}{ keys %$napp_opts } = @{$napp_opts}{ keys %$napp_opts }
              if $napp_opts;
            return _require_module(
                $app, %par,
                loop     => ++$loop,
                app_opts => $app_opts
            );
        }
    }

    else {
        return;
    }

    return ( $module, $app_opts );
}

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

sub _exclude_param_check {
    !ref $_[0]
      || 'ARRAY' eq ref $_[0]
      || 'Regexp' eq ref $_[0]
      || 'CODE' eq ref $_[0];
}

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

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' => \&_exclude_param_check },
                default   => undef
            },
        } );

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


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

    my @vars = $self->_filter_env( $include, $opt{Exclude} );

    ## no critic ( ProhibitAccessOfPrivateData )
    if ( wantarray() ) {
        return map { exists $env->{$_} ? $env->{$_} : undef } @vars;
    }
    elsif ( @_ == 1 && !ref $_[0] ) {
        return 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 _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' => \&_exclude_param_check },
                optional  => 1
            },
        } );

    my $include = [ @_ ? @_ : qr/.*/ ];

    if ( !grep { $_ eq 'TERMCAP' } @$include ) {
        $opt{Exclude} ||= [];
        $opt{Exclude} = [ $opt{Exclude} ] unless 'ARRAY' eq ref $opt{Exclude};
        push @{ $opt{Exclude} }, 'TERMCAP';
    }

    my $env = $self->_envhash;
    ## no critic ( ProhibitAccessOfPrivateData )
    my @vars = grep { exists $env->{$_} }
      $self->_filter_env( $include, $opt{Exclude} );
    return join( ' ', map { "$_=" . _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;

        if ( !ref $spec ) {
            # always return a plain name.  this allows
            #   @values = $env->env( @names) to work.
            push @keys, $spec;
        }
        elsif ( 'Regexp' eq ref $spec ) {
            push @keys, grep { /$spec/ } keys %$env;
        }
        elsif ( 'CODE' eq ref $spec ) {
            ## no critic ( ProhibitAccessOfPrivateData )
            push @keys, grep { $spec->( $_, $env->{$_} ) } keys %$env;
        }
        else {
            _croak( "match specification is of unsupported type: ",
                ref $spec, "\n" );
        }
    }

    return @keys;
}

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


sub _shell_escape {
    my $str = shift;

    # empty string
    if ( $str eq '' ) {
        $str = "''";
    }

    # otherwise, escape all but the "known" non-magic characters.
    else {
        $str =~ s{([^\w/.:=\-+%])}{\\$1}go;
    }

    $str;
}

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

sub system {
    my $self = shift;

    local %ENV = %{$self};
    if ( $self->_opt->{SysFatal} ) {
        require IPC::System::Simple;
        return IPC::System::Simple::system( @_ );
    }
    else {
        return CORE::system( @_ );
    }
}

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

sub qexec {
    my $self = shift;
    local %ENV = %{$self};

    require IPC::System::Simple;

    my ( @res, $res );

    if ( wantarray ) {
        @res = eval { IPC::System::Simple::capture( @_ ) }
    }
    else {
        $res = eval { IPC::System::Simple::capture( @_ ) }
    }

    if ( $@ ne '' ) {
        _croak( $@ ) if $self->_opt->{SysFatal};
        return;
    }

    return wantarray ? @res : $res;
}

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

sub capture {
    my $self = shift;
    my @args = @_;

    local %ENV = %{$self};

    require Capture::Tiny;
    require IPC::System::Simple;

    my $sub
      = $self->_opt->{SysFatal}
      ? sub { IPC::System::Simple::system( @args ) }
      : sub { CORE::system( @args ) };

    my ( $stdout, $stderr );

    # Capture::Tiny::capture is prototyped as (&;@). App::Env
    # lazy-loads Capture::Tiny and thus nominally avoids the prototype
    # check. However, if Capture::Tiny is explicitly loaded prior to
    # App::Env, the prototype check will be performed when App::Env is
    # compiled.  In that case the following calls to capture are
    # singled out, as while the calls are correct, the prototype
    # requires an explicit block or sub{}.  So, explicitly
    # ignore prototypes.

    if ( wantarray ) {
        ( $stdout, $stderr ) = eval { &Capture::Tiny::capture( $sub ) };

    }
    else {
        $stdout = eval { &Capture::Tiny::capture( $sub ) };
    }

    _croak( $@ ) if $@ ne '';

    return wantarray ? ( $stdout, $stderr ) : $stdout;
}

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

sub exec {
    my $self = shift;

    local %ENV = %{$self};
    exec( @_ );
}


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

sub which {
    require File::Which;
    my $self = shift;

    {
        local %ENV = %{$self};
        return File::Which::which( @_ );
    }
}

###############################################
###############################################

package App::Env::_app;

use Carp();
use Storable ();
use Digest;

use strict;
use warnings;

# new( pid => $pid, app => $app, opt => \%opt )
# new( pid => $pid, env => \%env, module => $module, cacheid => $cacheid )
sub new {
    my ( $class, %opt ) = @_;

    # make copy of options
    my $self = bless Storable::dclone( \%opt ), $class;

    if ( exists $self->{env} ) {
        $self->{opt} = {} unless defined $self->{opt};
        $self->{ENV} = delete $self->{env};
    }
    else {

        ( $self->{module}, my $app_opts ) = eval {
            App::Env::_require_module(
                $self->{app},
                (
                    exists $self->{opt}{Site}
                    ? ( site => $self->{opt}{Site} )
                    : () ) );
        };

        _croak(
            ref $@
            ? $@
            : "error loading application environment module for $self->{app}:\n",
            $@
        ) if $@;

        _croak(
            "application environment module for $self->{app} does not exist\n" )
          unless defined $self->{module};

        # merge possible alias AppOpts
        $self->{opt}{AppOpts} ||= {};
        $self->{opt}{AppOpts} = { %$app_opts, %{ $self->{opt}{AppOpts} } };

        $self->mk_cacheid;
    }

    # return cached entry if possible
    if ( exists $App::Env::EnvCache{ $self->cacheid } && !$opt{opt}{Force} ) {
        $self = $App::Env::EnvCache{ $self->cacheid };
    }

    else {
        $self->load unless $self->{NoLoad};
        delete $self->{NoLoad};
    }

    return $self;
}

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

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

    $cacheid = $self->{opt}{CacheID} unless defined $cacheid;

    my @elements;

    if ( defined $cacheid ) {
        push @elements, $cacheid eq 'AppID' ? $self->{module} : $cacheid;
    }
    else {
        # create a hash of unique stuff which will be folded
        # into the cacheid
        my %uniq;
        $uniq{AppOpts} = $self->{opt}{AppOpts}
          if defined $self->{opt}{AppOpts} && keys %{ $self->{opt}{AppOpts} };

        my $digest;

        if ( keys %uniq ) {
            local $Storable::canonical = 1;
            $digest = Storable::freeze( \%uniq );

            # use whatever digest aglorithm we can find.  if none is
            # found, default to the frozen representation of the
            # options
            for my $alg ( qw[ SHA-256 SHA-1 MD5 ] ) {
                my $ctx = eval { Digest->new( $alg ) };

                if ( defined $ctx ) {
                    $digest = $ctx->add( $digest )->digest;
                    last;
                }
            }
        }
        push @elements, $self->{module}, $digest;
    }

    $self->cacheid( join( $;, grep { defined $_ } @elements ) );
}


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

sub load {
    my ( $self ) = @_;

    # only load if we haven't before
    return $self->{ENV} if exists $self->{ENV};

    my $module = $self->module;

    my $envs;
    my $fenvs = $module->can( 'envs' );

    _croak( "$module does not have an 'envs' function\n" )
      unless $fenvs;

    $envs = eval { $fenvs->( $self->{opt}{AppOpts} ) };

    _croak( ref $@ ? $@ : "error in ${module}::envs: $@\n" )
      if $@;

    # make copy of environment
    $self->{ENV} = { %{$envs} };

    # cache it
    $self->cache if $self->{opt}{Cache};

    return $self->{ENV};
}

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

sub cache {
    my ( $self ) = @_;
    $App::Env::EnvCache{ $self->cacheid } = $self;
}

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

sub uncache {
    my ( $self ) = @_;
    my $cacheid = $self->cacheid;

    delete $App::Env::EnvCache{$cacheid}
      if exists $App::Env::EnvCache{$cacheid}
      && $App::Env::EnvCache{$cacheid}{pid} eq $self->{pid};
}

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

sub _opt    { @_ > 1 ? $_[0]->{opt}     = $_[1] : $_[0]->{opt} }
sub cacheid { @_ > 1 ? $_[0]->{cacheid} = $_[1] : $_[0]->{cacheid} }
sub module  { $_[0]->{module} }

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

1;

#
# This file is part of App-Env
#
# This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

__END__