File Coverage

blib/lib/PPIx/Regexp/Structure/BranchReset.pm
Criterion Covered Total %
statement 25 25 100.0
branch 6 8 75.0
condition 2 3 66.6
subroutine 6 6 100.0
pod n/a
total 39 42 92.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PPIx::Regexp::Structure::BranchReset - Represent a branch reset group
4              
5             =head1 SYNOPSIS
6              
7             use PPIx::Regexp::Dumper;
8             PPIx::Regexp::Dumper->new( 'qr{(?|(foo)|(bar))}smx' )
9             ->print();
10              
11             =head1 INHERITANCE
12              
13             C<PPIx::Regexp::Structure::BranchReset> is a
14             L<PPIx::Regexp::Structure|PPIx::Regexp::Structure>.
15              
16             C<PPIx::Regexp::Structure::BranchReset> has no descendants.
17              
18             =head1 DESCRIPTION
19              
20             This class represents a branch reset group. That is, the construction
21             C<(?|(...)|(...)|...)>. This is new with Perl 5.010.
22              
23             =head1 METHODS
24              
25             This class provides no public methods beyond those provided by its
26             superclass.
27              
28             =cut
29              
30             package PPIx::Regexp::Structure::BranchReset;
31              
32 9     9   39 use strict;
  9         10  
  9         275  
33 9     9   30 use warnings;
  9         11  
  9         313  
34              
35 9     9   29 use base qw{ PPIx::Regexp::Structure };
  9         11  
  9         717  
36              
37 9     9   39 use Carp qw{ confess };
  9         11  
  9         410  
38 9     9   38 use PPIx::Regexp::Constant qw{ @CARP_NOT };
  9         11  
  9         1839  
39              
40             our $VERSION = '0.091';
41              
42             # Called by the lexer to record the capture number.
43             sub __PPIX_LEXER__record_capture_number {
44 6     6   13 my ( $self, $number ) = @_;
45 6 50       17 defined $number
46             or confess 'Programming error - initial $number is undef';
47 6         12 my $original = $number;
48 6         9 my $hiwater = $number;
49 6         42 foreach my $kid ( $self->children() ) {
50 16 100 66     84 if ( $kid->isa( 'PPIx::Regexp::Token::Operator' )
51             && $kid->content() eq '|' ) {
52 5 50       13 $number > $hiwater and $hiwater = $number;
53 5         10 $number = $original;
54             } else {
55 11         39 $number = $kid->__PPIX_LEXER__record_capture_number( $number );
56             }
57             }
58 6 100       24 return $number > $hiwater ? $number : $hiwater;
59             }
60              
61             1;
62              
63             __END__
64              
65             =head1 SUPPORT
66              
67             Support is by the author. Please file bug reports at
68             L<https://rt.cpan.org/Public/Dist/Display.html?Name=PPIx-Regexp>,
69             L<https://github.com/trwyant/perl-PPIx-Regexp/issues>, or in
70             electronic mail to the author.
71              
72             =head1 AUTHOR
73              
74             Thomas R. Wyant, III F<wyant at cpan dot org>
75              
76             =head1 COPYRIGHT AND LICENSE
77              
78             Copyright (C) 2009-2023, 2025 by Thomas R. Wyant, III
79              
80             This program is free software; you can redistribute it and/or modify it
81             under the same terms as Perl 5.10.0. For more details, see the full text
82             of the licenses in the directory LICENSES.
83              
84             This program is distributed in the hope that it will be useful, but
85             without any warranty; without even the implied warranty of
86             merchantability or fitness for a particular purpose.
87              
88             =cut
89              
90             # ex: set textwidth=72 :