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
|
|
|
|
|
|
|
|