This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Text::Balanced from 2.03 to 2.04
authorMax Maischein <corion@corion.net>
Fri, 18 Dec 2020 09:12:49 +0000 (10:12 +0100)
committerMax Maischein <corion@corion.net>
Fri, 18 Dec 2020 09:12:49 +0000 (10:12 +0100)
No entry in Perldelta because that will be generated automatically

17 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/Text-Balanced/lib/Text/Balanced.pm
cpan/Text-Balanced/t/01_compile.t
cpan/Text-Balanced/t/02_extbrk.t
cpan/Text-Balanced/t/03_extcbk.t
cpan/Text-Balanced/t/04_extdel.t
cpan/Text-Balanced/t/05_extmul.t
cpan/Text-Balanced/t/06_extqlk.t
cpan/Text-Balanced/t/07_exttag.t
cpan/Text-Balanced/t/08_extvar.t
cpan/Text-Balanced/t/09_gentag.t
cpan/Text-Balanced/t/94_changes.t [new file with mode: 0644]
cpan/Text-Balanced/t/95_critic.t [new file with mode: 0644]
cpan/Text-Balanced/t/96_pmv.t [new file with mode: 0644]
cpan/Text-Balanced/t/97_pod.t [new file with mode: 0644]
cpan/Text-Balanced/t/98_pod_coverage.t [new file with mode: 0644]

index 6ac7ad4..c79545e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2581,6 +2581,11 @@ cpan/Text-Balanced/t/06_extqlk.t See if Text::Balanced works
 cpan/Text-Balanced/t/07_exttag.t       See if Text::Balanced works
 cpan/Text-Balanced/t/08_extvar.t       See if Text::Balanced works
 cpan/Text-Balanced/t/09_gentag.t       See if Text::Balanced works
+cpan/Text-Balanced/t/94_changes.t
+cpan/Text-Balanced/t/95_critic.t
+cpan/Text-Balanced/t/96_pmv.t
+cpan/Text-Balanced/t/97_pod.t
+cpan/Text-Balanced/t/98_pod_coverage.t
 cpan/Text-ParseWords/lib/Text/ParseWords.pm    Perl module to split words on arbitrary delimiter
 cpan/Text-ParseWords/t/ParseWords.t            See if Text::ParseWords works
 cpan/Text-ParseWords/t/taint.t                 See if Text::ParseWords works with tainting
index 74b930b..dc608ef 100755 (executable)
@@ -1109,7 +1109,7 @@ use File::Glob qw(:case);
     },
 
     'Text::Balanced' => {
-        'DISTRIBUTION' => 'SHAY/Text-Balanced-2.03.tar.gz',
+        'DISTRIBUTION' => 'SHAY/Text-Balanced-2.04.tar.gz',
         'FILES'        => q[cpan/Text-Balanced],
         'EXCLUDED'     => [
             qw( t/97_meta.t
index f1a5780..324a023 100644 (file)
@@ -1,35 +1,44 @@
+# Copyright (C) 1997-2001 Damian Conway.  All rights reserved.
+# Copyright (C) 2009 Adam Kennedy.
+# Copyright (C) 2015 Steve Hay.  All rights reserved.
+
+# This module is free software; you can redistribute it and/or modify it under
+# the same terms as Perl itself, i.e. under the terms of either the GNU General
+# Public License or the Artistic License, as specified in the F<LICENCE> file.
+
 package Text::Balanced;
 
 # EXTRACT VARIOUSLY DELIMITED TEXT SEQUENCES FROM STRINGS.
 # FOR FULL DOCUMENTATION SEE Balanced.pod
 
-use 5.005;
+use 5.008001;
 use strict;
 use Exporter ();
-use SelfLoader;
 
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 BEGIN {
-       $VERSION     = '2.03';
-       @ISA         = 'Exporter';
-       %EXPORT_TAGS = (
-               ALL => [ qw{
-                       &extract_delimited
-                       &extract_bracketed
-                       &extract_quotelike
-                       &extract_codeblock
-                       &extract_variable
-                       &extract_tagged
-                       &extract_multiple
-                       &gen_delimited_pat
-                       &gen_extract_tagged
-                       &delimited_pat
-               } ],
-       );
+    $VERSION     = '2.04';
+    @ISA         = 'Exporter';
+    %EXPORT_TAGS = (
+        ALL => [ qw{
+            &extract_delimited
+            &extract_bracketed
+            &extract_quotelike
+            &extract_codeblock
+            &extract_variable
+            &extract_tagged
+            &extract_multiple
+            &gen_delimited_pat
+            &gen_extract_tagged
+            &delimited_pat
+        } ],
+    );
 }
 
 Exporter::export_ok_tags('ALL');
 
+## no critic (Subroutines::ProhibitSubroutinePrototypes)
+
 # PROTOTYPES
 
 sub _match_bracketed($$$$$$);
@@ -40,80 +49,80 @@ sub _match_quotelike($$$$);
 # HANDLE RETURN VALUES IN VARIOUS CONTEXTS
 
 sub _failmsg {
-       my ($message, $pos) = @_;
-       $@ = bless {
-               error => $message,
-               pos   => $pos,
-       }, 'Text::Balanced::ErrorMsg';
+    my ($message, $pos) = @_;
+    $@ = bless {
+        error => $message,
+        pos   => $pos,
+    }, 'Text::Balanced::ErrorMsg';
 }
 
 sub _fail {
-       my ($wantarray, $textref, $message, $pos) = @_;
-       _failmsg $message, $pos if $message;
-       return (undef, $$textref, undef) if $wantarray;
-       return undef;
+    my ($wantarray, $textref, $message, $pos) = @_;
+    _failmsg $message, $pos if $message;
+    return (undef, $$textref, undef) if $wantarray;
+    return;
 }
 
 sub _succeed {
-       $@ = undef;
-       my ($wantarray,$textref) = splice @_, 0, 2;
-       my ($extrapos, $extralen) = @_ > 18
-               ? splice(@_, -2, 2)
-               : (0, 0);
-       my ($startlen, $oppos) = @_[5,6];
-       my $remainderpos = $_[2];
-       if ( $wantarray ) {
-               my @res;
-               while (my ($from, $len) = splice @_, 0, 2) {
-                       push @res, substr($$textref, $from, $len);
-               }
-               if ( $extralen ) { # CORRECT FILLET
-                       my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n");
-                       $res[1] = "$extra$res[1]";
-                       eval { substr($$textref,$remainderpos,0) = $extra;
-                              substr($$textref,$extrapos,$extralen,"\n")} ;
-                               #REARRANGE HERE DOC AND FILLET IF POSSIBLE
-                       pos($$textref) = $remainderpos-$extralen+1; # RESET \G
-               } else {
-                       pos($$textref) = $remainderpos;             # RESET \G
-               }
-               return @res;
-       } else {
-               my $match = substr($$textref,$_[0],$_[1]);
-               substr($match,$extrapos-$_[0]-$startlen,$extralen,"") if $extralen;
-               my $extra = $extralen
-                       ? substr($$textref, $extrapos, $extralen)."\n" : "";
-               eval {substr($$textref,$_[4],$_[1]+$_[5])=$extra} ;     #CHOP OUT PREFIX & MATCH, IF POSSIBLE
-               pos($$textref) = $_[4];                         # RESET \G
-               return $match;
-       }
+    $@ = undef;
+    my ($wantarray,$textref) = splice @_, 0, 2;
+    my ($extrapos, $extralen) = @_ > 18
+        ? splice(@_, -2, 2)
+        : (0, 0);
+    my ($startlen, $oppos) = @_[5,6];
+    my $remainderpos = $_[2];
+    if ( $wantarray ) {
+        my @res;
+        while (my ($from, $len) = splice @_, 0, 2) {
+            push @res, substr($$textref, $from, $len);
+        }
+        if ( $extralen ) { # CORRECT FILLET
+            my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n");
+            $res[1] = "$extra$res[1]";
+            eval { substr($$textref,$remainderpos,0) = $extra;
+                   substr($$textref,$extrapos,$extralen,"\n")} ;
+                    #REARRANGE HERE DOC AND FILLET IF POSSIBLE
+            pos($$textref) = $remainderpos-$extralen+1; # RESET \G
+        } else {
+            pos($$textref) = $remainderpos;             # RESET \G
+        }
+        return @res;
+    } else {
+        my $match = substr($$textref,$_[0],$_[1]);
+        substr($match,$extrapos-$_[0]-$startlen,$extralen,"") if $extralen;
+        my $extra = $extralen
+            ? substr($$textref, $extrapos, $extralen)."\n" : "";
+        eval {substr($$textref,$_[4],$_[1]+$_[5])=$extra} ;     #CHOP OUT PREFIX & MATCH, IF POSSIBLE
+        pos($$textref) = $_[4];                         # RESET \G
+        return $match;
+    }
 }
 
 # BUILD A PATTERN MATCHING A SIMPLE DELIMITED STRING
 
 sub gen_delimited_pat($;$)  # ($delimiters;$escapes)
 {
-       my ($dels, $escs) = @_;
-       return "" unless $dels =~ /\S/;
-       $escs = '\\' unless $escs;
-       $escs .= substr($escs,-1) x (length($dels)-length($escs));
-       my @pat = ();
-       my $i;
-       for ($i=0; $i<length $dels; $i++)
-       {
-               my $del = quotemeta substr($dels,$i,1);
-               my $esc = quotemeta substr($escs,$i,1);
-               if ($del eq $esc)
-               {
-                       push @pat, "$del(?:[^$del]*(?:(?:$del$del)[^$del]*)*)$del";
-               }
-               else
-               {
-                       push @pat, "$del(?:[^$esc$del]*(?:$esc.[^$esc$del]*)*)$del";
-               }
-       }
-       my $pat = join '|', @pat;
-       return "(?:$pat)";
+    my ($dels, $escs) = @_;
+    return "" unless $dels =~ /\S/;
+    $escs = '\\' unless $escs;
+    $escs .= substr($escs,-1) x (length($dels)-length($escs));
+    my @pat = ();
+    my $i;
+    for ($i=0; $i<length $dels; $i++)
+    {
+        my $del = quotemeta substr($dels,$i,1);
+        my $esc = quotemeta substr($escs,$i,1);
+        if ($del eq $esc)
+        {
+            push @pat, "$del(?:[^$del]*(?:(?:$del$del)[^$del]*)*)$del";
+        }
+        else
+        {
+            push @pat, "$del(?:[^$esc$del]*(?:$esc.[^$esc$del]*)*)$del";
+        }
+    }
+    my $pat = join '|', @pat;
+    return "(?:$pat)";
 }
 
 *delimited_pat = \&gen_delimited_pat;
@@ -122,315 +131,316 @@ sub gen_delimited_pat($;$)  # ($delimiters;$escapes)
 
 sub extract_delimited (;$$$$)
 {
-       my $textref = defined $_[0] ? \$_[0] : \$_;
-       my $wantarray = wantarray;
-       my $del  = defined $_[1] ? $_[1] : qq{\'\"\`};
-       my $pre  = defined $_[2] ? $_[2] : '\s*';
-       my $esc  = defined $_[3] ? $_[3] : qq{\\};
-       my $pat = gen_delimited_pat($del, $esc);
-       my $startpos = pos $$textref || 0;
-       return _fail($wantarray, $textref, "Not a delimited pattern", 0)
-               unless $$textref =~ m/\G($pre)($pat)/gc;
-       my $prelen = length($1);
-       my $matchpos = $startpos+$prelen;
-       my $endpos = pos $$textref;
-       return _succeed $wantarray, $textref,
-                       $matchpos, $endpos-$matchpos,           # MATCH
-                       $endpos,   length($$textref)-$endpos,   # REMAINDER
-                       $startpos, $prelen;                     # PREFIX
+    my $textref = defined $_[0] ? \$_[0] : \$_;
+    my $wantarray = wantarray;
+    my $del  = defined $_[1] ? $_[1] : qq{\'\"\`};
+    my $pre  = defined $_[2] ? $_[2] : '\s*';
+    my $esc  = defined $_[3] ? $_[3] : qq{\\};
+    my $pat = gen_delimited_pat($del, $esc);
+    my $startpos = pos $$textref || 0;
+    return _fail($wantarray, $textref, "Not a delimited pattern", 0)
+        unless $$textref =~ m/\G($pre)($pat)/gc;
+    my $prelen = length($1);
+    my $matchpos = $startpos+$prelen;
+    my $endpos = pos $$textref;
+    return _succeed $wantarray, $textref,
+                    $matchpos, $endpos-$matchpos,               # MATCH
+                    $endpos,   length($$textref)-$endpos,       # REMAINDER
+                    $startpos, $prelen;                         # PREFIX
 }
 
 sub extract_bracketed (;$$$)
 {
-       my $textref = defined $_[0] ? \$_[0] : \$_;
-       my $ldel = defined $_[1] ? $_[1] : '{([<';
-       my $pre  = defined $_[2] ? $_[2] : '\s*';
-       my $wantarray = wantarray;
-       my $qdel = "";
-       my $quotelike;
-       $ldel =~ s/'//g and $qdel .= q{'};
-       $ldel =~ s/"//g and $qdel .= q{"};
-       $ldel =~ s/`//g and $qdel .= q{`};
-       $ldel =~ s/q//g and $quotelike = 1;
-       $ldel =~ tr/[](){}<>\0-\377/[[(({{<</ds;
-       my $rdel = $ldel;
-       unless ($rdel =~ tr/[({</])}>/)
-        {
-               return _fail $wantarray, $textref,
-                            "Did not find a suitable bracket in delimiter: \"$_[1]\"",
-                            0;
-       }
-       my $posbug = pos;
-       $ldel = join('|', map { quotemeta $_ } split('', $ldel));
-       $rdel = join('|', map { quotemeta $_ } split('', $rdel));
-       pos = $posbug;
-
-       my $startpos = pos $$textref || 0;
-       my @match = _match_bracketed($textref,$pre, $ldel, $qdel, $quotelike, $rdel);
-
-       return _fail ($wantarray, $textref) unless @match;
-
-       return _succeed ( $wantarray, $textref,
-                         $match[2], $match[5]+2,       # MATCH
-                         @match[8,9],                  # REMAINDER
-                         @match[0,1],                  # PREFIX
-                       );
+    my $textref = defined $_[0] ? \$_[0] : \$_;
+    my $ldel = defined $_[1] ? $_[1] : '{([<';
+    my $pre  = defined $_[2] ? $_[2] : '\s*';
+    my $wantarray = wantarray;
+    my $qdel = "";
+    my $quotelike;
+    $ldel =~ s/'//g and $qdel .= q{'};
+    $ldel =~ s/"//g and $qdel .= q{"};
+    $ldel =~ s/`//g and $qdel .= q{`};
+    $ldel =~ s/q//g and $quotelike = 1;
+    $ldel =~ tr/[](){}<>\0-\377/[[(({{<</ds;
+    my $rdel = $ldel;
+    unless ($rdel =~ tr/[({</])}>/)
+    {
+        return _fail $wantarray, $textref,
+                     "Did not find a suitable bracket in delimiter: \"$_[1]\"",
+                     0;
+    }
+    my $posbug = pos;
+    $ldel = join('|', map { quotemeta $_ } split('', $ldel));
+    $rdel = join('|', map { quotemeta $_ } split('', $rdel));
+    pos = $posbug;
+
+    my $startpos = pos $$textref || 0;
+    my @match = _match_bracketed($textref,$pre, $ldel, $qdel, $quotelike, $rdel);
+
+    return _fail ($wantarray, $textref) unless @match;
+
+    return _succeed ( $wantarray, $textref,
+                      $match[2], $match[5]+2,           # MATCH
+                      @match[8,9],                      # REMAINDER
+                      @match[0,1],                      # PREFIX
+                    );
 }
 
-sub _match_bracketed($$$$$$)   # $textref, $pre, $ldel, $qdel, $quotelike, $rdel
+sub _match_bracketed($$$$$$)    # $textref, $pre, $ldel, $qdel, $quotelike, $rdel
 {
-       my ($textref, $pre, $ldel, $qdel, $quotelike, $rdel) = @_;
-       my ($startpos, $ldelpos, $endpos) = (pos $$textref = pos $$textref||0);
-       unless ($$textref =~ m/\G$pre/gc)
-       {
-               _failmsg "Did not find prefix: /$pre/", $startpos;
-               return;
-       }
-
-       $ldelpos = pos $$textref;
-
-       unless ($$textref =~ m/\G($ldel)/gc)
-       {
-               _failmsg "Did not find opening bracket after prefix: \"$pre\"",
-                        pos $$textref;
-               pos $$textref = $startpos;
-               return;
-       }
-
-       my @nesting = ( $1 );
-       my $textlen = length $$textref;
-       while (pos $$textref < $textlen)
-       {
-               next if $$textref =~ m/\G\\./gcs;
-
-               if ($$textref =~ m/\G($ldel)/gc)
-               {
-                       push @nesting, $1;
-               }
-               elsif ($$textref =~ m/\G($rdel)/gc)
-               {
-                       my ($found, $brackettype) = ($1, $1);
-                       if ($#nesting < 0)
-                       {
-                               _failmsg "Unmatched closing bracket: \"$found\"",
-                                        pos $$textref;
-                               pos $$textref = $startpos;
-                               return;
-                       }
-                       my $expected = pop(@nesting);
-                       $expected =~ tr/({[</)}]>/;
-                       if ($expected ne $brackettype)
-                       {
-                               _failmsg qq{Mismatched closing bracket: expected "$expected" but found "$found"},
-                                        pos $$textref;
-                               pos $$textref = $startpos;
-                               return;
-                       }
-                       last if $#nesting < 0;
-               }
-               elsif ($qdel && $$textref =~ m/\G([$qdel])/gc)
-               {
-                       $$textref =~ m/\G[^\\$1]*(?:\\.[^\\$1]*)*(\Q$1\E)/gsc and next;
-                       _failmsg "Unmatched embedded quote ($1)",
-                                pos $$textref;
-                       pos $$textref = $startpos;
-                       return;
-               }
-               elsif ($quotelike && _match_quotelike($textref,"",1,0))
-               {
-                       next;
-               }
-
-               else { $$textref =~ m/\G(?:[a-zA-Z0-9]+|.)/gcs }
-       }
-       if ($#nesting>=0)
-       {
-               _failmsg "Unmatched opening bracket(s): "
-                               . join("..",@nesting)."..",
-                        pos $$textref;
-               pos $$textref = $startpos;
-               return;
-       }
-
-       $endpos = pos $$textref;
-       
-       return (
-               $startpos,  $ldelpos-$startpos,         # PREFIX
-               $ldelpos,   1,                          # OPENING BRACKET
-               $ldelpos+1, $endpos-$ldelpos-2,         # CONTENTS
-               $endpos-1,  1,                          # CLOSING BRACKET
-               $endpos,    length($$textref)-$endpos,  # REMAINDER
-              );
+    my ($textref, $pre, $ldel, $qdel, $quotelike, $rdel) = @_;
+    my ($startpos, $ldelpos, $endpos) = (pos $$textref = pos $$textref||0);
+    unless ($$textref =~ m/\G$pre/gc)
+    {
+        _failmsg "Did not find prefix: /$pre/", $startpos;
+        return;
+    }
+
+    $ldelpos = pos $$textref;
+
+    unless ($$textref =~ m/\G($ldel)/gc)
+    {
+        _failmsg "Did not find opening bracket after prefix: \"$pre\"",
+                 pos $$textref;
+        pos $$textref = $startpos;
+        return;
+    }
+
+    my @nesting = ( $1 );
+    my $textlen = length $$textref;
+    while (pos $$textref < $textlen)
+    {
+        next if $$textref =~ m/\G\\./gcs;
+
+        if ($$textref =~ m/\G($ldel)/gc)
+        {
+            push @nesting, $1;
+        }
+        elsif ($$textref =~ m/\G($rdel)/gc)
+        {
+            my ($found, $brackettype) = ($1, $1);
+            if ($#nesting < 0)
+            {
+                _failmsg "Unmatched closing bracket: \"$found\"",
+                         pos $$textref;
+                pos $$textref = $startpos;
+                return;
+            }
+            my $expected = pop(@nesting);
+            $expected =~ tr/({[</)}]>/;
+            if ($expected ne $brackettype)
+            {
+                _failmsg qq{Mismatched closing bracket: expected "$expected" but found "$found"},
+                         pos $$textref;
+                pos $$textref = $startpos;
+                return;
+            }
+            last if $#nesting < 0;
+        }
+        elsif ($qdel && $$textref =~ m/\G([$qdel])/gc)
+        {
+            $$textref =~ m/\G[^\\$1]*(?:\\.[^\\$1]*)*(\Q$1\E)/gsc and next;
+            _failmsg "Unmatched embedded quote ($1)",
+                     pos $$textref;
+            pos $$textref = $startpos;
+            return;
+        }
+        elsif ($quotelike && _match_quotelike($textref,"",1,0))
+        {
+            next;
+        }
+
+        else { $$textref =~ m/\G(?:[a-zA-Z0-9]+|.)/gcs }
+    }
+    if ($#nesting>=0)
+    {
+        _failmsg "Unmatched opening bracket(s): "
+                     . join("..",@nesting)."..",
+                 pos $$textref;
+        pos $$textref = $startpos;
+        return;
+    }
+
+    $endpos = pos $$textref;
+
+    return (
+        $startpos,  $ldelpos-$startpos,         # PREFIX
+        $ldelpos,   1,                          # OPENING BRACKET
+        $ldelpos+1, $endpos-$ldelpos-2,         # CONTENTS
+        $endpos-1,  1,                          # CLOSING BRACKET
+        $endpos,    length($$textref)-$endpos,  # REMAINDER
+    );
 }
 
 sub _revbracket($)
 {
-       my $brack = reverse $_[0];
-       $brack =~ tr/[({</])}>/;
-       return $brack;
+    my $brack = reverse $_[0];
+    $brack =~ tr/[({</])}>/;
+    return $brack;
 }
 
 my $XMLNAME = q{[a-zA-Z_:][a-zA-Z0-9_:.-]*};
 
 sub extract_tagged (;$$$$$) # ($text, $opentag, $closetag, $pre, \%options)
 {
-       my $textref = defined $_[0] ? \$_[0] : \$_;
-       my $ldel    = $_[1];
-       my $rdel    = $_[2];
-       my $pre     = defined $_[3] ? $_[3] : '\s*';
-       my %options = defined $_[4] ? %{$_[4]} : ();
-       my $omode   = defined $options{fail} ? $options{fail} : '';
-       my $bad     = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}})
-                   : defined($options{reject})        ? $options{reject}
-                   :                                    ''
-                   ;
-       my $ignore  = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}})
-                   : defined($options{ignore})        ? $options{ignore}
-                   :                                    ''
-                   ;
-
-       if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; }
-       $@ = undef;
-
-       my @match = _match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore);
-
-       return _fail(wantarray, $textref) unless @match;
-       return _succeed wantarray, $textref,
-                       $match[2], $match[3]+$match[5]+$match[7],       # MATCH
-                       @match[8..9,0..1,2..7];                         # REM, PRE, BITS
+    my $textref = defined $_[0] ? \$_[0] : \$_;
+    my $ldel    = $_[1];
+    my $rdel    = $_[2];
+    my $pre     = defined $_[3] ? $_[3] : '\s*';
+    my %options = defined $_[4] ? %{$_[4]} : ();
+    my $omode   = defined $options{fail} ? $options{fail} : '';
+    my $bad     = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}})
+                : defined($options{reject})        ? $options{reject}
+                :                                    ''
+                ;
+    my $ignore  = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}})
+                : defined($options{ignore})        ? $options{ignore}
+                :                                    ''
+                ;
+
+    if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; }
+    $@ = undef;
+
+    my @match = _match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore);
+
+    return _fail(wantarray, $textref) unless @match;
+    return _succeed wantarray, $textref,
+            $match[2], $match[3]+$match[5]+$match[7],    # MATCH
+            @match[8..9,0..1,2..7];                      # REM, PRE, BITS
 }
 
