1N/Apackage Env;
1N/A
1N/Aour $VERSION = '1.00';
1N/A
1N/A=head1 NAME
1N/A
1N/AEnv - perl module that imports environment variables as scalars or arrays
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use Env;
1N/A use Env qw(PATH HOME TERM);
1N/A use Env qw($SHELL @LD_LIBRARY_PATH);
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/APerl maintains environment variables in a special hash named C<%ENV>. For
1N/Awhen this access method is inconvenient, the Perl module C<Env> allows
1N/Aenvironment variables to be treated as scalar or array variables.
1N/A
1N/AThe C<Env::import()> function ties environment variables with suitable
1N/Anames to global Perl variables with the same names. By default it
1N/Aties all existing environment variables (C<keys %ENV>) to scalars. If
1N/Athe C<import> function receives arguments, it takes them to be a list of
1N/Avariables to tie; it's okay if they don't yet exist. The scalar type
1N/Aprefix '$' is inferred for any element of this list not prefixed by '$'
1N/Aor '@'. Arrays are implemented in terms of C<split> and C<join>, using
1N/AC<$Config::Config{path_sep}> as the delimiter.
1N/A
1N/AAfter an environment variable is tied, merely use it like a normal variable.
1N/AYou may access its value
1N/A
1N/A @path = split(/:/, $PATH);
1N/A print join("\n", @LD_LIBRARY_PATH), "\n";
1N/A
1N/Aor modify it
1N/A
1N/A $PATH .= ":.";
1N/A push @LD_LIBRARY_PATH, $dir;
1N/A
1N/Ahowever you'd like. Bear in mind, however, that each access to a tied array
1N/Avariable requires splitting the environment variable's string anew.
1N/A
1N/AThe code:
1N/A
1N/A use Env qw(@PATH);
1N/A push @PATH, '.';
1N/A
1N/Ais equivalent to:
1N/A
1N/A use Env qw(PATH);
1N/A $PATH .= ":.";
1N/A
1N/Aexcept that if C<$ENV{PATH}> started out empty, the second approach leaves
1N/Ait with the (odd) value "C<:.>", but the first approach leaves it with "C<.>".
1N/A
1N/ATo remove a tied environment variable from
1N/Athe environment, assign it the undefined value
1N/A
1N/A undef $PATH;
1N/A undef @LD_LIBRARY_PATH;
1N/A
1N/A=head1 LIMITATIONS
1N/A
1N/AOn VMS systems, arrays tied to environment variables are read-only. Attempting
1N/Ato change anything will cause a warning.
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AChip Salzenberg E<lt>F<chip@fin.uucp>E<gt>
1N/Aand
1N/AGregor N. Purdy E<lt>F<gregor@focusresearch.com>E<gt>
1N/A
1N/A=cut
1N/A
1N/Asub import {
1N/A my ($callpack) = caller(0);
1N/A my $pack = shift;
1N/A my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
1N/A return unless @vars;
1N/A
1N/A @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars;
1N/A
1N/A eval "package $callpack; use vars qw(" . join(' ', @vars) . ")";
1N/A die $@ if $@;
1N/A foreach (@vars) {
1N/A my ($type, $name) = m/^([\$\@])(.*)$/;
1N/A if ($type eq '$') {
1N/A tie ${"${callpack}::$name"}, Env, $name;
1N/A } else {
1N/A if ($^O eq 'VMS') {
1N/A tie @{"${callpack}::$name"}, Env::Array::VMS, $name;
1N/A } else {
1N/A tie @{"${callpack}::$name"}, Env::Array, $name;
1N/A }
1N/A }
1N/A }
1N/A}
1N/A
1N/Asub TIESCALAR {
1N/A bless \($_[1]);
1N/A}
1N/A
1N/Asub FETCH {
1N/A my ($self) = @_;
1N/A $ENV{$$self};
1N/A}
1N/A
1N/Asub STORE {
1N/A my ($self, $value) = @_;
1N/A if (defined($value)) {
1N/A $ENV{$$self} = $value;
1N/A } else {
1N/A delete $ENV{$$self};
1N/A }
1N/A}
1N/A
1N/A######################################################################
1N/A
1N/Apackage Env::Array;
1N/A
1N/Ause Config;
1N/Ause Tie::Array;
1N/A
1N/A@ISA = qw(Tie::Array);
1N/A
1N/Amy $sep = $Config::Config{path_sep};
1N/A
1N/Asub TIEARRAY {
1N/A bless \($_[1]);
1N/A}
1N/A
1N/Asub FETCHSIZE {
1N/A my ($self) = @_;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A return scalar(@temp);
1N/A}
1N/A
1N/Asub STORESIZE {
1N/A my ($self, $size) = @_;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A $#temp = $size - 1;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A}
1N/A
1N/Asub CLEAR {
1N/A my ($self) = @_;
1N/A $ENV{$$self} = '';
1N/A}
1N/A
1N/Asub FETCH {
1N/A my ($self, $index) = @_;
1N/A return (split($sep, $ENV{$$self}))[$index];
1N/A}
1N/A
1N/Asub STORE {
1N/A my ($self, $index, $value) = @_;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A $temp[$index] = $value;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return $value;
1N/A}
1N/A
1N/Asub PUSH {
1N/A my $self = shift;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A push @temp, @_;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return scalar(@temp);
1N/A}
1N/A
1N/Asub POP {
1N/A my ($self) = @_;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A my $result = pop @temp;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return $result;
1N/A}
1N/A
1N/Asub UNSHIFT {
1N/A my $self = shift;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A my $result = unshift @temp, @_;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return $result;
1N/A}
1N/A
1N/Asub SHIFT {
1N/A my ($self) = @_;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A my $result = shift @temp;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return $result;
1N/A}
1N/A
1N/Asub SPLICE {
1N/A my $self = shift;
1N/A my $offset = shift;
1N/A my $length = shift;
1N/A my @temp = split($sep, $ENV{$$self});
1N/A if (wantarray) {
1N/A my @result = splice @temp, $self, $offset, $length, @_;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return @result;
1N/A } else {
1N/A my $result = scalar splice @temp, $offset, $length, @_;
1N/A $ENV{$$self} = join($sep, @temp);
1N/A return $result;
1N/A }
1N/A}
1N/A
1N/A######################################################################
1N/A
1N/Apackage Env::Array::VMS;
1N/Ause Tie::Array;
1N/A
1N/A@ISA = qw(Tie::Array);
1N/A
1N/Asub TIEARRAY {
1N/A bless \($_[1]);
1N/A}
1N/A
1N/Asub FETCHSIZE {
1N/A my ($self) = @_;
1N/A my $i = 0;
1N/A while ($i < 127 and defined $ENV{$$self . ';' . $i}) { $i++; };
1N/A return $i;
1N/A}
1N/A
1N/Asub FETCH {
1N/A my ($self, $index) = @_;
1N/A return $ENV{$$self . ';' . $index};
1N/A}
1N/A
1N/A1;