perl/env.pm


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

package reader;
use feature qw(switch);
use strict;
use warnings;
use Exporter 'import';


{
    package Env;
    use Data::Dumper;
    sub new  {
        my ($class,$outer,$binds,$exprs) = @_;
        my $data = { __outer__ => $outer };
        if ($binds) {
            for (my $i=0; $i<scalar(@{$binds->{val}}); $i++) {
                if (${$binds->nth($i)} eq "&") {
                    # variable length arguments
                    my @earr = @{$exprs->{val}}; # get the array
                    my @new_arr = @earr[$i..$#earr]; # slice it
                    $data->{${$binds->nth($i+1)}} = List->new(\@new_arr);
                    last;
                } else {
                    $data->{${$binds->nth($i)}} = $exprs->nth($i);
                }
            }
        }
        bless $data => $class
    }
    sub find {
        my ($self, $key) = @_;
        if (exists $self->{$$key}) { return $self; }
        elsif ($self->{__outer__}) { return $self->{__outer__}->find($key); }
        else { return undef; }
    }
    sub set {
        my ($self, $key, $value) = @_;
        $self->{$$key} = $value;
        return $value
    }
    sub get {
        my ($self, $key) = @_;
        my $env = $self->find($key);
        die "'" . $$key . "' not found\n" unless $env;
        return $env->{$$key};
    }
}

#my $e1 = Env->new();
#print Dumper($e1);
#
#my $e2 = Env->new();
#$e2->set('abc', 123);
#$e2->set('def', 456);
#print Dumper($e2);
#
#my $e3 = Env->new($e2);
#$e3->set('abc', 789);
#$e3->set('ghi', 1024);
#print Dumper($e3);
#
#print Dumper($e3->find('abc'));
#print Dumper($e3->get('abc'));
#print Dumper($e3->find('def'));
#print Dumper($e3->get('def'));

1;