I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / Env.pm
CommitLineData
a0d0e21e 1package Env;
2
b75c8c73 3our $VERSION = '1.00';
4
a0d0e21e 5=head1 NAME
6
2675e62c 7Env - perl module that imports environment variables as scalars or arrays
cb1a09d0 8
9=head1 SYNOPSIS
10
11 use Env;
12 use Env qw(PATH HOME TERM);
2675e62c 13 use Env qw($SHELL @LD_LIBRARY_PATH);
a0d0e21e 14
15=head1 DESCRIPTION
16
2675e62c 17Perl maintains environment variables in a special hash named C<%ENV>. For
aa689395 18when this access method is inconvenient, the Perl module C<Env> allows
2675e62c 19environment variables to be treated as scalar or array variables.
a0d0e21e 20
2675e62c 21The C<Env::import()> function ties environment variables with suitable
a0d0e21e 22names to global Perl variables with the same names. By default it
2675e62c 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.
a0d0e21e 29
30After an environment variable is tied, merely use it like a normal variable.
31You may access its value
32
33 @path = split(/:/, $PATH);
2675e62c 34 print join("\n", @LD_LIBRARY_PATH), "\n";
a0d0e21e 35
36or modify it
37
38 $PATH .= ":.";
2675e62c 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<.>".
a0d0e21e 56
a0d0e21e 57To remove a tied environment variable from
58the environment, assign it the undefined value
59
60 undef $PATH;
2675e62c 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.
a0d0e21e 67
68=head1 AUTHOR
69
1fef88e7 70Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt>
2675e62c 71and
72Gregor N. Purdy E<lt>F<gregor@focusresearch.com>E<gt>
a0d0e21e 73
74=cut
75
76sub import {
77 my ($callpack) = caller(0);
78 my $pack = shift;
2675e62c 79 my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
40da2db3 80 return unless @vars;
a0d0e21e 81
2675e62c 82 @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars;
83
84 eval "package $callpack; use vars qw(" . join(' ', @vars) . ")";
40da2db3 85 die $@ if $@;
a0d0e21e 86 foreach (@vars) {
2675e62c 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 }
a0d0e21e 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
2675e62c 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 my @temp = split($sep, $ENV{$$self});
136 return scalar(@temp);
137}
138
139sub STORESIZE {
140 my ($self, $size) = @_;
141 my @temp = split($sep, $ENV{$$self});
142 $#temp = $size - 1;
143 $ENV{$$self} = join($sep, @temp);
144}
145
146sub CLEAR {
147 my ($self) = @_;
148 $ENV{$$self} = '';
149}
150
151sub FETCH {
152 my ($self, $index) = @_;
153 return (split($sep, $ENV{$$self}))[$index];
154}
155
156sub STORE {
157 my ($self, $index, $value) = @_;
158 my @temp = split($sep, $ENV{$$self});
159 $temp[$index] = $value;
160 $ENV{$$self} = join($sep, @temp);
161 return $value;
162}
163
164sub PUSH {
165 my $self = shift;
166 my @temp = split($sep, $ENV{$$self});
167 push @temp, @_;
168 $ENV{$$self} = join($sep, @temp);
169 return scalar(@temp);
170}
171
172sub POP {
173 my ($self) = @_;
174 my @temp = split($sep, $ENV{$$self});
175 my $result = pop @temp;
176 $ENV{$$self} = join($sep, @temp);
177 return $result;
178}
179
180sub UNSHIFT {
181 my $self = shift;
182 my @temp = split($sep, $ENV{$$self});
183 my $result = unshift @temp, @_;
184 $ENV{$$self} = join($sep, @temp);
185 return $result;
186}
187
188sub SHIFT {
189 my ($self) = @_;
190 my @temp = split($sep, $ENV{$$self});
191 my $result = shift @temp;
192 $ENV{$$self} = join($sep, @temp);
193 return $result;
194}
195
196sub SPLICE {
197 my $self = shift;
198 my $offset = shift;
199 my $length = shift;
200 my @temp = split($sep, $ENV{$$self});
201 if (wantarray) {
202 my @result = splice @temp, $self, $offset, $length, @_;
203 $ENV{$$self} = join($sep, @temp);
204 return @result;
205 } else {
206 my $result = scalar splice @temp, $offset, $length, @_;
207 $ENV{$$self} = join($sep, @temp);
208 return $result;
209 }
210}
211
212######################################################################
213
214package Env::Array::VMS;
215use Tie::Array;
216
217@ISA = qw(Tie::Array);
218
219sub TIEARRAY {
220 bless \($_[1]);
221}
222
223sub FETCHSIZE {
224 my ($self) = @_;
225 my $i = 0;
226 while ($i < 127 and defined $ENV{$$self . ';' . $i}) { $i++; };
227 return $i;
228}
229
230sub FETCH {
231 my ($self, $index) = @_;
232 return $ENV{$$self . ';' . $index};
233}
234
a0d0e21e 2351;