File Coverage

blib/lib/DataStructure/DoubleList/Node.pm
Criterion Covered Total %
statement 85 85 100.0
branch 8 8 100.0
condition n/a
subroutine 15 15 100.0
pod 6 7 85.7
total 114 115 99.1


line stmt bran cond sub pod time code
1             # A node of a double linked list.
2              
3             package DataStructure::DoubleList::Node;
4              
5 1     1   6 use strict;
  1         3  
  1         28  
6 1     1   5 use warnings;
  1         2  
  1         22  
7 1     1   6 use utf8;
  1         2  
  1         5  
8 1     1   21 use feature ':5.24';
  1         2  
  1         76  
9 1     1   5 use feature 'signatures';
  1         2  
  1         26  
10 1     1   4 no warnings 'experimental::signatures';
  1         2  
  1         30  
11              
12 1     1   5 use Scalar::Util qw(weaken);
  1         2  
  1         727  
13              
14             =pod
15              
16             =head1 NAME
17              
18             DataStructure::DoubleList::Node
19              
20             =head1 SYNOPSIS
21              
22             A single node (element) in a L.
23              
24             =head1 DESCRIPTION
25              
26             =head2 CONSTRUCTOR
27              
28             You can’t build a node directly. Instead you can call one of the accessors of a
29             L or some of the methods below.
30              
31             Note that a B does not hold a reference on its
32             parent list. So a node becomes invalid when the last reference to its list is
33             deleted as the list itself will be destroyed. But you should also not depend on
34             this behavior as it might be fixed in the future.
35              
36             =cut
37              
38             # The constructor is private and should be called only by this package and its
39             # parent.
40 20     20 0 30 sub new ($class, $list, $prev, $next, $value) {
  20         30  
  20         27  
  20         28  
  20         30  
  20         28  
  20         29  
41 20         72 my $self = bless {
42             list => $list,
43             prev => $prev,
44             next => $next,
45             value => $value,
46             }, $class;
47 20         68 weaken($self->{list});
48 20         41 return $self;
49             }
50              
51             =pod
52              
53             =head2 METHODS
54              
55             All the functions below are class methods that should be called on a
56             C object.
57              
58             =over 4
59              
60             =item value()
61              
62             Returns the value held by this node.
63              
64             =cut
65              
66 122     122 1 1211 sub value ($self) {
  122         230  
  122         152  
67 122         260 return $self->{value};
68             }
69              
70             =pod
71              
72             =item prev()
73              
74             Returns the previous B in this list or B
75             if the current object is the first node in its list.
76              
77             The current node can still be used after that call.
78              
79             =cut
80              
81 1     1 1 3 sub prev ($self) {
  1         2  
  1         2  
82 1         5 return $self->{prev};
83             }
84              
85             =pod
86              
87             =item next()
88              
89             Returns the next B in this list or B
90             if the current object is the last node in its list.
91              
92             The current node can still be used after that call.
93              
94             =cut
95              
96 119     119 1 509 sub next ($self) {
  119         146  
  119         152  
97 119         284 return $self->{next};
98             }
99              
100             =pod
101              
102             =item insert_after($value)
103              
104             Inserts a new node in the list after the current one, with the given value and
105             returns that new node.
106              
107             The current node can still be used after that call.
108              
109             =cut
110              
111 4     4 1 11 sub insert_after ($self, $value) {
  4         7  
  4         6  
  4         8  
112 4         13 my $new_node = new(ref $self, $self->{list}, $self, $self->{next}, $value);
113 4 100       11 if (defined $self->{next}) {
114 2         5 $self->{next}{prev} = $new_node;
115             } else {
116 2         5 $self->{list}{last} = $new_node;
117             }
118 4         6 $self->{next} = $new_node;
119 4         9 $self->{list}{size}++;
120 4         9 return $new_node;
121             }
122              
123              
124             =pod
125              
126             =item insert_before($value)
127              
128             Inserts a new node before in the list before the current one, with the given
129             value and returns that new node.
130              
131             The current node can still be used after that call.
132              
133             =cut
134              
135 4     4 1 10 sub insert_before ($self, $value) {
  4         7  
  4         8  
  4         6  
136 4         15 my $new_node = new(ref $self, $self->{list}, $self->{prev}, $self, $value);
137 4 100       13 if (defined $self->{prev}) {
138 2         4 $self->{prev}{next} = $new_node;
139             } else {
140 2         4 $self->{list}{first} = $new_node;
141             }
142 4         8 $self->{prev} = $new_node;
143 4         6 $self->{list}{size}++;
144 4         9 return;
145             }
146              
147              
148             =pod
149              
150             =item delete()
151              
152             Removes the node from the list and returns the value that it help value. The
153             node becomes invalid and can no longer be used.
154              
155             =over
156              
157             =cut
158              
159 15     15 1 24 sub delete ($self) {
  15         24  
  15         18  
160 15         29 my $value = $self->{value};
161 15         43 $self->_delete();
162 15         55 return $value;
163             }
164              
165             # Removes the current element without returning its value.
166 15     15   24 sub _delete ($self) {
  15         20  
  15         22  
167 15         35 my ($prev, $next) = ($self->{prev}, $self->{next});
168 15 100       34 if (defined $prev) {
169 6         12 $prev->{next} = $next;
170             } else {
171 9         15 $self->{list}{first} = $next;
172             }
173 15 100       29 if (defined $next) {
174 7         10 $next->{prev} = $prev;
175             } else {
176 8         14 $self->{list}{last} = $prev;
177             }
178 15         27 $self->{list}{size}--;
179 15         18 undef %{$self};
  15         38  
180 15         25 return;
181             }
182              
183             1;