Commit | Line | Data |
a0d0e21e |
1 | package Env; |
2 | |
3 | =head1 NAME |
4 | |
cb1a09d0 |
5 | Env - perl module that imports environment variables |
6 | |
7 | =head1 SYNOPSIS |
8 | |
9 | use Env; |
10 | use Env qw(PATH HOME TERM); |
a0d0e21e |
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 |
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 |
42 | |
43 | =cut |
44 | |
45 | sub import { |
46 | my ($callpack) = caller(0); |
47 | my $pack = shift; |
dfb1c8b9 |
48 | my @vars = grep /^[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV)); |
40da2db3 |
49 | return unless @vars; |
a0d0e21e |
50 | |
40da2db3 |
51 | eval "package $callpack; use vars qw(" |
52 | . join(' ', map { '$'.$_ } @vars) . ")"; |
53 | die $@ if $@; |
a0d0e21e |
54 | foreach (@vars) { |
dfb1c8b9 |
55 | tie ${"${callpack}::$_"}, Env, $_; |
a0d0e21e |
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; |