Re: [PATCH] Make the 'sort' pragma lexically scoped

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

diff --git a/lib/Text/Balanced.pm b/lib/Text/Balanced.pm
index 820ae25..297e8df 100644 (file)
--- a/lib/Text/Balanced.pm
+++ b/lib/Text/Balanced.pm
@@ -7,10 +7,9 @@ use strict;
 package Text::Balanced;
 
 use Exporter;
-use SelfLoader;
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 
-$VERSION = '1.95';
+$VERSION = '1.95_01';
 @ISA           = qw ( Exporter );
                     
 %EXPORT_TAGS   = ( ALL => [ qw(
@@ -37,6 +36,14 @@ 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 {
@@ -58,6 +65,7 @@ sub _succeed
        my ($wantarray,$textref) = splice @_, 0, 2;
        my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0);
        my ($startlen) = $_[5];
+       my $oppos = $_[6];
        my $remainderpos = $_[2];
        if ($wantarray)
        {
@@ -67,7 +75,7 @@ sub _succeed
                        push @res, substr($$textref,$from,$len);
                }
                if ($extralen) {        # CORRECT FILLET
-                       my $extra = substr($res[0], $extrapos-$startlen, $extralen, "\n");
+                       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")} ;
@@ -343,8 +351,7 @@ sub _match_tagged   # ($$$$$$$)
                        for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',)
                                { next if $rdel =~ /\Q$_/; $del = $_; last }
                        unless ($del) {
-                               use Carp;
-                               croak "Can't interpolate right delimiter $rdel"
+                               croak ("Can't interpolate right delimiter $rdel")
                        }
                        eval "qq$del$rdel$del";
                };
@@ -583,12 +590,15 @@ 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/%^&|.]=?
                                        | [!=]~
                                        | =(?!>)
                                        | (\*\*|&&|\|\||<<|>>)=?
-                                       | split|grep|map|return
+                                       | case|split|grep|map|return
                                        | [([]
                                        )#gcx)
                {
@@ -748,8 +758,8 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                }
                my $extrapos = pos($$textref);
                $$textref =~ m{.*\n}gc;
-               $str1pos = pos($$textref);
-               unless ($$textref =~ m{.*?\n(?=$label\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{..."},
@@ -758,7 +768,7 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                        return;
                }
                $rd1pos = pos($$textref);
-               $$textref =~ m{$label\n}gc;
+               $$textref =~ m{\Q$label\E\n}gc;
                $ld2pos = pos($$textref);
                return (
                        $startpos,      $oppos-$startpos,       # PREFIX
@@ -791,7 +801,7 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
        if ($ldel1 =~ /[[(<{]/)
        {
                $rdel1 =~ tr/[({</])}>/;
-               _match_bracketed($textref,"",$ldel1,"","",$rdel1)
+               defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
                || do { pos $$textref = $startpos; return };
        }
        else
@@ -826,7 +836,7 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                if ($ldel2 =~ /[[(<{]/)
                {
                        pos($$textref)--;       # OVERCOME BROKEN LOOKAHEAD 
-                       _match_bracketed($textref,"",$ldel2,"","",$rdel2)
+                       defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2))
                        || do { pos $$textref = $startpos; return };
                }
                else
@@ -884,8 +894,7 @@ sub extract_multiple (;$$$$)        # ($text, $functions_ref, $max_fields, $ignoreunkno
 
                unless (wantarray)
                {
-                       use Carp;
-                       carp "extract_multiple reset maximal count to 1 in scalar context"
+                       carp ("extract_multiple reset maximal count to 1 in scalar context")
                                if $^W && defined($_[2]) && $max > 1;
                        $max = 1
                }
@@ -930,7 +939,7 @@ sub extract_multiple (;$$$$)        # ($text, $functions_ref, $max_fields, $ignoreunkno
                                if (defined($field) && length($field))
                                {
                                        if (!$igunk) {
-                                               $unkpos = pos $$textref
+                                               $unkpos = $lastpos
                                                        if length($pref) && !defined($unkpos);
                                                if (defined $unkpos)
                                                {
@@ -1126,9 +1135,9 @@ The substring to be extracted must appear at the
 current C<pos> location of the string's variable
 (or at index zero, if no C<pos> position is defined).
 In other words, the C<extract_...> subroutines I<don't>
-extract the first occurance of a substring anywhere
+extract the first occurrence of a substring anywhere
 in a string (like an unanchored regex would). Rather,
-they extract an occurance of the substring appearing
+they extract an occurrence of the substring appearing
 immediately at the current matching position in the
 string (like a C<\G>-anchored regex would).
 
@@ -1394,7 +1403,7 @@ See also: C<"extract_quotelike"> and C<"extract_codeblock">.
 
 C<extract_variable> extracts any valid Perl variable or
 variable-involved expression, including scalars, arrays, hashes, array
-accesses, hash look-ups, method calls through objects, subroutine calles
+accesses, hash look-ups, method calls through objects, subroutine calls
 through subroutine references, etc.
 
 The subroutine takes up to two optional arguments:
@@ -2053,7 +2062,7 @@ If none of the extractor subroutines succeeds, then one
 character is extracted from the start of the text and the extraction
 subroutines reapplied. Characters which are thus removed are accumulated and
 eventually become the next field (unless the fourth argument is true, in which
-case they are disgarded).
+case they are discarded).
 
 For example, the following extracts substrings that are valid Perl variables: