use 5.00503;
BEGIN {
if ($^X =~ m/ jperl /oxmsi) {
die __FILE__, ": needs perl(not jperl) 5.00503 or later. (\$^X==$^X)";
}
if (ord('A') == 193) {
die __FILE__, ": is not US-ASCII script (may be EBCDIC or EBCDIK script).";
}
if (ord('A') != 0x41) {
die __FILE__, ": is not US-ASCII script (must be US-ASCII script).";
}
}
BEGIN { eval q{ use vars qw($VERSION) } }
$VERSION = sprintf '%d.%02d', q$Revision: 0.81 $ =~ m/(\d+)/oxmsg;
BEGIN {
my $genpkg = "Symbol::";
my $genseq = 0;
sub gensym () {
my $name = "GEN" . $genseq++;
my $ref = \*{$genpkg . $name};
delete $$genpkg{$name};
$ref;
}
}
BEGIN {
if (eval {CORE::require strict}) { strict::->import;
}
}
sub LOCK_SH() {1}
sub LOCK_EX() {2}
sub LOCK_UN() {8}
sub LOCK_NB() {4}
$| = 1;
sub import() {}
sub unimport() {}
sub UTF2::escape_script;
my $your_char = q{(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF]|[\x00-\xFF]};
my $qq_char = qr/\\c[\x40-\x5F]|\\?(?:$your_char)/oxms;
my $q_char = qr/$your_char/oxms;
my $anchor = '';
BEGIN { eval q{ use vars qw($nest) } }
my $qq_paren = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] |
\\? (?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
\\ [\x00-\xFF] |
[^()] |
\( (?{$nest++}) |
\) (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_brace = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] |
\\? (?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
\\ [\x00-\xFF] |
[^{}] |
\{ (?{$nest++}) |
\} (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_bracket = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] |
\\? (?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
\\ [\x00-\xFF] |
[^[\]] |
\[ (?{$nest++}) |
\] (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_angle = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] |
\\? (?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
\\ [\x00-\xFF] |
[^<>] |
\< (?{$nest++}) |
\> (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_scalar = qr{(?: \{ (?:$qq_brace)*? \} |
(?: ::)? (?:
[a-zA-Z_][a-zA-Z_0-9]*
(?: ::[a-zA-Z_][a-zA-Z_0-9]* )* (?: \[ (?: \$\[ | \$\] | $qq_char )*? \] | \{ (?:$qq_brace)*? \} )*
(?: (?: -> )? (?: \[ (?: \$\[ | \$\] | $qq_char )*? \] | \{ (?:$qq_brace)*? \} ) )*
))
}xms;
my $qq_variable = qr{(?: \{ (?:$qq_brace)*? \} |
(?: ::)? (?:
[0-9]+ |
[^\x80-\xFFa-zA-Z_0-9\[\]] |
^[A-Z] |
[a-zA-Z_][a-zA-Z_0-9]*
(?: ::[a-zA-Z_][a-zA-Z_0-9]* )* (?: \[ (?: \$\[ | \$\] | $qq_char )*? \] | \{ (?:$qq_brace)*? \} )*
(?: (?: -> )? (?: \[ (?: \$\[ | \$\] | $qq_char )*? \] | \{ (?:$qq_brace)*? \} ) )*
))
}xms;
my $q_paren = qr{(?{local $nest=0}) (?>(?:
(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
[^()] |
\( (?{$nest++}) |
\) (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $q_brace = qr{(?{local $nest=0}) (?>(?:
(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
[^{}] |
\{ (?{$nest++}) |
\} (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $q_bracket = qr{(?{local $nest=0}) (?>(?:
(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
[^[\]] |
\[ (?{$nest++}) |
\] (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $q_angle = qr{(?{local $nest=0}) (?>(?:
(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF] |
[^<>] |
\< (?{$nest++}) |
\> (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $use_re_eval = '';
my $matched = '';
my $s_matched = '';
my $tr_variable = '';
my $sub_variable = '';
my $bind_operator = '';
BEGIN { eval q{ use vars qw($slash) } }
my @heredoc = ();
my @heredoc_delimiter = ();
my $here_script = '';
my $function_ord;
my $function_ord_;
my $function_reverse;
my $ignore_modules = join('|', qw(
utf8
bytes
charnames
I18N::Japanese
I18N::Collate
I18N::JExt
File::DosGlob
Wild
Wildcard
Japanese
));
if ($0 eq __FILE__) {
unless (@ARGV) {
die <<END;
$0: usage
perl $0 UTF-2_script.pl > Escaped_script.pl.e
END
}
print UTF2::escape_script($ARGV[0]);
exit 0;
}
my($package,$filename,$line,$subroutine,$hasargs,$wantarray,$evaltext,$is_require,$hints,$bitmask) = caller 0;
if ($package ne 'main') {
die <<END;
@{[__FILE__]}: escape by manually command '$^X @{[__FILE__]} "$filename" > "@{[__PACKAGE__]}::$filename"'
and rewrite "use $package;" to "use @{[__PACKAGE__]}::$package;" of script "$0".
END
}
if (-e("$filename.e")) {
if (exists $ENV{'SJIS_DEBUG'}) {
unlink "$filename.e";
}
elsif (-z("$filename.e")) {
unlink "$filename.e";
}
else {
my $e_mtime = (stat("$filename.e"))[9];
my $mtime = (stat($filename))[9];
my $__mtime__ = (stat(__FILE__))[9];
if (($e_mtime < $mtime) or ($mtime < $__mtime__)) {
unlink "$filename.e";
}
}
}
if (not -e("$filename.e")) {
my $fh = gensym();
if (eval q{ use Fcntl qw(O_WRONLY O_APPEND O_CREAT); 1 } and CORE::sysopen($fh,"$filename.e",&O_WRONLY|&O_APPEND|&O_CREAT)) {
}
else {
open($fh, ">>$filename.e") or die __FILE__, ": Can't write open file: $filename.e";
}
if (0) {
}
elsif (exists $ENV{'SJIS_NONBLOCK'}) {
eval q{
unless (flock($fh, LOCK_EX | LOCK_NB)) {
warn __FILE__, ": Can't immediately write-lock the file: $filename.e";
exit;
}
};
}
else {
eval q{ flock($fh, LOCK_EX) };
}
truncate($fh, 0) or die __FILE__, ": Can't truncate file: $filename.e";
seek($fh, 0, 0) or die __FILE__, ": Can't seek file: $filename.e";
my $e_script = UTF2::escape_script($filename);
print {$fh} $e_script;
my $mode = (stat($filename))[2] & 0777;
chmod $mode, "$filename.e";
close($fh) or die __FILE__, ": Can't close file: $filename.e";
}
local @ENV{qw(IFS CDPATH ENV BASH_ENV)};
my $fh = gensym();
open($fh, "$filename.e") or die __FILE__, ": Can't read open file: $filename.e";
if (0) {
}
elsif (exists $ENV{'SJIS_NONBLOCK'}) {
eval q{
unless (flock($fh, LOCK_SH | LOCK_NB)) {
warn __FILE__, ": Can't immediately read-lock the file: $filename.e";
exit;
}
};
}
else {
eval q{ flock($fh, LOCK_SH) };
}
my @switch = ();
if ($^W) {
push @switch, '-w';
}
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
exit system
_escapeshellcmd_MSWin32($^X),
(map { '-I' . $_ } @INC),
@switch,
'--',
map { _escapeshellcmd_MSWin32($_) } "$filename.e", @ARGV;
}
else {
exit system
_escapeshellcmd($^X),
(map { '-I' . _escapeshellcmd($_) } @INC),
@switch,
'--',
map { _escapeshellcmd($_) } "$filename.e", @ARGV;
}
sub _escapeshellcmd_MSWin32 {
my($word) = @_;
if ($word =~ m/ $anchor [ ] /oxms) {
return qq{"$word"};
}
else {
return $word;
}
}
sub _escapeshellcmd {
my($word) = @_;
$word =~ s/([\t\n\r\x20!"
return $word;
}
sub UTF2::escape_script {
my($script) = @_;
my $e_script = '';
my $fh = gensym();
open($fh, $script) or die __FILE__, ": Can't open file: $script";
local $/ = undef;
$_ = <$fh>;
close($fh) or die __FILE__, ": Can't close file: $script";
if (m/^ use Eutf2(?:\s+[0-9\.]*)?\s*; $/oxms) { return $_;
}
else {
if (s/\A(
my $head = $1;
$head =~ s/\bjperl\b/perl/gi;
$e_script .= $head;
}
if (s/\A(\@rem\s*=\s*'.*?'\s*;\s*\n)//oms) {
my $head = $1;
$head =~ s/\bjperl\b/perl/gi;
$e_script .= $head;
}
if (s/(.*^
my $head = $1;
$head =~ s/\bjperl\b/perl/gi;
$e_script .= $head;
}
$e_script .= sprintf("use Eutf2 %s;\n%s", $Eutf2::VERSION, $use_re_eval);
$function_ord = 'ord';
$function_ord_ = 'ord';
$function_reverse = 'reverse';
if (s/^ \s* use \s+ UTF2 \s* ([^\x80-\xFF;]*) ; \s* \n? $//oxms) {
my $list = $1;
if ($list =~ s/\A ([0-9]+(?:\.[0-9]*)) \s* //oxms) {
my $version = $1;
if ($version > $VERSION) {
die __FILE__, ": version $version required--this is only version $VERSION";
}
}
if ($list !~ m/\A \s* \z/oxms) {
local $@;
my @list = eval $list;
for (@list) {
$function_ord = 'UTF2::ord' if m/\A ord \z/oxms;
$function_ord_ = 'UTF2::ord_' if m/\A ord \z/oxms;
$function_reverse = 'UTF2::reverse' if m/\A reverse \z/oxms;
}
}
}
}
$slash = 'm//';
study $_;
while (not /\G \z/oxgc) {
$e_script .= escape();
}
return $e_script;
}
sub escape {
if (/\G ( \n ) /oxgc) {
my $heredoc = '';
if (scalar(@heredoc_delimiter) >= 1) {
$slash = 'm//';
$heredoc = join '', @heredoc;
@heredoc = ();
for my $heredoc_delimiter (@heredoc_delimiter) {
/\G .*? \n $heredoc_delimiter \n/xmsgc;
}
@heredoc_delimiter = ();
$here_script = '';
}
return "\n" . $heredoc;
}
elsif (/\G (\s+|\
elsif (/\G ( (?: if | elsif | unless | while | until | given | when ) \s* \( ) /oxgc) {
$slash = 'm//';
return $1;
}
elsif (/\G ( \( \s* (?: local \b | my \b | our \b | state \b )? \s* \$ $qq_scalar ) /oxgc) {
my $e_string = e_string($1);
if (/\G ( \s* = $qq_paren \) ) ( \s* (?: =~ | !~ ) \s* ) (?= (?: tr|y) \b ) /oxgc) {
$tr_variable = $e_string . e_string($1);
$bind_operator = $2;
$slash = 'm//';
return '';
}
elsif (/\G ( \s* = $qq_paren \) ) ( \s* (?: =~ | !~ ) \s* ) (?= s \b ) /oxgc) {
$sub_variable = $e_string . e_string($1);
$bind_operator = $2;
$slash = 'm//';
return '';
}
else {
$slash = 'div';
return $e_string;
}
}
elsif (/\G ( \$` | \$\{`\} | \$ \s* PREMATCH \b | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) /oxmsgc) {
$slash = 'div';
return q{Eutf2::PREMATCH()};
}
elsif (/\G ( \$& | \$\{&\} | \$ \s* MATCH \b | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) /oxmsgc) {
$slash = 'div';
return q{Eutf2::MATCH()};
}
elsif (/\G ( \$ \s* POSTMATCH \b | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) /oxmsgc) {
$slash = 'div';
return q{Eutf2::POSTMATCH()};
}
elsif (/\G ( \$ $qq_scalar ) /oxgc) {
my $scalar = e_string($1);
if (/\G ( \s* (?: =~ | !~ ) \s* ) (?= (?: tr|y) \b ) /oxgc) {
$tr_variable = $scalar;
$bind_operator = $1;
$slash = 'm//';
return '';
}
elsif (/\G ( \s* (?: =~ | !~ ) \s* ) (?= s \b ) /oxgc) {
$sub_variable = $scalar;
$bind_operator = $1;
$slash = 'm//';
return '';
}
else {
$slash = 'div';
return $scalar;
}
}
elsif (/\G ( [,;] ) /oxgc) {
$slash = 'm//';
$tr_variable = '';
$sub_variable = '';
$bind_operator = '';
return $1;
}
elsif (/\G ( \{ \s* (?: tr|index|rindex|reverse) \s* \} ) /oxmsgc) {
return $1;
}
elsif (/\G ( \$ 0 ) /oxmsgc) {
$slash = 'div';
return $1;
}
elsif (/\G ( \$ \{ \s* 0 \s* \} ) /oxmsgc) {
$slash = 'div';
return $1;
}
elsif (/\G ( \$ \$ ) (?![\w\{]) /oxmsgc) {
$slash = 'div';
return $1;
}
elsif (/\G \$ ([1-9][0-9]*) /oxmsgc) {
$slash = 'div';
return e_capture($1);
}
elsif (/\G \$ \{ \s* ([1-9][0-9]*) \s* \} /oxmsgc) {
$slash = 'div';
return e_capture($1);
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ .+? \] ) /oxmsgc) {
$slash = 'div';
return e_capture($1.'->'.$2);
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ .+? \} ) /oxmsgc) {
$slash = 'div';
return e_capture($1.'->'.$2);
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) /oxmsgc) {
$slash = 'div';
return e_capture($1);
}
elsif (/\G \$ \s* \{ ( \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \} /oxmsgc) {
$slash = 'div';
return '${' . $1 . '}';
}
elsif (/\G \$ \s* \{ \s* ( $qq_brace ) \s* \} /oxmsgc) {
$slash = 'div';
return e_capture($1);
}
elsif (/\G ( (?: [\$\@\%\&\*] | \$\
$slash = 'div';
return $1;
}
elsif (/\G ( \$[\$\@\
$slash = 'div';
return $1;
}
elsif (/\G \b (while \s* \( \s* <[\$]?[A-Za-z_][A-Za-z_0-9]*> \s* \)) \b /oxgc) {
return $1;
}
elsif (/\G \b while \s* \( \s* < ((?:(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF]|[^\x80-\xFF>\0\a\e\f\n\r\t])+?) > \s* \) \b /oxgc) {
return 'while ($_ = Eutf2::glob("' . $1 . '"))';
}
elsif (/\G \b while \s* \( \s* glob \s* \) /oxgc) {
return 'while ($_ = Eutf2::glob_)';
}
elsif (/\G \b while \s* \( \s* glob \b /oxgc) {
return 'while ($_ = Eutf2::glob';
}
elsif (m{\G \b ( if | unless | while | until | for | when ) \b }oxgc) { $slash = 'm//'; return $1; }
elsif (m{\G \b (CORE:: | ->[ ]* (?: atan2 | [a-z]{2,})) \b }oxgc) { $slash = 'm//'; return $1; }
elsif (m{\G \b bytes::substr \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'substr'; }
elsif (m{\G \b chop \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::chop'; }
elsif (m{\G \b bytes::index \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'index'; }
elsif (m{\G \b UTF2::index \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'UTF2::index'; }
elsif (m{\G \b index \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::index'; }
elsif (m{\G \b bytes::rindex \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'rindex'; }
elsif (m{\G \b UTF2::rindex \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'UTF2::rindex'; }
elsif (m{\G \b rindex \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::rindex'; }
elsif (m{\G \b lc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::lc'; }
elsif (m{\G \b lcfirst (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::lcfirst'; }
elsif (m{\G \b uc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::uc'; }
elsif (m{\G \b ucfirst (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::ucfirst'; }
elsif (m{\G \b fc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::fc'; }
elsif (m{\G -s \s+ \s* (\") ((?:$qq_char)+?) (\") }oxgc) { $slash = 'm//'; return '-s ' . e_qq('', $1,$3,$2); }
elsif (m{\G -s \s+ qq \s* (\
elsif (m{\G -s \s+ qq \s* (\() ((?:$qq_paren)+?) (\)) }oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); }
elsif (m{\G -s \s+ qq \s* (\{) ((?:$qq_brace)+?) (\}) }oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); }
elsif (m{\G -s \s+ qq \s* (\[) ((?:$qq_bracket)+?) (\]) }oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); }
elsif (m{\G -s \s+ qq \s* (\<) ((?:$qq_angle)+?) (\>) }oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); }
elsif (m{\G -s \s+ qq \s* (\S) ((?:$qq_char)+?) (\3) }oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); }
elsif (m{\G -s \s+ \s* (\') ((?:\\\1|\\\\|$q_char)+?) (\') }oxgc) { $slash = 'm//'; return '-s ' . e_q ('', $1,$3,$2); }
elsif (m{\G -s \s+ q \s* (\
elsif (m{\G -s \s+ q \s* (\() ((?:\\\)|\\\\|$q_paren)+?) (\)) }oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); }
elsif (m{\G -s \s+ q \s* (\{) ((?:\\\}|\\\\|$q_brace)+?) (\}) }oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); }
elsif (m{\G -s \s+ q \s* (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) }oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); }
elsif (m{\G -s \s+ q \s* (\<) ((?:\\\>|\\\\|$q_angle)+?) (\>) }oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); }
elsif (m{\G -s \s+ q \s* (\S) ((?:\\\1|\\\\|$q_char)+?) (\3) }oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); }
elsif (m{\G -s \s* (\$ \w+(?: ::\w+)* (?: (?: ->)? (?: \( (?:$qq_paren)*? \) | \{ (?:$qq_brace)+? \} | \[ (?:$qq_bracket)+? \] ) )*) }oxgc)
{ $slash = 'm//'; return "-s $1"; }
elsif (m{\G -s \s* \( ((?:$qq_paren)*?) \) }oxgc) { $slash = 'm//'; return "-s ($1)"; }
elsif (m{\G -s (?= \s+ [a-z]+) }oxgc) { $slash = 'm//'; return '-s'; }
elsif (m{\G -s \s+ (\w+) }oxgc) { $slash = 'm//'; return "-s $1"; }
elsif (m{\G \b bytes::length (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'length'; }
elsif (m{\G \b bytes::chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'chr'; }
elsif (m{\G \b chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::chr'; }
elsif (m{\G \b bytes::ord (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'div'; return 'ord'; }
elsif (m{\G \b ord (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'div'; return $function_ord; }
elsif (m{\G \b glob (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::glob'; }
elsif (m{\G \b lc \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::lc_'; }
elsif (m{\G \b lcfirst \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::lcfirst_'; }
elsif (m{\G \b uc \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::uc_'; }
elsif (m{\G \b ucfirst \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::ucfirst_'; }
elsif (m{\G \b fc \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::fc_'; }
elsif (m{\G -s \b (?! \s* => ) }oxgc) { $slash = 'm//'; return '-s '; }
elsif (m{\G \b bytes::length \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'length'; }
elsif (m{\G \b bytes::chr \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'chr'; }
elsif (m{\G \b chr \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::chr_'; }
elsif (m{\G \b bytes::ord \b (?! \s* => ) }oxgc) { $slash = 'div'; return 'ord'; }
elsif (m{\G \b ord \b (?! \s* => ) }oxgc) { $slash = 'div'; return $function_ord_; }
elsif (m{\G \b glob \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::glob_'; }
elsif (m{\G \b reverse \b (?! \s* => ) }oxgc) { $slash = 'm//'; return $function_reverse; }
elsif (m{\G \b (split) \b (?! \s* => ) }oxgc) {
$slash = 'm//';
my $e = '';
while (/\G ( \s+ | \( | \
$e .= $1;
}
if (/\G (?= [,;\)\}\]] ) /oxgc) { return 'Eutf2::split' . $e; }
elsif (/\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { return 'Eutf2::split' . $e . e_string($1); }
elsif (/\G \b qq (\
elsif (/\G \b qq (\s*) (\() [ ] (\)) /oxgc) { return 'Eutf2::split' . $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\{) [ ] (\}) /oxgc) { return 'Eutf2::split' . $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\[) [ ] (\]) /oxgc) { return 'Eutf2::split' . $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\<) [ ] (\>) /oxgc) { return 'Eutf2::split' . $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\S) [ ] (\2) /oxgc) { return 'Eutf2::split' . $e . qq{$1qq$2 $3}; }
elsif (/\G \b q (\
elsif (/\G \b q (\s*) (\() [ ] (\)) /oxgc) { return 'Eutf2::split' . $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\{) [ ] (\}) /oxgc) { return 'Eutf2::split' . $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\[) [ ] (\]) /oxgc) { return 'Eutf2::split' . $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\<) [ ] (\>) /oxgc) { return 'Eutf2::split' . $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\S) [ ] (\2) /oxgc) { return 'Eutf2::split' . $e . qq {$1q$2 $3}; }
elsif (/\G ' [ ] ' /oxgc) { return 'Eutf2::split' . $e . qq {' '}; }
elsif (/\G " [ ] " /oxgc) { return 'Eutf2::split' . $e . qq {" "}; }
elsif (/\G \b (qq) \b /oxgc) {
if (/\G (\
else {
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { return e_split($e.'qr',$1,$3,$2,''); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { return e_split($e.'qr',$1,$3,$2,''); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return e_split($e.'qr',$1,$3,$2,''); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { return e_split($e.'qr',$1,$3,$2,''); }
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) /oxgc) { return e_split($e.'qr','{','}',$2,''); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { return e_split($e.'qr',$1,$3,$2,''); }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (qr) \b /oxgc) {
if (/\G (\
else {
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([imosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([imosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([imosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([imosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([imosxpadlubB]*) /oxgc) { return e_split_q($e.'qr',$1, $3, $2,$4); } # qr ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([imosxpadlubB]*) /oxgc) { return e_split ($e.'qr','{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([imosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (q) \b /oxgc) {
if (/\G (\
else {
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?) (\)) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,''); }
elsif (/\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?) (\}) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,''); }
elsif (/\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,''); }
elsif (/\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?) (\>) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,''); }
elsif (/\G ([*\-:?\\^|]) ((?:$q_char)*?) (\1) /oxgc) { return e_split_q($e.'qr','{','}',$2,''); }
elsif (/\G (\S) ((?:\\\\|\\\1| $q_char)*?) (\1) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,''); }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (m) \b /oxgc) {
if (/\G (\
else {
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cgimosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cgimosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cgimosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cgimosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cgimosxpadlubB]*) /oxgc) { return e_split_q($e.'qr',$1, $3, $2,$4); } # m ' ' --> qr ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([cgimosxpadlubB]*) /oxgc) { return e_split ($e.'qr','{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cgimosxpadlubB]*) /oxgc) { return e_split ($e.'qr',$1, $3, $2,$4); }
}
die __FILE__, ": Search pattern not terminated";
}
}
elsif (/\G (\') /oxgc) {
my $q_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\') /oxgc) { $q_string .= $1; } # splitqr'' --> split qr''
elsif (/\G \' /oxgc) { return e_split_q($e.q{ qr},"'","'",$q_string,''); } # ' ' --> qr ' '
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\") /oxgc) {
my $qq_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\") /oxgc) { $qq_string .= $1; } # splitqr"" --> split qr""
elsif (/\G \" /oxgc) { return e_split($e.q{ qr},'"','"',$qq_string,''); }
elsif (/\G ($q_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\/) /oxgc) {
my $regexp = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $regexp .= $1; }
elsif (/\G (\\\/) /oxgc) { $regexp .= $1; }
elsif (/\G \/ ([cgimosxpadlubB]*) /oxgc) { return e_split($e.q{ qr}, '/','/',$regexp,$1); }
elsif (/\G ($q_char) /oxgc) { $regexp .= $1; }
}
die __FILE__, ": Search pattern not terminated";
}
}
elsif (/\G \b (tr|y) \b /oxgc) {
my $ope = $1;
if (/\G (\
my @tr = ($tr_variable,$2);
return e_tr(@tr,'',$4,$6);
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) {
my @tr = ($tr_variable,$2);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
}
die __FILE__, ": Transliteration replacement not terminated";
}
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) {
my @tr = ($tr_variable,$2);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
}
die __FILE__, ": Transliteration replacement not terminated";
}
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) {
my @tr = ($tr_variable,$2);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
}
die __FILE__, ": Transliteration replacement not terminated";
}
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) {
my @tr = ($tr_variable,$2);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
}
die __FILE__, ": Transliteration replacement not terminated";
}
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) {
my @tr = ($tr_variable,$2);
return e_tr(@tr,'',$4,$6);
}
}
die __FILE__, ": Transliteration pattern not terminated";
}
}
elsif (/\G \b (qq) \b /oxgc) {
my $ope = $1;
if (/\G (\
my $qq_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\
elsif (/\G (\
elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() /oxgc) {
my $qq_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\)) /oxgc) { $qq_string .= $1; }
elsif (/\G (\() /oxgc) { $qq_string .= $1; $nest++; }
elsif (/\G (\)) /oxgc) {
if (--$nest == 0) { return $e . e_qq($ope,'(',')',$qq_string); }
else { $qq_string .= $1; }
}
elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\{) /oxgc) {
my $qq_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\}) /oxgc) { $qq_string .= $1; }
elsif (/\G (\{) /oxgc) { $qq_string .= $1; $nest++; }
elsif (/\G (\}) /oxgc) {
if (--$nest == 0) { return $e . e_qq($ope,'{','}',$qq_string); }
else { $qq_string .= $1; }
}
elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\[) /oxgc) {
my $qq_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\]) /oxgc) { $qq_string .= $1; }
elsif (/\G (\[) /oxgc) { $qq_string .= $1; $nest++; }
elsif (/\G (\]) /oxgc) {
if (--$nest == 0) { return $e . e_qq($ope,'[',']',$qq_string); }
else { $qq_string .= $1; }
}
elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\<) /oxgc) {
my $qq_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\>) /oxgc) { $qq_string .= $1; }
elsif (/\G (\<) /oxgc) { $qq_string .= $1; $nest++; }
elsif (/\G (\>) /oxgc) {
if (--$nest == 0) { return $e . e_qq($ope,'<','>',$qq_string); }
else { $qq_string .= $1; }
}
elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\S) /oxgc) {
my $delimiter = $1;
my $qq_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\Q$delimiter\E) /oxgc) { $qq_string .= $1; }
elsif (/\G (\Q$delimiter\E) /oxgc) { return $e . e_qq($ope,$delimiter,$delimiter,$qq_string); }
elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (qr) \b /oxgc) {
my $ope = $1;
if (/\G (\
return e_qr($ope,$1,$3,$2,$4);
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([imosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([imosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([imosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([imosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([imosxpadlubB]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # qr ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([imosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,'{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([imosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (qw) \b /oxgc) {
my $ope = $1;
if (/\G (\
return e_qw($ope,$1,$3,$2);
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ([^(]*?) (\)) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\() ((?:$q_paren)*?) (\)) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\{) ([^{]*?) (\}) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\{) ((?:$q_brace)*?) (\}) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\[) ([^[]*?) (\]) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\[) ((?:$q_bracket)*?) (\]) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\<) ([^<]*?) (\>) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\<) ((?:$q_angle)*?) (\>) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G ([\x21-\x3F]) (.*?) (\1) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
elsif (/\G (\S) ((?:$q_char)*?) (\1) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (qx) \b /oxgc) {
my $ope = $1;
if (/\G (\
return e_qq($ope,$1,$3,$2);
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { return $e . e_qq($ope,$1,$3,$2); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { return $e . e_qq($ope,$1,$3,$2); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_qq($ope,$1,$3,$2); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { return $e . e_qq($ope,$1,$3,$2); }
elsif (/\G (\') ((?:$qq_char)*?) (\') /oxgc) { return $e . e_q ($ope,$1,$3,$2); } # qx ' '
elsif (/\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { return $e . e_qq($ope,$1,$3,$2); }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (q) \b /oxgc) {
my $ope = $1;
if (/\G (\
my $q_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\
elsif (/\G (\
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() /oxgc) {
my $q_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\)) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\() /oxgc) { $q_string .= $1; }
elsif (/\G (\() /oxgc) { $q_string .= $1; $nest++; }
elsif (/\G (\)) /oxgc) {
if (--$nest == 0) { return $e . e_q($ope,'(',')',$q_string); }
else { $q_string .= $1; }
}
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\{) /oxgc) {
my $q_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\}) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\{) /oxgc) { $q_string .= $1; }
elsif (/\G (\{) /oxgc) { $q_string .= $1; $nest++; }
elsif (/\G (\}) /oxgc) {
if (--$nest == 0) { return $e . e_q($ope,'{','}',$q_string); }
else { $q_string .= $1; }
}
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\[) /oxgc) {
my $q_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\]) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\[) /oxgc) { $q_string .= $1; }
elsif (/\G (\[) /oxgc) { $q_string .= $1; $nest++; }
elsif (/\G (\]) /oxgc) {
if (--$nest == 0) { return $e . e_q($ope,'[',']',$q_string); }
else { $q_string .= $1; }
}
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\<) /oxgc) {
my $q_string = '';
local $nest = 1;
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\>) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\<) /oxgc) { $q_string .= $1; }
elsif (/\G (\<) /oxgc) { $q_string .= $1; $nest++; }
elsif (/\G (\>) /oxgc) {
if (--$nest == 0) { return $e . e_q($ope,'<','>',$q_string); }
else { $q_string .= $1; }
}
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\S) /oxgc) {
my $delimiter = $1;
my $q_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\Q$delimiter\E) /oxgc) { $q_string .= $1; }
elsif (/\G (\Q$delimiter\E) /oxgc) { return $e . e_q($ope,$delimiter,$delimiter,$q_string); }
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (m) \b /oxgc) {
my $ope = $1;
if (/\G (\
return e_qr($ope,$1,$3,$2,$4);
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\?) ((?:$qq_char)*?) (\?) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # m ' '
elsif (/\G ([*\-:\\^|]) ((?:$qq_char)*?) (\1) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,'{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cgimosxpadlubB]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
}
die __FILE__, ": Search pattern not terminated";
}
}
elsif (/\G \b (s) \b /oxgc) {
my $ope = $1;
if (/\G (\
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
else {
my $e = '';
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) {
my @s = ($1,$2,$3);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\:) ((?:$qq_char)*?) (\:) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\@) ((?:$qq_char)*?) (\@) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
}
die __FILE__, ": Substitution replacement not terminated";
}
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) {
my @s = ($1,$2,$3);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\:) ((?:$qq_char)*?) (\:) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\@) ((?:$qq_char)*?) (\@) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
}
die __FILE__, ": Substitution replacement not terminated";
}
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) {
my @s = ($1,$2,$3);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
}
die __FILE__, ": Substitution replacement not terminated";
}
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) {
my @s = ($1,$2,$3);
while (not /\G \z/oxgc) {
if (/\G (\s+|\
elsif (/\G (\() ((?:$qq_paren)*?) (\)) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\:) ((?:$qq_char)*?) (\:) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\@) ((?:$qq_char)*?) (\@) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
}
die __FILE__, ": Substitution replacement not terminated";
}
elsif (/\G (\') ((?:$qq_char)*?) (\') ((?:$qq_char)*?) (\') ([cegimosxpradlubB]*) /oxgc) {
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) {
return e_sub($sub_variable,'{',$2,'}','{',$4,'}',$6);
}
elsif (/\G (\$) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) {
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlubB]*) /oxgc) {
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
}
die __FILE__, ": Substitution pattern not terminated";
}
}
elsif (/\G \b require (\s+ (?:$ignore_modules) .*? ;) ([ \t]* [
elsif (/\G \b require (\s+ (?:$ignore_modules) .*? ;) ([ \t]* [^\x80-\xFF
elsif (/\G \b require (\s+ (?:$ignore_modules)) \b /oxmsgc) { return "# require$1"; }
elsif (/\G \b use (\s+ strict .*? ;) ([ \t]* [
elsif (/\G \b use (\s+ strict .*? ;) ([ \t]* [^\x80-\xFF
elsif (/\G \b use (\s+ strict) \b /oxmsgc) { return "use$1; no strict qw(refs)"; }
elsif (/\G \b use \s+ (([1-9][0-9_]*)(?:\.([0-9_]+))*) \s* ; /oxmsgc) {
if (($2 >= 6) or (($2 == 5) and ($3 >= 12))) {
return "use$1 no strict qw(refs);";
}
else {
return "use$1";
}
}
elsif (/\G \b use \s+ (v([0-9][0-9_]*)(?:\.([0-9_]+))*) \s* ; /oxmsgc) {
if (($2 >= 6) or (($2 == 5) and ($3 >= 12))) {
return "use$1 no strict qw(refs);";
}
else {
return "use$1";
}
}
elsif (/\G \b use (\s+ (?:$ignore_modules) .*? ;) ([ \t]* [
elsif (/\G \b use (\s+ (?:$ignore_modules) .*? ;) ([ \t]* [^\x80-\xFF
elsif (/\G \b use (\s+ (?:$ignore_modules)) \b /oxmsgc) { return "# use$1"; }
elsif (/\G \b no (\s+ (?:$ignore_modules) .*? ;) ([ \t]* [
elsif (/\G \b no (\s+ (?:$ignore_modules) .*? ;) ([ \t]* [^\x80-\xFF
elsif (/\G \b no (\s+ (?:$ignore_modules)) \b /oxmsgc) { return "# no$1"; }
elsif (/\G \b use \b /oxmsgc) { return "use"; }
elsif (/\G \b no \b /oxmsgc) { return "no"; }
elsif (/\G (?<![\w\$\@\%\&\*]) (\') /oxgc) {
my $q_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $q_string .= $1; }
elsif (/\G (\\\') /oxgc) { $q_string .= $1; }
elsif (/\G \' /oxgc) { return e_q('', "'","'",$q_string); }
elsif (/\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\") /oxgc) {
my $qq_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif (/\G (\\\") /oxgc) { $qq_string .= $1; }
elsif (/\G \" /oxgc) { return e_qq('', '"','"',$qq_string); }
elsif (/\G ($q_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (/\G (\`) /oxgc) {
my $qx_string = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $qx_string .= $1; }
elsif (/\G (\\\`) /oxgc) { $qx_string .= $1; }
elsif (/\G \` /oxgc) { return e_qq('', '`','`',$qx_string); }
elsif (/\G ($q_char) /oxgc) { $qx_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif (($slash eq 'm//') and /\G (\/) /oxgc) {
my $regexp = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $regexp .= $1; }
elsif (/\G (\\\/) /oxgc) { $regexp .= $1; }
elsif (/\G \/ ([cgimosxpadlubB]*) /oxgc) { return e_qr('', '/','/',$regexp,$1); }
elsif (/\G ($q_char) /oxgc) { $regexp .= $1; }
}
die __FILE__, ": Search pattern not terminated";
}
elsif (($slash eq 'm//') and /\G (\?) /oxgc) {
my $regexp = '';
while (not /\G \z/oxgc) {
if (/\G (\\\\) /oxgc) { $regexp .= $1; }
elsif (/\G (\\\?) /oxgc) { $regexp .= $1; }
elsif (/\G \? ([cgimosxpadlubB]*) /oxgc) { return e_qr('m','?','?',$regexp,$1); }
elsif (/\G ($q_char) /oxgc) { $regexp .= $1; }
}
die __FILE__, ": Search pattern not terminated";
}
elsif (/\G ( << \s* ) (?= [0-9\$\@\&] ) /oxgc) { $slash = 'm//'; return $1; }
elsif (/\G ( << '([a-zA-Z_0-9]*)' ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, $1 . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
return $here_quote;
}
elsif (/\G ( << \\([a-zA-Z_0-9]+) ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, $1 . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
return $here_quote;
}
elsif (/\G ( << "([a-zA-Z_0-9]*)" ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, e_heredoc($1) . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
return $here_quote;
}
elsif (/\G ( << ([a-zA-Z_0-9]+) ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, e_heredoc($1) . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
return $here_quote;
}
elsif (/\G ( << `([a-zA-Z_0-9]*)` ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, e_heredoc($1) . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
return $here_quote;
}
elsif (/\G (<<=|<=>|<=|<) (?= \s* [A-Za-z_0-9'"`\$\@\&\*\(\+\-] )/oxgc) {
return $1;
}
elsif (/\G (<[\$]?[A-Za-z_][A-Za-z_0-9]*>) /oxgc) {
return $1;
}
elsif (/\G < ((?:(?:[\xC2-\xDF]|[\xE0-\xE0][\xA0-\xBF]|[\xE1-\xEC][\x80-\xBF]|[\xED-\xED][\x80-\x9F]|[\xEE-\xEF][\x80-\xBF]|[\xF0-\xF0][\x90-\xBF][\x80-\xBF]|[\xF1-\xF3][\x80-\xBF][\x80-\xBF]|[\xF4-\xF4][\x80-\x8F][\x80-\xBF])[\x00-\xFF]|[^\x80-\xFF>\0\a\e\f\n\r\t])+?) > /oxgc) {
return 'Eutf2::glob("' . $1 . '")';
}
elsif (/\G ^ ( __DATA__ \n .*) \z /oxmsgc) { return $1; }
elsif (/\G ^ ( __END__ \n .*) \z /oxmsgc) { return $1; }
elsif (/\G ( \cD .*) \z /oxmsgc) { return $1; }
elsif (/\G ( \cZ .*) \z /oxmsgc) { return $1; }
elsif (/\G (
-- | \+\+ |
[\)\}\]]
) /oxgc) { $slash = 'div'; return $1; }
elsif (/\G (
!~~ | !~ | != | ! |
%= | % |
&&= | && | &= | & |
-= | -> | - |
:\s*= |
: |
<<= | <=> | <= | < |
== | => | =~ | = |
>>= | >> | >= | > |
\*\*= | \*\* | \*= | \* |
\+= | \+ |
\.\.\. | \.\. | \.= | \. |
\/\/= | \/\/ |
\/= | \/ |
\? |
\\ |
\^= | \^ |
\b x= |
\|\|= | \|\| | \|= | \| |
~~ | ~ |
\b(?: and | cmp | eq | ge | gt | le | lt | ne | not | or | xor | x )\b |
\b(?: print )\b |
[,;\(\{\[]
) /oxgc) { $slash = 'm//'; return $1; }
elsif (/\G ($q_char) /oxgc) { $slash = 'div'; return $1; }
else {
die __FILE__, ": Oops, this shouldn't happen!";
}
}
sub e_string {
my($string) = @_;
my $e_string = '';
local $slash = 'm//';
my @char = $string =~ m/ \G (\\?(?:$q_char)) /oxmsg;
if (not (grep(m/\A \{ \z/xms, @char) and grep(m/\A \} \z/xms, @char))) {
if ($string !~ /<</oxms) {
return $string;
}
}
E_STRING_LOOP:
while ($string !~ /\G \z/oxgc) {
if (0) {
}
elsif ($string =~ /\G ( \$` | \$\{`\} | \$ \s* PREMATCH \b | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) /oxmsgc) {
$e_string .= q{Eutf2::PREMATCH()};
$slash = 'div';
}
elsif ($string =~ /\G ( \$& | \$\{&\} | \$ \s* MATCH \b | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) /oxmsgc) {
$e_string .= q{Eutf2::MATCH()};
$slash = 'div';
}
elsif ($string =~ /\G ( \$ \s* POSTMATCH \b | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) /oxmsgc) {
$e_string .= q{Eutf2::POSTMATCH()};
$slash = 'div';
}
elsif ($string =~ /\G ( \{ \s* (?: tr|index|rindex|reverse) \s* \} ) /oxmsgc) {
$e_string .= $1;
$slash = 'div';
}
elsif ($string =~ /\G ( \$ 0 ) /oxmsgc) {
$e_string .= $1;
$slash = 'div';
}
elsif ($string =~ /\G ( \$ \{ \s* 0 \s* \} ) /oxmsgc) {
$e_string .= $1;
$slash = 'div';
}
elsif ($string =~ /\G ( \$ \$ ) (?![\w\{]) /oxmsgc) {
$e_string .= $1;
$slash = 'div';
}
elsif ($string =~ /\G \$ ([1-9][0-9]*) /oxmsgc) {
$e_string .= e_capture($1);
$slash = 'div';
}
elsif ($string =~ /\G \$ \{ \s* ([1-9][0-9]*) \s* \} /oxmsgc) {
$e_string .= e_capture($1);
$slash = 'div';
}
elsif ($string =~ /\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ .+? \] ) /oxmsgc) {
$e_string .= e_capture($1.'->'.$2);
$slash = 'div';
}
elsif ($string =~ /\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ .+? \} ) /oxmsgc) {
$e_string .= e_capture($1.'->'.$2);
$slash = 'div';
}
elsif ($string =~ /\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) /oxmsgc) {
$e_string .= e_capture($1);
$slash = 'div';
}
elsif ($string =~ /\G \$ \s* \{ ( \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \} /oxmsgc) {
$e_string .= '${' . $1 . '}';
$slash = 'div';
}
elsif ($string =~ /\G \$ \s* \{ \s* ( $qq_brace ) \s* \} /oxmsgc) {
$e_string .= e_capture($1);
$slash = 'div';
}
elsif ($string =~ /\G ( (?: [\$\@\%\&\*] | \$\
$e_string .= $1;
$slash = 'div';
}
elsif ($string =~ /\G ( \$[\$\@\
$e_string .= $1;
$slash = 'div';
}
elsif ($string =~ m{\G \b (CORE:: | ->[ ]* (?: atan2 | [a-z]{2,})) \b }oxgc) { $e_string .= $1; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::substr \b }oxgc) { $e_string .= 'substr'; $slash = 'm//'; }
elsif ($string =~ m{\G \b chop \b }oxgc) { $e_string .= 'Eutf2::chop'; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::index \b }oxgc) { $e_string .= 'index'; $slash = 'm//'; }
elsif ($string =~ m{\G \b UTF2::index \b }oxgc) { $e_string .= 'UTF2::index'; $slash = 'm//'; }
elsif ($string =~ m{\G \b index \b }oxgc) { $e_string .= 'Eutf2::index'; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::rindex \b }oxgc) { $e_string .= 'rindex'; $slash = 'm//'; }
elsif ($string =~ m{\G \b UTF2::rindex \b }oxgc) { $e_string .= 'UTF2::rindex'; $slash = 'm//'; }
elsif ($string =~ m{\G \b rindex \b }oxgc) { $e_string .= 'Eutf2::rindex'; $slash = 'm//'; }
elsif ($string =~ m{\G \b lc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::lc'; $slash = 'm//'; }
elsif ($string =~ m{\G \b lcfirst (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::lcfirst'; $slash = 'm//'; }
elsif ($string =~ m{\G \b uc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::uc'; $slash = 'm//'; }
elsif ($string =~ m{\G \b ucfirst (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::ucfirst'; $slash = 'm//'; }
elsif ($string =~ m{\G \b fc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::fc'; $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ \s* (\") ((?:$qq_char)+?) (\") }oxgc) { $e_string .= '-s ' . e_qq('', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ qq \s* (\
elsif ($string =~ m{\G -s \s+ qq \s* (\() ((?:$qq_paren)+?) (\)) }oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ qq \s* (\{) ((?:$qq_brace)+?) (\}) }oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ qq \s* (\[) ((?:$qq_bracket)+?) (\]) }oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ qq \s* (\<) ((?:$qq_angle)+?) (\>) }oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ qq \s* (\S) ((?:$qq_char)+?) (\3) }oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ \s* (\') ((?:\\\1|\\\\|$q_char)+?) (\') }oxgc) { $e_string .= '-s ' . e_q ('', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ q \s* (\
elsif ($string =~ m{\G -s \s+ q \s* (\() ((?:\\\)|\\\\|$q_paren)+?) (\)) }oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ q \s* (\{) ((?:\\\}|\\\\|$q_brace)+?) (\}) }oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ q \s* (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) }oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ q \s* (\<) ((?:\\\>|\\\\|$q_angle)+?) (\>) }oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ q \s* (\S) ((?:\\\1|\\\\|$q_char)+?) (\3) }oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; }
elsif ($string =~ m{\G -s \s* (\$ \w+(?: ::\w+)* (?: (?: ->)? (?: \( (?:$qq_paren)*? \) | \{ (?:$qq_brace)+? \} | \[ (?:$qq_bracket)+? \] ) )*) }oxgc)
{ $e_string .= "-s $1"; $slash = 'm//'; }
elsif ($string =~ m{\G -s \s* \( ((?:$qq_paren)*?) \) }oxgc) { $e_string .= "-s ($1)"; $slash = 'm//'; }
elsif ($string =~ m{\G -s (?= \s+ [a-z]+) }oxgc) { $e_string .= '-s'; $slash = 'm//'; }
elsif ($string =~ m{\G -s \s+ (\w+) }oxgc) { $e_string .= "-s $1"; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::length (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'length'; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'chr'; $slash = 'm//'; }
elsif ($string =~ m{\G \b chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::chr'; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::ord (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'ord'; $slash = 'div'; }
elsif ($string =~ m{\G \b ord (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= $function_ord; $slash = 'div'; }
elsif ($string =~ m{\G \b glob (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::glob'; $slash = 'm//'; }
elsif ($string =~ m{\G \b lc \b }oxgc) { $e_string .= 'Eutf2::lc_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b lcfirst \b }oxgc) { $e_string .= 'Eutf2::lcfirst_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b uc \b }oxgc) { $e_string .= 'Eutf2::uc_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b ucfirst \b }oxgc) { $e_string .= 'Eutf2::ucfirst_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b fc \b }oxgc) { $e_string .= 'Eutf2::fc_'; $slash = 'm//'; }
elsif ($string =~ m{\G -s \b }oxgc) { $e_string .= '-s '; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::length \b }oxgc) { $e_string .= 'length'; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::chr \b }oxgc) { $e_string .= 'chr'; $slash = 'm//'; }
elsif ($string =~ m{\G \b chr \b }oxgc) { $e_string .= 'Eutf2::chr_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b bytes::ord \b }oxgc) { $e_string .= 'ord'; $slash = 'div'; }
elsif ($string =~ m{\G \b ord \b }oxgc) { $e_string .= $function_ord_; $slash = 'div'; }
elsif ($string =~ m{\G \b glob \b }oxgc) { $e_string .= 'Eutf2::glob_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b reverse \b }oxgc) { $e_string .= $function_reverse; $slash = 'm//'; }
elsif ($string =~ m{\G \b (split) \b (?! \s* => ) }oxgc) {
$slash = 'm//';
my $e = '';
while ($string =~ /\G ( \s+ | \( | \
$e .= $1;
}
if ($string =~ /\G (?= [,;\)\}\]] ) /oxgc) { return 'Eutf2::split' . $e; }
elsif ($string =~ /\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { $e_string .= 'Eutf2::split' . $e . e_string($1); next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\
elsif ($string =~ /\G \b qq (\s*) (\() [ ] (\)) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\{) [ ] (\}) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\[) [ ] (\]) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\<) [ ] (\>) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\S) [ ] (\2) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\
elsif ($string =~ /\G \b q (\s*) (\() [ ] (\)) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\{) [ ] (\}) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\[) [ ] (\]) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\<) [ ] (\>) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\S) [ ] (\2) /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G ' [ ] ' /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {' '}; next E_STRING_LOOP; }
elsif ($string =~ /\G " [ ] " /oxgc) { $e_string .= 'Eutf2::split' . $e . qq {" "}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b (qq) \b /oxgc) {
if ($string =~ /\G (\
else {
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) /oxgc) { $e_string .= e_split($e.'qr','{','}',$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif ($string =~ /\G \b (qr) \b /oxgc) {
if ($string =~ /\G (\
else {
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:$qq_paren)*?) (\)) ([imosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) ([imosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) ([imosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) ([imosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\') ((?:$qq_char)*?) (\') ([imosxpadlubB]*) /oxgc) { $e_string .= e_split_q($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr ' '
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([imosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr','{','}',$2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) ([imosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif ($string =~ /\G \b (q) \b /oxgc) {
if ($string =~ /\G (\
else {
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?) (\)) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?) (\}) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?) (\>) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$q_char)*?) (\1) /oxgc) { $e_string .= e_split_q($e.'qr','{','}',$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:\\\\|\\\1| $q_char)*?) (\1) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,''); next E_STRING_LOOP; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif ($string =~ /\G \b (m) \b /oxgc) {
if ($string =~ /\G (\
else {
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:$qq_paren)*?) (\)) ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\') ((?:$qq_char)*?) (\') ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split_q($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m ' ' --> qr ' '
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr','{','}',$2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; }
}
die __FILE__, ": Search pattern not terminated";
}
}
elsif ($string =~ /\G (\') /oxgc) {
my $q_string = '';
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\\\\) /oxgc) { $q_string .= $1; }
elsif ($string =~ /\G (\\\') /oxgc) { $q_string .= $1; } # splitqr'' --> split qr''
elsif ($string =~ /\G \' /oxgc) { $e_string .= e_split_q($e.q{ qr},"'","'",$q_string,''); next E_STRING_LOOP; } # ' ' --> qr ' '
elsif ($string =~ /\G ($q_char) /oxgc) { $q_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif ($string =~ /\G (\") /oxgc) {
my $qq_string = '';
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\\\\) /oxgc) { $qq_string .= $1; }
elsif ($string =~ /\G (\\\") /oxgc) { $qq_string .= $1; } # splitqr"" --> split qr""
elsif ($string =~ /\G \" /oxgc) { $e_string .= e_split($e.q{ qr},'"','"',$qq_string,''); next E_STRING_LOOP; }
elsif ($string =~ /\G ($q_char) /oxgc) { $qq_string .= $1; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
elsif ($string =~ /\G (\/) /oxgc) {
my $regexp = '';
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\\\\) /oxgc) { $regexp .= $1; }
elsif ($string =~ /\G (\\\/) /oxgc) { $regexp .= $1; }
elsif ($string =~ /\G \/ ([cgimosxpadlubB]*) /oxgc) { $e_string .= e_split($e.q{ qr}, '/','/',$regexp,$1); next E_STRING_LOOP; }
elsif ($string =~ /\G ($q_char) /oxgc) { $regexp .= $1; }
}
die __FILE__, ": Search pattern not terminated";
}
}
elsif ($string =~ /\G \b (qq) \b /oxgc) {
my $ope = $1;
if ($string =~ /\G (\
$e_string .= e_qq($ope,$1,$3,$2);
}
else {
my $e = '';
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif ($string =~ /\G \b (qx) \b /oxgc) {
my $ope = $1;
if ($string =~ /\G (\
$e_string .= e_qq($ope,$1,$3,$2);
}
else {
my $e = '';
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\') ((?:$qq_char)*?) (\') /oxgc) { $e_string .= $e . e_q ($ope,$1,$3,$2); next E_STRING_LOOP; } # qx ' '
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif ($string =~ /\G \b (q) \b /oxgc) {
my $ope = $1;
if ($string =~ /\G (\
$e_string .= e_q($ope,$1,$3,$2);
}
else {
my $e = '';
while ($string !~ /\G \z/oxgc) {
if ($string =~ /\G (\s+|\
elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?) (\)) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?) (\}) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?) (\>) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:\\\\|\\\1| $q_char)*?) (\1) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; }
}
die __FILE__, ": Can't find string terminator anywhere before EOF";
}
}
elsif ($string =~ /\G (?<![\w\$\@\%\&\*]) (\') ((?:\\\'|\\\\|$q_char)*?) (\') /oxgc) { $e_string .= e_q('',$1,$3,$2); }
elsif ($string =~ /\G (\") ((?:$qq_char)*?) (\") /oxgc) { $e_string .= e_qq('',$1,$3,$2); }
elsif ($string =~ /\G (\`) ((?:$qq_char)*?) (\`) /oxgc) { $e_string .= e_qq('',$1,$3,$2); }
elsif ($string =~ /\G (<<=|<=>|<=|<) (?= \s* [A-Za-z_0-9'"`\$\@\&\*\(\+\-] )/oxgc) { $e_string .= $1; }
elsif ($string =~ /\G (<[\$]?[A-Za-z_][A-Za-z_0-9]*>) /oxgc) { $e_string .= $1; }
elsif ($string =~ /\G < ((?:$q_char)+?) > /oxgc) {
$e_string .= 'Eutf2::glob("' . $1 . '")';
}
elsif ($string =~ /\G ( << \s* ) (?= [0-9\$\@\&] ) /oxgc) { $slash = 'm//'; $e_string .= $1; }
elsif ($string =~ /\G ( << '([a-zA-Z_0-9]*)' ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, $1 . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
$e_string .= $here_quote;
}
elsif ($string =~ /\G ( << \\([a-zA-Z_0-9]+) ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, $1 . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
$e_string .= $here_quote;
}
elsif ($string =~ /\G ( << "([a-zA-Z_0-9]*)" ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, e_heredoc($1) . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
$e_string .= $here_quote;
}
elsif ($string =~ /\G ( << ([a-zA-Z_0-9]+) ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, e_heredoc($1) . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
$e_string .= $here_quote;
}
elsif ($string =~ /\G ( << `([a-zA-Z_0-9]*)` ) /oxgc) {
$slash = 'm//';
my $here_quote = $1;
my $delimiter = $2;
if ($here_script eq '') {
$here_script = CORE::substr $_, pos $_;
$here_script =~ s/.*?\n//oxm;
}
if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) {
push @heredoc, e_heredoc($1) . qq{\n$delimiter\n};
push @heredoc_delimiter, $delimiter;
}
else {
die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF";
}
$e_string .= $here_quote;
}
elsif ($string =~ /\G (
-- | \+\+ |
[\)\}\]]
) /oxgc) { $slash = 'div'; $e_string .= $1; }
elsif ($string =~ /\G (
!~~ | !~ | != | ! |
%= | % |
&&= | && | &= | & |
-= | -> | - |
:\s*= |
: |
<<= | <=> | <= | < |
== | => | =~ | = |
>>= | >> | >= | > |
\*\*= | \*\* | \*= | \* |
\+= | \+ |
\.\.\. | \.\. | \.= | \. |
\/\/= | \/\/ |
\/= | \/ |
\? |
\\ |
\^= | \^ |
\b x= |
\|\|= | \|\| | \|= | \| |
~~ | ~ |
\b(?: and | cmp | eq | ge | gt | le | lt | ne | not | or | xor | x )\b |
\b(?: print )\b |
[,;\(\{\[]
) /oxgc) { $slash = 'm//'; $e_string .= $1; }
elsif ($string =~ /\G ($q_char) /oxgc) { $e_string .= $1; }
else {
die __FILE__, ": Oops, this shouldn't happen!";
}
}
return $e_string;
}
sub character_class {
my($char,$modifier) = @_;
if ($char eq '.') {
if ($modifier =~ /s/) {
return '@{Eutf2::dot_s}';
}
else {
return '@{Eutf2::dot}';
}
}
else {
return Eutf2::classic_character_class($char);
}
}
sub e_capture {
return join '', '$', $_[0];
}
sub e_tr {
my($variable,$charclass,$e,$charclass2,$modifier) = @_;
my $e_tr = '';
$modifier ||= '';
$slash = 'div';
$charclass = q_tr($charclass);
$charclass2 = q_tr($charclass2);
if ($modifier =~ tr/bB//d) {
if ($variable eq '') {
$e_tr = qq{tr$charclass$e$charclass2$modifier};
}
else {
$e_tr = qq{$variable${bind_operator}tr$charclass$e$charclass2$modifier};
}
}
else {
if ($variable eq '') {
$e_tr = qq{Eutf2::tr(\$_,' =~ ',$charclass,$e$charclass2,'$modifier')};
}
else {
$e_tr = qq{Eutf2::tr($variable,'$bind_operator',$charclass,$e$charclass2,'$modifier')};
}
}
$tr_variable = '';
$bind_operator = '';
return $e_tr;
}
sub q_tr {
my($charclass) = @_;
if ($charclass !~ m/'/oxms) {
return e_q('', "'", "'", $charclass);
}
elsif ($charclass !~ m{/}oxms) {
return e_q('q', '/', '/', $charclass);
}
elsif ($charclass !~ m/\
return e_q('q', '#', '#', $charclass); # --> q# #
}
elsif ($charclass !~ m/[\<\>]/oxms) {
return e_q('q', '<', '>', $charclass);
}
elsif ($charclass !~ m/[\(\)]/oxms) {
return e_q('q', '(', ')', $charclass);
}
elsif ($charclass !~ m/[\{\}]/oxms) {
return e_q('q', '{', '}', $charclass);
}
else {
for my $char (qw( ! " $ % & * + . : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if ($charclass !~ m/\Q$char\E/xms) {
return e_q('q', $char, $char, $charclass);
}
}
}
return e_q('q', '{', '}', $charclass);
}
sub e_q {
my($ope,$delimiter,$end_delimiter,$string) = @_;
$slash = 'div';
return join '', $ope, $delimiter, $string, $end_delimiter;
}
sub e_qq {
my($ope,$delimiter,$end_delimiter,$string) = @_;
$slash = 'div';
my $metachar = qr/[\@\\\|]/oxms;
my $left_e = 0;
my $right_e = 0;
my @char = $string =~ m{ \G (
\\o\{ [0-7]+ \} |
\\x\{ [0-9A-Fa-f]+ \} |
\\N\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} |
\$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} |
\$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\\?(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif ($char[$i] =~ m/\A \\o \{ ([0-7]+) \} \z/oxms) {
$char[$i] = Eutf2::octchr($1);
}
elsif ($char[$i] =~ m/\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) {
$char[$i] = Eutf2::hexchr($1);
}
elsif ($char[$i] =~ m/\A \\ ( N\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
if (0) {
}
elsif ($char[$i] =~ m/\A ([\x80-\xFF].*) ($metachar|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
elsif ($char[$i] =~ m/\A ([<>]) \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\u') {
$char[$i] = '@{[Eutf2::ucfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\l') {
$char[$i] = '@{[Eutf2::lcfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Eutf2::uc qq<';
$left_e++;
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Eutf2::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\F') {
$char[$i] = '@{[Eutf2::fc qq<';
$left_e++;
}
elsif ($char[$i] eq '\Q') {
$char[$i] = '@{[CORE::quotemeta qq<';
$left_e++;
}
elsif ($char[$i] eq '\E') {
if ($right_e < $left_e) {
$char[$i] = '>]}';
$right_e++;
}
else {
$char[$i] = '';
}
}
elsif ($char[$i] eq '\Q') {
while (1) {
if (++$i > $#char) {
last;
}
if ($char[$i] eq '\E') {
last;
}
}
}
elsif ($char[$i] eq '\E') {
}
elsif ($char[$i] =~ m/\A \$ 0 \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
$char[$i] = e_capture($1);
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ (?:$qq_brace)*? \} ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
$char[$i] = e_capture($1);
}
elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Eutf2::PREMATCH()]}';
}
elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Eutf2::MATCH()]}';
}
elsif ($char[$i] =~ /\A ( \$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Eutf2::POSTMATCH()]}';
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* \} \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
}
}
if ($left_e > $right_e) {
return join '', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter;
}
return join '', $ope, $delimiter, @char, $end_delimiter;
}
sub e_qw {
my($ope,$delimiter,$end_delimiter,$string) = @_;
$slash = 'div';
my %octet = map {$_ => 1} ($string =~ m/\G ([\x00-\xFF]) /oxmsg);
if (not $octet{$end_delimiter}) {
return join '', $ope, $delimiter, $string, $end_delimiter;
}
elsif (not $octet{')'}) {
return join '', $ope, '(', $string, ')';
}
elsif (not $octet{'}'}) {
return join '', $ope, '{', $string, '}';
}
elsif (not $octet{']'}) {
return join '', $ope, '[', $string, ']';
}
elsif (not $octet{'>'}) {
return join '', $ope, '<', $string, '>';
}
else {
for my $char (qw( ! " $ % & * + - . / : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
return join '', $ope, $char, $string, $char;
}
}
}
my @string = CORE::split(/\s+/, $string);
for my $string (@string) {
my @octet = $string =~ m/\G ([\x00-\xFF]) /oxmsg;
for my $octet (@octet) {
if ($octet =~ m/\A (['\\]) \z/oxms) {
$octet = '\\' . $1;
}
}
$string = join '', @octet;
}
return join '', '(', (join ', ', map { "'$_'" } @string), ')';
}
sub e_heredoc {
my($string) = @_;
$slash = 'm//';
my $metachar = qr/[\@\\|]/oxms;
my $left_e = 0;
my $right_e = 0;
my @char = $string =~ m{ \G (
\\o\{ [0-7]+ \} |
\\x\{ [0-9A-Fa-f]+ \} |
\\N\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} |
\$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} |
\$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\\?(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif ($char[$i] =~ m/\A \\o \{ ([0-7]+) \} \z/oxms) {
$char[$i] = Eutf2::octchr($1);
}
elsif ($char[$i] =~ m/\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) {
$char[$i] = Eutf2::hexchr($1);
}
elsif ($char[$i] =~ m/\A \\ ( N\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
if (0) {
}
elsif ($char[$i] =~ m/\A ([\x80-\xFF].*) ($metachar) \z/oxms) {
$char[$i] = $1 . '\\' . $2;
}
elsif ($char[$i] =~ m/\A ([<>]) \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\u') {
$char[$i] = '@{[Eutf2::ucfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\l') {
$char[$i] = '@{[Eutf2::lcfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Eutf2::uc qq<';
$left_e++;
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Eutf2::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\F') {
$char[$i] = '@{[Eutf2::fc qq<';
$left_e++;
}
elsif ($char[$i] eq '\Q') {
$char[$i] = '@{[CORE::quotemeta qq<';
$left_e++;
}
elsif ($char[$i] eq '\E') {
if ($right_e < $left_e) {
$char[$i] = '>]}';
$right_e++;
}
else {
$char[$i] = '';
}
}
elsif ($char[$i] eq '\Q') {
while (1) {
if (++$i > $#char) {
last;
}
if ($char[$i] eq '\E') {
last;
}
}
}
elsif ($char[$i] eq '\E') {
}
elsif ($char[$i] =~ m/\A \$ 0 \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
$char[$i] = e_capture($1);
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ (?:$qq_brace)*? \} ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
$char[$i] = e_capture($1);
}
elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Eutf2::PREMATCH()]}';
}
elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Eutf2::MATCH()]}';
}
elsif ($char[$i] =~ /\A ( \$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Eutf2::POSTMATCH()]}';
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* \} \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
}
}
if ($left_e > $right_e) {
return join '', @char, '>]}' x ($left_e - $right_e);
}
return join '', @char;
}
sub e_qr {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
elsif ($modifier =~ tr/bB//d) {
if ($delimiter =~ m/ [\@:] /oxms) {
my @char = $string =~ m{\G([\x00-\xFF])}oxmsg;
my %octet = map {$_ => 1} @char;
if (not $octet{')'}) {
$delimiter = '(';
$end_delimiter = ')';
}
elsif (not $octet{'}'}) {
$delimiter = '{';
$end_delimiter = '}';
}
elsif (not $octet{']'}) {
$delimiter = '[';
$end_delimiter = ']';
}
elsif (not $octet{'>'}) {
$delimiter = '<';
$end_delimiter = '>';
}
else {
for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
$delimiter = $char;
$end_delimiter = $char;
last;
}
}
}
}
if (($ope =~ m/\A m? \z/oxms) and ($delimiter eq '?')) {
return join '', $ope, $delimiter, $string, $matched, $end_delimiter, $modifier;
}
else {
return join '', $ope, $delimiter, '(?:', $string, ')', $matched, $end_delimiter, $modifier;
}
}
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
my $metachar = qr/[\@\\|[\]{^]/oxms;
my @char = $string =~ m{\G(
\\o\{ [0-7]+ \} |
\\ [0-7]{2,3} |
\\x\{ [0-9A-Fa-f]+ \} |
\\x [0-9A-Fa-f]{1,2} |
\\c [\x40-\x5F] |
\\N\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\p\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\P\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\ (?:$q_char) |
\$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} |
\$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} |
\$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} |
[\$\@] $qq_variable |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\[\:\^ (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] |
\[\: (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] |
\[\^ |
\(\? |
(?:$q_char)
)}oxmsg;
if ($delimiter =~ m/ [\@:] /oxms) {
my %octet = map {$_ => 1} @char;
if (not $octet{')'}) {
$delimiter = '(';
$end_delimiter = ')';
}
elsif (not $octet{'}'}) {
$delimiter = '{';
$end_delimiter = '}';
}
elsif (not $octet{']'}) {
$delimiter = '[';
$end_delimiter = ']';
}
elsif (not $octet{'>'}) {
$delimiter = '<';
$end_delimiter = '>';
}
else {
for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
$delimiter = $char;
$end_delimiter = $char;
last;
}
}
}
}
my $left_e = 0;
my $right_e = 0;
for (my $i=0; $i <= $#char; $i++) {
if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif ($char[$i] =~ m/\A \\o \{ ([0-7]+) \} \z/oxms) {
$char[$i] = Eutf2::octchr($1);
}
elsif ($char[$i] =~ m/\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) {
$char[$i] = Eutf2::hexchr($1);
}
elsif ($char[$i] =~ m/\A \\ ( N\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( p\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( P\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( [pPX] ) \z/oxms) {
$char[$i] = $1;
}
if (0) {
}
elsif ($char[$i] =~ m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) {
if ( ($i+3 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+3]) == 3) and (eval(sprintf '"%s%s%s%s"', @char[$i..$i+3]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 3;
}
elsif (($i+2 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+2]) == 2) and (eval(sprintf '"%s%s%s"', @char[$i..$i+2]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 2;
}
elsif (($i+1 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, $char[$i+1 ]) == 1) and (eval(sprintf '"%s%s"', @char[$i..$i+1]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 1;
}
}
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($ignorecase and ($char[$i] =~ m/\A [\x00-\xFF] \z/oxms) and (Eutf2::uc($char[$i]) ne Eutf2::fc($char[$i]))) {
if (CORE::length(Eutf2::fc($char[$i])) == 1) {
$char[$i] = '[' . Eutf2::uc($char[$i]) . Eutf2::fc($char[$i]) . ']';
}
else {
$char[$i] = '(?:' . Eutf2::uc($char[$i]) . '|' . Eutf2::fc($char[$i]) . ')';
}
}
elsif ($char[$i] =~ m/\A [<>] \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\u') {
$char[$i] = '@{[Eutf2::ucfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\l') {
$char[$i] = '@{[Eutf2::lcfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Eutf2::uc qq<';
$left_e++;
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Eutf2::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\F') {
$char[$i] = '@{[Eutf2::fc qq<';
$left_e++;
}
elsif ($char[$i] eq '\Q') {
$char[$i] = '@{[CORE::quotemeta qq<';
$left_e++;
}
elsif ($char[$i] eq '\E') {
if ($right_e < $left_e) {
$char[$i] = '>]}';
$right_e++;
}
else {
$char[$i] = '';
}
}
elsif ($char[$i] eq '\Q') {
while (1) {
if (++$i > $#char) {
last;
}
if ($char[$i] eq '\E') {
last;
}
}
}
elsif ($char[$i] eq '\E') {
}
elsif ($char[$i] =~ m/\A \$ 0 \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ (?:$qq_brace)*? \} ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::PREMATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::PREMATCH()]}';
}
}
elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::MATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::MATCH()]}';
}
}
elsif ($char[$i] =~ /\A ( \$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::POSTMATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::POSTMATCH()]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ ( \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ m/\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
elsif (($ope =~ m/\A m? \z/oxms) and ($delimiter eq '?')) {
my $char = $char[$i-1];
if ($char[$i] eq '{') {
die __FILE__, qq{: "MULTIBYTE{n}" should be "(MULTIBYTE){n}" in m?? (and shift \$1,\$2,\$3,...) ($char){n}};
}
else {
die __FILE__, qq{: "MULTIBYTE$char[$i]" should be "(MULTIBYTE)$char[$i]" in m?? (and shift \$1,\$2,\$3,...) ($char)$char[$i]};
}
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
if (($ope =~ m/\A m? \z/oxms) and ($delimiter eq '?')) {
return join '', $ope, $delimiter, $anchor, @char, '>]}' x ($left_e - $right_e), $matched, $end_delimiter, $modifier;
}
else {
return join '', $ope, $delimiter, $anchor, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier;
}
}
if (($ope =~ m/\A m? \z/oxms) and ($delimiter eq '?')) {
return join '', $ope, $delimiter, $anchor, @char, $matched, $end_delimiter, $modifier;
}
else {
return join '', $ope, $delimiter, $anchor, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
}
sub e_qr_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
elsif ($modifier =~ tr/bB//d) {
return e_qr_qb($ope,$delimiter,$end_delimiter,$string,$modifier);
}
else {
return e_qr_qt($ope,$delimiter,$end_delimiter,$string,$modifier);
}
}
sub e_qr_qt {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
my @char = $string =~ m{\G(
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
[\$\@/\\] |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] =~ m{\A [\$\@/\\] \z}oxms) {
$char[$i] = '\\' . $char[$i];
}
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($ignorecase and ($char[$i] =~ m/\A [\x00-\xFF] \z/oxms) and (Eutf2::uc($char[$i]) ne Eutf2::fc($char[$i]))) {
if (CORE::length(Eutf2::fc($char[$i])) == 1) {
$char[$i] = '[' . Eutf2::uc($char[$i]) . Eutf2::fc($char[$i]) . ']';
}
else {
$char[$i] = '(?:' . Eutf2::uc($char[$i]) . '|' . Eutf2::fc($char[$i]) . ')';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ m/\A [\x00-\xFF] \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$delimiter = '/';
$end_delimiter = '/';
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $anchor, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
sub e_qr_qb {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
my @char = $string =~ m{\G(
\\\\ |
[\$\@/\\] |
[\x00-\xFF]
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
elsif ($char[$i] eq '\\\\') {
}
elsif ($char[$i] =~ m{\A [\$\@/\\] \z}oxms) {
$char[$i] = '\\' . $char[$i];
}
}
$delimiter = '/';
$end_delimiter = '/';
return join '', $ope, $delimiter, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
sub e_s1 {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
elsif ($modifier =~ tr/bB//d) {
if ($delimiter =~ m/ [\@:] /oxms) {
my @char = $string =~ m{\G([\x00-\xFF])}oxmsg;
my %octet = map {$_ => 1} @char;
if (not $octet{')'}) {
$delimiter = '(';
$end_delimiter = ')';
}
elsif (not $octet{'}'}) {
$delimiter = '{';
$end_delimiter = '}';
}
elsif (not $octet{']'}) {
$delimiter = '[';
$end_delimiter = ']';
}
elsif (not $octet{'>'}) {
$delimiter = '<';
$end_delimiter = '>';
}
else {
for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
$delimiter = $char;
$end_delimiter = $char;
last;
}
}
}
}
my $prematch = '';
return join '', $ope, $delimiter, $prematch, '(?:', $string, ')', $matched, $end_delimiter, $modifier;
}
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
my $metachar = qr/[\@\\|[\]{^]/oxms;
my @char = $string =~ m{\G(
\\g \s* \{ \s* - \s* [1-9][0-9]* \s* \} |
\\g \s* \{ \s* [1-9][0-9]* \s* \} |
\\g \s* [1-9][0-9]* |
\\o\{ [0-7]+ \} |
\\ [1-9][0-9]* |
\\ [0-7]{2,3} |
\\x\{ [0-9A-Fa-f]+ \} |
\\x [0-9A-Fa-f]{1,2} |
\\c [\x40-\x5F] |
\\N\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\p\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\P\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\ (?:$q_char) |
\$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} |
\$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} |
\$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} |
[\$\@] $qq_variable |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\[\:\^ (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] |
\[\: (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] |
\[\^ |
\(\? |
(?:$q_char)
)}oxmsg;
if ($delimiter =~ m/ [\@:] /oxms) {
my %octet = map {$_ => 1} @char;
if (not $octet{')'}) {
$delimiter = '(';
$end_delimiter = ')';
}
elsif (not $octet{'}'}) {
$delimiter = '{';
$end_delimiter = '}';
}
elsif (not $octet{']'}) {
$delimiter = '[';
$end_delimiter = ']';
}
elsif (not $octet{'>'}) {
$delimiter = '<';
$end_delimiter = '>';
}
else {
for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
$delimiter = $char;
$end_delimiter = $char;
last;
}
}
}
}
my $parens = grep { $_ eq '(' } @char;
my $left_e = 0;
my $right_e = 0;
for (my $i=0; $i <= $#char; $i++) {
if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif ($char[$i] =~ m/\A \\o \{ ([0-7]+) \} \z/oxms) {
$char[$i] = Eutf2::octchr($1);
}
elsif ($char[$i] =~ m/\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) {
$char[$i] = Eutf2::hexchr($1);
}
elsif ($char[$i] =~ m/\A \\ ( N\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( p\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( P\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( [pPX] ) \z/oxms) {
$char[$i] = $1;
}
if (0) {
}
elsif ($char[$i] =~ m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) {
if ( ($i+3 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+3]) == 3) and (eval(sprintf '"%s%s%s%s"', @char[$i..$i+3]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 3;
}
elsif (($i+2 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+2]) == 2) and (eval(sprintf '"%s%s%s"', @char[$i..$i+2]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 2;
}
elsif (($i+1 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, $char[$i+1 ]) == 1) and (eval(sprintf '"%s%s"', @char[$i..$i+1]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 1;
}
}
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($ignorecase and ($char[$i] =~ m/\A [\x00-\xFF] \z/oxms) and (Eutf2::uc($char[$i]) ne Eutf2::fc($char[$i]))) {
if (CORE::length(Eutf2::fc($char[$i])) == 1) {
$char[$i] = '[' . Eutf2::uc($char[$i]) . Eutf2::fc($char[$i]) . ']';
}
else {
$char[$i] = '(?:' . Eutf2::uc($char[$i]) . '|' . Eutf2::fc($char[$i]) . ')';
}
}
elsif ($char[$i] =~ m/\A [<>] \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\u') {
$char[$i] = '@{[Eutf2::ucfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\l') {
$char[$i] = '@{[Eutf2::lcfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Eutf2::uc qq<';
$left_e++;
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Eutf2::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\F') {
$char[$i] = '@{[Eutf2::fc qq<';
$left_e++;
}
elsif ($char[$i] eq '\Q') {
$char[$i] = '@{[CORE::quotemeta qq<';
$left_e++;
}
elsif ($char[$i] eq '\E') {
if ($right_e < $left_e) {
$char[$i] = '>]}';
$right_e++;
}
else {
$char[$i] = '';
}
}
elsif ($char[$i] eq '\Q') {
while (1) {
if (++$i > $#char) {
last;
}
if ($char[$i] eq '\E') {
last;
}
}
}
elsif ($char[$i] eq '\E') {
}
elsif ($char[$i] =~ m/\A \\ \s* 0 \z/oxms) {
}
elsif ($char[$i] =~ m/\A \\g \s* \{ \s* - \s* ([1-9][0-9]*) \s* \} \z/oxms) {
}
elsif ($char[$i] =~ m/\A \\g \s* \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
}
elsif ($char[$i] =~ m/\A \\g \s* ([1-9][0-9]*) \z/oxms) {
}
elsif ($char[$i] =~ m/\A \\ \s* ([1-9][0-9]*) \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ 0 \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ (?:$qq_brace)*? \} ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::PREMATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::PREMATCH()]}';
}
}
elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::MATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::MATCH()]}';
}
}
elsif ($char[$i] =~ /\A ( \$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::POSTMATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::POSTMATCH()]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ ( \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ m/\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
my $prematch = '';
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
return join '', $ope, $delimiter, $prematch, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier;
}
return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
sub e_s1_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
elsif ($modifier =~ tr/bB//d) {
return e_s1_qb($ope,$delimiter,$end_delimiter,$string,$modifier);
}
else {
return e_s1_qt($ope,$delimiter,$end_delimiter,$string,$modifier);
}
}
sub e_s1_qt {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
my @char = $string =~ m{\G(
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
[\$\@/\\] |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] =~ m{\A [\$\@/\\] \z}oxms) {
$char[$i] = '\\' . $char[$i];
}
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($ignorecase and ($char[$i] =~ m/\A [\x00-\xFF] \z/oxms) and (Eutf2::uc($char[$i]) ne Eutf2::fc($char[$i]))) {
if (CORE::length(Eutf2::fc($char[$i])) == 1) {
$char[$i] = '[' . Eutf2::uc($char[$i]) . Eutf2::fc($char[$i]) . ']';
}
else {
$char[$i] = '(?:' . Eutf2::uc($char[$i]) . '|' . Eutf2::fc($char[$i]) . ')';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ m/\A [\x00-\xFF] \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
$delimiter = '/';
$end_delimiter = '/';
my $prematch = '';
return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
sub e_s1_qb {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
my @char = $string =~ m{\G(
\\\\ |
[\$\@/\\] |
[\x00-\xFF]
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
elsif ($char[$i] eq '\\\\') {
}
elsif ($char[$i] =~ m{\A [\$\@/\\] \z}oxms) {
$char[$i] = '\\' . $char[$i];
}
}
$delimiter = '/';
$end_delimiter = '/';
my $prematch = '';
return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
sub e_s2_q {
my($ope,$delimiter,$end_delimiter,$string) = @_;
$slash = 'div';
my @char = $string =~ m/ \G (\\\\|[\$\@\/\\]|$q_char) /oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
elsif ($char[$i] =~ m{\A \\\\ \z}oxms) {
}
elsif ($char[$i] =~ m{\A [\$\@/\\] \z}oxms) {
$char[$i] = '\\' . $char[$i];
}
}
return join '', $ope, $delimiter, @char, $end_delimiter;
}
sub e_sub {
my($variable,$delimiter1,$pattern,$end_delimiter1,$delimiter2,$replacement,$end_delimiter2,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
if ($variable eq '') {
$variable = '$_';
$bind_operator = ' =~ ';
}
$slash = 'div';
my $e_modifier = $modifier =~ tr/e//d;
my $r_modifier = $modifier =~ tr/r//d;
my $my = '';
if ($variable =~ s/\A \( \s* ( (?: local \b | my \b | our \b | state \b )? .+ ) \) \z/$1/oxms) {
$my = $variable;
$variable =~ s/ (?: local \b | my \b | our \b | state \b ) \s* //oxms;
$variable =~ s/ = .+ \z//oxms;
}
(my $variable_basename = $variable) =~ s/ [\[\{].* \z//oxms;
$variable_basename =~ s/ \s+ \z//oxms;
my $e_replacement = '';
if ($e_modifier >= 1) {
$e_replacement = e_qq('', '', '', $replacement);
$e_modifier--;
}
else {
if ($delimiter2 eq "'") {
$e_replacement = e_s2_q('qq', '/', '/', $replacement);
}
else {
$e_replacement = e_qq ('qq', $delimiter2, $end_delimiter2, $replacement);
}
}
my $local = '';
if ($variable_basename =~ /::/) {
$local = 'local';
}
else{
$local = 'my';
}
my $sub = '';
if ($r_modifier) {
if (0) {
}
elsif ($modifier =~ m/g/oxms) {
$sub = sprintf(
q<eval{%s %s_t=%s; while(%s_t%s%s){%s local $^W=0; %s %s_r=%s; %s%s_t="$`%s_r$'"; pos(%s_t)=length "$`%s_r"; } return %s_t}>,
$local,
$variable_basename,
$variable,
$variable_basename,
$bind_operator,
($delimiter1 eq "'") ?
e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) :
e_s1 ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),
$s_matched,
$local,
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$variable_basename,
$variable_basename,
$variable_basename,
$variable_basename,
$variable_basename,
);
}
else {
my $prematch = q{$`};
$sub = sprintf(
q<(%s%s%s) ? eval{%s local $^W=0; %s %s_r=%s; %s"%s%s_r$'" } : %s>,
$variable,
$bind_operator,
($delimiter1 eq "'") ?
e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) :
e_s1 ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),
$s_matched,
$local,
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$prematch,
$variable_basename,
$variable,
);
}
if ($bind_operator =~ m/ !~ /oxms) {
$sub = q{die("$0: Using !~ with s///r doesn't make sense"), } . $sub;
}
}
else {
if (0) {
}
elsif ($modifier =~ m/g/oxms) {
$sub = sprintf(
q<eval{%s %s_n=0; while(%s%s%s){%s local $^W=0; %s %s_r=%s; %s%s="$`%s_r$'"; pos(%s)=length "$`%s_r"; %s_n++} return %s_n}>,
$local,
$variable_basename,
$variable,
$bind_operator,
($delimiter1 eq "'") ?
e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) :
e_s1 ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),
$s_matched,
$local,
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$variable,
$variable_basename,
$variable,
$variable_basename,
$variable_basename,
$variable_basename,
);
}
else {
my $prematch = q{$`};
$sub = sprintf(
q<(%s%s%s) ? eval{%s local $^W=0; %s %s_r=%s; %s%s="%s%s_r$'"; 1 } : undef>,
$variable,
$bind_operator,
($delimiter1 eq "'") ?
e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) :
e_s1 ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),
$s_matched,
$local,
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$variable,
$prematch,
$variable_basename,
);
}
}
if ($my ne '') {
$sub = "($my, $sub)[1]";
}
$sub_variable = '';
$bind_operator = '';
return $sub;
}
sub e_split {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
if ($modifier =~ tr/bB//d) {
return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier;
}
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
my $metachar = qr/[\@\\|[\]{^]/oxms;
my @char = $string =~ m{\G(
\\o\{ [0-7]+ \} |
\\ [0-7]{2,3} |
\\x\{ [0-9A-Fa-f]+ \} |
\\x [0-9A-Fa-f]{1,2} |
\\c [\x40-\x5F] |
\\N\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\p\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\P\{ [^\x80-\xFF0-9\}][^\x80-\xFF\}]* \} |
\\ (?:$q_char) |
\$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} |
\$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} |
\$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} |
[\$\@] $qq_variable |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\[\:\^ (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] |
\[\: (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] |
\[\^ |
\(\? |
(?:$q_char)
)}oxmsg;
my $left_e = 0;
my $right_e = 0;
for (my $i=0; $i <= $#char; $i++) {
if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
elsif ($char[$i] =~ m/\A \\o \{ ([0-7]+) \} \z/oxms) {
$char[$i] = Eutf2::octchr($1);
}
elsif ($char[$i] =~ m/\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) {
$char[$i] = Eutf2::hexchr($1);
}
elsif ($char[$i] =~ m/\A \\ ( N\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( p\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( P\{ ([^\x80-\xFF0-9\}][^\x80-\xFF\}]*) \} ) \z/oxms) {
$char[$i] = $1;
}
elsif ($char[$i] =~ m/\A \\ ( [pPX] ) \z/oxms) {
$char[$i] = $1;
}
if (0) {
}
elsif ($char[$i] =~ m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) {
if ( ($i+3 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+3]) == 3) and (eval(sprintf '"%s%s%s%s"', @char[$i..$i+3]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 3;
}
elsif (($i+2 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+2]) == 2) and (eval(sprintf '"%s%s%s"', @char[$i..$i+2]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 2;
}
elsif (($i+1 <= $#char) and (grep(m/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, $char[$i+1 ]) == 1) and (eval(sprintf '"%s%s"', @char[$i..$i+1]) =~ m/\A $q_char \z/oxms)) {
$char[$i] .= join '', splice @char, $i+1, 1;
}
}
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif (($char[$i] eq '^') and ($modifier !~ m/m/oxms)) {
$modifier .= 'm';
}
elsif ($ignorecase and ($char[$i] =~ m/\A [\x00-\xFF] \z/oxms) and (Eutf2::uc($char[$i]) ne Eutf2::fc($char[$i]))) {
if (CORE::length(Eutf2::fc($char[$i])) == 1) {
$char[$i] = '[' . Eutf2::uc($char[$i]) . Eutf2::fc($char[$i]) . ']';
}
else {
$char[$i] = '(?:' . Eutf2::uc($char[$i]) . '|' . Eutf2::fc($char[$i]) . ')';
}
}
elsif ($char[$i] =~ m/\A ([<>]) \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\u') {
$char[$i] = '@{[Eutf2::ucfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\l') {
$char[$i] = '@{[Eutf2::lcfirst qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Eutf2::uc qq<';
$left_e++;
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Eutf2::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\F') {
$char[$i] = '@{[Eutf2::fc qq<';
$left_e++;
}
elsif ($char[$i] eq '\Q') {
$char[$i] = '@{[CORE::quotemeta qq<';
$left_e++;
}
elsif ($char[$i] eq '\E') {
if ($right_e < $left_e) {
$char[$i] = '>]}';
$right_e++;
}
else {
$char[$i] = '';
}
}
elsif ($char[$i] eq '\Q') {
while (1) {
if (++$i > $#char) {
last;
}
if ($char[$i] eq '\E') {
last;
}
}
}
elsif ($char[$i] eq '\E') {
}
elsif ($char[$i] =~ m/\A \$ 0 \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ (?:$qq_brace)*? \} ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ \s* PREMATCH | \$ \s* \{ \s* PREMATCH \s* \} | \$ \s* \{\^PREMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::PREMATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::PREMATCH()]}';
}
}
elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ \s* MATCH | \$ \s* \{ \s* MATCH \s* \} | \$ \s* \{\^MATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::MATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::MATCH()]}';
}
}
elsif ($char[$i] =~ /\A ( \$ \s* POSTMATCH | \$ \s* \{ \s* POSTMATCH \s* \} | \$ \s* \{\^POSTMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(Eutf2::POSTMATCH())]}';
}
else {
$char[$i] = '@{[Eutf2::POSTMATCH()]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ ( \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $1 . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
if ($ignorecase) {
$char[$i] = '@{[Eutf2::ignorecase(' . $char[$i] . ')]}';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ m/\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
return join '', 'Eutf2::split', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter, $modifier;
}
return join '', 'Eutf2::split', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
sub e_split_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ m/([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
if ($modifier =~ tr/bB//d) {
return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier;
}
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
my @char = $string =~ m{\G(
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Eutf2::charlist_not_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif (my $char = character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif (($char[$i] eq '^') and ($modifier !~ m/m/oxms)) {
$modifier .= 'm';
}
elsif ($ignorecase and ($char[$i] =~ m/\A [\x00-\xFF] \z/oxms) and (Eutf2::uc($char[$i]) ne Eutf2::fc($char[$i]))) {
if (CORE::length(Eutf2::fc($char[$i])) == 1) {
$char[$i] = '[' . Eutf2::uc($char[$i]) . Eutf2::fc($char[$i]) . ']';
}
else {
$char[$i] = '(?:' . Eutf2::uc($char[$i]) . '|' . Eutf2::fc($char[$i]) . ')';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ m/\A [\x00-\xFF] \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
return join '', 'Eutf2::split', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
1;