File Coverage

blib/lib/List/AutoNumbered.pm
Criterion Covered Total %
statement 62 62 100.0
branch 18 18 100.0
condition 3 3 100.0
subroutine 22 22 100.0
pod 8 8 100.0
total 113 113 100.0


line stmt bran cond sub pod time code
1             package List::AutoNumbered;
2              
3 6     6   357985 use 5.006;
  6         73  
4 6     6   33 use strict;
  6         12  
  6         134  
5 6     6   29 use warnings;
  6         11  
  6         211  
6             use overload
7 6     6   6178 '@{}' => \&arr;
  6         5240  
  6         42  
8              
9             our $VERSION = '0.000009'; # TRIAL
10              
11             # Exports
12 6     6   3180 use parent 'Exporter';
  6         1819  
  6         34  
13             our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
14             BEGIN {
15 6     6   653 @EXPORT = qw(LSKIP);
16 6         13 @EXPORT_OK = qw(*TRACE); # can be localized
17 6         125 %EXPORT_TAGS = (
18             default => [@EXPORT],
19             all => [@EXPORT, @EXPORT_OK]
20             );
21             }
22              
23             # Imports
24 6     6   2961 use Getargs::Mixed;
  6         6384  
  6         4136  
25              
26             # Documentation ======================================================== {{{1
27              
28             =head1 NAME
29              
30             List::AutoNumbered - Add sequential numbers to lists while creating them
31              
32             =head1 SYNOPSIS
33              
34             This module adds sequential numbers to lists of lists so you don't have to
35             type all the numbers. Its original use case was for adding line numbers
36             to lists of testcases. For example:
37              
38             use List::AutoNumbered; # line 1
39             my $list = List::AutoNumbered->new(__LINE__); # line 2
40             $list->load("a")-> # line 3
41             ("b") # line 4
42             ("c") # line 5
43             ("d"); # line 6
44              
45             # Now $list->arr is [ [3,"a"], [4,"b"], [5,"c"], [6,"d"] ]
46             # and @$list is ( [3,"a"] ... ).
47              
48             In general, you can pass any number to the constructor. For example:
49              
50             use List::AutoNumbered;
51             use Test::More tests => 1;
52              
53             my $list = List::AutoNumbered->new; # First entry will be number 1
54             $list->load("a")-> # Yes, trailing arrow
55             ("b") # Magic! Don"t need any more arrows!
56             ("c")
57             ("d");
58              
59             is_deeply($list->arr, [
60             [1, "a"], [2, "b"], [3, "c"], [4, "d"]
61             ]); # Yes, it is!
62              
63             =cut
64              
65             our $TRACE = 0; # Documented below
66              
67             =head1 METHODS
68              
69             =cut
70              
71             # }}}1
72              
73             # Internal helpers {{{1
74              
75             # Defined-or
76 40 100   40   227 sub _dor { (defined $_[0]) ? $_[0] : $_[1] }
77              
78             # }}}1
79              
80             =head2 new
81              
82             Constructor. Basic usage options:
83              
84             $list = List::AutoNumbered->new(); # first list item is number 1
85             $list = List::AutoNumbered->new($num); # first list item is $num+1
86             $list = List::AutoNumbered->new(-at => $num); # ditto
87              
88             Each successive element
89             will have the next number, unless you say otherwise (e.g., using
90             L). Specifically, the first item in the list will be numbered
91             one higher than the number passed to the C constructor.
92              
93             Constructor parameters are processed using L, so positional
94             and named parameters are both OK.
95              
96             =head3 The C function
97              
98             You can give the constructor a "how" function that will make the list entry
99             for a single L or L call:
100              
101             $list = List::AutoNumbered->new(-how => sub { @_ });
102             # Jam everything together to make a flat array
103             $list = List::AutoNumbered->new(41, sub { @_ });
104             # Positional is OK, too.
105              
106             The C function is called as C. C<$num> is the
107             line number for L calls, or C for L calls.
108             C<@data> is whatever data you passed to C or C. For example,
109             the default C function is:
110              
111             sub how {
112             shift unless defined $_[0]; # add passes undef as the line number.
113             [@_] # Wrap everything in an arrayref.
114             }
115              
116             See C for examples of custom C functions.
117              
118             =cut
119              
120             sub new {
121 20     20 1 5379 my ($class, %args) = parameters('self',[qw(; at how)], @_);
122             my $self = bless {
123             num => _dor($args{at}, 0), # The last number used
124             arr => [], # The data
125             how => _dor($args{how}, # Routine to make a list item
126             sub {
127 31 100   31   66 shift unless defined $_[0]; # add passes undef
128             # as the line number.
129 31         72 [@_] # By default, just wrap it
130             }
131 20         1240 ),
132             }, $class;
133              
134             # Make a loader that adds an item and returns itself --- not $self.
135             # Note that $self is captured --- the loader function does not take
136             # a $self argument.
137 20     37   274 $self->{loader} = sub { $self->_L(@_); return $self->{loader} };
  37         138  
  37         80  
138              
139 20 100       190 print "# Created - now $self->{num}\n" if $TRACE;
140 20         80 return $self;
141             } #new()
142              
143             # Accessors {{{1
144              
145             =head2 size
146              
147             Returns the size of the array. Like C.
148              
149             =cut
150              
151 19     19 1 373 sub size { scalar @{ shift->{arr} }; }
  19         106  
