File Coverage

blib/lib/Regexp/Result.pm
Criterion Covered Total %
statement 55 65 84.6
branch 1 6 16.6
condition n/a
subroutine 16 23 69.5
pod 5 7 71.4
total 77 101 76.2


line stmt bran cond sub pod time code
1             package Regexp::Result;
2 2     2   32203 use strict;
  2         4  
  2         82  
3 2     2   9 use warnings;
  2         3  
  2         63  
4 2     2   1256 use Moo;
  2         28263  
  2         13  
5 2     2   2658 use 5.010; # we require ${^MATCH} etc
  2         6  
  2         80  
6             our $VERSION = '0.004';
7 2     2   9 use Exporter qw(import);
  2         3  
  2         85  
8             our @EXPORT_OK = qw(rr);
9 2     2   9 use Sub::Name 'subname';
  2         3  
  2         247  
10              
11             =head1 NAME
12              
13             Regexp::Result - store information about a regexp match for later retrieval
14              
15             =head1 SYNOPSIS
16              
17             $foo =~ /(a|an|the) (\w+)/;
18             my $result = Regexp::Result->new();
19            
20             # or, equivalently
21             my $result = rr;
22              
23             # ...
24             # some other code which potentially executes a regular expression
25              
26             my $determiner = $result->c(1);
27             # i.e. $1 at the time when the object was created
28              
29             Have you ever wanted to retain information about a regular expression
30             match, without having to go through the palaver of pulling things out
31             of C<$1>, C, etc. and assigning them each to temporary variables
32             until you've decided what to use them as?
33              
34             Regexp::Result objects, when created, contain as much information about
35             a match as perl can tell you. This means that you just need to create
36             one variable and keep it.
37              
38             Hopefully, your code will be more comprehensible when it looks like
39             C<< $result->last_numbered_match_start->[-1] >>,
40             instead of C<$-[-1]>. The documentation for the punctuation
41             variables, by the way, is hidden away in C
42             along with scary things like C<^H>. I've copied most of it and/or
43             rewritten it below.
44              
45             =head1 FUNCTIONS
46              
47             =head3 rr
48              
49             use Regexp::Result qw(rr);
50            
51             $foo =~ /(a|an|the) (\w+)/;
52             my $result = rr;
53              
54             Equivalent to calling C<< Regexp::Result->new() >>.
55              
56             =cut
57              
58             sub rr {
59 1     1 1 21 __PACKAGE__->new
60             }
61              
62             =head1 METHODS
63              
64             =head3 new
65              
66             Creates a new Regexp::Result object. The object will gather data from
67             the last match (if successful) and store it for later retrieval.
68              
69             Note that almost all of the contents are read-only.
70              
71             =cut
72              
73             =head3 numbered_captures
74              
75             This accesses C<$1>, C<$2>, etc as C<< $rr->numbered_captures->[0] >>
76             etc. Note the numbering difference!
77              
78             =cut
79              
80             has numbered_captures=>
81             is => 'ro',
82             default => sub{
83             my $captures = [];
84 2     2   9 no strict 'refs';
  2         2  
  2         111  
85             for my $i (1..$#-) { #~ i.e until the end of LAST_MATCH_START
86             push @$captures, ${$i};
87             }
88 2     2   7 use strict 'refs';
  2         3  
  2         350  
89             $captures;
90             };
91              
92             =head3 c
93              
94             This accesses the contents of C, but uses numbers from 1
95             for comparability with C<$1>, C<$2>, C<$3>, etc.
96              
97             =cut
98              
99             sub c {
100 5     5 1 18 my ($self, $number) = @_;
101 5 50       10 if ($number) {
102             #:todo: consider allowing more than one number
103 5         28 return $self->numbered_captures->[$number - 1];
104             }
105 0         0 return undef;
106             }
107              
108             sub _has_scalar {
109 14     14   37 my ($name, $creator) = @_;
110 14         32 has $name =>
111             is => 'ro',
112             default => $creator
113             }
114              
115             #~ _has_array
116             #~
117             #~ _has_array primes => sub { [2,3,5,7,11] };
118             #~ $object->primes->[0]; # 2
119             #~ $object->primes(0); # also 2
120              
121             sub _has_array {
122 4     4   7 my ($name, $creator) = @_;
123 4         14 my $realName = '_'.$name;
124 4         10 has $realName =>
125             is => 'ro',
126             default => $creator;
127             my $accessor = sub {
128 0     0 1 0 my $self = shift;
        0 1    
        0      
129 0 0       0 if (@_) {
130             #~ ideally check if @_ contains only numbers
131             #~ Should foo(1,3) return something different?
132 0         0 return $self->$realName->[@_];
133             }
134             else {
135 0         0 return $self->$realName;
136             }
137 4         679 };
138             {
139 4         6 my $package = __PACKAGE__;
  4         7  
140 2     2   8 no strict 'refs';
  2         16  
  2         298  
141 4         14 my $fullName = $package . '::' . $name;
142 4         32 *$fullName = subname( $name, $accessor );
143             }
144             }
145              
146             sub _has_hash {
147 4     4   5 my ($name, $creator) = @_;
148 4         9 my $realName = '_'.$name;
149 4         9 has $realName =>
150             is => 'ro',
151             default => $creator;
152             my $accessor = sub {
153 0     0 0 0 my $self = shift;
        0 0    
        0      
154 0 0       0 if (@_) {
155 0         0 return $self->$realName->{@_};
156             }
157             else {
158 0         0 return $self->$realName;
159             }
160 4         699 };
161             {
162 4         7 my $package = __PACKAGE__;
  4         4  
163 2     2   9 no strict 'refs';
  2         2  
  2         596  
164 4         8 my $fullName = $package . '::' . $name;
165 4         37 *$fullName = subname( $name, $accessor );
166             }
167             }
168              
169             =head3 match, prematch, postmatch
170              
171             'The quick brown fox' =~ /q[\w]+/p;
172             my $rr = Regexp::Result->new();
173             print $rr->match; # prints 'quick'
174             print $rr->prematch; # prints 'The '
175             print $rr->postmatch; # prints ' brown fox'
176              
177             When a regexp is executed with the C

