2014-04-21 07:54:38 +04:00
|
|
|
package reader;
|
|
|
|
use feature qw(switch);
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
use Exporter 'import';
|
|
|
|
|
|
|
|
|
|
|
|
{
|
|
|
|
package Env;
|
2014-04-24 06:46:57 +04:00
|
|
|
use Data::Dumper;
|
2014-04-21 07:54:38 +04:00
|
|
|
sub new {
|
|
|
|
my ($class,$outer,$binds,$exprs) = @_;
|
|
|
|
my $data = { __outer__ => $outer };
|
2014-04-21 08:45:58 +04:00
|
|
|
if ($binds) {
|
2014-04-24 06:46:57 +04:00
|
|
|
for (my $i=0; $i<scalar(@{$binds->{val}}); $i++) {
|
|
|
|
if (${$binds->nth($i)} eq "&") {
|
2014-04-21 08:45:58 +04:00
|
|
|
# variable length arguments
|
2014-04-24 06:46:57 +04:00
|
|
|
my @earr = @{$exprs->{val}}; # get the array
|
2014-04-21 08:45:58 +04:00
|
|
|
my @new_arr = @earr[$i..$#earr]; # slice it
|
2014-04-24 06:46:57 +04:00
|
|
|
$data->{${$binds->nth($i+1)}} = List->new(\@new_arr);
|
2014-04-21 08:45:58 +04:00
|
|
|
last;
|
|
|
|
} else {
|
2014-04-24 06:46:57 +04:00
|
|
|
$data->{${$binds->nth($i)}} = $exprs->nth($i);
|
2014-04-21 08:45:58 +04:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2014-04-21 07:54:38 +04:00
|
|
|
bless $data => $class
|
|
|
|
}
|
|
|
|
sub find {
|
|
|
|
my ($self, $key) = @_;
|
2014-12-19 05:33:49 +03:00
|
|
|
if (exists $self->{$$key}) { return $self; }
|
2014-04-21 07:54:38 +04:00
|
|
|
elsif ($self->{__outer__}) { return $self->{__outer__}->find($key); }
|
|
|
|
else { return undef; }
|
|
|
|
}
|
|
|
|
sub set {
|
|
|
|
my ($self, $key, $value) = @_;
|
2014-12-19 05:33:49 +03:00
|
|
|
$self->{$$key} = $value;
|
2014-04-21 07:54:38 +04:00
|
|
|
return $value
|
|
|
|
}
|
|
|
|
sub get {
|
|
|
|
my ($self, $key) = @_;
|
|
|
|
my $env = $self->find($key);
|
2014-12-19 05:33:49 +03:00
|
|
|
die "'" . $$key . "' not found\n" unless $env;
|
|
|
|
return $env->{$$key};
|
2014-04-21 07:54:38 +04:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
#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;
|