-sub _match_tagged      # ($$$$$$$)
+sub _match_tagged       # ($$$$$$$)
 {
-       my ($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore) = @_;
-       my $rdelspec;
-
-       my ($startpos, $opentagpos, $textpos, $parapos, $closetagpos, $endpos) = ( pos($$textref) = pos($$textref)||0 );
-
-       unless ($$textref =~ m/\G($pre)/gc)
-       {
-               _failmsg "Did not find prefix: /$pre/", pos $$textref;
-               goto failed;
-       }
-
-       $opentagpos = pos($$textref);
-
-       unless ($$textref =~ m/\G$ldel/gc)
-       {
-               _failmsg "Did not find opening tag: /$ldel/", pos $$textref;
-               goto failed;
-       }
-
-       $textpos = pos($$textref);
-
-       if (!defined $rdel)
-       {
-               $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]);
-               unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes)
-               {
-                       _failmsg "Unable to construct closing tag to match: $rdel",
-                                pos $$textref;
-                       goto failed;
-               }
-       }
-       else
-       {
-               $rdelspec = eval "qq{$rdel}" || do {
-                       my $del;
-                       for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',)
-                               { next if $rdel =~ /\Q$_/; $del = $_; last }
-                       unless ($del) {
-                               use Carp;
-                               croak "Can't interpolate right delimiter $rdel"
-                       }
-                       eval "qq$del$rdel$del";
-               };
-       }
-
-       while (pos($$textref) < length($$textref))
-       {
-               next if $$textref =~ m/\G\\./gc;
-
-               if ($$textref =~ m/\G(\n[ \t]*\n)/gc )
-               {
-                       $parapos = pos($$textref) - length($1)
-                               unless defined $parapos;
-               }
-               elsif ($$textref =~ m/\G($rdelspec)/gc )
-               {
-                       $closetagpos = pos($$textref)-length($1);
-                       goto matched;
-               }
-               elsif ($ignore && $$textref =~ m/\G(?:$ignore)/gc)
-               {
-                       next;
-               }
-               elsif ($bad && $$textref =~ m/\G($bad)/gcs)
-               {
-                       pos($$textref) -= length($1);   # CUT OFF WHATEVER CAUSED THE SHORTNESS
-                       goto short if ($omode eq 'PARA' || $omode eq 'MAX');
-                       _failmsg "Found invalid nested tag: $1", pos $$textref;
-                       goto failed;
-               }
-               elsif ($$textref =~ m/\G($ldel)/gc)
-               {
-                       my $tag = $1;
-                       pos($$textref) -= length($tag); # REWIND TO NESTED TAG
-                       unless (_match_tagged(@_))      # MATCH NESTED TAG
-                       {
-                               goto short if $omode eq 'PARA' || $omode eq 'MAX';
-                               _failmsg "Found unbalanced nested tag: $tag",
-                                        pos $$textref;
-                               goto failed;
-                       }
-               }
-               else { $$textref =~ m/./gcs }
-       }
+    my ($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore) = @_;
+    my $rdelspec;
+
+    my ($startpos, $opentagpos, $textpos, $parapos, $closetagpos, $endpos) = ( pos($$textref) = pos($$textref)||0 );
+
+    unless ($$textref =~ m/\G($pre)/gc)
+    {
+        _failmsg "Did not find prefix: /$pre/", pos $$textref;
+        goto failed;
+    }
+
+    $opentagpos = pos($$textref);
+
+    unless ($$textref =~ m/\G$ldel/gc)
+    {
+        _failmsg "Did not find opening tag: /$ldel/", pos $$textref;
+        goto failed;
+    }
+
+    $textpos = pos($$textref);
+
+    if (!defined $rdel)
+    {
+        $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]);
+        unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes)
+        {
+            _failmsg "Unable to construct closing tag to match: $rdel",
+                     pos $$textref;
+            goto failed;
+        }
+    }
+    else
+    {
+        ## no critic (BuiltinFunctions::ProhibitStringyEval)
+        $rdelspec = eval "qq{$rdel}" || do {
+            my $del;
+            for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',)
+                { next if $rdel =~ /\Q$_/; $del = $_; last }
+            unless ($del) {
+                use Carp;
+                croak "Can't interpolate right delimiter $rdel"
+            }
+            eval "qq$del$rdel$del";
+        };
+    }
+
+    while (pos($$textref) < length($$textref))
+    {
+        next if $$textref =~ m/\G\\./gc;
+
+        if ($$textref =~ m/\G(\n[ \t]*\n)/gc )
+        {
+            $parapos = pos($$textref) - length($1)
+                unless defined $parapos;
+        }
+        elsif ($$textref =~ m/\G($rdelspec)/gc )
+        {
+            $closetagpos = pos($$textref)-length($1);
+            goto matched;
+        }
+        elsif ($ignore && $$textref =~ m/\G(?:$ignore)/gc)
+        {
+            next;
+        }
+        elsif ($bad && $$textref =~ m/\G($bad)/gcs)
+        {
+            pos($$textref) -= length($1);       # CUT OFF WHATEVER CAUSED THE SHORTNESS
+            goto short if ($omode eq 'PARA' || $omode eq 'MAX');
+            _failmsg "Found invalid nested tag: $1", pos $$textref;
+            goto failed;
+        }
+        elsif ($$textref =~ m/\G($ldel)/gc)
+        {
+            my $tag = $1;
+            pos($$textref) -= length($tag);     # REWIND TO NESTED TAG
+            unless (_match_tagged(@_))  # MATCH NESTED TAG
+            {
+                goto short if $omode eq 'PARA' || $omode eq 'MAX';
+                _failmsg "Found unbalanced nested tag: $tag",
+                         pos $$textref;
+                goto failed;
+            }
+        }
+        else { $$textref =~ m/./gcs }
+    }
 
 short:
-       $closetagpos = pos($$textref);
-       goto matched if $omode eq 'MAX';
-       goto failed unless $omode eq 'PARA';
-
-       if (defined $parapos) { pos($$textref) = $parapos }
-       else                  { $parapos = pos($$textref) }
-
-       return (
-               $startpos,    $opentagpos-$startpos,            # PREFIX
-               $opentagpos,  $textpos-$opentagpos,             # OPENING TAG
-               $textpos,     $parapos-$textpos,                # TEXT
-               $parapos,     0,                                # NO CLOSING TAG
-               $parapos,     length($$textref)-$parapos,       # REMAINDER
-              );
-       
+    $closetagpos = pos($$textref);
+    goto matched if $omode eq 'MAX';
+    goto failed unless $omode eq 'PARA';
+
+    if (defined $parapos) { pos($$textref) = $parapos }
+    else                  { $parapos = pos($$textref) }
+
+    return (
+        $startpos,    $opentagpos-$startpos,            # PREFIX
+        $opentagpos,  $textpos-$opentagpos,             # OPENING TAG
+        $textpos,     $parapos-$textpos,                # TEXT
+        $parapos,     0,                                # NO CLOSING TAG
+        $parapos,     length($$textref)-$parapos,       # REMAINDER
+    );
+
 matched:
-       $endpos = pos($$textref);
-       return (
-               $startpos,    $opentagpos-$startpos,            # PREFIX
-               $opentagpos,  $textpos-$opentagpos,             # OPENING TAG
-               $textpos,     $closetagpos-$textpos,            # TEXT
-               $closetagpos, $endpos-$closetagpos,             # CLOSING TAG
-               $endpos,      length($$textref)-$endpos,        # REMAINDER
-              );
+    $endpos = pos($$textref);
+    return (
+        $startpos,    $opentagpos-$startpos,            # PREFIX
+        $opentagpos,  $textpos-$opentagpos,             # OPENING TAG
+        $textpos,     $closetagpos-$textpos,            # TEXT
+        $closetagpos, $endpos-$closetagpos,             # CLOSING TAG
+        $endpos,      length($$textref)-$endpos,        # REMAINDER
+    );
 
 failed:
-       _failmsg "Did not find closing tag", pos $$textref unless $@;
-       pos($$textref) = $startpos;
-       return;
+    _failmsg "Did not find closing tag", pos $$textref unless $@;
+    pos($$textref) = $startpos;
+    return;
 }
 
 sub extract_variable (;$$)
 {
-       my $textref = defined $_[0] ? \$_[0] : \$_;
-       return ("","","") unless defined $$textref;
-       my $pre  = defined $_[1] ? $_[1] : '\s*';
+    my $textref = defined $_[0] ? \$_[0] : \$_;
+    return ("","","") unless defined $$textref;
+    my $pre  = defined $_[1] ? $_[1] : '\s*';
 
-       my @match = _match_variable($textref,$pre);
+    my @match = _match_variable($textref,$pre);
 
-       return _fail wantarray, $textref unless @match;
+    return _fail wantarray, $textref unless @match;
 
-       return _succeed wantarray, $textref,
-                       @match[2..3,4..5,0..1];         # MATCH, REMAINDER, PREFIX
+    return _succeed wantarray, $textref,
+                    @match[2..3,4..5,0..1];        # MATCH, REMAINDER, PREFIX
 }
 
 sub _match_variable($$)
@@ -438,582 +448,581 @@ sub _match_variable($$)
 #  $#
 #  $^
 #  $$
