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(
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 {
{
my ($wantarray, $textref, $message, $pos) = @_;
_failmsg $message, $pos if $message;
- return ("",$$textref,"") if $wantarray;
+ return (undef,$$textref,undef) if $wantarray;
return undef;
}
$@ = undef;
my ($wantarray,$textref) = splice @_, 0, 2;
my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0);
- my ($startlen) = $_[5];
+ my ($startlen, $oppos) = @_[5,6];
my $remainderpos = $_[2];
if ($wantarray)
{
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")} ;
);
}
-sub revbracket($)
+sub _revbracket($)
{
my $brack = reverse $_[0];
$brack =~ tr/[({</])}>/;
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;
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";
};
# 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)
{
}
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{..."},
return;
}
$rd1pos = pos($$textref);
- $$textref =~ m{$label\n}gc;
+ $$textref =~ m{\Q$label\E\n}gc;
$ld2pos = pos($$textref);
return (
$startpos, $oppos-$startpos, # PREFIX
if ($ldel1 =~ /[[(<{]/)
{
$rdel1 =~ tr/[({</])}>/;
- _match_bracketed($textref,"",$ldel1,"","",$rdel1)
+ 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)
if ($ldel2 =~ /[[(<{]/)
{
pos($$textref)--; # OVERCOME BROKEN LOOKAHEAD
- _match_bracketed($textref,"",$ldel2,"","",$rdel2)
+ defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2))
|| do { pos $$textref = $startpos; return };
}
else
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
}
$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))
{
if (!$igunk) {
- $unkpos = pos $$textref
+ $unkpos = $lastpos
if length($pref) && !defined($unkpos);
if (defined $unkpos)
{
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).
=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]
=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
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
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:
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:
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
projects / p5sagit/p5-mst-13.2.git / blobdiff