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   358381 use 5.006;
  6         73  
4 6     6   37 use strict;
  6         12  
  6         130  
5 6     6   28 use warnings;
  6         12  
  6         346  
6             use overload
7 6     6   6151 '@{}' => \&arr;
  6         5081  
  6         46  
8              
9             our $VERSION = '0.000010';
10              
11             # Exports
12 6     6   3226 use parent 'Exporter';
  6         1804  
  6         31  
13             our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
14             BEGIN {
15 6     6   645 @EXPORT = qw(LSKIP);
16 6         15 @EXPORT_OK = qw(*TRACE); # can be localized
17 6         132 %EXPORT_TAGS = (
18             default => [@EXPORT],
19             all => [@EXPORT, @EXPORT_OK]
20             );
21             }
22              
23             # Imports
24 6     6   2853 use Getargs::Mixed;
  6         6419  
  6         4068  
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   224 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 5113 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   69 shift unless defined $_[0]; # add passes undef
128             # as the line number.
129 31         77 [@_] # By default, just wrap it
130             }
131 20         1289 ),
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   271 $self->{loader} = sub { $self->_L(@_); return $self->{loader} };
  37         146  
  37         87  
138              
139 20 100       215 print "# Created - now $self->{num}\n" if $TRACE;
140 20         79 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 515 sub size { scalar @{ shift->{arr} }; }
  19         108  
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 26 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 2132 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 47 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 2065 sub load { goto &{ shift->{loader} } } # kick off loading
  25         160  
211              
212             # _L: Implementation of load()
213             sub _L {
214 37     37   57 my $self = shift;
215              
216 37 100       76 shift if $self->_update_lnum(@_); # Check for skipped lines from LSKIP()
217              
218 37         56 push @{ $self->{arr} }, $self->{how}->($self->{num}, @_);
  37         146  
219 37         115 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 140 my $self = shift;
233 8 100       22 shift if $self->_update_lnum(@_); # Check for skipped lines from LSKIP()
234 8         20 push @{ $self->{arr} }, $self->{how}->(undef, @_);
  8         41  
235 8         40 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 1505 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   56 my $self = shift;
273              
274 45 100       121 if(ref $_[0] eq 'List::AutoNumbered::Skipper') { # implies scalar @_
275 12         44 $self->{num} += $_[0]->{how_many} + 1;
276 12 100       104 print "# Skipped $_[0]->{how_many} - now $self->{num}\n" if $TRACE;
277 12         38 return 1; # We do need to shift
278              
279             } else {
280 33         58 ++$self->{num};
281 33 100       116 print "# Incremented - now $self->{num}\n" if $TRACE;
282 33         118 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   50 use Scalar::Util qw(looks_like_number);
  6         12  
  6         876  
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   2370 my $class = shift;
308 24 100 100     254 die "Need a single number" unless @_==1 and looks_like_number $_[0];
309 14         87 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__