1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
package Env;
our $VERSION = '1.05';
=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<Env> allows
environment variables to be treated as scalar or array variables.
The C<Env::import()> function ties environment variables with suitable
names to global Perl variables with the same names. By default it
ties all existing environment variables (C<keys %ENV>) to scalars. If
the C<import> 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<split> and C<join>, 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 .= ":/any/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, '/any/path';
is almost equivalent to:
use Env qw(PATH);
$PATH .= ":/any/path";
except that if C<$ENV{PATH}> started out empty, the second approach leaves
it with the (odd) value "C<:/any/path>", but the first approach leaves it with
"C</any/path>".
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 E<lt>F<chip@fin.uucp>E<gt>
and
Gregor N. Purdy E<lt>F<gregor@focusresearch.com>E<gt>
=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, $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;
|
