use 5.00503;
use vars qw($VERSION $_warning);$VERSION = sprintf '%d.%02d', q$Revision: 0.49 $ =~ m/(\d+)/xmsg;
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'};
$_warning = $^W;
local $^W = 1;
BEGIN {
if ($^X =~ m/ jperl /oxmsi) {
croak "$0 need perl(not jperl) 5.00503 or later. (\$^X==$^X)";
}
}
my $your_char = q{\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[\x00-\xFF]};
my $q_char = qr/$your_char/oxms;
my %range_tr = ();
my $is_shiftjis_family = 0;
my $is_eucjp_family = 0;
if (0) {
}
elsif (__PACKAGE__ eq 'Ebig5plus') {
%range_tr = (
1 => [ [0x00..0x80,0xFF],
],
2 => [ [0x81..0xFE],[0x40..0x7E,0x80..0xFE],
],
);
}
elsif (__PACKAGE__ eq 'Egb18030') {
%range_tr = (
1 => [ [0x00..0x80,0xFF],
],
2 => [ [0x81..0xFE],[0x40..0x7E,0x80..0xFE],
],
4 => [ [0x81..0xFE],[0x30..0x39],[0x81..0xFE],[0x30..0x39],
],
);
}
elsif (__PACKAGE__ eq 'Egbk') {
%range_tr = (
1 => [ [0x00..0x80,0xFF],
],
2 => [ [0x81..0xFE],[0x40..0x7E,0x80..0xFE],
],
);
}
elsif (__PACKAGE__ eq 'Ehp15') {
%range_tr = (
1 => [ [0x00..0x7F,0xA1..0xDF,0xFF],
],
2 => [ [0x80..0xA0,0xE0..0xFE],[0x21..0x7E,0x80..0xFF],
],
);
$is_shiftjis_family = 1;
}
elsif (__PACKAGE__ eq 'Einfomixv6als') {
%range_tr = (
1 => [ [0x00..0x80,0xA0..0xDF,0xFE..0xFF],
],
2 => [ [0x81..0x9F,0xE0..0xFC],[0x40..0x7E,0x80..0xFC],
],
3 => [ [0xFD..0xFD],[0xA1..0xFE],[0xA1..0xFE],
],
);
$is_shiftjis_family = 1;
}
elsif (__PACKAGE__ eq 'E'.'sjis') {
%range_tr = (
1 => [ [0x00..0x80,0xA0..0xDF,0xFD..0xFF],
],
2 => [ [0x81..0x9F,0xE0..0xFC],[0x40..0x7E,0x80..0xFC],
],
);
$is_shiftjis_family = 1;
}
elsif (__PACKAGE__ eq 'Euhc') {
%range_tr = (
1 => [ [0x00..0x80,0xFF],
],
2 => [ [0x81..0xFE],[0x41..0x5A,0x61..0x7A,0x81..0xFE],
],
);
}
elsif (__PACKAGE__ eq 'Eeucjp') {
%range_tr = (
1 => [ [0x00..0x8D,0x90..0xA0,0xFF],
],
2 => [ [0x8E..0x8E],[0xA1..0xDF],
[0xA1..0xFE],[0xA1..0xFE],
],
3 => [ [0x8F..0x8F],[0xA1..0xFE],[0xA1..0xFE],
],
);
$is_eucjp_family = 1;
}
elsif (__PACKAGE__ eq 'Eutf2') {
%range_tr = (
1 => [ [0x00..0x7F],
],
2 => [ [0xC2..0xDF],[0x80..0xBF],
],
3 => [ [0xE0..0xE0],[0xA0..0xBF],[0x80..0xBF],
[0xE1..0xEC],[0x80..0xBF],[0x80..0xBF],
[0xED..0xED],[0x80..0x9F],[0x80..0xBF],
[0xEE..0xEF],[0x80..0xBF],[0x80..0xBF],
],
4 => [ [0xF0..0xF0],[0x90..0xBF],[0x80..0xBF],[0x80..0xBF],
[0xF1..0xF3],[0x80..0xBF],[0x80..0xBF],[0x80..0xBF],
[0xF4..0xF4],[0x80..0x8F],[0x80..0xBF],[0x80..0xBF],
],
);
}
else {
croak "$0 don't know my package name '" . __PACKAGE__ . "'";
}
sub import() {}
sub unimport() {}
sub Einfomixv6als::split(;$$$);
sub Einfomixv6als::tr($$$$;$);
sub Einfomixv6als::chop(@);
sub Einfomixv6als::index($$;$);
sub Einfomixv6als::rindex($$;$);
sub Einfomixv6als::lc(@);
sub Einfomixv6als::lc_();
sub Einfomixv6als::uc(@);
sub Einfomixv6als::uc_();
sub Einfomixv6als::capture($);
sub Einfomixv6als::ignorecase(@);
sub Einfomixv6als::chr(;$);
sub Einfomixv6als::chr_();
sub Einfomixv6als::filetest(@);
sub Einfomixv6als::r(;*@);
sub Einfomixv6als::w(;*@);
sub Einfomixv6als::x(;*@);
sub Einfomixv6als::o(;*@);
sub Einfomixv6als::R(;*@);
sub Einfomixv6als::W(;*@);
sub Einfomixv6als::X(;*@);
sub Einfomixv6als::O(;*@);
sub Einfomixv6als::e(;*@);
sub Einfomixv6als::z(;*@);
sub Einfomixv6als::s(;*@);
sub Einfomixv6als::f(;*@);
sub Einfomixv6als::d(;*@);
sub Einfomixv6als::l(;*@);
sub Einfomixv6als::p(;*@);
sub Einfomixv6als::S(;*@);
sub Einfomixv6als::b(;*@);
sub Einfomixv6als::c(;*@);
sub Einfomixv6als::t(;*@);
sub Einfomixv6als::u(;*@);
sub Einfomixv6als::g(;*@);
sub Einfomixv6als::k(;*@);
sub Einfomixv6als::T(;*@);
sub Einfomixv6als::B(;*@);
sub Einfomixv6als::M(;*@);
sub Einfomixv6als::A(;*@);
sub Einfomixv6als::C(;*@);
sub Einfomixv6als::filetest_(@);
sub Einfomixv6als::r_();
sub Einfomixv6als::w_();
sub Einfomixv6als::x_();
sub Einfomixv6als::o_();
sub Einfomixv6als::R_();
sub Einfomixv6als::W_();
sub Einfomixv6als::X_();
sub Einfomixv6als::O_();
sub Einfomixv6als::e_();
sub Einfomixv6als::z_();
sub Einfomixv6als::s_();
sub Einfomixv6als::f_();
sub Einfomixv6als::d_();
sub Einfomixv6als::l_();
sub Einfomixv6als::p_();
sub Einfomixv6als::S_();
sub Einfomixv6als::b_();
sub Einfomixv6als::c_();
sub Einfomixv6als::t_();
sub Einfomixv6als::u_();
sub Einfomixv6als::g_();
sub Einfomixv6als::k_();
sub Einfomixv6als::T_();
sub Einfomixv6als::B_();
sub Einfomixv6als::M_();
sub Einfomixv6als::A_();
sub Einfomixv6als::C_();
sub Einfomixv6als::glob($);
sub Einfomixv6als::glob_();
sub Einfomixv6als::lstat(*);
sub Einfomixv6als::lstat_();
sub Einfomixv6als::opendir(*$);
sub Einfomixv6als::stat(*);
sub Einfomixv6als::stat_();
sub Einfomixv6als::unlink(@);
sub Einfomixv6als::chdir(;$);
sub Einfomixv6als::do($);
sub Einfomixv6als::require(;$);
sub Einfomixv6als::telldir(*);
sub INFOMIXV6ALS::ord(;$);
sub INFOMIXV6ALS::ord_();
sub INFOMIXV6ALS::reverse(@);
sub INFOMIXV6ALS::length(;$);
sub INFOMIXV6ALS::substr($$;$$);
sub INFOMIXV6ALS::index($$;$);
sub INFOMIXV6ALS::rindex($$;$);
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
if ($ENV{'ComSpec'} =~ / (?: COMMAND\.COM | CMD\.EXE ) \z /oxmsi) {
my @argv = ();
for (@ARGV) {
if (m/\A ' ((?:$q_char)*) ' \z/oxms) {
push @argv, $1;
}
elsif (my @glob = Einfomixv6als::glob($_)) {
push @argv, @glob;
}
else {
push @argv, $_;
}
}
@ARGV = @argv;
}
}
my @chars1 = ();
my @chars2 = ();
my @chars3 = ();
my @chars4 = ();
if (exists $range_tr{1}) {
my @ranges = @{ $range_tr{1} };
while (my @range = splice(@ranges,0,1)) {
for my $oct0 (@{$range[0]}) {
push @chars1, pack 'C', $oct0;
}
}
}
if (exists $range_tr{2}) {
my @ranges = @{ $range_tr{2} };
while (my @range = splice(@ranges,0,2)) {
for my $oct0 (@{$range[0]}) {
for my $oct1 (@{$range[1]}) {
push @chars2, pack 'CC', $oct0,$oct1;
}
}
}
}
if (exists $range_tr{3}) {
my @ranges = @{ $range_tr{3} };
while (my @range = splice(@ranges,0,3)) {
for my $oct0 (@{$range[0]}) {
for my $oct1 (@{$range[1]}) {
for my $oct2 (@{$range[2]}) {
push @chars3, pack 'CCC', $oct0,$oct1,$oct2;
}
}
}
}
}
if (exists $range_tr{4}) {
my @ranges = @{ $range_tr{4} };
while (my @range = splice(@ranges,0,4)) {
for my $oct0 (@{$range[0]}) {
for my $oct1 (@{$range[1]}) {
for my $oct2 (@{$range[2]}) {
for my $oct3 (@{$range[3]}) {
push @chars4, pack 'CCCC', $oct0,$oct1,$oct2,$oct3;
}
}
}
}
}
}
my @minchar = (undef, $chars1[ 0], $chars2[ 0], $chars3[ 0], $chars4[ 0]);
my @maxchar = (undef, $chars1[-1], $chars2[-1], $chars3[-1], $chars4[-1]);
sub Einfomixv6als::split(;$$$) {
my $pattern = $_[0];
my $string = $_[1];
my $limit = $_[2];
$string = $_ if not defined $string;
my @split = ();
if ($string eq '') {
if (wantarray) {
return @split;
}
else {
cluck "$0: Use of implicit split to \@_ is deprecated" if $^W;
@_ = @split;
return scalar @_;
}
}
if ((not defined $limit) or ($limit <= 0)) {
if ((not defined $pattern) or ($pattern eq ' ')) {
$string =~ s/ \A \s+ //oxms;
while ($string =~ s/\A((?:$q_char)*?)\s+//m) {
local $@;
for (my $digit=1; eval "defined(\$$digit)"; $digit++) {
push @split, eval '$' . $digit;
}
}
}
elsif ('' =~ m/ \A $pattern \z /xms) {
while ($string =~ s/\A((?:$q_char)+?)$pattern//m) {
local $@;
for (my $digit=1; eval "defined(\$$digit)"; $digit++) {
push @split, eval '$' . $digit;
}
}
}
else {
while ($string =~ s/\A((?:$q_char)*?)$pattern//m) {
local $@;
for (my $digit=1; eval "defined(\$$digit)"; $digit++) {
push @split, eval '$' . $digit;
}
}
}
}
else {
if ((not defined $pattern) or ($pattern eq ' ')) {
$string =~ s/ \A \s+ //oxms;
while ((--$limit > 0) and (CORE::length($string) > 0)) {
if ($string =~ s/\A((?:$q_char)*?)\s+//m) {
local $@;
for (my $digit=1; eval "defined(\$$digit)"; $digit++) {
push @split, eval '$' . $digit;
}
}
}
}
elsif ('' =~ m/ \A $pattern \z /xms) {
while ((--$limit > 0) and (CORE::length($string) > 0)) {
if ($string =~ s/\A((?:$q_char)+?)$pattern//m) {
local $@;
for (my $digit=1; eval "defined(\$$digit)"; $digit++) {
push @split, eval '$' . $digit;
}
}
}
}
else {
while ((--$limit > 0) and (CORE::length($string) > 0)) {
if ($string =~ s/\A((?:$q_char)*?)$pattern//m) {
local $@;
for (my $digit=1; eval "defined(\$$digit)"; $digit++) {
push @split, eval '$' . $digit;
}
}
}
}
}
push @split, $string;
if ((not defined $limit) or ($limit == 0)) {
while ((scalar(@split) >= 1) and ($split[-1] eq '')) {
pop @split;
}
}
if (wantarray) {
return @split;
}
else {
cluck "$0: Use of implicit split to \@_ is deprecated" if $^W;
@_ = @split;
return scalar @_;
}
}
sub Einfomixv6als::tr($$$$;$) {
my $bind_operator = $_[1];
my $searchlist = $_[2];
my $replacementlist = $_[3];
my $modifier = $_[4] || '';
my @char = $_[0] =~ m/\G ($q_char) /oxmsg;
my @searchlist = _charlist_tr($searchlist);
my @replacementlist = _charlist_tr($replacementlist);
my %tr = ();
for (my $i=0; $i <= $#searchlist; $i++) {
if (not exists $tr{$searchlist[$i]}) {
if (defined $replacementlist[$i] and ($replacementlist[$i] ne '')) {
$tr{$searchlist[$i]} = $replacementlist[$i];
}
elsif ($modifier =~ m/d/oxms) {
$tr{$searchlist[$i]} = '';
}
elsif (defined $replacementlist[-1] and ($replacementlist[-1] ne '')) {
$tr{$searchlist[$i]} = $replacementlist[-1];
}
else {
$tr{$searchlist[$i]} = $searchlist[$i];
}
}
}
my $tr = 0;
$_[0] = '';
if ($modifier =~ m/c/oxms) {
while (defined(my $char = shift @char)) {
if (not exists $tr{$char}) {
if (defined $replacementlist[0]) {
$_[0] .= $replacementlist[0];
}
$tr++;
if ($modifier =~ m/s/oxms) {
while (@char and (not exists $tr{$char[0]})) {
shift @char;
$tr++;
}
}
}
else {
$_[0] .= $char;
}
}
}
else {
while (defined(my $char = shift @char)) {
if (exists $tr{$char}) {
$_[0] .= $tr{$char};
$tr++;
if ($modifier =~ m/s/oxms) {
while (@char and (exists $tr{$char[0]}) and ($tr{$char[0]} eq $tr{$char})) {
shift @char;
$tr++;
}
}
}
else {
$_[0] .= $char;
}
}
}
if ($bind_operator =~ m/ !~ /oxms) {
return not $tr;
}
else {
return $tr;
}
}
sub Einfomixv6als::chop(@) {
my $chop;
if (@_ == 0) {
my @char = m/\G ($q_char) /oxmsg;
$chop = pop @char;
$_ = join '', @char;
}
else {
for (@_) {
my @char = m/\G ($q_char) /oxmsg;
$chop = pop @char;
$_ = join '', @char;
}
}
return $chop;
}
sub Einfomixv6als::index($$;$) {
my($str,$substr,$position) = @_;
$position ||= 0;
my $pos = 0;
while ($pos < CORE::length($str)) {
if (CORE::substr($str,$pos,CORE::length($substr)) eq $substr) {
if ($pos >= $position) {
return $pos;
}
}
if (CORE::substr($str,$pos) =~ m/\A ($q_char) /oxms) {
$pos += CORE::length($1);
}
else {
$pos += 1;
}
}
return -1;
}
sub Einfomixv6als::rindex($$;$) {
my($str,$substr,$position) = @_;
$position ||= CORE::length($str) - 1;
my $pos = 0;
my $rindex = -1;
while (($pos < CORE::length($str)) and ($pos <= $position)) {
if (CORE::substr($str,$pos,CORE::length($substr)) eq $substr) {
$rindex = $pos;
}
if (CORE::substr($str,$pos) =~ m/\A ($q_char) /oxms) {
$pos += CORE::length($1);
}
else {
$pos += 1;
}
}
return $rindex;
}
{
my %lc = ();
@lc{qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z)} =
qw(a b c d e f g h i j k l m n o p q r s t u v w x y z);
sub Einfomixv6als::lc(@) {
local $_ = shift if @_;
return join('', map {defined($lc{$_}) ? $lc{$_} : $_} m/\G ($q_char) /oxmsg), @_;
}
sub Einfomixv6als::lc_() {
return join('', map {defined($lc{$_}) ? $lc{$_} : $_} m/\G ($q_char) /oxmsg);
}
}
{
my %uc = ();
@uc{qw(a b c d e f g h i j k l m n o p q r s t u v w x y z)} =
qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z);
sub Einfomixv6als::uc(@) {
local $_ = shift if @_;
return join('', map {defined($uc{$_}) ? $uc{$_} : $_} m/\G ($q_char) /oxmsg), @_;
}
sub Einfomixv6als::uc_() {
return join('', map {defined($uc{$_}) ? $uc{$_} : $_} m/\G ($q_char) /oxmsg);
}
}
{
my $last_s_matched = 0;
sub Einfomixv6als::capture($) {
if ($last_s_matched and ($_[0] =~ m/\A [1-9][0-9]* \z/oxms)) {
return $_[0] + 1;
}
else {
return $_[0];
}
}
sub Einfomixv6als::m_matched() {
$last_s_matched = 0;
}
sub Einfomixv6als::s_matched() {
$last_s_matched = 1;
}
}
sub Einfomixv6als::ignorecase(@) {
my @string = @_;
my $metachar = qr/[\@\\|[\]{]/oxms;
for my $string (@string) {
my @char = $string =~ m{\G(
\[\^ |
\\? (?:$q_char)
)}oxmsg;
for (my $i=0; $i <= $#char; $i++) {
next if not defined $char[$i];
if ($char[$i] eq '[') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$0: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
my @charlist = charlist_qr(@char[$left+1..$right-1], 'i');
for my $char (@charlist) {
if ($char =~ m/\A ([\x80-\xFF].*) ($metachar) \z/oxms) {
$char = $1 . '\\' . $2;
}
elsif ($char =~ m/\A [.|)] \z/oxms) {
$char = $1 . '\\' . $char;
}
}
splice @char, $left, $right-$left+1, '(?:' . join('|', @charlist) . ')';
$i = $left;
last;
}
}
}
elsif ($char[$i] eq '[^') {
my $left = $i;
while (1) {
if (++$i > $#char) {
croak "$0: unmatched [] in regexp";
}
if ($char[$i] eq ']') {
my $right = $i;
my @charlist = charlist_not_qr(@char[$left+1..$right-1], 'i');
for my $char (@charlist) {
if ($char =~ m/\A ([\x80-\xFF].*) ($metachar) \z/oxms) {
$char = $1 . '\\' . $2;
}
elsif ($char =~ m/\A [.|)] \z/oxms) {
$char = '\\' . $char;
}
}
splice @char, $left, $right-$left+1, '(?!' . join('|', @charlist) . ")(?:$your_char)";
$i = $left;
last;
}
}
}
elsif (my $char = {
'\D' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^0-9])',
'\S' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x09\x0A\x0C\x0D\x20])',
'\W' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^0-9A-Z_a-z])',
'\d' => '[0-9]',
'\s' => '[\x09\x0A\x0C\x0D\x20]',
'\w' => '[0-9A-Z_a-z]',
'\H' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x09\x20])',
'\V' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x0C\x0A\x0D])',
'\h' => '[\x09\x20]',
'\v' => '[\x0C\x0A\x0D]',
}->{$char[$i]}
) {
$char[$i] = $char;
}
elsif ($char[$i] =~ m/\A ([A-Za-z]) \z/oxms) {
my $c = $1;
$char[$i] = '[' . CORE::uc($c) . CORE::lc($c) . ']';
}
}
for (my $i=0; $i <= $#char; $i++) {
next if not defined $char[$i];
if ($char[$i] =~ m/\A ([\x80-\xFF].*) ($metachar) \z/oxms) {
$char[$i] = $1 . '\\' . $2;
}
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] . ')';
}
}
}
$string = join '', @char;
}
return @string;
}
sub _charlist_tr {
local $_ = shift @_;
my @char = ();
while (not m/\G \z/oxmsgc) {
if (m/\G (\\0?55|\\x2[Dd]|\\-) /oxmsgc) {
push @char, '\-';
}
elsif (m/\G \\ ([0-7]{2,3}) /oxmsgc) {
push @char, CORE::chr(oct $1);
}
elsif (m/\G \\x ([0-9A-Fa-f]{1,2}) /oxmsgc) {
push @char, CORE::chr(hex $1);
}
elsif (m/\G \\c ([\x40-\x5F]) /oxmsgc) {
push @char, CORE::chr(CORE::ord($1) & 0x1F);
}
elsif (m/\G (\\ [0nrtfbae]) /oxmsgc) {
push @char, {
'\0' => "\0",
'\n' => "\n",
'\r' => "\r",
'\t' => "\t",
'\f' => "\f",
'\b' => "\x08",
'\a' => "\a",
'\e' => "\e",
}->{$1};
}
elsif (m/\G \\ ($q_char) /oxmsgc) {
push @char, $1;
}
elsif (m/\G ($q_char) /oxmsgc) {
push @char, $1;
}
}
@char = join('',@char) =~ m/\G (\\-|$q_char) /oxmsg;
my @i = ();
for my $i (0 .. $#char) {
if ($char[$i] eq '\-') {
$char[$i] = '-';
}
elsif ($char[$i] eq '-') {
if ((0 < $i) and ($i < $#char)) {
push @i, $i;
}
}
}
for my $i (CORE::reverse @i) {
my @range = ();
if ((length($char[$i-1]) > length($char[$i+1])) or ($char[$i-1] gt $char[$i+1])) {
croak "$0: invalid [] range \"\\x" . unpack('H*',$char[$i-1]) . '-\\x' . unpack('H*',$char[$i+1]) . '" in regexp';
}
if (length($char[$i-1]) == 1) {
if (length($char[$i+1]) == 1) {
push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} @chars1;
}
elsif (length($char[$i+1]) == 2) {
push @range, grep {$char[$i-1] le $_} @chars1;
push @range, grep {$_ le $char[$i+1]} @chars2;
}
elsif (length($char[$i+1]) == 3) {
push @range, grep {$char[$i-1] le $_} @chars1;
push @range, @chars2;
push @range, grep {$_ le $char[$i+1]} @chars3;
}
elsif (length($char[$i+1]) == 4) {
push @range, grep {$char[$i-1] le $_} @chars1;
push @range, @chars2;
push @range, @chars3;
push @range, grep {$_ le $char[$i+1]} @chars4;
}
}
elsif (length($char[$i-1]) == 2) {
if (length($char[$i+1]) == 2) {
push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} @chars2;
}
elsif (length($char[$i+1]) == 3) {
push @range, grep {$char[$i-1] le $_} @chars2;
push @range, grep {$_ le $char[$i+1]} @chars3;
}
elsif (length($char[$i+1]) == 4) {
push @range, grep {$char[$i-1] le $_} @chars2;
push @range, @chars3;
push @range, grep {$_ le $char[$i+1]} @chars4;
}
}
elsif (length($char[$i-1]) == 3) {
if (length($char[$i+1]) == 3) {
push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} @chars3;
}
elsif (length($char[$i+1]) == 4) {
push @range, grep {$char[$i-1] le $_} @chars3;
push @range, grep {$_ le $char[$i+1]} @chars4;
}
}
elsif (length($char[$i-1]) == 4) {
if (length($char[$i+1]) == 4) {
push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} @chars4;
}
}
splice @char, $i-1, 3, @range;
}
return @char;
}
sub _octets {
my $modifier = pop @_;
my $length = shift;
my($a) = unpack 'C', $_[0];
my($z) = unpack 'C', $_[1];
if ($length == 1) {
if (((caller(1))[3] ne 'Einfomixv6als::_octets') and ($modifier =~ m/i/oxms)) {
if ($a == $z) {
return sprintf('(?i:\x%02X)', $a);
}
elsif (($a+1) == $z) {
return sprintf('(?i:[\x%02X\x%02X])', $a, $z);
}
else {
return sprintf('(?i:[\x%02X-\x%02X])', $a, $z);
}
}
else {
if ($a == $z) {
return sprintf('\x%02X', $a);
}
elsif (($a+1) == $z) {
return sprintf('[\x%02X\x%02X]', $a, $z);
}
else {
return sprintf('[\x%02X-\x%02X]', $a, $z);
}
}
}
elsif (($length == 2) and $is_shiftjis_family and ($a <= 0x9F) and (0xE0 <= $z)) {
my(undef,$a2) = unpack 'CC', $_[0];
my(undef,$z2) = unpack 'CC', $_[1];
my $octets1;
my $octets2;
if ($a == 0x9F) {
$octets1 = sprintf('\x%02X[\x%02X-\xFF]', 0x9F,$a2);
}
elsif (($a+1) == 0x9F) {
$octets1 = sprintf('\x%02X[\x%02X-\xFF]|\x%02X[\x00-\xFF]', $a, $a2,$a+1);
}
elsif (($a+2) == 0x9F) {
$octets1 = sprintf('\x%02X[\x%02X-\xFF]|[\x%02X\x%02X][\x00-\xFF]', $a, $a2,$a+1,$a+2);
}
else {
$octets1 = sprintf('\x%02X[\x%02X-\xFF]|[\x%02X-\x%02X][\x00-\xFF]', $a, $a2,$a+1,$a+2);
}
if ($z == 0xE0) {
$octets2 = sprintf('\x%02X[\x00-\x%02X]', $z,$z2);
}
elsif (($z-1) == 0xE0) {
$octets2 = sprintf('\x%02X[\x00-\xFF]|\x%02X[\x00-\x%02X]', $z-1,$z,$z2);
}
elsif (($z-2) == 0xE0) {
$octets2 = sprintf('[\x%02X\x%02X][\x00-\xFF]|\x%02X[\x00X-\x%02X]', $z-2,$z-1,$z,$z2);
}
else {
$octets2 = sprintf('[\x%02X-\x%02X][\x00-\xFF]|\x%02X[\x00-\x%02X]', 0xE0,$z-1,$z,$z2);
}
return "(?:$octets1|$octets2)";
}
elsif (($length == 2) and $is_eucjp_family and ($a == 0x8E) and (0xA1 <= $z)) {
my(undef,$a2) = unpack 'CC', $_[0];
my(undef,$z2) = unpack 'CC', $_[1];
my $octets1;
my $octets2;
$octets1 = sprintf('\x%02X[\x%02X-\xFF]', 0x8E,$a2);
if ($z == 0xA1) {
$octets2 = sprintf('\x%02X[\x00-\x%02X]', $z,$z2);
}
elsif (($z-1) == 0xA1) {
$octets2 = sprintf('\x%02X[\x00-\xFF]|\x%02X[\x00-\x%02X]', $z-1,$z,$z2);
}
elsif (($z-2) == 0xA1) {
$octets2 = sprintf('[\x%02X\x%02X][\x00-\xFF]|\x%02X[\x00X-\x%02X]', $z-2,$z-1,$z,$z2);
}
else {
$octets2 = sprintf('[\x%02X-\x%02X][\x00-\xFF]|\x%02X[\x00-\x%02X]', 0xA1,$z-1,$z,$z2);
}
return "(?:$octets1|$octets2)";
}
else {
my(undef,$aa) = unpack 'Ca*', $_[0];
my(undef,$zz) = unpack 'Ca*', $_[1];
if ($a == $z) {
return '(?:' . join('|',
sprintf('\x%02X%s', $a, _octets($length-1,$aa, $zz, $modifier)),
) . ')';
}
elsif (($a+1) == $z) {
return '(?:' . join('|',
sprintf('\x%02X%s', $a, _octets($length-1,$aa, $maxchar[$length-1],$modifier)),
sprintf('\x%02X%s', $z, _octets($length-1,$minchar[$length-1],$zz, $modifier)),
) . ')';
}
elsif (($a+2) == $z) {
return '(?:' . join('|',
sprintf('\x%02X%s', $a, _octets($length-1,$aa, $maxchar[$length-1],$modifier)),
sprintf('\x%02X%s', $a+1, _octets($length-1,$minchar[$length-1],$maxchar[$length-1],$modifier)),
sprintf('\x%02X%s', $z, _octets($length-1,$minchar[$length-1],$zz, $modifier)),
) . ')';
}
elsif (($a+3) == $z) {
return '(?:' . join('|',
sprintf('\x%02X%s', $a, _octets($length-1,$aa, $maxchar[$length-1],$modifier)),
sprintf('[\x%02X\x%02X]%s', $a+1,$z-1, _octets($length-1,$minchar[$length-1],$maxchar[$length-1],$modifier)),
sprintf('\x%02X%s', $z, _octets($length-1,$minchar[$length-1],$zz, $modifier)),
) . ')';
}
else {
return '(?:' . join('|',
sprintf('\x%02X%s', $a, _octets($length-1,$aa, $maxchar[$length-1],$modifier)),
sprintf('[\x%02X-\x%02X]%s', $a+1,$z-1, _octets($length-1,$minchar[$length-1],$maxchar[$length-1],$modifier)),
sprintf('\x%02X%s', $z, _octets($length-1,$minchar[$length-1],$zz, $modifier)),
) . ')';
}
}
}
sub _charlist {
my $modifier = pop @_;
my @char = @_;
for (my $i=0; $i <= $#char; $i++) {
if ($char[$i] eq '-') {
if ((0 < $i) and ($i < $#char)) {
$char[$i] = '...';
}
}
elsif ($char[$i] =~ m/\A \\ ([0-7]{2,3}) \z/oxms) {
$char[$i] = CORE::chr oct $1;
}
elsif ($char[$i] =~ m/\A \\x ([0-9A-Fa-f]{1,2}) \z/oxms) {
$char[$i] = CORE::chr hex $1;
}
elsif ($char[$i] =~ m/\A \\c ([\x40-\x5F]) \z/oxms) {
$char[$i] = CORE::chr(CORE::ord($1) & 0x1F);
}
elsif ($char[$i] =~ m/\A (\\ [0nrtfbaedDhHsSvVwW]) \z/oxms) {
$char[$i] = {
'\0' => "\0",
'\n' => "\n",
'\r' => "\r",
'\t' => "\t",
'\f' => "\f",
'\b' => "\x08",
'\a' => "\a",
'\e' => "\e",
'\d' => '[0-9]',
'\s' => '[\x09\x0A\x0C\x0D\x20]',
'\w' => '[0-9A-Z_a-z]',
'\D' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^0-9])',
'\S' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x09\x0A\x0C\x0D\x20])',
'\W' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^0-9A-Z_a-z])',
'\H' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x09\x20])',
'\V' => '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^\x0C\x0A\x0D])',
'\h' => '[\x09\x20]',
'\v' => '[\x0C\x0A\x0D]',
}->{$1};
}
elsif ($char[$i] =~ m/\A \\ ($q_char) \z/oxms) {
$char[$i] = $1;
}
}
my @singleoctet = ();
my @charlist = ();
for (my $i=0; $i <= $#char; ) {
if (defined($char[$i+1]) and ($char[$i+1] eq '...')) {
$i += 1;
next;
}
elsif ($char[$i] eq '...') {
if ((length($char[$i-1]) > length($char[$i+1])) or ($char[$i-1] gt $char[$i+1])) {
croak "$0: invalid [] range \"\\x" . unpack('H*',$char[$i-1]) . '-\\x' . unpack('H*',$char[$i+1]) . '" in regexp';
}
if ((length($char[$i-1]) == 1) and (length($char[$i+1]) == 1) and ($modifier !~ m/i/oxms)) {
my $a = unpack 'C', $char[$i-1];
my $z = unpack 'C', $char[$i+1];
if ($a == $z) {
push @singleoctet, sprintf('\x%02X', $a);
}
elsif (($a+1) == $z) {
push @singleoctet, sprintf('\x%02X\x%02X', $a, $z);
}
else {
push @singleoctet, sprintf('\x%02X-\x%02X', $a, $z);
}
}
elsif (length($char[$i-1]) == length($char[$i+1])) {
push @charlist, _octets(length($char[$i-1]), $char[$i-1], $char[$i+1], $modifier);
}
elsif (length($char[$i-1]) == 1) {
if (length($char[$i+1]) == 2) {
push @charlist,
_octets(1, $char[$i-1], $maxchar[1], $modifier),
_octets(2, $minchar[2], $char[$i+1], $modifier);
}
elsif (length($char[$i+1]) == 3) {
push @charlist,
_octets(1, $char[$i-1], $maxchar[1], $modifier),
_octets(2, $minchar[2], $maxchar[2], $modifier),
_octets(3, $minchar[3], $char[$i+1], $modifier);
}
elsif (length($char[$i+1]) == 4) {
push @charlist,
_octets(1, $char[$i-1], $maxchar[1], $modifier),
_octets(2, $minchar[2], $maxchar[2], $modifier),
_octets(3, $minchar[3], $maxchar[3], $modifier),
_octets(4, $minchar[4], $char[$i+1], $modifier);
}
}
elsif (length($char[$i-1]) == 2) {
if (length($char[$i+1]) == 3) {
push @charlist,
_octets(2, $char[$i-1], $maxchar[2], $modifier),
_octets(3, $minchar[3], $char[$i+1], $modifier);
}
elsif (length($char[$i+1]) == 4) {
push @charlist,
_octets(2, $char[$i-1], $maxchar[2], $modifier),
_octets(3, $minchar[3], $maxchar[3], $modifier),
_octets(4, $minchar[4], $char[$i+1], $modifier);
}
}
elsif (length($char[$i-1]) == 3) {
if (length($char[$i+1]) == 4) {
push @charlist,
_octets(3, $char[$i-1], $maxchar[3], $modifier),
_octets(4, $minchar[4], $char[$i+1], $modifier);
}
}
else {
croak "$0: invalid [] range \"\\x" . unpack('H*',$char[$i-1]) . '-\\x' . unpack('H*',$char[$i+1]) . '" in regexp';
}
$i += 2;
}
elsif ($char[$i] =~ m/\A [A-Za-z] \z/oxms) {
if ($modifier =~ m/i/oxms) {
push @singleoctet, CORE::uc $char[$i], CORE::lc $char[$i];
}
else {
push @singleoctet, $char[$i];
}
$i += 1;
}
elsif ($char[$i] =~ m/\A (?: \\h ) \z/oxms) {
push @singleoctet, "\t", "\x20";
$i += 1;
}
elsif ($char[$i] =~ m/\A (?: \\v ) \z/oxms) {
push @singleoctet, "\f","\n","\r";
$i += 1;
}
elsif ($char[$i] =~ m/\A (?: [\x00-\xFF] | \\d | \\s | \\w ) \z/oxms) {
push @singleoctet, $char[$i];
$i += 1;
}
else {
push @charlist, $char[$i];
$i += 1;
}
}
for (@singleoctet) {
if (m/\A \n \z/oxms) {
$_ = '\n';
}
elsif (m/\A \r \z/oxms) {
$_ = '\r';
}
elsif (m/\A ([\x00-\x20\x7F-\xFF]) \z/oxms) {
$_ = sprintf('\x%02X', CORE::ord $1);
}
elsif (m/\A [\x00-\xFF] \z/oxms) {
$_ = quotemeta $_;
}
}
for (@charlist) {
if (m/\A (\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC]) ([\x00-\xFF]) \z/oxms) {
$_ = $1 . quotemeta $2;
}
}
return \@singleoctet, \@charlist;
}
sub charlist_qr {
my $modifier = pop @_;
my @char = @_;
my($singleoctet, $charlist) = _charlist(@char, $modifier);
my @singleoctet = @$singleoctet;
my @charlist = @$charlist;
if (scalar(@singleoctet) == 0) {
}
elsif (scalar(@singleoctet) >= 2) {
push @charlist, '[' . join('',@singleoctet) . ']';
}
elsif ($singleoctet[0] =~ m/ . - . /oxms) {
push @charlist, '[' . $singleoctet[0] . ']';
}
else {
push @charlist, $singleoctet[0];
}
if (scalar(@charlist) >= 2) {
return '(?:' . join('|', @charlist) . ')';
}
else {
return $charlist[0];
}
}
sub charlist_not_qr {
my $modifier = pop @_;
my @char = @_;
my($singleoctet, $charlist) = _charlist(@char, $modifier);
my @singleoctet = @$singleoctet;
my @charlist = @$charlist;
if (scalar(@charlist) >= 1) {
if (scalar(@singleoctet) >= 1) {
return '(?!' . join('|', @charlist) . ')(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^'. join('', @singleoctet) . '])';
}
else {
return '(?!' . join('|', @charlist) . ")(?:$your_char)";
}
}
else {
if (scalar(@singleoctet) >= 1) {
return '(?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^'. join('', @singleoctet) . '])';
}
else {
return "(?:$your_char)";
}
}
}
sub Einfomixv6als::chr(;$) {
my $c = @_ ? $_[0] : $_;
if ($c == 0x00) {
return "\x00";
}
else {
my @chr = ();
while ($c > 0) {
unshift @chr, ($c % 0x100);
$c = int($c / 0x100);
}
return pack 'C*', @chr;
}
}
sub Einfomixv6als::chr_() {
my $c = $_;
if ($c == 0x00) {
return "\x00";
}
else {
my @chr = ();
while ($c > 0) {
unshift @chr, ($c % 0x100);
$c = int($c / 0x100);
}
return pack 'C*', @chr;
}
}
sub Einfomixv6als::filetest (@) {
my $file = pop @_;
my $filetest = substr(pop @_, 1);
unless (eval qq{Einfomixv6als::$filetest(\$file)}) {
return '';
}
for my $filetest (reverse @_) {
unless (eval qq{ $filetest _ }) {
return '';
}
}
return 1;
}
sub Einfomixv6als::r(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -r (Einfomixv6als::r)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-r _,@_) : -r _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-r $fh,@_) : -r $fh;
}
elsif (-e $_) {
return wantarray ? (-r _,@_) : -r _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-r _,@_) : -r _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $r = -r $fh;
close $fh;
return wantarray ? ($r,@_) : $r;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::w(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -w (Einfomixv6als::w)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-w _,@_) : -w _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-w $fh,@_) : -w $fh;
}
elsif (-e $_) {
return wantarray ? (-w _,@_) : -w _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-w _,@_) : -w _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_WRONLY|O_APPEND) {
my $w = -w $fh;
close $fh;
return wantarray ? ($w,@_) : $w;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::x(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -x (Einfomixv6als::x)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-x _,@_) : -x _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-x $fh,@_) : -x $fh;
}
elsif (-e $_) {
return wantarray ? (-x _,@_) : -x _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-x _,@_) : -x _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $dummy_for_underline_cache = -x $fh;
close $fh;
}
return wantarray ? ('',@_) : '';
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::o(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -o (Einfomixv6als::o)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-o _,@_) : -o _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-o $fh,@_) : -o $fh;
}
elsif (-e $_) {
return wantarray ? (-o _,@_) : -o _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-o _,@_) : -o _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $o = -o $fh;
close $fh;
return wantarray ? ($o,@_) : $o;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::R(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -R (Einfomixv6als::R)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-R _,@_) : -R _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-R $fh,@_) : -R $fh;
}
elsif (-e $_) {
return wantarray ? (-R _,@_) : -R _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-R _,@_) : -R _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $R = -R $fh;
close $fh;
return wantarray ? ($R,@_) : $R;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::W(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -W (Einfomixv6als::W)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-W _,@_) : -W _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-W $fh,@_) : -W $fh;
}
elsif (-e $_) {
return wantarray ? (-W _,@_) : -W _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-W _,@_) : -W _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_WRONLY|O_APPEND) {
my $W = -W $fh;
close $fh;
return wantarray ? ($W,@_) : $W;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::X(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -X (Einfomixv6als::X)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-X _,@_) : -X _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-X $fh,@_) : -X $fh;
}
elsif (-e $_) {
return wantarray ? (-X _,@_) : -X _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-X _,@_) : -X _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $dummy_for_underline_cache = -X $fh;
close $fh;
}
return wantarray ? ('',@_) : '';
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::O(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -O (Einfomixv6als::O)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-O _,@_) : -O _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-O $fh,@_) : -O $fh;
}
elsif (-e $_) {
return wantarray ? (-O _,@_) : -O _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-O _,@_) : -O _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $O = -O $fh;
close $fh;
return wantarray ? ($O,@_) : $O;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::e(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -e (Einfomixv6als::e)' if @_ and not wantarray;
my $fh = Symbol::qualify_to_ref $_;
if ($_ eq '_') {
return wantarray ? (-e _,@_) : -e _;
}
elsif (defined Einfomixv6als::telldir($fh)) {
return wantarray ? ('',@_) : '';
}
elsif (fileno $fh) {
return wantarray ? (1,@_) : 1;
}
elsif (-e $_) {
return wantarray ? (1,@_) : 1;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (1,@_) : 1;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $e = -e $fh;
close $fh;
return wantarray ? ($e,@_) : $e;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::z(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -z (Einfomixv6als::z)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-z _,@_) : -z _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-z $fh,@_) : -z $fh;
}
elsif (-e $_) {
return wantarray ? (-z _,@_) : -z _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-z _,@_) : -z _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $z = -z $fh;
close $fh;
return wantarray ? ($z,@_) : $z;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::s(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -s (Einfomixv6als::s)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-s _,@_) : -s _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-s $fh,@_) : -s $fh;
}
elsif (-e $_) {
return wantarray ? (-s _,@_) : -s _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-s _,@_) : -s _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $s = -s $fh;
close $fh;
return wantarray ? ($s,@_) : $s;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::f(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -f (Einfomixv6als::f)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-f _,@_) : -f _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-f $fh,@_) : -f $fh;
}
elsif (-e $_) {
return wantarray ? (-f _,@_) : -f _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? ('',@_) : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $f = -f $fh;
close $fh;
return wantarray ? ($f,@_) : $f;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::d(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -d (Einfomixv6als::d)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-d _,@_) : -d _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? ('',@_) : '';
}
elsif (-e $_) {
return wantarray ? (-d _,@_) : -d _;
}
elsif (_MSWin32_5Cended_path($_)) {
return wantarray ? (-d "$_/.",@_) : -d "$_/.";
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::l(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -l (Einfomixv6als::l)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-l _,@_) : -l _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-l $fh,@_) : -l $fh;
}
elsif (-e $_) {
return wantarray ? (-l _,@_) : -l _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-l _,@_) : -l _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $l = -l $fh;
close $fh;
return wantarray ? ($l,@_) : $l;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::p(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -p (Einfomixv6als::p)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-p _,@_) : -p _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-p $fh,@_) : -p $fh;
}
elsif (-e $_) {
return wantarray ? (-p _,@_) : -p _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-p _,@_) : -p _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $p = -p $fh;
close $fh;
return wantarray ? ($p,@_) : $p;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::S(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -S (Einfomixv6als::S)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-S _,@_) : -S _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-S $fh,@_) : -S $fh;
}
elsif (-e $_) {
return wantarray ? (-S _,@_) : -S _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-S _,@_) : -S _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $S = -S $fh;
close $fh;
return wantarray ? ($S,@_) : $S;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::b(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -b (Einfomixv6als::b)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-b _,@_) : -b _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-b $fh,@_) : -b $fh;
}
elsif (-e $_) {
return wantarray ? (-b _,@_) : -b _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-b _,@_) : -b _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $b = -b $fh;
close $fh;
return wantarray ? ($b,@_) : $b;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::c(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -c (Einfomixv6als::c)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-c _,@_) : -c _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-c $fh,@_) : -c $fh;
}
elsif (-e $_) {
return wantarray ? (-c _,@_) : -c _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-c _,@_) : -c _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $c = -c $fh;
close $fh;
return wantarray ? ($c,@_) : $c;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::t(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -t (Einfomixv6als::t)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-t _,@_) : -t _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-t $fh,@_) : -t $fh;
}
elsif (-e $_) {
return wantarray ? (-t _,@_) : -t _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? ('',@_) : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
close $fh;
my $t = -t $fh;
return wantarray ? ($t,@_) : $t;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::u(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -u (Einfomixv6als::u)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-u _,@_) : -u _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-u $fh,@_) : -u $fh;
}
elsif (-e $_) {
return wantarray ? (-u _,@_) : -u _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-u _,@_) : -u _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $u = -u $fh;
close $fh;
return wantarray ? ($u,@_) : $u;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::g(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -g (Einfomixv6als::g)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-g _,@_) : -g _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-g $fh,@_) : -g $fh;
}
elsif (-e $_) {
return wantarray ? (-g _,@_) : -g _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-g _,@_) : -g _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $g = -g $fh;
close $fh;
return wantarray ? ($g,@_) : $g;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::k(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -k (Einfomixv6als::k)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-k _,@_) : -k _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-k $fh,@_) : -k $fh;
}
elsif (-e $_) {
return wantarray ? (-k _,@_) : -k _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-k _,@_) : -k _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $k = -k $fh;
close $fh;
return wantarray ? ($k,@_) : $k;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::T(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -T (Einfomixv6als::T)' if @_ and not wantarray;
my $T = 1;
my $fh = Symbol::qualify_to_ref $_;
if (fileno $fh) {
if (defined Einfomixv6als::telldir($fh)) {
return wantarray ? (undef,@_) : undef;
}
my $systell = sysseek $fh, 0, 1;
if (sysread $fh, my $block, 512) {
if ($block =~ /[\000\377]/oxms) {
$T = '';
}
elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) {
$T = '';
}
}
else {
$T = 1;
}
sysseek $fh, $systell, 0;
}
else {
if (-d $_ or -d "$_/.") {
return wantarray ? (undef,@_) : undef;
}
$fh = Symbol::gensym();
unless (sysopen $fh, $_, O_RDONLY) {
return wantarray ? (undef,@_) : undef;
}
if (sysread $fh, my $block, 512) {
if ($block =~ /[\000\377]/oxms) {
$T = '';
}
elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) {
$T = '';
}
}
else {
$T = 1;
}
close $fh;
}
my $dummy_for_underline_cache = -T $fh;
return wantarray ? ($T,@_) : $T;
}
sub Einfomixv6als::B(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -B (Einfomixv6als::B)' if @_ and not wantarray;
my $B = '';
my $fh = Symbol::qualify_to_ref $_;
if (fileno $fh) {
if (defined Einfomixv6als::telldir($fh)) {
return wantarray ? (undef,@_) : undef;
}
my $systell = sysseek $fh, 0, 1;
if (sysread $fh, my $block, 512) {
if ($block =~ /[\000\377]/oxms) {
$B = 1;
}
elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) {
$B = 1;
}
}
else {
$B = 1;
}
sysseek $fh, $systell, 0;
}
else {
if (-d $_ or -d "$_/.") {
return wantarray ? (undef,@_) : undef;
}
$fh = Symbol::gensym();
unless (sysopen $fh, $_, O_RDONLY) {
return wantarray ? (undef,@_) : undef;
}
if (sysread $fh, my $block, 512) {
if ($block =~ /[\000\377]/oxms) {
$B = 1;
}
elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) {
$B = 1;
}
}
else {
$B = 1;
}
close $fh;
}
my $dummy_for_underline_cache = -B $fh;
return wantarray ? ($B,@_) : $B;
}
sub Einfomixv6als::M(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -M (Einfomixv6als::M)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-M _,@_) : -M _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-M $fh,@_) : -M $fh;
}
elsif (-e $_) {
return wantarray ? (-M _,@_) : -M _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-M _,@_) : -M _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh;
close $fh;
my $M = ($^T - $mtime) / (24*60*60);
return wantarray ? ($M,@_) : $M;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::A(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -A (Einfomixv6als::A)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-A _,@_) : -A _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-A $fh,@_) : -A $fh;
}
elsif (-e $_) {
return wantarray ? (-A _,@_) : -A _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-A _,@_) : -A _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh;
close $fh;
my $A = ($^T - $atime) / (24*60*60);
return wantarray ? ($A,@_) : $A;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::C(;*@) {
local $_ = shift if @_;
croak 'Too many arguments for -C (Einfomixv6als::C)' if @_ and not wantarray;
if ($_ eq '_') {
return wantarray ? (-C _,@_) : -C _;
}
elsif (fileno(my $fh = Symbol::qualify_to_ref $_)) {
return wantarray ? (-C $fh,@_) : -C $fh;
}
elsif (-e $_) {
return wantarray ? (-C _,@_) : -C _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return wantarray ? (-C _,@_) : -C _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh;
close $fh;
my $C = ($^T - $ctime) / (24*60*60);
return wantarray ? ($C,@_) : $C;
}
}
}
return wantarray ? (undef,@_) : undef;
}
sub Einfomixv6als::filetest_ (@) {
my $filetest = substr(pop @_, 1);
unless (eval qq{Einfomixv6als::${filetest}_}) {
return '';
}
for my $filetest (reverse @_) {
unless (eval qq{ $filetest _ }) {
return '';
}
}
return 1;
}
sub Einfomixv6als::r_() {
if (-e $_) {
return -r _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -r _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $r = -r $fh;
close $fh;
return $r ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::w_() {
if (-e $_) {
return -w _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -w _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_WRONLY|O_APPEND) {
my $w = -w $fh;
close $fh;
return $w ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::x_() {
if (-e $_) {
return -x _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -x _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $dummy_for_underline_cache = -x $fh;
close $fh;
}
return '';
}
}
return;
}
sub Einfomixv6als::o_() {
if (-e $_) {
return -o _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -o _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $o = -o $fh;
close $fh;
return $o ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::R_() {
if (-e $_) {
return -R _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -R _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $R = -R $fh;
close $fh;
return $R ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::W_() {
if (-e $_) {
return -W _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -W _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_WRONLY|O_APPEND) {
my $W = -W $fh;
close $fh;
return $W ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::X_() {
if (-e $_) {
return -X _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -X _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $dummy_for_underline_cache = -X $fh;
close $fh;
}
return '';
}
}
return;
}
sub Einfomixv6als::O_() {
if (-e $_) {
return -O _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -O _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $O = -O $fh;
close $fh;
return $O ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::e_() {
if (-e $_) {
return 1;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return 1;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $e = -e $fh;
close $fh;
return $e ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::z_() {
if (-e $_) {
return -z _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -z _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $z = -z $fh;
close $fh;
return $z ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::s_() {
if (-e $_) {
return -s _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -s _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $s = -s $fh;
close $fh;
return $s;
}
}
}
return;
}
sub Einfomixv6als::f_() {
if (-e $_) {
return -f _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $f = -f $fh;
close $fh;
return $f ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::d_() {
if (-e $_) {
return -d _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
return -d "$_/." ? 1 : '';
}
return;
}
sub Einfomixv6als::l_() {
if (-e $_) {
return -l _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -l _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $l = -l $fh;
close $fh;
return $l ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::p_() {
if (-e $_) {
return -p _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -p _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $p = -p $fh;
close $fh;
return $p ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::S_() {
if (-e $_) {
return -S _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -S _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $S = -S $fh;
close $fh;
return $S ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::b_() {
if (-e $_) {
return -b _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -b _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $b = -b $fh;
close $fh;
return $b ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::c_() {
if (-e $_) {
return -c _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -c _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $c = -c $fh;
close $fh;
return $c ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::t_() {
return -t STDIN ? 1 : '';
}
sub Einfomixv6als::u_() {
if (-e $_) {
return -u _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -u _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $u = -u $fh;
close $fh;
return $u ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::g_() {
if (-e $_) {
return -g _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -g _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $g = -g $fh;
close $fh;
return $g ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::k_() {
if (-e $_) {
return -k _ ? 1 : '';
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -k _ ? 1 : '';
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my $k = -k $fh;
close $fh;
return $k ? 1 : '';
}
}
}
return;
}
sub Einfomixv6als::T_() {
my $T = 1;
if (-d $_ or -d "$_/.") {
return;
}
my $fh = Symbol::gensym();
unless (sysopen $fh, $_, O_RDONLY) {
return;
}
if (sysread $fh, my $block, 512) {
if ($block =~ /[\000\377]/oxms) {
$T = '';
}
elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) {
$T = '';
}
}
else {
$T = 1;
}
close $fh;
my $dummy_for_underline_cache = -T $fh;
return $T;
}
sub Einfomixv6als::B_() {
my $B = '';
if (-d $_ or -d "$_/.") {
return;
}
my $fh = Symbol::gensym();
unless (sysopen $fh, $_, O_RDONLY) {
return;
}
if (sysread $fh, my $block, 512) {
if ($block =~ /[\000\377]/oxms) {
$B = 1;
}
elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) {
$B = 1;
}
}
else {
$B = 1;
}
close $fh;
my $dummy_for_underline_cache = -B $fh;
return $B;
}
sub Einfomixv6als::M_() {
if (-e $_) {
return -M _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -M _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh;
close $fh;
my $M = ($^T - $mtime) / (24*60*60);
return $M;
}
}
}
return;
}
sub Einfomixv6als::A_() {
if (-e $_) {
return -A _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -A _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh;
close $fh;
my $A = ($^T - $atime) / (24*60*60);
return $A;
}
}
}
return;
}
sub Einfomixv6als::C_() {
if (-e $_) {
return -C _;
}
elsif (_MSWin32_5Cended_path($_)) {
if (-d "$_/.") {
return -C _;
}
else {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh;
close $fh;
my $C = ($^T - $ctime) / (24*60*60);
return $C;
}
}
}
return;
}
sub Einfomixv6als::glob($) {
return _dosglob(@_);
}
sub Einfomixv6als::glob_() {
return _dosglob();
}
my %iter;
my %entries;
sub _dosglob {
my($expr,$cxix) = @_;
$expr = $_ if not defined $expr;
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
$expr =~ s{ \A ~ (?= [^/\\] ) }
{ $ENV{'HOME'} || $ENV{'USERPROFILE'} || "$ENV{'HOMEDRIVE'}$ENV{'HOMEPATH'}" }oxmse;
}
else {
$expr =~ s{ \A ~ ( (?:\xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^/])* ) }
{ $1 ? (getpwnam($1))[7] : ($ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7]) }oxmse;
}
$cxix = '_G_' if not defined $cxix;
$iter{$cxix} = 0 if not exists $iter{$cxix};
if ($iter{$cxix} == 0) {
$entries{$cxix} = [ _do_glob(1, _parse_line($expr)) ];
}
if (wantarray) {
delete $iter{$cxix};
return @{delete $entries{$cxix}};
}
else {
if ($iter{$cxix} = scalar @{$entries{$cxix}}) {
return shift @{$entries{$cxix}};
}
else {
delete $iter{$cxix};
delete $entries{$cxix};
return undef;
}
}
}
sub _do_glob {
my($cond,@expr) = @_;
my @glob = ();
OUTER:
for my $expr (@expr) {
next OUTER if not defined $expr;
next OUTER if $expr eq '';
my @matched = ();
my @globdir = ();
my $head = '.';
my $pathsep = '/';
my $tail;
if ($expr =~ m/\A " ((?:$q_char)*) " \z/oxms) {
$expr = $1;
if ($cond eq 'd') {
if (Einfomixv6als::d $expr) {
push @glob, $expr;
}
}
else {
if (Einfomixv6als::e $expr) {
push @glob, $expr;
}
}
next OUTER;
}
if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
$expr =~ s
}
if (($head, $tail) = _parse_path($expr,$pathsep)) {
if ($tail eq '') {
push @glob, $expr;
next OUTER;
}
if ($head =~ m/ \A (?:$q_char)*? [*?] /oxms) {
if (@globdir = _do_glob('d', $head)) {
push @glob, _do_glob($cond, map {"$_$pathsep$tail"} @globdir);
next OUTER;
}
}
if ($head eq '' or $head =~ m/\A [A-Za-z]: \z/oxms) {
$head .= $pathsep;
}
$expr = $tail;
}
if ($expr !~ m/ \A (?:$q_char)*? [*?] /oxms) {
if ($head eq '.') {
$head = '';
}
if ($head ne '' and ($head =~ m/ \G ($q_char) /oxmsg)[-1] ne $pathsep) {
$head .= $pathsep;
}
$head .= $expr;
if ($cond eq 'd') {
if (Einfomixv6als::d $head) {
push @glob, $head;
}
}
else {
if (Einfomixv6als::e $head) {
push @glob, $head;
}
}
next OUTER;
}
Einfomixv6als::opendir(*DIR, $head) or next OUTER;
my @leaf = readdir DIR;
closedir DIR;
if ($head eq '.') {
$head = '';
}
if ($head ne '' and ($head =~ m/ \G ($q_char) /oxmsg)[-1] ne $pathsep) {
$head .= $pathsep;
}
my $pattern = '';
while ($expr =~ m/ \G ($q_char) /oxgc) {
$pattern .= {
'*' => "(?:$your_char)*",
'?' => "(?:$your_char)?",
'a' => 'A',
'b' => 'B',
'c' => 'C',
'd' => 'D',
'e' => 'E',
'f' => 'F',
'g' => 'G',
'h' => 'H',
'i' => 'I',
'j' => 'J',
'k' => 'K',
'l' => 'L',
'm' => 'M',
'n' => 'N',
'o' => 'O',
'p' => 'P',
'q' => 'Q',
'r' => 'R',
's' => 'S',
't' => 'T',
'u' => 'U',
'v' => 'V',
'w' => 'W',
'x' => 'X',
'y' => 'Y',
'z' => 'Z',
}->{$1} || quotemeta $1;
}
my $matchsub = sub { Einfomixv6als::uc($_[0]) =~ m{\A $pattern \z}xms };
INNER:
for my $leaf (@leaf) {
if ($leaf eq '.' or $leaf eq '..') {
next INNER;
}
if ($cond eq 'd' and not Einfomixv6als::d "$head$leaf") {
next INNER;
}
if (&$matchsub($leaf)) {
push @matched, "$head$leaf";
next INNER;
}
if (Einfomixv6als::index($leaf,'.') == -1 and
CORE::length($leaf) <= 8 and
Einfomixv6als::index($pattern,'\\.') != -1
) {
if (&$matchsub("$leaf.")) {
push @matched, "$head$leaf";
next INNER;
}
}
}
if (@matched) {
push @glob, @matched;
}
}
return @glob;
}
sub _parse_line {
my($line) = @_;
$line .= ' ';
my @piece = ();
while ($line =~ m{
" ( (?: \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^"] )* ) " \s+ |
( (?: \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^"\s] )* ) \s+
}oxmsg
) {
push @piece, defined($1) ? $1 : $2;
}
return @piece;
}
sub _parse_path {
my($path,$pathsep) = @_;
$path .= '/';
my @subpath = ();
while ($path =~ m{
((?: \xFD[\xA1-\xFE][\xA1-\xFE]|[\x81-\x9F\xE0-\xFC][\x00-\xFF]|[^/\\] )+?) [/\\] }oxmsg
) {
push @subpath, $1;
}
my $tail = pop @subpath;
my $head = join $pathsep, @subpath;
return $head, $tail;
}
sub Einfomixv6als::lstat(*) {
local $_ = shift if @_;
my $fh = Symbol::qualify_to_ref $_;
if (fileno $fh) {
return CORE::lstat $fh;
}
elsif (-e $_) {
return CORE::lstat _;
}
elsif (_MSWin32_5Cended_path($_)) {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my @lstat = CORE::lstat $fh;
close $fh;
return @lstat;
}
}
return;
}
sub Einfomixv6als::lstat_() {
my $fh = Symbol::qualify_to_ref $_;
if (fileno $fh) {
return CORE::lstat $fh;
}
elsif (-e $_) {
return CORE::lstat _;
}
elsif (_MSWin32_5Cended_path($_)) {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my @lstat = CORE::lstat $fh;
close $fh;
return @lstat;
}
}
return;
}
sub Einfomixv6als::opendir(*$) {
my $dh = Symbol::qualify_to_ref $_[0];
if (CORE::opendir $dh, $_[1]) {
return 1;
}
elsif (_MSWin32_5Cended_path($_[1])) {
if (CORE::opendir $dh, "$_[1]/.") {
return 1;
}
}
return;
}
sub Einfomixv6als::stat(*) {
local $_ = shift if @_;
my $fh = Symbol::qualify_to_ref $_;
if (fileno $fh) {
return CORE::stat $fh;
}
elsif (-e $_) {
return CORE::stat _;
}
elsif (_MSWin32_5Cended_path($_)) {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my @stat = CORE::stat $fh;
close $fh;
return @stat;
}
}
return;
}
sub Einfomixv6als::stat_() {
my $fh = Symbol::qualify_to_ref $_;
if (fileno $fh) {
return CORE::stat $fh;
}
elsif (-e $_) {
return CORE::stat _;
}
elsif (_MSWin32_5Cended_path($_)) {
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
my @stat = CORE::stat $fh;
close $fh;
return @stat;
}
}
return;
}
sub Einfomixv6als::unlink(@) {
local @_ = ($_) unless @_;
my $unlink = 0;
for (@_) {
if (CORE::unlink) {
$unlink++;
}
elsif (_MSWin32_5Cended_path($_)) {
my @char = m/\G ($q_char) /oxmsg;
my $file = join '', map {{'/' => '\\'}->{$_} || $_} @char;
if ($file =~ m/ \A (?:$q_char)*? [ ] /oxms) {
$file = qq{"$file"};
}
local @ENV{qw(IFS CDPATH ENV BASH_ENV)};
system qq{del $file >NUL 2>NUL};
my $fh = Symbol::gensym();
if (sysopen $fh, $_, O_RDONLY) {
close $fh;
}
else {
$unlink++;
}
}
}
return $unlink;
}
sub Einfomixv6als::chdir(;$) {
my($dir) = @_;
if (not defined $dir) {
$dir = ($ENV{'HOME'} || $ENV{'USERPROFILE'} || "$ENV{'HOMEDRIVE'}$ENV{'HOMEPATH'}");
}
if (_MSWin32_5Cended_path($dir)) {
if (not Einfomixv6als::d $dir) {
return 0;
}
if ($] =~ /^5\.005/) {
return CORE::chdir $dir;
}
elsif ($] =~ /^5\.006/) {
croak "perl$] can't chdir to $dir (chr(0x5C) ended path)";
}
elsif ($] =~ /^5\.008/) {
croak "perl$] can't chdir to $dir (chr(0x5C) ended path)";
}
elsif ($] =~ /^5\.010/) {
croak "perl$] can't chdir to $dir (chr(0x5C) ended path)";
}
else {
croak "perl$] can't chdir to $dir (chr(0x5C) ended path)";
}
}
else {
return CORE::chdir $dir;
}
}
sub _MSWin32_5Cended_path {
if ((@_ >= 1) and ($_[0] ne '')) {
if ($^O =~ m/\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) {
my @char = $_[0] =~ /\G ($q_char) /oxmsg;
if ($char[-1] =~ m/ \x5C \z/oxms) {
return 1;
}
}
}
return;
}
sub Einfomixv6als::do($) {
my($filename) = @_;
my $realfilename;
my $result;
ITER_DO:
{
for my $prefix (@INC) {
$realfilename = "$prefix/$filename";
if (Einfomixv6als::f($realfilename)) {
my $script = '';
my $e_mtime = (Einfomixv6als::stat("$realfilename.e"))[9];
my $mtime = (Einfomixv6als::stat($realfilename))[9];
my $module_mtime = (Einfomixv6als::stat("$FindBin::Bin/INFOMIXV6ALS.pm"))[9];
if (Einfomixv6als::e("$realfilename.e") and ($mtime < $e_mtime) and ($module_mtime < $e_mtime)) {
my $fh = Symbol::gensym();
sysopen $fh, "$realfilename.e", O_RDONLY;
local $/ = undef;
$script = <$fh>;
close $fh;
}
else {
my $fh = Symbol::gensym();
sysopen $fh, $realfilename, O_RDONLY;
local $/ = undef;
$script = <$fh>;
close $fh;
if ($script =~ m/^ \s* use \s+ INFOMIXV6ALS \s* ([^;]*) ; \s* \n? $/oxms) {
$script = INFOMIXV6ALS::escape_script($script);
my $fh = Symbol::gensym();
sysopen $fh, "$realfilename.e", O_WRONLY | O_TRUNC | O_CREAT;
print {$fh} $script;
close $fh;
}
}
no strict;
local $^W = $_warning;
local $@;
$result = eval $script;
last ITER_DO;
}
}
}
$INC{$filename} = $realfilename;
return $result;
}
sub Einfomixv6als::require(;$) {
local $_ = shift if @_;
return 1 if $INC{$_};
if (m{ \b (?: jcode\.pl | jacode\.pl) \z }oxms) {
return CORE::require($_);
}
my $realfilename;
my $result;
ITER_REQUIRE:
{
for my $prefix (@INC) {
$realfilename = "$prefix/$_";
if (Einfomixv6als::f($realfilename)) {
my $script = '';
my $e_mtime = (Einfomixv6als::stat("$realfilename.e"))[9];
my $mtime = (Einfomixv6als::stat($realfilename))[9];
my $module_mtime = (Einfomixv6als::stat("$FindBin::Bin/INFOMIXV6ALS.pm"))[9];
if (Einfomixv6als::e("$realfilename.e") and ($mtime < $e_mtime) and ($module_mtime < $e_mtime)) {
my $fh = Symbol::gensym();
sysopen($fh, "$realfilename.e", O_RDONLY) or croak "Can't open file: $realfilename.e";
local $/ = undef;
$script = <$fh>;
close($fh) or croak "Can't close file: $realfilename";
}
else {
my $fh = Symbol::gensym();
sysopen($fh, $realfilename, O_RDONLY) or croak "Can't open file: $realfilename";
local $/ = undef;
$script = <$fh>;
close($fh) or croak "Can't close file: $realfilename";
if ($script =~ m/^ \s* use \s+ INFOMIXV6ALS \s* ([^;]*) ; \s* \n? $/oxms) {
$script = INFOMIXV6ALS::escape_script($script);
my $fh = Symbol::gensym();
sysopen($fh, "$realfilename.e", O_WRONLY | O_TRUNC | O_CREAT) or croak "Can't open file: $realfilename.e";
print {$fh} $script;
close($fh) or croak "Can't close file: $realfilename";
}
}
no strict;
local $^W = $_warning;
$result = eval $script;
last ITER_REQUIRE;
}
}
croak "Can't find $_ in \@INC";
}
croak $@ if $@;
croak "$_ did not return true value" unless $result;
$INC{$_} = $realfilename;
return $result;
}
sub Einfomixv6als::telldir(*) {
local $^W = 0;
return CORE::telldir $_[0];
}
sub INFOMIXV6ALS::ord(;$) {
local $_ = shift if @_;
if (m/\A ($q_char) /oxms) {
my @ord = unpack 'C*', $1;
my $ord = 0;
while (my $o = shift @ord) {
$ord = $ord * 0x100 + $o;
}
return $ord;
}
else {
return CORE::ord $_;
}
}
sub INFOMIXV6ALS::ord_() {
if (m/\A ($q_char) /oxms) {
my @ord = unpack 'C*', $1;
my $ord = 0;
while (my $o = shift @ord) {
$ord = $ord * 0x100 + $o;
}
return $ord;
}
else {
return CORE::ord $_;
}
}
sub INFOMIXV6ALS::reverse(@) {
if (wantarray) {
return CORE::reverse @_;
}
else {
return join '', CORE::reverse(join('',@_) =~ m/\G ($q_char) /oxmsg);
}
}
sub INFOMIXV6ALS::length(;$) {
local $_ = shift if @_;
local @_ = m/\G ($q_char) /oxmsg;
return scalar @_;
}
sub INFOMIXV6ALS::substr($$;$$) {
my @char = $_[0] =~ m/\G ($q_char) /oxmsg;
if (@_ == 4) {
my(undef,$offset,$length,$replacement) = @_;
my $substr = join '', splice(@char, $offset, $length, $replacement);
$_[0] = join '', @char;
return $substr;
}
elsif (@_ == 3) {
my(undef,$offset,$length) = @_;
if ($length == 0) {
return '';
}
if ($offset >= 0) {
return join '', (@char[$offset .. $#char])[0 .. $length-1];
}
else {
return join '', (@char[($#char+$offset+1) .. $#char])[0 .. $length-1];
}
}
else {
my(undef,$offset) = @_;
if ($offset >= 0) {
return join '', @char[$offset .. $#char];
}
else {
return join '', @char[($#char+$offset+1) .. $#char];
}
}
}
sub INFOMIXV6ALS::index($$;$) {
my $index;
if (@_ == 3) {
$index = Einfomixv6als::index($_[0], $_[1], CORE::length(INFOMIXV6ALS::substr($_[0], 0, $_[2])));
}
else {
$index = Einfomixv6als::index($_[0], $_[1]);
}
if ($index == -1) {
return -1;
}
else {
return INFOMIXV6ALS::length(CORE::substr $_[0], 0, $index);
}
}
sub INFOMIXV6ALS::rindex($$;$) {
my $rindex;
if (@_ == 3) {
$rindex = Einfomixv6als::rindex($_[0], $_[1], CORE::length(INFOMIXV6ALS::substr($_[0], 0, $_[2])));
}
else {
$rindex = Einfomixv6als::rindex($_[0], $_[1]);
}
if ($rindex == -1) {
return -1;
}
else {
return INFOMIXV6ALS::length(CORE::substr $_[0], 0, $rindex);
}
}
$^W = $_warning;
1;