File Coverage

blib/lib/Language/Farnsworth/Variables.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Language::Farnsworth::Variables;
2              
3 1     1   6 use strict;
  1         2  
  1         41  
4 1     1   5 use warnings;
  1         3  
  1         38  
5              
6 1     1   587 use Language::Farnsworth::Error;
  0            
  0            
7              
8             use Data::Dumper;
9              
10             #this is very simple right now but i'll need to make a way to inherit
11             #variables from an old Language::Farnsworth::Variables class so that i can do
12             #functions with "scoping"
13              
14             sub new
15             {
16             my $class = shift;
17             my $state = shift;
18             my $self = {parent => undef, vars => {}};
19             $self->{parent} = $state if (ref($state) eq "Language::Farnsworth::Variables");
20             bless $self;
21             }
22              
23             sub DESTROY
24             {
25             debug 2,"VARIABLES DIE: $_[0]";
26             }
27              
28             sub setvar
29             {
30             my $self = shift;
31             my $name = shift;
32             my $value = shift;
33              
34             if ((exists($self->{vars}{$name})) || !defined($self->{parent}))
35             {
36             if (exists($self->{vars}{$name}) && ref($self->{vars}{$name}) eq "REF")
37             {
38             #we've got a reference
39             ${$self->{vars}{$name}} = $value;
40             }
41             else
42             {
43             $self->{vars}{$name} = $value;
44             }
45             }
46             else
47             {
48             $self->{parent}->setvar($name, $value); #set it in the previous scope
49             }
50             }
51              
52             sub declare
53             {
54             my $self = shift;
55             my $name = shift;
56             my $value = shift;
57              
58             if (!defined($name))
59             {
60             error "NAME UNDEFINED!\n".Dumper([$self, $name, $value, @_]);
61             }
62              
63             #really all we need to do is just set it in this scope to see it
64             $self->{vars}{$name} = $value;
65             }
66              
67             sub setref
68             {
69             my $self = shift;
70             my $name = shift;
71              
72             if (!defined($name))
73             {
74             error "NAME UNDEFINED!\n".Dumper([$self, $name, @_]);
75             }
76              
77             #really all we need to do is just set it in this scope to see it
78             $self->{vars}{$name} = $_[0]; #can't set things myself with shift, HAVE to use @_ directly
79             }
80              
81             sub getref
82             {
83             my $self = shift;
84             my $name = shift;
85             my $val;
86              
87             error "DEPRECIATED CALL TO Variables->getref()";
88              
89             if (exists($self->{vars}{$name}))
90             {
91             $val = \$self->{vars}{$name};
92             }
93             elsif (defined($self->{parent}))
94             {
95             $val = $self->{parent}->getref($name);
96             }
97              
98             return $val;
99             }
100              
101             sub getvar
102             {
103             my $self = shift;
104             my $name = shift;
105             my $val;
106              
107             if (exists($self->{vars}{$name}))
108             {
109             $val = $self->{vars}{$name};
110             $val->setref(\$self->{vars}{$name}) unless (ref($val) eq "REF");
111             #$val->sethomescope($self);
112             }
113             elsif (defined($self->{parent}))
114             {
115             $val = $self->{parent}->getvar($name);
116             }
117              
118             if (ref $val eq "REF")
119             { #we've got one set by reference
120             $val = $$val; #deref it for getting its value
121             }
122              
123             return $val;
124             }
125              
126             sub isvar
127             {
128             my $self = shift;
129             my $name = shift;
130              
131             my $r = exists($self->{vars}{$name});
132              
133             if (!exists($self->{vars}{$name}) && defined($self->{parent}))
134             {
135             $r = $self->{parent}->isvar($name);
136             }
137              
138             return $r;
139             }
140             1;