Big5
view release on metacpan or search on metacpan
lib/Ebig5.pm view on Meta::CPAN
$char[$i] = e_capture($1);
}
# $$foo[ ... ] --> $ $foo->[ ... ]
elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
}
# $$foo{ ... } --> $ $foo->{ ... }
elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) {
$char[$i] = e_capture($1.'->'.$2);
}
# $$foo
elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) {
$char[$i] = e_capture($1);
}
# $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5::PREMATCH()
elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH | \$ (?>\s*) \{ (?>\s*) PREMATCH (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Ebig5::PREMATCH()]}';
}
# $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5::MATCH()
elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH | \$ (?>\s*) \{ (?>\s*) MATCH (?>\s*) \} | \$ (?>\s*) \{\^MATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Ebig5::MATCH()]}';
}
# $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5::POSTMATCH()
elsif ($char[$i] =~ /\A ( \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) {
$char[$i] = '@{[Ebig5::POSTMATCH()]}';
}
# ${ foo } --> ${ foo }
elsif ($char[$i] =~ /\A \$ (?>\s*) \{ (?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \} \z/oxms) {
}
# ${ ... }
elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) {
$char[$i] = e_capture($1);
}
}
# return string
if ($left_e > $right_e) {
return join '', @char, '>]}' x ($left_e - $right_e);
}
return join '', @char;
}
#
# escape regexp (m//, qr//)
#
sub e_qr {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
# literal null string pattern
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
# /b /B modifier
elsif ($modifier =~ tr/bB//d) {
# choice again delimiter
if ($delimiter =~ / [\@:] /oxms) {
my @char = $string =~ /\G ([\x00-\xFF]) /oxmsg;
my %octet = map {$_ => 1} @char;
if (not $octet{')'}) {
$delimiter = '(';
$end_delimiter = ')';
}
elsif (not $octet{'}'}) {
$delimiter = '{';
$end_delimiter = '}';
}
elsif (not $octet{']'}) {
$delimiter = '[';
$end_delimiter = ']';
}
elsif (not $octet{'>'}) {
$delimiter = '<';
$end_delimiter = '>';
}
else {
for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
$delimiter = $char;
$end_delimiter = $char;
last;
}
}
}
}
if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) {
return join '', $ope, $delimiter, $string, $matched, $end_delimiter, $modifier;
}
else {
return join '', $ope, $delimiter, '(?:', $string, ')', $matched, $end_delimiter, $modifier;
}
}
my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0;
lib/Ebig5.pm view on Meta::CPAN
die __FILE__, qq{: "MULTIBYTE$char[$i]" should be "(MULTIBYTE)$char[$i]" in m?? (and shift \$1,\$2,\$3,...) ($char)$char[$i]\n};
}
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
# make regexp string
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) {
return join '', $ope, $delimiter, $anchor, @char, '>]}' x ($left_e - $right_e), $matched, $end_delimiter, $modifier;
}
else {
return join '', $ope, $delimiter, $anchor, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier;
}
}
if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) {
return join '', $ope, $delimiter, $anchor, @char, $matched, $end_delimiter, $modifier;
}
else {
return join '', $ope, $delimiter, $anchor, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
}
#
# double quote stuff
#
sub qq_stuff {
my($delimiter,$end_delimiter,$stuff) = @_;
# scalar variable or array variable
if ($stuff =~ /\A [\$\@] /oxms) {
return $stuff;
}
# quote by delimiter
my %octet = map {$_ => 1} ($stuff =~ /\G ([\x00-\xFF]) /oxmsg);
for my $char (qw( ! " $ % & * + - . / : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
next if $char eq $delimiter;
next if $char eq $end_delimiter;
if (not $octet{$char}) {
return join '', 'qq', $char, $stuff, $char;
}
}
return join '', 'qq', '<', $stuff, '>';
}
#
# escape regexp (m'', qr'', and m''b, qr''b)
#
sub e_qr_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
# literal null string pattern
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
# with /b /B modifier
elsif ($modifier =~ tr/bB//d) {
return e_qr_qb($ope,$delimiter,$end_delimiter,$string,$modifier);
}
# without /b /B modifier
else {
return e_qr_qt($ope,$delimiter,$end_delimiter,$string,$modifier);
}
}
#
# escape regexp (m'', qr'')
#
sub e_qr_qt {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0;
# split regexp
my @char = $string =~ /\G((?>
[^\x81-\xFE\\\[\$\@\/] |
[\x81-\xFE][\x00-\xFF] |
\[\^ |
\[\: (?>[a-z]+) \:\] |
\[\:\^ (?>[a-z]+) \:\] |
[\$\@\/] |
\\ (?:$q_char) |
(?:$q_char)
))/oxmsg;
# unescape character
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
# escape last octet of multiple-octet
elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
# open character class [...]
elsif ($char[$i] eq '[') {
lib/Ebig5.pm view on Meta::CPAN
$char[$i] = '(?:' . Ebig5::uc($char[$i]) . '|' . Ebig5::fc($char[$i]) . ')';
}
}
# quote character before ? + * {
elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
$delimiter = '/';
$end_delimiter = '/';
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $anchor, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
#
# escape regexp (m''b, qr''b)
#
sub e_qr_qb {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
# split regexp
my @char = $string =~ /\G ((?>[^\\]|\\\\|[\x00-\xFF])) /oxmsg;
# unescape character
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
# remain \\
elsif ($char[$i] eq '\\\\') {
}
# escape $ @ / and \
elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) {
$char[$i] = '\\' . $char[$i];
}
}
$delimiter = '/';
$end_delimiter = '/';
return join '', $ope, $delimiter, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
#
# escape regexp (s/here//)
#
sub e_s1 {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
# literal null string pattern
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
# /b /B modifier
elsif ($modifier =~ tr/bB//d) {
# choice again delimiter
if ($delimiter =~ / [\@:] /oxms) {
my @char = $string =~ /\G ([\x00-\xFF]) /oxmsg;
my %octet = map {$_ => 1} @char;
if (not $octet{')'}) {
$delimiter = '(';
$end_delimiter = ')';
}
elsif (not $octet{'}'}) {
$delimiter = '{';
$end_delimiter = '}';
}
elsif (not $octet{']'}) {
$delimiter = '[';
$end_delimiter = ']';
}
elsif (not $octet{'>'}) {
$delimiter = '<';
$end_delimiter = '>';
}
else {
for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") {
if (not $octet{$char}) {
$delimiter = $char;
$end_delimiter = $char;
last;
}
}
}
}
my $prematch = '';
$prematch = q{(\G[\x00-\xFF]*?)};
return join '', $ope, $delimiter, $prematch, '(?:', $string, ')', $matched, $end_delimiter, $modifier;
}
my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0;
my $metachar = qr/[\@\\|[\]{^]/oxms;
# split regexp
lib/Ebig5.pm view on Meta::CPAN
$char[$i] = '@{[Ebig5::ignorecase(Ebig5::POSTMATCH())]}';
}
else {
$char[$i] = '@{[Ebig5::POSTMATCH()]}';
}
}
# ${ foo }
elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(' . $char[$i] . ')]}';
}
}
# ${ ... }
elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(' . $char[$i] . ')]}';
}
}
# $scalar or @array
elsif ($char[$i] =~ /\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(' . $char[$i] . ')]}';
}
}
# quote character before ? + * {
elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
# make regexp string
my $prematch = '';
$prematch = "($anchor)";
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
return join '', $ope, $delimiter, $prematch, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier;
}
return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
#
# escape regexp (s'here'' or s'here''b)
#
sub e_s1_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
# literal null string pattern
if ($string eq '') {
$modifier =~ tr/bB//d;
$modifier =~ tr/i//d;
return join '', $ope, $delimiter, $end_delimiter, $modifier;
}
# with /b /B modifier
elsif ($modifier =~ tr/bB//d) {
return e_s1_qb($ope,$delimiter,$end_delimiter,$string,$modifier);
}
# without /b /B modifier
else {
return e_s1_qt($ope,$delimiter,$end_delimiter,$string,$modifier);
}
}
#
# escape regexp (s'here'')
#
sub e_s1_qt {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0;
# split regexp
my @char = $string =~ /\G((?>
[^\x81-\xFE\\\[\$\@\/] |
[\x81-\xFE][\x00-\xFF] |
\[\^ |
\[\: (?>[a-z]+) \:\] |
\[\:\^ (?>[a-z]+) \:\] |
[\$\@\/] |
\\ (?:$q_char) |
(?:$q_char)
))/oxmsg;
# unescape character
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
# escape last octet of multiple-octet
elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
# open character class [...]
elsif ($char[$i] eq '[') {
lib/Ebig5.pm view on Meta::CPAN
# escape $ @ / and \
elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) {
$char[$i] = '\\' . $char[$i];
}
}
$delimiter = '/';
$end_delimiter = '/';
my $prematch = '';
$prematch = q{(\G[\x00-\xFF]*?)};
return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier;
}
#
# escape regexp (s''here')
#
sub e_s2_q {
my($ope,$delimiter,$end_delimiter,$string) = @_;
$slash = 'div';
my @char = $string =~ / \G (?>[^\x81-\xFE\\]|\\\\|$q_char) /oxmsg;
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
# escape last octet of multiple-octet
elsif ($char[$i] =~ /\A ([\x80-\xFF].*) (\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
elsif (defined($char[$i+1]) and ($char[$i+1] eq '\\') and ($char[$i] =~ /\A ([\x80-\xFF].*) (\\) \z/xms)) {
$char[$i] = $1 . '\\' . $2;
}
# not escape \\
elsif ($char[$i] =~ /\A \\\\ \z/oxms) {
}
# escape $ @ / and \
elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) {
$char[$i] = '\\' . $char[$i];
}
}
if (defined($char[-1]) and ($char[-1] =~ /\A ([\x80-\xFF].*) (\\) \z/xms)) {
$char[-1] = $1 . '\\' . $2;
}
return join '', $ope, $delimiter, @char, $end_delimiter;
}
#
# escape regexp (s/here/and here/modifier)
#
sub e_sub {
my($variable,$delimiter1,$pattern,$end_delimiter1,$delimiter2,$replacement,$end_delimiter2,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
if ($variable eq '') {
$variable = '$_';
$bind_operator = ' =~ ';
}
$slash = 'div';
# P.128 Start of match (or end of previous match): \G
# P.130 Advanced Use of \G with Perl
# in Chapter 3: Overview of Regular Expression Features and Flavors
# P.312 Iterative Matching: Scalar Context, with /g
# in Chapter 7: Perl
# of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition
# P.181 Where You Left Off: The \G Assertion
# in Chapter 5: Pattern Matching
# of ISBN 0-596-00027-8 Programming Perl Third Edition.
# P.220 Where You Left Off: The \G Assertion
# in Chapter 5: Pattern Matching
# of ISBN 978-0-596-00492-7 Programming Perl 4th Edition.
my $e_modifier = $modifier =~ tr/e//d;
my $r_modifier = $modifier =~ tr/r//d;
my $my = '';
if ($variable =~ s/\A \( (?>\s*) ( (?>(?: local \b | my \b | our \b | state \b )?) .+ ) \) \z/$1/oxms) {
$my = $variable;
$variable =~ s/ (?: local \b | my \b | our \b | state \b ) (?>\s*) //oxms;
$variable =~ s/ = .+ \z//oxms;
}
(my $variable_basename = $variable) =~ s/ [\[\{].* \z//oxms;
$variable_basename =~ s/ \s+ \z//oxms;
# quote replacement string
my $e_replacement = '';
if ($e_modifier >= 1) {
$e_replacement = e_qq('', '', '', $replacement);
$e_modifier--;
}
else {
if ($delimiter2 eq "'") {
$e_replacement = e_s2_q('qq', '/', '/', $replacement);
}
else {
$e_replacement = e_qq ('qq', $delimiter2, $end_delimiter2, $replacement);
}
}
my $sub = '';
lib/Ebig5.pm view on Meta::CPAN
$sub_variable = '';
$bind_operator = '';
return $sub;
}
#
# escape chdir (qq//, "")
#
sub e_chdir {
my($ope,$delimiter,$end_delimiter,$string) = @_;
if ($^W) {
if (Ebig5::_MSWin32_5Cended_path($string)) {
if ($] !~ /^5\.005/oxms) {
warn <<END;
@{[__FILE__]}: Can't chdir to '$string'
chdir does not work with chr(0x5C) at end of path
http://bugs.activestate.com/show_bug.cgi?id=81839
END
}
}
}
return e_qq($ope,$delimiter,$end_delimiter,$string);
}
#
# escape chdir (q//, '')
#
sub e_chdir_q {
my($ope,$delimiter,$end_delimiter,$string) = @_;
if ($^W) {
if (Ebig5::_MSWin32_5Cended_path($string)) {
if ($] !~ /^5\.005/oxms) {
warn <<END;
@{[__FILE__]}: Can't chdir to '$string'
chdir does not work with chr(0x5C) at end of path
http://bugs.activestate.com/show_bug.cgi?id=81839
END
}
}
}
return e_q($ope,$delimiter,$end_delimiter,$string);
}
#
# escape regexp of split qr//
#
sub e_split {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
# /b /B modifier
if ($modifier =~ tr/bB//d) {
return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier;
}
my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0;
my $metachar = qr/[\@\\|[\]{^]/oxms;
# split regexp
my @char = $string =~ /\G((?>
[^\x81-\xFE\\\$\@\[\(]|[\x81-\xFE][\x00-\xFF] |
\\x (?>[0-9A-Fa-f]{1,2}) |
\\ (?>[0-7]{2,3}) |
\\c [\x40-\x5F] |
\\x\{ (?>[0-9A-Fa-f]+) \} |
\\o\{ (?>[0-7]+) \} |
\\[bBNpP]\{ (?>[^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} |
\\ $q_char |
\$` | \$\{`\} | \$ (?>\s*) PREMATCH | \$ (?>\s*) \{ (?>\s*) PREMATCH (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\} |
\$& | \$\{&\} | \$ (?>\s*) MATCH | \$ (?>\s*) \{ (?>\s*) MATCH (?>\s*) \} | \$ (?>\s*) \{\^MATCH\} |
\$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} |
[\$\@] $qq_variable |
\$ (?>\s* [0-9]+) |
\$ (?>\s*) \{ (?>\s* [0-9]+ \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++) {
# "\L\u" --> "\u\L"
if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
# "\U\l" --> "\l\U"
elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) {
@char[$i,$i+1] = @char[$i+1,$i];
}
# octal escape sequence
elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) {
$char[$i] = Ebig5::octchr($1);
lib/Ebig5.pm view on Meta::CPAN
elsif ($char[$i] =~ /\A ( \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) {
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(Ebig5::POSTMATCH())]}';
}
else {
$char[$i] = '@{[Ebig5::POSTMATCH()]}';
}
}
# ${ foo }
elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \} \z/oxms) {
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(' . $1 . ')]}';
}
}
# ${ ... }
elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) {
$char[$i] = e_capture($1);
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(' . $char[$i] . ')]}';
}
}
# $scalar or @array
elsif ($char[$i] =~ /\A [\$\@].+ /oxms) {
$char[$i] = e_string($char[$i]);
if ($ignorecase) {
$char[$i] = '@{[Ebig5::ignorecase(' . $char[$i] . ')]}';
}
}
# quote character before ? + * {
elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) {
if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) {
}
else {
$char[$i-1] = '(?:' . $char[$i-1] . ')';
}
}
}
# make regexp string
$modifier =~ tr/i//d;
if ($left_e > $right_e) {
return join '', 'Ebig5::split', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter, $modifier;
}
return join '', 'Ebig5::split', $ope, $delimiter, @char, $end_delimiter, $modifier;
}
#
# escape regexp of split qr''
#
sub e_split_q {
my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_;
$modifier ||= '';
$modifier =~ tr/p//d;
if ($modifier =~ /([adlu])/oxms) {
my $line = 0;
for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) {
if ($filename ne __FILE__) {
$line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1;
last;
}
}
die qq{Unsupported modifier "$1" used at line $line.\n};
}
$slash = 'div';
# /b /B modifier
if ($modifier =~ tr/bB//d) {
return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier;
}
my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0;
# split regexp
my @char = $string =~ /\G((?>
[^\x81-\xFE\\\[] |
[\x81-\xFE][\x00-\xFF] |
\[\^ |
\[\: (?>[a-z]+) \:\] |
\[\:\^ (?>[a-z]+) \:\] |
\\ (?:$q_char) |
(?:$q_char)
))/oxmsg;
# unescape character
for (my $i=0; $i <= $#char; $i++) {
if (0) {
}
# escape last octet of multiple-octet
elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) {
$char[$i] = $1 . '\\' . $2;
}
# open character class [...]
elsif ($char[$i] eq '[') {
my $left = $i;
if ($char[$i+1] eq ']') {
$i++;
}
while (1) {
if (++$i > $#char) {
die __FILE__, ": Unmatched [] in regexp\n";
}
if ($char[$i] eq ']') {
my $right = $i;
# [...]
splice @char, $left, $right-$left+1, Ebig5::charlist_qr(@char[$left+1..$right-1], $modifier);
$i = $left;
last;
}
}
}
lib/Ebig5.pm view on Meta::CPAN
# escape no with unimport parameters
#
sub e_no {
my($module,$list) = @_;
my $expr = _pathof($module);
my $fh = gensym();
for my $realfilename (_realfilename($expr)) {
if (Ebig5::_open_r($fh, $realfilename)) {
local $/ = undef; # slurp mode
my $script = <$fh>;
close($fh) or die "Can't close file: $realfilename: $!";
if ($script =~ /^ (?>\s*) use (?>\s+) Big5 (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) {
return qq[BEGIN { Ebig5::require '$expr'; $module->unimport($list) if $module->can('unimport'); }];
}
last;
}
}
return qq<no $module $list;>;
}
#
# file path of module
#
sub _pathof {
my($expr) = @_;
if ($^O eq 'MacOS') {
$expr =~ s#::#:#g;
}
else {
$expr =~ s#::#/#g;
}
$expr .= '.pm' if $expr !~ / \.pm \z/oxmsi;
return $expr;
}
#
# real file name of module
#
sub _realfilename {
my($expr) = @_;
if ($^O eq 'MacOS') {
return map {"$_$expr"} @INC;
}
else {
return map {"$_/$expr"} @INC;
}
}
#
# instead of Carp::carp
#
sub carp {
my($package,$filename,$line) = caller(1);
print STDERR "@_ at $filename line $line.\n";
}
#
# instead of Carp::croak
#
sub croak {
my($package,$filename,$line) = caller(1);
print STDERR "@_ at $filename line $line.\n";
die "\n";
}
#
# instead of Carp::cluck
#
sub cluck {
my $i = 0;
my @cluck = ();
while (my($package,$filename,$line,$subroutine) = caller($i)) {
push @cluck, "[$i] $filename($line) $package::$subroutine\n";
$i++;
}
print STDERR CORE::reverse @cluck;
print STDERR "\n";
print STDERR @_;
}
#
# instead of Carp::confess
#
sub confess {
my $i = 0;
my @confess = ();
while (my($package,$filename,$line,$subroutine) = caller($i)) {
push @confess, "[$i] $filename($line) $package::$subroutine\n";
$i++;
}
print STDERR CORE::reverse @confess;
print STDERR "\n";
print STDERR @_;
die "\n";
}
1;
__END__
=pod
=head1 NAME
Ebig5 - Run-time routines for Big5.pm
=head1 SYNOPSIS
use Ebig5;
Ebig5::split(...);
Ebig5::tr(...);
Ebig5::chop(...);
Ebig5::index(...);
Ebig5::rindex(...);
Ebig5::lc(...);
Ebig5::lc_;
Ebig5::lcfirst(...);
Ebig5::lcfirst_;
Ebig5::uc(...);
Ebig5::uc_;
Ebig5::ucfirst(...);
Ebig5::ucfirst_;
Ebig5::fc(...);
Ebig5::fc_;
Ebig5::ignorecase(...);
Ebig5::capture(...);
Ebig5::chr(...);
Ebig5::chr_;
Ebig5::X ...;
Ebig5::X_;
Ebig5::glob(...);
Ebig5::glob_;
Ebig5::lstat(...);
Ebig5::lstat_;
Ebig5::opendir(...);
Ebig5::stat(...);
Ebig5::stat_;
Ebig5::unlink(...);
Ebig5::chdir(...);
Ebig5::do(...);
Ebig5::require(...);
Ebig5::telldir(...);
# "no Ebig5;" not supported
=head1 ABSTRACT
( run in 2.150 seconds using v1.01-cache-2.11-cpan-ceb78f64989 )