flag, the variables
178             C<${^MATCH}>, C<${^PREMATCH}>, and C<${^POSTMATCH}> are set.
179             These correspond to the entire text matched by the regular expression,
180             the text in the string which preceded the matched text, and the text in
181             the string which followed it.
182              
183             The C method provides access to the data in C<${^MATCH}>.
184              
185             The C method provides access to the data in C<${^PREMATCH}>.
186              
187             The C method provides access to the data in C<${^POSTMATCH}>.
188              
189             Note: no accessor is provided for C<$&>, C<$`>, and C<$'>, because:
190              
191             a) The author feels they are unnecessary since perl 5.10 introduced
192             C<${^MATCH}> etc.
193              
194             b) Implementing accessors for them would force a performance penalty
195             on everyone who uses this module, even if they don't have any need of
196             C<$&>.
197              
198             =cut
199              
200             _has_scalar match => sub{
201             ${^MATCH}
202             };
203              
204             _has_scalar prematch => sub{
205             ${^PREMATCH}
206             };
207              
208             _has_scalar postmatch => sub{
209             ${^POSTMATCH}
210             };
211             =head3 last_paren_match
212              
213             Equivalent to C<$+>.
214              
215             The text matched by the last capturing parentheses of the match.
216             This is useful if you don't know which one of a set of
217             alternative patterns matched. For example, in:
218              
219             /Version: (.*)|Revision: (.*)/
220              
221             C stores either the version or revision (whichever
222             exists); perl would number these C<$1> and C<$2>.
223              
224             =cut
225              
226             _has_scalar last_paren_match => sub{
227             $+;
228             };
229              
230             =head3 last_submatch_result
231              
232             Equivalent to C<$^N>.
233              
234             =cut
235              
236             _has_scalar last_submatch_result => sub{
237             $^N;
238             };
239              
240             =head3 last_numbered_match_end
241              
242             Equivalent to C<@+>.
243              
244             This array holds the offsets of the ends of the last successful
245             submatches in the currently active dynamic scope. C<$+[0]> is the
246             offset into the string of the end of the entire match. This is the
247             same value as what the C function returns when called on the
248             variable that was matched against. The nth element of this array
249             holds the offset of the nth submatch, so C<$+[1]> is the offset past
250             where C<$1> ends, C<$+[2]> the offset past where C<$2> ends, and so
251             on.
252              
253             =cut
254              
255             _has_array last_numbered_match_end => sub{
256             [@+]
257             };
258              
259             =head3 last_numbered_match_start
260              
261             Equivalent to C<@->.
262              
263             This array holds the offsets of the starts of the last successful
264             submatches in the currently active dynamic scope. C<$-[0]> is the
265             offset into the string of the start of the entire match. The nth
266             element of this array holds the offset of the nth submatch, so
267             C<$-[1]> is the offset where C<$1> starts, C<$-[2]> the offset
268             where C<$2> starts, and so on.
269              
270             =cut
271              
272             _has_array last_numbered_match_start => sub{
273             [@-]
274             };
275             =head3 named_paren_matches
276              
277             'wxyz' =~ /(?w)(?x)(?y)(?z)/
278              
279             # named_paren_matches is now:
280             #
281             # {
282             # EVEN => [ 'x', 'z' ],
283             # ODD => [ 'w', 'y' ]
284             # }
285              
286             Equivalent to C<%->.
287              
288             This variable allows access to the named capture
289             groups in the last successful match in the currently active
290             dynamic scope. To each capture group name found in the regular
291             expression, it associates a reference to an array containing the
292             list of values captured by all buffers with that name (should
293             there be several of them), in the order where they appear.
294              
295             =cut
296              
297             _has_hash named_paren_matches => sub{
298 2     2   948 {%-}
  2         779  
  2         253  
299             };
300              
301             =head3 last_named_paren_matches
302              
303             'wxyz' =~ /(?w)(?x)(?y)(?z)/
304              
305             # last_named_paren_matches is now:
306             #
307             # {
308             # EVEN => 'x',
309             # ODD => 'w',
310             # }
311              
312             The "%+" hash allows access to the named capture
313             buffers, should they exist, in the last successful match in the
314             currently active dynamic scope.
315              
316             The keys of the "%+" hash list only the names of buffers that have
317             captured (and that are thus associated to defined values).
318              
319             Note: C<%-> and C<%+> are tied views into a common internal hash
320             associated with the last successful regular expression. Therefore
321             mixing iterative access to them via C may have unpredictable
322             results. Likewise, if the last successful match changes, then the
323             results may be surprising.
324              
325             Author's note: I have no idea why this is a useful thing to use.
326             But perl provides it, and it is occasionally used according to
327             L (461 distros, of which some the string
328             C<\%\+|\$\+\{> is in a binary stream).
329              
330             =cut
331              
332             _has_hash last_named_paren_match => sub{
333             {%+}
334             };
335              
336             =head3 last_regexp_code_result
337              
338             The result of evaluation of the last successful C<(?{ code })>
339             regular expression assertion (see L).
340              
341             =cut
342              
343             _has_scalar last_regexp_code_result => sub{
344             $^R;
345             };
346              
347             =head3 re_debug_flags
348              
349             The current value of the regex debugging flags. Set to 0 for no
350             debug output even when the C module is loaded. See
351             L for details.
352              
353             =cut
354              
355             _has_scalar re_debug_flags => sub{
356             ${^RE_DEBUG_FLAGS}
357             };
358              
359             =head3 pos
360              
361             Returns the end of the match. Equivalent to C<$+[0]>.
362              
363             =cut
364              
365             sub pos {
366 0     0 1   return shift->last_match_end->[0];
367             }
368              
369             =head1 BUGS
370              
371             Please report any bugs or feature requests to the github issues tracker at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
372              
373             =head1 AUTHORS
374              
375             Daniel Perrett
376              
377             =head1 LICENSE AND COPYRIGHT
378              
379             Copyright 2012-2013 Daniel Perrett.
380              
381             This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License.
382              
383             See L for more information.
384              
385              
386             =cut
387              
388             1;
389