Deprecate assignment to $[

[p5sagit/p5-mst-13.2.git] / lib / Text / Balanced.pm

diff --git a/lib/Text/Balanced.pm b/lib/Text/Balanced.pm
index 297e8df..16a559b 100644 (file)
--- a/lib/Text/Balanced.pm
+++ b/lib/Text/Balanced.pm
@@ -7,9 +7,10 @@ use strict;
 package Text::Balanced;
 
 use Exporter;
+use SelfLoader;
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 
-$VERSION = '1.95_01';
+use version; $VERSION = qv('2.0.0');
 @ISA           = qw ( Exporter );
                     
 %EXPORT_TAGS   = ( ALL => [ qw(
@@ -36,14 +37,6 @@ sub _match_variable($$);
 sub _match_codeblock($$$$$$$);
 sub _match_quotelike($$$$);
 
-sub carp {
-  require Carp; goto &Carp::carp;
-}
-
-sub croak {
-  require Carp; goto &Carp::croak;
-}
-
 # HANDLE RETURN VALUES IN VARIOUS CONTEXTS
 
 sub _failmsg {
@@ -55,7 +48,7 @@ sub _fail
 {
        my ($wantarray, $textref, $message, $pos) = @_;
        _failmsg $message, $pos if $message;
-       return ("",$$textref,"") if $wantarray;
+       return (undef,$$textref,undef) if $wantarray;
        return undef;
 }
 
@@ -64,8 +57,7 @@ sub _succeed
        $@ = undef;
        my ($wantarray,$textref) = splice @_, 0, 2;
        my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0);
-       my ($startlen) = $_[5];
-       my $oppos = $_[6];
+       my ($startlen, $oppos) = @_[5,6];
        my $remainderpos = $_[2];
        if ($wantarray)
        {
@@ -274,7 +266,7 @@ sub _match_bracketed($$$$$$)        # $textref, $pre, $ldel, $qdel, $quotelike, $rdel
               );
 }
 
-sub revbracket($)
+sub _revbracket($)
 {
        my $brack = reverse $_[0];
        $brack =~ tr/[({</])}>/;
@@ -336,8 +328,8 @@ sub _match_tagged   # ($$$$$$$)
 
        if (!defined $rdel)
        {
-               $rdelspec = $&;
-               unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". revbracket($1) /oes)
+               $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;
@@ -351,7 +343,8 @@ sub _match_tagged   # ($$$$$$$)
                        for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',)
                                { next if $rdel =~ /\Q$_/; $del = $_; last }
                        unless ($del) {
-                               croak ("Can't interpolate right delimiter $rdel")
+                               use Carp;
+                               croak "Can't interpolate right delimiter $rdel"
                        }
                        eval "qq$del$rdel$del";
                };
@@ -590,15 +583,12 @@ sub _match_codeblock($$$$$$$)
 
 
                # NEED TO COVER MANY MORE CASES HERE!!!
-               # NB 'case' is included here, because in Switch.pm,
-               # it's followed by a term, not an op
-
                if ($$textref =~ m#\G\s*(?!$ldel_inner)
                                        ( [-+*x/%^&|.]=?
                                        | [!=]~
                                        | =(?!>)
                                        | (\*\*|&&|\|\||<<|>>)=?
-                                       | case|split|grep|map|return
+                                       | split|grep|map|return
                                        | [([]
                                        )#gcx)
                {
@@ -768,7 +758,7 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                        return;
                }
                $rd1pos = pos($$textref);
-               $$textref =~ m{\Q$label\E\n}gc;
+        $$textref =~ m{\Q$label\E\n}gc;
                $ld2pos = pos($$textref);
                return (
                        $startpos,      $oppos-$startpos,       # PREFIX
@@ -803,13 +793,15 @@ sub _match_quotelike($$$$)        # ($textref, $prepat, $allow_raw_match)
                $rdel1 =~ tr/[({</])}>/;
                defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
                || do { pos $$textref = $startpos; return };
+        $ld2pos = pos($$textref);
+        $rd1pos = $ld2pos-1;
        }
        else
        {
-               $$textref =~ /$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
+               $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
                || do { pos $$textref = $startpos; return };
+        $ld2pos = $rd1pos = pos($$textref)-1;
        }
-       $ld2pos = $rd1pos = pos($$textref)-1;
 
        my $second_arg = $op =~ /s|tr|y/ ? 1 : 0;
        if ($second_arg)
@@ -894,7 +886,8 @@ sub extract_multiple (;$$$$)        # ($text, $functions_ref, $max_fields, $ignoreunkno
 
                unless (wantarray)
                {
-                       carp ("extract_multiple reset maximal count to 1 in scalar context")
+                       use Carp;
+                       carp "extract_multiple reset maximal count to 1 in scalar context"
                                if $^W && defined($_[2]) && $max > 1;
                        $max = 1
                }
@@ -928,13 +921,14 @@ sub extract_multiple (;$$$$)      # ($text, $functions_ref, $max_fields, $ignoreunkno
                                $class = $class[$i];
                                $lastpos = pos $$textref;
                                if (ref($func) eq 'CODE')
-                                       { ($field,$rem,$pref) = @bits = $func->($$textref);
-                                       # print "[$field|$rem]" if $field;
-                                       }
+                                       { ($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 : $& }
+                                       { @bits = $field = defined($1)
+                                ? $1
+                                : substr($$textref, $-[0], $+[0] - $-[0])
+                    }
                                $pref ||= "";
                                if (defined($field) && length($field))
                                {
@@ -1153,7 +1147,7 @@ elements of which are always:
 =item [0]
 
 The extracted string, including the specified delimiters.
-If the extraction fails an empty string is returned.
+If the extraction fails C<undef> is returned.
 
 =item [1]
 
@@ -1163,7 +1157,7 @@ extracted string). On failure, the entire string is returned.
 =item [2]
 
 The skipped prefix (i.e. the characters before the extracted string).
-On failure, the empty string is returned.
+On failure, C<undef> is returned.
 
 =back 
 
@@ -1243,7 +1237,7 @@ pattern C<'\s*'> - optional whitespace - is used. If the delimiter set
 is also not specified, the set C</["'`]/> is used. If the text to be processed
 is not specified either, C<$_> is used.
 
-In list context, C<extract_delimited> returns a array of three
+In list context, C<extract_delimited> returns an array of three
 elements, the extracted substring (I<including the surrounding
 delimiters>), the remainder of the text, and the skipped prefix (if
 any). If a suitable delimited substring is not found, the first
@@ -2149,9 +2143,10 @@ 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.
 
-Note that 
-C<gen_delimited_pat> was previously called
-C<delimited_pat>. That name may still be used, but is now deprecated.
+=head2 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.
         
 
 =head1 DIAGNOSTICS