use 5.00503;
$VERSION = sprintf '%d.%02d', q$Revision: 0.45 $ =~ m/(\d+)/oxmsg;
use Carp qw(carp croak confess cluck verbose);local $SIG{__DIE__} = sub { confess @_ } if exists $ENV{'SJIS_DEBUG'};
local $SIG{__WARN__} = sub { cluck @_ } if exists $ENV{'SJIS_DEBUG'};
local $^W = 1;
$| = 1;
BEGIN {
if ($^X =~ m/ jperl /oxmsi) {
croak __FILE__, ": need perl(not jperl) 5.00503 or later. (\$^X==$^X)";
}
}
sub import() {}
sub unimport() {}
sub INFOMIXV6ALS::escape_script;
my $your_char = q{\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[\x00-\xFF]};
my $qq_char = qr/\\c[\x40-\x5F]|\\?(?:$your_char)/oxms;
my $q_char = qr/$your_char/oxms;
my $your_gap = q{\G(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x81-\x9F\xE0-\xFD])*?};
my $qq_paren = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] | \\? \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] | \\ [\x00-\xFF] |
[^()] |
\( (?{$nest++}) |
\) (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_brace = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] | \\? \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] | \\ [\x00-\xFF] |
[^{}] |
\{ (?{$nest++}) |
\} (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_bracket = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] | \\? \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] | \\ [\x00-\xFF] |
[^[\]] |
\[ (?{$nest++}) |
\] (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $qq_angle = qr{(?{local $nest=0}) (?>(?:
\\c[\x40-\x5F] | \\? \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\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}) (?>(?:
\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] |
[^()] |
\( (?{$nest++}) |
\) (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $q_brace = qr{(?{local $nest=0}) (?>(?:
\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] |
[^{}] |
\{ (?{$nest++}) |
\} (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $q_bracket = qr{(?{local $nest=0}) (?>(?:
\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] |
[^[\]] |
\[ (?{$nest++}) |
\] (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $q_angle = qr{(?{local $nest=0}) (?>(?:
\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF] |
[^<>] |
\< (?{$nest++}) |
\> (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!))
}xms;
my $tr_variable = '';
my $sub_variable = '';
my $bind_operator = '';
my %heredoc = ();
my $heredoc_qq = 0;
my $function_ord;
my $function_ord_;
my $function_reverse;
my $ignore_modules = join('|', qw(
utf8
I18N::Japanese
I18N::Collate
));
my $standard_modules = join('|', qw(
AnyDBM_File
Attribute::Handlers
attributes
attrs
AutoLoader
AutoSplit
autouse
B
B::Asmdata
B::Assembler
B::Bblock
B::Bytecode
B::C
B::CC
B::Concise
B::Debug
B::Deparse
B::Disassembler
B::Lint
B::Showlex
B::Stackobj
B::Terse
B::Xref
base
Benchmark
bigint
bignum
bigrat
blib
bytes
ByteLoader
Carp
CGI
CGI::Apache
CGI::Carp
CGI::Cookie
CGI::Fast
CGI::Pretty
CGI::Push
CGI::Switch
charnames
Class::ISA
Class::Struct
Config
constant
CPAN
CPAN::FirstTime
CPAN::Nox
Cwd
Data::Dumper
DB
DB_File
Devel::DProf
Devel::PPPort
Devel::SelfStubber
diagnostics
Digest
Digest::MD5
DirHandle
Dumpvalue
DynaLoader
encoding
English
Env
Errno
Exporter
ExtUtils::Command
ExtUtils::Command::MM
ExtUtils::Constant
ExtUtils::Embed
ExtUtils::Install
ExtUtils::Installed
ExtUtils::Liblist
ExtUtils::MakeMaker
ExtUtils::Manifest
ExtUtils::Miniperl
ExtUtils::Mkbootstrap
ExtUtils::Mksymlists
ExtUtils::MM
ExtUtils::MM_Any
ExtUtils::MM_BeOS
ExtUtils::MM_DOS
ExtUtils::MM_NW5
ExtUtils::MM_OS2
ExtUtils::MM_Unix
ExtUtils::MM_UWIN
ExtUtils::MM_VMS
ExtUtils::MM_Win32
ExtUtils::MY
ExtUtils::Packlist
ExtUtils::testlib
Fatal
Fcntl
fields
File::Basename
File::CheckTree
File::Compare
File::Copy
File::DosGlob
File::Find
File::Path
File::Spec
File::Spec::Cygwin
File::Spec::Mac
File::Spec::OS2
File::Spec::Unix
File::Spec::VMS
File::Spec::Win32
File::stat
File::Temp
FileCache
FileHandle
Filter::Simple
Filter::Util::Call
FindBin
GDBM_File
Getopt::Long
Getopt::Std
Hash::Util
I18N::Collate
I18N::Langinfo
I18N::LangTags
I18N::LangTags::List
if
integer
IO
IO::File
IO::Handle
IO::Pipe
IO::Seekable
IO::Select
IO::Socket
IPC::Msg
IPC::Open2
IPC::Open3
IPC::Semaphore
IPC::SysV
less
lib
List::Util
locale
Math::BigFloat
Math::BigInt
Math::BigInt::Calc
Math::BigRat
Math::Complex
Math::Trig
MIME::Base64
MIME::QuotedPrint
NDBM_File
Net::Cmd
Net::Config
Net::Domain
Net::FTP
Net::hostent
Net::netent
Net::Netrc
Net::NNTP
Net::Ping
Net::POP3
Net::protoent
Net::servent
Net::SMTP
Net::Time
O
ODBM_File
Opcode
ops
overload
PerlIO
PerlIO::Scalar
PerlIO::Via
Pod::Functions
Pod::Html
Pod::ParseLink
Pod::Text
POSIX
re
Safe
Scalar::Util
SDBM_File
Search::Dict
SelectSaver
SelfLoader
Shell
sigtrap
Socket
sort
Storable
strict
subs
Switch
Symbol
Sys::Hostname
Sys::Syslog
Term::Cap
Term::Complete
Term::ReadLine
Test
Test::Builder
Test::Harness
Test::More
Test::Simple
Text::Abbrev
Text::Balanced
Text::ParseWords
Text::Soundex
Text::Tabs
Text::Wrap
Thread
Thread::Queue
Thread::Semaphore
Thread::Signal
Thread::Specific
Tie::Array
Tie::StdArray
Tie::File
Tie::Handle
Tie::Hash
Tie::Memoize
Tie::RefHash
Tie::Scalar
Tie::SubstrHash
Time::gmtime
Time::HiRes
Time::Local
Time::localtime
Time::tm
UNIVERSAL
User::grent
User::pwent
utf8
vars
vmsish
XS::Typemap
));
if ($0 eq __FILE__) {
unless (@ARGV) {
die <<END;
$0: usage
perl $0 INFOMIX V6 ALS_script.pl > Escaped_script.pl.e
END
}
print INFOMIXV6ALS::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') {
croak <<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'}) {
Einfomixv6als::unlink "$filename.e";
}
my $e_script = '';
my $e_mtime = (Einfomixv6als::stat("$filename.e"))[9];
my $mtime = (Einfomixv6als::stat($filename))[9];
my $__mtime__ = (Einfomixv6als::stat($__FILE__))[9];
if ((not Einfomixv6als::e("$filename.e")) or ($e_mtime < $mtime) or ($mtime < $__mtime__)) {
my $fh = Symbol::gensym();
sysopen($fh, "$filename.e", O_WRONLY | O_TRUNC | O_CREAT) or croak "$__FILE__: Can't open file: $filename.e";
print {$fh} INFOMIXV6ALS::escape_script($filename);
close($fh) or croak "$__FILE__: Can't close file: $filename.e";
}
local @ENV{qw(IFS CDPATH ENV BASH_ENV)};
exit system map {m/ $your_gap [ ] /oxms ? qq{"$_"} : $_} $^X, "$filename.e", @ARGV;
sub INFOMIXV6ALS::escape_script {
my($script) = @_;
my $e_script = '';
my $fh = Symbol::gensym();
sysopen($fh, $script, O_RDONLY) or croak "$__FILE__: Can't open file: $script";
local $/ = undef;
$_ = <$fh>;
close($fh) or croak "$__FILE__: Can't close file: $script";
return $_;
}
else {
if (s/\A(
my $head = $1;
$head =~ s/\bjperl\b/perl/gi;
$e_script .= $head;
}
if (m/(.*
my $head = $1;
$head =~ s/\bjperl\b/perl/gi;
$e_script .= $head;
}
$e_script .= sprintf(<<'END', $Einfomixv6als::VERSION); # require run-time routines version
use Einfomixv6als %s;
use re 'eval';
END
$function_ord = 'ord';
$function_ord_ = 'ord';
$function_reverse = 'reverse';
if (s/^ \s* use \s+ INFOMIXV6ALS \s* ([^;]*) ; \s* \n? $//oxms) {
my $list = $1;
if ($list =~ s/\A ([0-9]+(?:\.[0-9]*)) \s* //oxms) {
my $version = $1;
if ($version > $VERSION) {
croak "$__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 = 'INFOMIXV6ALS::ord' if m/\A ord \z/oxms;
$function_ord_ = 'INFOMIXV6ALS::ord_' if m/\A ord \z/oxms;
$function_reverse = 'INFOMIXV6ALS::reverse' if m/\A reverse \z/oxms;
}
}
}
}
my $tkmodule = '';
for my $widget (qw(
Button
Canvas
Checkbutton
Entry
Frame
Label
Listbox
MainWindow
Message
Menu
Menubutton
Radiobutton
Scale
Text
Toplevel
)) {
if (m/ $widget /xms) {
$tkmodule .= " eval qq{ use INFOMIXV6ALS::Tk::$widget; };\n";
}
}
my $use_tk = <<"USE_TK";
BEGIN {
eval qq{ use INFOMIXV6ALS::Encode; };
if (\$] >= 5.007) {
$tkmodule
}
else {
eval qq{ use INFOMIXV6ALS::Tk::Entry55; };
eval qq{ use INFOMIXV6ALS::Tk::MainWindow; };
}
}
USE_TK
if (s/^ (\s* use \s+ Tk [^:;]* ; \s*? \n) /$1$use_tk/oxmsg) {
s/ \b (MainWindow \s* -> \s* new) \b /INFOMIXV6ALS::Tk::$1/oxmsg;
s/^ (\s* use \s+ )(Tk::(?:Ballon|BrowseEntry|ColorEditor|Dialog|DialogBox|DirTree|FileSelect|HList|ROText|Table|TixGrid|TList|Tree) [^:;]* ; \s*? ) \n /BEGIN { eval qq{ $1$2 ${1}INFOMIXV6ALS::${2} }};\n/oxmsg;
s/^ (\s* use \s+ )(Tk::(?:LabFrame) [^:;]*) ; \s*? \n /BEGIN { eval qq{ $1$2; ${1}INFOMIXV6ALS::${2}55; }};\n/oxmsg;
}
$slash = 'm//';
study $_;
while (not /\G \z/oxgc) {
$e_script .= escape();
}
return $e_script;
}
sub escape {
if (/\G ( \n ) /oxgc) {
my $heredoc = '';
if (scalar(keys %heredoc) >= 1) {
$slash = 'm//';
my($longest_heredoc_delimiter) = sort { CORE::length($heredoc{$b}) <=> CORE::length($heredoc{$a}) } keys %heredoc;
if ($heredoc_qq >= 1) {
$heredoc = e_heredoc($heredoc{$longest_heredoc_delimiter});
}
else {
$heredoc = $heredoc{$longest_heredoc_delimiter};
}
/\G .*? \n $longest_heredoc_delimiter \n/xmsgc;
%heredoc = ();
$heredoc_qq = 0;
}
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 '${Einfomixv6als::capture(' . $1 . ')}';
}
elsif (/\G \$ \{ \s* ([1-9][0-9]*) \s* \} /oxmsgc) {
$slash = 'div';
return '${Einfomixv6als::capture(' . $1 . ')}';
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ .+? \] ) /oxmsgc) {
$slash = 'div';
return '${Einfomixv6als::capture(' . $1 . '->' . $2 . ')}';
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \{ .+? \} ) /oxmsgc) {
$slash = 'div';
return '${Einfomixv6als::capture(' . $1 . '->' . $2 . ')}';
}
elsif (/\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) /oxmsgc) {
$slash = 'div';
return '${Einfomixv6als::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 '${Einfomixv6als::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* < ((?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^>\0\a\e\f\n\r\t])+?) > \s* \) \b /oxgc) {
return 'while ($_ = Einfomixv6als::glob("' . $1 . '"))';
}
elsif (/\G \b while \s* \( \s* glob \s* \) /oxgc) {
return 'while ($_ = Einfomixv6als::glob_)';
}
elsif (/\G \b while \s* \( \s* glob \b /oxgc) {
return 'while ($_ = Einfomixv6als::glob';
}
elsif (m{\G \b ( if | unless | while | until | for ) \b }oxgc) { $slash = 'm//'; return $1; }
elsif (m{\G \b (CORE::(?:split|chop|index|rindex|lc|uc|chr|ord|reverse)) \b }oxgc) { $slash = 'm//'; return $1; }
elsif (m{\G \b chop \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::chop'; }
elsif (m{\G \b INFOMIXV6ALS::index \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'INFOMIXV6ALS::index'; }
elsif (m{\G \b index \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::index'; }
elsif (m{\G \b INFOMIXV6ALS::rindex \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'INFOMIXV6ALS::rindex'; }
elsif (m{\G \b rindex \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::rindex'; }
elsif (m{\G \b lc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::lc'; }
elsif (m{\G \b uc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::uc'; }
elsif (m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+)
\s* (\") ((?:$qq_char)+?) (\") }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_qq('', $2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\() ((?:$qq_paren)+?) (\)) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\{) ((?:$qq_brace)+?) (\}) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\[) ((?:$qq_bracket)+?) (\]) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\<) ((?:$qq_angle)+?) (\>) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\S) ((?:$qq_char)+?) (\3) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+)
\s* (\') ((?:\\\1|\\\\|$q_char)+?) (\') }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_q ('', $2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\() ((?:\\\)|\\\\|$q_paren)+?) (\)) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\{) ((?:\\\}|\\\\|$q_brace)+?) (\}) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\<) ((?:\\\>|\\\\|$q_angle)+?) (\>) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\S) ((?:\\\1|\\\\|$q_char)+?) (\3) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+) (\$ \w+(?: ::\w+)* (?: (?: ->)? (?: \( (?:$qq_paren)*? \) | \{ (?:$qq_brace)+? \} | \[ (?:$qq_bracket)+? \] ) )*) }oxgc)
{ $slash = 'm//'; return "Einfomixv6als::filetest(qw($1),$2)"; }
elsif (m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+) \( ((?:$qq_paren)*?) \) }oxgc)
{ $slash = 'm//'; return "Einfomixv6als::filetest(qw($1),$2)"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) (?= [a-z]+) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest qw($1),"; }
elsif (m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) (\w+) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest(qw($1),$2)"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ \s* (\") ((?:$qq_char)+?) (\") }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_qq('', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\() ((?:$qq_paren)+?) (\)) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\{) ((?:$qq_brace)+?) (\}) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\[) ((?:$qq_bracket)+?) (\]) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\<) ((?:$qq_angle)+?) (\>) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\S) ((?:$qq_char)+?) (\3) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ \s* (\') ((?:\\\1|\\\\|$q_char)+?) (\') }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_q ('', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\() ((?:\\\)|\\\\|$q_paren)+?) (\)) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\{) ((?:\\\}|\\\\|$q_brace)+?) (\}) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\<) ((?:\\\>|\\\\|$q_angle)+?) (\>) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\S) ((?:\\\1|\\\\|$q_char)+?) (\3) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s* (\$ \w+(?: ::\w+)* (?: (?: ->)? (?: \( (?:$qq_paren)*? \) | \{ (?:$qq_brace)+? \} | \[ (?:$qq_bracket)+? \] ) )*) }oxgc)
{ $slash = 'm//'; return "Einfomixv6als::$1($2)"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s* \( ((?:$qq_paren)*?) \) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1($2)"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) (?= \s+ [a-z]+) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ (\w+) }oxgc) { $slash = 'm//'; return "Einfomixv6als::$1($2)"; }
elsif (m{\G \b lstat (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::lstat'; }
elsif (m{\G \b stat (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::stat'; }
elsif (m{\G \b chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::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 'Einfomixv6als::glob'; }
elsif (m{\G \b lc \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::lc_'; }
elsif (m{\G \b uc \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::uc_'; }
elsif (m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+)
\b (?! \s* => ) }oxgc) { $slash = 'm//'; return "Einfomixv6als::filetest_(qw($1))"; }
elsif (m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC])
\b (?! \s* => ) }oxgc) { $slash = 'm//'; return "Einfomixv6als::${1}_"; }
elsif (m{\G \b lstat \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::lstat_'; }
elsif (m{\G \b stat \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::stat_'; }
elsif (m{\G \b chr \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::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 'Einfomixv6als::glob_'; }
elsif (m{\G \b reverse \b (?! \s* => ) }oxgc) { $slash = 'm//'; return $function_reverse; }
elsif (m{\G \b opendir (\s* \( \s*) (?=[A-Za-z_]) }oxgc) { $slash = 'm//'; return "Einfomixv6als::opendir$1*"; }
elsif (m{\G \b opendir (\s+) (?=[A-Za-z_]) }oxgc) { $slash = 'm//'; return "Einfomixv6als::opendir$1*"; }
elsif (m{\G \b unlink \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::unlink'; }
elsif (m{\G \b chdir \b (?! \s* => ) }oxgc) { $slash = 'm//'; return 'Einfomixv6als::chdir'; }
elsif (m{\G \b (split) \b (?! \s* => ) }oxgc) {
$slash = 'm//';
my $e = 'Einfomixv6als::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,''); }
}
croak "$__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); }
}
croak "$__FILE__: Can't find string terminator anywhere before EOF";
}
}
elsif (/\G \b (q) \b /oxgc) {
if (/\G (\
else {
while (/\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,''); }
}
croak "$__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); }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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);
}
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__FILE__: Can't find string terminator anywhere before EOF";
}
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__FILE__: Can't find string terminator anywhere before EOF";
}
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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); }
}
croak "$__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);
}
}
croak "$__FILE__: Substitution pattern not terminated";
}
}
elsif (/\G \b do (?= \s* \{ ) /oxmsgc) { return 'do'; }
elsif (/\G \b do (?= \s+ (?: q|qq|qx) \b) /oxmsgc) { return 'Einfomixv6als::do'; }
elsif (/\G \b do (?= \s+ \w+) /oxmsgc) { return 'do'; }
elsif (/\G \b do (?= \s* \$ \w+ (?: ::\w+)* \( ) /oxmsgc) { return 'do'; }
elsif (/\G \b do \b /oxmsgc) { return 'Einfomixv6als::do'; }
elsif (/\G \b require \s+ ($ignore_modules) \b /oxmsgc) { return "# require $1"; }
elsif (/\G \b require \s+ ($standard_modules) \b /oxmsgc) { return "require $1"; }
elsif (/\G \b require \s+ (v? [0-9]+(?: [._][0-9]+)*) \s* ; /oxmsgc) { return "require $1;"; }
elsif (/\G \b require \s+ (\w+(?: ::\w+)*) \s* ; /oxmsgc) { return e_require($1); }
elsif (/\G \b require \s* ; /oxmsgc) { return 'Einfomixv6als::require;'; }
elsif (/\G \b require \b /oxmsgc) { return 'Einfomixv6als::require'; }
elsif (/\G \b use \s+ ($ignore_modules) \b /oxmsgc) { return "# use $1"; }
elsif (/\G \b use \s+ ($standard_modules) \b /oxmsgc) { return "use $1"; }
elsif (/\G \b use \s+ (v? [0-9]+(?: [._][0-9]+)*) \s* ; /oxmsgc) { return "use $1;"; }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s* (\() \s* \) \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ qw \s* (\() \s* \) \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ qw \s* (\{) \s* \} \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ qw \s* (\[) \s* \] \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ qw \s* (\<) \s* \> \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ qw \s* ([\x21-\x3F]) \s* \2 \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ qw \s* (\S) \s* \2 \s* ; /oxmsgc) { return e_use_noimport($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s* ; /oxmsgc) { return e_use_noparam($1); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s* ( (\() [^)]* \)) \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s* ( (\') [^']* \') \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s* ( (\") [^"]* \") \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ ((?:q|qq|qw) \s* (\() [^)]* \)) \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ ((?:q|qq|qw) \s* (\{) (?:$q_char)*? \}) \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ ((?:q|qq|qw) \s* (\[) (?:$q_char)*? \]) \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ ((?:q|qq|qw) \s* (\<) [^>]* \>) \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ ((?:q|qq|qw) \s* ([\x21-\x3F]) .*? \3) \s* ; /oxmsgc) { return e_use($1,$2); }
elsif (/\G \b use \s+ ([A-Z]\w*(?: ::\w+)*) \s+ ((?:q|qq|qw) \s* (\S) (?:$q_char)*? \3) \s* ; /oxmsgc) { return e_use($1,$2); }
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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
$heredoc_qq++;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
$heredoc_qq++;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
$heredoc_qq++;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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 < ((?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^>\0\a\e\f\n\r\t])+?) > /oxgc) {
return 'Einfomixv6als::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 (
!~~ | !~ | != | ! |
%= | % |
&&= | && | &= | & |
-= | -> | - |
: |
<<= | <=> | <= | < |
== | => | =~ | = |
>>= | >> | >= | > |
\*\*= | \*\* | \*= | \* |
\+= | \+ |
\.\.\. | \.\. | \.= | \. |
\/\/= | \/\/ |
\/= | \/ |
\? |
\\ |
\^= | \^ |
\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 {
croak "$__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 .= '${Einfomixv6als::capture(' . $1 . ')}';
$slash = 'div';
}
elsif ($string =~ /\G \$ \{ \s* ([1-9][0-9]*) \s* \} /oxmsgc) {
$e_string .= '${Einfomixv6als::capture(' . $1 . ')}';
$slash = 'div';
}
elsif ($string =~ /\G \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) ( \[ .+? \] ) /oxmsgc) {
$e_string .= '${Einfomixv6als::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 .= '${Einfomixv6als::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 .= '${Einfomixv6als::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 .= '${Einfomixv6als::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)) \b }oxgc) { $e_string .= $1; $slash = 'm//'; }
elsif ($string =~ m{\G \b chop \b }oxgc) { $e_string .= 'Einfomixv6als::chop'; $slash = 'm//'; }
elsif ($string =~ m{\G \b INFOMIXV6ALS::index \b }oxgc) { $e_string .= 'INFOMIXV6ALS::index'; $slash = 'm//'; }
elsif ($string =~ m{\G \b index \b }oxgc) { $e_string .= 'Einfomixv6als::index'; $slash = 'm//'; }
elsif ($string =~ m{\G \b INFOMIXV6ALS::rindex \b }oxgc) { $e_string .= 'INFOMIXV6ALS::rindex'; $slash = 'm//'; }
elsif ($string =~ m{\G \b rindex \b }oxgc) { $e_string .= 'Einfomixv6als::rindex'; $slash = 'm//'; }
elsif ($string =~ m{\G \b lc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Einfomixv6als::lc'; $slash = 'm//'; }
elsif ($string =~ m{\G \b uc (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Einfomixv6als::uc'; $slash = 'm//'; }
elsif ($string =~ m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+)
\s* (\") ((?:$qq_char)+?) (\") }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_qq('', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\() ((?:$qq_paren)+?) (\)) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\{) ((?:$qq_brace)+?) (\}) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\[) ((?:$qq_bracket)+?) (\]) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\<) ((?:$qq_angle)+?) (\>) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) qq \s* (\S) ((?:$qq_char)+?) (\3) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+)
\s* (\') ((?:\\\1|\\\\|$q_char)+?) (\') }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_q ('', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\() ((?:\\\)|\\\\|$q_paren)+?) (\)) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\{) ((?:\\\}|\\\\|$q_brace)+?) (\}) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\<) ((?:\\\>|\\\\|$q_angle)+?) (\>) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) q \s* (\S) ((?:\\\1|\\\\|$q_char)+?) (\3) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+) (\$ \w+(?: ::\w+)* (?: (?: ->)? (?: \( (?:$qq_paren)*? \) | \{ (?:$qq_brace)+? \} | \[ (?:$qq_bracket)+? \] ) )*) }oxgc)
{ $e_string .= "Einfomixv6als::filetest(qw($1),$2)"; $slash = 'm//'; }
elsif ($string =~ m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+) \( ((?:$qq_paren)*?) \) }oxgc)
{ $e_string .= "Einfomixv6als::filetest(qw($1),$2)"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) (?= [a-z]+) }oxgc) { $e_string .= "Einfomixv6als::filetest qw($1),"; $slash = 'm//'; }
elsif ($string =~ m{\G ((?:-[rwxoRWXOezfdlpSbctugkTB]\s+){2,}) (\w+) }oxgc) { $e_string .= "Einfomixv6als::filetest(qw($1),$2)"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ \s* (\") ((?:$qq_char)+?) (\") }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_qq('', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\() ((?:$qq_paren)+?) (\)) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\{) ((?:$qq_brace)+?) (\}) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\[) ((?:$qq_bracket)+?) (\]) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\<) ((?:$qq_angle)+?) (\>) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ qq \s* (\S) ((?:$qq_char)+?) (\3) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ \s* (\') ((?:\\\1|\\\\|$q_char)+?) (\') }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_q ('', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\() ((?:\\\)|\\\\|$q_paren)+?) (\)) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\{) ((?:\\\}|\\\\|$q_brace)+?) (\}) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\<) ((?:\\\>|\\\\|$q_angle)+?) (\>) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ q \s* (\S) ((?:\\\1|\\\\|$q_char)+?) (\3) }oxgc) { $e_string .= "Einfomixv6als::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s* (\$ \w+(?: ::\w+)* (?: (?: ->)? (?: \( (?:$qq_paren)*? \) | \{ (?:$qq_brace)+? \} | \[ (?:$qq_bracket)+? \] ) )*) }oxgc)
{ $e_string .= "Einfomixv6als::$1($2)"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s* \( ((?:$qq_paren)*?) \) }oxgc) { $e_string .= "Einfomixv6als::$1($2)"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) (?= \s+ [a-z]+) }oxgc) { $e_string .= "Einfomixv6als::$1"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \s+ (\w+) }oxgc) { $e_string .= "Einfomixv6als::$1($2)"; $slash = 'm//'; }
elsif ($string =~ m{\G \b lstat (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Einfomixv6als::lstat'; $slash = 'm//'; }
elsif ($string =~ m{\G \b stat (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Einfomixv6als::stat'; $slash = 'm//'; }
elsif ($string =~ m{\G \b chr (?= \s+[A-Za-z_]|\s*['"`\$\@\&\*\(]) }oxgc) { $e_string .= 'Einfomixv6als::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 .= 'Einfomixv6als::glob'; $slash = 'm//'; }
elsif ($string =~ m{\G \b lc \b }oxgc) { $e_string .= 'Einfomixv6als::lc_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b uc \b }oxgc) { $e_string .= 'Einfomixv6als::uc_'; $slash = 'm//'; }
elsif ($string =~ m{\G (-[rwxoRWXOezfdlpSbctugkTB](?:\s+-[rwxoRWXOezfdlpSbctugkTB])+)
\b }oxgc) { $e_string .= "Einfomixv6als::filetest_(qw($1))"; $slash = 'm//'; }
elsif ($string =~ m{\G -([rwxoRWXOezsfdlpSbctugkTBMAC]) \b }oxgc) { $e_string .= "Einfomixv6als::${1}_"; $slash = 'm//'; }
elsif ($string =~ m{\G \b lstat \b }oxgc) { $e_string .= 'Einfomixv6als::lstat_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b stat \b }oxgc) { $e_string .= 'Einfomixv6als::stat_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b chr \b }oxgc) { $e_string .= 'Einfomixv6als::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 .= 'Einfomixv6als::glob_'; $slash = 'm//'; }
elsif ($string =~ m{\G \b reverse \b }oxgc) { $e_string .= $function_reverse; $slash = 'm//'; }
elsif ($string =~ m{\G \b opendir (\s* \( \s*) (?=[A-Za-z_]) }oxgc) { $e_string .= "Einfomixv6als::opendir$1*"; $slash = 'm//'; }
elsif ($string =~ m{\G \b opendir (\s+) (?=[A-Za-z_]) }oxgc) { $e_string .= "Einfomixv6als::opendir$1*"; $slash = 'm//'; }
elsif ($string =~ m{\G \b unlink \b }oxgc) { $e_string .= 'Einfomixv6als::unlink'; $slash = 'm//'; }
elsif ($string =~ m{\G \b chdir \b }oxgc) { $e_string .= 'Einfomixv6als::chdir'; $slash = 'm//'; }
elsif ($string =~ m{\G \b (split) \b (?! \s* => ) }oxgc) {
$slash = 'm//';
my $e_string = 'Einfomixv6als::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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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; }
}
croak "$__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 .= 'Einfomixv6als::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;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
$heredoc_qq++;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
$heredoc_qq++;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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;
$heredoc_qq++;
my $script = CORE::substr $_, pos $_;
$script =~ s/.*?\n//oxm;
if ($script =~ /\A (.*? \n $delimiter \n) /xms) {
$heredoc{$delimiter} = $1;
}
else {
croak "$__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 (
!~~ | !~ | != | ! |
%= | % |
&&= | && | &= | & |
-= | -> | - |
: |
<<= | <=> | <= | < |
== | => | =~ | = |
>>= | >> | >= | > |
\*\*= | \*\* | \*= | \* |
\+= | \+ |
\.\.\. | \.\. | \.= | \. |
\/\/= | \/\/ |
\/= | \/ |
\? |
\\ |
\^= | \^ |
\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 {
croak "$__FILE__: oops, this shouldn't happen!";
}
}
return $e_string;
}
sub classic_character_class {
my($char,$modifier) = @_;
return {
'.' => ($modifier =~ /s/) ?
'(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[\x00-\xFF])' :
'(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\n])',
'\D' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\d])',
'\S' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\s])',
'\W' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\w])',
'\H' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\t\x20])',
'\V' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\f\n\r])',
'\h' => '[\t\x20]',
'\v' => '[\f\n\r]',
}->{$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{Einfomixv6als::tr(\$_, ' =~ ', $charclass,$e$charclass2,'$modifier')};
}
else {
$e_tr = qq{Einfomixv6als::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';
my @char = $string =~ m/ \G ($q_char) /oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if ($char[$i] =~ m/\A ([\x80-\xFF].*) (\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
elsif (($char[$i] =~ m/\A ([\x80-\xFF].*) (\\) \z/xms) and defined($char[$i+1]) and ($char[$i+1] eq '\\')) {
$char[$i] = $1 . '\\' . $2;
}
}
if (defined($char[-1]) and ($char[-1] =~ m/\A ([\x80-\xFF].*) (\\) \z/xms)) {
$char[-1] = $1 . '\\' . $2;
}
return join '', $ope, $delimiter, @char, $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 (
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\\?(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if ($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 '\L') {
$char[$i] = '@{[Einfomixv6als::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Einfomixv6als::uc 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] =~ 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] = '${Einfomixv6als::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Einfomixv6als::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] = '${Einfomixv6als::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] = '${Einfomixv6als::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] = '${Einfomixv6als::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] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
if ($left_e > $right_e) {
return join '', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter;
}
else {
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 (
\$ \s* \d+ |
\$ \s* \{ \s* \d+ \s* \} |
\$ \$ (?![\w\{]) |
\$ \s* \$ \s* $qq_variable |
\\?(?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if ($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 '\L') {
$char[$i] = '@{[Einfomixv6als::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Einfomixv6als::uc 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] =~ 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] = '${Einfomixv6als::capture(' . $1 . ')}';
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
$char[$i] = '${Einfomixv6als::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] = '${Einfomixv6als::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] = '${Einfomixv6als::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] = '${Einfomixv6als::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] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
if ($left_e > $right_e) {
return join '', @char, '>]}' x ($left_e - $right_e);
}
else {
return join '', @char;
}
}
sub e_qr {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
$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;
my $left_e = 0;
my $right_e = 0;
for (my $i=0; $i <= $#char; $i++) {
if ($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 (?: \\ [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;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '[' . CORE::uc($1) . CORE::lc($1) . ']';
}
}
elsif ($char[$i] =~ m/\A ([<>]) \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Einfomixv6als::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Einfomixv6als::uc 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] =~ m/\A \$ 0 \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '->' . $2 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '->' . $2 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . '->' . $2 . ')}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $1 . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . e_string($char[$i]) . ')]}';
}
else {
$char[$i] = e_string($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) {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
my $re;
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
$re = join '', $ope, $delimiter, "$your_gap(?:", @char, '>]}' x ($left_e - $right_e), ')(?{Einfomixv6als::m_matched})', $end_delimiter, $modifier;
}
else {
$re = join '', $ope, $delimiter, "$your_gap(?:", @char, ')(?{Einfomixv6als::m_matched})', $end_delimiter, $modifier;
}
return $re;
}
sub e_qr_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
$slash = 'div';
my @char = $string =~ m{\G(
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if ($char[$i] =~ m/\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
elsif ($char[$i] eq '[') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '[' . CORE::uc($1) . CORE::lc($1) . ']';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] !~ m/\A [\x00-\xFF] \z/oxms) {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, "$your_gap(?:", @char, ')(?{Einfomixv6als::m_matched})', $end_delimiter, $modifier;
}
sub e_s1 {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
$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;
my $parens = grep { $_ eq '(' } @char;
my $left_e = 0;
my $right_e = 0;
for (my $i=0; $i <= $#char; $i++) {
if ($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 (?: \\ [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;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '[' . CORE::uc($1) . CORE::lc($1) . ']';
}
}
elsif ($char[$i] =~ m/\A ([<>]) \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Einfomixv6als::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Einfomixv6als::uc 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] =~ 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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '->' . $2 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '->' . $2 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . '->' . $2 . ')}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $1 . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . e_string($char[$i]) . ')]}';
}
else {
$char[$i] = e_string($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) {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
my $re;
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
$re = join '', $ope, $delimiter, "($your_gap)(?:", @char, '>]}' x ($left_e - $right_e), ')(?{Einfomixv6als::s_matched})', $end_delimiter, $modifier;
}
else {
$re = join '', $ope, $delimiter, "($your_gap)(?:", @char, ')(?{Einfomixv6als::s_matched})', $end_delimiter, $modifier;
}
return $re;
}
sub e_s1_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
$slash = 'div';
my @char = $string =~ m{\G(
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if ($char[$i] =~ m/\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
elsif ($char[$i] eq '[') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '[' . CORE::uc($1) . CORE::lc($1) . ']';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] !~ m/\A [\x00-\xFF] \z/oxms) {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, "($your_gap)(?:", @char, ')(?{Einfomixv6als::s_matched})', $end_delimiter, $modifier;
}
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_q ('', "'", "'", $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 $sub;
if ($modifier =~ m/g/oxms) {
$sub = sprintf(
q<eval{my %s_n=0; my %s_a=''; while(%s%s%s){my %s_r=eval %s; %s%s="%s_a${1}%s_r$'"; pos(%s)=length "%s_a${1}%s_r"; %s_a=substr(%s,0,pos(%s)); %s_n++} %s_n}>,
$variable_basename,
$variable_basename,
$variable,
$bind_operator,
($delimiter1 eq "'") ?
e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) :
e_s1 ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$variable,
$variable_basename,
$variable_basename,
$variable,
$variable_basename,
$variable_basename,
$variable_basename,
$variable,
$variable,
$variable_basename,
$variable_basename,
);
}
else {
$sub = sprintf(
q<(%s%s%s) ? eval{my %s_r=eval %s; %s%s="${1}%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),
$variable_basename,
$e_replacement,
sprintf('%s_r=eval %s_r; ', $variable_basename, $variable_basename) x $e_modifier,
$variable,
$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 ||= '';
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
$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;
my $left_e = 0;
my $right_e = 0;
for (my $i=0; $i <= $#char; $i++) {
if ($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 (?: \\ [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;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '[' . CORE::uc($1) . CORE::lc($1) . ']';
}
}
elsif ($char[$i] =~ m/\A ([<>]) \z/oxms) {
if ($right_e < $left_e) {
$char[$i] = '\\' . $char[$i];
}
}
elsif ($char[$i] eq '\L') {
$char[$i] = '@{[Einfomixv6als::lc qq<';
$left_e++;
}
elsif ($char[$i] eq '\U') {
$char[$i] = '@{[Einfomixv6als::uc 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] =~ m/\A \$ 0 \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* 0 \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $char[$i] . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$\$ \z/oxms) {
}
elsif ($char[$i] =~ m/\A \$ ([1-9][0-9]*) \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
elsif ($char[$i] =~ m/\A \$ \{ \s* ([1-9][0-9]*) \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '->' . $2 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '->' . $2 .'))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . '->' . $2 . ')}';
}
}
elsif ($char[$i] =~ m/\A \$ ( \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . $1 . ')]}';
}
}
elsif ($char[$i] =~ m/\A \$ \s* \{ \s* ( .+ ) \s* \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(Einfomixv6als::capture(' . $1 . '))]}';
}
else {
$char[$i] = '${Einfomixv6als::capture(' . $1 . ')}';
}
}
elsif ($char[$i] =~ m/\A [\$\@].+ /oxms) {
if ($ignorecase) {
$char[$i] = '@{[Einfomixv6als::ignorecase(' . e_string($char[$i]) . ')]}';
}
else {
$char[$i] = e_string($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) {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
my $re;
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
$re = join '', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter, $modifier;
}
else {
$re = join '', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
return $re;
}
sub e_split_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
my $ignorecase = ($modifier =~ m/i/oxms) ? 1 : 0;
$slash = 'div';
my @char = $string =~ m{\G(
\[\:\^ [a-z]+ \:\] |
\[\: [a-z]+ \:\] |
\[\^ |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if ($char[$i] =~ m/\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
elsif ($char[$i] eq '[') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$__FILE__: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
splice @char, $left, $right-$left+1, Einfomixv6als::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) {
if ($ignorecase) {
$char[$i] = '[' . CORE::uc($1) . CORE::lc($1) . ']';
}
}
elsif (($i >= 1) and ($char[$i] =~ m/\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] !~ m/\A [\x00-\xFF] \z/oxms) {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
sub e_require {
my($module) = @_;
my $expr = $module;
$expr =~ s
$expr .= '.pm' if $expr !~ m/ \.pm \z/oxmsi;
return qq<Einfomixv6als::require '$expr';>;
}
sub e_use_noimport {
my($module) = @_;
my $expr = $module;
$expr =~ s
$expr .= '.pm' if $expr !~ m/ \.pm \z/oxmsi;
my $fh = Symbol::gensym();
for my $prefix (@INC) {
my $realfilename = "$prefix/$expr";
if (sysopen($fh, $realfilename, O_RDONLY)) {
local $/ = undef;
my $script = <$fh>;
close($fh) or croak "Can't close file: $realfilename";
if ($script =~ m/^ \s* use \s+ INFOMIXV6ALS \s* ([^;]*) ; \s* \n? $/oxms) {
return qq<BEGIN { Einfomixv6als::require '$expr'; }>;
}
last;
}
}
return qq<use $module ();>;
}
sub e_use_noparam {
my($module) = @_;
my $expr = $module;
$expr =~ s
$expr .= '.pm' if $expr !~ m/ \.pm \z/oxmsi;
my $fh = Symbol::gensym();
for my $prefix (@INC) {
my $realfilename = "$prefix/$expr";
if (sysopen($fh, $realfilename, O_RDONLY)) {
local $/ = undef;
my $script = <$fh>;
close($fh) or croak "Can't close file: $realfilename";
if ($script =~ m/^ \s* use \s+ INFOMIXV6ALS \s* ([^;]*) ; \s* \n? $/oxms) {
return qq[BEGIN { Einfomixv6als::require '$expr'; $module->import(); }];
}
last;
}
}
return qq<use $module;>;
}
sub e_use {
my($module,$list) = @_;
my $expr = $module;
$expr =~ s
$expr .= '.pm' if $expr !~ m/ \.pm \z/oxmsi;
my $fh = Symbol::gensym();
for my $prefix (@INC) {
my $realfilename = "$prefix/$expr";
if (sysopen($fh, $realfilename, O_RDONLY)) {
local $/ = undef;
my $script = <$fh>;
close($fh) or croak "Can't close file: $realfilename";
if ($script =~ m/^ \s* use \s+ INFOMIXV6ALS \s* ([^;]*) ; \s* \n? $/oxms) {
return qq[BEGIN { Einfomixv6als::require '$expr'; $module->import($list); }];
}
last;
}
}
return qq<use $module $list;>;
}
1;