From 41e13b7c97391e529c57ed40083c910e3b9f3951 Mon Sep 17 00:00:00 2001 From: Florian Ragwitz Date: Fri, 10 Dec 2010 22:02:52 +0100 Subject: Dual-life Env --- lib/Env.pm | 254 ------------------------------------------------------------- 1 file changed, 254 deletions(-) delete mode 100644 lib/Env.pm (limited to 'lib/Env.pm') diff --git a/lib/Env.pm b/lib/Env.pm deleted file mode 100644 index deac5fc4b9..0000000000 --- a/lib/Env.pm +++ /dev/null @@ -1,254 +0,0 @@ -package Env; - -our $VERSION = '1.01'; - -=head1 NAME - -Env - perl module that imports environment variables as scalars or arrays - -=head1 SYNOPSIS - - use Env; - use Env qw(PATH HOME TERM); - use Env qw($SHELL @LD_LIBRARY_PATH); - -=head1 DESCRIPTION - -Perl maintains environment variables in a special hash named C<%ENV>. For -when this access method is inconvenient, the Perl module C allows -environment variables to be treated as scalar or array variables. - -The C function ties environment variables with suitable -names to global Perl variables with the same names. By default it -ties all existing environment variables (C) to scalars. If -the C function receives arguments, it takes them to be a list of -variables to tie; it's okay if they don't yet exist. The scalar type -prefix '$' is inferred for any element of this list not prefixed by '$' -or '@'. Arrays are implemented in terms of C and C, using -C<$Config::Config{path_sep}> as the delimiter. - -After an environment variable is tied, merely use it like a normal variable. -You may access its value - - @path = split(/:/, $PATH); - print join("\n", @LD_LIBRARY_PATH), "\n"; - -or modify it - - $PATH .= ":."; - push @LD_LIBRARY_PATH, $dir; - -however you'd like. Bear in mind, however, that each access to a tied array -variable requires splitting the environment variable's string anew. - -The code: - - use Env qw(@PATH); - push @PATH, '.'; - -is equivalent to: - - use Env qw(PATH); - $PATH .= ":."; - -except that if C<$ENV{PATH}> started out empty, the second approach leaves -it with the (odd) value "C<:.>", but the first approach leaves it with "C<.>". - -To remove a tied environment variable from -the environment, assign it the undefined value - - undef $PATH; - undef @LD_LIBRARY_PATH; - -=head1 LIMITATIONS - -On VMS systems, arrays tied to environment variables are read-only. Attempting -to change anything will cause a warning. - -=head1 AUTHOR - -Chip Salzenberg EFE -and -Gregor N. Purdy EFE - -=cut - -sub import { - my ($callpack) = caller(0); - my $pack = shift; - my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV)); - return unless @vars; - - @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars; - - eval "package $callpack; use vars qw(" . join(' ', @vars) . ")"; - die $@ if $@; - foreach (@vars) { - my ($type, $name) = m/^([\$\@])(.*)$/; - if ($type eq '$') { - tie ${"${callpack}::$name"}, Env, $name; - } else { - if ($^O eq 'VMS') { - tie @{"${callpack}::$name"}, Env::Array::VMS, $name; - } else { - tie @{"${callpack}::$name"}, Env::Array, $name; - } - } - } -} - -sub TIESCALAR { - bless \($_[1]); -} - -sub FETCH { - my ($self) = @_; - $ENV{$$self}; -} - -sub STORE { - my ($self, $value) = @_; - if (defined($value)) { - $ENV{$$self} = $value; - } else { - delete $ENV{$$self}; - } -} - -###################################################################### - -package Env::Array; - -use Config; -use Tie::Array; - -@ISA = qw(Tie::Array); - -my $sep = $Config::Config{path_sep}; - -sub TIEARRAY { - bless \($_[1]); -} - -sub FETCHSIZE { - my ($self) = @_; - return 1 + scalar(() = $ENV{$$self} =~ /\Q$sep\E/g); -} - -sub STORESIZE { - my ($self, $size) = @_; - my @temp = split($sep, $ENV{$$self}); - $#temp = $size - 1; - $ENV{$$self} = join($sep, @temp); -} - -sub CLEAR { - my ($self) = @_; - $ENV{$$self} = ''; -} - -sub FETCH { - my ($self, $index) = @_; - return (split($sep, $ENV{$$self}))[$index]; -} - -sub STORE { - my ($self, $index, $value) = @_; - my @temp = split($sep, $ENV{$$self}); - $temp[$index] = $value; - $ENV{$$self} = join($sep, @temp); - return $value; -} - -sub EXISTS { - my ($self, $index) = @_; - return $index < $self->FETCHSIZE; -} - -sub DELETE { - my ($self, $index) = @_; - my @temp = split($sep, $ENV{$$self}); - my $value = splice(@temp, $index, 1, ()); - $ENV{$$self} = join($sep, @temp); - return $value; -} - -sub PUSH { - my $self = shift; - my @temp = split($sep, $ENV{$$self}); - push @temp, @_; - $ENV{$$self} = join($sep, @temp); - return scalar(@temp); -} - -sub POP { - my ($self) = @_; - my @temp = split($sep, $ENV{$$self}); - my $result = pop @temp; - $ENV{$$self} = join($sep, @temp); - return $result; -} - -sub UNSHIFT { - my $self = shift; - my @temp = split($sep, $ENV{$$self}); - my $result = unshift @temp, @_; - $ENV{$$self} = join($sep, @temp); - return $result; -} - -sub SHIFT { - my ($self) = @_; - my @temp = split($sep, $ENV{$$self}); - my $result = shift @temp; - $ENV{$$self} = join($sep, @temp); - return $result; -} - -sub SPLICE { - my $self = shift; - my $offset = shift; - my $length = shift; - my @temp = split($sep, $ENV{$$self}); - if (wantarray) { - my @result = splice @temp, $self, $offset, $length, @_; - $ENV{$$self} = join($sep, @temp); - return @result; - } else { - my $result = scalar splice @temp, $offset, $length, @_; - $ENV{$$self} = join($sep, @temp); - return $result; - } -} - -###################################################################### - -package Env::Array::VMS; -use Tie::Array; - -@ISA = qw(Tie::Array); - -sub TIEARRAY { - bless \($_[1]); -} - -sub FETCHSIZE { - my ($self) = @_; - my $i = 0; - while ($i < 127 and defined $ENV{$$self . ';' . $i}) { $i++; }; - return $i; -} - -sub FETCH { - my ($self, $index) = @_; - return $ENV{$$self . ';' . $index}; -} - -sub EXISTS { - my ($self, $index) = @_; - return $index < $self->FETCHSIZE; -} - -sub DELETE { } - -1; -- cgit v1.2.1