File Coverage

blib/lib/Array/Iterator/LegacyBiDirectional.pm
Criterion Covered Total %
statement 39 39 100.0
branch 20 20 100.0
condition n/a
subroutine 10 10 100.0
pod 4 7 57.1
total 73 76 96.0


line stmt bran cond sub pod time code
1             package Array::Iterator::LegacyBiDirectional;
2              
3 1     1   142715 use strict;
  1         8  
  1         47  
4 1     1   7 use warnings;
  1         3  
  1         80  
5              
6 1     1   714 use Array::Iterator;
  1         3  
  1         487  
7              
8             # AUTHORITY
9             # DATE
10             # DIST
11              
12             =head1 VERSION
13              
14             Version 0.135
15              
16             =cut
17              
18             our $VERSION = '0.135';
19              
20             =head1 SYNOPSIS
21              
22             use Array::Iterator::LegacyBiDirectional;
23              
24             # create an instance of the iterator
25             my $i = Array::Iterator::LegacyBiDirectional->new(1 .. 100);
26              
27             while ($some_condition_exists) {
28             # get the latest item from
29             # the iterator
30             my $current = $i->get_next();
31             # ...
32             if ($something_happens) {
33             # back up the iterator
34             $current = $i->get_previous();
35             }
36             }
37              
38             =head1 DESCRIPTION
39              
40             This is the old BiDirectional code.
41             It is kept for users who want the old way that the pointer was kept.
42             See RT#126034 for further details.
43              
44             Occasionally it is useful for an iterator to go in both directions, forward and backward. One example would be token processing. When looping though tokens it is sometimes necessary to advance forward looking for a match to a rule. If the match fails, a bi-directional iterator can be moved back so that the next rule can be tried.
45              
46             =cut
47              
48             our @ISA = qw(Array::Iterator);
49              
50             sub has_previous {
51 17     17 1 144 my ($self, $n) = @_;
52              
53 17 100       67 if(not defined $n) { $n = 1 }
  10 100       18  
    100          
54 1         11 elsif(not $n) { die "has_previous(0) doesn't make sense, did you mean current()?" }
55 1         13 elsif($n < 0) { die "has_previous() with negative argument doesn't make sense, did you mean has_next()?" }
56              
57 15         49 my $idx = $self->_current_index - $n;
58              
59 15 100       77 return ($idx > 0) ? 1 : 0;
60             }
61              
62 10     10 0 3269 sub hasPrevious { my $self = shift; $self->has_previous(@_) }
  10         30  
63              
64             sub previous {
65 5     5 1 3008 my ($self) = @_;
66 5 100       17 (($self->_current_index - 1) > 0)
67             || die "Out Of Bounds : no more elements";
68 4         18 $self->_iterated = 1;
69 4         12 return $self->_getItem($self->_iteratee, --$self->_current_index);
70             }
71              
72             sub get_previous {
73 5     5 1 10 my ($self) = @_;
74 5 100       23 return undef unless (($self->_current_index - 1) > 0); ## no critic: Subroutines::ProhibitExplicitReturnUndef
75 4         13 $self->_iterated = 1;
76 4         13 return $self->_getItem($self->_iteratee, --$self->_current_index);
77             }
78              
79 5     5 0 3331 sub getPrevious { my $self = shift; $self->get_previous(@_) }
  5         18  
80              
81             sub look_back {
82 14     14 1 135 my ($self, $n) = @_;
83              
84 14 100       54 if(not defined $n) { $n = 1 }
  5 100       11  
    100          
85 1         11 elsif(not $n) { die "look_back(0) doesn't make sense, did you mean get_previous()?" }
86 1         10 elsif($n < 0) { die "look_back() with negative argument doesn't make sense, did you mean get_next()?" }
87              
88 12         40 my $idx = $self->_current_index - ($n + 1);
89              
90 12 100       49 return undef unless ($idx > 0); ## no critic: Subroutines::ProhibitExplicitReturnUndef
91 7         44 $self->_iterated = 1;
92 7         24 return $self->_getItem($self->_iteratee, $idx);
93             }
94              
95 4     4 0 10 sub lookBack { my $self = shift; $self->look_back(@_) }
  4         13  
96              
97             1;
98              
99             #ABSTRACT: A subclass of Array::Iterator to allow forwards and backwards iteration
100              
101             =for Pod::Coverage .+
102              
103             =head1 METHODS
104              
105             This is a subclass of Array::Iterator, only those methods that have been added are documented here, refer to the Array::Iterator documentation for more information.
106              
107             =over 4
108              
109             =item B
110              
111             This method works much like C does, it will return true (C<1>) unless the beginning of the array has been reached, and false (C<0>) otherwise.
112              
113             Optional argument has the same meaning except that it specifies C<$n>th previous element.
114              
115             =item B
116              
117             This method is much like C. It will return the previous item in the iterator, and throw an exception if it attempts to reach past the beginning of the array.
118              
119             =item B
120              
121             This method is much like C. It will return the previous item in the iterator, and return undef if it attempts to reach past the beginning of the array.
122              
123             =item B
124              
125             This is the counterpart to C, it will return the previous items in the iterator, but will not affect the internal counter.
126              
127             Optional argument has the same meaning except that it specifies C<$n>th previous element.
128              
129             =back
130              
131             =head1 SEE ALSO
132              
133             This is a subclass of B, please refer to it for more documentation.
134              
135             =head1 ORIGINAL AUTHOR
136              
137             stevan little, Estevan@iinteractive.comE
138              
139             =head1 ORIGINAL COPYRIGHT AND LICENSE
140              
141             Copyright 2004 by Infinity Interactive, Inc.
142              
143             L
144              
145             This library is free software; you can redistribute it and/or modify
146             it under the same terms as Perl itself.
147              
148             =cut