use 5.00503;
BEGIN { eval q{ use vars qw($VERSION $_warning) } }
$VERSION = sprintf '%d.%02d', q$Revision: 0.63 $ =~ 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 {
eval { require strict ; 'strict' ->import; };
}
sub LOCK_SH() {1}
sub LOCK_EX() {2}
sub LOCK_UN() {8}
sub LOCK_NB() {4}
$_warning = $^W;
local $^W = 1;
$| = 1;
BEGIN {
if ($^X =~ m/ jperl /oxmsi) {
die __FILE__, ": need perl(not jperl) 5.00503 or later. (\$^X==$^X)";
}
}
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 $your_gap = '';
$your_gap = q{\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]|[\x00-\x7F])*?};
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]+ |
[^a-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 $m_matched = '';
my $s_matched = '';
$m_matched = q{@Eutf2::m_matched};
$s_matched = q{@Eutf2::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
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__ = __PACKAGE__;
my $__FILE__ = __FILE__;
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 (exists $ENV{'SJIS_DEBUG'}) {
unlink "$filename.e";
}
my $e_mtime = (stat("$filename.e"))[9];
my $mtime = (stat($filename))[9];
my $__mtime__ = (stat($__FILE__))[9];
if ((not -e("$filename.e")) or ($e_mtime < $mtime) or ($mtime < $__mtime__)) {
my $fh = gensym();
open($fh, ">$filename.e") or die "$__FILE__: Can't write open file: $filename.e";
if (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) };
}
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 (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) };
}
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
exit system map {m/ $your_gap [ ] /oxms ? qq{"$_"} : $_} $^X, "$filename.e", @ARGV;
}
else {
exit system map { escapeshellcmd($_) } $^X, "$filename.e", @ARGV;
}
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* ([^;]*) ; \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 ( \$ $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 '${Eutf2::capture(' . $1 . ')}';
}
elsif (/\G \$ \{ \s* ([1-9][0-9]*) \s* \} /oxmsgc) {
$slash = 'div';
return '${Eutf2::capture(' . $1 . ')}';
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ .+? \] ) /oxmsgc) {
$slash = 'div';
return '${Eutf2::capture(' . $1 . '->' . $2 . ')}';
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ .+? \} ) /oxmsgc) {
$slash = 'div';
return '${Eutf2::capture(' . $1 . '->' . $2 . ')}';
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) /oxmsgc) {
$slash = 'div';
return '${Eutf2::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 '${Eutf2::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]|[^>\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::(?:split|chop|index|rindex|lc|uc|chr|ord|reverse|open|binmode)) \b }oxgc) { $slash = 'm//'; return $1; }
elsif (m{\G \b chop \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::chop'; }
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 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 chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Eutf2::chr'; }
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 chr \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Eutf2::chr_'; }
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 = 'Eutf2::split';
while (/\G ( \s+ | \( | \
$e .= $1;
}
if (/\G (?= [,;\)\}\]] ) /oxgc) { return $e; }
elsif (/\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { return $e . e_string($1); }
elsif (/\G \b qq (\
elsif (/\G \b qq (\s*) (\() [ ] (\)) /oxgc) { return $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\{) [ ] (\}) /oxgc) { return $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\[) [ ] (\]) /oxgc) { return $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\<) [ ] (\>) /oxgc) { return $e . qq{$1qq$2 $3}; }
elsif (/\G \b qq (\s*) (\S) [ ] (\2) /oxgc) { return $e . qq{$1qq$2 $3}; }
elsif (/\G \b q (\
elsif (/\G \b q (\s*) (\() [ ] (\)) /oxgc) { return $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\{) [ ] (\}) /oxgc) { return $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\[) [ ] (\]) /oxgc) { return $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\<) [ ] (\>) /oxgc) { return $e . qq {$1q$2 $3}; }
elsif (/\G \b q (\s*) (\S) [ ] (\2) /oxgc) { return $e . qq {$1q$2 $3}; }
elsif (/\G ' [ ] ' /oxgc) { return $e . qq {' '}; }
elsif (/\G " [ ] " /oxgc) { return $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 . e_split('qr',$1,$3,$2,''); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { return $e . e_split('qr',$1,$3,$2,''); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_split('qr',$1,$3,$2,''); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { return $e . e_split('qr',$1,$3,$2,''); }
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) /oxgc) { return $e . e_split('qr','{','}',$2,''); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { return $e . e_split('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)*?) (\)) ([imosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([imosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([imosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([imosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([imosxp]*) /oxgc) { return $e . e_split_q('qr',$1, $3, $2,$4); } # qr ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([imosxp]*) /oxgc) { return $e . e_split ('qr','{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([imosxp]*) /oxgc) { return $e . e_split ('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 . e_split_q('qr',$1,$3,$2,''); }
elsif (/\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?) (\}) /oxgc) { return $e . e_split_q('qr',$1,$3,$2,''); }
elsif (/\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { return $e . e_split_q('qr',$1,$3,$2,''); }
elsif (/\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?) (\>) /oxgc) { return $e . e_split_q('qr',$1,$3,$2,''); }
elsif (/\G ([*\-:?\\^|]) ((?:$q_char)*?) (\1) /oxgc) { return $e . e_split_q('qr','{','}',$2,''); }
elsif (/\G (\S) ((?:\\\\|\\\1| $q_char)*?) (\1) /oxgc) { return $e . e_split_q('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)*?) (\)) ([cgimosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cgimosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cgimosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cgimosxp]*) /oxgc) { return $e . e_split ('qr',$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cgimosxp]*) /oxgc) { return $e . e_split_q('qr',$1, $3, $2,$4); } # m ' ' --> qr ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([cgimosxp]*) /oxgc) { return $e . e_split ('qr','{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cgimosxp]*) /oxgc) { return $e . e_split ('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 . e_split_q(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 . e_split(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 \/ ([cgimosxp]*) /oxgc) { return $e . e_split(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)*?) (\)) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsbB]*) /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)*?) (\)) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsbB]*) /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)*?) (\)) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsbB]*) /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)*?) (\)) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cdsbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); }
}
die "$__FILE__: Transliteration replacement not terminated";
}
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cdsbB]*) /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)*?) (\)) ([imosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([imosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([imosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([imosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([imosxp]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # qr ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([imosxp]*) /oxgc) { return $e . e_qr ($ope,'{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([imosxp]*) /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)*?) (\)) ([cgimosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cgimosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cgimosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cgimosxp]*) /oxgc) { return $e . e_qr ($ope,$1, $3, $2,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cgimosxp]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # m ' '
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([cgimosxp]*) /oxgc) { return $e . e_qr ($ope,'{','}',$2,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cgimosxp]*) /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)*?) (\)) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\:) ((?:$qq_char)*?) (\:) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\@) ((?:$qq_char)*?) (\@) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /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)*?) (\)) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\:) ((?:$qq_char)*?) (\:) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\@) ((?:$qq_char)*?) (\@) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /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)*?) (\)) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /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)*?) (\)) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\{) ((?:$qq_brace)*?) (\}) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\<) ((?:$qq_angle)*?) (\>) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\') ((?:$qq_char)*?) (\') ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\$) ((?:$qq_char)*?) (\$) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\:) ((?:$qq_char)*?) (\:) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\@) ((?:$qq_char)*?) (\@) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); }
}
die "$__FILE__: Substitution replacement not terminated";
}
elsif (/\G (\') ((?:$qq_char)*?) (\') ((?:$qq_char)*?) (\') ([cegimosxp]*) /oxgc) {
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /oxgc) {
return e_sub($sub_variable,'{',$2,'}','{',$4,'}',$6);
}
elsif (/\G (\$) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /oxgc) {
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxp]*) /oxgc) {
return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6);
}
}
die "$__FILE__: Substitution pattern not terminated";
}
}
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 \/ ([cgimosxp]*) /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 \? ([cgimosxp]*) /oxgc) { return e_qr('', '?','?',$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]|[^>\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 ($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 .= '${Eutf2::capture(' . $1 . ')}';
$slash = 'div';
}
elsif ($string =~ /\G \$ \{ \s* ([1-9][0-9]*) \s* \} /oxmsgc) {
$e_string .= '${Eutf2::capture(' . $1 . ')}';
$slash = 'div';
}
elsif ($string =~ /\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ .+? \] ) /oxmsgc) {
$e_string .= '${Eutf2::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 .= '${Eutf2::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 .= '${Eutf2::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 .= '${Eutf2::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::(?:split|chop|index|rindex|lc|uc|chr|ord|reverse|open|binmode)) \b }oxgc) { $e_string .= $1; $slash = 'm//'; }
elsif ($string =~ m{\G \b chop \b }oxgc) { $e_string .= 'Eutf2::chop'; $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 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 chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Eutf2::chr'; $slash = 'm//'; }
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 chr \b }oxgc) { $e_string .= 'Eutf2::chr_'; $slash = 'm//'; }
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_string = 'Eutf2::split';
while ($string =~ /\G ( \s+ | \( | \
$e_string .= $1;
}
if ($string =~ /\G (?= [,;\)\}\]] ) /oxgc) { return $e_string; }
elsif ($string =~ /\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { $e_string .= e_string($1); next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\
elsif ($string =~ /\G \b qq (\s*) (\() [ ] (\)) /oxgc) { $e_string .= qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\{) [ ] (\}) /oxgc) { $e_string .= qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\[) [ ] (\]) /oxgc) { $e_string .= qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\<) [ ] (\>) /oxgc) { $e_string .= qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b qq (\s*) (\S) [ ] (\2) /oxgc) { $e_string .= qq{$1qq$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\
elsif ($string =~ /\G \b q (\s*) (\() [ ] (\)) /oxgc) { $e_string .= qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\{) [ ] (\}) /oxgc) { $e_string .= qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\[) [ ] (\]) /oxgc) { $e_string .= qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\<) [ ] (\>) /oxgc) { $e_string .= qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G \b q (\s*) (\S) [ ] (\2) /oxgc) { $e_string .= qq {$1q$2 $3}; next E_STRING_LOOP; }
elsif ($string =~ /\G ' [ ] ' /oxgc) { $e_string .= qq {' '}; next E_STRING_LOOP; }
elsif ($string =~ /\G " [ ] " /oxgc) { $e_string .= 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('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { $e_string .= e_split('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= e_split('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { $e_string .= e_split('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) /oxgc) { $e_string .= e_split('qr','{','}',$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { $e_string .= e_split('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)*?) (\)) ([imosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) ([imosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) ([imosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) ([imosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\') ((?:$qq_char)*?) (\') ([imosxp]*) /oxgc) { $e_string .= e_split_q('qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr ' '
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([imosxp]*) /oxgc) { $e_string .= e_split ('qr','{','}',$2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) ([imosxp]*) /oxgc) { $e_string .= e_split ('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('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?) (\}) /oxgc) { $e_string .= e_split_q('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= e_split_q('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?) (\>) /oxgc) { $e_string .= e_split_q('qr',$1,$3,$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$q_char)*?) (\1) /oxgc) { $e_string .= e_split_q('qr','{','}',$2,''); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:\\\\|\\\1| $q_char)*?) (\1) /oxgc) { $e_string .= e_split_q('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)*?) (\)) ([cgimosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\{) ((?:$qq_brace)*?) (\}) ([cgimosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) ([cgimosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\<) ((?:$qq_angle)*?) (\>) ([cgimosxp]*) /oxgc) { $e_string .= e_split ('qr',$1, $3, $2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\') ((?:$qq_char)*?) (\') ([cgimosxp]*) /oxgc) { $e_string .= e_split_q('qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m ' ' --> qr ' '
elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ([cgimosxp]*) /oxgc) { $e_string .= e_split ('qr','{','}',$2,$4); next E_STRING_LOOP; }
elsif ($string =~ /\G (\S) ((?:$qq_char)*?) (\1) ([cgimosxp]*) /oxgc) { $e_string .= e_split ('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(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(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 \/ ([cgimosxp]*) /oxgc) { $e_string .= e_split(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 classic_character_class {
my($char,$modifier) = @_;
return {
'.' => ($modifier =~ /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]|[\x00-\xFF])' :
'(?:(?:[\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]|[^\x0A])',
'\D' => '(?:(?:[\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]|[^0-9])',
'\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]|[^\x09\x0A\x0C\x0D\x20])',
'\W' => '(?:(?:[\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]|[^0-9A-Z_a-z])',
'\d' => '[0-9]',
'\s' => '[\x09\x0A\x0C\x0D\x20]',
'\w' => '[0-9A-Z_a-z]',
'\H' => '(?:(?:[\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]|[^\x09\x20])',
'\V' => '(?:(?:[\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]|[^\x0C\x0A\x0D])',
'\h' => '[\x09\x20]',
'\v' => '[\x0C\x0A\x0D]',
'\b' => '(?:\A(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[0-9A-Z_a-z])|(?<=[0-9A-Z_a-z])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]|\z))',
'\B' => '(?:(?<=[0-9A-Z_a-z])(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]))',
}->{$char};
}
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 @char = $string =~ m{ \G (
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\\?(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::capture(' . $1 . ')}';
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
}
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 @char = $string =~ m{ \G (
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\\?(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::capture(' . $1 . ')}';
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
}
return join '', @char;
}
sub e_qr {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$slash = 'div';
my $metachar = qr/[\@\\|[\]{^]/oxms;
my @char = $string =~ m{\G(
\\ [0-7]{2,3} |
\\x [0-9A-Fa-f]{1,2} |
\\c [\x40-\x5F] |
\\ (?:$q_char) |
[\$\@] $qq_variable |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\(\? |
(?:$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;
}
}
}
}
for (my $i=0; $i <= $#char; $i++) {
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 = classic_character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($char[$i] =~ m/\A [A-Za-z] \z/oxms) {
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::capture(' . $1 . ')}';
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if (CORE::length($char[$i-1]) == 1) {
}
elsif ($char[$i-1] =~ m/\A (?:\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
return join '', $ope, $delimiter, "$your_gap(?:", @char, ')', $m_matched, $end_delimiter, $modifier;
}
sub e_qr_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$slash = 'div';
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 = classic_character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($char[$i] =~ m/\A [A-Za-z] \z/oxms) {
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if (CORE::length($char[$i-1]) == 1) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$delimiter = '/';
$end_delimiter = '/';
return join '', $ope, $delimiter, "$your_gap(?:", @char, ')', $m_matched, $end_delimiter, $modifier;
}
sub e_s1 {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$slash = 'div';
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]* |
\\ [1-9][0-9]* |
\\ [0-7]{2,3} |
\\x [0-9A-Fa-f]{1,2} |
\\c [\x40-\x5F] |
\\ (?:$q_char) |
[\$\@] $qq_variable |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\(\? |
(?:$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;
for (my $i=0; $i <= $#char; $i++) {
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 = classic_character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($char[$i] =~ m/\A [A-Za-z] \z/oxms) {
}
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) {
if ($1 <= $parens) {
$char[$i] = '\\g{' . ($1 + 1) . '}';
}
}
elsif ($char[$i] =~ m/\A \\g \s* ([1-9][0-9]*) \z/oxms) {
if ($1 <= $parens) {
$char[$i] = '\\g' . ($1 + 1);
}
}
elsif ($char[$i] =~ m/\A \\ \s* ([1-9][0-9]*) \z/oxms) {
if ($1 <= $parens) {
$char[$i] = '\\' . ($1 + 1);
}
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::capture(' . $1 . ')}';
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if (CORE::length($char[$i-1]) == 1) {
}
elsif ($char[$i-1] =~ m/\A (?:\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
my $capture_your_gap = '';
$capture_your_gap = "($your_gap)";
return join '', $ope, $delimiter, $capture_your_gap, '(?:', @char, ')', $s_matched, $end_delimiter, $modifier;
}
sub e_s1_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$slash = 'div';
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 = classic_character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif ($char[$i] =~ m/\A [A-Za-z] \z/oxms) {
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if (CORE::length($char[$i-1]) == 1) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$delimiter = '/';
$end_delimiter = '/';
my $capture_your_gap = '';
$capture_your_gap = "($your_gap)";
return join '', $ope, $delimiter, $capture_your_gap, '(?:', @char, ')', $s_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) {
$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 ||= '';
if ($variable eq '') {
$variable = '$_';
$bind_operator = ' =~ ';
}
$slash = 'div';
my $e_modifier = $modifier =~ tr/e//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 $q_replacement = '';
if ($delimiter2 eq "'") {
$q_replacement = e_s2_q('qq', '/', '/', $replacement);
}
else {
$q_replacement = e_qq ('qq', $delimiter2, $end_delimiter2, $replacement);
}
my $e_replacement = '';
if ($q_replacement !~ m/'/oxms) {
$e_replacement = e_q('', "'", "'", $q_replacement);
}
elsif ($q_replacement !~ m{/}oxms) {
$e_replacement = e_q('q', '/', '/', $q_replacement);
}
elsif ($q_replacement !~ m/\
$e_replacement = e_q('q', '#', '#', $q_replacement); # --> q# #
}
elsif ($q_replacement !~ m/[\<\>]/oxms) {
$e_replacement = e_q('q', '<', '>', $q_replacement);
}
elsif ($q_replacement !~ m/[\(\)]/oxms) {
$e_replacement = e_q('q', '(', ')', $q_replacement);
}
elsif ($q_replacement !~ m/[\{\}]/oxms) {
$e_replacement = e_q('q', '{', '}', $q_replacement);
}
else {
for my $char (qw( ! " $ % & * + . : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if ($q_replacement !~ m/\Q$char\E/xms) {
$e_replacement = e_q('q', $char, $char, $q_replacement);
last;
}
}
}
my $local = '';
if ($variable_basename =~ /::/) {
$local = 'local';
}
else{
$local = 'my';
}
my $sub;
if ($modifier =~ m/g/oxms) {
my $prematch = q{1};
$sub = sprintf(
q<eval{%s %s_n=0; %s %s_a=''; while(%s%s%s){%s %s_r=eval %s; %s%s="%s_a${%s}%s_r$'"; pos(%s)=length "%s_a${%s}%s_r"; %s_a=substr(%s,0,pos(%s)); %s_n++} %s_n}>,
$local,
$variable_basename,
$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),
$local,
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$variable,
$variable_basename,
$prematch,
$variable_basename,
$variable,
$variable_basename,
$prematch,
$variable_basename,
$variable_basename,
$variable,
$variable,
$variable_basename,
$variable_basename,
);
}
else {
my $prematch = q{`};
$prematch = q{1};
$sub = sprintf(
q<(%s%s%s) ? eval{%s %s_r=eval %s; %s%s="${%s}%s_r$'"; 1 } : ''>,
$variable,
$bind_operator,
($delimiter1 eq "'") ?
e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) :
e_s1 ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),
$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 ||= '';
$slash = 'div';
my $metachar = qr/[\@\\|[\]{^]/oxms;
my @char = $string =~ m{\G(
\\ [0-7]{2,3} |
\\x [0-9A-Fa-f]{1,2} |
\\c [\x40-\x5F] |
\\ (?:$q_char) |
[\$\@] $qq_variable |
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\(\? |
(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
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 = classic_character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif (($char[$i] eq '^') and ($modifier !~ m/m/oxms)) {
$modifier .= 'm';
}
elsif ($char[$i] =~ m/\A ([A-Za-z]) \z/oxms) {
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::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] = '${Eutf2::capture(' . $1 . ')}';
}
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] = '${Eutf2::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if (CORE::length($char[$i-1]) == 1) {
}
elsif ($char[$i-1] =~ m/\A (?:\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
return join '', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
sub e_split_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$slash = 'div';
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 = classic_character_class($char[$i],$modifier)) {
$char[$i] = $char;
}
elsif (($char[$i] eq '^') and ($modifier !~ m/m/oxms)) {
$modifier .= 'm';
}
elsif ($char[$i] =~ m/\A ([A-Za-z]) \z/oxms) {
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if (CORE::length($char[$i-1]) == 1) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
return join '', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
1;
Hide Show 837 lines of Pod