1package Env; 2 3our $VERSION = '1.04'; 4 5=head1 NAME 6 7Env - perl module that imports environment variables as scalars or arrays 8 9=head1 SYNOPSIS 10 11 use Env; 12 use Env qw(PATH HOME TERM); 13 use Env qw($SHELL @LD_LIBRARY_PATH); 14 15=head1 DESCRIPTION 16 17Perl maintains environment variables in a special hash named C<%ENV>. For 18when this access method is inconvenient, the Perl module C<Env> allows 19environment variables to be treated as scalar or array variables. 20 21The C<Env::import()> function ties environment variables with suitable 22names to global Perl variables with the same names. By default it 23ties all existing environment variables (C<keys %ENV>) to scalars. If 24the C<import> function receives arguments, it takes them to be a list of 25variables to tie; it's okay if they don't yet exist. The scalar type 26prefix '$' is inferred for any element of this list not prefixed by '$' 27or '@'. Arrays are implemented in terms of C<split> and C<join>, using 28C<$Config::Config{path_sep}> as the delimiter. 29 30After an environment variable is tied, merely use it like a normal variable. 31You may access its value 32 33 @path = split(/:/, $PATH); 34 print join("\n", @LD_LIBRARY_PATH), "\n"; 35 36or modify it 37 38 $PATH .= ":."; 39 push @LD_LIBRARY_PATH, $dir; 40 41however you'd like. Bear in mind, however, that each access to a tied array 42variable requires splitting the environment variable's string anew. 43 44The code: 45 46 use Env qw(@PATH); 47 push @PATH, '.'; 48 49is equivalent to: 50 51 use Env qw(PATH); 52 $PATH .= ":."; 53 54except that if C<$ENV{PATH}> started out empty, the second approach leaves 55it with the (odd) value "C<:.>", but the first approach leaves it with "C<.>". 56 57To remove a tied environment variable from 58the environment, assign it the undefined value 59 60 undef $PATH; 61 undef @LD_LIBRARY_PATH; 62 63=head1 LIMITATIONS 64 65On VMS systems, arrays tied to environment variables are read-only. Attempting 66to change anything will cause a warning. 67 68=head1 AUTHOR 69 70Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt> 71and 72Gregor N. Purdy E<lt>F<gregor@focusresearch.com>E<gt> 73 74=cut 75 76sub import { 77 my ($callpack) = caller(0); 78 my $pack = shift; 79 my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV)); 80 return unless @vars; 81 82 @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars; 83 84 eval "package $callpack; use vars qw(" . join(' ', @vars) . ")"; 85 die $@ if $@; 86 foreach (@vars) { 87 my ($type, $name) = m/^([\$\@])(.*)$/; 88 if ($type eq '$') { 89 tie ${"${callpack}::$name"}, Env, $name; 90 } else { 91 if ($^O eq 'VMS') { 92 tie @{"${callpack}::$name"}, Env::Array::VMS, $name; 93 } else { 94 tie @{"${callpack}::$name"}, Env::Array, $name; 95 } 96 } 97 } 98} 99 100sub TIESCALAR { 101 bless \($_[1]); 102} 103 104sub FETCH { 105 my ($self) = @_; 106 $ENV{$$self}; 107} 108 109sub STORE { 110 my ($self, $value) = @_; 111 if (defined($value)) { 112 $ENV{$$self} = $value; 113 } else { 114 delete $ENV{$$self}; 115 } 116} 117 118###################################################################### 119 120package Env::Array; 121 122use Config; 123use Tie::Array; 124 125@ISA = qw(Tie::Array); 126 127my $sep = $Config::Config{path_sep}; 128 129sub TIEARRAY { 130 bless \($_[1]); 131} 132 133sub FETCHSIZE { 134 my ($self) = @_; 135 return 1 + scalar(() = $ENV{$$self} =~ /\Q$sep\E/g); 136} 137 138sub STORESIZE { 139 my ($self, $size) = @_; 140 my @temp = split($sep, $ENV{$$self}); 141 $#temp = $size - 1; 142 $ENV{$$self} = join($sep, @temp); 143} 144 145sub CLEAR { 146 my ($self) = @_; 147 $ENV{$$self} = ''; 148} 149 150sub FETCH { 151 my ($self, $index) = @_; 152 return (split($sep, $ENV{$$self}))[$index]; 153} 154 155sub STORE { 156 my ($self, $index, $value) = @_; 157 my @temp = split($sep, $ENV{$$self}); 158 $temp[$index] = $value; 159 $ENV{$$self} = join($sep, @temp); 160 return $value; 161} 162 163sub EXISTS { 164 my ($self, $index) = @_; 165 return $index < $self->FETCHSIZE; 166} 167 168sub DELETE { 169 my ($self, $index) = @_; 170 my @temp = split($sep, $ENV{$$self}); 171 my $value = splice(@temp, $index, 1, ()); 172 $ENV{$$self} = join($sep, @temp); 173 return $value; 174} 175 176sub PUSH { 177 my $self = shift; 178 my @temp = split($sep, $ENV{$$self}); 179 push @temp, @_; 180 $ENV{$$self} = join($sep, @temp); 181 return scalar(@temp); 182} 183 184sub POP { 185 my ($self) = @_; 186 my @temp = split($sep, $ENV{$$self}); 187 my $result = pop @temp; 188 $ENV{$$self} = join($sep, @temp); 189 return $result; 190} 191 192sub UNSHIFT { 193 my $self = shift; 194 my @temp = split($sep, $ENV{$$self}); 195 my $result = unshift @temp, @_; 196 $ENV{$$self} = join($sep, @temp); 197 return $result; 198} 199 200sub SHIFT { 201 my ($self) = @_; 202 my @temp = split($sep, $ENV{$$self}); 203 my $result = shift @temp; 204 $ENV{$$self} = join($sep, @temp); 205 return $result; 206} 207 208sub SPLICE { 209 my $self = shift; 210 my $offset = shift; 211 my $length = shift; 212 my @temp = split($sep, $ENV{$$self}); 213 if (wantarray) { 214 my @result = splice @temp, $offset, $length, @_; 215 $ENV{$$self} = join($sep, @temp); 216 return @result; 217 } else { 218 my $result = scalar splice @temp, $offset, $length, @_; 219 $ENV{$$self} = join($sep, @temp); 220 return $result; 221 } 222} 223 224###################################################################### 225 226package Env::Array::VMS; 227use Tie::Array; 228 229@ISA = qw(Tie::Array); 230 231sub TIEARRAY { 232 bless \($_[1]); 233} 234 235sub FETCHSIZE { 236 my ($self) = @_; 237 my $i = 0; 238 while ($i < 127 and defined $ENV{$$self . ';' . $i}) { $i++; }; 239 return $i; 240} 241 242sub FETCH { 243 my ($self, $index) = @_; 244 return $ENV{$$self . ';' . $index}; 245} 246 247sub EXISTS { 248 my ($self, $index) = @_; 249 return $index < $self->FETCHSIZE; 250} 251 252sub DELETE { } 253 2541; 255