File Coverage

blib/lib/List/DoubleLinked.pm
Criterion Covered Total %
statement 82 82 100.0
branch 4 8 50.0
condition n/a
subroutine 19 19 100.0
pod 13 13 100.0
total 118 122 96.7


line stmt bran cond sub pod time code
1             package List::DoubleLinked;
2             $List::DoubleLinked::VERSION = '0.005';
3 1     1   27485 use strict;
  1         1  
  1         25  
4 1     1   3 use warnings FATAL => 'all';
  1         1  
  1         31  
5              
6 1     1   3 use Carp qw/carp croak/;
  1         4  
  1         41  
7 1     1   3 use Scalar::Util 'weaken';
  1         1  
  1         39  
8 1     1   378 use namespace::clean 0.20;
  1         10943  
  1         4  
9             #no autovivication;
10              
11             sub new {
12 2     2 1 328 my ($class, @items) = @_;
13 2         10 my $self = bless {
14             head => undef,
15             tail => undef,
16             head => { prev => undef },
17             tail => { tail => undef },
18             }, $class;
19 2         6 $self->{head}{next} = $self->{tail};
20 2         3 $self->{tail}{prev} = $self->{head};
21 2         4 $self->push(@items);
22 2         4 return $self;
23             }
24              
25             ## no critic (Subroutines::ProhibitBuiltinHomonyms, ControlStructures::ProhibitCStyleForLoops)
26              
27             sub push {
28 4     4 1 729 my ($self, @items) = @_;
29 4         8 for my $item (@items) {
30             my $new_tail = {
31             item => $item,
32             prev => $self->{tail}{prev},
33             next => $self->{tail},
34 7         14 };
35 7         8 $self->{tail}{prev}{next} = $new_tail;
36 7         7 $self->{tail}{prev} = $new_tail;
37 7 50       14 $self->{head}{next} = $new_tail if $self->{head}{next} == $self->{tail};
38             }
39 4         5 return;
40             }
41              
42             sub pop {
43 1     1 1 2 my $self = shift;
44 1 50       4 croak 'No items to pop from the list' if $self->{tail}{prev} == $self->{head};
45 1         1 my $ret = $self->{tail}{prev};
46 1         2 $self->{tail}{prev} = $ret->{prev};
47 1         2 $ret->{prev}{next} = $self->{tail};
48 1         4 return $ret->{item};
49             }
50              
51             sub unshift {
52 1     1 1 3 my ($self, @items) = @_;
53 1         3 for my $item (reverse @items) {
54             my $new_head = {
55             item => $item,
56             prev => $self->{head},
57             next => $self->{head}{next},
58 1         4 };
59 1         1 $self->{head}{next}{prev} = $new_head;
60 1         2 $self->{head}{next} = $new_head;
61             }
62 1         2 return;
63             }
64              
65             sub shift {
66 1     1 1 4 my $self = CORE::shift;
67 1 50       4 croak 'No items to shift from the list' if $self->{head}{next} == $self->{tail};
68 1         1 my $ret = $self->{head}{next};
69 1         2 $self->{head}{next} = $ret->{next};
70 1         1 $ret->{next}{prev} = $self->{head};
71 1         2 return $ret->{item};
72             }
73              
74             sub flatten {
75 8     8 1 11 my $self = CORE::shift;
76 8         8 my @ret;
77 8         24 for (my $current = $self->{head}{next} ; $current != $self->{tail}; $current = $current->{next}) {
78 25         45 CORE::push @ret, $current->{item};
79             }
80 8         43 return @ret;
81             }
82              
83             sub front {
84 1     1 1 2 my $self = CORE::shift;
85 1         4 return $self->{head}{next}{item};
86             }
87              
88             sub back {
89 1     1 1 1 my $self = CORE::shift;
90 1         5 return $self->{tail}{prev}{item};
91             }
92              
93             sub empty {
94 2     2 1 4 my $self = CORE::shift;
95             return $self->{head}{next} == $self->{tail}
96 2         9 }
97              
98             sub size {
99 2     2 1 2 my $self = CORE::shift;
100 2         3 my $ret = 0;
101 2         9 for (my $current = $self->{head}{next} ; $current != $self->{tail}; $current = $current->{next}) {
102 3         5 $ret++;
103             }
104 2         6 return $ret;
105             }
106              
107             sub erase {
108 1     1 1 1 my ($self, $iter) = @_;
109              
110 1         3 my $ret = $iter->next;
111 1         2 my $node = $iter->[0];
112              
113 1         2 $node->{prev}{next} = $node->{next};
114 1         1 $node->{next}{prev} = $node->{prev};
115              
116 1         8 weaken $node;
117 1 50       3 carp 'Node may be leaking' if $node;
118              
119 1         4 return $ret;
120             }
121              
122             sub begin {
123 2     2 1 349 my $self = CORE::shift;
124 2         460 require List::DoubleLinked::Iterator;
125              
126 2         7 return List::DoubleLinked::Iterator->new($self->{head}{next});
127             }
128              
129             sub end {
130 7     7 1 3 my $self = CORE::shift;
131 7         15 require List::DoubleLinked::Iterator;
132              
133 7         13 return List::DoubleLinked::Iterator->new($self->{tail});
134             }
135              
136             sub DESTROY {
137 2     2   603 my $self = CORE::shift;
138 2         3 my $current = $self->{head};
139 2         8 while ($current) {
140 13         14 delete $current->{prev};
141 13         21 $current = delete $current->{next};
142             }
143 2         29 return;
144             }
145              
146             # ABSTRACT: Double Linked Lists for Perl
147              
148             1;
149              
150             __END__