File Coverage

blib/lib/Language/Homespring/Node.pm
Criterion Covered Total %
statement 45 63 71.4
branch 5 12 41.6
condition 3 4 75.0
subroutine 9 12 75.0
pod 0 8 0.0
total 62 99 62.6


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