Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package Env; |
2 | ||
3 | =head1 NAME | |
4 | ||
cb1a09d0 AD |
5 | Env - perl module that imports environment variables |
6 | ||
7 | =head1 SYNOPSIS | |
8 | ||
9 | use Env; | |
10 | use Env qw(PATH HOME TERM); | |
a0d0e21e LW |
11 | |
12 | =head1 DESCRIPTION | |
13 | ||
aa689395 | 14 | Perl maintains environment variables in a pseudo-hash named %ENV. For |
15 | when this access method is inconvenient, the Perl module C<Env> allows | |
16 | environment variables to be treated as simple variables. | |
a0d0e21e LW |
17 | |
18 | The Env::import() function ties environment variables with suitable | |
19 | names to global Perl variables with the same names. By default it | |
20 | does so with all existing environment variables (C<keys %ENV>). If | |
21 | the import function receives arguments, it takes them to be a list of | |
22 | environment variables to tie; it's okay if they don't yet exist. | |
23 | ||
24 | After an environment variable is tied, merely use it like a normal variable. | |
25 | You may access its value | |
26 | ||
27 | @path = split(/:/, $PATH); | |
28 | ||
29 | or modify it | |
30 | ||
31 | $PATH .= ":."; | |
32 | ||
33 | however you'd like. | |
34 | To remove a tied environment variable from | |
35 | the environment, assign it the undefined value | |
36 | ||
37 | undef $PATH; | |
38 | ||
39 | =head1 AUTHOR | |
40 | ||
1fef88e7 | 41 | Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt> |
a0d0e21e LW |
42 | |
43 | =cut | |
44 | ||
45 | sub import { | |
46 | my ($callpack) = caller(0); | |
47 | my $pack = shift; | |
48 | my @vars = @_ ? @_ : keys(%ENV); | |
40da2db3 | 49 | return unless @vars; |
a0d0e21e | 50 | |
40da2db3 JH |
51 | eval "package $callpack; use vars qw(" |
52 | . join(' ', map { '$'.$_ } @vars) . ")"; | |
53 | die $@ if $@; | |
a0d0e21e LW |
54 | foreach (@vars) { |
55 | tie ${"${callpack}::$_"}, Env, $_ if /^[A-Za-z_]\w*$/; | |
56 | } | |
57 | } | |
58 | ||
59 | sub TIESCALAR { | |
60 | bless \($_[1]); | |
61 | } | |
62 | ||
63 | sub FETCH { | |
64 | my ($self) = @_; | |
65 | $ENV{$$self}; | |
66 | } | |
67 | ||
68 | sub STORE { | |
69 | my ($self, $value) = @_; | |
70 | if (defined($value)) { | |
71 | $ENV{$$self} = $value; | |
72 | } else { | |
73 | delete $ENV{$$self}; | |
74 | } | |
75 | } | |
76 | ||
77 | 1; |