vitalif
/
VMXTemplate
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

VMX::Common::litsplit()

databind
vitalif 2009-04-15 19:52:48 +00:00 committed by Vitaliy Filippov
parent 8f9131d60a
commit 1729668afe
1 changed files with 22 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
VMX/Common.pm
View File

@ -26,7 +26,7 @@ our @EXPORT_OK = qw(
HASHARRAY quotequote min max trim htmlspecialchars strip_tags strip_unsafe_tags
file_get_contents dbi_hacks ar1el filemd5 mysql_quote updaterow_hashref
insertall_hashref deleteall_hashref dumper_no_lf str2time callif urandom
normalize_url utf8on rfrom_to mysql2time mysqllocaltime resub hashmrg
normalize_url utf8on rfrom_to mysql2time mysqllocaltime resub hashmrg litsplit
);
our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
@ -631,5 +631,26 @@ sub hashmrg
return $h;
}
# разбиение строки по регэкспу, однако не как split(//), а с учётом литералов,
# входящих в строку. границы литералов можно задавать доп.аргументом
my $deflit = qr/\'(?:[^\'\\]+|\\.)+\'|\"(?:[^\"\\]+|\\.)+\"|\`(?:[^\`\\]+|\\.)+\`/;
# @a = litsplit /PATTERN/, EXPR[, LIMIT[, /LITERAL_PATTERN/]]
sub litsplit
{
my ($re, $s, $lim, $lit) = @_;
$lit ||= $deflit;
my @r;
my $l = 0;
my $ml;
$s =~ /^/g;
while ($s =~ /\G((?:$lit|.+)*?)$re/gc && (!$lim || $lim <= 0 || @r+1 < $lim))
{
push @r, $1;
}
push @r, substr($s, pos($s));
return @r;
}
1;
__END__