view release on metacpan or  search on metacpan

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

#    * 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;
        App::Env::_Util::croak( __PACKAGE__, "->import: too many arguments\n" )
          if @_;

        $ENV{$_} = $self->{$_} for keys %$self;    ## no critic (Variables::RequireLocalizedPunctuationVars)
    }

    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( my $app = App::Env::_Util::getCacheEntry( $cacheid ) ) ) {
        $self = __PACKAGE__->new();
        $self->_var( app => $app );
    }

    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;
            App::Env::_Util::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} ) {
                        App::Env::_Util::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 ( @app_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( @app_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} && defined( my $app = App::Env::_Util::getCacheEntry( $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( $app );

            # 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 = $app;
        }
    }

    # 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 };    ## no critic (Variables::RequireLocalizedPunctuationVars)
        }

        $App = App::Env::_app->new(

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

    ${$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 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 ) {