develooper Front page | perl.perl5.porters | Postings from February 2000

PATCH: Env.pm

Thread Next
From:
Gregor N. Purdy
Date:
February 8, 2000 21:44
Subject:
PATCH: Env.pm
Message ID:
4.2.2.20000209002604.00a906e0@ipass.one.net
Here's a patch for Env.pm that integrates the ideas from my
Env::Array CPAN module. It was suggested to me that incorporating
this functionality into Env might make it more attractive for
inclusion with the base Perl distribution. I think this new
capability is a nice complement to the existing functionality.
Now we can treat array-ish environment variables as arrays without
the explicit splitting and joining. Also, the usage of Env now
parallels that of vars, although I've taken care to retain the
prior semantics of the prior syntax. This does what (I think)
you would expect:

     use Env qw(HOME $USER @PATH);

The CPAN module allows user-specified delimiters, but this code
just uses $Config::Config{path_sep}. This simplifies the
implementation and usage, and probably covers a large percentage
of the cases where this would be useful, such as FPATH, CDPATH,
PERL5LIB, PERLLIB, PATH, and LD_LIBRARY_PATH.

I put this code through a series of tests comparing the results
of operating on a tied array to those with a regular array,
including push/pop, shift/unshift, splice, etc. It passes all
the tests I've thrown at it. I have a null implementation of
EXTEND because it didn't appear that it was required to do
anything, but it is required to be present.

I listed myself as co-author, secondary to Chip, although I
don't know if this is the accepted way to note attribution in
cases like this. Guidance here if I've made a misstep would
be appreciated.



--- Env.pm.orig Tue Jul 20 13:18:00 1999
+++ Env.pm      Tue Feb  8 19:18:17 2000
@@ -2,57 +2,87 @@
  
  =head1 NAME
  
-Env - perl module that imports environment variables
+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 pseudo-hash named %ENV.  For
+Perl maintains environment variables in a pseudo-hash named C<%ENV>.  For
  when this access method is inconvenient, the Perl module C<Env> allows
-environment variables to be treated as simple variables.
+environment variables to be treated as scalar or array variables.
  
-The Env::import() function ties environment variables with suitable
+The C<Env::import()> function ties environment variables with suitable
  names to global Perl variables with the same names.  By default it
-does so with all existing environment variables (C<keys %ENV>).  If
-the import function receives arguments, it takes them to be a list of
-environment variables to tie; it's okay if they don't yet exist.
+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 .= ":.";
+    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, '.';
+
+is equivalent to:
+
+    use Env qw(PATH);
+    $PATH .= ":.";
+
+except that if C<$ENV{PATH}> started out empty, the second approach leaves
+it with the (odd) value "C<:.>", but the first approach leaves it with "C<.>".
  
-however you'd like.
  To remove a tied environment variable from
  the environment, assign it the undefined value
  
      undef $PATH;
+    undef @LD_LIBRARY_PATH;
  
  =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));
+    my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
      return unless @vars;
  
-    eval "package $callpack; use vars qw("
-        . join(' ', map { '$'.$_ } @vars) . ")";
+    @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars;
+
+    eval "package $callpack; use vars qw(" . join(' ', @vars) . ")";
      die $@ if $@;
      foreach (@vars) {
-       tie ${"${callpack}::$_"}, Env, $_;
+       my ($type, $name) = m/^([\$\@])(.*)$/;
+       if ($type eq '$') {
+           tie ${"${callpack}::$name"}, Env, $name;
+       } else {
+           tie @{"${callpack}::$name"}, Env::Array, $name;
+       }
      }
  }
  
@@ -72,6 +102,98 @@
      } else {
         delete $ENV{$$self};
      }
+}
+
+################################################################################
+
+package Env::Array;
+ 
+use Config;
+
+sub TIEARRAY {
+    bless \($_[1]);
+}
+
+sub FETCHSIZE {
+    my ($self) = @_;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    return scalar(@temp);
+}
+
+sub STORESIZE {
+    my ($self, $size) = @_;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    $#temp = $size - 1;
+    $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+    return $value;
+}
+
+sub CLEAR {
+    my ($self) = @_;
+    $ENV{$$self} = '';
+}
+
+sub FETCH {
+    my ($self, $index) = @_;
+    return (split($Config::Config{path_sep}, $ENV{$$self}))[$index];
+}
+
+sub STORE {
+    my ($self, $index, $value) = @_;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    $temp[$index] = $value;
+    $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+    return $value;
+}
+
+sub PUSH {
+    my $self = shift;
+    my $temp = join($Config::Config{path_sep}, @_);
+    $temp = $Config::Config{path_sep} . $temp if $ENV{$$self} ne '';
+    $ENV{$$self} .= $temp;
+}
+
+sub POP {
+    my ($self) = @_;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    my $result = pop @temp;
+    $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+    return $result;
+}
+
+sub UNSHIFT {
+    my $self = shift;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    my $result = unshift @temp, @_;
+    $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+    return $result;
+}
+
+sub SHIFT {
+    my ($self) = @_;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    my $result = shift @temp;
+    $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+    return $result;
+}
+
+sub SPLICE {
+    my $self = shift;
+    my $offset = shift;
+    my $length = shift;
+    my @temp = split($Config::Config{path_sep}, $ENV{$$self});
+    if (wantarray) {
+       my @result = splice @temp, $self, $offset, $length, @_;
+       $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+       return @result;
+    } else {
+       my $result = scalar splice @temp, $offset, $length, @_;
+       $ENV{$$self} = join($Config::Config{path_sep}, @temp);
+       return $result;
+    }
+}
+
+sub EXTEND {
  }
  
  1;


+--------------------------------------------------------------+
| Gregor N. Purdy                     gregor@focusresearch.com |
|                                                              |
| Swiss army chainsaw operator.      y2k: perl -pe 'tr/yY/kK/' |
+--------------------------------------------------------------+


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About