| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Language::Homespring::Node; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
$VERSION = 0.02; |
|
4
|
|
|
|
|
|
|
|
|
5
|
4
|
|
|
4
|
|
26
|
use warnings; |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
109
|
|
|
6
|
4
|
|
|
4
|
|
22
|
use strict; |
|
|
4
|
|
|
|
|
8
|
|
|
|
4
|
|
|
|
|
3339
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
my $node_count = 0; |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
|
11
|
121
|
|
|
121
|
0
|
157
|
my $class = shift; |
|
12
|
121
|
|
|
|
|
277
|
my $self = bless {}, $class; |
|
13
|
|
|
|
|
|
|
|
|
14
|
121
|
|
|
|
|
151
|
my $options = shift; |
|
15
|
121
|
|
|
|
|
947
|
$self->{interp} = $options->{interp}; |
|
16
|
121
|
|
100
|
|
|
399
|
$self->{parent_node} = $options->{parent_node} || undef; |
|
17
|
121
|
|
50
|
|
|
331
|
$self->{node_name} = $options->{node_name} || ''; |
|
18
|
121
|
|
|
|
|
210
|
$self->{child_nodes} = []; |
|
19
|
121
|
|
|
|
|
185
|
$self->{rivers_up} = []; |
|
20
|
121
|
|
|
|
|
166
|
$self->{river_down} = undef; |
|
21
|
121
|
|
|
|
|
184
|
$self->{power} = 0; |
|
22
|
121
|
|
|
|
|
358
|
$self->{water} = 0; |
|
23
|
121
|
|
|
|
|
168
|
$self->{destroyed} = 0; |
|
24
|
121
|
|
|
|
|
277
|
$self->{spring} = $self->_is_spring(); |
|
25
|
121
|
|
|
|
|
196
|
$self->{uid} = ++$node_count; |
|
26
|
121
|
|
|
|
|
178
|
$self->{depth} = 0; |
|
27
|
121
|
|
|
|
|
281
|
$self->{node_name_safe} = $self->_make_safe($options->{node_name}); |
|
28
|
121
|
|
|
|
|
198
|
$self->{toggle} = 0; |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# easier to deal with lowercase commands :) |
|
31
|
121
|
100
|
|
|
|
334
|
$self->{node_name} = lc($self->{node_name}) if (!$self->{spring}); |
|
32
|
|
|
|
|
|
|
|
|
33
|
121
|
|
|
|
|
318
|
return $self; |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub add_child { |
|
37
|
95
|
|
|
95
|
0
|
129
|
my ($self, $child) = @_; |
|
38
|
95
|
|
|
|
|
107
|
push @{$self->{child_nodes}}, $child; |
|
|
95
|
|
|
|
|
554
|
|
|
39
|
|
|
|
|
|
|
} |
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub get_salmon { |
|
42
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
|
43
|
0
|
|
|
|
|
0
|
my @out; |
|
44
|
0
|
|
|
|
|
0
|
for (@{$self->{interp}->{salmon}}){ |
|
|
0
|
|
|
|
|
0
|
|
|
45
|
0
|
0
|
|
|
|
0
|
if ($_->{location} eq $self){ |
|
46
|
0
|
|
|
|
|
0
|
push @out, $_; |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
} |
|
49
|
0
|
|
|
|
|
0
|
return @out; |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub get_depth { |
|
53
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
|
54
|
|
|
|
|
|
|
|
|
55
|
0
|
0
|
|
|
|
0
|
if (!$self->{depth}){ |
|
56
|
0
|
0
|
|
|
|
0
|
if (scalar(@{$self->{child_nodes}})){ |
|
|
0
|
|
|
|
|
0
|
|
|
57
|
0
|
|
|
|
|
0
|
for (@{$self->{child_nodes}}){ |
|
|
0
|
|
|
|
|
0
|
|
|
58
|
0
|
|
|
|
|
0
|
$self->{depth} += $_->get_depth(); |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
}else{ |
|
61
|
0
|
|
|
|
|
0
|
$self->{depth} = 2; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
0
|
return $self->{depth}; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub _is_spring { |
|
69
|
121
|
|
|
121
|
|
151
|
my ($self) = @_; |
|
70
|
|
|
|
|
|
|
|
|
71
|
121
|
|
|
|
|
1042
|
my @keywords = ( |
|
72
|
|
|
|
|
|
|
'powers', |
|
73
|
|
|
|
|
|
|
'hydro power', |
|
74
|
|
|
|
|
|
|
'power invert', |
|
75
|
|
|
|
|
|
|
'marshy', |
|
76
|
|
|
|
|
|
|
'shallows', |
|
77
|
|
|
|
|
|
|
'rapids', |
|
78
|
|
|
|
|
|
|
'bear', |
|
79
|
|
|
|
|
|
|
'young bear', |
|
80
|
|
|
|
|
|
|
'bird', |
|
81
|
|
|
|
|
|
|
'upstream killing device', |
|
82
|
|
|
|
|
|
|
'net', |
|
83
|
|
|
|
|
|
|
'current', |
|
84
|
|
|
|
|
|
|
'insulated', |
|
85
|
|
|
|
|
|
|
'force field', |
|
86
|
|
|
|
|
|
|
'bridge', |
|
87
|
|
|
|
|
|
|
'waterfall', |
|
88
|
|
|
|
|
|
|
'evaporates', |
|
89
|
|
|
|
|
|
|
'pump', |
|
90
|
|
|
|
|
|
|
'fear', |
|
91
|
|
|
|
|
|
|
'lock', |
|
92
|
|
|
|
|
|
|
'inverse lock', |
|
93
|
|
|
|
|
|
|
'narrows', |
|
94
|
|
|
|
|
|
|
'sense', |
|
95
|
|
|
|
|
|
|
'switch', |
|
96
|
|
|
|
|
|
|
'upstream sense', |
|
97
|
|
|
|
|
|
|
'downstream sense', |
|
98
|
|
|
|
|
|
|
'range sense', |
|
99
|
|
|
|
|
|
|
'range switch', |
|
100
|
|
|
|
|
|
|
'young sense', |
|
101
|
|
|
|
|
|
|
'young switch', |
|
102
|
|
|
|
|
|
|
'young range sense', |
|
103
|
|
|
|
|
|
|
'young range switch', |
|
104
|
|
|
|
|
|
|
'youth fountain', |
|
105
|
|
|
|
|
|
|
'time', |
|
106
|
|
|
|
|
|
|
'reverse up', |
|
107
|
|
|
|
|
|
|
'reverse down', |
|
108
|
|
|
|
|
|
|
'force up', |
|
109
|
|
|
|
|
|
|
'force down', |
|
110
|
|
|
|
|
|
|
'hatchery', |
|
111
|
|
|
|
|
|
|
'snowmelt', |
|
112
|
|
|
|
|
|
|
'append down', |
|
113
|
|
|
|
|
|
|
'append up', |
|
114
|
|
|
|
|
|
|
'clone', |
|
115
|
|
|
|
|
|
|
'universe', |
|
116
|
|
|
|
|
|
|
'oblivion', |
|
117
|
|
|
|
|
|
|
'spawn', |
|
118
|
|
|
|
|
|
|
'split', |
|
119
|
|
|
|
|
|
|
); |
|
120
|
|
|
|
|
|
|
|
|
121
|
121
|
|
|
|
|
196
|
for (@keywords){ |
|
122
|
2991
|
100
|
|
|
|
7889
|
return 0 if (lc $_ eq lc $self->{node_name}); |
|
123
|
|
|
|
|
|
|
} |
|
124
|
30
|
|
|
|
|
125
|
return 1; |
|
125
|
|
|
|
|
|
|
} |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _make_safe { |
|
128
|
121
|
|
|
121
|
|
617
|
my ($self, $name) = @_; |
|
129
|
|
|
|
|
|
|
|
|
130
|
121
|
50
|
|
|
|
218
|
if ($name){ |
|
131
|
121
|
|
|
|
|
203
|
$name =~ s/\n/\\n/g; |
|
132
|
|
|
|
|
|
|
} |
|
133
|
|
|
|
|
|
|
|
|
134
|
121
|
|
|
|
|
294
|
return $name; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub add_river_up { |
|
138
|
95
|
|
|
95
|
0
|
126
|
my ($self, $river) = @_; |
|
139
|
95
|
|
|
|
|
120
|
push @{$self->{rivers_up}}, $river; |
|
|
95
|
|
|
|
|
283
|
|
|
140
|
|
|
|
|
|
|
} |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub add_river_down { |
|
143
|
95
|
|
|
95
|
0
|
136
|
my ($self, $river) = @_; |
|
144
|
95
|
|
|
|
|
716
|
$self->{river_down} = $river; |
|
145
|
|
|
|
|
|
|
} |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub debug { |
|
148
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
|
149
|
0
|
|
|
|
|
0
|
return "node $self->{uid} ($self->{node_name_safe})"; |
|
150
|
|
|
|
|
|
|
} |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub every_other { |
|
153
|
4
|
|
|
4
|
0
|
13
|
my ($self) = @_; |
|
154
|
4
|
|
|
|
|
7
|
$self->{toggle} = !$self->{toggle}; |
|
155
|
4
|
|
|
|
|
14
|
return $self->{toggle}; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
1; |
|
159
|
|
|
|
|
|
|
|