-       my ($textref, $pre) = @_;
-       my $startpos = pos($$textref) = pos($$textref)||0;
-       unless ($$textref =~ m/\G($pre)/gc)
-       {
-               _failmsg "Did not find prefix: /$pre/", pos $$textref;
-               return;
-       }
-       my $varpos = pos($$textref);
-        unless ($$textref =~ m{\G\$\s*(?!::)(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci)
-       {
-           unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc)
-           {
-               _failmsg "Did not find leading dereferencer", pos $$textref;
-               pos $$textref = $startpos;
-               return;
-           }
-           my $deref = $1;
-
-           unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci
-               or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0)
-               or $deref eq '$#' or $deref eq '$$' )
-           {
-               _failmsg "Bad identifier after dereferencer", pos $$textref;
-               pos $$textref = $startpos;
-               return;
-           }
-       }
-
-       while (1)
-       {
-               next if $$textref =~ m/\G\s*(?:->)?\s*[{]\w+[}]/gc;
-               next if _match_codeblock($textref,
-                                        qr/\s*->\s*(?:[_a-zA-Z]\w+\s*)?/,
-                                        qr/[({[]/, qr/[)}\]]/,
-                                        qr/[({[]/, qr/[)}\]]/, 0);
-               next if _match_codeblock($textref,
-                                        qr/\s*/, qr/[{[]/, qr/[}\]]/,
-                                        qr/[{[]/, qr/[}\]]/, 0);
-               next if _match_variable($textref,'\s*->\s*');
-               next if $$textref =~ m/\G\s*->\s*\w+(?![{([])/gc;
-               last;
-       }
-       
-       my $endpos = pos($$textref);
-       return ($startpos, $varpos-$startpos,
-               $varpos,   $endpos-$varpos,
-               $endpos,   length($$textref)-$endpos
-               );
+    my ($textref, $pre) = @_;
+    my $startpos = pos($$textref) = pos($$textref)||0;
+    unless ($$textref =~ m/\G($pre)/gc)
+    {
+        _failmsg "Did not find prefix: /$pre/", pos $$textref;
+        return;
+    }
+    my $varpos = pos($$textref);
+    unless ($$textref =~ m{\G\$\s*(?!::)(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci)
+    {
+        unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc)
+        {
+            _failmsg "Did not find leading dereferencer", pos $$textref;
+            pos $$textref = $startpos;
+            return;
+        }
+        my $deref = $1;
+
+        unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci
+            or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0)
+            or $deref eq '$#' or $deref eq '$$' )
+        {
+            _failmsg "Bad identifier after dereferencer", pos $$textref;
+            pos $$textref = $startpos;
+            return;
+        }
+    }
+
+    while (1)
+    {
+        next if $$textref =~ m/\G\s*(?:->)?\s*[{]\w+[}]/gc;
+        next if _match_codeblock($textref,
+                                 qr/\s*->\s*(?:[_a-zA-Z]\w+\s*)?/,
+                                 qr/[({[]/, qr/[)}\]]/,
+                                 qr/[({[]/, qr/[)}\]]/, 0);
+        next if _match_codeblock($textref,
+                                 qr/\s*/, qr/[{[]/, qr/[}\]]/,
+                                 qr/[{[]/, qr/[}\]]/, 0);
+        next if _match_variable($textref,'\s*->\s*');
+        next if $$textref =~ m/\G\s*->\s*\w+(?![{([])/gc;
+        last;
+    }
+
+    my $endpos = pos($$textref);
+    return ($startpos, $varpos-$startpos,
+            $varpos,   $endpos-$varpos,
+            $endpos,   length($$textref)-$endpos
+    );
 }
 
 sub extract_codeblock (;$$$$$)
 {
-       my $textref = defined $_[0] ? \$_[0] : \$_;
-       my $wantarray = wantarray;
-       my $ldel_inner = defined $_[1] ? $_[1] : '{';
-       my $pre        = defined $_[2] ? $_[2] : '\s*';
-       my $ldel_outer = defined $_[3] ? $_[3] : $ldel_inner;
-       my $rd         = $_[4];
-       my $rdel_inner = $ldel_inner;
-       my $rdel_outer = $ldel_outer;
-       my $posbug = pos;
-       for ($ldel_inner, $ldel_outer) { tr/[]()<>{}\0-\377/[[((<<{{/ds }
-       for ($rdel_inner, $rdel_outer) { tr/[]()<>{}\0-\377/]]))>>}}/ds }
-       for ($ldel_inner, $ldel_outer, $rdel_inner, $rdel_outer)
-       {
-               $_ = '('.join('|',map { quotemeta $_ } split('',$_)).')'
-       }
-       pos = $posbug;
-
-       my @match = _match_codeblock($textref, $pre,
-                                    $ldel_outer, $rdel_outer,
-                                    $ldel_inner, $rdel_inner,
-                                    $rd);
-       return _fail($wantarray, $textref) unless @match;
-       return _succeed($wantarray, $textref,
-                       @match[2..3,4..5,0..1]  # MATCH, REMAINDER, PREFIX
-                      );
+    my $textref = defined $_[0] ? \$_[0] : \$_;
+    my $wantarray = wantarray;
+    my $ldel_inner = defined $_[1] ? $_[1] : '{';
+    my $pre        = defined $_[2] ? $_[2] : '\s*';
+    my $ldel_outer = defined $_[3] ? $_[3] : $ldel_inner;
+    my $rd         = $_[4];
+    my $rdel_inner = $ldel_inner;
+    my $rdel_outer = $ldel_outer;
+    my $posbug = pos;
+    for ($ldel_inner, $ldel_outer) { tr/[]()<>{}\0-\377/[[((<<{{/ds }
+    for ($rdel_inner, $rdel_outer) { tr/[]()<>{}\0-\377/]]))>>}}/ds }
+    for ($ldel_inner, $ldel_outer, $rdel_inner, $rdel_outer)
+    {
+        $_ = '('.join('|',map { quotemeta $_ } split('',$_)).')'
+    }
+    pos = $posbug;
+
+    my @match = _match_codeblock($textref, $pre,
+                                 $ldel_outer, $rdel_outer,
+                                 $ldel_inner, $rdel_inner,
+                                 $rd);
+    return _fail($wantarray, $textref) unless @match;
+    return _succeed($wantarray, $textref,
+                    @match[2..3,4..5,0..1]    # MATCH, REMAINDER, PREFIX
+    );
 
 }
 
 sub _match_codeblock($$$$$$$)
 {
-       my ($textref, $pre, $ldel_outer, $rdel_outer, $ldel_inner, $rdel_inner, $rd) = @_;
-       my $startpos = pos($$textref) = pos($$textref) || 0;
-       unless ($$textref =~ m/\G($pre)/gc)
-       {
-               _failmsg qq{Did not match prefix /$pre/ at"} .
-                           substr($$textref,pos($$textref),20) .
-                           q{..."},
-                        pos $$textref;
-               return; 
-       }
-       my $codepos = pos($$textref);
-       unless ($$textref =~ m/\G($ldel_outer)/gc)      # OUTERMOST DELIMITER
-       {
-               _failmsg qq{Did not find expected opening bracket at "} .
-                            substr($$textref,pos($$textref),20) .
-                            q{..."},
-                        pos $$textref;
-               pos $$textref = $startpos;
-               return;
-       }
-       my $closing = $1;
-          $closing =~ tr/([<{/)]>}/;
-       my $matched;
-       my $patvalid = 1;
-       while (pos($$textref) < length($$textref))
-       {
-               $matched = '';
-               if ($rd && $$textref =~ m#\G(\Q(?)\E|\Q(s?)\E|\Q(s)\E)#gc)
-               {
-                       $patvalid = 0;
-                       next;
-               }
-
-               if ($$textref =~ m/\G\s*#.*/gc)
-               {
-                       next;
-               }
-
-               if ($$textref =~ m/\G\s*($rdel_outer)/gc)
-               {
-                       unless ($matched = ($closing && $1 eq $closing) )
-                       {
-                               next if $1 eq '>';      # MIGHT BE A "LESS THAN"
-                               _failmsg q{Mismatched closing bracket at "} .
-                                            substr($$textref,pos($$textref),20) .
-                                            qq{...". Expected '$closing'},
-                                        pos $$textref;
-                       }
-                       last;
-               }
-
-               if (_match_variable($textref,'\s*') ||
-                   _match_quotelike($textref,'\s*',$patvalid,$patvalid) )
-               {
-                       $patvalid = 0;
-                       next;
-               }
-
-
-               # NEED TO COVER MANY MORE CASES HERE!!!
-               if ($$textref =~ m#\G\s*(?!$ldel_inner)
-                                       ( [-+*x/%^&|.]=?
-                                       | [!=]~
-                                       | =(?!>)
-                                       | (\*\*|&&|\|\||<<|>>)=?
-                                       | split|grep|map|return
-                                       | [([]
-                                       )#gcx)
-               {
-                       $patvalid = 1;
-                       next;
-               }
-
-               if ( _match_codeblock($textref, '\s*', $ldel_inner, $rdel_inner, $ldel_inner, $rdel_inner, $rd) )
-               {
-                       $patvalid = 1;
-                       next;
-               }
-
-               if ($$textref =~ m/\G\s*$ldel_outer/gc)
-               {
-                       _failmsg q{Improperly nested codeblock at "} .
-                                    substr($$textref,pos($$textref),20) .
-                                    q{..."},
-                                pos $$textref;
-                       last;
-               }
-
-               $patvalid = 0;
-               $$textref =~ m/\G\s*(\w+|[-=>]>|.|\Z)/gc;
-       }
-       continue { $@ = undef }
-
-       unless ($matched)
-       {
-               _failmsg 'No match found for opening bracket', pos $$textref
-                       unless $@;
-               return;
-       }
-
-       my $endpos = pos($$textref);
-       return ( $startpos, $codepos-$startpos,
-                $codepos, $endpos-$codepos,
-                $endpos,  length($$textref)-$endpos,
-              );
+    my ($textref, $pre, $ldel_outer, $rdel_outer, $ldel_inner, $rdel_inner, $rd) = @_;
+    my $startpos = pos($$textref) = pos($$textref) || 0;
+    unless ($$textref =~ m/\G($pre)/gc)
+    {
+        _failmsg qq{Did not match prefix /$pre/ at"} .
+                     substr($$textref,pos($$textref),20) .
+                     q{..."},
+                 pos $$textref;
+        return;
+    }
+    my $codepos = pos($$textref);
+    unless ($$textref =~ m/\G($ldel_outer)/gc)  # OUTERMOST DELIMITER
+    {
+        _failmsg qq{Did not find expected opening bracket at "} .
+                     substr($$textref,pos($$textref),20) .
+                     q{..."},
+                 pos $$textref;
+        pos $$textref = $startpos;
+        return;
+    }
+    my $closing = $1;
+       $closing =~ tr/([<{/)]>}/;
+    my $matched;
+    my $patvalid = 1;
+    while (pos($$textref) < length($$textref))
+    {
+        $matched = '';
+        if ($rd && $$textref =~ m#\G(\Q(?)\E|\Q(s?)\E|\Q(s)\E)#gc)
+        {
+            $patvalid = 0;
+            next;
+        }
+
+        if ($$textref =~ m/\G\s*#.*/gc)
+        {
+            next;
+        }
+
+        if ($$textref =~ m/\G\s*($rdel_outer)/gc)
+        {
+            unless ($matched = ($closing && $1 eq $closing) )
+            {
+                next if $1 eq '>';      # MIGHT BE A "LESS THAN"
+                _failmsg q{Mismatched closing bracket at "} .
+                             substr($$textref,pos($$textref),20) .
+                             qq{...". Expected '$closing'},
+                         pos $$textref;
+            }
+            last;
+        }
+
+        if (_match_variable($textref,'\s*') ||
+            _match_quotelike($textref,'\s*',$patvalid,$patvalid) )
+        {
+            $patvalid = 0;
+            next;
+        }
+
+
+        # NEED TO COVER MANY MORE CASES HERE!!!
+        if ($$textref =~ m#\G\s*(?!$ldel_inner)
+                                ( [-+*x/%^&|.]=?
+                                | [!=]~
+                                | =(?!>)
+                                | (\*\*|&&|\|\||<<|>>)=?
+                                | split|grep|map|return
+                                | [([]
+                                )#gcx)
+        {
+            $patvalid = 1;
+            next;
+        }
+
+        if ( _match_codeblock($textref, '\s*', $ldel_inner, $rdel_inner, $ldel_inner, $rdel_inner, $rd) )
+        {
+            $patvalid = 1;
+            next;
+        }
+
+        if ($$textref =~ m/\G\s*$ldel_outer/gc)
+        {
+            _failmsg q{Improperly nested codeblock at "} .
+                         substr($$textref,pos($$textref),20) .
+                         q{..."},
+                     pos $$textref;
+            last;
+        }
+
+        $patvalid = 0;
+        $$textref =~ m/\G\s*(\w+|[-=>]>|.|\Z)/gc;
+    }
+    continue { $@ = undef }
+
+    unless ($matched)
+    {
+        _failmsg 'No match found for opening bracket', pos $$textref
+                unless $@;
+        return;
+    }
+
+    my $endpos = pos($$textref);
+    return ( $startpos, $codepos-$startpos,
+             $codepos, $endpos-$codepos,
+             $endpos,  length($$textref)-$endpos,
+    );
 }
 
 
 my %mods   = (
-               'none'  => '[cgimsox]*',
-               'm'     => '[cgimsox]*',
-               's'     => '[cegimsox]*',
-               'tr'    => '[cds]*',
-               'y'     => '[cds]*',
-               'qq'    => '',
-               'qx'    => '',
-               'qw'    => '',
-               'qr'    => '[imsx]*',
-               'q'     => '',
-            );
+    'none' => '[cgimsox]*',
+    'm'    => '[cgimsox]*',
+    's'    => '[cegimsox]*',
+    'tr'   => '[cds]*',
+    'y'    => '[cds]*',
+    'qq'   => '',
+    'qx'   => '',
+    'qw'   => '',
+    'qr'   => '[imsx]*',
+    'q'    => '',
+);
 
 sub extract_quotelike (;$$)
 {
-       my $textref = $_[0] ? \$_[0] : \$_;
-       my $wantarray = wantarray;
-       my $pre  = defined $_[1] ? $_[1] : '\s*';
-
-       my @match = _match_quotelike($textref,$pre,1,0);
-       return _fail($wantarray, $textref) unless @match;
-       return _succeed($wantarray, $textref,
-                       $match[2], $match[18]-$match[2],        # MATCH
-                       @match[18,19],                          # REMAINDER
-                       @match[0,1],                            # PREFIX
-                       @match[2..17],                          # THE BITS
-                       @match[20,21],                          # ANY FILLET?
-                      );
+    my $textref = $_[0] ? \$_[0] : \$_;
+    my $wantarray = wantarray;
+    my $pre  = defined $_[1] ? $_[1] : '\s*';
+
+    my @match = _match_quotelike($textref,$pre,1,0);
+    return _fail($wantarray, $textref) unless @match;
+    return _succeed($wantarray, $textref,
+                    $match[2], $match[18]-$match[2],    # MATCH
+                    @match[18,19],                      # REMAINDER
+                    @match[0,1],                        # PREFIX
+                    @match[2..17],                      # THE BITS
+                    @match[20,21],                      # ANY FILLET?
+    );
 };
 
-sub _match_quotelike($$$$)     # ($textref, $prepat, $allow_raw_match)
+sub _match_quotelike($$$$)      # ($textref, $prepat, $allow_raw_match)
 {
-       my ($textref, $pre, $rawmatch, $qmark) = @_;
-
-       my ($textlen,$startpos,
-           $oppos,
-           $preld1pos,$ld1pos,$str1pos,$rd1pos,
-           $preld2pos,$ld2pos,$str2pos,$rd2pos,
-           $modpos) = ( length($$textref), pos($$textref) = pos($$textref) || 0 );
-
-       unless ($$textref =~ m/\G($pre)/gc)
-       {
-               _failmsg qq{Did not find prefix /$pre/ at "} .
-                            substr($$textref, pos($$textref), 20) .
-                            q{..."},
-                        pos $$textref;
-               return; 
-       }
-       $oppos = pos($$textref);
-
-       my $initial = substr($$textref,$oppos,1);
-
-       if ($initial && $initial =~ m|^[\"\'\`]|
-                    || $rawmatch && $initial =~ m|^/|
-                    || $qmark && $initial =~ m|^\?|)
-       {
-               unless ($$textref =~ m/ \Q$initial\E [^\\$initial]* (\\.[^\\$initial]*)* \Q$initial\E /gcsx)
-               {
-                       _failmsg qq{Did not find closing delimiter to match '$initial' at "} .
-                                    substr($$textref, $oppos, 20) .
-                                    q{..."},
-                                pos $$textref;
-                       pos $$textref = $startpos;
-                       return;
-               }
-               $modpos= pos($$textref);
-               $rd1pos = $modpos-1;
-
-               if ($initial eq '/' || $initial eq '?') 
-               {
-                       $$textref =~ m/\G$mods{none}/gc
-               }
-
-               my $endpos = pos($$textref);
-               return (
-                       $startpos,      $oppos-$startpos,       # PREFIX
-                       $oppos,         0,                      # NO OPERATOR
-                       $oppos,         1,                      # LEFT DEL
-                       $oppos+1,       $rd1pos-$oppos-1,       # STR/PAT
-                       $rd1pos,        1,                      # RIGHT DEL
-                       $modpos,        0,                      # NO 2ND LDEL
-                       $modpos,        0,                      # NO 2ND STR
-                       $modpos,        0,                      # NO 2ND RDEL
-                       $modpos,        $endpos-$modpos,        # MODIFIERS
-                       $endpos,        $textlen-$endpos,       # REMAINDER
-                      );
-       }
-
-       unless ($$textref =~ m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc)
-       {
-               _failmsg q{No quotelike operator found after prefix at "} .
-                            substr($$textref, pos($$textref), 20) .
-                            q{..."},
-                        pos $$textref;
-               pos $$textref = $startpos;
-               return;
-       }
-
-       my $op = $1;
-       $preld1pos = pos($$textref);
-       if ($op eq '<<') {
-               $ld1pos = pos($$textref);
-               my $label;
-               if ($$textref =~ m{\G([A-Za-z_]\w*)}gc) {
-                       $label = $1;
-               }
-               elsif ($$textref =~ m{ \G ' ([^'\\]* (?:\\.[^'\\]*)*) '
-                                    | \G " ([^"\\]* (?:\\.[^"\\]*)*) "
-                                    | \G ` ([^`\\]* (?:\\.[^`\\]*)*) `
-                                    }gcsx) {
-                       $label = $+;
-               }
-               else {
-                       $label = "";
-               }
-               my $extrapos = pos($$textref);
-               $$textref =~ m{.*\n}gc;
-               $str1pos = pos($$textref)--;
-               unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) {
-                       _failmsg qq{Missing here doc terminator ('$label') after "} .
-                                    substr($$textref, $startpos, 20) .
-                                    q{..."},
-                                pos $$textref;
-                       pos $$textref = $startpos;
-                       return;
-               }
-               $rd1pos = pos($$textref);
+    my ($textref, $pre, $rawmatch, $qmark) = @_;
+
+    my ($textlen,$startpos,
+        $oppos,
+        $preld1pos,$ld1pos,$str1pos,$rd1pos,
+        $preld2pos,$ld2pos,$str2pos,$rd2pos,
+        $modpos) = ( length($$textref), pos($$textref) = pos($$textref) || 0 );
+
+    unless ($$textref =~ m/\G($pre)/gc)
+    {
+        _failmsg qq{Did not find prefix /$pre/ at "} .
+                     substr($$textref, pos($$textref), 20) .
+                     q{..."},
+                 pos $$textref;
+        return;
+    }
+    $oppos = pos($$textref);
+
+    my $initial = substr($$textref,$oppos,1);
+
+    if ($initial && $initial =~ m|^[\"\'\`]|
+                 || $rawmatch && $initial =~ m|^/|
+                 || $qmark && $initial =~ m|^\?|)
+    {
+        unless ($$textref =~ m/ \Q$initial\E [^\\$initial]* (\\.[^\\$initial]*)* \Q$initial\E /gcsx)
+        {
+            _failmsg qq{Did not find closing delimiter to match '$initial' at "} .
+                         substr($$textref, $oppos, 20) .
+                         q{..."},
+                     pos $$textref;
+            pos $$textref = $startpos;
+            return;
+        }
+        $modpos= pos($$textref);
+        $rd1pos = $modpos-1;
+
+        if ($initial eq '/' || $initial eq '?')
+        {
+            $$textref =~ m/\G$mods{none}/gc
+        }
+
+        my $endpos = pos($$textref);
+        return (
+            $startpos,  $oppos-$startpos,       # PREFIX
+            $oppos,     0,                      # NO OPERATOR
+            $oppos,     1,                      # LEFT DEL
+            $oppos+1,   $rd1pos-$oppos-1,       # STR/PAT
+            $rd1pos,    1,                      # RIGHT DEL
+            $modpos,    0,                      # NO 2ND LDEL
+            $modpos,    0,                      # NO 2ND STR
+            $modpos,    0,                      # NO 2ND RDEL
+            $modpos,    $endpos-$modpos,        # MODIFIERS
+            $endpos,    $textlen-$endpos,       # REMAINDER
+        );
+    }
+
+    unless ($$textref =~ m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc)
+    {
+        _failmsg q{No quotelike operator found after prefix at "} .
+                     substr($$textref, pos($$textref), 20) .
+                     q{..."},
+                 pos $$textref;
+        pos $$textref = $startpos;
+        return;
+    }
+
+    my $op = $1;
+    $preld1pos = pos($$textref);
+    if ($op eq '<<') {
+        $ld1pos = pos($$textref);
+        my $label;
+        if ($$textref =~ m{\G([A-Za-z_]\w*)}gc) {
+            $label = $1;
+        }
+        elsif ($$textref =~ m{ \G ' ([^'\\]* (?:\\.[^'\\]*)*) '
+                             | \G " ([^"\\]* (?:\\.[^"\\]*)*) "
+                             | \G ` ([^`\\]* (?:\\.[^`\\]*)*) `
+                             }gcsx) {
+            $label = $+;
+        }
+        else {
+            $label = "";
+        }
+        my $extrapos = pos($$textref);
+        $$textref =~ m{.*\n}gc;
+        $str1pos = pos($$textref)--;
+        unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) {
+            _failmsg qq{Missing here doc terminator ('$label') after "} .
+                         substr($$textref, $startpos, 20) .
+                         q{..."},
+                     pos $$textref;
+            pos $$textref = $startpos;
+            return;
+        }
+        $rd1pos = pos($$textref);
         $$textref =~ m{\Q$label\E\n}gc;
-               $ld2pos = pos($$textref);
-               return (
-                       $startpos,      $oppos-$startpos,       # PREFIX
-                       $oppos,         length($op),            # OPERATOR
-                       $ld1pos,        $extrapos-$ld1pos,      # LEFT DEL
-                       $str1pos,       $rd1pos-$str1pos,       # STR/PAT
-                       $rd1pos,        $ld2pos-$rd1pos,        # RIGHT DEL
-                       $ld2pos,        0,                      # NO 2ND LDEL
-                       $ld2pos,        0,                      # NO 2ND STR
-                       $ld2pos,        0,                      # NO 2ND RDEL
-                       $ld2pos,        0,                      # NO MODIFIERS
-                       $ld2pos,        $textlen-$ld2pos,       # REMAINDER
-                       $extrapos,      $str1pos-$extrapos,     # FILLETED BIT
-                      );
-       }
-
-       $$textref =~ m/\G\s*/gc;
-       $ld1pos = pos($$textref);
-       $str1pos = $ld1pos+1;
-
-       unless ($$textref =~ m/\G(\S)/gc)       # SHOULD USE LOOKAHEAD
-       {
-               _failmsg "No block delimiter found after quotelike $op",
-                        pos $$textref;
-               pos $$textref = $startpos;
-               return;
-       }
-       pos($$textref) = $ld1pos;       # HAVE TO DO THIS BECAUSE LOOKAHEAD BROKEN
-       my ($ldel1, $rdel1) = ("\Q$1","\Q$1");
-       if ($ldel1 =~ /[[(<{]/)
-       {
-               $rdel1 =~ tr/[({</])}>/;
-               defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
-               || do { pos $$textref = $startpos; return };
+        $ld2pos = pos($$textref);
+        return (
+            $startpos,  $oppos-$startpos,       # PREFIX
+            $oppos,     length($op),            # OPERATOR
+            $ld1pos,    $extrapos-$ld1pos,      # LEFT DEL
+            $str1pos,   $rd1pos-$str1pos,       # STR/PAT
+            $rd1pos,    $ld2pos-$rd1pos,        # RIGHT DEL
+            $ld2pos,    0,                      # NO 2ND LDEL
+            $ld2pos,    0,                      # NO 2ND STR
+            $ld2pos,    0,                      # NO 2ND RDEL
+            $ld2pos,    0,                      # NO MODIFIERS
+            $ld2pos,    $textlen-$ld2pos,       # REMAINDER
+            $extrapos,  $str1pos-$extrapos,     # FILLETED BIT
+        );
+    }
+
+    $$textref =~ m/\G\s*/gc;
+    $ld1pos = pos($$textref);
+    $str1pos = $ld1pos+1;
+
+    unless ($$textref =~ m/\G(\S)/gc)   # SHOULD USE LOOKAHEAD
+    {
+        _failmsg "No block delimiter found after quotelike $op",
+                 pos $$textref;
+        pos $$textref = $startpos;
+        return;
+    }
+    pos($$textref) = $ld1pos;   # HAVE TO DO THIS BECAUSE LOOKAHEAD BROKEN
+    my ($ldel1, $rdel1) = ("\Q$1","\Q$1");
+    if ($ldel1 =~ /[[(<{]/)
+    {
+        $rdel1 =~ tr/[({</])}>/;
+        defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
+            || do { pos $$textref = $startpos; return };
         $ld2pos = pos($$textref);
         $rd1pos = $ld2pos-1;
-       }
-       else
-       {
-               $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
-               || do { pos $$textref = $startpos; return };
+    }
+    else
+    {
+        $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
+            || do { pos $$textref = $startpos; return };
         $ld2pos = $rd1pos = pos($$textref)-1;
-       }
-
-       my $second_arg = $op =~ /s|tr|y/ ? 1 : 0;
-       if ($second_arg)
-       {
-               my ($ldel2, $rdel2);
-               if ($ldel1 =~ /[[(<{]/)
-               {
-                       unless ($$textref =~ /\G\s*(\S)/gc)     # SHOULD USE LOOKAHEAD
-                       {
-                               _failmsg "Missing second block for quotelike $op",
-                                        pos $$textref;
-                               pos $$textref = $startpos;
-                               return;
-                       }
-                       $ldel2 = $rdel2 = "\Q$1";
-                       $rdel2 =~ tr/[({</])}>/;
-               }
-               else
-               {
-                       $ldel2 = $rdel2 = $ldel1;
-               }
-               $str2pos = $ld2pos+1;
-
-               if ($ldel2 =~ /[[(<{]/)
-               {
-                       pos($$textref)--;       # OVERCOME BROKEN LOOKAHEAD 
-                       defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2))
-                       || do { pos $$textref = $startpos; return };
-               }
-               else
-               {
-                       $$textref =~ /[^\\$ldel2]*(\\.[^\\$ldel2]*)*$ldel2/gcs
-                       || do { pos $$textref = $startpos; return };
-               }
-               $rd2pos = pos($$textref)-1;
-       }
-       else
-       {
-               $ld2pos = $str2pos = $rd2pos = $rd1pos;
-       }
-
-       $modpos = pos $$textref;
-
-       $$textref =~ m/\G($mods{$op})/gc;
-       my $endpos = pos $$textref;
-
-       return (
-               $startpos,      $oppos-$startpos,       # PREFIX
-               $oppos,         length($op),            # OPERATOR
-               $ld1pos,        1,                      # LEFT DEL
-               $str1pos,       $rd1pos-$str1pos,       # STR/PAT
-               $rd1pos,        1,                      # RIGHT DEL
-               $ld2pos,        $second_arg,            # 2ND LDEL (MAYBE)
-               $str2pos,       $rd2pos-$str2pos,       # 2ND STR (MAYBE)
-               $rd2pos,        $second_arg,            # 2ND RDEL (MAYBE)
-               $modpos,        $endpos-$modpos,        # MODIFIERS
-               $endpos,        $textlen-$endpos,       # REMAINDER
-              );
+    }
+
+    my $second_arg = $op =~ /s|tr|y/ ? 1 : 0;
+    if ($second_arg)
+    {
+        my ($ldel2, $rdel2);
+        if ($ldel1 =~ /[[(<{]/)
+        {
+            unless ($$textref =~ /\G\s*(\S)/gc) # SHOULD USE LOOKAHEAD
+            {
+                _failmsg "Missing second block for quotelike $op",
+                         pos $$textref;
+                pos $$textref = $startpos;
+                return;
+            }
+            $ldel2 = $rdel2 = "\Q$1";
+            $rdel2 =~ tr/[({</])}>/;
+        }
+        else
+        {
+            $ldel2 = $rdel2 = $ldel1;
+        }
+        $str2pos = $ld2pos+1;
+
+        if ($ldel2 =~ /[[(<{]/)
+        {
+            pos($$textref)--;   # OVERCOME BROKEN LOOKAHEAD
+            defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2))
+                || do { pos $$textref = $startpos; return };
+        }
+        else
+        {
+            $$textref =~ /[^\\$ldel2]*(\\.[^\\$ldel2]*)*$ldel2/gcs
+                || do { pos $$textref = $startpos; return };
+        }
+        $rd2pos = pos($$textref)-1;
+    }
+    else
+    {
+        $ld2pos = $str2pos = $rd2pos = $rd1pos;
+    }
+
+    $modpos = pos $$textref;
+
+    $$textref =~ m/\G($mods{$op})/gc;
+    my $endpos = pos $$textref;
+
+    return (
+        $startpos,      $oppos-$startpos,       # PREFIX
+        $oppos,         length($op),            # OPERATOR
+        $ld1pos,        1,                      # LEFT DEL
+        $str1pos,       $rd1pos-$str1pos,       # STR/PAT
+        $rd1pos,        1,                      # RIGHT DEL
+        $ld2pos,        $second_arg,            # 2ND LDEL (MAYBE)
+        $str2pos,       $rd2pos-$str2pos,       # 2ND STR (MAYBE)
+        $rd2pos,        $second_arg,            # 2ND RDEL (MAYBE)
+        $modpos,        $endpos-$modpos,        # MODIFIERS
+        $endpos,        $textlen-$endpos,       # REMAINDER
+    );
 }
 
 my $def_func = [
-       sub { extract_variable($_[0], '') },
-       sub { extract_quotelike($_[0],'') },
-       sub { extract_codeblock($_[0],'{}','') },
+    sub { extract_variable($_[0], '') },
+    sub { extract_quotelike($_[0],'') },
+    sub { extract_codeblock($_[0],'{}','') },
 ];
 
-sub extract_multiple (;$$$$)   # ($text, $functions_ref, $max_fields, $ignoreunknown)
+sub extract_multiple (;$$$$)    # ($text, $functions_ref, $max_fields, $ignoreunknown)
 {
-       my $textref = defined($_[0]) ? \$_[0] : \$_;
-       my $posbug = pos;
-       my ($lastpos, $firstpos);
-       my @fields = ();
-
-       #for ($$textref)
-       {
-               my @func = defined $_[1] ? @{$_[1]} : @{$def_func};
-               my $max  = defined $_[2] && $_[2]>0 ? $_[2] : 1_000_000_000;
-               my $igunk = $_[3];
-
-               pos $$textref ||= 0;
-
-               unless (wantarray)
-               {
-                       use Carp;
-                       carp "extract_multiple reset maximal count to 1 in scalar context"
-                               if $^W && defined($_[2]) && $max > 1;
-                       $max = 1
-               }
-
-               my $unkpos;
-               my $func;
-               my $class;
-
-               my @class;
-               foreach $func ( @func )
-               {
-                       if (ref($func) eq 'HASH')
-                       {
-                               push @class, (keys %$func)[0];
-                               $func = (values %$func)[0];
-                       }
-                       else
-                       {
-                               push @class, undef;
-                       }
-               }
-
-               FIELD: while (pos($$textref) < length($$textref))
-               {
-                       my ($field, $rem);
-                       my @bits;
-                       foreach my $i ( 0..$#func )
-                       {
-                               my $pref;
-                               $func = $func[$i];
-                               $class = $class[$i];
-                               $lastpos = pos $$textref;
-                               if (ref($func) eq 'CODE')
-                                       { ($field,$rem,$pref) = @bits = $func->($$textref) }
-                               elsif (ref($func) eq 'Text::Balanced::Extractor')
-                                       { @bits = $field = $func->extract($$textref) }
-                               elsif( $$textref =~ m/\G$func/gc )
-                                       { @bits = $field = defined($1)
-                                ? $1
-                                : substr($$textref, $-[0], $+[0] - $-[0])
+    my $textref = defined($_[0]) ? \$_[0] : \$_;
+    my $posbug = pos;
+    my ($lastpos, $firstpos);
+    my @fields = ();
+
+    #for ($$textref)
+    {
+        my @func = defined $_[1] ? @{$_[1]} : @{$def_func};
+        my $max  = defined $_[2] && $_[2]>0 ? $_[2] : 1_000_000_000;
+        my $igunk = $_[3];
+
+        pos $$textref ||= 0;
+
+        unless (wantarray)
+        {
+            use Carp;
+            carp "extract_multiple reset maximal count to 1 in scalar context"
+                    if $^W && defined($_[2]) && $max > 1;
+            $max = 1
+        }
+
+        my $unkpos;
+        my $class;
+
+        my @class;
+        foreach my $func ( @func )
+        {
+            if (ref($func) eq 'HASH')
+            {
+                push @class, (keys %$func)[0];
+                $func = (values %$func)[0];
+            }
+            else
+            {
+                push @class, undef;
+            }
+        }
+
+        FIELD: while (pos($$textref) < length($$textref))
+        {
+            my ($field, $rem);
+            my @bits;
+            foreach my $i ( 0..$#func )
+            {
+                my $pref;
+                my $func = $func[$i];
+                $class = $class[$i];
+                $lastpos = pos $$textref;
+                if (ref($func) eq 'CODE')
+                    { ($field,$rem,$pref) = @bits = $func->($$textref) }
+                elsif (ref($func) eq 'Text::Balanced::Extractor')
+                    { @bits = $field = $func->extract($$textref) }
+                elsif( $$textref =~ m/\G$func/gc )
+                    { @bits = $field = defined($1)
+                        ? $1
+                        : substr($$textref, $-[0], $+[0] - $-[0])
+                    }
+                $pref ||= "";
+                if (defined($field) && length($field))
+                {
+                    if (!$igunk) {
+                        $unkpos = $lastpos
+                            if length($pref) && !defined($unkpos);
+                        if (defined $unkpos)
+                        {
+                            push @fields, substr($$textref, $unkpos, $lastpos-$unkpos).$pref;
+                            $firstpos = $unkpos unless defined $firstpos;
+                            undef $unkpos;
+                            last FIELD if @fields == $max;
+                        }
                     }
-                               $pref ||= "";
-                               if (defined($field) && length($field))
-                               {
-                                       if (!$igunk) {
-                                               $unkpos = $lastpos
-                                                       if length($pref) && !defined($unkpos);
-                                               if (defined $unkpos)
-                                               {
-                                                       push @fields, substr($$textref, $unkpos, $lastpos-$unkpos).$pref;
-                                                       $firstpos = $unkpos unless defined $firstpos;
-                                                       undef $unkpos;
-                                                       last FIELD if @fields == $max;
-                                               }
-                                       }
-                                       push @fields, $class
-                                               ? bless (\$field, $class)
-                                               : $field;
-                                       $firstpos = $lastpos unless defined $firstpos;
-                                       $lastpos = pos $$textref;
-                                       last FIELD if @fields == $max;
-                                       next FIELD;
-                               }
-                       }
-                       if ($$textref =~ /\G(.)/gcs)
-                       {
-                               $unkpos = pos($$textref)-1
-                                       unless $igunk || defined $unkpos;
-                       }
-               }
-               
-               if (defined $unkpos)
-               {
-                       push @fields, substr($$textref, $unkpos);
-                       $firstpos = $unkpos unless defined $firstpos;
-                       $lastpos = length $$textref;
-               }
-               last;
-       }
-
-       pos $$textref = $lastpos;
-       return @fields if wantarray;
-
-       $firstpos ||= 0;
-       eval { substr($$textref,$firstpos,$lastpos-$firstpos)="";
-              pos $$textref = $firstpos };
-       return $fields[0];
+                    push @fields, $class
+                            ? bless (\$field, $class)
+                            : $field;
+                    $firstpos = $lastpos unless defined $firstpos;
+                    $lastpos = pos $$textref;
+                    last FIELD if @fields == $max;
+                    next FIELD;
+                }
+            }
+            if ($$textref =~ /\G(.)/gcs)
+            {
+                $unkpos = pos($$textref)-1
+                    unless $igunk || defined $unkpos;
+            }
+        }
+
+        if (defined $unkpos)
+        {
+            push @fields, substr($$textref, $unkpos);
+            $firstpos = $unkpos unless defined $firstpos;
+            $lastpos = length $$textref;
+        }
+        last;
+    }
+
+    pos $$textref = $lastpos;
+    return @fields if wantarray;
+
+    $firstpos ||= 0;
+    eval { substr($$textref,$firstpos,$lastpos-$firstpos)="";
+           pos $$textref = $firstpos };
+    return $fields[0];
 }
 
 sub gen_extract_tagged # ($opentag, $closetag, $pre, \%options)
 {
-       my $ldel    = $_[0];
-       my $rdel    = $_[1];
-       my $pre     = defined $_[2] ? $_[2] : '\s*';
-       my %options = defined $_[3] ? %{$_[3]} : ();
-       my $omode   = defined $options{fail} ? $options{fail} : '';
-       my $bad     = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}})
-                   : defined($options{reject})        ? $options{reject}
-                   :                                    ''
-                   ;
-       my $ignore  = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}})
-                   : defined($options{ignore})        ? $options{ignore}
-                   :                                    ''
-                   ;
-
-       if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; }
-
-       my $posbug = pos;
-       for ($ldel, $pre, $bad, $ignore) { $_ = qr/$_/ if $_ }
-       pos = $posbug;
-
-       my $closure = sub
-       {
-               my $textref = defined $_[0] ? \$_[0] : \$_;
-               my @match = Text::Balanced::_match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore);
-
-               return _fail(wantarray, $textref) unless @match;
-               return _succeed wantarray, $textref,
-                               $match[2], $match[3]+$match[5]+$match[7],       # MATCH
-                               @match[8..9,0..1,2..7];                         # REM, PRE, BITS
-       };
-
-       bless $closure, 'Text::Balanced::Extractor';
+    my $ldel    = $_[0];
+    my $rdel    = $_[1];
+    my $pre     = defined $_[2] ? $_[2] : '\s*';
+    my %options = defined $_[3] ? %{$_[3]} : ();
+    my $omode   = defined $options{fail} ? $options{fail} : '';
+    my $bad     = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}})
+                : defined($options{reject})        ? $options{reject}
+                :                                    ''
+                ;
+    my $ignore  = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}})
+                : defined($options{ignore})        ? $options{ignore}
+                :                                    ''
+                ;
+
+    if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; }
+
+    my $posbug = pos;
+    for ($ldel, $pre, $bad, $ignore) { $_ = qr/$_/ if $_ }
+    pos = $posbug;
+
+    my $closure = sub
+    {
+        my $textref = defined $_[0] ? \$_[0] : \$_;
+        my @match = Text::Balanced::_match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore);
+
+        return _fail(wantarray, $textref) unless @match;
+        return _succeed wantarray, $textref,
+                        $match[2], $match[3]+$match[5]+$match[7],   # MATCH
+                        @match[8..9,0..1,2..7];                     # REM, PRE, BITS
+    };
+
+    bless $closure, 'Text::Balanced::Extractor';
 }
 
 package Text::Balanced::Extractor;
 
-sub extract($$)        # ($self, $text)
+sub extract($$) # ($self, $text)
 {
-       &{$_[0]}($_[1]);
+    &{$_[0]}($_[1]);
 }
 
 package Text::Balanced::ErrorMsg;
@@ -1032,83 +1041,76 @@ Text::Balanced - Extract delimited text sequences from strings.
 
 =head1 SYNOPSIS
 
- use Text::Balanced qw (
-                       extract_delimited
-                       extract_bracketed
-                       extract_quotelike
-                       extract_codeblock
-                       extract_variable
-                       extract_tagged
-                       extract_multiple
-                       gen_delimited_pat
-                       gen_extract_tagged
-                      );
   use Text::Balanced qw (
+        extract_delimited
+        extract_bracketed
+        extract_quotelike
+        extract_codeblock
+        extract_variable
+        extract_tagged
+        extract_multiple
+        gen_delimited_pat
+        gen_extract_tagged
+    );
 
- # Extract the initial substring of $text that is delimited by
- # two (unescaped) instances of the first character in $delim.
   # Extract the initial substring of $text that is delimited by
   # two (unescaped) instances of the first character in $delim.
 
-       ($extracted, $remainder) = extract_delimited($text,$delim);
+    ($extracted, $remainder) = extract_delimited($text,$delim);
 
+    # Extract the initial substring of $text that is bracketed
+    # with a delimiter(s) specified by $delim (where the string
+    # in $delim contains one or more of '(){}[]<>').
 
- # Extract the initial substring of $text that is bracketed
- # with a delimiter(s) specified by $delim (where the string
- # in $delim contains one or more of '(){}[]<>').
+    ($extracted, $remainder) = extract_bracketed($text,$delim);
 
-       ($extracted, $remainder) = extract_bracketed($text,$delim);
+    # Extract the initial substring of $text that is bounded by
+    # an XML tag.
 
+    ($extracted, $remainder) = extract_tagged($text);
 
- # Extract the initial substring of $text that is bounded by
- # an XML tag.
   # Extract the initial substring of $text that is bounded by
+    # a C<BEGIN>...C<END> pair. Don't allow nested C<BEGIN> tags
 
-       ($extracted, $remainder) = extract_tagged($text);
+    ($extracted, $remainder) =
+        extract_tagged($text,"BEGIN","END",undef,{bad=>["BEGIN"]});
 
+    # Extract the initial substring of $text that represents a
+    # Perl "quote or quote-like operation"
 
- # Extract the initial substring of $text that is bounded by
- # a C<BEGIN>...C<END> pair. Don't allow nested C<BEGIN> tags
+    ($extracted, $remainder) = extract_quotelike($text);
 
-       ($extracted, $remainder) =
-               extract_tagged($text,"BEGIN","END",undef,{bad=>["BEGIN"]});
+    # Extract the initial substring of $text that represents a block
+    # of Perl code, bracketed by any of character(s) specified by $delim
+    # (where the string $delim contains one or more of '(){}[]<>').
 
+    ($extracted, $remainder) = extract_codeblock($text,$delim);
 
- # Extract the initial substring of $text that represents a
- # Perl "quote or quote-like operation"
+    # Extract the initial substrings of $text that would be extracted by
+    # one or more sequential applications of the specified functions
+    # or regular expressions
 
-       ($extracted, $remainder) = extract_quotelike($text);
+    @extracted = extract_multiple($text,
+                                  [ \&extract_bracketed,
+                                    \&extract_quotelike,
+                                    \&some_other_extractor_sub,
+                                    qr/[xyz]*/,
+                                    'literal',
+                                  ]);
 
+    # Create a string representing an optimized pattern (a la Friedl)
+    # that matches a substring delimited by any of the specified characters
+    # (in this case: any type of quote or a slash)
 
- # Extract the initial substring of $text that represents a block
- # of Perl code, bracketed by any of character(s) specified by $delim
- # (where the string $delim contains one or more of '(){}[]<>').
+    $patstring = gen_delimited_pat(q{'"`/});
 
-       ($extracted, $remainder) = extract_codeblock($text,$delim);
+    # Generate a reference to an anonymous sub that is just like extract_tagged
+    # but pre-compiled and optimized for a specific pair of tags, and
+    # consequently much faster (i.e. 3 times faster). It uses qr// for better
+    # performance on repeated calls.
 
-
- # Extract the initial substrings of $text that would be extracted by
- # one or more sequential applications of the specified functions
- # or regular expressions
-
-       @extracted = extract_multiple($text,
-                                     [ \&extract_bracketed,
-                                       \&extract_quotelike,
-                                       \&some_other_extractor_sub,
-                                       qr/[xyz]*/,
-                                       'literal',
-                                     ]);
-
-# Create a string representing an optimized pattern (a la Friedl)
-# that matches a substring delimited by any of the specified characters
-# (in this case: any type of quote or a slash)
-
-       $patstring = gen_delimited_pat(q{'"`/});
-
-# Generate a reference to an anonymous sub that is just like extract_tagged
-# but pre-compiled and optimized for a specific pair of tags, and consequently
-# much faster (i.e. 3 times faster). It uses qr// for better performance on
-# repeated calls, so it only works under Perl 5.005 or later.
-
-       $extract_head = gen_extract_tagged('<HEAD>','</HEAD>');
-
-       ($extracted, $remainder) = $extract_head->($text);
+    $extract_head = gen_extract_tagged('<HEAD>','</HEAD>');
+    ($extracted, $remainder) = $extract_head->($text);
 
 =head1 DESCRIPTION
 
@@ -1128,7 +1130,7 @@ they extract an occurrence of the substring appearing
 immediately at the current matching position in the
 string (like a C<\G>-anchored regex would).
 
-=head2 General behaviour in list contexts
+=head2 General Behaviour in List Contexts
 
 In a list context, all the subroutines return a list, the first three
 elements of which are always:
@@ -1150,31 +1152,31 @@ extracted string). On failure, the entire string is returned.
 The skipped prefix (i.e. the characters before the extracted string).
 On failure, C<undef> is returned.
 
-=back 
+=back
 
 Note that in a list context, the contents of the original input text (the first
-argument) are not modified in any way. 
+argument) are not modified in any way.
 
 However, if the input text was passed in a variable, that variable's
 C<pos> value is updated to point at the first character after the
 extracted text. That means that in a list context the various
 subroutines can be used much like regular expressions. For example:
 
-       while ( $next = (extract_quotelike($text))[0] )
-       {
-               # process next quote-like (in $next)
-       }
+    while ( $next = (extract_quotelike($text))[0] )
+    {
+        # process next quote-like (in $next)
+    }
 
-=head2 General behaviour in scalar and void contexts
+=head2 General Behaviour in Scalar and Void Contexts
 
 In a scalar context, the extracted string is returned, having first been
 removed from the input text. Thus, the following code also processes
 each quote-like operation, but actually removes them from $text:
 
-       while ( $next = extract_quotelike($text) )
-       {
-               # process next quote-like (in $next)
-       }
+    while ( $next = extract_quotelike($text) )
+    {
+        # process next quote-like (in $next)
+    }
 
 Note that if the input text is a read-only string (i.e. a literal),
 no attempt is made to remove the extracted text.
@@ -1183,7 +1185,7 @@ In a void context the behaviour of the extraction subroutines is
 exactly the same as in a scalar context, except (of course) that the
 extracted substring is not returned.
 
-=head2 A note about prefixes
+=head2 A Note About Prefixes
 
 Prefix patterns are matched without any trailing modifiers (C</gimsox> etc.)
 This can bite you if you're expecting a prefix specification like
@@ -1194,19 +1196,23 @@ pattern will only succeed if the <H1> tag is on the current line, since
 To overcome this limitation, you need to turn on /s matching within
 the prefix pattern, using the C<(?s)> directive: '(?s).*?(?=<H1>)'
 
-=head2 C<extract_delimited>
+=head2 Functions
+
+=over 4
+
+=item C<extract_delimited>
 
 The C<extract_delimited> function formalizes the common idiom
 of extracting a single-character-delimited substring from the start of
 a string. For example, to extract a single-quote delimited string, the
 following code is typically used:
 
-       ($remainder = $text) =~ s/\A('(\\.|[^'])*')//s;
-       $extracted = $1;
+    ($remainder = $text) =~ s/\A('(\\.|[^'])*')//s;
+    $extracted = $1;
 
 but with C<extract_delimited> it can be simplified to:
 
-       ($extracted,$remainder) = extract_delimited($text, "'");
+    ($extracted,$remainder) = extract_delimited($text, "'");
 
 C<extract_delimited> takes up to four scalars (the input text, the
 delimiters, a prefix pattern to be skipped, and any escape characters)
@@ -1240,42 +1246,42 @@ removed from the beginning of the first argument.
 
 Examples:
 
-       # Remove a single-quoted substring from the very beginning of $text:
+    # Remove a single-quoted substring from the very beginning of $text:
 
-               $substring = extract_delimited($text, "'", '');
+        $substring = extract_delimited($text, "'", '');
 
-       # Remove a single-quoted Pascalish substring (i.e. one in which
-       # doubling the quote character escapes it) from the very
-       # beginning of $text:
+    # Remove a single-quoted Pascalish substring (i.e. one in which
+    # doubling the quote character escapes it) from the very
+    # beginning of $text:
 
-               $substring = extract_delimited($text, "'", '', "'");
+        $substring = extract_delimited($text, "'", '', "'");
 
-       # Extract a single- or double- quoted substring from the
-       # beginning of $text, optionally after some whitespace
-       # (note the list context to protect $text from modification):
+    # Extract a single- or double- quoted substring from the
+    # beginning of $text, optionally after some whitespace
+    # (note the list context to protect $text from modification):
 
-               ($substring) = extract_delimited $text, q{"'};
+        ($substring) = extract_delimited $text, q{"'};
 
-       # Delete the substring delimited by the first '/' in $text:
+    # Delete the substring delimited by the first '/' in $text:
 
-               $text = join '', (extract_delimited($text,'/','[^/]*')[2,1];
+        $text = join '', (extract_delimited($text,'/','[^/]*')[2,1];
 
 Note that this last example is I<not> the same as deleting the first
 quote-like pattern. For instance, if C<$text> contained the string:
 
-       "if ('./cmd' =~ m/$UNIXCMD/s) { $cmd = $1; }"
-       
+    "if ('./cmd' =~ m/$UNIXCMD/s) { $cmd = $1; }"
+
 then after the deletion it would contain:
 
-       "if ('.$UNIXCMD/s) { $cmd = $1; }"
+    "if ('.$UNIXCMD/s) { $cmd = $1; }"
 
 not:
 
-       "if ('./cmd' =~ ms) { $cmd = $1; }"
-       
+    "if ('./cmd' =~ ms) { $cmd = $1; }"
+
 See L<"extract_quotelike"> for a (partial) solution to this problem.
 
-=head2 C<extract_bracketed>
+=item C<extract_bracketed>
 
 Like C<"extract_delimited">, the C<extract_bracketed> function takes
 up to three optional scalar arguments: a string to extract from, a delimiter
@@ -1307,15 +1313,15 @@ balanced and correctly nested within the substring, and any other kind of
 
 For example, given the string:
 
-       $text = "{ an '[irregularly :-(] {} parenthesized >:-)' string }";
+    $text = "{ an '[irregularly :-(] {} parenthesized >:-)' string }";
 
 then a call to C<extract_bracketed> in a list context:
 
-       @result = extract_bracketed( $text, '{}' );
+    @result = extract_bracketed( $text, '{}' );
 
 would return:
 
-       ( "{ an '[irregularly :-(] {} parenthesized >:-)' string }" , "" , "" )
+    ( "{ an '[irregularly :-(] {} parenthesized >:-)' string }" , "" , "" )
 
 since both sets of C<'{..}'> brackets are properly nested and evenly balanced.
 (In a scalar context just the first element of the array would be returned. In
@@ -1323,18 +1329,18 @@ a void context, C<$text> would be replaced by an empty string.)
 
 Likewise the call in:
 
-       @result = extract_bracketed( $text, '{[' );
+    @result = extract_bracketed( $text, '{[' );
 
 would return the same result, since all sets of both types of specified
 delimiter brackets are correctly nested and balanced.
 
 However, the call in:
 
-       @result = extract_bracketed( $text, '{([<' );
+    @result = extract_bracketed( $text, '{([<' );
 
 would fail, returning:
 
-       ( undef , "{ an '[irregularly :-(] {} parenthesized >:-)' string }"  );
+    ( undef , "{ an '[irregularly :-(] {} parenthesized >:-)' string }"  );
 
 because the embedded pairs of C<'(..)'>s and C<'[..]'>s are "cross-nested" and
 the embedded C<'E<gt>'> is unbalanced. (In a scalar context, this call would
@@ -1348,37 +1354,37 @@ However, if a particular species of quote character is included in the
 delimiter specification, then that type of quote will be correctly handled.
 for example, if C<$text> is:
 
-       $text = '<A HREF=">>>>">link</A>';
+    $text = '<A HREF=">>>>">link</A>';
 
 then
 
-       @result = extract_bracketed( $text, '<">' );
+    @result = extract_bracketed( $text, '<">' );
 
 returns:
 
-       ( '<A HREF=">>>>">', 'link</A>', "" )
+    ( '<A HREF=">>>>">', 'link</A>', "" )
 
 as expected. Without the specification of C<"> as an embedded quoter:
 
-       @result = extract_bracketed( $text, '<>' );
+    @result = extract_bracketed( $text, '<>' );
 
 the result would be:
 
-       ( '<A HREF=">', '>>>">link</A>', "" )
+    ( '<A HREF=">', '>>>">link</A>', "" )
 
 In addition to the quote delimiters C<'>, C<">, and C<`>, full Perl quote-like
 quoting (i.e. q{string}, qq{string}, etc) can be specified by including the
 letter 'q' as a delimiter. Hence:
 
-       @result = extract_bracketed( $text, '<q>' );
+    @result = extract_bracketed( $text, '<q>' );
 
 would correctly match something like this:
 
-       $text = '<leftop: conj /and/ conj>';
+    $text = '<leftop: conj /and/ conj>';
 
 See also: C<"extract_quotelike"> and C<"extract_codeblock">.
 
-=head2 C<extract_variable>
+=item C<extract_variable>
 
 C<extract_variable> extracts any valid Perl variable or
 variable-involved expression, including scalars, arrays, hashes, array
@@ -1429,11 +1435,10 @@ failure. In addition, the original input text has the returned substring
 In a void context, the input text just has the matched substring (and
 any specified prefix) removed.
 
-
-=head2 C<extract_tagged>
+=item C<extract_tagged>
 
 C<extract_tagged> extracts and segments text between (balanced)
-specified tags. 
+specified tags.
 
 The subroutine takes up to five optional arguments:
 
@@ -1451,12 +1456,12 @@ that matches any standard XML tag is used.
 
 =item 3.
 
-A string specifying a pattern to be matched at the closing tag. 
+A string specifying a pattern to be matched at the closing tag.
 If the pattern string is omitted (or C<undef>) then the closing
 tag is constructed by inserting a C</> after any leading bracket
 characters in the actual opening tag that was matched (I<not> the pattern
 that matched the tag). For example, if the opening tag pattern
-is specified as C<'{{\w+}}'> and actually matched the opening tag 
+is specified as C<'{{\w+}}'> and actually matched the opening tag
 C<"{{DATA}}">, then the constructed closing tag would be C<"{{/DATA}}">.
 
 =item 4.
@@ -1487,7 +1492,7 @@ an HTML link (which should not contain nested links) use:
 =item C<ignore =E<gt> $listref>
 
 The list reference contains one or more strings specifying patterns
-that are I<not> be be treated as nested tags within the tagged text
+that are I<not> to be treated as nested tags within the tagged text
 (even if they would match the start tag pattern).
 
 For example, to extract an arbitrary XML tag, but ignore "empty" elements:
@@ -1508,7 +1513,7 @@ C<extract_tagged> returns the complete text up to the point of failure.
 If the string is "PARA", C<extract_tagged> returns only the first paragraph
 after the tag (up to the first line that is either empty or contains
 only whitespace characters).
-If the string is "", the the default behaviour (i.e. failure) is reinstated.
+If the string is "", the default behaviour (i.e. failure) is reinstated.
 
 For example, suppose the start tag "/para" introduces a paragraph, which then
 continues until the next "/endpara" tag or until another "/para" tag is
@@ -1575,9 +1580,7 @@ text has the returned substring (and any prefix) removed from it.
 In a void context, the input text just has the matched substring (and
 any specified prefix) removed.
 
-=head2 C<gen_extract_tagged>
-
-(Note: This subroutine is only available under Perl5.005)
+=item C<gen_extract_tagged>
 
 C<gen_extract_tagged> generates a new anonymous subroutine which
 extracts text between (balanced) specified tags. In other words,
@@ -1589,7 +1592,7 @@ C<gen_extract_tagged>, is that those generated subroutines:
 
 =over 4
 
-=item * 
+=item *
 
 do not have to reparse tag specification or parsing options every time
 they are called (whereas C<extract_tagged> has to effectively rebuild
@@ -1598,7 +1601,7 @@ its tag parser on every call);
 =item *
 
 make use of the new qr// construct to pre-compile the regexes they use
-(whereas C<extract_tagged> uses standard string variable interpolation 
+(whereas C<extract_tagged> uses standard string variable interpolation
 to create tag-matching patterns).
 
 =back
@@ -1618,16 +1621,14 @@ equivalent to:
                 return $extractor->($text);
         }
 
-(although C<extract_tagged> is not currently implemented that way, in order
-to preserve pre-5.005 compatibility).
+(although C<extract_tagged> is not currently implemented that way).
 
-Using C<gen_extract_tagged> to create extraction functions for specific tags 
+Using C<gen_extract_tagged> to create extraction functions for specific tags
 is a good idea if those functions are going to be called more than once, since
 their performance is typically twice as good as the more general-purpose
 C<extract_tagged>.
 
-
-=head2 C<extract_quotelike>
+=item C<extract_quotelike>
 
 C<extract_quotelike> attempts to recognize, extract, and segment any
 one of the various Perl quotes and quotelike operators (see
@@ -1636,7 +1637,7 @@ delimiters (for the quotelike operators), and trailing modifiers are
 all caught. For example, in:
 
         extract_quotelike 'q # an octothorpe: \# (not the end of the q!) #'
-        
+
         extract_quotelike '  "You said, \"Use sed\"."  '
 
         extract_quotelike ' s{([A-Z]{1,8}\.[A-Z]{3})} /\L$1\E/; '
@@ -1664,7 +1665,7 @@ will be extracted as if it were:
 This behaviour is identical to that of the actual compiler.
 
 C<extract_quotelike> takes two arguments: the text to be processed and
-a prefix to be matched at the very beginning of the text. If no prefix 
+a prefix to be matched at the very beginning of the text. If no prefix
 is specified, optional whitespace is the default. If no text is given,
 C<$_> is used.
 
@@ -1710,7 +1711,7 @@ the left delimiter of the second block of the operation
 
 =item [8]
 
-the text of the second block of the operation 
+the text of the second block of the operation
 (that is, the replacement of a substitution or the translation list
 of a translation),
 
@@ -1757,7 +1758,7 @@ Examples:
                         print "$op is not a pattern matching operation\n";
                 }
 
-=head2 C<extract_quotelike> and "here documents"
+=item C<extract_quotelike>
 
 C<extract_quotelike> can successfully extract "here documents" from an input
 string, but with an important caveat in list contexts.
@@ -1842,7 +1843,7 @@ you can pass the input variable as an interpolated literal:
 
         $quotelike = extract_quotelike("$var");
 
-=head2 C<extract_codeblock>
+=item C<extract_codeblock>
 
 C<extract_codeblock> attempts to recognize and extract a balanced
 bracket delimited substring that may contain unbalanced brackets
@@ -1861,7 +1862,7 @@ Omitting the third argument (prefix argument) implies optional whitespace at the
 Omitting the fourth argument (outermost delimiter brackets) indicates that the
 value of the second argument is to be used for the outermost delimiters.
 
-Once the prefix an dthe outermost opening delimiter bracket have been
+Once the prefix anthe outermost opening delimiter bracket have been
 recognized, code blocks are extracted by stepping through the input text and
 trying the following alternatives in sequence:
 
@@ -1933,9 +1934,9 @@ S<C<extract_codeblock($text, '{}', undef, 'E<lt>E<gt>')>>
 the '>' character is only treated as a delimited at the outermost
 level of the code block, so the directive is parsed correctly.
 
-=head2 C<extract_multiple>
+=item C<extract_multiple>
 
-The C<extract_multiple> subroutine takes a string to be processed and a 
+The C<extract_multiple> subroutine takes a string to be processed and a
 list of extractors (subroutines or regular expressions) to apply to that string.
 
 In an array context C<extract_multiple> returns an array of substrings
@@ -1947,7 +1948,7 @@ extracted substring removed from it. In all contexts
 C<extract_multiple> starts at the current C<pos> of the string, and
 sets that C<pos> appropriately after it matches.
 
-Hence, the aim of of a call to C<extract_multiple> in a list context
+Hence, the aim of a call to C<extract_multiple> in a list context
 is to split the processed string into as many non-overlapping fields as
 possible, by repeatedly applying each of the specified extractors
 to the remainder of the string. Thus C<extract_multiple> is
@@ -1982,11 +1983,11 @@ An number specifying the maximum number of fields to return. If this
 argument is omitted (or C<undef>), split continues as long as possible.
 
 If the third argument is I<N>, then extraction continues until I<N> fields
-have been successfully extracted, or until the string has been completely 
+have been successfully extracted, or until the string has been completely
 processed.
 
-Note that in scalar and void contexts the value of this argument is 
-automatically reset to 1 (under C<-w>, a warning is issued if the argument 
+Note that in scalar and void contexts the value of this argument is
+automatically reset to 1 (under C<-w>, a warning is issued if the argument
 has to be reset).
 
 =item 4.
@@ -2026,7 +2027,7 @@ return value of the extractor will be blessed.
 If an extractor returns a defined value, that value is immediately
 treated as the next extracted field and pushed onto the list of fields.
 If the extractor was specified in a hash reference, the field is also
-blessed into the appropriate class, 
+blessed into the appropriate class,
 
 If the extractor fails to match (in the case of a regex extractor), or returns an empty list or an undefined value (in the case of a subroutine extractor), it is
 assumed to have failed to extract.
@@ -2080,7 +2081,7 @@ If you wanted the commas preserved as separate fields (i.e. like split
 does if your split pattern has capturing parentheses), you would
 just make the last parameter undefined (or remove it).
 
-=head2 C<gen_delimited_pat>
+=item C<gen_delimited_pat>
 
 The C<gen_delimited_pat> subroutine takes a single (string) argument and
    > builds a Friedl-style optimized regex that matches a string delimited
@@ -2119,11 +2120,12 @@ If more delimiters than escape chars are specified, the last escape char
 is used for the remaining delimiters.
 If no escape char is specified for a given specified delimiter, '\' is used.
 
-=head2 C<delimited_pat>
+=item C<delimited_pat>
 
 Note that C<gen_delimited_pat> was previously called C<delimited_pat>.
 That name may still be used, but is now deprecated.
-        
+
+=back
 
 =head1 DIAGNOSTICS
 
@@ -2170,7 +2172,7 @@ a closing bracket where none was expected.
 
 =item  C<Unmatched opening bracket(s): "%s">
 
-C<extract_bracketed>, C<extract_quotelike> or C<extract_codeblock> ran 
+C<extract_bracketed>, C<extract_quotelike> or C<extract_codeblock> ran
 out of characters in the text before closing one or more levels of nested
 brackets.
 
@@ -2257,25 +2259,125 @@ to match the original opening tag (and the failure mode was not
 
 =back
 
-=head1 AUTHOR
+=head1 EXPORTS
 
-Damian Conway (damian@conway.org)
+The following symbols are, or can be, exported by this module:
 
-=head1 BUGS AND IRRITATIONS
+=over 4
+
+=item Default Exports
+
+I<None>.
+
+=item Optional Exports
+
+C<extract_delimited>,
+C<extract_bracketed>,
+C<extract_quotelike>,
+C<extract_codeblock>,
+C<extract_variable>,
+C<extract_tagged>,
+C<extract_multiple>,
+C<gen_delimited_pat>,
+C<gen_extract_tagged>,
+C<delimited_pat>.
+
+=item Export Tags
+
+=over 4
+
+=item C<:ALL>
+
+C<extract_delimited>,
+C<extract_bracketed>,
+C<extract_quotelike>,
+C<extract_codeblock>,
+C<extract_variable>,
+C<extract_tagged>,
+C<extract_multiple>,
+C<gen_delimited_pat>,
+C<gen_extract_tagged>,
+C<delimited_pat>.
+
+=back
+
+=back
+
+=head1 KNOWN BUGS
+
+See L<https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=Text-Balanced>.
+
+=head1 FEEDBACK
+
+Patches, bug reports, suggestions or any other feedback is welcome.
+
+Patches can be sent as GitHub pull requests at
+L<https://github.com/steve-m-hay/Text-Balanced/pulls>.
+
+Bug reports and suggestions can be made on the CPAN Request Tracker at
+L<https://rt.cpan.org/Public/Bug/Report.html?Queue=Text-Balanced>.
+
+Currently active requests on the CPAN Request Tracker can be viewed at
+L<https://rt.cpan.org/Public/Dist/Display.html?Status=Active;Queue=Text-Balanced>.
 
-There are undoubtedly serious bugs lurking somewhere in this code, if
-only because parts of it give the impression of understanding a great deal
-more about Perl than they really do. 
+Please test this distribution.  See CPAN Testers Reports at
+L<https://www.cpantesters.org/> for details of how to get involved.
 
-Bug reports and other feedback are most welcome.
+Previous test results on CPAN Testers Reports can be viewed at
+L<https://www.cpantesters.org/distro/T/Text-Balanced.html>.
+
+Please rate this distribution on CPAN Ratings at
+L<https://cpanratings.perl.org/rate/?distribution=Text-Balanced>.
+
+=head1 AVAILABILITY
+
+The latest version of this module is available from CPAN (see
+L<perlmodlib/"CPAN"> for details) at
+
+L<https://metacpan.org/release/Text-Balanced> or
+
+L<https://www.cpan.org/authors/id/S/SH/SHAY/> or
+
+L<https://www.cpan.org/modules/by-module/Text/>.
+
+The latest source code is available from GitHub at
+L<https://github.com/steve-m-hay/Text-Balanced>.
+
+=head1 INSTALLATION
+
+See the F<INSTALL> file.
+
+=head1 AUTHOR
+
+Damian Conway E<lt>L<damian@conway.org|mailto:damian@conway.org>E<gt>.
+
+Steve Hay E<lt>L<shay@cpan.org|mailto:shay@cpan.org>E<gt> is now maintaining
+Text::Balanced as of version 2.03.
 
 =head1 COPYRIGHT
 
-Copyright 1997 - 2001 Damian Conway. All Rights Reserved.
+Copyright (C) 1997-2001 Damian Conway.  All rights reserved.
+
+Copyright (C) 2009 Adam Kennedy.
+
+Copyright (C) 2015, 2020 Steve Hay.  All rights reserved.
+
+=head1 LICENCE
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself, i.e. under the terms of either the GNU General Public
+License or the Artistic License, as specified in the F<LICENCE> file.
+
+=head1 VERSION
+
+Version 2.04
+
+=head1 DATE
+
+11 Dec 2020
 
-Some (minor) parts copyright 2009 Adam Kennedy.
+=head1 HISTORY
 
-This module is free software. It may be used, redistributed
-and/or modified under the same terms as Perl itself.
+See the F<Changes> file.
 
 =cut
index 77c1099..a6e9191 100644 (file)
@@ -1,10 +1,9 @@
 #!/usr/bin/perl
 
+use 5.008001;
+
 use strict;
-BEGIN {
-       $|  = 1;
-       $^W = 1;
-}
+use warnings;
 
 use Test::More tests => 1;
 
index a36025d..5da792f 100644 (file)
@@ -1,52 +1,60 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..19\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_bracketed );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       $var = eval "() = $cmd";
-       debug "\t list got: [$var]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    chomp $str;
+    if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    $str =~ s/\\n/\n/g;
+    debug "\tUsing: $cmd\n";
+    debug "\t   on: [$str]\n";
+
+    my $var = eval "() = $cmd";
+    debug "\t list got: [$var]\n";
+    debug "\t list left: [$str]\n";
+    print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
+
+    pos $str = 0;
+    $var = eval $cmd;
+    $var = "<undef>" unless defined $var;
+    debug "\t scalar got: [$var]\n";
+    debug "\t scalar left: [$str]\n";
+    print "not " if ($str =~ '\A;')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 }
 
 __DATA__
index 83081ae..398d277 100644 (file)
@@ -1,53 +1,61 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..41\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_codeblock );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval "\@res = $cmd";
-       debug "\t   Failed: $@ at " . $@+0 .")" if $@;
-       debug "\t list got: [" . join("|", map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    chomp $str;
+    if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    $str =~ s/\\n/\n/g;
+    debug "\tUsing: $cmd\n";
+    debug "\t   on: [$str]\n";
+
+    my @res;
+    my $var = eval "\@res = $cmd";
+    debug "\t   Failed: $@ at " . $@+0 .")" if $@;
+    debug "\t list got: [" . join("|", map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
+    debug "\t list left: [$str]\n";
+    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+    print "ok ", $count++;
+    print "\n";
+
+    pos $str = 0;
+    $var = eval $cmd;
+    $var = "<undef>" unless defined $var;
+    debug "\t scalar got: [$var]\n";
+    debug "\t scalar left: [$str]\n";
+    print "not " if ($str =~ '\A;')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 }
 
 __DATA__
index c5ca88e..b2f94cf 100644 (file)
@@ -1,52 +1,60 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..45\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_delimited );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
+    chomp $str;
+    if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    $str =~ s/\\n/\n/g;
+    debug "\tUsing: $cmd\n";
+    debug "\t   on: [$str]\n";
 
-       $var = eval "() = $cmd";
-       debug "\t list got: [$var]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    my $var = eval "() = $cmd";
+    debug "\t list got: [$var]\n";
+    debug "\t list left: [$str]\n";
+    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    pos $str = 0;
+    $var = eval $cmd;
+    $var = "<undef>" unless defined $var;
+    debug "\t scalar got: [$var]\n";
+    debug "\t scalar left: [$str]\n";
+    print "not " if ($str =~ '\A;')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 }
 
 __DATA__
index 2ac1b19..9a9711b 100644 (file)
@@ -1,17 +1,23 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..86\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( :ALL );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
@@ -19,62 +25,62 @@ sub debug { print "\t>>>",@_ if $DEBUG }
 
 sub expect
 {
-       local $^W;
-       my ($l1, $l2) = @_;
-
-       if (@$l1 != @$l2)
-       {
-               print "\@l1: ", join(", ", @$l1), "\n";
-               print "\@l2: ", join(", ", @$l2), "\n";
-               print "not ";
-       }
-       else
-       {
-               for (my $i = 0; $i < @$l1; $i++)
-               {
-                       if ($l1->[$i] ne $l2->[$i])
-                       {
-                               print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
-                               print "not ";
-                               last;
-                       }
-               }
-       }
-
-       print "ok $count\n";
-       $count++;
+    local $^W;
+    my ($l1, $l2) = @_;
+
+    if (@$l1 != @$l2)
+    {
+        print "\@l1: ", join(", ", @$l1), "\n";
+        print "\@l2: ", join(", ", @$l2), "\n";
+        print "not ";
+    }
+    else
+    {
+        for (my $i = 0; $i < @$l1; $i++)
+        {
+            if ($l1->[$i] ne $l2->[$i])
+            {
+                print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
+                print "not ";
+                last;
+            }
+        }
+    }
+
+    print "ok $count\n";
+    $count++;
 }
 
 sub divide
 {
-       my ($text, @index) = @_;
-       my @bits = ();
-       unshift @index, 0;
-       push @index, length($text);
-       for ( my $i= 0; $i < $#index; $i++)
-       {
-               push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
-       }
-       pop @bits;
-       return @bits;
+    my ($text, @index) = @_;
+    my @bits = ();
+    unshift @index, 0;
+    push @index, length($text);
+    for ( my $i= 0; $i < $#index; $i++)
+    {
+        push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
+    }
+    pop @bits;
+    return @bits;
 
 }
 
 
-$stdtext1 = q{$var = do {"val" && $val;};};
+my $stdtext1 = q{$var = do {"val" && $val;};};
 
 # TESTS 2-4
-$text = $stdtext1;
-expect [ extract_multiple($text,undef,1) ],
-       [ divide $stdtext1 => 4 ];
+my $text = $stdtext1;
+expect [ extract_multiple($text,undef,1) ],
+       [ divide $stdtext1 => 4 ];
 
 expect [ pos $text], [ 4 ];
 expect [ $text ], [ $stdtext1 ];
 
 # TESTS 5-7
 $text = $stdtext1;
-expect [ scalar extract_multiple($text,undef,1) ],
-       [ divide $stdtext1 => 4 ];
+expect [ scalar extract_multiple($text,undef,1) ],
+       [ divide $stdtext1 => 4 ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext1,4) ];
@@ -82,16 +88,16 @@ expect [ $text ], [ substr($stdtext1,4) ];
 
 # TESTS 8-10
 $text = $stdtext1;
-expect [ extract_multiple($text,undef,2) ],
-       [ divide($stdtext1 => 4, 10) ];
+expect [ extract_multiple($text,undef,2) ],
+       [ divide($stdtext1 => 4, 10) ];
 
 expect [ pos $text], [ 10 ];
 expect [ $text ], [ $stdtext1 ];
 
 # TESTS 11-13
 $text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
-       [ substr($stdtext1,0,4) ];
+expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
+       [ substr($stdtext1,0,4) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext1,4) ];
@@ -99,16 +105,16 @@ expect [ $text ], [ substr($stdtext1,4) ];
 
 # TESTS 14-16
 $text = $stdtext1;
-expect [ extract_multiple($text,undef,3) ],
-       [ divide($stdtext1 => 4, 10, 26) ];
+expect [ extract_multiple($text,undef,3) ],
+       [ divide($stdtext1 => 4, 10, 26) ];
 
 expect [ pos $text], [ 26 ];
 expect [ $text ], [ $stdtext1 ];
 
 # TESTS 17-19
 $text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
-       [ substr($stdtext1,0,4) ];
+expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
+       [ substr($stdtext1,0,4) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext1,4) ];
@@ -116,16 +122,16 @@ expect [ $text ], [ substr($stdtext1,4) ];
 
 # TESTS 20-22
 $text = $stdtext1;
-expect [ extract_multiple($text,undef,4) ],
-       [ divide($stdtext1 => 4, 10, 26, 27) ];
+expect [ extract_multiple($text,undef,4) ],
+       [ divide($stdtext1 => 4, 10, 26, 27) ];
 
 expect [ pos $text], [ 27 ];
 expect [ $text ], [ $stdtext1 ];
 
 # TESTS 23-25
 $text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
-       [ substr($stdtext1,0,4) ];
+expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
+       [ substr($stdtext1,0,4) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext1,4) ];
@@ -133,8 +139,8 @@ expect [ $text ], [ substr($stdtext1,4) ];
 
 # TESTS 26-28
 $text = $stdtext1;
-expect [ extract_multiple($text,undef,5) ],
-       [ divide($stdtext1 => 4, 10, 26, 27) ];
+expect [ extract_multiple($text,undef,5) ],
+       [ divide($stdtext1 => 4, 10, 26, 27) ];
 
 expect [ pos $text], [ 27 ];
 expect [ $text ], [ $stdtext1 ];
@@ -142,8 +148,8 @@ expect [ $text ], [ $stdtext1 ];
 
 # TESTS 29-31
 $text = $stdtext1;
-expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
-       [ substr($stdtext1,0,4) ];
+expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
+       [ substr($stdtext1,0,4) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext1,4) ];
@@ -151,19 +157,19 @@ expect [ $text ], [ substr($stdtext1,4) ];
 
 
 # TESTS 32-34
-$stdtext2 = q{$var = "val" && (1,2,3);};
+my $stdtext2 = q{$var = "val" && (1,2,3);};
 
 $text = $stdtext2;
-expect [ extract_multiple($text) ],
-       [ divide($stdtext2 => 4, 7, 12, 24) ];
+expect [ extract_multiple($text) ],
+       [ divide($stdtext2 => 4, 7, 12, 24) ];
 
 expect [ pos $text], [ 24 ];
 expect [ $text ], [ $stdtext2 ];
 
 # TESTS 35-37
 $text = $stdtext2;
-expect [ scalar extract_multiple($text) ],
-       [ substr($stdtext2,0,4) ];
+expect [ scalar extract_multiple($text) ],
+       [ substr($stdtext2,0,4) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext2,4) ];
@@ -171,16 +177,16 @@ expect [ $text ], [ substr($stdtext2,4) ];
 
 # TESTS 38-40
 $text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_bracketed]) ],
-       [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
+expect [ extract_multiple($text,[\&extract_bracketed]) ],
+       [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
 
 expect [ pos $text], [ 24 ];
 expect [ $text ], [ $stdtext2 ];
 
 # TESTS 41-43
 $text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
-       [ substr($stdtext2,0,16) ];
+expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
+       [ substr($stdtext2,0,16) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext2,15) ];
@@ -188,16 +194,16 @@ expect [ $text ], [ substr($stdtext2,15) ];
 
 # TESTS 44-46
 $text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_variable]) ],
-       [ substr($stdtext2,0,4), substr($stdtext2,4) ];
+expect [ extract_multiple($text,[\&extract_variable]) ],
+       [ substr($stdtext2,0,4), substr($stdtext2,4) ];
 
 expect [ pos $text], [ length($text) ];
 expect [ $text ], [ $stdtext2 ];
 
 # TESTS 47-49
 $text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_variable]) ],
-       [ substr($stdtext2,0,4) ];
+expect [ scalar extract_multiple($text,[\&extract_variable]) ],
+       [ substr($stdtext2,0,4) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext2,4) ];
@@ -205,16 +211,16 @@ expect [ $text ], [ substr($stdtext2,4) ];
 
 # TESTS 50-52
 $text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_quotelike]) ],
-       [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
+expect [ extract_multiple($text,[\&extract_quotelike]) ],
+       [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
 
 expect [ pos $text], [ length($text) ];
 expect [ $text ], [ $stdtext2 ];
 
 # TESTS 53-55
 $text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
-       [ substr($stdtext2,0,7) ];
+expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
+       [ substr($stdtext2,0,7) ];
 
 expect [ pos $text], [ 0 ];
 expect [ $text ], [ substr($stdtext2,6) ];
@@ -222,16 +228,16 @@ expect [ $text ], [ substr($stdtext2,6) ];
 
 # TESTS 56-58
 $text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
-       [ substr($stdtext2,7,5) ];
+expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
+       [ substr($stdtext2,7,5) ];
 
 expect [ pos $text], [ 23 ];
 expect [ $text ], [ $stdtext2 ];
 
 # TESTS 59-61
 $text = $stdtext2;
-expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
-       [ substr($stdtext2,7,5) ];
+expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
+       [ substr($stdtext2,7,5) ];
 
 expect [ pos $text], [ 6 ];
 expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
@@ -239,16 +245,16 @@ expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
 
 # TESTS 62-64
 $text = $stdtext2;
-expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
-       [ substr($stdtext2,7,5) ];
+expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
+       [ substr($stdtext2,7,5) ];
 
 expect [ pos $text], [ 12 ];
 expect [ $text ], [ $stdtext2 ];
 
 # TESTS 65-67
 $text = $stdtext2;
-expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
-       [ substr($stdtext2,7,5) ];
+expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
+       [ substr($stdtext2,7,5) ];
 
 expect [ pos $text], [ 6 ];
 expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
@@ -257,8 +263,8 @@ expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
 my $stdtext3 = "a,b,c";
 
 $_ = $stdtext3;
-expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
-       [ divide($stdtext3 => 1,2,3,4,5) ];
+expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+       [ divide($stdtext3 => 1,2,3,4,5) ];
 
 expect [ pos ], [ 5 ];
 expect [ $_ ], [ $stdtext3 ];
@@ -266,8 +272,8 @@ expect [ $_ ], [ $stdtext3 ];
 # TESTS 71-73
 
 $_ = $stdtext3;
-expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
-       [ divide($stdtext3 => 1) ];
+expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+       [ divide($stdtext3 => 1) ];
 
 expect [ pos ], [ 0 ];
 expect [ $_ ], [ substr($stdtext3,1) ];
@@ -276,8 +282,8 @@ expect [ $_ ], [ substr($stdtext3,1) ];
 # TESTS 74-76
 
 $_ = $stdtext3;
-expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
-       [ divide($stdtext3 => 1,2,3,4,5) ];
+expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+       [ divide($stdtext3 => 1,2,3,4,5) ];
 
 expect [ pos ], [ 5 ];
 expect [ $_ ], [ $stdtext3 ];
@@ -285,8 +291,8 @@ expect [ $_ ], [ $stdtext3 ];
 # TESTS 77-79
 
 $_ = $stdtext3;
-expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
-       [ divide($stdtext3 => 1) ];
+expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+       [ divide($stdtext3 => 1) ];
 
 expect [ pos ], [ 0 ];
 expect [ $_ ], [ substr($stdtext3,1) ];
@@ -295,8 +301,8 @@ expect [ $_ ], [ substr($stdtext3,1) ];
 # TESTS 80-82
 
 $_ = $stdtext3;
-expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
-       [ qw(a b c) ];
+expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+       [ qw(a b c) ];
 
 expect [ pos ], [ 5 ];
 expect [ $_ ], [ $stdtext3 ];
@@ -304,8 +310,8 @@ expect [ $_ ], [ $stdtext3 ];
 # TESTS 83-85
 
 $_ = $stdtext3;
-expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
-       [ divide($stdtext3 => 1) ];
+expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+       [ divide($stdtext3 => 1) ];
 
 expect [ pos ], [ 0 ];
 expect [ $_ ], [ substr($stdtext3,2) ];
@@ -315,5 +321,5 @@ expect [ $_ ], [ substr($stdtext3,2) ];
 
 # Fails in Text-Balanced-1.95 with result ['1 ', '""', '1234']
 $_ = q{ ""1234};
-expect [ extract_multiple(undef, [\&extract_quotelike]) ],
-       [ ' ', '""', '1234' ];
+expect [ extract_multiple(undef, [\&extract_quotelike]) ],
+       [ ' ', '""', '1234' ];
index 6badc0e..e32ca7d 100644 (file)
@@ -2,17 +2,23 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..95\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_quotelike );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 #$DEBUG=1;
 sub debug { print "\t>>>",@_ if $ENV{DEBUG} }
@@ -20,48 +26,50 @@ sub esc   { my $x = shift||'<undef>'; $x =~ s/\n/\\n/gs; $x }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       if ($str =~ s/\A# USING://)                 { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/)              { $neg = 0; next }
-       my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
-       my $tests = 'sl';
-       $str =~ s/\\n/\n/g;
-       my $orig = $str;
-
-       eval $setup_cmd if $setup_cmd ne ''; 
-       if($tests =~ /l/) {
-               debug "\tUsing: $cmd\n";
-               debug "\t   on: [" . esc($setup_cmd) . "][" . esc($str) . "]\n";
-               my @res;
-               eval qq{\@res = $cmd; };
-               debug "\t  got:\n" . join "", map { "\t\t\t$_: [" . esc($res[$_]) . "]\n"} (0..$#res);
-               debug "\t left: [" . esc($str) . "]\n";
-               debug "\t  pos: [" . esc(substr($str,pos($str))) . "...]\n";
-               print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-               print "ok ", $count++;
-               print "\n";
-       }
-
-       eval $setup_cmd if $setup_cmd ne '';
-       if($tests =~ /s/) {
-               $str = $orig;
-               debug "\tUsing: scalar $cmd\n";
-               debug "\t   on: [" . esc($str) . "]\n";
-               $var = eval $cmd;
-               print " ($@)" if $@ && $DEBUG;
-               $var = "<undef>" unless defined $var;
-               debug "\t scalar got: [" . esc($var) . "]\n";
-               debug "\t scalar left: [" . esc($str) . "]\n";
-               print "not " if ($str =~ '\A;')==$neg;
-               print "ok ", $count++;
-               print "\n";
-       }
+    chomp $str;
+    if ($str =~ s/\A# USING://)                 { $neg = 0; $cmd = $str; next; }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/)              { $neg = 0; next }
+    my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
+    my $tests = 'sl';
+    $str =~ s/\\n/\n/g;
+    my $orig = $str;
+
+    eval $setup_cmd if $setup_cmd ne '';
+    if($tests =~ /l/) {
+        debug "\tUsing: $cmd\n";
+        debug "\t   on: [" . esc($setup_cmd) . "][" . esc($str) . "]\n";
+        my @res;
+        eval qq{\@res = $cmd; };
+        debug "\t  got:\n" . join "", map { "\t\t\t$_: [" . esc($res[$_]) . "]\n"} (0..$#res);
+        debug "\t left: [" . esc($str) . "]\n";
+        debug "\t  pos: [" . esc(substr($str,pos($str))) . "...]\n";
+        print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+        print "ok ", $count++;
+        print "\n";
+    }
+
+    eval $setup_cmd if $setup_cmd ne '';
+    if($tests =~ /s/) {
+        $str = $orig;
+        debug "\tUsing: scalar $cmd\n";
+        debug "\t   on: [" . esc($str) . "]\n";
+        my $var = eval $cmd;
+        print " ($@)" if $@ && $DEBUG;
+        $var = "<undef>" unless defined $var;
+        debug "\t scalar got: [" . esc($var) . "]\n";
+        debug "\t scalar left: [" . esc($str) . "]\n";
+        print "not " if ($str =~ '\A;')==$neg;
+        print "ok ", $count++;
+        print "\n";
+    }
 }
 
 # fails in Text::Balanced 1.95
@@ -71,7 +79,7 @@ print "not " if $z[0] eq '';
 print "ok ", $count++;
 print "\n";
 
+
 __DATA__
 
 # USING: extract_quotelike($str);
@@ -92,9 +100,9 @@ __DATA__
 <<""; done()\nline1\nline2\n\n and next
 <<; done()\nline1\nline2\n\n and next
 # fails in Text::Balanced 1.95
-<<EOHERE;\nEOHERE\n; 
+<<EOHERE;\nEOHERE\n;
 # fails in Text::Balanced 1.95
-<<"*";\n\n*\n; 
+<<"*";\n\n*\n;
 
 "this is a nested $var[$x] {";
 /a/gci;
@@ -128,8 +136,8 @@ y/x/y/;
 { $tests = 'l'; pos($str)=6 }012345<<E;\n\nE\n
 
 # THESE SHOULD FAIL
-s<$self->{pat}>{$self->{sub}};         # CAN'T HANDLE '>' in '->'
-s-$self->{pap}-$self->{sub}-;          # CAN'T HANDLE '-' in '->'
-<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next;          # RDEL HAS NO ';'
-<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next;        # RDEF HAS NO ';'
+s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->'
+s-$self->{pap}-$self->{sub}-;  # CAN'T HANDLE '-' in '->'
+<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next;   # RDEL HAS NO ';'
+<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next; # RDEF HAS NO ';'
      <<    EOTHERE; done();\nline1\nline2\n    EOTHERE\n; next;  # RDEL IS "" (!)
index 16a48b2..fd7eff4 100644 (file)
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..53\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_tagged gen_extract_tagged );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval "\@res = $cmd";
-       debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    chomp $str;
+    if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    $str =~ s/\\n/\n/g;
+    debug "\tUsing: $cmd\n";
+    debug "\t   on: [$str]\n";
+
+    my @res;
+    my $var = eval "\@res = $cmd";
+    debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
+    debug "\t list left: [$str]\n";
+    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
+
+    pos $str = 0;
+    $var = eval $cmd;
+    $var = "<undef>" unless defined $var;
+    debug "\t scalar got: [$var]\n";
+    debug "\t scalar left: [$str]\n";
+    print "not " if ($str =~ '\A;')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 }
 
 __DATA__
 # USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str);
-       ignore\n this and then BEGINHERE at the ENDHERE;
-       ignore\n this and then BEGINTHIS at the ENDTHIS;
+    ignore\n this and then BEGINHERE at the ENDHERE;
+    ignore\n this and then BEGINTHIS at the ENDTHIS;
 
 # USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
-       ignore\n this and then BEGINHERE at the ENDHERE;
-       ignore\n this and then BEGINTHIS at the ENDTHIS;
+    ignore\n this and then BEGINHERE at the ENDHERE;
+    ignore\n this and then BEGINTHIS at the ENDTHIS;
 
 # USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
-       ignore\n this and then BEGINHERE at the ENDHERE;
-       ignore\n this and then BEGINTHIS at the ENDTHIS;
+    ignore\n this and then BEGINHERE at the ENDHERE;
+    ignore\n this and then BEGINTHIS at the ENDTHIS;
 
 # THIS SHOULD FAIL
-       ignore\n this and then BEGINTHIS at the ENDTHAT;
+    ignore\n this and then BEGINTHIS at the ENDTHAT;
 
 # USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)");
-       ignore\n this and then BEGIN at the END;
+    ignore\n this and then BEGIN at the END;
 
 # USING: extract_tagged($str);
-       <A-1 HREF="#section2">some text</A-1>;
+    <A-1 HREF="#section2">some text</A-1>;
 
 # USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+    <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
 
 # USING: extract_tagged($str,"BEGIN","END");
-       BEGIN at the BEGIN keyword and END at the END;
-       BEGIN at the beginning and end at the END;
+    BEGIN at the BEGIN keyword and END at the END;
+    BEGIN at the beginning and end at the END;
 
 # USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]});
-       <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+    <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
 
 # USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"});
-       ; at the ;-) keyword
+    ; at the ;-) keyword
 
 # USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+    <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
 
 # THESE SHOULD FAIL
-       BEGIN at the beginning and end at the end;
-       BEGIN at the BEGIN keyword and END at the end;
+    BEGIN at the beginning and end at the end;
+    BEGIN at the BEGIN keyword and END at the end;
 
 # TEST EXTRACTION OF TAGGED STRINGS
 # USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]});
 # THESE SHOULD FAIL
-       BEGIN at the BEGIN keyword and END at the end;
+    BEGIN at the BEGIN keyword and END at the end;
 
 # USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"});
-       ; at the ;-) keyword
+    ; at the ;-) keyword
 
 
 # USING: extract_tagged($str);
-       <A>some text</A>;
-       <B>some text<A>other text</A></B>;
-       <A>some text<A>other text</A></A>;
-       <A HREF="#section2">some text</A>;
+    <A>some text</A>;
+    <B>some text<A>other text</A></B>;
+    <A>some text<A>other text</A></A>;
+    <A HREF="#section2">some text</A>;
 
 # THESE SHOULD FAIL
-       <A>some text
-       <A>some text<A>other text</A>;
-       <B>some text<A>other text</B>;
+    <A>some text
+    <A>some text<A>other text</A>;
+    <B>some text<A>other text</B>;
index a33ac91..f527b84 100644 (file)
@@ -1,53 +1,61 @@
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..183\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_variable );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
+    chomp $str;
+    if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    $str =~ s/\\n/\n/g;
+    debug "\tUsing: $cmd\n";
+    debug "\t   on: [$str]\n";
 
-       my @res;
-       $var = eval "\@res = $cmd";
-       debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    my @res;
+    my $var = eval "\@res = $cmd";
+    debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
+    debug "\t list left: [$str]\n";
+    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 
-       pos $str = 0;
-       $var = eval $cmd;
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    pos $str = 0;
+    $var = eval $cmd;
+    $var = "<undef>" unless defined $var;
+    debug "\t scalar got: [$var]\n";
+    debug "\t scalar left: [$str]\n";
+    print "not " if ($str =~ '\A;')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 }
 
 __DATA__
index 0dd55a5..1a82ae1 100644 (file)
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
+use 5.008001;
+
+use strict;
+use warnings;
+
 ######################### We start with some black magic to print on failure.
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
+my $loaded = 0;
 BEGIN { $| = 1; print "1..37\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( gen_extract_tagged );
 $loaded = 1;
 print "ok 1\n";
-$count=2;
+my $count=2;
 use vars qw( $DEBUG );
 sub debug { print "\t>>>",@_ if $DEBUG }
 
 ######################### End of black magic.
 
+## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-$cmd = "print";
-$neg = 0;
+my $cmd = "print";
+my $neg = 0;
+my $str;
 while (defined($str = <DATA>))
 {
-       chomp $str;
-       $str =~ s/\\n/\n/g;
-       if ($str =~ s/\A# USING://)
-       {
-               $neg = 0;
-               eval{local$^W;*f = eval $str || die};
-               next;
-       }
-       elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
-       elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
-       $str =~ s/\\n/\n/g;
-       debug "\tUsing: $cmd\n";
-       debug "\t   on: [$str]\n";
-
-       my @res;
-       $var = eval { @res = f($str) };
-       debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
-       debug "\t list left: [$str]\n";
-       print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
-
-       pos $str = 0;
-       $var = eval { scalar f($str) };
-       $var = "<undef>" unless defined $var;
-       debug "\t scalar got: [$var]\n";
-       debug "\t scalar left: [$str]\n";
-       print "not " if ($str =~ '\A;')==$neg;
-       print "ok ", $count++;
-       print " ($@)" if $@ && $DEBUG;
-       print "\n";
+    chomp $str;
+    $str =~ s/\\n/\n/g;
+    if ($str =~ s/\A# USING://)
+    {
+        $neg = 0;
+        eval {
+                # Capture "Subroutine main::f redefined" warning
+                my @warnings;
+                local $SIG{__WARN__} = sub { push @warnings, shift; };
+                *f = eval $str || die;
+        };
+        next;
+    }
+    elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+    elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+    $str =~ s/\\n/\n/g;
+    debug "\tUsing: $cmd\n";
+    debug "\t   on: [$str]\n";
+
+    my @res;
+    my $var = eval { @res = f($str) };
+    debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
+    debug "\t list left: [$str]\n";
+    print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
+
+    pos $str = 0;
+    $var = eval { scalar f($str) };
+    $var = "<undef>" unless defined $var;
+    debug "\t scalar got: [$var]\n";
+    debug "\t scalar left: [$str]\n";
+    print "not " if ($str =~ '\A;')==$neg;
+    print "ok ", $count++;
+    print " ($@)" if $@ && $DEBUG;
+    print "\n";
 }
 
 __DATA__
 
 # USING: gen_extract_tagged('{','}');
-       { a test };
+    { a test };
 
 # USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+    <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
 
 # USING: gen_extract_tagged("BEGIN","END");
-       BEGIN at the BEGIN keyword and END at the END;
-       BEGIN at the beginning and end at the END;
+    BEGIN at the BEGIN keyword and END at the END;
+    BEGIN at the beginning and end at the END;
 
 # USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]});
-       <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+    <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
 
 # USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"});
-       ; at the ;-) keyword
+    ; at the ;-) keyword
 
 # USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
-       <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+    <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
 
 # THESE SHOULD FAIL
-       BEGIN at the beginning and end at the end;
-       BEGIN at the BEGIN keyword and END at the end;
+    BEGIN at the beginning and end at the end;
+    BEGIN at the BEGIN keyword and END at the end;
 
 # TEST EXTRACTION OF TAGGED STRINGS
 # USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]});
 # THESE SHOULD FAIL
-       BEGIN at the BEGIN keyword and END at the end;
+    BEGIN at the BEGIN keyword and END at the end;
 
 # USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"});
-       ; at the ;-) keyword
+    ; at the ;-) keyword
 
 
 # USING: gen_extract_tagged();
-       <A>some text</A>;
-       <B>some text<A>other text</A></B>;
-       <A>some text<A>other text</A></A>;
-       <A HREF="#section2">some text</A>;
+    <A>some text</A>;
+    <B>some text<A>other text</A></B>;
+    <A>some text<A>other text</A></A>;
+    <A HREF="#section2">some text</A>;
 
 # THESE SHOULD FAIL
-       <A>some text
-       <A>some text<A>other text</A>;
-       <B>some text<A>other text</B>;
+    <A>some text
+    <A>some text<A>other text</A>;
+    <B>some text<A>other text</B>;
diff --git a/cpan/Text-Balanced/t/94_changes.t b/cpan/Text-Balanced/t/94_changes.t
new file mode 100644 (file)
index 0000000..400ec89
--- /dev/null
@@ -0,0 +1,48 @@
+#!perl
+#===============================================================================
+#
+# t/94_changes.t
+#
+# DESCRIPTION
+#   Test script to check CPAN::Changes conformance.
+#
+# COPYRIGHT
+#   Copyright (C) 2015 Steve Hay.  All rights reserved.
+#
+# LICENCE
+#   This script is free software; you can redistribute it and/or modify it under
+#   the same terms as Perl itself, i.e. under the terms of either the GNU
+#   General Public License or the Artistic License, as specified in the LICENCE
+#   file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+    plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING};
+
+    my $ok = eval {
+        require Test::CPAN::Changes;
+        Test::CPAN::Changes->import();
+        1;
+    };
+
+    if (not $ok) {
+        plan skip_all => 'Test::CPAN::Changes required to test Changes';
+    }
+    else {
+        changes_ok();
+    }
+}
+
+#===============================================================================
diff --git a/cpan/Text-Balanced/t/95_critic.t b/cpan/Text-Balanced/t/95_critic.t
new file mode 100644 (file)
index 0000000..1e57542
--- /dev/null
@@ -0,0 +1,48 @@
+#!perl
+#===============================================================================
+#
+# t/95_critic.t
+#
+# DESCRIPTION
+#   Test script to check Perl::Critic conformance.
+#
+# COPYRIGHT
+#   Copyright (C) 2015 Steve Hay.  All rights reserved.
+#
+# LICENCE
+#   This script is free software; you can redistribute it and/or modify it under
+#   the same terms as Perl itself, i.e. under the terms of either the GNU
+#   General Public License or the Artistic License, as specified in the LICENCE
+#   file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+    plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING};
+
+    my $ok = eval {
+        require Test::Perl::Critic;
+        Test::Perl::Critic->import(-profile => '');
+        1;
+    };
+
+    if (not $ok) {
+        plan skip_all => 'Test::Perl::Critic required to test with Perl::Critic';
+    }
+    else {
+        all_critic_ok('.');
+    }
+}
+
+#===============================================================================
diff --git a/cpan/Text-Balanced/t/96_pmv.t b/cpan/Text-Balanced/t/96_pmv.t
new file mode 100644 (file)
index 0000000..e1197da
--- /dev/null
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+# Test that our declared minimum Perl version matches our syntax
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+my @MODULES = (
+    'Perl::MinimumVersion 1.20',
+    'Test::MinimumVersion 0.101082',
+);
+
+# Don't run tests for installs
+use Test::More;
+unless ( $ENV{AUTHOR_TESTING} ) {
+    plan( skip_all => "Author testing only" );
+}
+
+# Load the testing modules
+foreach my $MODULE ( @MODULES ) {
+    ## no critic (BuiltinFunctions::ProhibitStringyEval)
+    eval "use $MODULE";
+    if ( $@ ) {
+        plan( skip_all => "$MODULE not available for testing" );
+    }
+}
+
+all_minimum_version_from_mymetayml_ok();
diff --git a/cpan/Text-Balanced/t/97_pod.t b/cpan/Text-Balanced/t/97_pod.t
new file mode 100644 (file)
index 0000000..d0f4cae
--- /dev/null
@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+
+# Test that the syntax of our POD documentation is valid
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+my @MODULES = (
+    'Pod::Simple 3.07',
+    'Test::Pod 1.26',
+);
+
+# Don't run tests for installs
+use Test::More;
+unless ( $ENV{AUTHOR_TESTING} ) {
+    plan( skip_all => "Author testing only" );
+}
+
+# Load the testing modules
+foreach my $MODULE ( @MODULES ) {
+    ## no critic (BuiltinFunctions::ProhibitStringyEval)
+    eval "use $MODULE";
+    if ( $@ ) {
+        plan( skip_all => "$MODULE not available for testing" );
+    }
+}
+
+all_pod_files_ok();
diff --git a/cpan/Text-Balanced/t/98_pod_coverage.t b/cpan/Text-Balanced/t/98_pod_coverage.t
new file mode 100644 (file)
index 0000000..cce4f94
--- /dev/null
@@ -0,0 +1,51 @@
+#!perl
+#===============================================================================
+#
+# t/99_pod_coverage.t
+#
+# DESCRIPTION
+#   Test script to check POD coverage.
+#
+# COPYRIGHT
+#   Copyright (C) 2015 Steve Hay.  All rights reserved.
+#
+# LICENCE
+#   This script is free software; you can redistribute it and/or modify it under
+#   the same terms as Perl itself, i.e. under the terms of either the GNU
+#   General Public License or the Artistic License, as specified in the LICENCE
+#   file.
+#
+#===============================================================================
+
+use 5.008001;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+#===============================================================================
+# MAIN PROGRAM
+#===============================================================================
+
+MAIN: {
+    plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING};
+
+    my $ok = eval {
+        require Test::Pod::Coverage;
+        Test::Pod::Coverage->import();
+        1;
+    };
+
+    if (not $ok) {
+        plan skip_all => 'Test::Pod::Coverage required to test POD coverage';
+    }
+    elsif ($Test::Pod::Coverage::VERSION < 0.08) {
+        plan skip_all => 'Test::Pod::Coverage 0.08 or higher required to test POD coverage';
+    }
+    else {
+        all_pod_coverage_ok();
+    }
+}
+
+#===============================================================================