perl/env.pm

   1 package reader;
   2 use feature qw(switch);
   3 use strict;
   4 use warnings;
   5 use Exporter 'import';
   6
   7
   8 {
   9     package Env;
  10     use Data::Dumper;
  11     sub new  {
  12         my ($class,$outer,$binds,$exprs) = @_;
  13         my $data = { __outer__ => $outer };
  14         if ($binds) {
  15             for (my $i=0; $i<scalar(@{$binds->{val}}); $i++) {
  16                 if (${$binds->nth($i)} eq "&") {
  17                     # variable length arguments
  18                     my @earr = @{$exprs->{val}}; # get the array
  19                     my @new_arr = @earr[$i..$#earr]; # slice it
  20                     $data->{${$binds->nth($i+1)}} = List->new(\@new_arr);
  21                     last;
  22                 } else {
  23                     $data->{${$binds->nth($i)}} = $exprs->nth($i);
  24                 }
  25             }
  26         }
  27         bless $data => $class
  28     }
  29     sub find {
  30         my ($self, $key) = @_;
  31         if (exists $self->{$$key}) { return $self; }
  32         elsif ($self->{__outer__}) { return $self->{__outer__}->find($key); }
  33         else { return undef; }
  34     }
  35     sub set {
  36         my ($self, $key, $value) = @_;
  37         $self->{$$key} = $value;
  38         return $value
  39     }
  40     sub get {
  41         my ($self, $key) = @_;
  42         my $env = $self->find($key);
  43         die "'" . $$key . "' not found\n" unless $env;
  44         return $env->{$$key};
  45     }
  46 }
  47
  48 #my $e1 = Env->new();
  49 #print Dumper($e1);
  50 #
  51 #my $e2 = Env->new();
  52 #$e2->set('abc', 123);
  53 #$e2->set('def', 456);
  54 #print Dumper($e2);
  55 #
  56 #my $e3 = Env->new($e2);
  57 #$e3->set('abc', 789);
  58 #$e3->set('ghi', 1024);
  59 #print Dumper($e3);
  60 #
  61 #print Dumper($e3->find('abc'));
  62 #print Dumper($e3->get('abc'));
  63 #print Dumper($e3->find('def'));
  64 #print Dumper($e3->get('def'));
  65
  66 1;