152              
153             =head2 last
154              
155             Returns the index of the last element in the array. Like C<$#array>.
156              
157             =cut
158              
159 8     8 1 24 sub last { shift->size-1; }
160              
161             =head2 arr
162              
163             Returns a reference to the array being built. Please do not modify this
164             array directly until you are done loading it. List::AutoNumbered may not
165             work if you do.
166              
167             This can also be called by using the List::AutoNumbered object as an array:
168              
169             my $list = List::AutoNumbered->new...;
170             foreach my $item (@$list) { ... } # Instead of my $item (@{$list->arr})
171              
172             =cut
173              
174 34     34 1 2124 sub arr { shift->{arr}; }
175              
176             =head2 last_number
177              
178             Returns the current number stored by the instance. This is the number
179             of the most recently preceding L or L call.
180             This is B the number that will be given to the next record, since that
181             depends on whether or not the next record has a skip (L).
182              
183             =cut
184              
185 7     7 1 42 sub last_number { shift->{num} }
186              
187             # }}}1
188             # Loading {{{1
189              
190             =head2 load
191              
192             Push a new record with the next number on the front. Usage:
193              
194             $instance->load(whatever args you want to push);
195              
196             Or, if the current record isn't associated with the number immediately after
197             the previous record,
198              
199             $instance->load(LSKIP $n, args);
200              
201             where C<$n> is the number of lines between this C call and the last one.
202              
203             Returns a coderef that you can call to chain loads. For example, this works:
204              
205             $instance->load(...)->(...)(...)(...) ... ;
206             # You need an arrow ^^ here, but don't need any after that.
207              
208             =cut
209              
210 25     25 1 2298 sub load { goto &{ shift->{loader} } } # kick off loading
  25         109  
211              
212             # _L: Implementation of load()
213             sub _L {
214 37     37   56 my $self = shift;
215              
216 37 100       77 shift if $self->_update_lnum(@_); # Check for skipped lines from LSKIP()
217              
218 37         51 push @{ $self->{arr} }, $self->{how}->($self->{num}, @_);
  37         114  
219 37         113 return $self;
220             } #_L()
221              
222             =head2 add
223              
224             Add to the array being built, B inserting the number on the front.
225             Does increment the number and respect skips, for consistency.
226              
227             Returns the instance.
228              
229             =cut
230              
231             sub add { # just add it
232 8     8 1 124 my $self = shift;
233 8 100       23 shift if $self->_update_lnum(@_); # Check for skipped lines from LSKIP()
234 8         20 push @{ $self->{arr} }, $self->{how}->(undef, @_);
  8         42  
235 8         41 return $self;
236             } #add
237              
238             # }}}1
239             # Skipping {{{1
240              
241             =head1 FUNCTIONS
242              
243             =head2 LSKIP
244              
245             A convenience function to create a skipper. Prototyped as C<($)> so you can
246             use it conveniently with L:
247              
248             $instance->load(LSKIP 1, whatever args...);
249              
250             If you are using line numbers, the parameter to C should be the number
251             of lines above the current line and below the last L or
252             L call. For example:
253              
254             my $instance = List::AutoNumbered->new(__LINE__);
255             # A line
256             # Another one
257             $instance->load(LSKIP 2, # two comment lines between new() and here
258             'some data');
259              
260             =cut
261              
262             sub LSKIP ($) {
263 19     19 1 1421 List::AutoNumbered::Skipper->new(@_);
264             } #LSKIP()
265              
266             # _update_lnum: Increment the line number, and run a skip if there is one.
267             # Call from a method as:
268             # my $self = shift;
269             # shift if $self->_update_lnum(@_);
270              
271             sub _update_lnum {
272 45     45   73 my $self = shift;
273              
274 45 100       113 if(ref $_[0] eq 'List::AutoNumbered::Skipper') { # implies scalar @_
275 12         40 $self->{num} += $_[0]->{how_many} + 1;
276 12 100       54 print "# Skipped $_[0]->{how_many} - now $self->{num}\n" if $TRACE;
277 12         37 return 1; # We do need to shift
278              
279             } else {
280 33         62 ++$self->{num};
281 33 100       111 print "# Incremented - now $self->{num}\n" if $TRACE;
282 33         102 return 0; # No skipper, so don't shift it off.
283             }
284             } #_update_lnum()
285              
286             =head1 INTERNAL PACKAGES
287              
288             =head2 List::AutoNumbered::Skipper
289              
290             This package represents a skip and is created by L.
291             No user-serviceable parts inside.
292              
293             =cut
294              
295             {
296             package List::AutoNumbered::Skipper;
297 6     6   53 use Scalar::Util qw(looks_like_number);
  6         11  
  6         979  
298              
299             =head3 new
300              
301             Creates a new skipper. Parameters are for internal use only and are not
302             part of the public API.
303              
304             =cut
305              
306             sub new {
307 24     24   2397 my $class = shift;
308 24 100 100     267 die "Need a single number" unless @_==1 and looks_like_number $_[0];
309 14         84 bless {how_many => $_[0]}, $class;
310             }
311             } #List::AutoNumbered::Skipper
312              
313             # }}}1
314              
315             1; # End of List::AutoNumbered
316              
317             # Rest of the docs {{{1
318             __END__