| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Ebig5hkscs; | 
| 2 | 389 |  |  | 389 |  | 14927 | use strict; | 
|  | 389 |  |  |  |  | 2279 |  | 
|  | 389 |  |  |  |  | 15479 |  | 
| 3 |  |  |  |  |  |  | ###################################################################### | 
| 4 |  |  |  |  |  |  | # | 
| 5 |  |  |  |  |  |  | # Ebig5hkscs - Run-time routines for Big5HKSCS.pm | 
| 6 |  |  |  |  |  |  | # | 
| 7 |  |  |  |  |  |  | # http://search.cpan.org/dist/Char-Big5HKSCS/ | 
| 8 |  |  |  |  |  |  | # | 
| 9 |  |  |  |  |  |  | # Copyright (c) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2019 INABA Hitoshi | 
| 10 |  |  |  |  |  |  | ###################################################################### | 
| 11 |  |  |  |  |  |  |  | 
| 12 | 389 |  |  | 389 |  | 5530 | use 5.00503;    # Galapagos Consensus 1998 for primetools | 
|  | 389 |  |  |  |  | 2923 |  | 
| 13 |  |  |  |  |  |  | # use 5.008001; # Lancaster Consensus 2013 for toolchains | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | # 12.3. Delaying use Until Runtime | 
| 16 |  |  |  |  |  |  | # in Chapter 12. Packages, Libraries, and Modules | 
| 17 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 18 |  |  |  |  |  |  | # (and so on) | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | # Version numbers should be boring | 
| 21 |  |  |  |  |  |  | # http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/ | 
| 22 |  |  |  |  |  |  | # For the impatient, the disinterested or those who just want to follow | 
| 23 |  |  |  |  |  |  | # a recipe, my advice for all modules is this: | 
| 24 |  |  |  |  |  |  | # our $VERSION = "0.001"; # or "0.001_001" for a dev release | 
| 25 |  |  |  |  |  |  | # $VERSION = eval $VERSION; # No!! because '1.10' makes '1.1' | 
| 26 |  |  |  |  |  |  |  | 
| 27 | 389 |  |  | 389 |  | 3476 | use vars qw($VERSION); | 
|  | 389 |  |  |  |  | 3711 |  | 
|  | 389 |  |  |  |  | 58515 |  | 
| 28 |  |  |  |  |  |  | $VERSION = '1.13'; | 
| 29 |  |  |  |  |  |  | $VERSION = $VERSION; | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | BEGIN { | 
| 32 | 389 | 50 |  | 389 |  | 8763 | if ($^X =~ / jperl /oxmsi) { | 
| 33 | 0 |  |  |  |  | 0 | die __FILE__, ": needs perl(not jperl) 5.00503 or later. (\$^X==$^X)\n"; | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 389 |  |  |  |  | 2086 | if (CORE::ord('A') == 193) { | 
| 36 |  |  |  |  |  |  | die __FILE__, ": is not US-ASCII script (may be EBCDIC or EBCDIK script).\n"; | 
| 37 |  |  |  |  |  |  | } | 
| 38 | 389 |  |  |  |  | 63367 | if (CORE::ord('A') != 0x41) { | 
| 39 |  |  |  |  |  |  | die __FILE__, ": is not US-ASCII script (must be US-ASCII script).\n"; | 
| 40 |  |  |  |  |  |  | } | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | BEGIN { | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | # instead of utf8.pm | 
| 46 | 389 |  |  | 389 |  | 29453 | CORE::eval q{ | 
|  | 389 |  |  | 389 |  | 4195 |  | 
|  | 389 |  |  | 114 |  | 5977 |  | 
|  | 389 |  |  |  |  | 52010 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 47 |  |  |  |  |  |  | no warnings qw(redefine); | 
| 48 |  |  |  |  |  |  | *utf8::upgrade   = sub { CORE::length $_[0] }; | 
| 49 |  |  |  |  |  |  | *utf8::downgrade = sub { 1 }; | 
| 50 |  |  |  |  |  |  | *utf8::encode    = sub {   }; | 
| 51 |  |  |  |  |  |  | *utf8::decode    = sub { 1 }; | 
| 52 |  |  |  |  |  |  | *utf8::is_utf8   = sub {   }; | 
| 53 |  |  |  |  |  |  | *utf8::valid     = sub { 1 }; | 
| 54 |  |  |  |  |  |  | }; | 
| 55 | 389 | 50 |  |  |  | 157280 | if ($@) { | 
| 56 | 0 |  |  |  |  | 0 | *utf8::upgrade   = sub { CORE::length $_[0] }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 57 | 0 |  |  |  |  | 0 | *utf8::downgrade = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 58 | 0 |  |  |  |  | 0 | *utf8::encode    = sub {   }; | 
| 59 | 0 |  |  |  |  | 0 | *utf8::decode    = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 60 | 0 |  |  |  |  | 0 | *utf8::is_utf8   = sub {   }; | 
| 61 | 0 |  |  |  |  | 0 | *utf8::valid     = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | # instead of Symbol.pm | 
| 66 | 0 |  |  |  |  | 0 | BEGIN { | 
| 67 |  |  |  |  |  |  | sub gensym () { | 
| 68 | 0 |  |  | 0 | 0 | 0 | return \do { local *_ }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | sub qualify ($$) { | 
| 72 | 0 |  |  | 1152 | 0 | 0 | my($name) = @_; | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 1152 | 50 |  |  |  | 2819 | if (ref $name) { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 75 | 1152 |  |  |  |  | 4509 | return $name; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | elsif (Ebig5hkscs::index($name,'::') >= 0) { | 
| 78 | 0 |  |  |  |  | 0 | return $name; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  | elsif (Ebig5hkscs::index($name,"'") >= 0) { | 
| 81 | 0 |  |  |  |  | 0 | return $name; | 
| 82 |  |  |  |  |  |  | } | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | # special character, "^xyz" | 
| 85 |  |  |  |  |  |  | elsif ($name =~ /\A \^ [ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_]+ \z/x) { | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | # RGS 2001-11-05 : translate leading ^X to control-char | 
| 88 | 0 |  |  |  |  | 0 | $name =~ s{\A \^ ([ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_]) }{'qq(\c'.$1.')'}xee; | 
|  | 0 |  |  |  |  | 0 |  | 
| 89 | 0 |  |  |  |  | 0 | return 'main::' . $name; | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | # Global names | 
| 93 |  |  |  |  |  |  | elsif ($name =~ /\A (?: ARGV | ARGVOUT | ENV | INC | SIG | STDERR | STDIN | STDOUT ) \z/x) { | 
| 94 | 0 |  |  |  |  | 0 | return 'main::' . $name; | 
| 95 |  |  |  |  |  |  | } | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | # or other | 
| 98 |  |  |  |  |  |  | elsif ($name =~ /\A [^ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz] \z/x) { | 
| 99 | 0 |  |  |  |  | 0 | return 'main::' . $name; | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | elsif (defined $_[1]) { | 
| 103 | 0 |  |  |  |  | 0 | return $_[1] . '::' . $name; | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  | else { | 
| 106 | 1152 |  |  |  |  | 9071 | return (caller)[0] . '::' . $name; | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | sub qualify_to_ref ($;$) { | 
| 111 | 0 | 50 |  | 1152 | 0 | 0 | if (defined $_[1]) { | 
| 112 | 389 |  |  | 389 |  | 4554 | no strict qw(refs); | 
|  | 389 |  |  |  |  | 4579 |  | 
|  | 389 |  |  |  |  | 32031 |  | 
| 113 | 1152 |  |  |  |  | 4530 | return \*{ qualify $_[0], $_[1] }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 114 |  |  |  |  |  |  | } | 
| 115 |  |  |  |  |  |  | else { | 
| 116 | 389 |  |  | 389 |  | 2351 | no strict qw(refs); | 
|  | 389 |  |  | 0 |  | 2402 |  | 
|  | 389 |  |  |  |  | 107072 |  | 
| 117 | 0 |  |  |  |  | 0 | return \*{ qualify $_[0], (caller)[0] }; | 
|  | 1152 |  |  |  |  | 1909 |  | 
| 118 |  |  |  |  |  |  | } | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | # P.714 29.2.39. flock | 
| 123 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 124 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | # P.863 flock | 
| 127 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 128 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | sub LOCK_SH() {1} | 
| 131 |  |  |  |  |  |  | sub LOCK_EX() {2} | 
| 132 |  |  |  |  |  |  | sub LOCK_UN() {8} | 
| 133 |  |  |  |  |  |  | sub LOCK_NB() {4} | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | # instead of Carp.pm | 
| 136 |  |  |  |  |  |  | sub carp; | 
| 137 |  |  |  |  |  |  | sub croak; | 
| 138 |  |  |  |  |  |  | sub cluck; | 
| 139 |  |  |  |  |  |  | sub confess; | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | # 6.18. Matching Multiple-Byte Characters | 
| 142 |  |  |  |  |  |  | # in Chapter 6. Pattern Matching | 
| 143 |  |  |  |  |  |  | # of ISBN 978-1-56592-243-3 Perl Perl Cookbook. | 
| 144 |  |  |  |  |  |  | # (and so on) | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | # regexp of character | 
| 147 |  |  |  |  |  |  | my $your_char = q{[\x81-\xFE][\x00-\xFF]|[\x00-\xFF]}; | 
| 148 | 389 |  |  | 389 |  | 4259 | use vars qw($qq_char); $qq_char = qr/\\c[\x40-\x5F]|\\?(?:$your_char)/oxms; | 
|  | 389 |  |  |  |  | 2538 |  | 
|  | 389 |  |  |  |  | 28668 |  | 
| 149 | 389 |  |  | 389 |  | 2621 | use vars qw($q_char);  $q_char  = qr/$your_char/oxms; | 
|  | 389 |  |  |  |  | 923 |  | 
|  | 389 |  |  |  |  | 654127 |  | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | # | 
| 152 |  |  |  |  |  |  | # Big5-HKSCS character range per length | 
| 153 |  |  |  |  |  |  | # | 
| 154 |  |  |  |  |  |  | my %range_tr = (); | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | # | 
| 157 |  |  |  |  |  |  | # Big5-HKSCS case conversion | 
| 158 |  |  |  |  |  |  | # | 
| 159 |  |  |  |  |  |  | my %lc = (); | 
| 160 |  |  |  |  |  |  | @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)} = | 
| 161 |  |  |  |  |  |  | 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); | 
| 162 |  |  |  |  |  |  | my %uc = (); | 
| 163 |  |  |  |  |  |  | @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)} = | 
| 164 |  |  |  |  |  |  | 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); | 
| 165 |  |  |  |  |  |  | my %fc = (); | 
| 166 |  |  |  |  |  |  | @fc{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)} = | 
| 167 |  |  |  |  |  |  | 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); | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | if (0) { | 
| 170 |  |  |  |  |  |  | } | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | elsif (__PACKAGE__ =~ / \b Ebig5hkscs \z/oxms) { | 
| 173 |  |  |  |  |  |  | %range_tr = ( | 
| 174 |  |  |  |  |  |  | 1 => [ [0x00..0x80], | 
| 175 |  |  |  |  |  |  | [0xFF..0xFF], | 
| 176 |  |  |  |  |  |  | ], | 
| 177 |  |  |  |  |  |  | 2 => [ [0x81..0xFE],[0x40..0x7E], | 
| 178 |  |  |  |  |  |  | [0x81..0xFE],[0xA1..0xFE], | 
| 179 |  |  |  |  |  |  | ], | 
| 180 |  |  |  |  |  |  | ); | 
| 181 |  |  |  |  |  |  | } | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | else { | 
| 184 |  |  |  |  |  |  | croak "Don't know my package name '@{[__PACKAGE__]}'"; | 
| 185 |  |  |  |  |  |  | } | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | # | 
| 188 |  |  |  |  |  |  | # @ARGV wildcard globbing | 
| 189 |  |  |  |  |  |  | # | 
| 190 |  |  |  |  |  |  | sub import { | 
| 191 |  |  |  |  |  |  |  | 
| 192 | 1152 | 50 |  | 5 |  | 7524 | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 193 | 5 |  |  |  |  | 86 | my @argv = (); | 
| 194 | 0 |  |  |  |  | 0 | for (@ARGV) { | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | # has space | 
| 197 | 0 | 0 |  |  |  | 0 | if (/\A (?:$q_char)*? [ ] /oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 198 | 0 | 0 |  |  |  | 0 | if (my @glob = Ebig5hkscs::glob(qq{"$_"})) { | 
| 199 | 0 |  |  |  |  | 0 | push @argv, @glob; | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  | else { | 
| 202 | 0 |  |  |  |  | 0 | push @argv, $_; | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  | } | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | # has wildcard metachar | 
| 207 |  |  |  |  |  |  | elsif (/\A (?:$q_char)*? [*?] /oxms) { | 
| 208 | 0 | 0 |  |  |  | 0 | if (my @glob = Ebig5hkscs::glob($_)) { | 
| 209 | 0 |  |  |  |  | 0 | push @argv, @glob; | 
| 210 |  |  |  |  |  |  | } | 
| 211 |  |  |  |  |  |  | else { | 
| 212 | 0 |  |  |  |  | 0 | push @argv, $_; | 
| 213 |  |  |  |  |  |  | } | 
| 214 |  |  |  |  |  |  | } | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | # no wildcard globbing | 
| 217 |  |  |  |  |  |  | else { | 
| 218 | 0 |  |  |  |  | 0 | push @argv, $_; | 
| 219 |  |  |  |  |  |  | } | 
| 220 |  |  |  |  |  |  | } | 
| 221 | 0 |  |  |  |  | 0 | @ARGV = @argv; | 
| 222 |  |  |  |  |  |  | } | 
| 223 |  |  |  |  |  |  |  | 
| 224 | 0 |  |  |  |  | 0 | *Char::ord           = \&Big5HKSCS::ord; | 
| 225 | 5 |  |  |  |  | 28 | *Char::ord_          = \&Big5HKSCS::ord_; | 
| 226 | 5 |  |  |  |  | 14 | *Char::reverse       = \&Big5HKSCS::reverse; | 
| 227 | 5 |  |  |  |  | 12 | *Char::getc          = \&Big5HKSCS::getc; | 
| 228 | 5 |  |  |  |  | 11 | *Char::length        = \&Big5HKSCS::length; | 
| 229 | 5 |  |  |  |  | 9 | *Char::substr        = \&Big5HKSCS::substr; | 
| 230 | 5 |  |  |  |  | 11 | *Char::index         = \&Big5HKSCS::index; | 
| 231 | 5 |  |  |  |  | 11 | *Char::rindex        = \&Big5HKSCS::rindex; | 
| 232 | 5 |  |  |  |  | 11 | *Char::eval          = \&Big5HKSCS::eval; | 
| 233 | 5 |  |  |  |  | 35 | *Char::escape        = \&Big5HKSCS::escape; | 
| 234 | 5 |  |  |  |  | 12 | *Char::escape_token  = \&Big5HKSCS::escape_token; | 
| 235 | 5 |  |  |  |  | 11 | *Char::escape_script = \&Big5HKSCS::escape_script; | 
| 236 |  |  |  |  |  |  | } | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | # P.230 Care with Prototypes | 
| 239 |  |  |  |  |  |  | # in Chapter 6: Subroutines | 
| 240 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 241 |  |  |  |  |  |  | # | 
| 242 |  |  |  |  |  |  | # If you aren't careful, you can get yourself into trouble with prototypes. | 
| 243 |  |  |  |  |  |  | # But if you are careful, you can do a lot of neat things with them. This is | 
| 244 |  |  |  |  |  |  | # all very powerful, of course, and should only be used in moderation to make | 
| 245 |  |  |  |  |  |  | # the world a better place. | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  | # P.332 Care with Prototypes | 
| 248 |  |  |  |  |  |  | # in Chapter 7: Subroutines | 
| 249 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 250 |  |  |  |  |  |  | # | 
| 251 |  |  |  |  |  |  | # If you aren't careful, you can get yourself into trouble with prototypes. | 
| 252 |  |  |  |  |  |  | # But if you are careful, you can do a lot of neat things with them. This is | 
| 253 |  |  |  |  |  |  | # all very powerful, of course, and should only be used in moderation to make | 
| 254 |  |  |  |  |  |  | # the world a better place. | 
| 255 |  |  |  |  |  |  |  | 
| 256 |  |  |  |  |  |  | # | 
| 257 |  |  |  |  |  |  | # Prototypes of subroutines | 
| 258 |  |  |  |  |  |  | # | 
| 259 |  |  |  | 0 |  |  | sub unimport {} | 
| 260 |  |  |  |  |  |  | sub Ebig5hkscs::split(;$$$); | 
| 261 |  |  |  |  |  |  | sub Ebig5hkscs::tr($$$$;$); | 
| 262 |  |  |  |  |  |  | sub Ebig5hkscs::chop(@); | 
| 263 |  |  |  |  |  |  | sub Ebig5hkscs::index($$;$); | 
| 264 |  |  |  |  |  |  | sub Ebig5hkscs::rindex($$;$); | 
| 265 |  |  |  |  |  |  | sub Ebig5hkscs::lcfirst(@); | 
| 266 |  |  |  |  |  |  | sub Ebig5hkscs::lcfirst_(); | 
| 267 |  |  |  |  |  |  | sub Ebig5hkscs::lc(@); | 
| 268 |  |  |  |  |  |  | sub Ebig5hkscs::lc_(); | 
| 269 |  |  |  |  |  |  | sub Ebig5hkscs::ucfirst(@); | 
| 270 |  |  |  |  |  |  | sub Ebig5hkscs::ucfirst_(); | 
| 271 |  |  |  |  |  |  | sub Ebig5hkscs::uc(@); | 
| 272 |  |  |  |  |  |  | sub Ebig5hkscs::uc_(); | 
| 273 |  |  |  |  |  |  | sub Ebig5hkscs::fc(@); | 
| 274 |  |  |  |  |  |  | sub Ebig5hkscs::fc_(); | 
| 275 |  |  |  |  |  |  | sub Ebig5hkscs::ignorecase; | 
| 276 |  |  |  |  |  |  | sub Ebig5hkscs::classic_character_class; | 
| 277 |  |  |  |  |  |  | sub Ebig5hkscs::capture; | 
| 278 |  |  |  |  |  |  | sub Ebig5hkscs::chr(;$); | 
| 279 |  |  |  |  |  |  | sub Ebig5hkscs::chr_(); | 
| 280 |  |  |  |  |  |  | sub Ebig5hkscs::filetest; | 
| 281 |  |  |  |  |  |  | sub Ebig5hkscs::r(;*@); | 
| 282 |  |  |  |  |  |  | sub Ebig5hkscs::w(;*@); | 
| 283 |  |  |  |  |  |  | sub Ebig5hkscs::x(;*@); | 
| 284 |  |  |  |  |  |  | sub Ebig5hkscs::o(;*@); | 
| 285 |  |  |  |  |  |  | sub Ebig5hkscs::R(;*@); | 
| 286 |  |  |  |  |  |  | sub Ebig5hkscs::W(;*@); | 
| 287 |  |  |  |  |  |  | sub Ebig5hkscs::X(;*@); | 
| 288 |  |  |  |  |  |  | sub Ebig5hkscs::O(;*@); | 
| 289 |  |  |  |  |  |  | sub Ebig5hkscs::e(;*@); | 
| 290 |  |  |  |  |  |  | sub Ebig5hkscs::z(;*@); | 
| 291 |  |  |  |  |  |  | sub Ebig5hkscs::s(;*@); | 
| 292 |  |  |  |  |  |  | sub Ebig5hkscs::f(;*@); | 
| 293 |  |  |  |  |  |  | sub Ebig5hkscs::d(;*@); | 
| 294 |  |  |  |  |  |  | sub Ebig5hkscs::l(;*@); | 
| 295 |  |  |  |  |  |  | sub Ebig5hkscs::p(;*@); | 
| 296 |  |  |  |  |  |  | sub Ebig5hkscs::S(;*@); | 
| 297 |  |  |  |  |  |  | sub Ebig5hkscs::b(;*@); | 
| 298 |  |  |  |  |  |  | sub Ebig5hkscs::c(;*@); | 
| 299 |  |  |  |  |  |  | sub Ebig5hkscs::u(;*@); | 
| 300 |  |  |  |  |  |  | sub Ebig5hkscs::g(;*@); | 
| 301 |  |  |  |  |  |  | sub Ebig5hkscs::k(;*@); | 
| 302 |  |  |  |  |  |  | sub Ebig5hkscs::T(;*@); | 
| 303 |  |  |  |  |  |  | sub Ebig5hkscs::B(;*@); | 
| 304 |  |  |  |  |  |  | sub Ebig5hkscs::M(;*@); | 
| 305 |  |  |  |  |  |  | sub Ebig5hkscs::A(;*@); | 
| 306 |  |  |  |  |  |  | sub Ebig5hkscs::C(;*@); | 
| 307 |  |  |  |  |  |  | sub Ebig5hkscs::filetest_; | 
| 308 |  |  |  |  |  |  | sub Ebig5hkscs::r_(); | 
| 309 |  |  |  |  |  |  | sub Ebig5hkscs::w_(); | 
| 310 |  |  |  |  |  |  | sub Ebig5hkscs::x_(); | 
| 311 |  |  |  |  |  |  | sub Ebig5hkscs::o_(); | 
| 312 |  |  |  |  |  |  | sub Ebig5hkscs::R_(); | 
| 313 |  |  |  |  |  |  | sub Ebig5hkscs::W_(); | 
| 314 |  |  |  |  |  |  | sub Ebig5hkscs::X_(); | 
| 315 |  |  |  |  |  |  | sub Ebig5hkscs::O_(); | 
| 316 |  |  |  |  |  |  | sub Ebig5hkscs::e_(); | 
| 317 |  |  |  |  |  |  | sub Ebig5hkscs::z_(); | 
| 318 |  |  |  |  |  |  | sub Ebig5hkscs::s_(); | 
| 319 |  |  |  |  |  |  | sub Ebig5hkscs::f_(); | 
| 320 |  |  |  |  |  |  | sub Ebig5hkscs::d_(); | 
| 321 |  |  |  |  |  |  | sub Ebig5hkscs::l_(); | 
| 322 |  |  |  |  |  |  | sub Ebig5hkscs::p_(); | 
| 323 |  |  |  |  |  |  | sub Ebig5hkscs::S_(); | 
| 324 |  |  |  |  |  |  | sub Ebig5hkscs::b_(); | 
| 325 |  |  |  |  |  |  | sub Ebig5hkscs::c_(); | 
| 326 |  |  |  |  |  |  | sub Ebig5hkscs::u_(); | 
| 327 |  |  |  |  |  |  | sub Ebig5hkscs::g_(); | 
| 328 |  |  |  |  |  |  | sub Ebig5hkscs::k_(); | 
| 329 |  |  |  |  |  |  | sub Ebig5hkscs::T_(); | 
| 330 |  |  |  |  |  |  | sub Ebig5hkscs::B_(); | 
| 331 |  |  |  |  |  |  | sub Ebig5hkscs::M_(); | 
| 332 |  |  |  |  |  |  | sub Ebig5hkscs::A_(); | 
| 333 |  |  |  |  |  |  | sub Ebig5hkscs::C_(); | 
| 334 |  |  |  |  |  |  | sub Ebig5hkscs::glob($); | 
| 335 |  |  |  |  |  |  | sub Ebig5hkscs::glob_(); | 
| 336 |  |  |  |  |  |  | sub Ebig5hkscs::lstat(*); | 
| 337 |  |  |  |  |  |  | sub Ebig5hkscs::lstat_(); | 
| 338 |  |  |  |  |  |  | sub Ebig5hkscs::opendir(*$); | 
| 339 |  |  |  |  |  |  | sub Ebig5hkscs::stat(*); | 
| 340 |  |  |  |  |  |  | sub Ebig5hkscs::stat_(); | 
| 341 |  |  |  |  |  |  | sub Ebig5hkscs::unlink(@); | 
| 342 |  |  |  |  |  |  | sub Ebig5hkscs::chdir(;$); | 
| 343 |  |  |  |  |  |  | sub Ebig5hkscs::do($); | 
| 344 |  |  |  |  |  |  | sub Ebig5hkscs::require(;$); | 
| 345 |  |  |  |  |  |  | sub Ebig5hkscs::telldir(*); | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | sub Big5HKSCS::ord(;$); | 
| 348 |  |  |  |  |  |  | sub Big5HKSCS::ord_(); | 
| 349 |  |  |  |  |  |  | sub Big5HKSCS::reverse(@); | 
| 350 |  |  |  |  |  |  | sub Big5HKSCS::getc(;*@); | 
| 351 |  |  |  |  |  |  | sub Big5HKSCS::length(;$); | 
| 352 |  |  |  |  |  |  | sub Big5HKSCS::substr($$;$$); | 
| 353 |  |  |  |  |  |  | sub Big5HKSCS::index($$;$); | 
| 354 |  |  |  |  |  |  | sub Big5HKSCS::rindex($$;$); | 
| 355 |  |  |  |  |  |  | sub Big5HKSCS::escape(;$); | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | # | 
| 358 |  |  |  |  |  |  | # Regexp work | 
| 359 |  |  |  |  |  |  | # | 
| 360 | 389 |  |  |  |  | 43042 | use vars qw( | 
| 361 |  |  |  |  |  |  | $re_a | 
| 362 |  |  |  |  |  |  | $re_t | 
| 363 |  |  |  |  |  |  | $re_n | 
| 364 |  |  |  |  |  |  | $re_r | 
| 365 | 389 |  |  | 389 |  | 6378 | ); | 
|  | 389 |  |  |  |  | 2094 |  | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  | # | 
| 368 |  |  |  |  |  |  | # Character class | 
| 369 |  |  |  |  |  |  | # | 
| 370 | 389 |  |  |  |  | 156205 | use vars qw( | 
| 371 |  |  |  |  |  |  | $dot | 
| 372 |  |  |  |  |  |  | $dot_s | 
| 373 |  |  |  |  |  |  | $eD | 
| 374 |  |  |  |  |  |  | $eS | 
| 375 |  |  |  |  |  |  | $eW | 
| 376 |  |  |  |  |  |  | $eH | 
| 377 |  |  |  |  |  |  | $eV | 
| 378 |  |  |  |  |  |  | $eR | 
| 379 |  |  |  |  |  |  | $eN | 
| 380 |  |  |  |  |  |  | $not_alnum | 
| 381 |  |  |  |  |  |  | $not_alpha | 
| 382 |  |  |  |  |  |  | $not_ascii | 
| 383 |  |  |  |  |  |  | $not_blank | 
| 384 |  |  |  |  |  |  | $not_cntrl | 
| 385 |  |  |  |  |  |  | $not_digit | 
| 386 |  |  |  |  |  |  | $not_graph | 
| 387 |  |  |  |  |  |  | $not_lower | 
| 388 |  |  |  |  |  |  | $not_lower_i | 
| 389 |  |  |  |  |  |  | $not_print | 
| 390 |  |  |  |  |  |  | $not_punct | 
| 391 |  |  |  |  |  |  | $not_space | 
| 392 |  |  |  |  |  |  | $not_upper | 
| 393 |  |  |  |  |  |  | $not_upper_i | 
| 394 |  |  |  |  |  |  | $not_word | 
| 395 |  |  |  |  |  |  | $not_xdigit | 
| 396 |  |  |  |  |  |  | $eb | 
| 397 |  |  |  |  |  |  | $eB | 
| 398 | 389 |  |  | 389 |  | 5482 | ); | 
|  | 389 |  |  |  |  | 6872 |  | 
| 399 |  |  |  |  |  |  |  | 
| 400 | 389 |  |  |  |  | 4721921 | use vars qw( | 
| 401 |  |  |  |  |  |  | $anchor | 
| 402 |  |  |  |  |  |  | $matched | 
| 403 | 389 |  |  | 389 |  | 6353 | ); | 
|  | 389 |  |  |  |  | 689 |  | 
| 404 |  |  |  |  |  |  | ${Ebig5hkscs::anchor} = qr{\G(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])*?}oxms; | 
| 405 |  |  |  |  |  |  | my $q_char_SADAHIRO_Tomoyuki_2002_01_17 = ''; | 
| 406 |  |  |  |  |  |  |  | 
| 407 |  |  |  |  |  |  | # Quantifiers | 
| 408 |  |  |  |  |  |  | #   {n,m}  ---  Match at least n but not more than m times | 
| 409 |  |  |  |  |  |  | # | 
| 410 |  |  |  |  |  |  | # n and m are limited to non-negative integral values less than a | 
| 411 |  |  |  |  |  |  | # preset limit defined when perl is built. This is usually 32766 on | 
| 412 |  |  |  |  |  |  | # the most common platforms. | 
| 413 |  |  |  |  |  |  | # | 
| 414 |  |  |  |  |  |  | # The following code is an attempt to solve the above limitations | 
| 415 |  |  |  |  |  |  | # in a multi-byte anchoring. | 
| 416 |  |  |  |  |  |  |  | 
| 417 |  |  |  |  |  |  | # avoid "Segmentation fault" and "Error: Parse exception" | 
| 418 |  |  |  |  |  |  |  | 
| 419 |  |  |  |  |  |  | # perl5101delta | 
| 420 |  |  |  |  |  |  | # http://perldoc.perl.org/perl5101delta.html | 
| 421 |  |  |  |  |  |  | # In 5.10.0, the * quantifier in patterns was sometimes treated as {0,32767} | 
| 422 |  |  |  |  |  |  | # [RT #60034, #60464]. For example, this match would fail: | 
| 423 |  |  |  |  |  |  | #   ("ab" x 32768) =~ /^(ab)*$/ | 
| 424 |  |  |  |  |  |  |  | 
| 425 |  |  |  |  |  |  | # SEE ALSO | 
| 426 |  |  |  |  |  |  | # | 
| 427 |  |  |  |  |  |  | # Complex regular subexpression recursion limit | 
| 428 |  |  |  |  |  |  | # http://www.perlmonks.org/?node_id=810857 | 
| 429 |  |  |  |  |  |  | # | 
| 430 |  |  |  |  |  |  | # regexp iteration limits | 
| 431 |  |  |  |  |  |  | # http://www.nntp.perl.org/group/perl.perl5.porters/2009/02/msg144065.html | 
| 432 |  |  |  |  |  |  | # | 
| 433 |  |  |  |  |  |  | # latest Perl won't match certain regexes more than 32768 characters long | 
| 434 |  |  |  |  |  |  | # http://stackoverflow.com/questions/26226630/latest-perl-wont-match-certain-regexes-more-than-32768-characters-long | 
| 435 |  |  |  |  |  |  | # | 
| 436 |  |  |  |  |  |  | # Break through the limitations of regular expressions of Perl | 
| 437 |  |  |  |  |  |  | # http://d.hatena.ne.jp/gfx/20110212/1297512479 | 
| 438 |  |  |  |  |  |  |  | 
| 439 |  |  |  |  |  |  | if (($] >= 5.010001) or | 
| 440 |  |  |  |  |  |  | # ActivePerl 5.6 or later (include 5.10.0) | 
| 441 |  |  |  |  |  |  | (defined($ActivePerl::VERSION) and ($ActivePerl::VERSION > 800)) or | 
| 442 |  |  |  |  |  |  | (($^O eq 'MSWin32') and ($] =~ /\A 5\.006/oxms)) | 
| 443 |  |  |  |  |  |  | ) { | 
| 444 |  |  |  |  |  |  | my $sbcs = ''; # Single Byte Character Set | 
| 445 |  |  |  |  |  |  | for my $range (@{ $range_tr{1} }) { | 
| 446 |  |  |  |  |  |  | $sbcs .= sprintf('\\x%02X-\\x%02X', $range->[0], $range->[-1]); | 
| 447 |  |  |  |  |  |  | } | 
| 448 |  |  |  |  |  |  |  | 
| 449 |  |  |  |  |  |  | if (0) { | 
| 450 |  |  |  |  |  |  | } | 
| 451 |  |  |  |  |  |  |  | 
| 452 |  |  |  |  |  |  | # other encoding | 
| 453 |  |  |  |  |  |  | else { | 
| 454 |  |  |  |  |  |  | ${Ebig5hkscs::q_char_SADAHIRO_Tomoyuki_2002_01_17} = qr{.*?[$sbcs](?:[^$sbcs][^$sbcs])*?}oxms; | 
| 455 |  |  |  |  |  |  | #                                                     ******* octets not in multiple octet char (always char boundary) | 
| 456 |  |  |  |  |  |  | #                                                               **************** 2 octet chars | 
| 457 |  |  |  |  |  |  | } | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  | ${Ebig5hkscs::anchor_SADAHIRO_Tomoyuki_2002_01_17} = | 
| 460 |  |  |  |  |  |  | qr{\G(?(?=.{0,32766}\z)(?:[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])*?|(?(?=[$sbcs]+\z).*?|(?:${Ebig5hkscs::q_char_SADAHIRO_Tomoyuki_2002_01_17})))}oxms; | 
| 461 |  |  |  |  |  |  | #   qr{ | 
| 462 |  |  |  |  |  |  | #      \G # (1), (2) | 
| 463 |  |  |  |  |  |  | #        (? # (3) | 
| 464 |  |  |  |  |  |  | #          (?=.{0,32766}\z) # (4) | 
| 465 |  |  |  |  |  |  | #                          (?:[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])*?| # (5) | 
| 466 |  |  |  |  |  |  | #                                                                                      (?(?=[$sbcs]+\z) # (6) | 
| 467 |  |  |  |  |  |  | #                                                                                                      .*?| #(7) | 
| 468 |  |  |  |  |  |  | #                                                                                                          (?:${Ebig5hkscs::q_char_SADAHIRO_Tomoyuki_2002_01_17}) # (8) | 
| 469 |  |  |  |  |  |  | #                                                                                                                                           ))}oxms; | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | # avoid: Complex regular subexpression recursion limit (32766) exceeded at here. | 
| 472 |  |  |  |  |  |  | local $^W = 0; | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | if (((('A' x 32768).'B') !~ / ${Ebig5hkscs::anchor}                              B /oxms) and | 
| 475 |  |  |  |  |  |  | ((('A' x 32768).'B') =~ / ${Ebig5hkscs::anchor_SADAHIRO_Tomoyuki_2002_01_17} B /oxms) | 
| 476 |  |  |  |  |  |  | ) { | 
| 477 |  |  |  |  |  |  | ${Ebig5hkscs::anchor} = ${Ebig5hkscs::anchor_SADAHIRO_Tomoyuki_2002_01_17}; | 
| 478 |  |  |  |  |  |  | } | 
| 479 |  |  |  |  |  |  | else { | 
| 480 |  |  |  |  |  |  | undef ${Ebig5hkscs::q_char_SADAHIRO_Tomoyuki_2002_01_17}; | 
| 481 |  |  |  |  |  |  | } | 
| 482 |  |  |  |  |  |  | } | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | # (1) | 
| 485 |  |  |  |  |  |  | # P.128 Start of match (or end of previous match): \G | 
| 486 |  |  |  |  |  |  | # P.130 Advanced Use of \G with Perl | 
| 487 |  |  |  |  |  |  | # in Chapter3: Over view of Regular Expression Features and Flavors | 
| 488 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | # (2) | 
| 491 |  |  |  |  |  |  | # P.255 Use leading anchors | 
| 492 |  |  |  |  |  |  | # P.256 Expose ^ and \G at the front of expressions | 
| 493 |  |  |  |  |  |  | # in Chapter6: Crafting an Efficient Expression | 
| 494 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  | # (3) | 
| 497 |  |  |  |  |  |  | # P.138 Conditional: (? if then| else) | 
| 498 |  |  |  |  |  |  | # in Chapter3: Over view of Regular Expression Features and Flavors | 
| 499 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 500 |  |  |  |  |  |  |  | 
| 501 |  |  |  |  |  |  | # (4) | 
| 502 |  |  |  |  |  |  | # perlre | 
| 503 |  |  |  |  |  |  | # http://perldoc.perl.org/perlre.html | 
| 504 |  |  |  |  |  |  | # The "*" quantifier is equivalent to {0,} , the "+" quantifier to {1,} , | 
| 505 |  |  |  |  |  |  | # and the "?" quantifier to {0,1}, ., n, and m are limited to non-negative | 
| 506 |  |  |  |  |  |  | # integral values less than a preset limit defined when perl is built. | 
| 507 |  |  |  |  |  |  | # This is usually 32766 on the most common platforms. The actual limit | 
| 508 |  |  |  |  |  |  | # can be seen in the error message generated by code such as this: | 
| 509 |  |  |  |  |  |  | #  $_ **= $_ , / {$_} / for 2 .. 42; | 
| 510 |  |  |  |  |  |  |  | 
| 511 |  |  |  |  |  |  | # (5) | 
| 512 |  |  |  |  |  |  | # P.1023 Multiple-Byte Anchoring | 
| 513 |  |  |  |  |  |  | # in Appendix W Perl Code Examples | 
| 514 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | # (6) | 
| 517 |  |  |  |  |  |  | # if string has only SBCS (Single Byte Character Set) | 
| 518 |  |  |  |  |  |  |  | 
| 519 |  |  |  |  |  |  | # (7) | 
| 520 |  |  |  |  |  |  | # then .*? (isn't limited to 32766) | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | # (8) | 
| 523 |  |  |  |  |  |  | # else Big5-HKSCS::Regexp::Const (SADAHIRO Tomoyuki) | 
| 524 |  |  |  |  |  |  | # http://homepage1.nifty.com/nomenclator/perl/shiftjis.htm#long | 
| 525 |  |  |  |  |  |  | # http://search.cpan.org/~sadahiro/Big5-HKSCS-Regexp/ | 
| 526 |  |  |  |  |  |  | # $PadA  = '  (?:\A|                                           [\x00-\x80\xA0-\xDF])(?:[\x81-\xFE]{2})*?'; | 
| 527 |  |  |  |  |  |  | # $PadG  = '\G(?:                                |[\x00-\xFF]*?[\x00-\x80\xA0-\xDF])(?:[\x81-\xFE]{2})*?'; | 
| 528 |  |  |  |  |  |  | # $PadGA = '\G(?:\A|(?:[\x81-\xFE]{2})+?|[\x00-\xFF]*?[\x00-\x80\xA0-\xDF] (?:[\x81-\xFE]{2})*?)'; | 
| 529 |  |  |  |  |  |  |  | 
| 530 |  |  |  |  |  |  | ${Ebig5hkscs::dot}         = qr{(?>[^\x81-\xFE\x0A]|[\x81-\xFE][\x00-\xFF])}; | 
| 531 |  |  |  |  |  |  | ${Ebig5hkscs::dot_s}       = qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])}; | 
| 532 |  |  |  |  |  |  | ${Ebig5hkscs::eD}          = qr{(?>[^\x81-\xFE0-9]|[\x81-\xFE][\x00-\xFF])}; | 
| 533 |  |  |  |  |  |  |  | 
| 534 |  |  |  |  |  |  | # Vertical tabs are now whitespace | 
| 535 |  |  |  |  |  |  | # \s in a regex now matches a vertical tab in all circumstances. | 
| 536 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace | 
| 537 |  |  |  |  |  |  | # ${Ebig5hkscs::eS}          = qr{(?>[^\x81-\xFE\x09\x0A    \x0C\x0D\x20]|[\x81-\xFE][\x00-\xFF])}; | 
| 538 |  |  |  |  |  |  | # ${Ebig5hkscs::eS}          = qr{(?>[^\x81-\xFE\x09\x0A\x0B\x0C\x0D\x20]|[\x81-\xFE][\x00-\xFF])}; | 
| 539 |  |  |  |  |  |  | ${Ebig5hkscs::eS}            = qr{(?>[^\x81-\xFE\s]|[\x81-\xFE][\x00-\xFF])}; | 
| 540 |  |  |  |  |  |  |  | 
| 541 |  |  |  |  |  |  | ${Ebig5hkscs::eW}            = qr{(?>[^\x81-\xFE0-9A-Z_a-z]|[\x81-\xFE][\x00-\xFF])}; | 
| 542 |  |  |  |  |  |  | ${Ebig5hkscs::eH}            = qr{(?>[^\x81-\xFE\x09\x20]|[\x81-\xFE][\x00-\xFF])}; | 
| 543 |  |  |  |  |  |  | ${Ebig5hkscs::eV}            = qr{(?>[^\x81-\xFE\x0A\x0B\x0C\x0D]|[\x81-\xFE][\x00-\xFF])}; | 
| 544 |  |  |  |  |  |  | ${Ebig5hkscs::eR}            = qr{(?>\x0D\x0A|[\x0A\x0D])}; | 
| 545 |  |  |  |  |  |  | ${Ebig5hkscs::eN}            = qr{(?>[^\x81-\xFE\x0A]|[\x81-\xFE][\x00-\xFF])}; | 
| 546 |  |  |  |  |  |  | ${Ebig5hkscs::not_alnum}     = qr{(?>[^\x81-\xFE\x30-\x39\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; | 
| 547 |  |  |  |  |  |  | ${Ebig5hkscs::not_alpha}     = qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; | 
| 548 |  |  |  |  |  |  | ${Ebig5hkscs::not_ascii}     = qr{(?>[^\x81-\xFE\x00-\x7F]|[\x81-\xFE][\x00-\xFF])}; | 
| 549 |  |  |  |  |  |  | ${Ebig5hkscs::not_blank}     = qr{(?>[^\x81-\xFE\x09\x20]|[\x81-\xFE][\x00-\xFF])}; | 
| 550 |  |  |  |  |  |  | ${Ebig5hkscs::not_cntrl}     = qr{(?>[^\x81-\xFE\x00-\x1F\x7F]|[\x81-\xFE][\x00-\xFF])}; | 
| 551 |  |  |  |  |  |  | ${Ebig5hkscs::not_digit}     = qr{(?>[^\x81-\xFE\x30-\x39]|[\x81-\xFE][\x00-\xFF])}; | 
| 552 |  |  |  |  |  |  | ${Ebig5hkscs::not_graph}     = qr{(?>[^\x81-\xFE\x21-\x7F]|[\x81-\xFE][\x00-\xFF])}; | 
| 553 |  |  |  |  |  |  | ${Ebig5hkscs::not_lower}     = qr{(?>[^\x81-\xFE\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; | 
| 554 |  |  |  |  |  |  | ${Ebig5hkscs::not_lower_i}   = qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; # Perl 5.16 compatible | 
| 555 |  |  |  |  |  |  | # ${Ebig5hkscs::not_lower_i} = qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])};                   # older Perl compatible | 
| 556 |  |  |  |  |  |  | ${Ebig5hkscs::not_print}     = qr{(?>[^\x81-\xFE\x20-\x7F]|[\x81-\xFE][\x00-\xFF])}; | 
| 557 |  |  |  |  |  |  | ${Ebig5hkscs::not_punct}     = qr{(?>[^\x81-\xFE\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E]|[\x81-\xFE][\x00-\xFF])}; | 
| 558 |  |  |  |  |  |  | ${Ebig5hkscs::not_space}     = qr{(?>[^\x81-\xFE\s\x0B]|[\x81-\xFE][\x00-\xFF])}; | 
| 559 |  |  |  |  |  |  | ${Ebig5hkscs::not_upper}     = qr{(?>[^\x81-\xFE\x41-\x5A]|[\x81-\xFE][\x00-\xFF])}; | 
| 560 |  |  |  |  |  |  | ${Ebig5hkscs::not_upper_i}   = qr{(?>[^\x81-\xFE\x41-\x5A\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; # Perl 5.16 compatible | 
| 561 |  |  |  |  |  |  | # ${Ebig5hkscs::not_upper_i} = qr{(?>[^\x81-\xFE]|[\x81-\xFE][\x00-\xFF])};                   # older Perl compatible | 
| 562 |  |  |  |  |  |  | ${Ebig5hkscs::not_word}      = qr{(?>[^\x81-\xFE\x30-\x39\x41-\x5A\x5F\x61-\x7A]|[\x81-\xFE][\x00-\xFF])}; | 
| 563 |  |  |  |  |  |  | ${Ebig5hkscs::not_xdigit}    = qr{(?>[^\x81-\xFE\x30-\x39\x41-\x46\x61-\x66]|[\x81-\xFE][\x00-\xFF])}; | 
| 564 |  |  |  |  |  |  | ${Ebig5hkscs::eb}            = qr{(?:\A(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[0-9A-Z_a-z])|(?<=[0-9A-Z_a-z])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]|\z))}; | 
| 565 |  |  |  |  |  |  | ${Ebig5hkscs::eB}            = qr{(?:(?<=[0-9A-Z_a-z])(?=[0-9A-Z_a-z])|(?<=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF])(?=[\x00-\x2F\x40\x5B-\x5E\x60\x7B-\xFF]))}; | 
| 566 |  |  |  |  |  |  |  | 
| 567 |  |  |  |  |  |  | # avoid: Name "Ebig5hkscs::foo" used only once: possible typo at here. | 
| 568 |  |  |  |  |  |  | ${Ebig5hkscs::dot}         = ${Ebig5hkscs::dot}; | 
| 569 |  |  |  |  |  |  | ${Ebig5hkscs::dot_s}       = ${Ebig5hkscs::dot_s}; | 
| 570 |  |  |  |  |  |  | ${Ebig5hkscs::eD}          = ${Ebig5hkscs::eD}; | 
| 571 |  |  |  |  |  |  | ${Ebig5hkscs::eS}          = ${Ebig5hkscs::eS}; | 
| 572 |  |  |  |  |  |  | ${Ebig5hkscs::eW}          = ${Ebig5hkscs::eW}; | 
| 573 |  |  |  |  |  |  | ${Ebig5hkscs::eH}          = ${Ebig5hkscs::eH}; | 
| 574 |  |  |  |  |  |  | ${Ebig5hkscs::eV}          = ${Ebig5hkscs::eV}; | 
| 575 |  |  |  |  |  |  | ${Ebig5hkscs::eR}          = ${Ebig5hkscs::eR}; | 
| 576 |  |  |  |  |  |  | ${Ebig5hkscs::eN}          = ${Ebig5hkscs::eN}; | 
| 577 |  |  |  |  |  |  | ${Ebig5hkscs::not_alnum}   = ${Ebig5hkscs::not_alnum}; | 
| 578 |  |  |  |  |  |  | ${Ebig5hkscs::not_alpha}   = ${Ebig5hkscs::not_alpha}; | 
| 579 |  |  |  |  |  |  | ${Ebig5hkscs::not_ascii}   = ${Ebig5hkscs::not_ascii}; | 
| 580 |  |  |  |  |  |  | ${Ebig5hkscs::not_blank}   = ${Ebig5hkscs::not_blank}; | 
| 581 |  |  |  |  |  |  | ${Ebig5hkscs::not_cntrl}   = ${Ebig5hkscs::not_cntrl}; | 
| 582 |  |  |  |  |  |  | ${Ebig5hkscs::not_digit}   = ${Ebig5hkscs::not_digit}; | 
| 583 |  |  |  |  |  |  | ${Ebig5hkscs::not_graph}   = ${Ebig5hkscs::not_graph}; | 
| 584 |  |  |  |  |  |  | ${Ebig5hkscs::not_lower}   = ${Ebig5hkscs::not_lower}; | 
| 585 |  |  |  |  |  |  | ${Ebig5hkscs::not_lower_i} = ${Ebig5hkscs::not_lower_i}; | 
| 586 |  |  |  |  |  |  | ${Ebig5hkscs::not_print}   = ${Ebig5hkscs::not_print}; | 
| 587 |  |  |  |  |  |  | ${Ebig5hkscs::not_punct}   = ${Ebig5hkscs::not_punct}; | 
| 588 |  |  |  |  |  |  | ${Ebig5hkscs::not_space}   = ${Ebig5hkscs::not_space}; | 
| 589 |  |  |  |  |  |  | ${Ebig5hkscs::not_upper}   = ${Ebig5hkscs::not_upper}; | 
| 590 |  |  |  |  |  |  | ${Ebig5hkscs::not_upper_i} = ${Ebig5hkscs::not_upper_i}; | 
| 591 |  |  |  |  |  |  | ${Ebig5hkscs::not_word}    = ${Ebig5hkscs::not_word}; | 
| 592 |  |  |  |  |  |  | ${Ebig5hkscs::not_xdigit}  = ${Ebig5hkscs::not_xdigit}; | 
| 593 |  |  |  |  |  |  | ${Ebig5hkscs::eb}          = ${Ebig5hkscs::eb}; | 
| 594 |  |  |  |  |  |  | ${Ebig5hkscs::eB}          = ${Ebig5hkscs::eB}; | 
| 595 |  |  |  |  |  |  |  | 
| 596 |  |  |  |  |  |  | # | 
| 597 |  |  |  |  |  |  | # Big5-HKSCS split | 
| 598 |  |  |  |  |  |  | # | 
| 599 |  |  |  |  |  |  | sub Ebig5hkscs::split(;$$$) { | 
| 600 |  |  |  |  |  |  |  | 
| 601 |  |  |  |  |  |  | # P.794 29.2.161. split | 
| 602 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 603 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 604 |  |  |  |  |  |  |  | 
| 605 |  |  |  |  |  |  | # P.951 split | 
| 606 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 607 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 608 |  |  |  |  |  |  |  | 
| 609 | 5 |  |  | 0 | 0 | 11506 | my $pattern = $_[0]; | 
| 610 | 0 |  |  |  |  | 0 | my $string  = $_[1]; | 
| 611 | 0 |  |  |  |  | 0 | my $limit   = $_[2]; | 
| 612 |  |  |  |  |  |  |  | 
| 613 |  |  |  |  |  |  | # if $pattern is also omitted or is the literal space, " " | 
| 614 | 0 | 0 |  |  |  | 0 | if (not defined $pattern) { | 
| 615 | 0 |  |  |  |  | 0 | $pattern = ' '; | 
| 616 |  |  |  |  |  |  | } | 
| 617 |  |  |  |  |  |  |  | 
| 618 |  |  |  |  |  |  | # if $string is omitted, the function splits the $_ string | 
| 619 | 0 | 0 |  |  |  | 0 | if (not defined $string) { | 
| 620 | 0 | 0 |  |  |  | 0 | if (defined $_) { | 
| 621 | 0 |  |  |  |  | 0 | $string = $_; | 
| 622 |  |  |  |  |  |  | } | 
| 623 |  |  |  |  |  |  | else { | 
| 624 | 0 |  |  |  |  | 0 | $string = ''; | 
| 625 |  |  |  |  |  |  | } | 
| 626 |  |  |  |  |  |  | } | 
| 627 |  |  |  |  |  |  |  | 
| 628 | 0 |  |  |  |  | 0 | my @split = (); | 
| 629 |  |  |  |  |  |  |  | 
| 630 |  |  |  |  |  |  | # when string is empty | 
| 631 | 0 | 0 |  |  |  | 0 | if ($string eq '') { | 
|  |  | 0 |  |  |  |  |  | 
| 632 |  |  |  |  |  |  |  | 
| 633 |  |  |  |  |  |  | # resulting list value in list context | 
| 634 | 0 | 0 |  |  |  | 0 | if (wantarray) { | 
| 635 | 0 |  |  |  |  | 0 | return @split; | 
| 636 |  |  |  |  |  |  | } | 
| 637 |  |  |  |  |  |  |  | 
| 638 |  |  |  |  |  |  | # count of substrings in scalar context | 
| 639 |  |  |  |  |  |  | else { | 
| 640 | 0 | 0 |  |  |  | 0 | carp "Use of implicit split to \@_ is deprecated" if $^W; | 
| 641 | 0 |  |  |  |  | 0 | @_ = @split; | 
| 642 | 0 |  |  |  |  | 0 | return scalar @_; | 
| 643 |  |  |  |  |  |  | } | 
| 644 |  |  |  |  |  |  | } | 
| 645 |  |  |  |  |  |  |  | 
| 646 |  |  |  |  |  |  | # split's first argument is more consistently interpreted | 
| 647 |  |  |  |  |  |  | # | 
| 648 |  |  |  |  |  |  | # After some changes earlier in v5.17, split's behavior has been simplified: | 
| 649 |  |  |  |  |  |  | # if the PATTERN argument evaluates to a string containing one space, it is | 
| 650 |  |  |  |  |  |  | # treated the way that a literal string containing one space once was. | 
| 651 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#split's_first_argument_is_more_consistently_interpreted | 
| 652 |  |  |  |  |  |  |  | 
| 653 |  |  |  |  |  |  | # if $pattern is also omitted or is the literal space, " ", the function splits | 
| 654 |  |  |  |  |  |  | # on whitespace, /\s+/, after skipping any leading whitespace | 
| 655 |  |  |  |  |  |  | # (and so on) | 
| 656 |  |  |  |  |  |  |  | 
| 657 |  |  |  |  |  |  | elsif ($pattern eq ' ') { | 
| 658 | 0 | 0 |  |  |  | 0 | if (not defined $limit) { | 
| 659 | 0 |  |  |  |  | 0 | return CORE::split(' ', $string); | 
| 660 |  |  |  |  |  |  | } | 
| 661 |  |  |  |  |  |  | else { | 
| 662 | 0 |  |  |  |  | 0 | return CORE::split(' ', $string, $limit); | 
| 663 |  |  |  |  |  |  | } | 
| 664 |  |  |  |  |  |  | } | 
| 665 |  |  |  |  |  |  |  | 
| 666 | 0 |  |  |  |  | 0 | local $q_char = $q_char; | 
| 667 | 0 | 0 |  |  |  | 0 | if (CORE::length($string) > 32766) { | 
| 668 | 0 | 0 |  |  |  | 0 | if ($string =~ /\A [\x00-\x7F]+ \z/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 669 | 0 |  |  |  |  | 0 | $q_char = qr{.}s; | 
| 670 |  |  |  |  |  |  | } | 
| 671 |  |  |  |  |  |  | elsif (defined ${Ebig5hkscs::q_char_SADAHIRO_Tomoyuki_2002_01_17}) { | 
| 672 | 0 |  |  |  |  | 0 | $q_char = ${Ebig5hkscs::q_char_SADAHIRO_Tomoyuki_2002_01_17}; | 
| 673 |  |  |  |  |  |  | } | 
| 674 |  |  |  |  |  |  | } | 
| 675 |  |  |  |  |  |  |  | 
| 676 |  |  |  |  |  |  | # if $limit is negative, it is treated as if an arbitrarily large $limit has been specified | 
| 677 | 0 | 0 | 0 |  |  | 0 | if ((not defined $limit) or ($limit <= 0)) { | 
|  |  | 0 |  |  |  |  |  | 
| 678 |  |  |  |  |  |  |  | 
| 679 |  |  |  |  |  |  | # a pattern capable of matching either the null string or something longer than the | 
| 680 |  |  |  |  |  |  | # null string will split the value of $string into separate characters wherever it | 
| 681 |  |  |  |  |  |  | # matches the null string between characters | 
| 682 |  |  |  |  |  |  | # (and so on) | 
| 683 |  |  |  |  |  |  |  | 
| 684 | 0 | 0 |  |  |  | 0 | if ('' =~ / \A $pattern \z /xms) { | 
| 685 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 686 | 0 |  |  |  |  | 0 | my $limit = scalar(() = $string =~ /($pattern)/oxmsg); | 
| 687 |  |  |  |  |  |  |  | 
| 688 |  |  |  |  |  |  | # P.1024 Appendix W.10 Multibyte Processing | 
| 689 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 690 |  |  |  |  |  |  | # (and so on) | 
| 691 |  |  |  |  |  |  |  | 
| 692 |  |  |  |  |  |  | # the //m modifier is assumed when you split on the pattern /^/ | 
| 693 |  |  |  |  |  |  | # (and so on) | 
| 694 |  |  |  |  |  |  |  | 
| 695 |  |  |  |  |  |  | #                                                     V | 
| 696 | 0 |  | 0 |  |  | 0 | while ((--$limit > 0) and ($string =~ s/\A((?:$q_char)+?)$pattern//m)) { | 
| 697 |  |  |  |  |  |  |  | 
| 698 |  |  |  |  |  |  | # if the $pattern contains parentheses, then the substring matched by each pair of parentheses | 
| 699 |  |  |  |  |  |  | # is included in the resulting list, interspersed with the fields that are ordinarily returned | 
| 700 |  |  |  |  |  |  | # (and so on) | 
| 701 |  |  |  |  |  |  |  | 
| 702 | 0 |  |  |  |  | 0 | local $@; | 
| 703 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 704 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 705 |  |  |  |  |  |  | } | 
| 706 |  |  |  |  |  |  | } | 
| 707 |  |  |  |  |  |  | } | 
| 708 |  |  |  |  |  |  |  | 
| 709 |  |  |  |  |  |  | else { | 
| 710 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  | #                                 V | 
| 713 | 0 |  |  |  |  | 0 | while ($string =~ s/\A((?:$q_char)*?)$pattern//m) { | 
| 714 | 0 |  |  |  |  | 0 | local $@; | 
| 715 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 716 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 717 |  |  |  |  |  |  | } | 
| 718 |  |  |  |  |  |  | } | 
| 719 |  |  |  |  |  |  | } | 
| 720 |  |  |  |  |  |  | } | 
| 721 |  |  |  |  |  |  |  | 
| 722 |  |  |  |  |  |  | elsif ($limit > 0) { | 
| 723 | 0 | 0 |  |  |  | 0 | if ('' =~ / \A $pattern \z /xms) { | 
| 724 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 725 | 0 |  | 0 |  |  | 0 | while ((--$limit > 0) and (CORE::length($string) > 0)) { | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | #                              V | 
| 728 | 0 | 0 |  |  |  | 0 | if ($string =~ s/\A((?:$q_char)+?)$pattern//m) { | 
| 729 | 0 |  |  |  |  | 0 | local $@; | 
| 730 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 731 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 732 |  |  |  |  |  |  | } | 
| 733 |  |  |  |  |  |  | } | 
| 734 |  |  |  |  |  |  | } | 
| 735 |  |  |  |  |  |  | } | 
| 736 |  |  |  |  |  |  | else { | 
| 737 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 738 | 0 |  | 0 |  |  | 0 | while ((--$limit > 0) and (CORE::length($string) > 0)) { | 
| 739 |  |  |  |  |  |  |  | 
| 740 |  |  |  |  |  |  | #                              V | 
| 741 | 0 | 0 |  |  |  | 0 | if ($string =~ s/\A((?:$q_char)*?)$pattern//m) { | 
| 742 | 0 |  |  |  |  | 0 | local $@; | 
| 743 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 744 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 745 |  |  |  |  |  |  | } | 
| 746 |  |  |  |  |  |  | } | 
| 747 |  |  |  |  |  |  | } | 
| 748 |  |  |  |  |  |  | } | 
| 749 |  |  |  |  |  |  | } | 
| 750 |  |  |  |  |  |  |  | 
| 751 | 0 | 0 |  |  |  | 0 | if (CORE::length($string) > 0) { | 
| 752 | 0 |  |  |  |  | 0 | push @split, $string; | 
| 753 |  |  |  |  |  |  | } | 
| 754 |  |  |  |  |  |  |  | 
| 755 |  |  |  |  |  |  | # if $_[2] (NOT "$limit") is omitted or zero, trailing null fields are stripped from the result | 
| 756 | 0 | 0 | 0 |  |  | 0 | if ((not defined $_[2]) or ($_[2] == 0)) { | 
| 757 | 0 |  | 0 |  |  | 0 | while ((scalar(@split) >= 1) and ($split[-1] eq '')) { | 
| 758 | 0 |  |  |  |  | 0 | pop @split; | 
| 759 |  |  |  |  |  |  | } | 
| 760 |  |  |  |  |  |  | } | 
| 761 |  |  |  |  |  |  |  | 
| 762 |  |  |  |  |  |  | # resulting list value in list context | 
| 763 | 0 | 0 |  |  |  | 0 | if (wantarray) { | 
| 764 | 0 |  |  |  |  | 0 | return @split; | 
| 765 |  |  |  |  |  |  | } | 
| 766 |  |  |  |  |  |  |  | 
| 767 |  |  |  |  |  |  | # count of substrings in scalar context | 
| 768 |  |  |  |  |  |  | else { | 
| 769 | 0 | 0 |  |  |  | 0 | carp "Use of implicit split to \@_ is deprecated" if $^W; | 
| 770 | 0 |  |  |  |  | 0 | @_ = @split; | 
| 771 | 0 |  |  |  |  | 0 | return scalar @_; | 
| 772 |  |  |  |  |  |  | } | 
| 773 |  |  |  |  |  |  | } | 
| 774 |  |  |  |  |  |  |  | 
| 775 |  |  |  |  |  |  | # | 
| 776 |  |  |  |  |  |  | # get last subexpression offsets | 
| 777 |  |  |  |  |  |  | # | 
| 778 |  |  |  |  |  |  | sub _last_subexpression_offsets { | 
| 779 | 0 |  |  | 0 |  | 0 | my $pattern = $_[0]; | 
| 780 |  |  |  |  |  |  |  | 
| 781 |  |  |  |  |  |  | # remove comment | 
| 782 | 0 |  |  |  |  | 0 | $pattern =~ s/\(\?\# .*? \)//oxmsg; | 
| 783 |  |  |  |  |  |  |  | 
| 784 | 0 |  |  |  |  | 0 | my $modifier = ''; | 
| 785 | 0 | 0 |  |  |  | 0 | if ($pattern =~ /\(\?\^? ([\-A-Za-z]+) :/oxms) { | 
| 786 | 0 |  |  |  |  | 0 | $modifier = $1; | 
| 787 | 0 |  |  |  |  | 0 | $modifier =~ s/-[A-Za-z]*//; | 
| 788 |  |  |  |  |  |  | } | 
| 789 |  |  |  |  |  |  |  | 
| 790 |  |  |  |  |  |  | # with /x modifier | 
| 791 | 0 |  |  |  |  | 0 | my @char = (); | 
| 792 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /x/oxms) { | 
| 793 | 0 |  |  |  |  | 0 | @char = $pattern =~ /\G((?> | 
| 794 |  |  |  |  |  |  | [^\x81-\xFE\\\#\[\(]|[\x81-\xFE][\x00-\xFF] | | 
| 795 |  |  |  |  |  |  | \\ $q_char      | | 
| 796 |  |  |  |  |  |  | \# (?>[^\n]*) $ | | 
| 797 |  |  |  |  |  |  | \[ (?>(?:[^\x81-\xFE\\\]]|[\x81-\xFE][\x00-\xFF]|\\\\|\\\]|$q_char)+) \] | | 
| 798 |  |  |  |  |  |  | \(\?            | | 
| 799 |  |  |  |  |  |  | $q_char | 
| 800 |  |  |  |  |  |  | ))/oxmsg; | 
| 801 |  |  |  |  |  |  | } | 
| 802 |  |  |  |  |  |  |  | 
| 803 |  |  |  |  |  |  | # without /x modifier | 
| 804 |  |  |  |  |  |  | else { | 
| 805 | 0 |  |  |  |  | 0 | @char = $pattern =~ /\G((?> | 
| 806 |  |  |  |  |  |  | [^\x81-\xFE\\\[\(]|[\x81-\xFE][\x00-\xFF] | | 
| 807 |  |  |  |  |  |  | \\ $q_char      | | 
| 808 |  |  |  |  |  |  | \[ (?>(?:[^\x81-\xFE\\\]]|[\x81-\xFE][\x00-\xFF]|\\\\|\\\]|$q_char)+) \] | | 
| 809 |  |  |  |  |  |  | \(\?            | | 
| 810 |  |  |  |  |  |  | $q_char | 
| 811 |  |  |  |  |  |  | ))/oxmsg; | 
| 812 |  |  |  |  |  |  | } | 
| 813 |  |  |  |  |  |  |  | 
| 814 | 0 |  |  |  |  | 0 | return scalar grep { $_ eq '(' } @char; | 
|  | 0 |  |  |  |  | 0 |  | 
| 815 |  |  |  |  |  |  | } | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  | # | 
| 818 |  |  |  |  |  |  | # Big5-HKSCS transliteration (tr///) | 
| 819 |  |  |  |  |  |  | # | 
| 820 |  |  |  |  |  |  | sub Ebig5hkscs::tr($$$$;$) { | 
| 821 |  |  |  |  |  |  |  | 
| 822 | 0 |  |  | 0 | 0 | 0 | my $bind_operator   = $_[1]; | 
| 823 | 0 |  |  |  |  | 0 | my $searchlist      = $_[2]; | 
| 824 | 0 |  |  |  |  | 0 | my $replacementlist = $_[3]; | 
| 825 | 0 |  | 0 |  |  | 0 | my $modifier        = $_[4] || ''; | 
| 826 |  |  |  |  |  |  |  | 
| 827 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /r/oxms) { | 
| 828 | 0 | 0 |  |  |  | 0 | if ($bind_operator =~ / !~ /oxms) { | 
| 829 | 0 |  |  |  |  | 0 | croak "Using !~ with tr///r doesn't make sense"; | 
| 830 |  |  |  |  |  |  | } | 
| 831 |  |  |  |  |  |  | } | 
| 832 |  |  |  |  |  |  |  | 
| 833 | 0 |  |  |  |  | 0 | my @char            = $_[0] =~ /\G (?>$q_char) /oxmsg; | 
| 834 | 0 |  |  |  |  | 0 | my @searchlist      = _charlist_tr($searchlist); | 
| 835 | 0 |  |  |  |  | 0 | my @replacementlist = _charlist_tr($replacementlist); | 
| 836 |  |  |  |  |  |  |  | 
| 837 | 0 |  |  |  |  | 0 | my %tr = (); | 
| 838 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#searchlist; $i++) { | 
| 839 | 0 | 0 |  |  |  | 0 | if (not exists $tr{$searchlist[$i]}) { | 
| 840 | 0 | 0 | 0 |  |  | 0 | if (defined $replacementlist[$i] and ($replacementlist[$i] ne '')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 841 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = $replacementlist[$i]; | 
| 842 |  |  |  |  |  |  | } | 
| 843 |  |  |  |  |  |  | elsif ($modifier =~ /d/oxms) { | 
| 844 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = ''; | 
| 845 |  |  |  |  |  |  | } | 
| 846 |  |  |  |  |  |  | elsif (defined $replacementlist[-1] and ($replacementlist[-1] ne '')) { | 
| 847 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = $replacementlist[-1]; | 
| 848 |  |  |  |  |  |  | } | 
| 849 |  |  |  |  |  |  | else { | 
| 850 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = $searchlist[$i]; | 
| 851 |  |  |  |  |  |  | } | 
| 852 |  |  |  |  |  |  | } | 
| 853 |  |  |  |  |  |  | } | 
| 854 |  |  |  |  |  |  |  | 
| 855 | 0 |  |  |  |  | 0 | my $tr = 0; | 
| 856 | 0 |  |  |  |  | 0 | my $replaced = ''; | 
| 857 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /c/oxms) { | 
| 858 | 0 |  |  |  |  | 0 | while (defined(my $char = shift @char)) { | 
| 859 | 0 | 0 |  |  |  | 0 | if (not exists $tr{$char}) { | 
| 860 | 0 | 0 |  |  |  | 0 | if (defined $replacementlist[0]) { | 
| 861 | 0 |  |  |  |  | 0 | $replaced .= $replacementlist[0]; | 
| 862 |  |  |  |  |  |  | } | 
| 863 | 0 |  |  |  |  | 0 | $tr++; | 
| 864 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /s/oxms) { | 
| 865 | 0 |  | 0 |  |  | 0 | while (@char and (not exists $tr{$char[0]})) { | 
| 866 | 0 |  |  |  |  | 0 | shift @char; | 
| 867 | 0 |  |  |  |  | 0 | $tr++; | 
| 868 |  |  |  |  |  |  | } | 
| 869 |  |  |  |  |  |  | } | 
| 870 |  |  |  |  |  |  | } | 
| 871 |  |  |  |  |  |  | else { | 
| 872 | 0 |  |  |  |  | 0 | $replaced .= $char; | 
| 873 |  |  |  |  |  |  | } | 
| 874 |  |  |  |  |  |  | } | 
| 875 |  |  |  |  |  |  | } | 
| 876 |  |  |  |  |  |  | else { | 
| 877 | 0 |  |  |  |  | 0 | while (defined(my $char = shift @char)) { | 
| 878 | 0 | 0 |  |  |  | 0 | if (exists $tr{$char}) { | 
| 879 | 0 |  |  |  |  | 0 | $replaced .= $tr{$char}; | 
| 880 | 0 |  |  |  |  | 0 | $tr++; | 
| 881 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /s/oxms) { | 
| 882 | 0 |  | 0 |  |  | 0 | while (@char and (exists $tr{$char[0]}) and ($tr{$char[0]} eq $tr{$char})) { | 
|  |  |  | 0 |  |  |  |  | 
| 883 | 0 |  |  |  |  | 0 | shift @char; | 
| 884 | 0 |  |  |  |  | 0 | $tr++; | 
| 885 |  |  |  |  |  |  | } | 
| 886 |  |  |  |  |  |  | } | 
| 887 |  |  |  |  |  |  | } | 
| 888 |  |  |  |  |  |  | else { | 
| 889 | 0 |  |  |  |  | 0 | $replaced .= $char; | 
| 890 |  |  |  |  |  |  | } | 
| 891 |  |  |  |  |  |  | } | 
| 892 |  |  |  |  |  |  | } | 
| 893 |  |  |  |  |  |  |  | 
| 894 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /r/oxms) { | 
| 895 | 0 |  |  |  |  | 0 | return $replaced; | 
| 896 |  |  |  |  |  |  | } | 
| 897 |  |  |  |  |  |  | else { | 
| 898 | 0 |  |  |  |  | 0 | $_[0] = $replaced; | 
| 899 | 0 | 0 |  |  |  | 0 | if ($bind_operator =~ / !~ /oxms) { | 
| 900 | 0 |  |  |  |  | 0 | return not $tr; | 
| 901 |  |  |  |  |  |  | } | 
| 902 |  |  |  |  |  |  | else { | 
| 903 | 0 |  |  |  |  | 0 | return $tr; | 
| 904 |  |  |  |  |  |  | } | 
| 905 |  |  |  |  |  |  | } | 
| 906 |  |  |  |  |  |  | } | 
| 907 |  |  |  |  |  |  |  | 
| 908 |  |  |  |  |  |  | # | 
| 909 |  |  |  |  |  |  | # Big5-HKSCS chop | 
| 910 |  |  |  |  |  |  | # | 
| 911 |  |  |  |  |  |  | sub Ebig5hkscs::chop(@) { | 
| 912 |  |  |  |  |  |  |  | 
| 913 | 0 |  |  | 0 | 0 | 0 | my $chop; | 
| 914 | 0 | 0 |  |  |  | 0 | if (@_ == 0) { | 
| 915 | 0 |  |  |  |  | 0 | my @char = /\G (?>$q_char) /oxmsg; | 
| 916 | 0 |  |  |  |  | 0 | $chop = pop @char; | 
| 917 | 0 |  |  |  |  | 0 | $_ = join '', @char; | 
| 918 |  |  |  |  |  |  | } | 
| 919 |  |  |  |  |  |  | else { | 
| 920 | 0 |  |  |  |  | 0 | for (@_) { | 
| 921 | 0 |  |  |  |  | 0 | my @char = /\G (?>$q_char) /oxmsg; | 
| 922 | 0 |  |  |  |  | 0 | $chop = pop @char; | 
| 923 | 0 |  |  |  |  | 0 | $_ = join '', @char; | 
| 924 |  |  |  |  |  |  | } | 
| 925 |  |  |  |  |  |  | } | 
| 926 | 0 |  |  |  |  | 0 | return $chop; | 
| 927 |  |  |  |  |  |  | } | 
| 928 |  |  |  |  |  |  |  | 
| 929 |  |  |  |  |  |  | # | 
| 930 |  |  |  |  |  |  | # Big5-HKSCS index by octet | 
| 931 |  |  |  |  |  |  | # | 
| 932 |  |  |  |  |  |  | sub Ebig5hkscs::index($$;$) { | 
| 933 |  |  |  |  |  |  |  | 
| 934 | 0 |  |  | 2304 | 1 | 0 | my($str,$substr,$position) = @_; | 
| 935 | 2304 |  | 50 |  |  | 4801 | $position ||= 0; | 
| 936 | 2304 |  |  |  |  | 9330 | my $pos = 0; | 
| 937 |  |  |  |  |  |  |  | 
| 938 | 2304 |  |  |  |  | 2848 | while ($pos < CORE::length($str)) { | 
| 939 | 2304 | 50 |  |  |  | 5162 | if (CORE::substr($str,$pos,CORE::length($substr)) eq $substr) { | 
| 940 | 64284 | 0 |  |  |  | 123614 | if ($pos >= $position) { | 
| 941 | 0 |  |  |  |  | 0 | return $pos; | 
| 942 |  |  |  |  |  |  | } | 
| 943 |  |  |  |  |  |  | } | 
| 944 | 0 | 50 |  |  |  | 0 | if (CORE::substr($str,$pos) =~ /\A ($q_char) /oxms) { | 
| 945 | 64284 |  |  |  |  | 151743 | $pos += CORE::length($1); | 
| 946 |  |  |  |  |  |  | } | 
| 947 |  |  |  |  |  |  | else { | 
| 948 | 64284 |  |  |  |  | 111581 | $pos += 1; | 
| 949 |  |  |  |  |  |  | } | 
| 950 |  |  |  |  |  |  | } | 
| 951 | 0 |  |  |  |  | 0 | return -1; | 
| 952 |  |  |  |  |  |  | } | 
| 953 |  |  |  |  |  |  |  | 
| 954 |  |  |  |  |  |  | # | 
| 955 |  |  |  |  |  |  | # Big5-HKSCS reverse index | 
| 956 |  |  |  |  |  |  | # | 
| 957 |  |  |  |  |  |  | sub Ebig5hkscs::rindex($$;$) { | 
| 958 |  |  |  |  |  |  |  | 
| 959 | 2304 |  |  | 0 | 0 | 13707 | my($str,$substr,$position) = @_; | 
| 960 | 0 |  | 0 |  |  | 0 | $position ||= CORE::length($str) - 1; | 
| 961 | 0 |  |  |  |  | 0 | my $pos = 0; | 
| 962 | 0 |  |  |  |  | 0 | my $rindex = -1; | 
| 963 |  |  |  |  |  |  |  | 
| 964 | 0 |  | 0 |  |  | 0 | while (($pos < CORE::length($str)) and ($pos <= $position)) { | 
| 965 | 0 | 0 |  |  |  | 0 | if (CORE::substr($str,$pos,CORE::length($substr)) eq $substr) { | 
| 966 | 0 |  |  |  |  | 0 | $rindex = $pos; | 
| 967 |  |  |  |  |  |  | } | 
| 968 | 0 | 0 |  |  |  | 0 | if (CORE::substr($str,$pos) =~ /\A ($q_char) /oxms) { | 
| 969 | 0 |  |  |  |  | 0 | $pos += CORE::length($1); | 
| 970 |  |  |  |  |  |  | } | 
| 971 |  |  |  |  |  |  | else { | 
| 972 | 0 |  |  |  |  | 0 | $pos += 1; | 
| 973 |  |  |  |  |  |  | } | 
| 974 |  |  |  |  |  |  | } | 
| 975 | 0 |  |  |  |  | 0 | return $rindex; | 
| 976 |  |  |  |  |  |  | } | 
| 977 |  |  |  |  |  |  |  | 
| 978 |  |  |  |  |  |  | # | 
| 979 |  |  |  |  |  |  | # Big5-HKSCS lower case first with parameter | 
| 980 |  |  |  |  |  |  | # | 
| 981 |  |  |  |  |  |  | sub Ebig5hkscs::lcfirst(@) { | 
| 982 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 983 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 984 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 985 | 0 |  |  |  |  | 0 | return Ebig5hkscs::lc(CORE::substr($s,0,1)) . CORE::substr($s,1), @_; | 
| 986 |  |  |  |  |  |  | } | 
| 987 |  |  |  |  |  |  | else { | 
| 988 | 0 |  |  |  |  | 0 | return Ebig5hkscs::lc(CORE::substr($s,0,1)) . CORE::substr($s,1); | 
| 989 |  |  |  |  |  |  | } | 
| 990 |  |  |  |  |  |  | } | 
| 991 |  |  |  |  |  |  | else { | 
| 992 | 0 |  |  |  |  | 0 | return Ebig5hkscs::lc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 993 |  |  |  |  |  |  | } | 
| 994 |  |  |  |  |  |  | } | 
| 995 |  |  |  |  |  |  |  | 
| 996 |  |  |  |  |  |  | # | 
| 997 |  |  |  |  |  |  | # Big5-HKSCS lower case first without parameter | 
| 998 |  |  |  |  |  |  | # | 
| 999 |  |  |  |  |  |  | sub Ebig5hkscs::lcfirst_() { | 
| 1000 | 0 |  |  | 0 | 0 | 0 | return Ebig5hkscs::lc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 1001 |  |  |  |  |  |  | } | 
| 1002 |  |  |  |  |  |  |  | 
| 1003 |  |  |  |  |  |  | # | 
| 1004 |  |  |  |  |  |  | # Big5-HKSCS lower case with parameter | 
| 1005 |  |  |  |  |  |  | # | 
| 1006 |  |  |  |  |  |  | sub Ebig5hkscs::lc(@) { | 
| 1007 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 1008 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 1009 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 1010 | 0 | 0 |  |  |  | 0 | return join('', map {defined($lc{$_}) ? $lc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)), @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1011 |  |  |  |  |  |  | } | 
| 1012 |  |  |  |  |  |  | else { | 
| 1013 | 0 | 0 |  |  |  | 0 | return join('', map {defined($lc{$_}) ? $lc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1014 |  |  |  |  |  |  | } | 
| 1015 |  |  |  |  |  |  | } | 
| 1016 |  |  |  |  |  |  | else { | 
| 1017 | 0 |  |  |  |  | 0 | return Ebig5hkscs::lc_(); | 
| 1018 |  |  |  |  |  |  | } | 
| 1019 |  |  |  |  |  |  | } | 
| 1020 |  |  |  |  |  |  |  | 
| 1021 |  |  |  |  |  |  | # | 
| 1022 |  |  |  |  |  |  | # Big5-HKSCS lower case without parameter | 
| 1023 |  |  |  |  |  |  | # | 
| 1024 |  |  |  |  |  |  | sub Ebig5hkscs::lc_() { | 
| 1025 | 0 |  |  | 0 | 0 | 0 | my $s = $_; | 
| 1026 | 0 | 0 |  |  |  | 0 | return join '', map {defined($lc{$_}) ? $lc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1027 |  |  |  |  |  |  | } | 
| 1028 |  |  |  |  |  |  |  | 
| 1029 |  |  |  |  |  |  | # | 
| 1030 |  |  |  |  |  |  | # Big5-HKSCS upper case first with parameter | 
| 1031 |  |  |  |  |  |  | # | 
| 1032 |  |  |  |  |  |  | sub Ebig5hkscs::ucfirst(@) { | 
| 1033 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 1034 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 1035 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 1036 | 0 |  |  |  |  | 0 | return Ebig5hkscs::uc(CORE::substr($s,0,1)) . CORE::substr($s,1), @_; | 
| 1037 |  |  |  |  |  |  | } | 
| 1038 |  |  |  |  |  |  | else { | 
| 1039 | 0 |  |  |  |  | 0 | return Ebig5hkscs::uc(CORE::substr($s,0,1)) . CORE::substr($s,1); | 
| 1040 |  |  |  |  |  |  | } | 
| 1041 |  |  |  |  |  |  | } | 
| 1042 |  |  |  |  |  |  | else { | 
| 1043 | 0 |  |  |  |  | 0 | return Ebig5hkscs::uc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 1044 |  |  |  |  |  |  | } | 
| 1045 |  |  |  |  |  |  | } | 
| 1046 |  |  |  |  |  |  |  | 
| 1047 |  |  |  |  |  |  | # | 
| 1048 |  |  |  |  |  |  | # Big5-HKSCS upper case first without parameter | 
| 1049 |  |  |  |  |  |  | # | 
| 1050 |  |  |  |  |  |  | sub Ebig5hkscs::ucfirst_() { | 
| 1051 | 0 |  |  | 0 | 0 | 0 | return Ebig5hkscs::uc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 1052 |  |  |  |  |  |  | } | 
| 1053 |  |  |  |  |  |  |  | 
| 1054 |  |  |  |  |  |  | # | 
| 1055 |  |  |  |  |  |  | # Big5-HKSCS upper case with parameter | 
| 1056 |  |  |  |  |  |  | # | 
| 1057 |  |  |  |  |  |  | sub Ebig5hkscs::uc(@) { | 
| 1058 | 0 | 50 |  | 2968 | 0 | 0 | if (@_) { | 
| 1059 | 2968 |  |  |  |  | 4309 | my $s = shift @_; | 
| 1060 | 2968 | 50 | 33 |  |  | 3623 | if (@_ and wantarray) { | 
| 1061 | 2968 | 0 |  |  |  | 5422 | return join('', map {defined($uc{$_}) ? $uc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)), @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1062 |  |  |  |  |  |  | } | 
| 1063 |  |  |  |  |  |  | else { | 
| 1064 | 0 | 100 |  |  |  | 0 | return join('', map {defined($uc{$_}) ? $uc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)); | 
|  | 2968 |  |  |  |  | 7902 |  | 
| 1065 |  |  |  |  |  |  | } | 
| 1066 |  |  |  |  |  |  | } | 
| 1067 |  |  |  |  |  |  | else { | 
| 1068 | 2968 |  |  |  |  | 10129 | return Ebig5hkscs::uc_(); | 
| 1069 |  |  |  |  |  |  | } | 
| 1070 |  |  |  |  |  |  | } | 
| 1071 |  |  |  |  |  |  |  | 
| 1072 |  |  |  |  |  |  | # | 
| 1073 |  |  |  |  |  |  | # Big5-HKSCS upper case without parameter | 
| 1074 |  |  |  |  |  |  | # | 
| 1075 |  |  |  |  |  |  | sub Ebig5hkscs::uc_() { | 
| 1076 | 0 |  |  | 0 | 0 | 0 | my $s = $_; | 
| 1077 | 0 | 0 |  |  |  | 0 | return join '', map {defined($uc{$_}) ? $uc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1078 |  |  |  |  |  |  | } | 
| 1079 |  |  |  |  |  |  |  | 
| 1080 |  |  |  |  |  |  | # | 
| 1081 |  |  |  |  |  |  | # Big5-HKSCS fold case with parameter | 
| 1082 |  |  |  |  |  |  | # | 
| 1083 |  |  |  |  |  |  | sub Ebig5hkscs::fc(@) { | 
| 1084 | 0 | 50 |  | 3271 | 0 | 0 | if (@_) { | 
| 1085 | 3271 |  |  |  |  | 4480 | my $s = shift @_; | 
| 1086 | 3271 | 50 | 33 |  |  | 3705 | if (@_ and wantarray) { | 
| 1087 | 3271 | 0 |  |  |  | 5425 | return join('', map {defined($fc{$_}) ? $fc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)), @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1088 |  |  |  |  |  |  | } | 
| 1089 |  |  |  |  |  |  | else { | 
| 1090 | 0 | 100 |  |  |  | 0 | return join('', map {defined($fc{$_}) ? $fc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)); | 
|  | 3271 |  |  |  |  | 7989 |  | 
| 1091 |  |  |  |  |  |  | } | 
| 1092 |  |  |  |  |  |  | } | 
| 1093 |  |  |  |  |  |  | else { | 
| 1094 | 3271 |  |  |  |  | 12006 | return Ebig5hkscs::fc_(); | 
| 1095 |  |  |  |  |  |  | } | 
| 1096 |  |  |  |  |  |  | } | 
| 1097 |  |  |  |  |  |  |  | 
| 1098 |  |  |  |  |  |  | # | 
| 1099 |  |  |  |  |  |  | # Big5-HKSCS fold case without parameter | 
| 1100 |  |  |  |  |  |  | # | 
| 1101 |  |  |  |  |  |  | sub Ebig5hkscs::fc_() { | 
| 1102 | 0 |  |  | 0 | 0 | 0 | my $s = $_; | 
| 1103 | 0 | 0 |  |  |  | 0 | return join '', map {defined($fc{$_}) ? $fc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1104 |  |  |  |  |  |  | } | 
| 1105 |  |  |  |  |  |  |  | 
| 1106 |  |  |  |  |  |  | # | 
| 1107 |  |  |  |  |  |  | # Big5-HKSCS regexp capture | 
| 1108 |  |  |  |  |  |  | # | 
| 1109 |  |  |  |  |  |  | { | 
| 1110 |  |  |  |  |  |  | # 10.3. Creating Persistent Private Variables | 
| 1111 |  |  |  |  |  |  | # in Chapter 10. Subroutines | 
| 1112 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 1113 |  |  |  |  |  |  |  | 
| 1114 |  |  |  |  |  |  | my $last_s_matched = 0; | 
| 1115 |  |  |  |  |  |  |  | 
| 1116 |  |  |  |  |  |  | sub Ebig5hkscs::capture { | 
| 1117 | 0 | 0 | 0 | 0 | 1 | 0 | if ($last_s_matched and ($_[0] =~ /\A (?>[1-9][0-9]*) \z/oxms)) { | 
| 1118 | 0 |  |  |  |  | 0 | return $_[0] + 1; | 
| 1119 |  |  |  |  |  |  | } | 
| 1120 | 0 |  |  |  |  | 0 | return $_[0]; | 
| 1121 |  |  |  |  |  |  | } | 
| 1122 |  |  |  |  |  |  |  | 
| 1123 |  |  |  |  |  |  | # Big5-HKSCS mark last regexp matched | 
| 1124 |  |  |  |  |  |  | sub Ebig5hkscs::matched() { | 
| 1125 | 0 |  |  | 0 | 0 | 0 | $last_s_matched = 0; | 
| 1126 |  |  |  |  |  |  | } | 
| 1127 |  |  |  |  |  |  |  | 
| 1128 |  |  |  |  |  |  | # Big5-HKSCS mark last s/// matched | 
| 1129 |  |  |  |  |  |  | sub Ebig5hkscs::s_matched() { | 
| 1130 | 0 |  |  | 0 | 0 | 0 | $last_s_matched = 1; | 
| 1131 |  |  |  |  |  |  | } | 
| 1132 |  |  |  |  |  |  |  | 
| 1133 |  |  |  |  |  |  | # P.854 31.17. use re | 
| 1134 |  |  |  |  |  |  | # in Chapter 31. Pragmatic Modules | 
| 1135 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 1136 |  |  |  |  |  |  |  | 
| 1137 |  |  |  |  |  |  | # P.1026 re | 
| 1138 |  |  |  |  |  |  | # in Chapter 29. Pragmatic Modules | 
| 1139 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 1140 |  |  |  |  |  |  |  | 
| 1141 |  |  |  |  |  |  | $Ebig5hkscs::matched = qr/(?{Ebig5hkscs::matched})/; | 
| 1142 |  |  |  |  |  |  | } | 
| 1143 |  |  |  |  |  |  |  | 
| 1144 |  |  |  |  |  |  | # | 
| 1145 |  |  |  |  |  |  | # Big5-HKSCS regexp ignore case modifier | 
| 1146 |  |  |  |  |  |  | # | 
| 1147 |  |  |  |  |  |  | sub Ebig5hkscs::ignorecase { | 
| 1148 |  |  |  |  |  |  |  | 
| 1149 | 0 |  |  | 0 | 0 | 0 | my @string = @_; | 
| 1150 | 0 |  |  |  |  | 0 | my $metachar = qr/[\@\\|[\]{]/oxms; | 
| 1151 |  |  |  |  |  |  |  | 
| 1152 |  |  |  |  |  |  | # ignore case of $scalar or @array | 
| 1153 | 0 |  |  |  |  | 0 | for my $string (@string) { | 
| 1154 |  |  |  |  |  |  |  | 
| 1155 |  |  |  |  |  |  | # split regexp | 
| 1156 | 0 |  |  |  |  | 0 | my @char = $string =~ /\G (?>\[\^|\\$q_char|$q_char) /oxmsg; | 
| 1157 |  |  |  |  |  |  |  | 
| 1158 |  |  |  |  |  |  | # unescape character | 
| 1159 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#char; $i++) { | 
| 1160 | 0 | 0 |  |  |  | 0 | next if not defined $char[$i]; | 
| 1161 |  |  |  |  |  |  |  | 
| 1162 |  |  |  |  |  |  | # open character class [...] | 
| 1163 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq '[') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1164 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 1165 |  |  |  |  |  |  |  | 
| 1166 |  |  |  |  |  |  | # [] make die "unmatched [] in regexp ...\n" | 
| 1167 |  |  |  |  |  |  |  | 
| 1168 | 0 | 0 |  |  |  | 0 | if ($char[$i+1] eq ']') { | 
| 1169 | 0 |  |  |  |  | 0 | $i++; | 
| 1170 |  |  |  |  |  |  | } | 
| 1171 |  |  |  |  |  |  |  | 
| 1172 | 0 |  |  |  |  | 0 | while (1) { | 
| 1173 | 0 | 0 |  |  |  | 0 | if (++$i > $#char) { | 
| 1174 | 0 |  |  |  |  | 0 | croak "Unmatched [] in regexp"; | 
| 1175 |  |  |  |  |  |  | } | 
| 1176 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq ']') { | 
| 1177 | 0 |  |  |  |  | 0 | my $right = $i; | 
| 1178 | 0 |  |  |  |  | 0 | my @charlist = charlist_qr(@char[$left+1..$right-1], 'i'); | 
| 1179 |  |  |  |  |  |  |  | 
| 1180 |  |  |  |  |  |  | # escape character | 
| 1181 | 0 |  |  |  |  | 0 | for my $char (@charlist) { | 
| 1182 | 0 | 0 |  |  |  | 0 | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
| 1183 |  |  |  |  |  |  | } | 
| 1184 |  |  |  |  |  |  |  | 
| 1185 |  |  |  |  |  |  | # do not use quotemeta here | 
| 1186 | 0 |  |  |  |  | 0 | elsif ($char =~ /\A ([\x80-\xFF].*) ($metachar) \z/oxms) { | 
| 1187 | 0 |  |  |  |  | 0 | $char = $1 . '\\' . $2; | 
| 1188 |  |  |  |  |  |  | } | 
| 1189 |  |  |  |  |  |  | elsif ($char =~ /\A [.|)] \z/oxms) { | 
| 1190 | 0 |  |  |  |  | 0 | $char = '\\' . $char; | 
| 1191 |  |  |  |  |  |  | } | 
| 1192 |  |  |  |  |  |  | } | 
| 1193 |  |  |  |  |  |  |  | 
| 1194 |  |  |  |  |  |  | # [...] | 
| 1195 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, '(?:' . join('|', @charlist) . ')'; | 
| 1196 |  |  |  |  |  |  |  | 
| 1197 | 0 |  |  |  |  | 0 | $i = $left; | 
| 1198 | 0 |  |  |  |  | 0 | last; | 
| 1199 |  |  |  |  |  |  | } | 
| 1200 |  |  |  |  |  |  | } | 
| 1201 |  |  |  |  |  |  | } | 
| 1202 |  |  |  |  |  |  |  | 
| 1203 |  |  |  |  |  |  | # open character class [^...] | 
| 1204 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 1205 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 1206 |  |  |  |  |  |  |  | 
| 1207 |  |  |  |  |  |  | # [^] make die "unmatched [] in regexp ...\n" | 
| 1208 |  |  |  |  |  |  |  | 
| 1209 | 0 | 0 |  |  |  | 0 | if ($char[$i+1] eq ']') { | 
| 1210 | 0 |  |  |  |  | 0 | $i++; | 
| 1211 |  |  |  |  |  |  | } | 
| 1212 |  |  |  |  |  |  |  | 
| 1213 | 0 |  |  |  |  | 0 | while (1) { | 
| 1214 | 0 | 0 |  |  |  | 0 | if (++$i > $#char) { | 
| 1215 | 0 |  |  |  |  | 0 | croak "Unmatched [] in regexp"; | 
| 1216 |  |  |  |  |  |  | } | 
| 1217 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq ']') { | 
| 1218 | 0 |  |  |  |  | 0 | my $right = $i; | 
| 1219 | 0 |  |  |  |  | 0 | my @charlist = charlist_not_qr(@char[$left+1..$right-1], 'i'); | 
| 1220 |  |  |  |  |  |  |  | 
| 1221 |  |  |  |  |  |  | # escape character | 
| 1222 | 0 |  |  |  |  | 0 | for my $char (@charlist) { | 
| 1223 | 0 | 0 |  |  |  | 0 | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
| 1224 |  |  |  |  |  |  | } | 
| 1225 |  |  |  |  |  |  |  | 
| 1226 |  |  |  |  |  |  | # do not use quotemeta here | 
| 1227 | 0 |  |  |  |  | 0 | elsif ($char =~ /\A ([\x80-\xFF].*) ($metachar) \z/oxms) { | 
| 1228 | 0 |  |  |  |  | 0 | $char = $1 . '\\' . $2; | 
| 1229 |  |  |  |  |  |  | } | 
| 1230 |  |  |  |  |  |  | elsif ($char =~ /\A [.|)] \z/oxms) { | 
| 1231 | 0 |  |  |  |  | 0 | $char = '\\' . $char; | 
| 1232 |  |  |  |  |  |  | } | 
| 1233 |  |  |  |  |  |  | } | 
| 1234 |  |  |  |  |  |  |  | 
| 1235 |  |  |  |  |  |  | # [^...] | 
| 1236 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, '(?!' . join('|', @charlist) . ")(?:$your_char)"; | 
| 1237 |  |  |  |  |  |  |  | 
| 1238 | 0 |  |  |  |  | 0 | $i = $left; | 
| 1239 | 0 |  |  |  |  | 0 | last; | 
| 1240 |  |  |  |  |  |  | } | 
| 1241 |  |  |  |  |  |  | } | 
| 1242 |  |  |  |  |  |  | } | 
| 1243 |  |  |  |  |  |  |  | 
| 1244 |  |  |  |  |  |  | # rewrite classic character class or escape character | 
| 1245 |  |  |  |  |  |  | elsif (my $char = classic_character_class($char[$i])) { | 
| 1246 | 0 |  |  |  |  | 0 | $char[$i] = $char; | 
| 1247 |  |  |  |  |  |  | } | 
| 1248 |  |  |  |  |  |  |  | 
| 1249 |  |  |  |  |  |  | # with /i modifier | 
| 1250 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 1251 | 0 |  |  |  |  | 0 | my $uc = Ebig5hkscs::uc($char[$i]); | 
| 1252 | 0 |  |  |  |  | 0 | my $fc = Ebig5hkscs::fc($char[$i]); | 
| 1253 | 0 | 0 |  |  |  | 0 | if ($uc ne $fc) { | 
| 1254 | 0 | 0 |  |  |  | 0 | if (CORE::length($fc) == 1) { | 
| 1255 | 0 |  |  |  |  | 0 | $char[$i] = '['   . $uc       . $fc . ']'; | 
| 1256 |  |  |  |  |  |  | } | 
| 1257 |  |  |  |  |  |  | else { | 
| 1258 | 0 |  |  |  |  | 0 | $char[$i] = '(?:' . $uc . '|' . $fc . ')'; | 
| 1259 |  |  |  |  |  |  | } | 
| 1260 |  |  |  |  |  |  | } | 
| 1261 |  |  |  |  |  |  | } | 
| 1262 |  |  |  |  |  |  | } | 
| 1263 |  |  |  |  |  |  |  | 
| 1264 |  |  |  |  |  |  | # characterize | 
| 1265 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#char; $i++) { | 
| 1266 | 0 | 0 |  |  |  | 0 | next if not defined $char[$i]; | 
| 1267 |  |  |  |  |  |  |  | 
| 1268 | 0 | 0 | 0 |  |  | 0 | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
| 1269 |  |  |  |  |  |  | } | 
| 1270 |  |  |  |  |  |  |  | 
| 1271 |  |  |  |  |  |  | # escape last octet of multiple-octet | 
| 1272 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ($metachar) \z/oxms) { | 
| 1273 | 0 |  |  |  |  | 0 | $char[$i] = $1 . '\\' . $2; | 
| 1274 |  |  |  |  |  |  | } | 
| 1275 |  |  |  |  |  |  |  | 
| 1276 |  |  |  |  |  |  | # quote character before ? + * { | 
| 1277 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 1278 | 0 | 0 |  |  |  | 0 | if ($char[$i-1] !~ /\A [\x00-\xFF] \z/oxms) { | 
| 1279 | 0 |  |  |  |  | 0 | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 1280 |  |  |  |  |  |  | } | 
| 1281 |  |  |  |  |  |  | } | 
| 1282 |  |  |  |  |  |  | } | 
| 1283 |  |  |  |  |  |  |  | 
| 1284 | 0 |  |  |  |  | 0 | $string = join '', @char; | 
| 1285 |  |  |  |  |  |  | } | 
| 1286 |  |  |  |  |  |  |  | 
| 1287 |  |  |  |  |  |  | # make regexp string | 
| 1288 | 0 |  |  |  |  | 0 | return @string; | 
| 1289 |  |  |  |  |  |  | } | 
| 1290 |  |  |  |  |  |  |  | 
| 1291 |  |  |  |  |  |  | # | 
| 1292 |  |  |  |  |  |  | # classic character class ( \D \S \W \d \s \w \C \X \H \V \h \v \R \N \b \B ) | 
| 1293 |  |  |  |  |  |  | # | 
| 1294 |  |  |  |  |  |  | sub Ebig5hkscs::classic_character_class { | 
| 1295 | 0 |  |  | 5319 | 0 | 0 | my($char) = @_; | 
| 1296 |  |  |  |  |  |  |  | 
| 1297 |  |  |  |  |  |  | return { | 
| 1298 |  |  |  |  |  |  | '\D' => '${Ebig5hkscs::eD}', | 
| 1299 |  |  |  |  |  |  | '\S' => '${Ebig5hkscs::eS}', | 
| 1300 |  |  |  |  |  |  | '\W' => '${Ebig5hkscs::eW}', | 
| 1301 |  |  |  |  |  |  | '\d' => '[0-9]', | 
| 1302 |  |  |  |  |  |  |  | 
| 1303 |  |  |  |  |  |  | # Before Perl 5.6, \s only matched the five whitespace characters | 
| 1304 |  |  |  |  |  |  | # tab, newline, form-feed, carriage return, and the space character | 
| 1305 |  |  |  |  |  |  | # itself, which, taken together, is the character class [\t\n\f\r ]. | 
| 1306 |  |  |  |  |  |  |  | 
| 1307 |  |  |  |  |  |  | # Vertical tabs are now whitespace | 
| 1308 |  |  |  |  |  |  | # \s in a regex now matches a vertical tab in all circumstances. | 
| 1309 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace | 
| 1310 |  |  |  |  |  |  | #            \t  \n  \v  \f  \r space | 
| 1311 |  |  |  |  |  |  | # '\s' => '[\x09\x0A    \x0C\x0D\x20]', | 
| 1312 |  |  |  |  |  |  | # '\s' => '[\x09\x0A\x0B\x0C\x0D\x20]', | 
| 1313 |  |  |  |  |  |  | '\s'   => '\s', | 
| 1314 |  |  |  |  |  |  |  | 
| 1315 |  |  |  |  |  |  | '\w' => '[0-9A-Z_a-z]', | 
| 1316 |  |  |  |  |  |  | '\C' => '[\x00-\xFF]', | 
| 1317 |  |  |  |  |  |  | '\X' => 'X', | 
| 1318 |  |  |  |  |  |  |  | 
| 1319 |  |  |  |  |  |  | # \h \v \H \V | 
| 1320 |  |  |  |  |  |  |  | 
| 1321 |  |  |  |  |  |  | # P.114 Character Class Shortcuts | 
| 1322 |  |  |  |  |  |  | # in Chapter 7: In the World of Regular Expressions | 
| 1323 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 1324 |  |  |  |  |  |  |  | 
| 1325 |  |  |  |  |  |  | # P.357 13.2.3 Whitespace | 
| 1326 |  |  |  |  |  |  | # in Chapter 13: perlrecharclass: Perl Regular Expression Character Classes | 
| 1327 |  |  |  |  |  |  | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
| 1328 |  |  |  |  |  |  | # | 
| 1329 |  |  |  |  |  |  | # 0x00009   CHARACTER TABULATION  h s | 
| 1330 |  |  |  |  |  |  | # 0x0000a         LINE FEED (LF)   vs | 
| 1331 |  |  |  |  |  |  | # 0x0000b        LINE TABULATION   v | 
| 1332 |  |  |  |  |  |  | # 0x0000c         FORM FEED (FF)   vs | 
| 1333 |  |  |  |  |  |  | # 0x0000d   CARRIAGE RETURN (CR)   vs | 
| 1334 |  |  |  |  |  |  | # 0x00020                  SPACE  h s | 
| 1335 |  |  |  |  |  |  |  | 
| 1336 |  |  |  |  |  |  | # P.196 Table 5-9. Alphanumeric regex metasymbols | 
| 1337 |  |  |  |  |  |  | # in Chapter 5. Pattern Matching | 
| 1338 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 1339 |  |  |  |  |  |  |  | 
| 1340 |  |  |  |  |  |  | # (and so on) | 
| 1341 |  |  |  |  |  |  |  | 
| 1342 |  |  |  |  |  |  | '\H' => '${Ebig5hkscs::eH}', | 
| 1343 |  |  |  |  |  |  | '\V' => '${Ebig5hkscs::eV}', | 
| 1344 |  |  |  |  |  |  | '\h' => '[\x09\x20]', | 
| 1345 |  |  |  |  |  |  | '\v' => '[\x0A\x0B\x0C\x0D]', | 
| 1346 |  |  |  |  |  |  | '\R' => '${Ebig5hkscs::eR}', | 
| 1347 |  |  |  |  |  |  |  | 
| 1348 |  |  |  |  |  |  | # \N | 
| 1349 |  |  |  |  |  |  | # | 
| 1350 |  |  |  |  |  |  | # http://perldoc.perl.org/perlre.html | 
| 1351 |  |  |  |  |  |  | # Character Classes and other Special Escapes | 
| 1352 |  |  |  |  |  |  | # Any character but \n (experimental). Not affected by /s modifier | 
| 1353 |  |  |  |  |  |  |  | 
| 1354 |  |  |  |  |  |  | '\N' => '${Ebig5hkscs::eN}', | 
| 1355 |  |  |  |  |  |  |  | 
| 1356 |  |  |  |  |  |  | # \b \B | 
| 1357 |  |  |  |  |  |  |  | 
| 1358 |  |  |  |  |  |  | # P.180 Boundaries: The \b and \B Assertions | 
| 1359 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 1360 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 1361 |  |  |  |  |  |  |  | 
| 1362 |  |  |  |  |  |  | # P.219 Boundaries: The \b and \B Assertions | 
| 1363 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 1364 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 1365 |  |  |  |  |  |  |  | 
| 1366 |  |  |  |  |  |  | # \b really means (?:(?<=\w)(?!\w)|(? | 
| 1367 |  |  |  |  |  |  | #           or (?:(?<=\A|\W)(?=\w)|(?<=\w)(?=\W|\z)) | 
| 1368 |  |  |  |  |  |  | '\b' => '${Ebig5hkscs::eb}', | 
| 1369 |  |  |  |  |  |  |  | 
| 1370 |  |  |  |  |  |  | # \B really means (?:(?<=\w)(?=\w)|(? | 
| 1371 |  |  |  |  |  |  | #              or (?:(?<=\w)(?=\w)|(?<=\W)(?=\W)) | 
| 1372 |  |  |  |  |  |  | '\B' => '${Ebig5hkscs::eB}', | 
| 1373 |  |  |  |  |  |  |  | 
| 1374 | 5319 |  | 100 |  |  | 7637 | }->{$char} || ''; | 
| 1375 |  |  |  |  |  |  | } | 
| 1376 |  |  |  |  |  |  |  | 
| 1377 |  |  |  |  |  |  | # | 
| 1378 |  |  |  |  |  |  | # prepare Big5-HKSCS characters per length | 
| 1379 |  |  |  |  |  |  | # | 
| 1380 |  |  |  |  |  |  |  | 
| 1381 |  |  |  |  |  |  | # 1 octet characters | 
| 1382 |  |  |  |  |  |  | my @chars1 = (); | 
| 1383 |  |  |  |  |  |  | sub chars1 { | 
| 1384 | 5319 | 0 |  | 0 | 0 | 171771 | if (@chars1) { | 
| 1385 | 0 |  |  |  |  | 0 | return @chars1; | 
| 1386 |  |  |  |  |  |  | } | 
| 1387 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{1}) { | 
| 1388 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{1} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1389 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,1)) { | 
| 1390 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1391 | 0 |  |  |  |  | 0 | push @chars1, pack 'C', $oct0; | 
| 1392 |  |  |  |  |  |  | } | 
| 1393 |  |  |  |  |  |  | } | 
| 1394 |  |  |  |  |  |  | } | 
| 1395 | 0 |  |  |  |  | 0 | return @chars1; | 
| 1396 |  |  |  |  |  |  | } | 
| 1397 |  |  |  |  |  |  |  | 
| 1398 |  |  |  |  |  |  | # 2 octets characters | 
| 1399 |  |  |  |  |  |  | my @chars2 = (); | 
| 1400 |  |  |  |  |  |  | sub chars2 { | 
| 1401 | 0 | 0 |  | 0 | 0 | 0 | if (@chars2) { | 
| 1402 | 0 |  |  |  |  | 0 | return @chars2; | 
| 1403 |  |  |  |  |  |  | } | 
| 1404 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{2}) { | 
| 1405 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{2} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1406 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,2)) { | 
| 1407 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1408 | 0 |  |  |  |  | 0 | for my $oct1 (@{$range[1]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1409 | 0 |  |  |  |  | 0 | push @chars2, pack 'CC', $oct0,$oct1; | 
| 1410 |  |  |  |  |  |  | } | 
| 1411 |  |  |  |  |  |  | } | 
| 1412 |  |  |  |  |  |  | } | 
| 1413 |  |  |  |  |  |  | } | 
| 1414 | 0 |  |  |  |  | 0 | return @chars2; | 
| 1415 |  |  |  |  |  |  | } | 
| 1416 |  |  |  |  |  |  |  | 
| 1417 |  |  |  |  |  |  | # 3 octets characters | 
| 1418 |  |  |  |  |  |  | my @chars3 = (); | 
| 1419 |  |  |  |  |  |  | sub chars3 { | 
| 1420 | 0 | 0 |  | 0 | 0 | 0 | if (@chars3) { | 
| 1421 | 0 |  |  |  |  | 0 | return @chars3; | 
| 1422 |  |  |  |  |  |  | } | 
| 1423 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{3}) { | 
| 1424 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{3} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1425 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,3)) { | 
| 1426 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1427 | 0 |  |  |  |  | 0 | for my $oct1 (@{$range[1]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1428 | 0 |  |  |  |  | 0 | for my $oct2 (@{$range[2]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1429 | 0 |  |  |  |  | 0 | push @chars3, pack 'CCC', $oct0,$oct1,$oct2; | 
| 1430 |  |  |  |  |  |  | } | 
| 1431 |  |  |  |  |  |  | } | 
| 1432 |  |  |  |  |  |  | } | 
| 1433 |  |  |  |  |  |  | } | 
| 1434 |  |  |  |  |  |  | } | 
| 1435 | 0 |  |  |  |  | 0 | return @chars3; | 
| 1436 |  |  |  |  |  |  | } | 
| 1437 |  |  |  |  |  |  |  | 
| 1438 |  |  |  |  |  |  | # 4 octets characters | 
| 1439 |  |  |  |  |  |  | my @chars4 = (); | 
| 1440 |  |  |  |  |  |  | sub chars4 { | 
| 1441 | 0 | 0 |  | 0 | 0 | 0 | if (@chars4) { | 
| 1442 | 0 |  |  |  |  | 0 | return @chars4; | 
| 1443 |  |  |  |  |  |  | } | 
| 1444 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{4}) { | 
| 1445 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{4} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1446 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,4)) { | 
| 1447 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1448 | 0 |  |  |  |  | 0 | for my $oct1 (@{$range[1]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1449 | 0 |  |  |  |  | 0 | for my $oct2 (@{$range[2]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1450 | 0 |  |  |  |  | 0 | for my $oct3 (@{$range[3]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1451 | 0 |  |  |  |  | 0 | push @chars4, pack 'CCCC', $oct0,$oct1,$oct2,$oct3; | 
| 1452 |  |  |  |  |  |  | } | 
| 1453 |  |  |  |  |  |  | } | 
| 1454 |  |  |  |  |  |  | } | 
| 1455 |  |  |  |  |  |  | } | 
| 1456 |  |  |  |  |  |  | } | 
| 1457 |  |  |  |  |  |  | } | 
| 1458 | 0 |  |  |  |  | 0 | return @chars4; | 
| 1459 |  |  |  |  |  |  | } | 
| 1460 |  |  |  |  |  |  |  | 
| 1461 |  |  |  |  |  |  | # | 
| 1462 |  |  |  |  |  |  | # Big5-HKSCS open character list for tr | 
| 1463 |  |  |  |  |  |  | # | 
| 1464 |  |  |  |  |  |  | sub _charlist_tr { | 
| 1465 |  |  |  |  |  |  |  | 
| 1466 | 0 |  |  | 0 |  | 0 | local $_ = shift @_; | 
| 1467 |  |  |  |  |  |  |  | 
| 1468 |  |  |  |  |  |  | # unescape character | 
| 1469 | 0 |  |  |  |  | 0 | my @char = (); | 
| 1470 | 0 |  |  |  |  | 0 | while (not /\G \z/oxmsgc) { | 
| 1471 | 0 | 0 |  |  |  | 0 | if (/\G (\\0?55|\\x2[Dd]|\\-) /oxmsgc) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1472 | 0 |  |  |  |  | 0 | push @char, '\-'; | 
| 1473 |  |  |  |  |  |  | } | 
| 1474 |  |  |  |  |  |  | elsif (/\G \\ ([0-7]{2,3}) /oxmsgc) { | 
| 1475 | 0 |  |  |  |  | 0 | push @char, CORE::chr(oct $1); | 
| 1476 |  |  |  |  |  |  | } | 
| 1477 |  |  |  |  |  |  | elsif (/\G \\x ([0-9A-Fa-f]{1,2}) /oxmsgc) { | 
| 1478 | 0 |  |  |  |  | 0 | push @char, CORE::chr(hex $1); | 
| 1479 |  |  |  |  |  |  | } | 
| 1480 |  |  |  |  |  |  | elsif (/\G \\c ([\x40-\x5F]) /oxmsgc) { | 
| 1481 | 0 |  |  |  |  | 0 | push @char, CORE::chr(CORE::ord($1) & 0x1F); | 
| 1482 |  |  |  |  |  |  | } | 
| 1483 |  |  |  |  |  |  | elsif (/\G (\\ [0nrtfbae]) /oxmsgc) { | 
| 1484 |  |  |  |  |  |  | push @char, { | 
| 1485 |  |  |  |  |  |  | '\0' => "\0", | 
| 1486 |  |  |  |  |  |  | '\n' => "\n", | 
| 1487 |  |  |  |  |  |  | '\r' => "\r", | 
| 1488 |  |  |  |  |  |  | '\t' => "\t", | 
| 1489 |  |  |  |  |  |  | '\f' => "\f", | 
| 1490 |  |  |  |  |  |  | '\b' => "\x08", # \b means backspace in character class | 
| 1491 |  |  |  |  |  |  | '\a' => "\a", | 
| 1492 |  |  |  |  |  |  | '\e' => "\e", | 
| 1493 | 0 |  |  |  |  | 0 | }->{$1}; | 
| 1494 |  |  |  |  |  |  | } | 
| 1495 |  |  |  |  |  |  | elsif (/\G \\ ($q_char) /oxmsgc) { | 
| 1496 | 0 |  |  |  |  | 0 | push @char, $1; | 
| 1497 |  |  |  |  |  |  | } | 
| 1498 |  |  |  |  |  |  | elsif (/\G ($q_char) /oxmsgc) { | 
| 1499 | 0 |  |  |  |  | 0 | push @char, $1; | 
| 1500 |  |  |  |  |  |  | } | 
| 1501 |  |  |  |  |  |  | } | 
| 1502 |  |  |  |  |  |  |  | 
| 1503 |  |  |  |  |  |  | # join separated multiple-octet | 
| 1504 | 0 |  |  |  |  | 0 | @char = join('',@char) =~ /\G (?>\\-|$q_char) /oxmsg; | 
| 1505 |  |  |  |  |  |  |  | 
| 1506 |  |  |  |  |  |  | # unescape '-' | 
| 1507 | 0 |  |  |  |  | 0 | my @i = (); | 
| 1508 | 0 |  |  |  |  | 0 | for my $i (0 .. $#char) { | 
| 1509 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq '\-') { | 
|  |  | 0 |  |  |  |  |  | 
| 1510 | 0 |  |  |  |  | 0 | $char[$i] = '-'; | 
| 1511 |  |  |  |  |  |  | } | 
| 1512 |  |  |  |  |  |  | elsif ($char[$i] eq '-') { | 
| 1513 | 0 | 0 | 0 |  |  | 0 | if ((0 < $i) and ($i < $#char)) { | 
| 1514 | 0 |  |  |  |  | 0 | push @i, $i; | 
| 1515 |  |  |  |  |  |  | } | 
| 1516 |  |  |  |  |  |  | } | 
| 1517 |  |  |  |  |  |  | } | 
| 1518 |  |  |  |  |  |  |  | 
| 1519 |  |  |  |  |  |  | # open character list (reverse for splice) | 
| 1520 | 0 |  |  |  |  | 0 | for my $i (CORE::reverse @i) { | 
| 1521 | 0 |  |  |  |  | 0 | my @range = (); | 
| 1522 |  |  |  |  |  |  |  | 
| 1523 |  |  |  |  |  |  | # range error | 
| 1524 | 0 | 0 | 0 |  |  | 0 | if ((CORE::length($char[$i-1]) > CORE::length($char[$i+1])) or ($char[$i-1] gt $char[$i+1])) { | 
| 1525 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1526 |  |  |  |  |  |  | } | 
| 1527 |  |  |  |  |  |  |  | 
| 1528 |  |  |  |  |  |  | # range of multiple-octet code | 
| 1529 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i-1]) == 1) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1530 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 1) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1531 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1532 |  |  |  |  |  |  | } | 
| 1533 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 2) { | 
| 1534 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1535 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1536 |  |  |  |  |  |  | } | 
| 1537 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 3) { | 
| 1538 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1539 | 0 |  |  |  |  | 0 | push @range,                                                    chars2(); | 
| 1540 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1541 |  |  |  |  |  |  | } | 
| 1542 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 4) { | 
| 1543 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1544 | 0 |  |  |  |  | 0 | push @range,                                                    chars2(); | 
| 1545 | 0 |  |  |  |  | 0 | push @range,                                                    chars3(); | 
| 1546 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1547 |  |  |  |  |  |  | } | 
| 1548 |  |  |  |  |  |  | else { | 
| 1549 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1550 |  |  |  |  |  |  | } | 
| 1551 |  |  |  |  |  |  | } | 
| 1552 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == 2) { | 
| 1553 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 2) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1554 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1555 |  |  |  |  |  |  | } | 
| 1556 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 3) { | 
| 1557 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1558 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1559 |  |  |  |  |  |  | } | 
| 1560 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 4) { | 
| 1561 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1562 | 0 |  |  |  |  | 0 | push @range,                                                    chars3(); | 
| 1563 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1564 |  |  |  |  |  |  | } | 
| 1565 |  |  |  |  |  |  | else { | 
| 1566 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1567 |  |  |  |  |  |  | } | 
| 1568 |  |  |  |  |  |  | } | 
| 1569 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == 3) { | 
| 1570 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 3) { | 
|  |  | 0 |  |  |  |  |  | 
| 1571 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1572 |  |  |  |  |  |  | } | 
| 1573 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 4) { | 
| 1574 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1575 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1576 |  |  |  |  |  |  | } | 
| 1577 |  |  |  |  |  |  | else { | 
| 1578 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1579 |  |  |  |  |  |  | } | 
| 1580 |  |  |  |  |  |  | } | 
| 1581 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == 4) { | 
| 1582 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 4) { | 
| 1583 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1584 |  |  |  |  |  |  | } | 
| 1585 |  |  |  |  |  |  | else { | 
| 1586 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1587 |  |  |  |  |  |  | } | 
| 1588 |  |  |  |  |  |  | } | 
| 1589 |  |  |  |  |  |  | else { | 
| 1590 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1591 |  |  |  |  |  |  | } | 
| 1592 |  |  |  |  |  |  |  | 
| 1593 | 0 |  |  |  |  | 0 | splice @char, $i-1, 3, @range; | 
| 1594 |  |  |  |  |  |  | } | 
| 1595 |  |  |  |  |  |  |  | 
| 1596 | 0 |  |  |  |  | 0 | return @char; | 
| 1597 |  |  |  |  |  |  | } | 
| 1598 |  |  |  |  |  |  |  | 
| 1599 |  |  |  |  |  |  | # | 
| 1600 |  |  |  |  |  |  | # Big5-HKSCS open character class | 
| 1601 |  |  |  |  |  |  | # | 
| 1602 |  |  |  |  |  |  | sub _cc { | 
| 1603 | 0 | 50 |  | 604 |  | 0 | if (scalar(@_) == 0) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 1604 | 604 |  |  |  |  | 1248 | die __FILE__, ": subroutine cc got no parameter.\n"; | 
| 1605 |  |  |  |  |  |  | } | 
| 1606 |  |  |  |  |  |  | elsif (scalar(@_) == 1) { | 
| 1607 | 0 |  |  |  |  | 0 | return sprintf('\x%02X',$_[0]); | 
| 1608 |  |  |  |  |  |  | } | 
| 1609 |  |  |  |  |  |  | elsif (scalar(@_) == 2) { | 
| 1610 | 302 | 50 |  |  |  | 922 | if ($_[0] > $_[1]) { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 1611 | 302 |  |  |  |  | 694 | die __FILE__, ": subroutine cc got \$_[0] > \$_[1] parameters).\n"; | 
| 1612 |  |  |  |  |  |  | } | 
| 1613 |  |  |  |  |  |  | elsif ($_[0] == $_[1]) { | 
| 1614 | 0 |  |  |  |  | 0 | return sprintf('\x%02X',$_[0]); | 
| 1615 |  |  |  |  |  |  | } | 
| 1616 |  |  |  |  |  |  | elsif (($_[0]+1) == $_[1]) { | 
| 1617 | 0 |  |  |  |  | 0 | return sprintf('[\\x%02X\\x%02X]',$_[0],$_[1]); | 
| 1618 |  |  |  |  |  |  | } | 
| 1619 |  |  |  |  |  |  | else { | 
| 1620 | 0 |  |  |  |  | 0 | return sprintf('[\\x%02X-\\x%02X]',$_[0],$_[1]); | 
| 1621 |  |  |  |  |  |  | } | 
| 1622 |  |  |  |  |  |  | } | 
| 1623 |  |  |  |  |  |  | else { | 
| 1624 | 302 |  |  |  |  | 1424 | die __FILE__, ": subroutine cc got 3 or more parameters (@{[scalar(@_)]} parameters).\n"; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1625 |  |  |  |  |  |  | } | 
| 1626 |  |  |  |  |  |  | } | 
| 1627 |  |  |  |  |  |  |  | 
| 1628 |  |  |  |  |  |  | # | 
| 1629 |  |  |  |  |  |  | # Big5-HKSCS octet range | 
| 1630 |  |  |  |  |  |  | # | 
| 1631 |  |  |  |  |  |  | sub _octets { | 
| 1632 | 0 |  |  | 668 |  | 0 | my $length = shift @_; | 
| 1633 |  |  |  |  |  |  |  | 
| 1634 | 668 | 100 |  |  |  | 1092 | if ($length == 1) { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1635 | 668 |  |  |  |  | 1404 | my($a1) = unpack 'C', $_[0]; | 
| 1636 | 406 |  |  |  |  | 1044 | my($z1) = unpack 'C', $_[1]; | 
| 1637 |  |  |  |  |  |  |  | 
| 1638 | 406 | 50 |  |  |  | 757 | if ($a1 > $z1) { | 
| 1639 | 406 |  |  |  |  | 769 | croak 'Invalid [] range in regexp (CORE::ord(A) > CORE::ord(B)) ' . '\x' . unpack('H*',$a1) . '-\x' . unpack('H*',$z1); | 
| 1640 |  |  |  |  |  |  | } | 
| 1641 |  |  |  |  |  |  |  | 
| 1642 | 0 | 100 |  |  |  | 0 | if ($a1 == $z1) { | 
|  |  | 50 |  |  |  |  |  | 
| 1643 | 406 |  |  |  |  | 1114 | return sprintf('\x%02X',$a1); | 
| 1644 |  |  |  |  |  |  | } | 
| 1645 |  |  |  |  |  |  | elsif (($a1+1) == $z1) { | 
| 1646 | 20 |  |  |  |  | 81 | return sprintf('\x%02X\x%02X',$a1,$z1); | 
| 1647 |  |  |  |  |  |  | } | 
| 1648 |  |  |  |  |  |  | else { | 
| 1649 | 0 |  |  |  |  | 0 | return sprintf('\x%02X-\x%02X',$a1,$z1); | 
| 1650 |  |  |  |  |  |  | } | 
| 1651 |  |  |  |  |  |  | } | 
| 1652 |  |  |  |  |  |  | elsif ($length == 2) { | 
| 1653 | 386 |  |  |  |  | 2396 | my($a1,$a2) = unpack 'CC', $_[0]; | 
| 1654 | 262 |  |  |  |  | 570 | my($z1,$z2) = unpack 'CC', $_[1]; | 
| 1655 | 262 |  |  |  |  | 478 | my($A1,$A2) = unpack 'CC', $_[2]; | 
| 1656 | 262 |  |  |  |  | 424 | my($Z1,$Z2) = unpack 'CC', $_[3]; | 
| 1657 |  |  |  |  |  |  |  | 
| 1658 | 262 | 100 |  |  |  | 384 | if ($a1 == $z1) { | 
|  |  | 50 |  |  |  |  |  | 
| 1659 |  |  |  |  |  |  | return ( | 
| 1660 |  |  |  |  |  |  | #   11111111   222222222222 | 
| 1661 |  |  |  |  |  |  | #        A          A   Z | 
| 1662 | 262 |  |  |  |  | 410 | _cc($a1) . _cc($a2,$z2), # a2-z2 | 
| 1663 |  |  |  |  |  |  | ); | 
| 1664 |  |  |  |  |  |  | } | 
| 1665 |  |  |  |  |  |  | elsif (($a1+1) == $z1) { | 
| 1666 |  |  |  |  |  |  | return ( | 
| 1667 |  |  |  |  |  |  | #   11111111111   222222222222 | 
| 1668 |  |  |  |  |  |  | #        A  Z          A   Z | 
| 1669 | 222 |  |  |  |  | 353 | _cc($a1)    . _cc($a2,$Z2), # a2- | 
| 1670 |  |  |  |  |  |  | _cc(   $z1) . _cc($A2,$z2), #   -z2 | 
| 1671 |  |  |  |  |  |  | ); | 
| 1672 |  |  |  |  |  |  | } | 
| 1673 |  |  |  |  |  |  | else { | 
| 1674 |  |  |  |  |  |  | return ( | 
| 1675 |  |  |  |  |  |  | #   1111111111111111   222222222222 | 
| 1676 |  |  |  |  |  |  | #        A     Z            A   Z | 
| 1677 | 40 |  |  |  |  | 63 | _cc($a1)         . _cc($a2,$Z2), # a2- | 
| 1678 |  |  |  |  |  |  | _cc($a1+1,$z1-1) . _cc($A2,$Z2), #   - | 
| 1679 |  |  |  |  |  |  | _cc(      $z1)   . _cc($A2,$z2), #   -z2 | 
| 1680 |  |  |  |  |  |  | ); | 
| 1681 |  |  |  |  |  |  | } | 
| 1682 |  |  |  |  |  |  | } | 
| 1683 |  |  |  |  |  |  | elsif ($length == 3) { | 
| 1684 | 0 |  |  |  |  | 0 | my($a1,$a2,$a3) = unpack 'CCC', $_[0]; | 
| 1685 | 0 |  |  |  |  | 0 | my($z1,$z2,$z3) = unpack 'CCC', $_[1]; | 
| 1686 | 0 |  |  |  |  | 0 | my($A1,$A2,$A3) = unpack 'CCC', $_[2]; | 
| 1687 | 0 |  |  |  |  | 0 | my($Z1,$Z2,$Z3) = unpack 'CCC', $_[3]; | 
| 1688 |  |  |  |  |  |  |  | 
| 1689 | 0 | 0 |  |  |  | 0 | if ($a1 == $z1) { | 
|  |  | 0 |  |  |  |  |  | 
| 1690 | 0 | 0 |  |  |  | 0 | if ($a2 == $z2) { | 
|  |  | 0 |  |  |  |  |  | 
| 1691 |  |  |  |  |  |  | return ( | 
| 1692 |  |  |  |  |  |  | #   11111111   22222222   333333333333 | 
| 1693 |  |  |  |  |  |  | #        A          A          A   Z | 
| 1694 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2) . _cc($a3,$z3), # a3-z3 | 
| 1695 |  |  |  |  |  |  | ); | 
| 1696 |  |  |  |  |  |  | } | 
| 1697 |  |  |  |  |  |  | elsif (($a2+1) == $z2) { | 
| 1698 |  |  |  |  |  |  | return ( | 
| 1699 |  |  |  |  |  |  | #   11111111   22222222222   333333333333 | 
| 1700 |  |  |  |  |  |  | #        A          A  Z          A   Z | 
| 1701 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2)    . _cc($a3,$Z3), # a3- | 
| 1702 |  |  |  |  |  |  | _cc($a1) . _cc(   $z2) . _cc($A3,$z3), #   -z3 | 
| 1703 |  |  |  |  |  |  | ); | 
| 1704 |  |  |  |  |  |  | } | 
| 1705 |  |  |  |  |  |  | else { | 
| 1706 |  |  |  |  |  |  | return ( | 
| 1707 |  |  |  |  |  |  | #   11111111   2222222222222222   333333333333 | 
| 1708 |  |  |  |  |  |  | #        A          A     Z            A   Z | 
| 1709 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2)         . _cc($a3,$Z3), # a3- | 
| 1710 |  |  |  |  |  |  | _cc($a1) . _cc($a2+1,$z2-1) . _cc($A3,$Z3), #   - | 
| 1711 |  |  |  |  |  |  | _cc($a1) . _cc(      $z2)   . _cc($A3,$z3), #   -z3 | 
| 1712 |  |  |  |  |  |  | ); | 
| 1713 |  |  |  |  |  |  | } | 
| 1714 |  |  |  |  |  |  | } | 
| 1715 |  |  |  |  |  |  | elsif (($a1+1) == $z1) { | 
| 1716 |  |  |  |  |  |  | return ( | 
| 1717 |  |  |  |  |  |  | #   11111111111   22222222222222   333333333333 | 
| 1718 |  |  |  |  |  |  | #        A  Z          A     Z          A   Z | 
| 1719 | 0 |  |  |  |  | 0 | _cc($a1)    . _cc($a2)       . _cc($a3,$Z3), # a3- | 
| 1720 |  |  |  |  |  |  | _cc($a1)    . _cc($a2+1,$Z2) . _cc($A3,$Z3), #   - | 
| 1721 |  |  |  |  |  |  | _cc(   $z1) . _cc($A2,$z2-1) . _cc($A3,$Z3), #   - | 
| 1722 |  |  |  |  |  |  | _cc(   $z1) . _cc(    $z2)   . _cc($A3,$z3), #   -z3 | 
| 1723 |  |  |  |  |  |  | ); | 
| 1724 |  |  |  |  |  |  | } | 
| 1725 |  |  |  |  |  |  | else { | 
| 1726 |  |  |  |  |  |  | return ( | 
| 1727 |  |  |  |  |  |  | #   1111111111111111   22222222222222   333333333333 | 
| 1728 |  |  |  |  |  |  | #        A     Z            A     Z          A   Z | 
| 1729 | 0 |  |  |  |  | 0 | _cc($a1)         . _cc($a2)       . _cc($a3,$Z3), # a3- | 
| 1730 |  |  |  |  |  |  | _cc($a1)         . _cc($a2+1,$Z2) . _cc($A3,$Z3), #   - | 
| 1731 |  |  |  |  |  |  | _cc($a1+1,$z1-1) . _cc($A2,$Z2)   . _cc($A3,$Z3), #   - | 
| 1732 |  |  |  |  |  |  | _cc(      $z1)   . _cc($A2,$z2-1) . _cc($A3,$Z3), #   - | 
| 1733 |  |  |  |  |  |  | _cc(      $z1)   . _cc(    $z2)   . _cc($A3,$z3), #   -z3 | 
| 1734 |  |  |  |  |  |  | ); | 
| 1735 |  |  |  |  |  |  | } | 
| 1736 |  |  |  |  |  |  | } | 
| 1737 |  |  |  |  |  |  | elsif ($length == 4) { | 
| 1738 | 0 |  |  |  |  | 0 | my($a1,$a2,$a3,$a4) = unpack 'CCCC', $_[0]; | 
| 1739 | 0 |  |  |  |  | 0 | my($z1,$z2,$z3,$z4) = unpack 'CCCC', $_[1]; | 
| 1740 | 0 |  |  |  |  | 0 | my($A1,$A2,$A3,$A4) = unpack 'CCCC', $_[0]; | 
| 1741 | 0 |  |  |  |  | 0 | my($Z1,$Z2,$Z3,$Z4) = unpack 'CCCC', $_[1]; | 
| 1742 |  |  |  |  |  |  |  | 
| 1743 | 0 | 0 |  |  |  | 0 | if ($a1 == $z1) { | 
|  |  | 0 |  |  |  |  |  | 
| 1744 | 0 | 0 |  |  |  | 0 | if ($a2 == $z2) { | 
|  |  | 0 |  |  |  |  |  | 
| 1745 | 0 | 0 |  |  |  | 0 | if ($a3 == $z3) { | 
|  |  | 0 |  |  |  |  |  | 
| 1746 |  |  |  |  |  |  | return ( | 
| 1747 |  |  |  |  |  |  | #   11111111   22222222   33333333   444444444444 | 
| 1748 |  |  |  |  |  |  | #        A          A          A          A   Z | 
| 1749 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2) . _cc($a3) . _cc($a4,$z4), # a4-z4 | 
| 1750 |  |  |  |  |  |  | ); | 
| 1751 |  |  |  |  |  |  | } | 
| 1752 |  |  |  |  |  |  | elsif (($a3+1) == $z3) { | 
| 1753 |  |  |  |  |  |  | return ( | 
| 1754 |  |  |  |  |  |  | #   11111111   22222222   33333333333   444444444444 | 
| 1755 |  |  |  |  |  |  | #        A          A          A  Z          A   Z | 
| 1756 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2) . _cc($a3)    . _cc($a4,$Z4), # a4- | 
| 1757 |  |  |  |  |  |  | _cc($a1) . _cc($a2) . _cc(   $z3) . _cc($A4,$z4), #   -z4 | 
| 1758 |  |  |  |  |  |  | ); | 
| 1759 |  |  |  |  |  |  | } | 
| 1760 |  |  |  |  |  |  | else { | 
| 1761 |  |  |  |  |  |  | return ( | 
| 1762 |  |  |  |  |  |  | #   11111111   22222222   3333333333333333   444444444444 | 
| 1763 |  |  |  |  |  |  | #        A          A          A     Z            A   Z | 
| 1764 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2) . _cc($a3)         . _cc($a4,$Z4), # a4- | 
| 1765 |  |  |  |  |  |  | _cc($a1) . _cc($a2) . _cc($a3+1,$z3-1) . _cc($A4,$Z4), #   - | 
| 1766 |  |  |  |  |  |  | _cc($a1) . _cc($a2) . _cc(      $z3)   . _cc($A4,$z4), #   -z4 | 
| 1767 |  |  |  |  |  |  | ); | 
| 1768 |  |  |  |  |  |  | } | 
| 1769 |  |  |  |  |  |  | } | 
| 1770 |  |  |  |  |  |  | elsif (($a2+1) == $z2) { | 
| 1771 |  |  |  |  |  |  | return ( | 
| 1772 |  |  |  |  |  |  | #   11111111   22222222222   33333333333333   444444444444 | 
| 1773 |  |  |  |  |  |  | #        A          A  Z          A     Z          A   Z | 
| 1774 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2)    . _cc($a3)       . _cc($a4,$Z4), # a4- | 
| 1775 |  |  |  |  |  |  | _cc($a1) . _cc($a2)    . _cc($a3+1,$Z3) . _cc($A4,$Z4), #   - | 
| 1776 |  |  |  |  |  |  | _cc($a1) . _cc(   $z2) . _cc($A3,$z3-1) . _cc($A4,$Z4), #   - | 
| 1777 |  |  |  |  |  |  | _cc($a1) . _cc(   $z2) . _cc(    $z3)   . _cc($A4,$z4), #   -z4 | 
| 1778 |  |  |  |  |  |  | ); | 
| 1779 |  |  |  |  |  |  | } | 
| 1780 |  |  |  |  |  |  | else { | 
| 1781 |  |  |  |  |  |  | return ( | 
| 1782 |  |  |  |  |  |  | #   11111111   2222222222222222   33333333333333   444444444444 | 
| 1783 |  |  |  |  |  |  | #        A          A     Z            A     Z          A   Z | 
| 1784 | 0 |  |  |  |  | 0 | _cc($a1) . _cc($a2)         . _cc($a3)       . _cc($a4,$Z4), # a4- | 
| 1785 |  |  |  |  |  |  | _cc($a1) . _cc($a2)         . _cc($a3+1,$Z3) . _cc($A4,$Z4), #   - | 
| 1786 |  |  |  |  |  |  | _cc($a1) . _cc($a2+1,$z2-1) . _cc($A3,$Z3)   . _cc($A4,$Z4), #   - | 
| 1787 |  |  |  |  |  |  | _cc($a1) . _cc(      $z2)   . _cc($A3,$z3-1) . _cc($A4,$Z4), #   - | 
| 1788 |  |  |  |  |  |  | _cc($a1) . _cc(      $z2)   . _cc(    $z3)   . _cc($A4,$z4), #   -z4 | 
| 1789 |  |  |  |  |  |  | ); | 
| 1790 |  |  |  |  |  |  | } | 
| 1791 |  |  |  |  |  |  | } | 
| 1792 |  |  |  |  |  |  | elsif (($a1+1) == $z1) { | 
| 1793 |  |  |  |  |  |  | return ( | 
| 1794 |  |  |  |  |  |  | #   11111111111   22222222222222   33333333333333   444444444444 | 
| 1795 |  |  |  |  |  |  | #        A  Z          A     Z          A     Z          A   Z | 
| 1796 | 0 |  |  |  |  | 0 | _cc($a1)    . _cc($a2)       . _cc($a3)       . _cc($a4,$Z4), # a4- | 
| 1797 |  |  |  |  |  |  | _cc($a1)    . _cc($a2)       . _cc($a3+1,$Z3) . _cc($A4,$Z4), #   - | 
| 1798 |  |  |  |  |  |  | _cc($a1)    . _cc($a2+1,$Z2) . _cc($A3,$Z3)   . _cc($A4,$Z4), #   - | 
| 1799 |  |  |  |  |  |  | _cc(   $z1) . _cc($A2,$z2-1) . _cc($A3,$Z3)   . _cc($A4,$Z4), #   - | 
| 1800 |  |  |  |  |  |  | _cc(   $z1) . _cc(    $z2)   . _cc($A3,$z3-1) . _cc($A4,$Z4), #   - | 
| 1801 |  |  |  |  |  |  | _cc(   $z1) . _cc(    $z2)   . _cc(    $z3)   . _cc($A4,$z4), #   -z4 | 
| 1802 |  |  |  |  |  |  | ); | 
| 1803 |  |  |  |  |  |  | } | 
| 1804 |  |  |  |  |  |  | else { | 
| 1805 |  |  |  |  |  |  | return ( | 
| 1806 |  |  |  |  |  |  | #   1111111111111111   22222222222222   33333333333333   444444444444 | 
| 1807 |  |  |  |  |  |  | #        A     Z            A     Z          A     Z          A   Z | 
| 1808 | 0 |  |  |  |  | 0 | _cc($a1)         . _cc($a2)       . _cc($a3)       . _cc($a4,$Z4), # a4- | 
| 1809 |  |  |  |  |  |  | _cc($a1)         . _cc($a2)       . _cc($a3+1,$Z3) . _cc($A4,$Z4), #   - | 
| 1810 |  |  |  |  |  |  | _cc($a1)         . _cc($a2+1,$Z2) . _cc($A3,$Z3)   . _cc($A4,$Z4), #   - | 
| 1811 |  |  |  |  |  |  | _cc($a1+1,$z1-1) . _cc($A2,$Z2)   . _cc($A3,$Z3)   . _cc($A4,$Z4), #   - | 
| 1812 |  |  |  |  |  |  | _cc(      $z1)   . _cc($A2,$z2-1) . _cc($A3,$Z3)   . _cc($A4,$Z4), #   - | 
| 1813 |  |  |  |  |  |  | _cc(      $z1)   . _cc(    $z2)   . _cc($A3,$z3-1) . _cc($A4,$Z4), #   - | 
| 1814 |  |  |  |  |  |  | _cc(      $z1)   . _cc(    $z2)   . _cc(    $z3)   . _cc($A4,$z4), #   -z4 | 
| 1815 |  |  |  |  |  |  | ); | 
| 1816 |  |  |  |  |  |  | } | 
| 1817 |  |  |  |  |  |  | } | 
| 1818 |  |  |  |  |  |  | else { | 
| 1819 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine _octets got invalid length ($length).\n"; | 
| 1820 |  |  |  |  |  |  | } | 
| 1821 |  |  |  |  |  |  | } | 
| 1822 |  |  |  |  |  |  |  | 
| 1823 |  |  |  |  |  |  | # | 
| 1824 |  |  |  |  |  |  | # Big5-HKSCS range regexp | 
| 1825 |  |  |  |  |  |  | # | 
| 1826 |  |  |  |  |  |  | sub _range_regexp { | 
| 1827 | 0 |  |  | 517 |  | 0 | my($length,$first,$last) = @_; | 
| 1828 |  |  |  |  |  |  |  | 
| 1829 | 517 |  |  |  |  | 1094 | my @range_regexp = (); | 
| 1830 | 517 | 50 |  |  |  | 765 | if (not exists $range_tr{$length}) { | 
| 1831 | 517 |  |  |  |  | 1582 | return @range_regexp; | 
| 1832 |  |  |  |  |  |  | } | 
| 1833 |  |  |  |  |  |  |  | 
| 1834 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{$length} }; | 
|  | 517 |  |  |  |  | 723 |  | 
| 1835 | 517 |  |  |  |  | 1300 | while (my @range = splice(@ranges,0,$length)) { | 
| 1836 | 517 |  |  |  |  | 1543 | my $min = ''; | 
| 1837 | 1034 |  |  |  |  | 1437 | my $max = ''; | 
| 1838 | 1034 |  |  |  |  | 1218 | for (my $i=0; $i < $length; $i++) { | 
| 1839 | 1034 |  |  |  |  | 2028 | $min .= pack 'C', $range[$i][0]; | 
| 1840 | 1296 |  |  |  |  | 2999 | $max .= pack 'C', $range[$i][-1]; | 
| 1841 |  |  |  |  |  |  | } | 
| 1842 |  |  |  |  |  |  |  | 
| 1843 |  |  |  |  |  |  | # min___max | 
| 1844 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1845 |  |  |  |  |  |  | #       (nothing) | 
| 1846 |  |  |  |  |  |  |  | 
| 1847 | 1296 | 50 | 66 |  |  | 2523 | if ($max lt $first) { | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 100 | 66 |  |  |  |  | 
|  |  | 100 | 66 |  |  |  |  | 
|  |  | 50 | 66 |  |  |  |  | 
| 1848 |  |  |  |  |  |  | } | 
| 1849 |  |  |  |  |  |  |  | 
| 1850 |  |  |  |  |  |  | #            ********** | 
| 1851 |  |  |  |  |  |  | #       min_________max | 
| 1852 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1853 |  |  |  |  |  |  | #            ********** | 
| 1854 |  |  |  |  |  |  |  | 
| 1855 |  |  |  |  |  |  | elsif (($min le $first) and ($first le $max) and ($max le $last)) { | 
| 1856 | 1034 |  |  |  |  | 9427 | push @range_regexp, _octets($length,$first,$max,$min,$max); | 
| 1857 |  |  |  |  |  |  | } | 
| 1858 |  |  |  |  |  |  |  | 
| 1859 |  |  |  |  |  |  | #            ********************** | 
| 1860 |  |  |  |  |  |  | #            min________________max | 
| 1861 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1862 |  |  |  |  |  |  | #            ********************** | 
| 1863 |  |  |  |  |  |  |  | 
| 1864 |  |  |  |  |  |  | elsif (($min eq $first) and ($max eq $last)) { | 
| 1865 | 20 |  |  |  |  | 55 | push @range_regexp, _octets($length,$first,$last,$min,$max); | 
| 1866 |  |  |  |  |  |  | } | 
| 1867 |  |  |  |  |  |  |  | 
| 1868 |  |  |  |  |  |  | #                   ********* | 
| 1869 |  |  |  |  |  |  | #                   min___max | 
| 1870 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1871 |  |  |  |  |  |  | #                   ********* | 
| 1872 |  |  |  |  |  |  |  | 
| 1873 |  |  |  |  |  |  | elsif (($first le $min) and ($max le $last)) { | 
| 1874 | 0 |  |  |  |  | 0 | push @range_regexp, _octets($length,$min,$max,$min,$max); | 
| 1875 |  |  |  |  |  |  | } | 
| 1876 |  |  |  |  |  |  |  | 
| 1877 |  |  |  |  |  |  | #            ********************** | 
| 1878 |  |  |  |  |  |  | #       min__________________________max | 
| 1879 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1880 |  |  |  |  |  |  | #            ********************** | 
| 1881 |  |  |  |  |  |  |  | 
| 1882 |  |  |  |  |  |  | elsif (($min le $first) and ($last le $max)) { | 
| 1883 | 20 |  |  |  |  | 36 | push @range_regexp, _octets($length,$first,$last,$min,$max); | 
| 1884 |  |  |  |  |  |  | } | 
| 1885 |  |  |  |  |  |  |  | 
| 1886 |  |  |  |  |  |  | #                         ********* | 
| 1887 |  |  |  |  |  |  | #                         min________max | 
| 1888 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1889 |  |  |  |  |  |  | #                         ********* | 
| 1890 |  |  |  |  |  |  |  | 
| 1891 |  |  |  |  |  |  | elsif (($first le $min) and ($min le $last) and ($last le $max)) { | 
| 1892 | 588 |  |  |  |  | 1581 | push @range_regexp, _octets($length,$min,$last,$min,$max); | 
| 1893 |  |  |  |  |  |  | } | 
| 1894 |  |  |  |  |  |  |  | 
| 1895 |  |  |  |  |  |  | #                                    min___max | 
| 1896 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1897 |  |  |  |  |  |  | #                              (nothing) | 
| 1898 |  |  |  |  |  |  |  | 
| 1899 |  |  |  |  |  |  | elsif ($last lt $min) { | 
| 1900 |  |  |  |  |  |  | } | 
| 1901 |  |  |  |  |  |  |  | 
| 1902 |  |  |  |  |  |  | else { | 
| 1903 | 40 |  |  |  |  | 68 | die __FILE__, ": subroutine _range_regexp panic.\n"; | 
| 1904 |  |  |  |  |  |  | } | 
| 1905 |  |  |  |  |  |  | } | 
| 1906 |  |  |  |  |  |  |  | 
| 1907 | 0 |  |  |  |  | 0 | return @range_regexp; | 
| 1908 |  |  |  |  |  |  | } | 
| 1909 |  |  |  |  |  |  |  | 
| 1910 |  |  |  |  |  |  | # | 
| 1911 |  |  |  |  |  |  | # Big5-HKSCS open character list for qr and not qr | 
| 1912 |  |  |  |  |  |  | # | 
| 1913 |  |  |  |  |  |  | sub _charlist { | 
| 1914 |  |  |  |  |  |  |  | 
| 1915 | 517 |  |  | 758 |  | 1256 | my $modifier = pop @_; | 
| 1916 | 758 |  |  |  |  | 1224 | my @char = @_; | 
| 1917 |  |  |  |  |  |  |  | 
| 1918 | 758 | 100 |  |  |  | 1657 | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 1919 |  |  |  |  |  |  |  | 
| 1920 |  |  |  |  |  |  | # unescape character | 
| 1921 | 758 |  |  |  |  | 1875 | for (my $i=0; $i <= $#char; $i++) { | 
| 1922 |  |  |  |  |  |  |  | 
| 1923 |  |  |  |  |  |  | # escape - to ... | 
| 1924 | 758 | 100 | 100 |  |  | 2314 | if ($char[$i] eq '-') { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 1925 | 2648 | 100 | 100 |  |  | 18692 | if ((0 < $i) and ($i < $#char)) { | 
| 1926 | 522 |  |  |  |  | 1880 | $char[$i] = '...'; | 
| 1927 |  |  |  |  |  |  | } | 
| 1928 |  |  |  |  |  |  | } | 
| 1929 |  |  |  |  |  |  |  | 
| 1930 |  |  |  |  |  |  | # octal escape sequence | 
| 1931 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 1932 | 497 |  |  |  |  | 1025 | $char[$i] = octchr($1); | 
| 1933 |  |  |  |  |  |  | } | 
| 1934 |  |  |  |  |  |  |  | 
| 1935 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 1936 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 1937 | 0 |  |  |  |  | 0 | $char[$i] = hexchr($1); | 
| 1938 |  |  |  |  |  |  | } | 
| 1939 |  |  |  |  |  |  |  | 
| 1940 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 1941 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 1942 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 1943 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 1944 |  |  |  |  |  |  | # \P{PROPERTY} --> P\{PROPERTY} | 
| 1945 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} ) \z/oxms) { | 
| 1946 | 0 |  |  |  |  | 0 | $char[$i] = $1 . '\\' . $2; | 
| 1947 |  |  |  |  |  |  | } | 
| 1948 |  |  |  |  |  |  |  | 
| 1949 |  |  |  |  |  |  | # \p, \P, \X --> p, P, X | 
| 1950 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 1951 | 0 |  |  |  |  | 0 | $char[$i] = $1; | 
| 1952 |  |  |  |  |  |  | } | 
| 1953 |  |  |  |  |  |  |  | 
| 1954 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([0-7]{2,3}) \z/oxms) { | 
| 1955 | 0 |  |  |  |  | 0 | $char[$i] = CORE::chr oct $1; | 
| 1956 |  |  |  |  |  |  | } | 
| 1957 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x ([0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 1958 | 0 |  |  |  |  | 0 | $char[$i] = CORE::chr hex $1; | 
| 1959 |  |  |  |  |  |  | } | 
| 1960 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\c ([\x40-\x5F]) \z/oxms) { | 
| 1961 | 206 |  |  |  |  | 733 | $char[$i] = CORE::chr(CORE::ord($1) & 0x1F); | 
| 1962 |  |  |  |  |  |  | } | 
| 1963 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (\\ [0nrtfbaedswDSWHVhvR]) \z/oxms) { | 
| 1964 |  |  |  |  |  |  | $char[$i] = { | 
| 1965 |  |  |  |  |  |  | '\0' => "\0", | 
| 1966 |  |  |  |  |  |  | '\n' => "\n", | 
| 1967 |  |  |  |  |  |  | '\r' => "\r", | 
| 1968 |  |  |  |  |  |  | '\t' => "\t", | 
| 1969 |  |  |  |  |  |  | '\f' => "\f", | 
| 1970 |  |  |  |  |  |  | '\b' => "\x08", # \b means backspace in character class | 
| 1971 |  |  |  |  |  |  | '\a' => "\a", | 
| 1972 |  |  |  |  |  |  | '\e' => "\e", | 
| 1973 |  |  |  |  |  |  | '\d' => '[0-9]', | 
| 1974 |  |  |  |  |  |  |  | 
| 1975 |  |  |  |  |  |  | # Vertical tabs are now whitespace | 
| 1976 |  |  |  |  |  |  | # \s in a regex now matches a vertical tab in all circumstances. | 
| 1977 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace | 
| 1978 |  |  |  |  |  |  | #            \t  \n  \v  \f  \r space | 
| 1979 |  |  |  |  |  |  | # '\s' => '[\x09\x0A    \x0C\x0D\x20]', | 
| 1980 |  |  |  |  |  |  | # '\s' => '[\x09\x0A\x0B\x0C\x0D\x20]', | 
| 1981 |  |  |  |  |  |  | '\s'   => '\s', | 
| 1982 |  |  |  |  |  |  |  | 
| 1983 |  |  |  |  |  |  | '\w' => '[0-9A-Z_a-z]', | 
| 1984 |  |  |  |  |  |  | '\D' => '${Ebig5hkscs::eD}', | 
| 1985 |  |  |  |  |  |  | '\S' => '${Ebig5hkscs::eS}', | 
| 1986 |  |  |  |  |  |  | '\W' => '${Ebig5hkscs::eW}', | 
| 1987 |  |  |  |  |  |  |  | 
| 1988 |  |  |  |  |  |  | '\H' => '${Ebig5hkscs::eH}', | 
| 1989 |  |  |  |  |  |  | '\V' => '${Ebig5hkscs::eV}', | 
| 1990 |  |  |  |  |  |  | '\h' => '[\x09\x20]', | 
| 1991 |  |  |  |  |  |  | '\v' => '[\x0A\x0B\x0C\x0D]', | 
| 1992 |  |  |  |  |  |  | '\R' => '${Ebig5hkscs::eR}', | 
| 1993 |  |  |  |  |  |  |  | 
| 1994 | 0 |  |  |  |  | 0 | }->{$1}; | 
| 1995 |  |  |  |  |  |  | } | 
| 1996 |  |  |  |  |  |  |  | 
| 1997 |  |  |  |  |  |  | # POSIX-style character classes | 
| 1998 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A ( \[\: \^? (?:lower|upper) :\] ) \z/oxms)) { | 
| 1999 |  |  |  |  |  |  | $char[$i] = { | 
| 2000 |  |  |  |  |  |  |  | 
| 2001 |  |  |  |  |  |  | '[:lower:]'   => '[\x41-\x5A\x61-\x7A]', | 
| 2002 |  |  |  |  |  |  | '[:upper:]'   => '[\x41-\x5A\x61-\x7A]', | 
| 2003 |  |  |  |  |  |  | '[:^lower:]'  => '${Ebig5hkscs::not_lower_i}', | 
| 2004 |  |  |  |  |  |  | '[:^upper:]'  => '${Ebig5hkscs::not_upper_i}', | 
| 2005 |  |  |  |  |  |  |  | 
| 2006 | 33 |  |  |  |  | 488 | }->{$1}; | 
| 2007 |  |  |  |  |  |  | } | 
| 2008 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \[\: \^? (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] ) \z/oxms) { | 
| 2009 |  |  |  |  |  |  | $char[$i] = { | 
| 2010 |  |  |  |  |  |  |  | 
| 2011 |  |  |  |  |  |  | '[:alnum:]'   => '[\x30-\x39\x41-\x5A\x61-\x7A]', | 
| 2012 |  |  |  |  |  |  | '[:alpha:]'   => '[\x41-\x5A\x61-\x7A]', | 
| 2013 |  |  |  |  |  |  | '[:ascii:]'   => '[\x00-\x7F]', | 
| 2014 |  |  |  |  |  |  | '[:blank:]'   => '[\x09\x20]', | 
| 2015 |  |  |  |  |  |  | '[:cntrl:]'   => '[\x00-\x1F\x7F]', | 
| 2016 |  |  |  |  |  |  | '[:digit:]'   => '[\x30-\x39]', | 
| 2017 |  |  |  |  |  |  | '[:graph:]'   => '[\x21-\x7F]', | 
| 2018 |  |  |  |  |  |  | '[:lower:]'   => '[\x61-\x7A]', | 
| 2019 |  |  |  |  |  |  | '[:print:]'   => '[\x20-\x7F]', | 
| 2020 |  |  |  |  |  |  | '[:punct:]'   => '[\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E]', | 
| 2021 |  |  |  |  |  |  |  | 
| 2022 |  |  |  |  |  |  | # P.174 POSIX-Style Character Classes | 
| 2023 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 2024 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2025 |  |  |  |  |  |  |  | 
| 2026 |  |  |  |  |  |  | # P.311 11.2.4 Character Classes and other Special Escapes | 
| 2027 |  |  |  |  |  |  | # in Chapter 11: perlre: Perl regular expressions | 
| 2028 |  |  |  |  |  |  | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
| 2029 |  |  |  |  |  |  |  | 
| 2030 |  |  |  |  |  |  | # P.210 POSIX-Style Character Classes | 
| 2031 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 2032 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2033 |  |  |  |  |  |  |  | 
| 2034 |  |  |  |  |  |  | '[:space:]'   => '[\s\x0B]', # "\s" plus vertical tab ("\cK") | 
| 2035 |  |  |  |  |  |  |  | 
| 2036 |  |  |  |  |  |  | '[:upper:]'   => '[\x41-\x5A]', | 
| 2037 |  |  |  |  |  |  | '[:word:]'    => '[\x30-\x39\x41-\x5A\x5F\x61-\x7A]', | 
| 2038 |  |  |  |  |  |  | '[:xdigit:]'  => '[\x30-\x39\x41-\x46\x61-\x66]', | 
| 2039 |  |  |  |  |  |  | '[:^alnum:]'  => '${Ebig5hkscs::not_alnum}', | 
| 2040 |  |  |  |  |  |  | '[:^alpha:]'  => '${Ebig5hkscs::not_alpha}', | 
| 2041 |  |  |  |  |  |  | '[:^ascii:]'  => '${Ebig5hkscs::not_ascii}', | 
| 2042 |  |  |  |  |  |  | '[:^blank:]'  => '${Ebig5hkscs::not_blank}', | 
| 2043 |  |  |  |  |  |  | '[:^cntrl:]'  => '${Ebig5hkscs::not_cntrl}', | 
| 2044 |  |  |  |  |  |  | '[:^digit:]'  => '${Ebig5hkscs::not_digit}', | 
| 2045 |  |  |  |  |  |  | '[:^graph:]'  => '${Ebig5hkscs::not_graph}', | 
| 2046 |  |  |  |  |  |  | '[:^lower:]'  => '${Ebig5hkscs::not_lower}', | 
| 2047 |  |  |  |  |  |  | '[:^print:]'  => '${Ebig5hkscs::not_print}', | 
| 2048 |  |  |  |  |  |  | '[:^punct:]'  => '${Ebig5hkscs::not_punct}', | 
| 2049 |  |  |  |  |  |  | '[:^space:]'  => '${Ebig5hkscs::not_space}', | 
| 2050 |  |  |  |  |  |  | '[:^upper:]'  => '${Ebig5hkscs::not_upper}', | 
| 2051 |  |  |  |  |  |  | '[:^word:]'   => '${Ebig5hkscs::not_word}', | 
| 2052 |  |  |  |  |  |  | '[:^xdigit:]' => '${Ebig5hkscs::not_xdigit}', | 
| 2053 |  |  |  |  |  |  |  | 
| 2054 | 8 |  |  |  |  | 151 | }->{$1}; | 
| 2055 |  |  |  |  |  |  | } | 
| 2056 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ($q_char) \z/oxms) { | 
| 2057 | 70 |  |  |  |  | 1402 | $char[$i] = $1; | 
| 2058 |  |  |  |  |  |  | } | 
| 2059 |  |  |  |  |  |  | } | 
| 2060 |  |  |  |  |  |  |  | 
| 2061 |  |  |  |  |  |  | # open character list | 
| 2062 | 7 |  |  |  |  | 35 | my @singleoctet   = (); | 
| 2063 | 758 |  |  |  |  | 1434 | my @multipleoctet = (); | 
| 2064 | 758 |  |  |  |  | 1359 | for (my $i=0; $i <= $#char; ) { | 
| 2065 |  |  |  |  |  |  |  | 
| 2066 |  |  |  |  |  |  | # escaped - | 
| 2067 | 758 | 100 | 100 |  |  | 1607 | if (defined($char[$i+1]) and ($char[$i+1] eq '...')) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 2068 | 2151 |  |  |  |  | 8742 | $i += 1; | 
| 2069 | 497 |  |  |  |  | 795 | next; | 
| 2070 |  |  |  |  |  |  | } | 
| 2071 |  |  |  |  |  |  |  | 
| 2072 |  |  |  |  |  |  | # make range regexp | 
| 2073 |  |  |  |  |  |  | elsif ($char[$i] eq '...') { | 
| 2074 |  |  |  |  |  |  |  | 
| 2075 |  |  |  |  |  |  | # range error | 
| 2076 | 497 | 50 |  |  |  | 2203 | if (CORE::length($char[$i-1]) > CORE::length($char[$i+1])) { | 
|  |  | 100 |  |  |  |  |  | 
| 2077 | 497 |  |  |  |  | 1961 | croak 'Invalid [] range in regexp (length(A) > length(B)) ' . '\x' . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]); | 
| 2078 |  |  |  |  |  |  | } | 
| 2079 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == CORE::length($char[$i+1])) { | 
| 2080 | 0 | 50 |  |  |  | 0 | if ($char[$i-1] gt $char[$i+1]) { | 
| 2081 | 477 |  |  |  |  | 1231 | croak 'Invalid [] range in regexp (CORE::ord(A) > CORE::ord(B)) ' . '\x' . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]); | 
| 2082 |  |  |  |  |  |  | } | 
| 2083 |  |  |  |  |  |  | } | 
| 2084 |  |  |  |  |  |  |  | 
| 2085 |  |  |  |  |  |  | # make range regexp per length | 
| 2086 | 0 |  |  |  |  | 0 | for my $length (CORE::length($char[$i-1]) .. CORE::length($char[$i+1])) { | 
| 2087 | 497 |  |  |  |  | 1316 | my @regexp = (); | 
| 2088 |  |  |  |  |  |  |  | 
| 2089 |  |  |  |  |  |  | # is first and last | 
| 2090 | 517 | 100 | 100 |  |  | 766 | if (($length == CORE::length($char[$i-1])) and ($length == CORE::length($char[$i+1]))) { | 
|  |  | 100 | 33 |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 2091 | 517 |  |  |  |  | 1851 | push @regexp, _range_regexp($length, $char[$i-1], $char[$i+1]); | 
| 2092 |  |  |  |  |  |  | } | 
| 2093 |  |  |  |  |  |  |  | 
| 2094 |  |  |  |  |  |  | # is first | 
| 2095 |  |  |  |  |  |  | elsif ($length == CORE::length($char[$i-1])) { | 
| 2096 | 477 |  |  |  |  | 1419 | push @regexp, _range_regexp($length, $char[$i-1], "\xFF" x $length); | 
| 2097 |  |  |  |  |  |  | } | 
| 2098 |  |  |  |  |  |  |  | 
| 2099 |  |  |  |  |  |  | # is inside in first and last | 
| 2100 |  |  |  |  |  |  | elsif ((CORE::length($char[$i-1]) < $length) and ($length < CORE::length($char[$i+1]))) { | 
| 2101 | 20 |  |  |  |  | 65 | push @regexp, _range_regexp($length, "\x00" x $length, "\xFF" x $length); | 
| 2102 |  |  |  |  |  |  | } | 
| 2103 |  |  |  |  |  |  |  | 
| 2104 |  |  |  |  |  |  | # is last | 
| 2105 |  |  |  |  |  |  | elsif ($length == CORE::length($char[$i+1])) { | 
| 2106 | 0 |  |  |  |  | 0 | push @regexp, _range_regexp($length, "\x00" x $length, $char[$i+1]); | 
| 2107 |  |  |  |  |  |  | } | 
| 2108 |  |  |  |  |  |  |  | 
| 2109 |  |  |  |  |  |  | else { | 
| 2110 | 20 |  |  |  |  | 87 | die __FILE__, ": subroutine make_regexp panic.\n"; | 
| 2111 |  |  |  |  |  |  | } | 
| 2112 |  |  |  |  |  |  |  | 
| 2113 | 0 | 100 |  |  |  | 0 | if ($length == 1) { | 
| 2114 | 517 |  |  |  |  | 1026 | push @singleoctet, @regexp; | 
| 2115 |  |  |  |  |  |  | } | 
| 2116 |  |  |  |  |  |  | else { | 
| 2117 | 386 |  |  |  |  | 1039 | push @multipleoctet, @regexp; | 
| 2118 |  |  |  |  |  |  | } | 
| 2119 |  |  |  |  |  |  | } | 
| 2120 |  |  |  |  |  |  |  | 
| 2121 | 131 |  |  |  |  | 296 | $i += 2; | 
| 2122 |  |  |  |  |  |  | } | 
| 2123 |  |  |  |  |  |  |  | 
| 2124 |  |  |  |  |  |  | # with /i modifier | 
| 2125 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 2126 | 497 | 100 |  |  |  | 1028 | if ($modifier =~ /i/oxms) { | 
| 2127 | 764 |  |  |  |  | 1423 | my $uc = Ebig5hkscs::uc($char[$i]); | 
| 2128 | 192 |  |  |  |  | 303 | my $fc = Ebig5hkscs::fc($char[$i]); | 
| 2129 | 192 | 50 |  |  |  | 321 | if ($uc ne $fc) { | 
| 2130 | 192 | 50 |  |  |  | 310 | if (CORE::length($fc) == 1) { | 
| 2131 | 192 |  |  |  |  | 251 | push @singleoctet, $uc, $fc; | 
| 2132 |  |  |  |  |  |  | } | 
| 2133 |  |  |  |  |  |  | else { | 
| 2134 | 192 |  |  |  |  | 362 | push @singleoctet,   $uc; | 
| 2135 | 0 |  |  |  |  | 0 | push @multipleoctet, $fc; | 
| 2136 |  |  |  |  |  |  | } | 
| 2137 |  |  |  |  |  |  | } | 
| 2138 |  |  |  |  |  |  | else { | 
| 2139 | 0 |  |  |  |  | 0 | push @singleoctet, $char[$i]; | 
| 2140 |  |  |  |  |  |  | } | 
| 2141 |  |  |  |  |  |  | } | 
| 2142 |  |  |  |  |  |  | else { | 
| 2143 | 0 |  |  |  |  | 0 | push @singleoctet, $char[$i]; | 
| 2144 |  |  |  |  |  |  | } | 
| 2145 | 572 |  |  |  |  | 1161 | $i += 1; | 
| 2146 |  |  |  |  |  |  | } | 
| 2147 |  |  |  |  |  |  |  | 
| 2148 |  |  |  |  |  |  | # single character of single octet code | 
| 2149 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\h ) \z/oxms) { | 
| 2150 | 764 |  |  |  |  | 1569 | push @singleoctet, "\t", "\x20"; | 
| 2151 | 0 |  |  |  |  | 0 | $i += 1; | 
| 2152 |  |  |  |  |  |  | } | 
| 2153 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\v ) \z/oxms) { | 
| 2154 | 0 |  |  |  |  | 0 | push @singleoctet, "\x0A", "\x0B", "\x0C", "\x0D"; | 
| 2155 | 0 |  |  |  |  | 0 | $i += 1; | 
| 2156 |  |  |  |  |  |  | } | 
| 2157 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\d | \\s | \\w ) \z/oxms) { | 
| 2158 | 0 |  |  |  |  | 0 | push @singleoctet, $char[$i]; | 
| 2159 | 2 |  |  |  |  | 5 | $i += 1; | 
| 2160 |  |  |  |  |  |  | } | 
| 2161 |  |  |  |  |  |  |  | 
| 2162 |  |  |  |  |  |  | # single character of multiple-octet code | 
| 2163 |  |  |  |  |  |  | else { | 
| 2164 | 2 |  |  |  |  | 6 | push @multipleoctet, $char[$i]; | 
| 2165 | 391 |  |  |  |  | 691 | $i += 1; | 
| 2166 |  |  |  |  |  |  | } | 
| 2167 |  |  |  |  |  |  | } | 
| 2168 |  |  |  |  |  |  |  | 
| 2169 |  |  |  |  |  |  | # quote metachar | 
| 2170 | 391 |  |  |  |  | 701 | for (@singleoctet) { | 
| 2171 | 758 | 50 |  |  |  | 1989 | if ($_ eq '...') { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 2172 | 1364 |  |  |  |  | 6214 | $_ = '-'; | 
| 2173 |  |  |  |  |  |  | } | 
| 2174 |  |  |  |  |  |  | elsif (/\A \n \z/oxms) { | 
| 2175 | 0 |  |  |  |  | 0 | $_ = '\n'; | 
| 2176 |  |  |  |  |  |  | } | 
| 2177 |  |  |  |  |  |  | elsif (/\A \r \z/oxms) { | 
| 2178 | 8 |  |  |  |  | 16 | $_ = '\r'; | 
| 2179 |  |  |  |  |  |  | } | 
| 2180 |  |  |  |  |  |  | elsif (/\A ([\x00-\x20\x7F-\xFF]) \z/oxms) { | 
| 2181 | 8 |  |  |  |  | 24 | $_ = sprintf('\x%02X', CORE::ord $1); | 
| 2182 |  |  |  |  |  |  | } | 
| 2183 |  |  |  |  |  |  | elsif (/\A [\x00-\xFF] \z/oxms) { | 
| 2184 | 1 |  |  |  |  | 5 | $_ = quotemeta $_; | 
| 2185 |  |  |  |  |  |  | } | 
| 2186 |  |  |  |  |  |  | } | 
| 2187 | 939 |  |  |  |  | 1542 | for (@multipleoctet) { | 
| 2188 | 758 | 100 |  |  |  | 1308 | if (/\A ([\x80-\xFF].*) ([\x00-\xFF]) \z/oxms) { | 
| 2189 | 693 |  |  |  |  | 1745 | $_ = $1 . quotemeta $2; | 
| 2190 |  |  |  |  |  |  | } | 
| 2191 |  |  |  |  |  |  | } | 
| 2192 |  |  |  |  |  |  |  | 
| 2193 |  |  |  |  |  |  | # return character list | 
| 2194 | 307 |  |  |  |  | 745 | return \@singleoctet, \@multipleoctet; | 
| 2195 |  |  |  |  |  |  | } | 
| 2196 |  |  |  |  |  |  |  | 
| 2197 |  |  |  |  |  |  | # | 
| 2198 |  |  |  |  |  |  | # Big5-HKSCS octal escape sequence | 
| 2199 |  |  |  |  |  |  | # | 
| 2200 |  |  |  |  |  |  | sub octchr { | 
| 2201 | 758 |  |  | 5 | 0 | 2860 | my($octdigit) = @_; | 
| 2202 |  |  |  |  |  |  |  | 
| 2203 | 5 |  |  |  |  | 17 | my @binary = (); | 
| 2204 | 5 |  |  |  |  | 7 | for my $octal (split(//,$octdigit)) { | 
| 2205 |  |  |  |  |  |  | push @binary, { | 
| 2206 |  |  |  |  |  |  | '0' => '000', | 
| 2207 |  |  |  |  |  |  | '1' => '001', | 
| 2208 |  |  |  |  |  |  | '2' => '010', | 
| 2209 |  |  |  |  |  |  | '3' => '011', | 
| 2210 |  |  |  |  |  |  | '4' => '100', | 
| 2211 |  |  |  |  |  |  | '5' => '101', | 
| 2212 |  |  |  |  |  |  | '6' => '110', | 
| 2213 |  |  |  |  |  |  | '7' => '111', | 
| 2214 | 5 |  |  |  |  | 25 | }->{$octal}; | 
| 2215 |  |  |  |  |  |  | } | 
| 2216 | 50 |  |  |  |  | 187 | my $binary = join '', @binary; | 
| 2217 |  |  |  |  |  |  |  | 
| 2218 |  |  |  |  |  |  | my $octchr = { | 
| 2219 |  |  |  |  |  |  | #                1234567 | 
| 2220 |  |  |  |  |  |  | 1 => pack('B*', "0000000$binary"), | 
| 2221 |  |  |  |  |  |  | 2 => pack('B*', "000000$binary"), | 
| 2222 |  |  |  |  |  |  | 3 => pack('B*', "00000$binary"), | 
| 2223 |  |  |  |  |  |  | 4 => pack('B*', "0000$binary"), | 
| 2224 |  |  |  |  |  |  | 5 => pack('B*', "000$binary"), | 
| 2225 |  |  |  |  |  |  | 6 => pack('B*', "00$binary"), | 
| 2226 |  |  |  |  |  |  | 7 => pack('B*', "0$binary"), | 
| 2227 |  |  |  |  |  |  | 0 => pack('B*', "$binary"), | 
| 2228 |  |  |  |  |  |  |  | 
| 2229 | 5 |  |  |  |  | 14 | }->{CORE::length($binary) % 8}; | 
| 2230 |  |  |  |  |  |  |  | 
| 2231 | 5 |  |  |  |  | 69 | return $octchr; | 
| 2232 |  |  |  |  |  |  | } | 
| 2233 |  |  |  |  |  |  |  | 
| 2234 |  |  |  |  |  |  | # | 
| 2235 |  |  |  |  |  |  | # Big5-HKSCS hexadecimal escape sequence | 
| 2236 |  |  |  |  |  |  | # | 
| 2237 |  |  |  |  |  |  | sub hexchr { | 
| 2238 | 5 |  |  | 5 | 0 | 20 | my($hexdigit) = @_; | 
| 2239 |  |  |  |  |  |  |  | 
| 2240 |  |  |  |  |  |  | my $hexchr = { | 
| 2241 |  |  |  |  |  |  | 1 => pack('H*', "0$hexdigit"), | 
| 2242 |  |  |  |  |  |  | 0 => pack('H*', "$hexdigit"), | 
| 2243 |  |  |  |  |  |  |  | 
| 2244 | 5 |  |  |  |  | 14 | }->{CORE::length($_[0]) % 2}; | 
| 2245 |  |  |  |  |  |  |  | 
| 2246 | 5 |  |  |  |  | 62 | return $hexchr; | 
| 2247 |  |  |  |  |  |  | } | 
| 2248 |  |  |  |  |  |  |  | 
| 2249 |  |  |  |  |  |  | # | 
| 2250 |  |  |  |  |  |  | # Big5-HKSCS open character list for qr | 
| 2251 |  |  |  |  |  |  | # | 
| 2252 |  |  |  |  |  |  | sub charlist_qr { | 
| 2253 |  |  |  |  |  |  |  | 
| 2254 | 5 |  |  | 519 | 0 | 21 | my $modifier = pop @_; | 
| 2255 | 519 |  |  |  |  | 1025 | my @char = @_; | 
| 2256 |  |  |  |  |  |  |  | 
| 2257 | 519 |  |  |  |  | 1634 | my($singleoctet, $multipleoctet) = _charlist(@char, $modifier); | 
| 2258 | 519 |  |  |  |  | 1563 | my @singleoctet   = @$singleoctet; | 
| 2259 | 519 |  |  |  |  | 1119 | my @multipleoctet = @$multipleoctet; | 
| 2260 |  |  |  |  |  |  |  | 
| 2261 |  |  |  |  |  |  | # return character list | 
| 2262 | 519 | 100 |  |  |  | 817 | if (scalar(@singleoctet) >= 1) { | 
| 2263 |  |  |  |  |  |  |  | 
| 2264 |  |  |  |  |  |  | # with /i modifier | 
| 2265 | 519 | 100 |  |  |  | 1446 | if ($modifier =~ m/i/oxms) { | 
| 2266 | 384 |  |  |  |  | 879 | my %singleoctet_ignorecase = (); | 
| 2267 | 107 |  |  |  |  | 156 | for (@singleoctet) { | 
| 2268 | 107 |  | 100 |  |  | 145 | while (s/ \A \\x(..) - \\x(..) //oxms or s/ \A \\x((..)) //oxms) { | 
| 2269 | 272 |  |  |  |  | 873 | for my $ord (hex($1) .. hex($2)) { | 
| 2270 | 80 |  |  |  |  | 266 | my $char = CORE::chr($ord); | 
| 2271 | 1046 |  |  |  |  | 1437 | my $uc = Ebig5hkscs::uc($char); | 
| 2272 | 1046 |  |  |  |  | 1351 | my $fc = Ebig5hkscs::fc($char); | 
| 2273 | 1046 | 100 |  |  |  | 1513 | if ($uc eq $fc) { | 
| 2274 | 1046 |  |  |  |  | 1551 | $singleoctet_ignorecase{unpack 'C*', $char} = 1; | 
| 2275 |  |  |  |  |  |  | } | 
| 2276 |  |  |  |  |  |  | else { | 
| 2277 | 457 | 50 |  |  |  | 1073 | if (CORE::length($fc) == 1) { | 
| 2278 | 589 |  |  |  |  | 742 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2279 | 589 |  |  |  |  | 1209 | $singleoctet_ignorecase{unpack 'C*', $fc} = 1; | 
| 2280 |  |  |  |  |  |  | } | 
| 2281 |  |  |  |  |  |  | else { | 
| 2282 | 589 |  |  |  |  | 1472 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2283 | 0 |  |  |  |  | 0 | push @multipleoctet, join '', map {sprintf('\x%02X',$_)} unpack 'C*', $fc; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2284 |  |  |  |  |  |  | } | 
| 2285 |  |  |  |  |  |  | } | 
| 2286 |  |  |  |  |  |  | } | 
| 2287 |  |  |  |  |  |  | } | 
| 2288 | 0 | 100 |  |  |  | 0 | if ($_ ne '') { | 
| 2289 | 272 |  |  |  |  | 463 | $singleoctet_ignorecase{unpack 'C*', $_} = 1; | 
| 2290 |  |  |  |  |  |  | } | 
| 2291 |  |  |  |  |  |  | } | 
| 2292 | 192 |  |  |  |  | 462 | my $i = 0; | 
| 2293 | 107 |  |  |  |  | 138 | my @singleoctet_ignorecase = (); | 
| 2294 | 107 |  |  |  |  | 136 | for my $ord (0 .. 255) { | 
| 2295 | 107 | 100 |  |  |  | 165 | if (exists $singleoctet_ignorecase{$ord}) { | 
| 2296 | 27392 |  |  |  |  | 32586 | push @{$singleoctet_ignorecase[$i]}, $ord; | 
|  | 1577 |  |  |  |  | 1458 |  | 
| 2297 |  |  |  |  |  |  | } | 
| 2298 |  |  |  |  |  |  | else { | 
| 2299 | 1577 |  |  |  |  | 2375 | $i++; | 
| 2300 |  |  |  |  |  |  | } | 
| 2301 |  |  |  |  |  |  | } | 
| 2302 | 25815 |  |  |  |  | 27017 | @singleoctet = (); | 
| 2303 | 107 |  |  |  |  | 163 | for my $range (@singleoctet_ignorecase) { | 
| 2304 | 107 | 100 |  |  |  | 223 | if (ref $range) { | 
| 2305 | 11412 | 100 |  |  |  | 17699 | if (scalar(@{$range}) == 1) { | 
|  | 214 | 50 |  |  |  | 218 |  | 
| 2306 | 214 |  |  |  |  | 347 | push @singleoctet, sprintf('\x%02X', @{$range}[0]); | 
|  | 5 |  |  |  |  | 8 |  | 
| 2307 |  |  |  |  |  |  | } | 
| 2308 | 5 |  |  |  |  | 58 | elsif (scalar(@{$range}) == 2) { | 
| 2309 | 209 |  |  |  |  | 356 | push @singleoctet, sprintf('\x%02X\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2310 |  |  |  |  |  |  | } | 
| 2311 |  |  |  |  |  |  | else { | 
| 2312 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X-\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 209 |  |  |  |  | 236 |  | 
|  | 209 |  |  |  |  | 280 |  | 
| 2313 |  |  |  |  |  |  | } | 
| 2314 |  |  |  |  |  |  | } | 
| 2315 |  |  |  |  |  |  | } | 
| 2316 |  |  |  |  |  |  | } | 
| 2317 |  |  |  |  |  |  |  | 
| 2318 | 209 |  |  |  |  | 940 | my $not_anchor = ''; | 
| 2319 | 384 |  |  |  |  | 589 | $not_anchor = '(?![\x81-\xFE])'; | 
| 2320 |  |  |  |  |  |  |  | 
| 2321 | 384 |  |  |  |  | 917 | push @multipleoctet, join('', $not_anchor, '[', @singleoctet, ']' ); | 
| 2322 |  |  |  |  |  |  | } | 
| 2323 | 384 | 100 |  |  |  | 1924 | if (scalar(@multipleoctet) >= 2) { | 
| 2324 | 519 |  |  |  |  | 1537 | return '(?:' . join('|', @multipleoctet) . ')'; | 
| 2325 |  |  |  |  |  |  | } | 
| 2326 |  |  |  |  |  |  | else { | 
| 2327 | 131 |  |  |  |  | 789 | return $multipleoctet[0]; | 
| 2328 |  |  |  |  |  |  | } | 
| 2329 |  |  |  |  |  |  | } | 
| 2330 |  |  |  |  |  |  |  | 
| 2331 |  |  |  |  |  |  | # | 
| 2332 |  |  |  |  |  |  | # Big5-HKSCS open character list for not qr | 
| 2333 |  |  |  |  |  |  | # | 
| 2334 |  |  |  |  |  |  | sub charlist_not_qr { | 
| 2335 |  |  |  |  |  |  |  | 
| 2336 | 388 |  |  | 239 | 0 | 1842 | my $modifier = pop @_; | 
| 2337 | 239 |  |  |  |  | 409 | my @char = @_; | 
| 2338 |  |  |  |  |  |  |  | 
| 2339 | 239 |  |  |  |  | 541 | my($singleoctet, $multipleoctet) = _charlist(@char, $modifier); | 
| 2340 | 239 |  |  |  |  | 534 | my @singleoctet   = @$singleoctet; | 
| 2341 | 239 |  |  |  |  | 474 | my @multipleoctet = @$multipleoctet; | 
| 2342 |  |  |  |  |  |  |  | 
| 2343 |  |  |  |  |  |  | # with /i modifier | 
| 2344 | 239 | 100 |  |  |  | 395 | if ($modifier =~ m/i/oxms) { | 
| 2345 | 239 |  |  |  |  | 563 | my %singleoctet_ignorecase = (); | 
| 2346 | 128 |  |  |  |  | 176 | for (@singleoctet) { | 
| 2347 | 128 |  | 100 |  |  | 183 | while (s/ \A \\x(..) - \\x(..) //oxms or s/ \A \\x((..)) //oxms) { | 
| 2348 | 272 |  |  |  |  | 879 | for my $ord (hex($1) .. hex($2)) { | 
| 2349 | 80 |  |  |  |  | 274 | my $char = CORE::chr($ord); | 
| 2350 | 1046 |  |  |  |  | 1702 | my $uc = Ebig5hkscs::uc($char); | 
| 2351 | 1046 |  |  |  |  | 1288 | my $fc = Ebig5hkscs::fc($char); | 
| 2352 | 1046 | 100 |  |  |  | 1551 | if ($uc eq $fc) { | 
| 2353 | 1046 |  |  |  |  | 1568 | $singleoctet_ignorecase{unpack 'C*', $char} = 1; | 
| 2354 |  |  |  |  |  |  | } | 
| 2355 |  |  |  |  |  |  | else { | 
| 2356 | 457 | 50 |  |  |  | 1021 | if (CORE::length($fc) == 1) { | 
| 2357 | 589 |  |  |  |  | 754 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2358 | 589 |  |  |  |  | 1113 | $singleoctet_ignorecase{unpack 'C*', $fc} = 1; | 
| 2359 |  |  |  |  |  |  | } | 
| 2360 |  |  |  |  |  |  | else { | 
| 2361 | 589 |  |  |  |  | 1417 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2362 | 0 |  |  |  |  | 0 | push @multipleoctet, join '', map {sprintf('\x%02X',$_)} unpack 'C*', $fc; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2363 |  |  |  |  |  |  | } | 
| 2364 |  |  |  |  |  |  | } | 
| 2365 |  |  |  |  |  |  | } | 
| 2366 |  |  |  |  |  |  | } | 
| 2367 | 0 | 100 |  |  |  | 0 | if ($_ ne '') { | 
| 2368 | 272 |  |  |  |  | 513 | $singleoctet_ignorecase{unpack 'C*', $_} = 1; | 
| 2369 |  |  |  |  |  |  | } | 
| 2370 |  |  |  |  |  |  | } | 
| 2371 | 192 |  |  |  |  | 435 | my $i = 0; | 
| 2372 | 128 |  |  |  |  | 159 | my @singleoctet_ignorecase = (); | 
| 2373 | 128 |  |  |  |  | 169 | for my $ord (0 .. 255) { | 
| 2374 | 128 | 100 |  |  |  | 196 | if (exists $singleoctet_ignorecase{$ord}) { | 
| 2375 | 32768 |  |  |  |  | 38904 | push @{$singleoctet_ignorecase[$i]}, $ord; | 
|  | 1577 |  |  |  |  | 1490 |  | 
| 2376 |  |  |  |  |  |  | } | 
| 2377 |  |  |  |  |  |  | else { | 
| 2378 | 1577 |  |  |  |  | 2577 | $i++; | 
| 2379 |  |  |  |  |  |  | } | 
| 2380 |  |  |  |  |  |  | } | 
| 2381 | 31191 |  |  |  |  | 32767 | @singleoctet = (); | 
| 2382 | 128 |  |  |  |  | 184 | for my $range (@singleoctet_ignorecase) { | 
| 2383 | 128 | 100 |  |  |  | 266 | if (ref $range) { | 
| 2384 | 11412 | 100 |  |  |  | 17981 | if (scalar(@{$range}) == 1) { | 
|  | 214 | 50 |  |  |  | 213 |  | 
| 2385 | 214 |  |  |  |  | 378 | push @singleoctet, sprintf('\x%02X', @{$range}[0]); | 
|  | 5 |  |  |  |  | 6 |  | 
| 2386 |  |  |  |  |  |  | } | 
| 2387 | 5 |  |  |  |  | 54 | elsif (scalar(@{$range}) == 2) { | 
| 2388 | 209 |  |  |  |  | 290 | push @singleoctet, sprintf('\x%02X\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2389 |  |  |  |  |  |  | } | 
| 2390 |  |  |  |  |  |  | else { | 
| 2391 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X-\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 209 |  |  |  |  | 316 |  | 
|  | 209 |  |  |  |  | 265 |  | 
| 2392 |  |  |  |  |  |  | } | 
| 2393 |  |  |  |  |  |  | } | 
| 2394 |  |  |  |  |  |  | } | 
| 2395 |  |  |  |  |  |  | } | 
| 2396 |  |  |  |  |  |  |  | 
| 2397 |  |  |  |  |  |  | # return character list | 
| 2398 | 209 | 100 |  |  |  | 889 | if (scalar(@multipleoctet) >= 1) { | 
| 2399 | 239 | 100 |  |  |  | 479 | if (scalar(@singleoctet) >= 1) { | 
| 2400 |  |  |  |  |  |  |  | 
| 2401 |  |  |  |  |  |  | # any character other than multiple-octet and single octet character class | 
| 2402 | 114 |  |  |  |  | 205 | return '(?!' . join('|', @multipleoctet) . ')(?:[^\x81-\xFE' . join('', @singleoctet) . ']|[\x81-\xFE][\x00-\xFF])'; | 
| 2403 |  |  |  |  |  |  | } | 
| 2404 |  |  |  |  |  |  | else { | 
| 2405 |  |  |  |  |  |  |  | 
| 2406 |  |  |  |  |  |  | # any character other than multiple-octet character class | 
| 2407 | 70 |  |  |  |  | 472 | return '(?!' . join('|', @multipleoctet) . ")(?:$your_char)"; | 
| 2408 |  |  |  |  |  |  | } | 
| 2409 |  |  |  |  |  |  | } | 
| 2410 |  |  |  |  |  |  | else { | 
| 2411 | 44 | 50 |  |  |  | 267 | if (scalar(@singleoctet) >= 1) { | 
| 2412 |  |  |  |  |  |  |  | 
| 2413 |  |  |  |  |  |  | # any character other than single octet character class | 
| 2414 | 125 |  |  |  |  | 281 | return                                      '(?:[^\x81-\xFE' . join('', @singleoctet) . ']|[\x81-\xFE][\x00-\xFF])'; | 
| 2415 |  |  |  |  |  |  | } | 
| 2416 |  |  |  |  |  |  | else { | 
| 2417 |  |  |  |  |  |  |  | 
| 2418 |  |  |  |  |  |  | # any character | 
| 2419 | 125 |  |  |  |  | 689 | return                                      "(?:$your_char)"; | 
| 2420 |  |  |  |  |  |  | } | 
| 2421 |  |  |  |  |  |  | } | 
| 2422 |  |  |  |  |  |  | } | 
| 2423 |  |  |  |  |  |  |  | 
| 2424 |  |  |  |  |  |  | # | 
| 2425 |  |  |  |  |  |  | # open file in read mode | 
| 2426 |  |  |  |  |  |  | # | 
| 2427 |  |  |  |  |  |  | sub _open_r { | 
| 2428 | 0 |  |  | 768 |  | 0 | my(undef,$file) = @_; | 
| 2429 | 389 |  |  | 389 |  | 8200 | use Fcntl qw(O_RDONLY); | 
|  | 389 |  |  |  |  | 923 |  | 
|  | 389 |  |  |  |  | 61271 |  | 
| 2430 | 768 |  |  |  |  | 2878 | return CORE::sysopen($_[0], $file, &O_RDONLY); | 
| 2431 |  |  |  |  |  |  | } | 
| 2432 |  |  |  |  |  |  |  | 
| 2433 |  |  |  |  |  |  | # | 
| 2434 |  |  |  |  |  |  | # open file in append mode | 
| 2435 |  |  |  |  |  |  | # | 
| 2436 |  |  |  |  |  |  | sub _open_a { | 
| 2437 | 768 |  |  | 384 |  | 31826 | my(undef,$file) = @_; | 
| 2438 | 389 |  |  | 389 |  | 4268 | use Fcntl qw(O_WRONLY O_APPEND O_CREAT); | 
|  | 389 |  |  |  |  | 931 |  | 
|  | 389 |  |  |  |  | 5694839 |  | 
| 2439 | 384 |  |  |  |  | 1127 | return CORE::sysopen($_[0], $file, &O_WRONLY|&O_APPEND|&O_CREAT); | 
| 2440 |  |  |  |  |  |  | } | 
| 2441 |  |  |  |  |  |  |  | 
| 2442 |  |  |  |  |  |  | # | 
| 2443 |  |  |  |  |  |  | # safe system | 
| 2444 |  |  |  |  |  |  | # | 
| 2445 |  |  |  |  |  |  | sub _systemx { | 
| 2446 |  |  |  |  |  |  |  | 
| 2447 |  |  |  |  |  |  | # P.707 29.2.33. exec | 
| 2448 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 2449 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2450 |  |  |  |  |  |  | # | 
| 2451 |  |  |  |  |  |  | # Be aware that in older releases of Perl, exec (and system) did not flush | 
| 2452 |  |  |  |  |  |  | # your output buffer, so you needed to enable command buffering by setting $| | 
| 2453 |  |  |  |  |  |  | # on one or more filehandles to avoid lost output in the case of exec, or | 
| 2454 |  |  |  |  |  |  | # misordererd output in the case of system. This situation was largely remedied | 
| 2455 |  |  |  |  |  |  | # in the 5.6 release of Perl. (So, 5.005 release not yet.) | 
| 2456 |  |  |  |  |  |  |  | 
| 2457 |  |  |  |  |  |  | # P.855 exec | 
| 2458 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 2459 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2460 |  |  |  |  |  |  | # | 
| 2461 |  |  |  |  |  |  | # In very old release of Perl (before v5.6), exec (and system) did not flush | 
| 2462 |  |  |  |  |  |  | # your output buffer, so you needed to enable command buffering by setting $| | 
| 2463 |  |  |  |  |  |  | # on one or more filehandles to avoid lost output with exec or misordered | 
| 2464 |  |  |  |  |  |  | # output with system. | 
| 2465 |  |  |  |  |  |  |  | 
| 2466 | 384 |  |  | 384 |  | 77543 | $| = 1; | 
| 2467 |  |  |  |  |  |  |  | 
| 2468 |  |  |  |  |  |  | # P.565 23.1.2. Cleaning Up Your Environment | 
| 2469 |  |  |  |  |  |  | # in Chapter 23: Security | 
| 2470 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2471 |  |  |  |  |  |  |  | 
| 2472 |  |  |  |  |  |  | # P.656 Cleaning Up Your Environment | 
| 2473 |  |  |  |  |  |  | # in Chapter 20: Security | 
| 2474 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2475 |  |  |  |  |  |  |  | 
| 2476 |  |  |  |  |  |  | # local $ENV{'PATH'} = '.'; | 
| 2477 | 384 |  |  |  |  | 1445 | local @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer | 
| 2478 |  |  |  |  |  |  |  | 
| 2479 |  |  |  |  |  |  | # P.707 29.2.33. exec | 
| 2480 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 2481 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2482 |  |  |  |  |  |  | # | 
| 2483 |  |  |  |  |  |  | # As we mentioned earlier, exec treats a discrete list of arguments as an | 
| 2484 |  |  |  |  |  |  | # indication that it should bypass shell processing. However, there is one | 
| 2485 |  |  |  |  |  |  | # place where you might still get tripped up. The exec call (and system, too) | 
| 2486 |  |  |  |  |  |  | # will not distinguish between a single scalar argument and an array containing | 
| 2487 |  |  |  |  |  |  | # only one element. | 
| 2488 |  |  |  |  |  |  | # | 
| 2489 |  |  |  |  |  |  | #     @args = ("echo surprise");  # just one element in list | 
| 2490 |  |  |  |  |  |  | #     exec @args                  # still subject to shell escapes | 
| 2491 |  |  |  |  |  |  | #         or die "exec: $!";      #   because @args == 1 | 
| 2492 |  |  |  |  |  |  | # | 
| 2493 |  |  |  |  |  |  | # To avoid this, you can use the PATHNAME syntax, explicitly duplicating the | 
| 2494 |  |  |  |  |  |  | # first argument as the pathname, which forces the rest of the arguments to be | 
| 2495 |  |  |  |  |  |  | # interpreted as a list, even if there is only one of them: | 
| 2496 |  |  |  |  |  |  | # | 
| 2497 |  |  |  |  |  |  | #     exec { $args[0] } @args  # safe even with one-argument list | 
| 2498 |  |  |  |  |  |  | #         or die "can't exec @args: $!"; | 
| 2499 |  |  |  |  |  |  |  | 
| 2500 |  |  |  |  |  |  | # P.855 exec | 
| 2501 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 2502 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2503 |  |  |  |  |  |  | # | 
| 2504 |  |  |  |  |  |  | # As we mentioned earlier, exec treats a discrete list of arguments as a | 
| 2505 |  |  |  |  |  |  | # directive to bypass shell processing. However, there is one place where | 
| 2506 |  |  |  |  |  |  | # you might still get tripped up. The exec call (and system, too) cannot | 
| 2507 |  |  |  |  |  |  | # distinguish between a single scalar argument and an array containing | 
| 2508 |  |  |  |  |  |  | # only one element. | 
| 2509 |  |  |  |  |  |  | # | 
| 2510 |  |  |  |  |  |  | #     @args = ("echo surprise");  # just one element in list | 
| 2511 |  |  |  |  |  |  | #     exec @args                  # still subject to shell escapes | 
| 2512 |  |  |  |  |  |  | #         || die "exec: $!";      #   because @args == 1 | 
| 2513 |  |  |  |  |  |  | # | 
| 2514 |  |  |  |  |  |  | # To avoid this, use the PATHNAME syntax, explicitly duplicating the first | 
| 2515 |  |  |  |  |  |  | # argument as the pathname, which forces the rest of the arguments to be | 
| 2516 |  |  |  |  |  |  | # interpreted as a list, even if there is only one of them: | 
| 2517 |  |  |  |  |  |  | # | 
| 2518 |  |  |  |  |  |  | #     exec { $args[0] } @args  # safe even with one-argument list | 
| 2519 |  |  |  |  |  |  | #         || die "can't exec @args: $!"; | 
| 2520 |  |  |  |  |  |  |  | 
| 2521 | 384 |  |  |  |  | 12734 | return CORE::system { $_[0] } @_; # safe even with one-argument list | 
|  | 384 |  |  |  |  | 901 |  | 
| 2522 |  |  |  |  |  |  | } | 
| 2523 |  |  |  |  |  |  |  | 
| 2524 |  |  |  |  |  |  | # | 
| 2525 |  |  |  |  |  |  | # Big5-HKSCS order to character (with parameter) | 
| 2526 |  |  |  |  |  |  | # | 
| 2527 |  |  |  |  |  |  | sub Ebig5hkscs::chr(;$) { | 
| 2528 |  |  |  |  |  |  |  | 
| 2529 | 384 | 0 |  | 0 | 0 | 50359218 | my $c = @_ ? $_[0] : $_; | 
| 2530 |  |  |  |  |  |  |  | 
| 2531 | 0 | 0 |  |  |  | 0 | if ($c == 0x00) { | 
| 2532 | 0 |  |  |  |  | 0 | return "\x00"; | 
| 2533 |  |  |  |  |  |  | } | 
| 2534 |  |  |  |  |  |  | else { | 
| 2535 | 0 |  |  |  |  | 0 | my @chr = (); | 
| 2536 | 0 |  |  |  |  | 0 | while ($c > 0) { | 
| 2537 | 0 |  |  |  |  | 0 | unshift @chr, ($c % 0x100); | 
| 2538 | 0 |  |  |  |  | 0 | $c = int($c / 0x100); | 
| 2539 |  |  |  |  |  |  | } | 
| 2540 | 0 |  |  |  |  | 0 | return pack 'C*', @chr; | 
| 2541 |  |  |  |  |  |  | } | 
| 2542 |  |  |  |  |  |  | } | 
| 2543 |  |  |  |  |  |  |  | 
| 2544 |  |  |  |  |  |  | # | 
| 2545 |  |  |  |  |  |  | # Big5-HKSCS order to character (without parameter) | 
| 2546 |  |  |  |  |  |  | # | 
| 2547 |  |  |  |  |  |  | sub Ebig5hkscs::chr_() { | 
| 2548 |  |  |  |  |  |  |  | 
| 2549 | 0 |  |  | 0 | 0 | 0 | my $c = $_; | 
| 2550 |  |  |  |  |  |  |  | 
| 2551 | 0 | 0 |  |  |  | 0 | if ($c == 0x00) { | 
| 2552 | 0 |  |  |  |  | 0 | return "\x00"; | 
| 2553 |  |  |  |  |  |  | } | 
| 2554 |  |  |  |  |  |  | else { | 
| 2555 | 0 |  |  |  |  | 0 | my @chr = (); | 
| 2556 | 0 |  |  |  |  | 0 | while ($c > 0) { | 
| 2557 | 0 |  |  |  |  | 0 | unshift @chr, ($c % 0x100); | 
| 2558 | 0 |  |  |  |  | 0 | $c = int($c / 0x100); | 
| 2559 |  |  |  |  |  |  | } | 
| 2560 | 0 |  |  |  |  | 0 | return pack 'C*', @chr; | 
| 2561 |  |  |  |  |  |  | } | 
| 2562 |  |  |  |  |  |  | } | 
| 2563 |  |  |  |  |  |  |  | 
| 2564 |  |  |  |  |  |  | # | 
| 2565 |  |  |  |  |  |  | # Big5-HKSCS stacked file test expr | 
| 2566 |  |  |  |  |  |  | # | 
| 2567 |  |  |  |  |  |  | sub Ebig5hkscs::filetest { | 
| 2568 |  |  |  |  |  |  |  | 
| 2569 | 0 |  |  | 0 | 0 | 0 | my $file     = pop @_; | 
| 2570 | 0 |  |  |  |  | 0 | my $filetest = substr(pop @_, 1); | 
| 2571 |  |  |  |  |  |  |  | 
| 2572 | 0 | 0 |  |  |  | 0 | unless (CORE::eval qq{Ebig5hkscs::$filetest(\$file)}) { | 
| 2573 | 0 |  |  |  |  | 0 | return ''; | 
| 2574 |  |  |  |  |  |  | } | 
| 2575 | 0 |  |  |  |  | 0 | for my $filetest (CORE::reverse @_) { | 
| 2576 | 0 | 0 |  |  |  | 0 | unless (CORE::eval qq{ $filetest _ }) { | 
| 2577 | 0 |  |  |  |  | 0 | return ''; | 
| 2578 |  |  |  |  |  |  | } | 
| 2579 |  |  |  |  |  |  | } | 
| 2580 | 0 |  |  |  |  | 0 | return 1; | 
| 2581 |  |  |  |  |  |  | } | 
| 2582 |  |  |  |  |  |  |  | 
| 2583 |  |  |  |  |  |  | # | 
| 2584 |  |  |  |  |  |  | # Big5-HKSCS file test -r expr | 
| 2585 |  |  |  |  |  |  | # | 
| 2586 |  |  |  |  |  |  | sub Ebig5hkscs::r(;*@) { | 
| 2587 |  |  |  |  |  |  |  | 
| 2588 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2589 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -r (Ebig5hkscs::r)' if @_ and not wantarray; | 
| 2590 |  |  |  |  |  |  |  | 
| 2591 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2592 | 0 | 0 |  |  |  | 0 | return wantarray ? (-r _,@_) : -r _; | 
| 2593 |  |  |  |  |  |  | } | 
| 2594 |  |  |  |  |  |  |  | 
| 2595 |  |  |  |  |  |  | # P.908 32.39. Symbol | 
| 2596 |  |  |  |  |  |  | # in Chapter 32: Standard Modules | 
| 2597 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2598 |  |  |  |  |  |  |  | 
| 2599 |  |  |  |  |  |  | # P.326 Prototypes | 
| 2600 |  |  |  |  |  |  | # in Chapter 7: Subroutines | 
| 2601 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2602 |  |  |  |  |  |  |  | 
| 2603 |  |  |  |  |  |  | # (and so on) | 
| 2604 |  |  |  |  |  |  |  | 
| 2605 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2606 | 0 | 0 |  |  |  | 0 | return wantarray ? (-r $fh,@_) : -r $fh; | 
| 2607 |  |  |  |  |  |  | } | 
| 2608 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2609 | 0 | 0 |  |  |  | 0 | return wantarray ? (-r _,@_) : -r _; | 
| 2610 |  |  |  |  |  |  | } | 
| 2611 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2612 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2613 | 0 | 0 |  |  |  | 0 | return wantarray ? (-r _,@_) : -r _; | 
| 2614 |  |  |  |  |  |  | } | 
| 2615 |  |  |  |  |  |  | else { | 
| 2616 |  |  |  |  |  |  |  | 
| 2617 |  |  |  |  |  |  | # Even if ${^WIN32_SLOPPY_STAT} is set to a true value, Ebig5hkscs::*() | 
| 2618 |  |  |  |  |  |  | # on Windows opens the file for the path which has 5c at end. | 
| 2619 |  |  |  |  |  |  | # (and so on) | 
| 2620 |  |  |  |  |  |  |  | 
| 2621 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2622 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2623 | 0 |  |  |  |  | 0 | my $r = -r $fh; | 
| 2624 | 0 |  |  |  |  | 0 | close $fh; | 
| 2625 | 0 | 0 |  |  |  | 0 | return wantarray ? ($r,@_) : $r; | 
| 2626 |  |  |  |  |  |  | } | 
| 2627 |  |  |  |  |  |  | } | 
| 2628 |  |  |  |  |  |  | } | 
| 2629 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2630 |  |  |  |  |  |  | } | 
| 2631 |  |  |  |  |  |  |  | 
| 2632 |  |  |  |  |  |  | # | 
| 2633 |  |  |  |  |  |  | # Big5-HKSCS file test -w expr | 
| 2634 |  |  |  |  |  |  | # | 
| 2635 |  |  |  |  |  |  | sub Ebig5hkscs::w(;*@) { | 
| 2636 |  |  |  |  |  |  |  | 
| 2637 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2638 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -w (Ebig5hkscs::w)' if @_ and not wantarray; | 
| 2639 |  |  |  |  |  |  |  | 
| 2640 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2641 | 0 | 0 |  |  |  | 0 | return wantarray ? (-w _,@_) : -w _; | 
| 2642 |  |  |  |  |  |  | } | 
| 2643 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2644 | 0 | 0 |  |  |  | 0 | return wantarray ? (-w $fh,@_) : -w $fh; | 
| 2645 |  |  |  |  |  |  | } | 
| 2646 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2647 | 0 | 0 |  |  |  | 0 | return wantarray ? (-w _,@_) : -w _; | 
| 2648 |  |  |  |  |  |  | } | 
| 2649 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2650 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2651 | 0 | 0 |  |  |  | 0 | return wantarray ? (-w _,@_) : -w _; | 
| 2652 |  |  |  |  |  |  | } | 
| 2653 |  |  |  |  |  |  | else { | 
| 2654 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2655 | 0 | 0 |  |  |  | 0 | if (_open_a($fh, $_)) { | 
| 2656 | 0 |  |  |  |  | 0 | my $w = -w $fh; | 
| 2657 | 0 |  |  |  |  | 0 | close $fh; | 
| 2658 | 0 | 0 |  |  |  | 0 | return wantarray ? ($w,@_) : $w; | 
| 2659 |  |  |  |  |  |  | } | 
| 2660 |  |  |  |  |  |  | } | 
| 2661 |  |  |  |  |  |  | } | 
| 2662 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2663 |  |  |  |  |  |  | } | 
| 2664 |  |  |  |  |  |  |  | 
| 2665 |  |  |  |  |  |  | # | 
| 2666 |  |  |  |  |  |  | # Big5-HKSCS file test -x expr | 
| 2667 |  |  |  |  |  |  | # | 
| 2668 |  |  |  |  |  |  | sub Ebig5hkscs::x(;*@) { | 
| 2669 |  |  |  |  |  |  |  | 
| 2670 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2671 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -x (Ebig5hkscs::x)' if @_ and not wantarray; | 
| 2672 |  |  |  |  |  |  |  | 
| 2673 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2674 | 0 | 0 |  |  |  | 0 | return wantarray ? (-x _,@_) : -x _; | 
| 2675 |  |  |  |  |  |  | } | 
| 2676 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2677 | 0 | 0 |  |  |  | 0 | return wantarray ? (-x $fh,@_) : -x $fh; | 
| 2678 |  |  |  |  |  |  | } | 
| 2679 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2680 | 0 | 0 |  |  |  | 0 | return wantarray ? (-x _,@_) : -x _; | 
| 2681 |  |  |  |  |  |  | } | 
| 2682 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2683 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2684 | 0 | 0 |  |  |  | 0 | return wantarray ? (-x _,@_) : -x _; | 
| 2685 |  |  |  |  |  |  | } | 
| 2686 |  |  |  |  |  |  | else { | 
| 2687 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2688 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2689 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -x $fh; | 
| 2690 | 0 |  |  |  |  | 0 | close $fh; | 
| 2691 |  |  |  |  |  |  | } | 
| 2692 |  |  |  |  |  |  |  | 
| 2693 |  |  |  |  |  |  | # filename is not .COM .EXE .BAT .CMD | 
| 2694 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 2695 |  |  |  |  |  |  | } | 
| 2696 |  |  |  |  |  |  | } | 
| 2697 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2698 |  |  |  |  |  |  | } | 
| 2699 |  |  |  |  |  |  |  | 
| 2700 |  |  |  |  |  |  | # | 
| 2701 |  |  |  |  |  |  | # Big5-HKSCS file test -o expr | 
| 2702 |  |  |  |  |  |  | # | 
| 2703 |  |  |  |  |  |  | sub Ebig5hkscs::o(;*@) { | 
| 2704 |  |  |  |  |  |  |  | 
| 2705 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2706 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -o (Ebig5hkscs::o)' if @_ and not wantarray; | 
| 2707 |  |  |  |  |  |  |  | 
| 2708 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2709 | 0 | 0 |  |  |  | 0 | return wantarray ? (-o _,@_) : -o _; | 
| 2710 |  |  |  |  |  |  | } | 
| 2711 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2712 | 0 | 0 |  |  |  | 0 | return wantarray ? (-o $fh,@_) : -o $fh; | 
| 2713 |  |  |  |  |  |  | } | 
| 2714 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2715 | 0 | 0 |  |  |  | 0 | return wantarray ? (-o _,@_) : -o _; | 
| 2716 |  |  |  |  |  |  | } | 
| 2717 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2718 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2719 | 0 | 0 |  |  |  | 0 | return wantarray ? (-o _,@_) : -o _; | 
| 2720 |  |  |  |  |  |  | } | 
| 2721 |  |  |  |  |  |  | else { | 
| 2722 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2723 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2724 | 0 |  |  |  |  | 0 | my $o = -o $fh; | 
| 2725 | 0 |  |  |  |  | 0 | close $fh; | 
| 2726 | 0 | 0 |  |  |  | 0 | return wantarray ? ($o,@_) : $o; | 
| 2727 |  |  |  |  |  |  | } | 
| 2728 |  |  |  |  |  |  | } | 
| 2729 |  |  |  |  |  |  | } | 
| 2730 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2731 |  |  |  |  |  |  | } | 
| 2732 |  |  |  |  |  |  |  | 
| 2733 |  |  |  |  |  |  | # | 
| 2734 |  |  |  |  |  |  | # Big5-HKSCS file test -R expr | 
| 2735 |  |  |  |  |  |  | # | 
| 2736 |  |  |  |  |  |  | sub Ebig5hkscs::R(;*@) { | 
| 2737 |  |  |  |  |  |  |  | 
| 2738 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2739 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -R (Ebig5hkscs::R)' if @_ and not wantarray; | 
| 2740 |  |  |  |  |  |  |  | 
| 2741 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2742 | 0 | 0 |  |  |  | 0 | return wantarray ? (-R _,@_) : -R _; | 
| 2743 |  |  |  |  |  |  | } | 
| 2744 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2745 | 0 | 0 |  |  |  | 0 | return wantarray ? (-R $fh,@_) : -R $fh; | 
| 2746 |  |  |  |  |  |  | } | 
| 2747 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2748 | 0 | 0 |  |  |  | 0 | return wantarray ? (-R _,@_) : -R _; | 
| 2749 |  |  |  |  |  |  | } | 
| 2750 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2751 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2752 | 0 | 0 |  |  |  | 0 | return wantarray ? (-R _,@_) : -R _; | 
| 2753 |  |  |  |  |  |  | } | 
| 2754 |  |  |  |  |  |  | else { | 
| 2755 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2756 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2757 | 0 |  |  |  |  | 0 | my $R = -R $fh; | 
| 2758 | 0 |  |  |  |  | 0 | close $fh; | 
| 2759 | 0 | 0 |  |  |  | 0 | return wantarray ? ($R,@_) : $R; | 
| 2760 |  |  |  |  |  |  | } | 
| 2761 |  |  |  |  |  |  | } | 
| 2762 |  |  |  |  |  |  | } | 
| 2763 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2764 |  |  |  |  |  |  | } | 
| 2765 |  |  |  |  |  |  |  | 
| 2766 |  |  |  |  |  |  | # | 
| 2767 |  |  |  |  |  |  | # Big5-HKSCS file test -W expr | 
| 2768 |  |  |  |  |  |  | # | 
| 2769 |  |  |  |  |  |  | sub Ebig5hkscs::W(;*@) { | 
| 2770 |  |  |  |  |  |  |  | 
| 2771 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2772 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -W (Ebig5hkscs::W)' if @_ and not wantarray; | 
| 2773 |  |  |  |  |  |  |  | 
| 2774 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2775 | 0 | 0 |  |  |  | 0 | return wantarray ? (-W _,@_) : -W _; | 
| 2776 |  |  |  |  |  |  | } | 
| 2777 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2778 | 0 | 0 |  |  |  | 0 | return wantarray ? (-W $fh,@_) : -W $fh; | 
| 2779 |  |  |  |  |  |  | } | 
| 2780 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2781 | 0 | 0 |  |  |  | 0 | return wantarray ? (-W _,@_) : -W _; | 
| 2782 |  |  |  |  |  |  | } | 
| 2783 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2784 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2785 | 0 | 0 |  |  |  | 0 | return wantarray ? (-W _,@_) : -W _; | 
| 2786 |  |  |  |  |  |  | } | 
| 2787 |  |  |  |  |  |  | else { | 
| 2788 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2789 | 0 | 0 |  |  |  | 0 | if (_open_a($fh, $_)) { | 
| 2790 | 0 |  |  |  |  | 0 | my $W = -W $fh; | 
| 2791 | 0 |  |  |  |  | 0 | close $fh; | 
| 2792 | 0 | 0 |  |  |  | 0 | return wantarray ? ($W,@_) : $W; | 
| 2793 |  |  |  |  |  |  | } | 
| 2794 |  |  |  |  |  |  | } | 
| 2795 |  |  |  |  |  |  | } | 
| 2796 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2797 |  |  |  |  |  |  | } | 
| 2798 |  |  |  |  |  |  |  | 
| 2799 |  |  |  |  |  |  | # | 
| 2800 |  |  |  |  |  |  | # Big5-HKSCS file test -X expr | 
| 2801 |  |  |  |  |  |  | # | 
| 2802 |  |  |  |  |  |  | sub Ebig5hkscs::X(;*@) { | 
| 2803 |  |  |  |  |  |  |  | 
| 2804 | 0 | 0 |  | 0 | 1 | 0 | local $_ = shift if @_; | 
| 2805 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -X (Ebig5hkscs::X)' if @_ and not wantarray; | 
| 2806 |  |  |  |  |  |  |  | 
| 2807 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2808 | 0 | 0 |  |  |  | 0 | return wantarray ? (-X _,@_) : -X _; | 
| 2809 |  |  |  |  |  |  | } | 
| 2810 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2811 | 0 | 0 |  |  |  | 0 | return wantarray ? (-X $fh,@_) : -X $fh; | 
| 2812 |  |  |  |  |  |  | } | 
| 2813 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2814 | 0 | 0 |  |  |  | 0 | return wantarray ? (-X _,@_) : -X _; | 
| 2815 |  |  |  |  |  |  | } | 
| 2816 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2817 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2818 | 0 | 0 |  |  |  | 0 | return wantarray ? (-X _,@_) : -X _; | 
| 2819 |  |  |  |  |  |  | } | 
| 2820 |  |  |  |  |  |  | else { | 
| 2821 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2822 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2823 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -X $fh; | 
| 2824 | 0 |  |  |  |  | 0 | close $fh; | 
| 2825 |  |  |  |  |  |  | } | 
| 2826 |  |  |  |  |  |  |  | 
| 2827 |  |  |  |  |  |  | # filename is not .COM .EXE .BAT .CMD | 
| 2828 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 2829 |  |  |  |  |  |  | } | 
| 2830 |  |  |  |  |  |  | } | 
| 2831 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2832 |  |  |  |  |  |  | } | 
| 2833 |  |  |  |  |  |  |  | 
| 2834 |  |  |  |  |  |  | # | 
| 2835 |  |  |  |  |  |  | # Big5-HKSCS file test -O expr | 
| 2836 |  |  |  |  |  |  | # | 
| 2837 |  |  |  |  |  |  | sub Ebig5hkscs::O(;*@) { | 
| 2838 |  |  |  |  |  |  |  | 
| 2839 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2840 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -O (Ebig5hkscs::O)' if @_ and not wantarray; | 
| 2841 |  |  |  |  |  |  |  | 
| 2842 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2843 | 0 | 0 |  |  |  | 0 | return wantarray ? (-O _,@_) : -O _; | 
| 2844 |  |  |  |  |  |  | } | 
| 2845 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2846 | 0 | 0 |  |  |  | 0 | return wantarray ? (-O $fh,@_) : -O $fh; | 
| 2847 |  |  |  |  |  |  | } | 
| 2848 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2849 | 0 | 0 |  |  |  | 0 | return wantarray ? (-O _,@_) : -O _; | 
| 2850 |  |  |  |  |  |  | } | 
| 2851 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2852 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2853 | 0 | 0 |  |  |  | 0 | return wantarray ? (-O _,@_) : -O _; | 
| 2854 |  |  |  |  |  |  | } | 
| 2855 |  |  |  |  |  |  | else { | 
| 2856 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2857 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2858 | 0 |  |  |  |  | 0 | my $O = -O $fh; | 
| 2859 | 0 |  |  |  |  | 0 | close $fh; | 
| 2860 | 0 | 0 |  |  |  | 0 | return wantarray ? ($O,@_) : $O; | 
| 2861 |  |  |  |  |  |  | } | 
| 2862 |  |  |  |  |  |  | } | 
| 2863 |  |  |  |  |  |  | } | 
| 2864 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2865 |  |  |  |  |  |  | } | 
| 2866 |  |  |  |  |  |  |  | 
| 2867 |  |  |  |  |  |  | # | 
| 2868 |  |  |  |  |  |  | # Big5-HKSCS file test -e expr | 
| 2869 |  |  |  |  |  |  | # | 
| 2870 |  |  |  |  |  |  | sub Ebig5hkscs::e(;*@) { | 
| 2871 |  |  |  |  |  |  |  | 
| 2872 | 0 | 50 |  | 768 | 0 | 0 | local $_ = shift if @_; | 
| 2873 | 768 | 50 | 33 |  |  | 2911 | croak 'Too many arguments for -e (Ebig5hkscs::e)' if @_ and not wantarray; | 
| 2874 |  |  |  |  |  |  |  | 
| 2875 | 768 |  |  |  |  | 3062 | local $^W = 0; | 
| 2876 |  |  |  |  |  |  |  | 
| 2877 | 768 |  |  |  |  | 2588 | my $fh = qualify_to_ref $_; | 
| 2878 | 768 | 50 |  |  |  | 2113 | if ($_ eq '_') { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 2879 | 768 | 0 |  |  |  | 3939 | return wantarray ? (-e _,@_) : -e _; | 
| 2880 |  |  |  |  |  |  | } | 
| 2881 |  |  |  |  |  |  |  | 
| 2882 |  |  |  |  |  |  | # return false if directory handle | 
| 2883 |  |  |  |  |  |  | elsif (defined Ebig5hkscs::telldir($fh)) { | 
| 2884 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 2885 |  |  |  |  |  |  | } | 
| 2886 |  |  |  |  |  |  |  | 
| 2887 |  |  |  |  |  |  | # return true if file handle | 
| 2888 |  |  |  |  |  |  | elsif (defined fileno $fh) { | 
| 2889 | 0 | 0 |  |  |  | 0 | return wantarray ? (1,@_) : 1; | 
| 2890 |  |  |  |  |  |  | } | 
| 2891 |  |  |  |  |  |  |  | 
| 2892 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2893 | 0 | 0 |  |  |  | 0 | return wantarray ? (1,@_) : 1; | 
| 2894 |  |  |  |  |  |  | } | 
| 2895 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2896 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2897 | 0 | 0 |  |  |  | 0 | return wantarray ? (1,@_) : 1; | 
| 2898 |  |  |  |  |  |  | } | 
| 2899 |  |  |  |  |  |  | else { | 
| 2900 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2901 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2902 | 0 |  |  |  |  | 0 | my $e = -e $fh; | 
| 2903 | 0 |  |  |  |  | 0 | close $fh; | 
| 2904 | 0 | 0 |  |  |  | 0 | return wantarray ? ($e,@_) : $e; | 
| 2905 |  |  |  |  |  |  | } | 
| 2906 |  |  |  |  |  |  | } | 
| 2907 |  |  |  |  |  |  | } | 
| 2908 | 0 | 50 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2909 |  |  |  |  |  |  | } | 
| 2910 |  |  |  |  |  |  |  | 
| 2911 |  |  |  |  |  |  | # | 
| 2912 |  |  |  |  |  |  | # Big5-HKSCS file test -z expr | 
| 2913 |  |  |  |  |  |  | # | 
| 2914 |  |  |  |  |  |  | sub Ebig5hkscs::z(;*@) { | 
| 2915 |  |  |  |  |  |  |  | 
| 2916 | 768 | 0 |  | 0 | 0 | 4380 | local $_ = shift if @_; | 
| 2917 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -z (Ebig5hkscs::z)' if @_ and not wantarray; | 
| 2918 |  |  |  |  |  |  |  | 
| 2919 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2920 | 0 | 0 |  |  |  | 0 | return wantarray ? (-z _,@_) : -z _; | 
| 2921 |  |  |  |  |  |  | } | 
| 2922 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2923 | 0 | 0 |  |  |  | 0 | return wantarray ? (-z $fh,@_) : -z $fh; | 
| 2924 |  |  |  |  |  |  | } | 
| 2925 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2926 | 0 | 0 |  |  |  | 0 | return wantarray ? (-z _,@_) : -z _; | 
| 2927 |  |  |  |  |  |  | } | 
| 2928 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2929 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2930 | 0 | 0 |  |  |  | 0 | return wantarray ? (-z _,@_) : -z _; | 
| 2931 |  |  |  |  |  |  | } | 
| 2932 |  |  |  |  |  |  | else { | 
| 2933 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2934 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2935 | 0 |  |  |  |  | 0 | my $z = -z $fh; | 
| 2936 | 0 |  |  |  |  | 0 | close $fh; | 
| 2937 | 0 | 0 |  |  |  | 0 | return wantarray ? ($z,@_) : $z; | 
| 2938 |  |  |  |  |  |  | } | 
| 2939 |  |  |  |  |  |  | } | 
| 2940 |  |  |  |  |  |  | } | 
| 2941 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2942 |  |  |  |  |  |  | } | 
| 2943 |  |  |  |  |  |  |  | 
| 2944 |  |  |  |  |  |  | # | 
| 2945 |  |  |  |  |  |  | # Big5-HKSCS file test -s expr | 
| 2946 |  |  |  |  |  |  | # | 
| 2947 |  |  |  |  |  |  | sub Ebig5hkscs::s(;*@) { | 
| 2948 |  |  |  |  |  |  |  | 
| 2949 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2950 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -s (Ebig5hkscs::s)' if @_ and not wantarray; | 
| 2951 |  |  |  |  |  |  |  | 
| 2952 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2953 | 0 | 0 |  |  |  | 0 | return wantarray ? (-s _,@_) : -s _; | 
| 2954 |  |  |  |  |  |  | } | 
| 2955 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2956 | 0 | 0 |  |  |  | 0 | return wantarray ? (-s $fh,@_) : -s $fh; | 
| 2957 |  |  |  |  |  |  | } | 
| 2958 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2959 | 0 | 0 |  |  |  | 0 | return wantarray ? (-s _,@_) : -s _; | 
| 2960 |  |  |  |  |  |  | } | 
| 2961 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2962 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2963 | 0 | 0 |  |  |  | 0 | return wantarray ? (-s _,@_) : -s _; | 
| 2964 |  |  |  |  |  |  | } | 
| 2965 |  |  |  |  |  |  | else { | 
| 2966 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 2967 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 2968 | 0 |  |  |  |  | 0 | my $s = -s $fh; | 
| 2969 | 0 |  |  |  |  | 0 | close $fh; | 
| 2970 | 0 | 0 |  |  |  | 0 | return wantarray ? ($s,@_) : $s; | 
| 2971 |  |  |  |  |  |  | } | 
| 2972 |  |  |  |  |  |  | } | 
| 2973 |  |  |  |  |  |  | } | 
| 2974 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 2975 |  |  |  |  |  |  | } | 
| 2976 |  |  |  |  |  |  |  | 
| 2977 |  |  |  |  |  |  | # | 
| 2978 |  |  |  |  |  |  | # Big5-HKSCS file test -f expr | 
| 2979 |  |  |  |  |  |  | # | 
| 2980 |  |  |  |  |  |  | sub Ebig5hkscs::f(;*@) { | 
| 2981 |  |  |  |  |  |  |  | 
| 2982 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 2983 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -f (Ebig5hkscs::f)' if @_ and not wantarray; | 
| 2984 |  |  |  |  |  |  |  | 
| 2985 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2986 | 0 | 0 |  |  |  | 0 | return wantarray ? (-f _,@_) : -f _; | 
| 2987 |  |  |  |  |  |  | } | 
| 2988 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 2989 | 0 | 0 |  |  |  | 0 | return wantarray ? (-f $fh,@_) : -f $fh; | 
| 2990 |  |  |  |  |  |  | } | 
| 2991 |  |  |  |  |  |  | elsif (-e $_) { | 
| 2992 | 0 | 0 |  |  |  | 0 | return wantarray ? (-f _,@_) : -f _; | 
| 2993 |  |  |  |  |  |  | } | 
| 2994 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 2995 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 2996 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 2997 |  |  |  |  |  |  | } | 
| 2998 |  |  |  |  |  |  | else { | 
| 2999 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3000 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3001 | 0 |  |  |  |  | 0 | my $f = -f $fh; | 
| 3002 | 0 |  |  |  |  | 0 | close $fh; | 
| 3003 | 0 | 0 |  |  |  | 0 | return wantarray ? ($f,@_) : $f; | 
| 3004 |  |  |  |  |  |  | } | 
| 3005 |  |  |  |  |  |  | } | 
| 3006 |  |  |  |  |  |  | } | 
| 3007 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3008 |  |  |  |  |  |  | } | 
| 3009 |  |  |  |  |  |  |  | 
| 3010 |  |  |  |  |  |  | # | 
| 3011 |  |  |  |  |  |  | # Big5-HKSCS file test -d expr | 
| 3012 |  |  |  |  |  |  | # | 
| 3013 |  |  |  |  |  |  | sub Ebig5hkscs::d(;*@) { | 
| 3014 |  |  |  |  |  |  |  | 
| 3015 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3016 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -d (Ebig5hkscs::d)' if @_ and not wantarray; | 
| 3017 |  |  |  |  |  |  |  | 
| 3018 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3019 | 0 | 0 |  |  |  | 0 | return wantarray ? (-d _,@_) : -d _; | 
| 3020 |  |  |  |  |  |  | } | 
| 3021 |  |  |  |  |  |  |  | 
| 3022 |  |  |  |  |  |  | # return false if file handle or directory handle | 
| 3023 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3024 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 3025 |  |  |  |  |  |  | } | 
| 3026 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3027 | 0 | 0 |  |  |  | 0 | return wantarray ? (-d _,@_) : -d _; | 
| 3028 |  |  |  |  |  |  | } | 
| 3029 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3030 | 0 | 0 |  |  |  | 0 | return wantarray ? (-d "$_/.",@_) : -d "$_/."; | 
| 3031 |  |  |  |  |  |  | } | 
| 3032 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3033 |  |  |  |  |  |  | } | 
| 3034 |  |  |  |  |  |  |  | 
| 3035 |  |  |  |  |  |  | # | 
| 3036 |  |  |  |  |  |  | # Big5-HKSCS file test -l expr | 
| 3037 |  |  |  |  |  |  | # | 
| 3038 |  |  |  |  |  |  | sub Ebig5hkscs::l(;*@) { | 
| 3039 |  |  |  |  |  |  |  | 
| 3040 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3041 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -l (Ebig5hkscs::l)' if @_ and not wantarray; | 
| 3042 |  |  |  |  |  |  |  | 
| 3043 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3044 | 0 | 0 |  |  |  | 0 | return wantarray ? (-l _,@_) : -l _; | 
| 3045 |  |  |  |  |  |  | } | 
| 3046 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3047 | 0 | 0 |  |  |  | 0 | return wantarray ? (-l $fh,@_) : -l $fh; | 
| 3048 |  |  |  |  |  |  | } | 
| 3049 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3050 | 0 | 0 |  |  |  | 0 | return wantarray ? (-l _,@_) : -l _; | 
| 3051 |  |  |  |  |  |  | } | 
| 3052 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3053 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3054 | 0 | 0 |  |  |  | 0 | return wantarray ? (-l _,@_) : -l _; | 
| 3055 |  |  |  |  |  |  | } | 
| 3056 |  |  |  |  |  |  | else { | 
| 3057 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3058 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3059 | 0 |  |  |  |  | 0 | my $l = -l $fh; | 
| 3060 | 0 |  |  |  |  | 0 | close $fh; | 
| 3061 | 0 | 0 |  |  |  | 0 | return wantarray ? ($l,@_) : $l; | 
| 3062 |  |  |  |  |  |  | } | 
| 3063 |  |  |  |  |  |  | } | 
| 3064 |  |  |  |  |  |  | } | 
| 3065 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3066 |  |  |  |  |  |  | } | 
| 3067 |  |  |  |  |  |  |  | 
| 3068 |  |  |  |  |  |  | # | 
| 3069 |  |  |  |  |  |  | # Big5-HKSCS file test -p expr | 
| 3070 |  |  |  |  |  |  | # | 
| 3071 |  |  |  |  |  |  | sub Ebig5hkscs::p(;*@) { | 
| 3072 |  |  |  |  |  |  |  | 
| 3073 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3074 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -p (Ebig5hkscs::p)' if @_ and not wantarray; | 
| 3075 |  |  |  |  |  |  |  | 
| 3076 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3077 | 0 | 0 |  |  |  | 0 | return wantarray ? (-p _,@_) : -p _; | 
| 3078 |  |  |  |  |  |  | } | 
| 3079 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3080 | 0 | 0 |  |  |  | 0 | return wantarray ? (-p $fh,@_) : -p $fh; | 
| 3081 |  |  |  |  |  |  | } | 
| 3082 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3083 | 0 | 0 |  |  |  | 0 | return wantarray ? (-p _,@_) : -p _; | 
| 3084 |  |  |  |  |  |  | } | 
| 3085 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3086 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3087 | 0 | 0 |  |  |  | 0 | return wantarray ? (-p _,@_) : -p _; | 
| 3088 |  |  |  |  |  |  | } | 
| 3089 |  |  |  |  |  |  | else { | 
| 3090 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3091 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3092 | 0 |  |  |  |  | 0 | my $p = -p $fh; | 
| 3093 | 0 |  |  |  |  | 0 | close $fh; | 
| 3094 | 0 | 0 |  |  |  | 0 | return wantarray ? ($p,@_) : $p; | 
| 3095 |  |  |  |  |  |  | } | 
| 3096 |  |  |  |  |  |  | } | 
| 3097 |  |  |  |  |  |  | } | 
| 3098 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3099 |  |  |  |  |  |  | } | 
| 3100 |  |  |  |  |  |  |  | 
| 3101 |  |  |  |  |  |  | # | 
| 3102 |  |  |  |  |  |  | # Big5-HKSCS file test -S expr | 
| 3103 |  |  |  |  |  |  | # | 
| 3104 |  |  |  |  |  |  | sub Ebig5hkscs::S(;*@) { | 
| 3105 |  |  |  |  |  |  |  | 
| 3106 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3107 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -S (Ebig5hkscs::S)' if @_ and not wantarray; | 
| 3108 |  |  |  |  |  |  |  | 
| 3109 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3110 | 0 | 0 |  |  |  | 0 | return wantarray ? (-S _,@_) : -S _; | 
| 3111 |  |  |  |  |  |  | } | 
| 3112 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3113 | 0 | 0 |  |  |  | 0 | return wantarray ? (-S $fh,@_) : -S $fh; | 
| 3114 |  |  |  |  |  |  | } | 
| 3115 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3116 | 0 | 0 |  |  |  | 0 | return wantarray ? (-S _,@_) : -S _; | 
| 3117 |  |  |  |  |  |  | } | 
| 3118 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3119 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3120 | 0 | 0 |  |  |  | 0 | return wantarray ? (-S _,@_) : -S _; | 
| 3121 |  |  |  |  |  |  | } | 
| 3122 |  |  |  |  |  |  | else { | 
| 3123 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3124 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3125 | 0 |  |  |  |  | 0 | my $S = -S $fh; | 
| 3126 | 0 |  |  |  |  | 0 | close $fh; | 
| 3127 | 0 | 0 |  |  |  | 0 | return wantarray ? ($S,@_) : $S; | 
| 3128 |  |  |  |  |  |  | } | 
| 3129 |  |  |  |  |  |  | } | 
| 3130 |  |  |  |  |  |  | } | 
| 3131 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3132 |  |  |  |  |  |  | } | 
| 3133 |  |  |  |  |  |  |  | 
| 3134 |  |  |  |  |  |  | # | 
| 3135 |  |  |  |  |  |  | # Big5-HKSCS file test -b expr | 
| 3136 |  |  |  |  |  |  | # | 
| 3137 |  |  |  |  |  |  | sub Ebig5hkscs::b(;*@) { | 
| 3138 |  |  |  |  |  |  |  | 
| 3139 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3140 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -b (Ebig5hkscs::b)' if @_ and not wantarray; | 
| 3141 |  |  |  |  |  |  |  | 
| 3142 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3143 | 0 | 0 |  |  |  | 0 | return wantarray ? (-b _,@_) : -b _; | 
| 3144 |  |  |  |  |  |  | } | 
| 3145 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3146 | 0 | 0 |  |  |  | 0 | return wantarray ? (-b $fh,@_) : -b $fh; | 
| 3147 |  |  |  |  |  |  | } | 
| 3148 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3149 | 0 | 0 |  |  |  | 0 | return wantarray ? (-b _,@_) : -b _; | 
| 3150 |  |  |  |  |  |  | } | 
| 3151 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3152 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3153 | 0 | 0 |  |  |  | 0 | return wantarray ? (-b _,@_) : -b _; | 
| 3154 |  |  |  |  |  |  | } | 
| 3155 |  |  |  |  |  |  | else { | 
| 3156 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3157 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3158 | 0 |  |  |  |  | 0 | my $b = -b $fh; | 
| 3159 | 0 |  |  |  |  | 0 | close $fh; | 
| 3160 | 0 | 0 |  |  |  | 0 | return wantarray ? ($b,@_) : $b; | 
| 3161 |  |  |  |  |  |  | } | 
| 3162 |  |  |  |  |  |  | } | 
| 3163 |  |  |  |  |  |  | } | 
| 3164 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3165 |  |  |  |  |  |  | } | 
| 3166 |  |  |  |  |  |  |  | 
| 3167 |  |  |  |  |  |  | # | 
| 3168 |  |  |  |  |  |  | # Big5-HKSCS file test -c expr | 
| 3169 |  |  |  |  |  |  | # | 
| 3170 |  |  |  |  |  |  | sub Ebig5hkscs::c(;*@) { | 
| 3171 |  |  |  |  |  |  |  | 
| 3172 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3173 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -c (Ebig5hkscs::c)' if @_ and not wantarray; | 
| 3174 |  |  |  |  |  |  |  | 
| 3175 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3176 | 0 | 0 |  |  |  | 0 | return wantarray ? (-c _,@_) : -c _; | 
| 3177 |  |  |  |  |  |  | } | 
| 3178 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3179 | 0 | 0 |  |  |  | 0 | return wantarray ? (-c $fh,@_) : -c $fh; | 
| 3180 |  |  |  |  |  |  | } | 
| 3181 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3182 | 0 | 0 |  |  |  | 0 | return wantarray ? (-c _,@_) : -c _; | 
| 3183 |  |  |  |  |  |  | } | 
| 3184 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3185 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3186 | 0 | 0 |  |  |  | 0 | return wantarray ? (-c _,@_) : -c _; | 
| 3187 |  |  |  |  |  |  | } | 
| 3188 |  |  |  |  |  |  | else { | 
| 3189 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3190 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3191 | 0 |  |  |  |  | 0 | my $c = -c $fh; | 
| 3192 | 0 |  |  |  |  | 0 | close $fh; | 
| 3193 | 0 | 0 |  |  |  | 0 | return wantarray ? ($c,@_) : $c; | 
| 3194 |  |  |  |  |  |  | } | 
| 3195 |  |  |  |  |  |  | } | 
| 3196 |  |  |  |  |  |  | } | 
| 3197 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3198 |  |  |  |  |  |  | } | 
| 3199 |  |  |  |  |  |  |  | 
| 3200 |  |  |  |  |  |  | # | 
| 3201 |  |  |  |  |  |  | # Big5-HKSCS file test -u expr | 
| 3202 |  |  |  |  |  |  | # | 
| 3203 |  |  |  |  |  |  | sub Ebig5hkscs::u(;*@) { | 
| 3204 |  |  |  |  |  |  |  | 
| 3205 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3206 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -u (Ebig5hkscs::u)' if @_ and not wantarray; | 
| 3207 |  |  |  |  |  |  |  | 
| 3208 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3209 | 0 | 0 |  |  |  | 0 | return wantarray ? (-u _,@_) : -u _; | 
| 3210 |  |  |  |  |  |  | } | 
| 3211 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3212 | 0 | 0 |  |  |  | 0 | return wantarray ? (-u $fh,@_) : -u $fh; | 
| 3213 |  |  |  |  |  |  | } | 
| 3214 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3215 | 0 | 0 |  |  |  | 0 | return wantarray ? (-u _,@_) : -u _; | 
| 3216 |  |  |  |  |  |  | } | 
| 3217 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3218 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3219 | 0 | 0 |  |  |  | 0 | return wantarray ? (-u _,@_) : -u _; | 
| 3220 |  |  |  |  |  |  | } | 
| 3221 |  |  |  |  |  |  | else { | 
| 3222 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3223 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3224 | 0 |  |  |  |  | 0 | my $u = -u $fh; | 
| 3225 | 0 |  |  |  |  | 0 | close $fh; | 
| 3226 | 0 | 0 |  |  |  | 0 | return wantarray ? ($u,@_) : $u; | 
| 3227 |  |  |  |  |  |  | } | 
| 3228 |  |  |  |  |  |  | } | 
| 3229 |  |  |  |  |  |  | } | 
| 3230 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3231 |  |  |  |  |  |  | } | 
| 3232 |  |  |  |  |  |  |  | 
| 3233 |  |  |  |  |  |  | # | 
| 3234 |  |  |  |  |  |  | # Big5-HKSCS file test -g expr | 
| 3235 |  |  |  |  |  |  | # | 
| 3236 |  |  |  |  |  |  | sub Ebig5hkscs::g(;*@) { | 
| 3237 |  |  |  |  |  |  |  | 
| 3238 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3239 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -g (Ebig5hkscs::g)' if @_ and not wantarray; | 
| 3240 |  |  |  |  |  |  |  | 
| 3241 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3242 | 0 | 0 |  |  |  | 0 | return wantarray ? (-g _,@_) : -g _; | 
| 3243 |  |  |  |  |  |  | } | 
| 3244 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3245 | 0 | 0 |  |  |  | 0 | return wantarray ? (-g $fh,@_) : -g $fh; | 
| 3246 |  |  |  |  |  |  | } | 
| 3247 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3248 | 0 | 0 |  |  |  | 0 | return wantarray ? (-g _,@_) : -g _; | 
| 3249 |  |  |  |  |  |  | } | 
| 3250 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3251 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3252 | 0 | 0 |  |  |  | 0 | return wantarray ? (-g _,@_) : -g _; | 
| 3253 |  |  |  |  |  |  | } | 
| 3254 |  |  |  |  |  |  | else { | 
| 3255 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3256 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3257 | 0 |  |  |  |  | 0 | my $g = -g $fh; | 
| 3258 | 0 |  |  |  |  | 0 | close $fh; | 
| 3259 | 0 | 0 |  |  |  | 0 | return wantarray ? ($g,@_) : $g; | 
| 3260 |  |  |  |  |  |  | } | 
| 3261 |  |  |  |  |  |  | } | 
| 3262 |  |  |  |  |  |  | } | 
| 3263 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3264 |  |  |  |  |  |  | } | 
| 3265 |  |  |  |  |  |  |  | 
| 3266 |  |  |  |  |  |  | # | 
| 3267 |  |  |  |  |  |  | # Big5-HKSCS file test -k expr | 
| 3268 |  |  |  |  |  |  | # | 
| 3269 |  |  |  |  |  |  | sub Ebig5hkscs::k(;*@) { | 
| 3270 |  |  |  |  |  |  |  | 
| 3271 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3272 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -k (Ebig5hkscs::k)' if @_ and not wantarray; | 
| 3273 |  |  |  |  |  |  |  | 
| 3274 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3275 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 3276 |  |  |  |  |  |  | } | 
| 3277 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3278 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 3279 |  |  |  |  |  |  | } | 
| 3280 |  |  |  |  |  |  | elsif ($] =~ /^5\.008/oxms) { | 
| 3281 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 3282 |  |  |  |  |  |  | } | 
| 3283 | 0 | 0 |  |  |  | 0 | return wantarray ? ($_,@_) : $_; | 
| 3284 |  |  |  |  |  |  | } | 
| 3285 |  |  |  |  |  |  |  | 
| 3286 |  |  |  |  |  |  | # | 
| 3287 |  |  |  |  |  |  | # Big5-HKSCS file test -T expr | 
| 3288 |  |  |  |  |  |  | # | 
| 3289 |  |  |  |  |  |  | sub Ebig5hkscs::T(;*@) { | 
| 3290 |  |  |  |  |  |  |  | 
| 3291 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3292 |  |  |  |  |  |  |  | 
| 3293 |  |  |  |  |  |  | # Use of croak without parentheses makes die on Strawberry Perl 5.008 and 5.010, like: | 
| 3294 |  |  |  |  |  |  | #     croak 'Too many arguments for -T (Ebig5hkscs::T)'; | 
| 3295 |  |  |  |  |  |  | # Must be used by parentheses like: | 
| 3296 |  |  |  |  |  |  | #     croak('Too many arguments for -T (Ebig5hkscs::T)'); | 
| 3297 |  |  |  |  |  |  |  | 
| 3298 | 0 | 0 | 0 |  |  | 0 | if (@_ and not wantarray) { | 
| 3299 | 0 |  |  |  |  | 0 | croak('Too many arguments for -T (Ebig5hkscs::T)'); | 
| 3300 |  |  |  |  |  |  | } | 
| 3301 |  |  |  |  |  |  |  | 
| 3302 | 0 |  |  |  |  | 0 | my $T = 1; | 
| 3303 |  |  |  |  |  |  |  | 
| 3304 | 0 |  |  |  |  | 0 | my $fh = qualify_to_ref $_; | 
| 3305 | 0 | 0 |  |  |  | 0 | if (defined fileno $fh) { | 
| 3306 |  |  |  |  |  |  |  | 
| 3307 | 0 | 0 |  |  |  | 0 | if (defined Ebig5hkscs::telldir($fh)) { | 
| 3308 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3309 |  |  |  |  |  |  | } | 
| 3310 |  |  |  |  |  |  |  | 
| 3311 |  |  |  |  |  |  | # P.813 29.2.176. tell | 
| 3312 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 3313 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 3314 |  |  |  |  |  |  |  | 
| 3315 |  |  |  |  |  |  | # P.970 tell | 
| 3316 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 3317 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 3318 |  |  |  |  |  |  |  | 
| 3319 |  |  |  |  |  |  | # (and so on) | 
| 3320 |  |  |  |  |  |  |  | 
| 3321 | 0 |  |  |  |  | 0 | my $systell = sysseek $fh, 0, 1; | 
| 3322 |  |  |  |  |  |  |  | 
| 3323 | 0 | 0 |  |  |  | 0 | if (sysread $fh, my $block, 512) { | 
| 3324 |  |  |  |  |  |  |  | 
| 3325 |  |  |  |  |  |  | # P.163 Binary file check in Little Perl Parlor 16 | 
| 3326 |  |  |  |  |  |  | # of Book No. T1008901080816 ZASSHI 08901-8 UNIX MAGAZINE 1993 Aug VOL8#8 | 
| 3327 |  |  |  |  |  |  | # (and so on) | 
| 3328 |  |  |  |  |  |  |  | 
| 3329 | 0 | 0 |  |  |  | 0 | if ($block =~ /[\000\377]/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 3330 | 0 |  |  |  |  | 0 | $T = ''; | 
| 3331 |  |  |  |  |  |  | } | 
| 3332 |  |  |  |  |  |  | elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) { | 
| 3333 | 0 |  |  |  |  | 0 | $T = ''; | 
| 3334 |  |  |  |  |  |  | } | 
| 3335 |  |  |  |  |  |  | } | 
| 3336 |  |  |  |  |  |  |  | 
| 3337 |  |  |  |  |  |  | # 0 byte or eof | 
| 3338 |  |  |  |  |  |  | else { | 
| 3339 | 0 |  |  |  |  | 0 | $T = 1; | 
| 3340 |  |  |  |  |  |  | } | 
| 3341 |  |  |  |  |  |  |  | 
| 3342 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -T $fh; | 
| 3343 | 0 |  |  |  |  | 0 | sysseek $fh, $systell, 0; | 
| 3344 |  |  |  |  |  |  | } | 
| 3345 |  |  |  |  |  |  | else { | 
| 3346 | 0 | 0 | 0 |  |  | 0 | if (-d $_ or -d "$_/.") { | 
| 3347 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3348 |  |  |  |  |  |  | } | 
| 3349 |  |  |  |  |  |  |  | 
| 3350 | 0 |  |  |  |  | 0 | $fh = gensym(); | 
| 3351 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3352 |  |  |  |  |  |  | } | 
| 3353 |  |  |  |  |  |  | else { | 
| 3354 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3355 |  |  |  |  |  |  | } | 
| 3356 | 0 | 0 |  |  |  | 0 | if (sysread $fh, my $block, 512) { | 
| 3357 | 0 | 0 |  |  |  | 0 | if ($block =~ /[\000\377]/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 3358 | 0 |  |  |  |  | 0 | $T = ''; | 
| 3359 |  |  |  |  |  |  | } | 
| 3360 |  |  |  |  |  |  | elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) { | 
| 3361 | 0 |  |  |  |  | 0 | $T = ''; | 
| 3362 |  |  |  |  |  |  | } | 
| 3363 |  |  |  |  |  |  | } | 
| 3364 |  |  |  |  |  |  |  | 
| 3365 |  |  |  |  |  |  | # 0 byte or eof | 
| 3366 |  |  |  |  |  |  | else { | 
| 3367 | 0 |  |  |  |  | 0 | $T = 1; | 
| 3368 |  |  |  |  |  |  | } | 
| 3369 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -T $fh; | 
| 3370 | 0 |  |  |  |  | 0 | close $fh; | 
| 3371 |  |  |  |  |  |  | } | 
| 3372 |  |  |  |  |  |  |  | 
| 3373 | 0 | 0 |  |  |  | 0 | return wantarray ? ($T,@_) : $T; | 
| 3374 |  |  |  |  |  |  | } | 
| 3375 |  |  |  |  |  |  |  | 
| 3376 |  |  |  |  |  |  | # | 
| 3377 |  |  |  |  |  |  | # Big5-HKSCS file test -B expr | 
| 3378 |  |  |  |  |  |  | # | 
| 3379 |  |  |  |  |  |  | sub Ebig5hkscs::B(;*@) { | 
| 3380 |  |  |  |  |  |  |  | 
| 3381 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3382 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -B (Ebig5hkscs::B)' if @_ and not wantarray; | 
| 3383 | 0 |  |  |  |  | 0 | my $B = ''; | 
| 3384 |  |  |  |  |  |  |  | 
| 3385 | 0 |  |  |  |  | 0 | my $fh = qualify_to_ref $_; | 
| 3386 | 0 | 0 |  |  |  | 0 | if (defined fileno $fh) { | 
| 3387 |  |  |  |  |  |  |  | 
| 3388 | 0 | 0 |  |  |  | 0 | if (defined Ebig5hkscs::telldir($fh)) { | 
| 3389 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3390 |  |  |  |  |  |  | } | 
| 3391 |  |  |  |  |  |  |  | 
| 3392 | 0 |  |  |  |  | 0 | my $systell = sysseek $fh, 0, 1; | 
| 3393 |  |  |  |  |  |  |  | 
| 3394 | 0 | 0 |  |  |  | 0 | if (sysread $fh, my $block, 512) { | 
| 3395 | 0 | 0 |  |  |  | 0 | if ($block =~ /[\000\377]/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 3396 | 0 |  |  |  |  | 0 | $B = 1; | 
| 3397 |  |  |  |  |  |  | } | 
| 3398 |  |  |  |  |  |  | elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) { | 
| 3399 | 0 |  |  |  |  | 0 | $B = 1; | 
| 3400 |  |  |  |  |  |  | } | 
| 3401 |  |  |  |  |  |  | } | 
| 3402 |  |  |  |  |  |  |  | 
| 3403 |  |  |  |  |  |  | # 0 byte or eof | 
| 3404 |  |  |  |  |  |  | else { | 
| 3405 | 0 |  |  |  |  | 0 | $B = 1; | 
| 3406 |  |  |  |  |  |  | } | 
| 3407 |  |  |  |  |  |  |  | 
| 3408 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -B $fh; | 
| 3409 | 0 |  |  |  |  | 0 | sysseek $fh, $systell, 0; | 
| 3410 |  |  |  |  |  |  | } | 
| 3411 |  |  |  |  |  |  | else { | 
| 3412 | 0 | 0 | 0 |  |  | 0 | if (-d $_ or -d "$_/.") { | 
| 3413 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3414 |  |  |  |  |  |  | } | 
| 3415 |  |  |  |  |  |  |  | 
| 3416 | 0 |  |  |  |  | 0 | $fh = gensym(); | 
| 3417 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3418 |  |  |  |  |  |  | } | 
| 3419 |  |  |  |  |  |  | else { | 
| 3420 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3421 |  |  |  |  |  |  | } | 
| 3422 | 0 | 0 |  |  |  | 0 | if (sysread $fh, my $block, 512) { | 
| 3423 | 0 | 0 |  |  |  | 0 | if ($block =~ /[\000\377]/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 3424 | 0 |  |  |  |  | 0 | $B = 1; | 
| 3425 |  |  |  |  |  |  | } | 
| 3426 |  |  |  |  |  |  | elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) { | 
| 3427 | 0 |  |  |  |  | 0 | $B = 1; | 
| 3428 |  |  |  |  |  |  | } | 
| 3429 |  |  |  |  |  |  | } | 
| 3430 |  |  |  |  |  |  |  | 
| 3431 |  |  |  |  |  |  | # 0 byte or eof | 
| 3432 |  |  |  |  |  |  | else { | 
| 3433 | 0 |  |  |  |  | 0 | $B = 1; | 
| 3434 |  |  |  |  |  |  | } | 
| 3435 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -B $fh; | 
| 3436 | 0 |  |  |  |  | 0 | close $fh; | 
| 3437 |  |  |  |  |  |  | } | 
| 3438 |  |  |  |  |  |  |  | 
| 3439 | 0 | 0 |  |  |  | 0 | return wantarray ? ($B,@_) : $B; | 
| 3440 |  |  |  |  |  |  | } | 
| 3441 |  |  |  |  |  |  |  | 
| 3442 |  |  |  |  |  |  | # | 
| 3443 |  |  |  |  |  |  | # Big5-HKSCS file test -M expr | 
| 3444 |  |  |  |  |  |  | # | 
| 3445 |  |  |  |  |  |  | sub Ebig5hkscs::M(;*@) { | 
| 3446 |  |  |  |  |  |  |  | 
| 3447 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3448 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -M (Ebig5hkscs::M)' if @_ and not wantarray; | 
| 3449 |  |  |  |  |  |  |  | 
| 3450 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3451 | 0 | 0 |  |  |  | 0 | return wantarray ? (-M _,@_) : -M _; | 
| 3452 |  |  |  |  |  |  | } | 
| 3453 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3454 | 0 | 0 |  |  |  | 0 | return wantarray ? (-M $fh,@_) : -M $fh; | 
| 3455 |  |  |  |  |  |  | } | 
| 3456 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3457 | 0 | 0 |  |  |  | 0 | return wantarray ? (-M _,@_) : -M _; | 
| 3458 |  |  |  |  |  |  | } | 
| 3459 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3460 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3461 | 0 | 0 |  |  |  | 0 | return wantarray ? (-M _,@_) : -M _; | 
| 3462 |  |  |  |  |  |  | } | 
| 3463 |  |  |  |  |  |  | else { | 
| 3464 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3465 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3466 | 0 |  |  |  |  | 0 | my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh; | 
| 3467 | 0 |  |  |  |  | 0 | close $fh; | 
| 3468 | 0 |  |  |  |  | 0 | my $M = ($^T - $mtime) / (24*60*60); | 
| 3469 | 0 | 0 |  |  |  | 0 | return wantarray ? ($M,@_) : $M; | 
| 3470 |  |  |  |  |  |  | } | 
| 3471 |  |  |  |  |  |  | } | 
| 3472 |  |  |  |  |  |  | } | 
| 3473 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3474 |  |  |  |  |  |  | } | 
| 3475 |  |  |  |  |  |  |  | 
| 3476 |  |  |  |  |  |  | # | 
| 3477 |  |  |  |  |  |  | # Big5-HKSCS file test -A expr | 
| 3478 |  |  |  |  |  |  | # | 
| 3479 |  |  |  |  |  |  | sub Ebig5hkscs::A(;*@) { | 
| 3480 |  |  |  |  |  |  |  | 
| 3481 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3482 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -A (Ebig5hkscs::A)' if @_ and not wantarray; | 
| 3483 |  |  |  |  |  |  |  | 
| 3484 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3485 | 0 | 0 |  |  |  | 0 | return wantarray ? (-A _,@_) : -A _; | 
| 3486 |  |  |  |  |  |  | } | 
| 3487 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3488 | 0 | 0 |  |  |  | 0 | return wantarray ? (-A $fh,@_) : -A $fh; | 
| 3489 |  |  |  |  |  |  | } | 
| 3490 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3491 | 0 | 0 |  |  |  | 0 | return wantarray ? (-A _,@_) : -A _; | 
| 3492 |  |  |  |  |  |  | } | 
| 3493 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3494 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3495 | 0 | 0 |  |  |  | 0 | return wantarray ? (-A _,@_) : -A _; | 
| 3496 |  |  |  |  |  |  | } | 
| 3497 |  |  |  |  |  |  | else { | 
| 3498 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3499 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3500 | 0 |  |  |  |  | 0 | my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh; | 
| 3501 | 0 |  |  |  |  | 0 | close $fh; | 
| 3502 | 0 |  |  |  |  | 0 | my $A = ($^T - $atime) / (24*60*60); | 
| 3503 | 0 | 0 |  |  |  | 0 | return wantarray ? ($A,@_) : $A; | 
| 3504 |  |  |  |  |  |  | } | 
| 3505 |  |  |  |  |  |  | } | 
| 3506 |  |  |  |  |  |  | } | 
| 3507 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3508 |  |  |  |  |  |  | } | 
| 3509 |  |  |  |  |  |  |  | 
| 3510 |  |  |  |  |  |  | # | 
| 3511 |  |  |  |  |  |  | # Big5-HKSCS file test -C expr | 
| 3512 |  |  |  |  |  |  | # | 
| 3513 |  |  |  |  |  |  | sub Ebig5hkscs::C(;*@) { | 
| 3514 |  |  |  |  |  |  |  | 
| 3515 | 0 | 0 |  | 0 | 0 | 0 | local $_ = shift if @_; | 
| 3516 | 0 | 0 | 0 |  |  | 0 | croak 'Too many arguments for -C (Ebig5hkscs::C)' if @_ and not wantarray; | 
| 3517 |  |  |  |  |  |  |  | 
| 3518 | 0 | 0 |  |  |  | 0 | if ($_ eq '_') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3519 | 0 | 0 |  |  |  | 0 | return wantarray ? (-C _,@_) : -C _; | 
| 3520 |  |  |  |  |  |  | } | 
| 3521 |  |  |  |  |  |  | elsif (defined fileno(my $fh = qualify_to_ref $_)) { | 
| 3522 | 0 | 0 |  |  |  | 0 | return wantarray ? (-C $fh,@_) : -C $fh; | 
| 3523 |  |  |  |  |  |  | } | 
| 3524 |  |  |  |  |  |  | elsif (-e $_) { | 
| 3525 | 0 | 0 |  |  |  | 0 | return wantarray ? (-C _,@_) : -C _; | 
| 3526 |  |  |  |  |  |  | } | 
| 3527 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3528 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3529 | 0 | 0 |  |  |  | 0 | return wantarray ? (-C _,@_) : -C _; | 
| 3530 |  |  |  |  |  |  | } | 
| 3531 |  |  |  |  |  |  | else { | 
| 3532 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3533 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3534 | 0 |  |  |  |  | 0 | my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh; | 
| 3535 | 0 |  |  |  |  | 0 | close $fh; | 
| 3536 | 0 |  |  |  |  | 0 | my $C = ($^T - $ctime) / (24*60*60); | 
| 3537 | 0 | 0 |  |  |  | 0 | return wantarray ? ($C,@_) : $C; | 
| 3538 |  |  |  |  |  |  | } | 
| 3539 |  |  |  |  |  |  | } | 
| 3540 |  |  |  |  |  |  | } | 
| 3541 | 0 | 0 |  |  |  | 0 | return wantarray ? (undef,@_) : undef; | 
| 3542 |  |  |  |  |  |  | } | 
| 3543 |  |  |  |  |  |  |  | 
| 3544 |  |  |  |  |  |  | # | 
| 3545 |  |  |  |  |  |  | # Big5-HKSCS stacked file test $_ | 
| 3546 |  |  |  |  |  |  | # | 
| 3547 |  |  |  |  |  |  | sub Ebig5hkscs::filetest_ { | 
| 3548 |  |  |  |  |  |  |  | 
| 3549 | 0 |  |  | 0 | 0 | 0 | my $filetest = substr(pop @_, 1); | 
| 3550 |  |  |  |  |  |  |  | 
| 3551 | 0 | 0 |  |  |  | 0 | unless (CORE::eval qq{Ebig5hkscs::${filetest}_}) { | 
| 3552 | 0 |  |  |  |  | 0 | return ''; | 
| 3553 |  |  |  |  |  |  | } | 
| 3554 | 0 |  |  |  |  | 0 | for my $filetest (CORE::reverse @_) { | 
| 3555 | 0 | 0 |  |  |  | 0 | unless (CORE::eval qq{ $filetest _ }) { | 
| 3556 | 0 |  |  |  |  | 0 | return ''; | 
| 3557 |  |  |  |  |  |  | } | 
| 3558 |  |  |  |  |  |  | } | 
| 3559 | 0 |  |  |  |  | 0 | return 1; | 
| 3560 |  |  |  |  |  |  | } | 
| 3561 |  |  |  |  |  |  |  | 
| 3562 |  |  |  |  |  |  | # | 
| 3563 |  |  |  |  |  |  | # Big5-HKSCS file test -r $_ | 
| 3564 |  |  |  |  |  |  | # | 
| 3565 |  |  |  |  |  |  | sub Ebig5hkscs::r_() { | 
| 3566 |  |  |  |  |  |  |  | 
| 3567 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3568 | 0 | 0 |  |  |  | 0 | return -r _ ? 1 : ''; | 
| 3569 |  |  |  |  |  |  | } | 
| 3570 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3571 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3572 | 0 | 0 |  |  |  | 0 | return -r _ ? 1 : ''; | 
| 3573 |  |  |  |  |  |  | } | 
| 3574 |  |  |  |  |  |  | else { | 
| 3575 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3576 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3577 | 0 |  |  |  |  | 0 | my $r = -r $fh; | 
| 3578 | 0 |  |  |  |  | 0 | close $fh; | 
| 3579 | 0 | 0 |  |  |  | 0 | return $r ? 1 : ''; | 
| 3580 |  |  |  |  |  |  | } | 
| 3581 |  |  |  |  |  |  | } | 
| 3582 |  |  |  |  |  |  | } | 
| 3583 |  |  |  |  |  |  |  | 
| 3584 |  |  |  |  |  |  | # 10.10. Returning Failure | 
| 3585 |  |  |  |  |  |  | # in Chapter 10. Subroutines | 
| 3586 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 3587 |  |  |  |  |  |  | # (and so on) | 
| 3588 |  |  |  |  |  |  |  | 
| 3589 |  |  |  |  |  |  | # 2010-01-26 The difference of "return;" and "return undef;" | 
| 3590 |  |  |  |  |  |  | # http://d.hatena.ne.jp/gfx/20100126/1264474754 | 
| 3591 |  |  |  |  |  |  | # | 
| 3592 |  |  |  |  |  |  | # "Perl Best Practices" recommends to use "return;"*1 to return nothing, but | 
| 3593 |  |  |  |  |  |  | # it might be wrong in some cases. If you use this idiom for those functions | 
| 3594 |  |  |  |  |  |  | # which are expected to return a scalar value, e.g. searching functions, the | 
| 3595 |  |  |  |  |  |  | # user of those functions will be surprised at what they return in list | 
| 3596 |  |  |  |  |  |  | # context, an empty list - note that many functions and all the methods | 
| 3597 |  |  |  |  |  |  | # evaluate their arguments in list context. You'd better to use "return undef;" | 
| 3598 |  |  |  |  |  |  | # for such scalar functions. | 
| 3599 |  |  |  |  |  |  | # | 
| 3600 |  |  |  |  |  |  | #     sub search_something { | 
| 3601 |  |  |  |  |  |  | #         my($arg) = @_; | 
| 3602 |  |  |  |  |  |  | #         # search_something... | 
| 3603 |  |  |  |  |  |  | #         if(defined $found){ | 
| 3604 |  |  |  |  |  |  | #             return $found; | 
| 3605 |  |  |  |  |  |  | #         } | 
| 3606 |  |  |  |  |  |  | #         return; # XXX: you'd better to "return undef;" | 
| 3607 |  |  |  |  |  |  | #     } | 
| 3608 |  |  |  |  |  |  | # | 
| 3609 |  |  |  |  |  |  | #     # ... | 
| 3610 |  |  |  |  |  |  | # | 
| 3611 |  |  |  |  |  |  | #     # you'll get what you want, but ... | 
| 3612 |  |  |  |  |  |  | #     my $something = search_something($source); | 
| 3613 |  |  |  |  |  |  | # | 
| 3614 |  |  |  |  |  |  | #     # you won't get what you want here. | 
| 3615 |  |  |  |  |  |  | #     # @_ for doit() is (-foo => $opt), not (undef, -foo => $opt). | 
| 3616 |  |  |  |  |  |  | #     $obj->doit(search_something($source), -option=> $optval); | 
| 3617 |  |  |  |  |  |  | # | 
| 3618 |  |  |  |  |  |  | #     # you have to use the "scalar" operator in such a case. | 
| 3619 |  |  |  |  |  |  | #     $obj->doit(scalar search_something($source), ...); | 
| 3620 |  |  |  |  |  |  | # | 
| 3621 |  |  |  |  |  |  | # *1: it returns an empty list in list context, or returns undef in scalar | 
| 3622 |  |  |  |  |  |  | #     context | 
| 3623 |  |  |  |  |  |  | # | 
| 3624 |  |  |  |  |  |  | # (and so on) | 
| 3625 |  |  |  |  |  |  |  | 
| 3626 | 0 |  |  |  |  | 0 | return undef; | 
| 3627 |  |  |  |  |  |  | } | 
| 3628 |  |  |  |  |  |  |  | 
| 3629 |  |  |  |  |  |  | # | 
| 3630 |  |  |  |  |  |  | # Big5-HKSCS file test -w $_ | 
| 3631 |  |  |  |  |  |  | # | 
| 3632 |  |  |  |  |  |  | sub Ebig5hkscs::w_() { | 
| 3633 |  |  |  |  |  |  |  | 
| 3634 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3635 | 0 | 0 |  |  |  | 0 | return -w _ ? 1 : ''; | 
| 3636 |  |  |  |  |  |  | } | 
| 3637 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3638 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3639 | 0 | 0 |  |  |  | 0 | return -w _ ? 1 : ''; | 
| 3640 |  |  |  |  |  |  | } | 
| 3641 |  |  |  |  |  |  | else { | 
| 3642 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3643 | 0 | 0 |  |  |  | 0 | if (_open_a($fh, $_)) { | 
| 3644 | 0 |  |  |  |  | 0 | my $w = -w $fh; | 
| 3645 | 0 |  |  |  |  | 0 | close $fh; | 
| 3646 | 0 | 0 |  |  |  | 0 | return $w ? 1 : ''; | 
| 3647 |  |  |  |  |  |  | } | 
| 3648 |  |  |  |  |  |  | } | 
| 3649 |  |  |  |  |  |  | } | 
| 3650 | 0 |  |  |  |  | 0 | return undef; | 
| 3651 |  |  |  |  |  |  | } | 
| 3652 |  |  |  |  |  |  |  | 
| 3653 |  |  |  |  |  |  | # | 
| 3654 |  |  |  |  |  |  | # Big5-HKSCS file test -x $_ | 
| 3655 |  |  |  |  |  |  | # | 
| 3656 |  |  |  |  |  |  | sub Ebig5hkscs::x_() { | 
| 3657 |  |  |  |  |  |  |  | 
| 3658 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3659 | 0 | 0 |  |  |  | 0 | return -x _ ? 1 : ''; | 
| 3660 |  |  |  |  |  |  | } | 
| 3661 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3662 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3663 | 0 | 0 |  |  |  | 0 | return -x _ ? 1 : ''; | 
| 3664 |  |  |  |  |  |  | } | 
| 3665 |  |  |  |  |  |  | else { | 
| 3666 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3667 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3668 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -x $fh; | 
| 3669 | 0 |  |  |  |  | 0 | close $fh; | 
| 3670 |  |  |  |  |  |  | } | 
| 3671 |  |  |  |  |  |  |  | 
| 3672 |  |  |  |  |  |  | # filename is not .COM .EXE .BAT .CMD | 
| 3673 | 0 |  |  |  |  | 0 | return ''; | 
| 3674 |  |  |  |  |  |  | } | 
| 3675 |  |  |  |  |  |  | } | 
| 3676 | 0 |  |  |  |  | 0 | return undef; | 
| 3677 |  |  |  |  |  |  | } | 
| 3678 |  |  |  |  |  |  |  | 
| 3679 |  |  |  |  |  |  | # | 
| 3680 |  |  |  |  |  |  | # Big5-HKSCS file test -o $_ | 
| 3681 |  |  |  |  |  |  | # | 
| 3682 |  |  |  |  |  |  | sub Ebig5hkscs::o_() { | 
| 3683 |  |  |  |  |  |  |  | 
| 3684 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3685 | 0 | 0 |  |  |  | 0 | return -o _ ? 1 : ''; | 
| 3686 |  |  |  |  |  |  | } | 
| 3687 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3688 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3689 | 0 | 0 |  |  |  | 0 | return -o _ ? 1 : ''; | 
| 3690 |  |  |  |  |  |  | } | 
| 3691 |  |  |  |  |  |  | else { | 
| 3692 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3693 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3694 | 0 |  |  |  |  | 0 | my $o = -o $fh; | 
| 3695 | 0 |  |  |  |  | 0 | close $fh; | 
| 3696 | 0 | 0 |  |  |  | 0 | return $o ? 1 : ''; | 
| 3697 |  |  |  |  |  |  | } | 
| 3698 |  |  |  |  |  |  | } | 
| 3699 |  |  |  |  |  |  | } | 
| 3700 | 0 |  |  |  |  | 0 | return undef; | 
| 3701 |  |  |  |  |  |  | } | 
| 3702 |  |  |  |  |  |  |  | 
| 3703 |  |  |  |  |  |  | # | 
| 3704 |  |  |  |  |  |  | # Big5-HKSCS file test -R $_ | 
| 3705 |  |  |  |  |  |  | # | 
| 3706 |  |  |  |  |  |  | sub Ebig5hkscs::R_() { | 
| 3707 |  |  |  |  |  |  |  | 
| 3708 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3709 | 0 | 0 |  |  |  | 0 | return -R _ ? 1 : ''; | 
| 3710 |  |  |  |  |  |  | } | 
| 3711 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3712 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3713 | 0 | 0 |  |  |  | 0 | return -R _ ? 1 : ''; | 
| 3714 |  |  |  |  |  |  | } | 
| 3715 |  |  |  |  |  |  | else { | 
| 3716 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3717 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3718 | 0 |  |  |  |  | 0 | my $R = -R $fh; | 
| 3719 | 0 |  |  |  |  | 0 | close $fh; | 
| 3720 | 0 | 0 |  |  |  | 0 | return $R ? 1 : ''; | 
| 3721 |  |  |  |  |  |  | } | 
| 3722 |  |  |  |  |  |  | } | 
| 3723 |  |  |  |  |  |  | } | 
| 3724 | 0 |  |  |  |  | 0 | return undef; | 
| 3725 |  |  |  |  |  |  | } | 
| 3726 |  |  |  |  |  |  |  | 
| 3727 |  |  |  |  |  |  | # | 
| 3728 |  |  |  |  |  |  | # Big5-HKSCS file test -W $_ | 
| 3729 |  |  |  |  |  |  | # | 
| 3730 |  |  |  |  |  |  | sub Ebig5hkscs::W_() { | 
| 3731 |  |  |  |  |  |  |  | 
| 3732 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3733 | 0 | 0 |  |  |  | 0 | return -W _ ? 1 : ''; | 
| 3734 |  |  |  |  |  |  | } | 
| 3735 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3736 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3737 | 0 | 0 |  |  |  | 0 | return -W _ ? 1 : ''; | 
| 3738 |  |  |  |  |  |  | } | 
| 3739 |  |  |  |  |  |  | else { | 
| 3740 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3741 | 0 | 0 |  |  |  | 0 | if (_open_a($fh, $_)) { | 
| 3742 | 0 |  |  |  |  | 0 | my $W = -W $fh; | 
| 3743 | 0 |  |  |  |  | 0 | close $fh; | 
| 3744 | 0 | 0 |  |  |  | 0 | return $W ? 1 : ''; | 
| 3745 |  |  |  |  |  |  | } | 
| 3746 |  |  |  |  |  |  | } | 
| 3747 |  |  |  |  |  |  | } | 
| 3748 | 0 |  |  |  |  | 0 | return undef; | 
| 3749 |  |  |  |  |  |  | } | 
| 3750 |  |  |  |  |  |  |  | 
| 3751 |  |  |  |  |  |  | # | 
| 3752 |  |  |  |  |  |  | # Big5-HKSCS file test -X $_ | 
| 3753 |  |  |  |  |  |  | # | 
| 3754 |  |  |  |  |  |  | sub Ebig5hkscs::X_() { | 
| 3755 |  |  |  |  |  |  |  | 
| 3756 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3757 | 0 | 0 |  |  |  | 0 | return -X _ ? 1 : ''; | 
| 3758 |  |  |  |  |  |  | } | 
| 3759 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3760 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3761 | 0 | 0 |  |  |  | 0 | return -X _ ? 1 : ''; | 
| 3762 |  |  |  |  |  |  | } | 
| 3763 |  |  |  |  |  |  | else { | 
| 3764 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3765 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3766 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -X $fh; | 
| 3767 | 0 |  |  |  |  | 0 | close $fh; | 
| 3768 |  |  |  |  |  |  | } | 
| 3769 |  |  |  |  |  |  |  | 
| 3770 |  |  |  |  |  |  | # filename is not .COM .EXE .BAT .CMD | 
| 3771 | 0 |  |  |  |  | 0 | return ''; | 
| 3772 |  |  |  |  |  |  | } | 
| 3773 |  |  |  |  |  |  | } | 
| 3774 | 0 |  |  |  |  | 0 | return undef; | 
| 3775 |  |  |  |  |  |  | } | 
| 3776 |  |  |  |  |  |  |  | 
| 3777 |  |  |  |  |  |  | # | 
| 3778 |  |  |  |  |  |  | # Big5-HKSCS file test -O $_ | 
| 3779 |  |  |  |  |  |  | # | 
| 3780 |  |  |  |  |  |  | sub Ebig5hkscs::O_() { | 
| 3781 |  |  |  |  |  |  |  | 
| 3782 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3783 | 0 | 0 |  |  |  | 0 | return -O _ ? 1 : ''; | 
| 3784 |  |  |  |  |  |  | } | 
| 3785 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3786 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3787 | 0 | 0 |  |  |  | 0 | return -O _ ? 1 : ''; | 
| 3788 |  |  |  |  |  |  | } | 
| 3789 |  |  |  |  |  |  | else { | 
| 3790 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3791 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3792 | 0 |  |  |  |  | 0 | my $O = -O $fh; | 
| 3793 | 0 |  |  |  |  | 0 | close $fh; | 
| 3794 | 0 | 0 |  |  |  | 0 | return $O ? 1 : ''; | 
| 3795 |  |  |  |  |  |  | } | 
| 3796 |  |  |  |  |  |  | } | 
| 3797 |  |  |  |  |  |  | } | 
| 3798 | 0 |  |  |  |  | 0 | return undef; | 
| 3799 |  |  |  |  |  |  | } | 
| 3800 |  |  |  |  |  |  |  | 
| 3801 |  |  |  |  |  |  | # | 
| 3802 |  |  |  |  |  |  | # Big5-HKSCS file test -e $_ | 
| 3803 |  |  |  |  |  |  | # | 
| 3804 |  |  |  |  |  |  | sub Ebig5hkscs::e_() { | 
| 3805 |  |  |  |  |  |  |  | 
| 3806 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3807 | 0 |  |  |  |  | 0 | return 1; | 
| 3808 |  |  |  |  |  |  | } | 
| 3809 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3810 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3811 | 0 |  |  |  |  | 0 | return 1; | 
| 3812 |  |  |  |  |  |  | } | 
| 3813 |  |  |  |  |  |  | else { | 
| 3814 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3815 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3816 | 0 |  |  |  |  | 0 | my $e = -e $fh; | 
| 3817 | 0 |  |  |  |  | 0 | close $fh; | 
| 3818 | 0 | 0 |  |  |  | 0 | return $e ? 1 : ''; | 
| 3819 |  |  |  |  |  |  | } | 
| 3820 |  |  |  |  |  |  | } | 
| 3821 |  |  |  |  |  |  | } | 
| 3822 | 0 |  |  |  |  | 0 | return undef; | 
| 3823 |  |  |  |  |  |  | } | 
| 3824 |  |  |  |  |  |  |  | 
| 3825 |  |  |  |  |  |  | # | 
| 3826 |  |  |  |  |  |  | # Big5-HKSCS file test -z $_ | 
| 3827 |  |  |  |  |  |  | # | 
| 3828 |  |  |  |  |  |  | sub Ebig5hkscs::z_() { | 
| 3829 |  |  |  |  |  |  |  | 
| 3830 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3831 | 0 | 0 |  |  |  | 0 | return -z _ ? 1 : ''; | 
| 3832 |  |  |  |  |  |  | } | 
| 3833 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3834 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3835 | 0 | 0 |  |  |  | 0 | return -z _ ? 1 : ''; | 
| 3836 |  |  |  |  |  |  | } | 
| 3837 |  |  |  |  |  |  | else { | 
| 3838 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3839 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3840 | 0 |  |  |  |  | 0 | my $z = -z $fh; | 
| 3841 | 0 |  |  |  |  | 0 | close $fh; | 
| 3842 | 0 | 0 |  |  |  | 0 | return $z ? 1 : ''; | 
| 3843 |  |  |  |  |  |  | } | 
| 3844 |  |  |  |  |  |  | } | 
| 3845 |  |  |  |  |  |  | } | 
| 3846 | 0 |  |  |  |  | 0 | return undef; | 
| 3847 |  |  |  |  |  |  | } | 
| 3848 |  |  |  |  |  |  |  | 
| 3849 |  |  |  |  |  |  | # | 
| 3850 |  |  |  |  |  |  | # Big5-HKSCS file test -s $_ | 
| 3851 |  |  |  |  |  |  | # | 
| 3852 |  |  |  |  |  |  | sub Ebig5hkscs::s_() { | 
| 3853 |  |  |  |  |  |  |  | 
| 3854 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3855 | 0 |  |  |  |  | 0 | return -s _; | 
| 3856 |  |  |  |  |  |  | } | 
| 3857 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3858 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3859 | 0 |  |  |  |  | 0 | return -s _; | 
| 3860 |  |  |  |  |  |  | } | 
| 3861 |  |  |  |  |  |  | else { | 
| 3862 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3863 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3864 | 0 |  |  |  |  | 0 | my $s = -s $fh; | 
| 3865 | 0 |  |  |  |  | 0 | close $fh; | 
| 3866 | 0 |  |  |  |  | 0 | return $s; | 
| 3867 |  |  |  |  |  |  | } | 
| 3868 |  |  |  |  |  |  | } | 
| 3869 |  |  |  |  |  |  | } | 
| 3870 | 0 |  |  |  |  | 0 | return undef; | 
| 3871 |  |  |  |  |  |  | } | 
| 3872 |  |  |  |  |  |  |  | 
| 3873 |  |  |  |  |  |  | # | 
| 3874 |  |  |  |  |  |  | # Big5-HKSCS file test -f $_ | 
| 3875 |  |  |  |  |  |  | # | 
| 3876 |  |  |  |  |  |  | sub Ebig5hkscs::f_() { | 
| 3877 |  |  |  |  |  |  |  | 
| 3878 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3879 | 0 | 0 |  |  |  | 0 | return -f _ ? 1 : ''; | 
| 3880 |  |  |  |  |  |  | } | 
| 3881 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3882 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3883 | 0 |  |  |  |  | 0 | return ''; | 
| 3884 |  |  |  |  |  |  | } | 
| 3885 |  |  |  |  |  |  | else { | 
| 3886 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3887 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3888 | 0 |  |  |  |  | 0 | my $f = -f $fh; | 
| 3889 | 0 |  |  |  |  | 0 | close $fh; | 
| 3890 | 0 | 0 |  |  |  | 0 | return $f ? 1 : ''; | 
| 3891 |  |  |  |  |  |  | } | 
| 3892 |  |  |  |  |  |  | } | 
| 3893 |  |  |  |  |  |  | } | 
| 3894 | 0 |  |  |  |  | 0 | return undef; | 
| 3895 |  |  |  |  |  |  | } | 
| 3896 |  |  |  |  |  |  |  | 
| 3897 |  |  |  |  |  |  | # | 
| 3898 |  |  |  |  |  |  | # Big5-HKSCS file test -d $_ | 
| 3899 |  |  |  |  |  |  | # | 
| 3900 |  |  |  |  |  |  | sub Ebig5hkscs::d_() { | 
| 3901 |  |  |  |  |  |  |  | 
| 3902 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3903 | 0 | 0 |  |  |  | 0 | return -d _ ? 1 : ''; | 
| 3904 |  |  |  |  |  |  | } | 
| 3905 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3906 | 0 | 0 |  |  |  | 0 | return -d "$_/." ? 1 : ''; | 
| 3907 |  |  |  |  |  |  | } | 
| 3908 | 0 |  |  |  |  | 0 | return undef; | 
| 3909 |  |  |  |  |  |  | } | 
| 3910 |  |  |  |  |  |  |  | 
| 3911 |  |  |  |  |  |  | # | 
| 3912 |  |  |  |  |  |  | # Big5-HKSCS file test -l $_ | 
| 3913 |  |  |  |  |  |  | # | 
| 3914 |  |  |  |  |  |  | sub Ebig5hkscs::l_() { | 
| 3915 |  |  |  |  |  |  |  | 
| 3916 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3917 | 0 | 0 |  |  |  | 0 | return -l _ ? 1 : ''; | 
| 3918 |  |  |  |  |  |  | } | 
| 3919 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3920 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3921 | 0 | 0 |  |  |  | 0 | return -l _ ? 1 : ''; | 
| 3922 |  |  |  |  |  |  | } | 
| 3923 |  |  |  |  |  |  | else { | 
| 3924 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3925 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3926 | 0 |  |  |  |  | 0 | my $l = -l $fh; | 
| 3927 | 0 |  |  |  |  | 0 | close $fh; | 
| 3928 | 0 | 0 |  |  |  | 0 | return $l ? 1 : ''; | 
| 3929 |  |  |  |  |  |  | } | 
| 3930 |  |  |  |  |  |  | } | 
| 3931 |  |  |  |  |  |  | } | 
| 3932 | 0 |  |  |  |  | 0 | return undef; | 
| 3933 |  |  |  |  |  |  | } | 
| 3934 |  |  |  |  |  |  |  | 
| 3935 |  |  |  |  |  |  | # | 
| 3936 |  |  |  |  |  |  | # Big5-HKSCS file test -p $_ | 
| 3937 |  |  |  |  |  |  | # | 
| 3938 |  |  |  |  |  |  | sub Ebig5hkscs::p_() { | 
| 3939 |  |  |  |  |  |  |  | 
| 3940 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3941 | 0 | 0 |  |  |  | 0 | return -p _ ? 1 : ''; | 
| 3942 |  |  |  |  |  |  | } | 
| 3943 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3944 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3945 | 0 | 0 |  |  |  | 0 | return -p _ ? 1 : ''; | 
| 3946 |  |  |  |  |  |  | } | 
| 3947 |  |  |  |  |  |  | else { | 
| 3948 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3949 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3950 | 0 |  |  |  |  | 0 | my $p = -p $fh; | 
| 3951 | 0 |  |  |  |  | 0 | close $fh; | 
| 3952 | 0 | 0 |  |  |  | 0 | return $p ? 1 : ''; | 
| 3953 |  |  |  |  |  |  | } | 
| 3954 |  |  |  |  |  |  | } | 
| 3955 |  |  |  |  |  |  | } | 
| 3956 | 0 |  |  |  |  | 0 | return undef; | 
| 3957 |  |  |  |  |  |  | } | 
| 3958 |  |  |  |  |  |  |  | 
| 3959 |  |  |  |  |  |  | # | 
| 3960 |  |  |  |  |  |  | # Big5-HKSCS file test -S $_ | 
| 3961 |  |  |  |  |  |  | # | 
| 3962 |  |  |  |  |  |  | sub Ebig5hkscs::S_() { | 
| 3963 |  |  |  |  |  |  |  | 
| 3964 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3965 | 0 | 0 |  |  |  | 0 | return -S _ ? 1 : ''; | 
| 3966 |  |  |  |  |  |  | } | 
| 3967 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3968 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3969 | 0 | 0 |  |  |  | 0 | return -S _ ? 1 : ''; | 
| 3970 |  |  |  |  |  |  | } | 
| 3971 |  |  |  |  |  |  | else { | 
| 3972 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3973 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3974 | 0 |  |  |  |  | 0 | my $S = -S $fh; | 
| 3975 | 0 |  |  |  |  | 0 | close $fh; | 
| 3976 | 0 | 0 |  |  |  | 0 | return $S ? 1 : ''; | 
| 3977 |  |  |  |  |  |  | } | 
| 3978 |  |  |  |  |  |  | } | 
| 3979 |  |  |  |  |  |  | } | 
| 3980 | 0 |  |  |  |  | 0 | return undef; | 
| 3981 |  |  |  |  |  |  | } | 
| 3982 |  |  |  |  |  |  |  | 
| 3983 |  |  |  |  |  |  | # | 
| 3984 |  |  |  |  |  |  | # Big5-HKSCS file test -b $_ | 
| 3985 |  |  |  |  |  |  | # | 
| 3986 |  |  |  |  |  |  | sub Ebig5hkscs::b_() { | 
| 3987 |  |  |  |  |  |  |  | 
| 3988 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 3989 | 0 | 0 |  |  |  | 0 | return -b _ ? 1 : ''; | 
| 3990 |  |  |  |  |  |  | } | 
| 3991 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 3992 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 3993 | 0 | 0 |  |  |  | 0 | return -b _ ? 1 : ''; | 
| 3994 |  |  |  |  |  |  | } | 
| 3995 |  |  |  |  |  |  | else { | 
| 3996 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 3997 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 3998 | 0 |  |  |  |  | 0 | my $b = -b $fh; | 
| 3999 | 0 |  |  |  |  | 0 | close $fh; | 
| 4000 | 0 | 0 |  |  |  | 0 | return $b ? 1 : ''; | 
| 4001 |  |  |  |  |  |  | } | 
| 4002 |  |  |  |  |  |  | } | 
| 4003 |  |  |  |  |  |  | } | 
| 4004 | 0 |  |  |  |  | 0 | return undef; | 
| 4005 |  |  |  |  |  |  | } | 
| 4006 |  |  |  |  |  |  |  | 
| 4007 |  |  |  |  |  |  | # | 
| 4008 |  |  |  |  |  |  | # Big5-HKSCS file test -c $_ | 
| 4009 |  |  |  |  |  |  | # | 
| 4010 |  |  |  |  |  |  | sub Ebig5hkscs::c_() { | 
| 4011 |  |  |  |  |  |  |  | 
| 4012 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 4013 | 0 | 0 |  |  |  | 0 | return -c _ ? 1 : ''; | 
| 4014 |  |  |  |  |  |  | } | 
| 4015 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4016 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 4017 | 0 | 0 |  |  |  | 0 | return -c _ ? 1 : ''; | 
| 4018 |  |  |  |  |  |  | } | 
| 4019 |  |  |  |  |  |  | else { | 
| 4020 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4021 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4022 | 0 |  |  |  |  | 0 | my $c = -c $fh; | 
| 4023 | 0 |  |  |  |  | 0 | close $fh; | 
| 4024 | 0 | 0 |  |  |  | 0 | return $c ? 1 : ''; | 
| 4025 |  |  |  |  |  |  | } | 
| 4026 |  |  |  |  |  |  | } | 
| 4027 |  |  |  |  |  |  | } | 
| 4028 | 0 |  |  |  |  | 0 | return undef; | 
| 4029 |  |  |  |  |  |  | } | 
| 4030 |  |  |  |  |  |  |  | 
| 4031 |  |  |  |  |  |  | # | 
| 4032 |  |  |  |  |  |  | # Big5-HKSCS file test -u $_ | 
| 4033 |  |  |  |  |  |  | # | 
| 4034 |  |  |  |  |  |  | sub Ebig5hkscs::u_() { | 
| 4035 |  |  |  |  |  |  |  | 
| 4036 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 4037 | 0 | 0 |  |  |  | 0 | return -u _ ? 1 : ''; | 
| 4038 |  |  |  |  |  |  | } | 
| 4039 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4040 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 4041 | 0 | 0 |  |  |  | 0 | return -u _ ? 1 : ''; | 
| 4042 |  |  |  |  |  |  | } | 
| 4043 |  |  |  |  |  |  | else { | 
| 4044 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4045 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4046 | 0 |  |  |  |  | 0 | my $u = -u $fh; | 
| 4047 | 0 |  |  |  |  | 0 | close $fh; | 
| 4048 | 0 | 0 |  |  |  | 0 | return $u ? 1 : ''; | 
| 4049 |  |  |  |  |  |  | } | 
| 4050 |  |  |  |  |  |  | } | 
| 4051 |  |  |  |  |  |  | } | 
| 4052 | 0 |  |  |  |  | 0 | return undef; | 
| 4053 |  |  |  |  |  |  | } | 
| 4054 |  |  |  |  |  |  |  | 
| 4055 |  |  |  |  |  |  | # | 
| 4056 |  |  |  |  |  |  | # Big5-HKSCS file test -g $_ | 
| 4057 |  |  |  |  |  |  | # | 
| 4058 |  |  |  |  |  |  | sub Ebig5hkscs::g_() { | 
| 4059 |  |  |  |  |  |  |  | 
| 4060 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 4061 | 0 | 0 |  |  |  | 0 | return -g _ ? 1 : ''; | 
| 4062 |  |  |  |  |  |  | } | 
| 4063 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4064 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 4065 | 0 | 0 |  |  |  | 0 | return -g _ ? 1 : ''; | 
| 4066 |  |  |  |  |  |  | } | 
| 4067 |  |  |  |  |  |  | else { | 
| 4068 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4069 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4070 | 0 |  |  |  |  | 0 | my $g = -g $fh; | 
| 4071 | 0 |  |  |  |  | 0 | close $fh; | 
| 4072 | 0 | 0 |  |  |  | 0 | return $g ? 1 : ''; | 
| 4073 |  |  |  |  |  |  | } | 
| 4074 |  |  |  |  |  |  | } | 
| 4075 |  |  |  |  |  |  | } | 
| 4076 | 0 |  |  |  |  | 0 | return undef; | 
| 4077 |  |  |  |  |  |  | } | 
| 4078 |  |  |  |  |  |  |  | 
| 4079 |  |  |  |  |  |  | # | 
| 4080 |  |  |  |  |  |  | # Big5-HKSCS file test -k $_ | 
| 4081 |  |  |  |  |  |  | # | 
| 4082 |  |  |  |  |  |  | sub Ebig5hkscs::k_() { | 
| 4083 |  |  |  |  |  |  |  | 
| 4084 | 0 | 0 |  | 0 | 0 | 0 | if ($] =~ /^5\.008/oxms) { | 
| 4085 | 0 | 0 |  |  |  | 0 | return wantarray ? ('',@_) : ''; | 
| 4086 |  |  |  |  |  |  | } | 
| 4087 | 0 | 0 |  |  |  | 0 | return wantarray ? ($_,@_) : $_; | 
| 4088 |  |  |  |  |  |  | } | 
| 4089 |  |  |  |  |  |  |  | 
| 4090 |  |  |  |  |  |  | # | 
| 4091 |  |  |  |  |  |  | # Big5-HKSCS file test -T $_ | 
| 4092 |  |  |  |  |  |  | # | 
| 4093 |  |  |  |  |  |  | sub Ebig5hkscs::T_() { | 
| 4094 |  |  |  |  |  |  |  | 
| 4095 | 0 |  |  | 0 | 0 | 0 | my $T = 1; | 
| 4096 |  |  |  |  |  |  |  | 
| 4097 | 0 | 0 | 0 |  |  | 0 | if (-d $_ or -d "$_/.") { | 
| 4098 | 0 |  |  |  |  | 0 | return undef; | 
| 4099 |  |  |  |  |  |  | } | 
| 4100 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4101 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4102 |  |  |  |  |  |  | } | 
| 4103 |  |  |  |  |  |  | else { | 
| 4104 | 0 |  |  |  |  | 0 | return undef; | 
| 4105 |  |  |  |  |  |  | } | 
| 4106 |  |  |  |  |  |  |  | 
| 4107 | 0 | 0 |  |  |  | 0 | if (sysread $fh, my $block, 512) { | 
| 4108 | 0 | 0 |  |  |  | 0 | if ($block =~ /[\000\377]/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 4109 | 0 |  |  |  |  | 0 | $T = ''; | 
| 4110 |  |  |  |  |  |  | } | 
| 4111 |  |  |  |  |  |  | elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) { | 
| 4112 | 0 |  |  |  |  | 0 | $T = ''; | 
| 4113 |  |  |  |  |  |  | } | 
| 4114 |  |  |  |  |  |  | } | 
| 4115 |  |  |  |  |  |  |  | 
| 4116 |  |  |  |  |  |  | # 0 byte or eof | 
| 4117 |  |  |  |  |  |  | else { | 
| 4118 | 0 |  |  |  |  | 0 | $T = 1; | 
| 4119 |  |  |  |  |  |  | } | 
| 4120 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -T $fh; | 
| 4121 | 0 |  |  |  |  | 0 | close $fh; | 
| 4122 |  |  |  |  |  |  |  | 
| 4123 | 0 |  |  |  |  | 0 | return $T; | 
| 4124 |  |  |  |  |  |  | } | 
| 4125 |  |  |  |  |  |  |  | 
| 4126 |  |  |  |  |  |  | # | 
| 4127 |  |  |  |  |  |  | # Big5-HKSCS file test -B $_ | 
| 4128 |  |  |  |  |  |  | # | 
| 4129 |  |  |  |  |  |  | sub Ebig5hkscs::B_() { | 
| 4130 |  |  |  |  |  |  |  | 
| 4131 | 0 |  |  | 0 | 0 | 0 | my $B = ''; | 
| 4132 |  |  |  |  |  |  |  | 
| 4133 | 0 | 0 | 0 |  |  | 0 | if (-d $_ or -d "$_/.") { | 
| 4134 | 0 |  |  |  |  | 0 | return undef; | 
| 4135 |  |  |  |  |  |  | } | 
| 4136 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4137 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4138 |  |  |  |  |  |  | } | 
| 4139 |  |  |  |  |  |  | else { | 
| 4140 | 0 |  |  |  |  | 0 | return undef; | 
| 4141 |  |  |  |  |  |  | } | 
| 4142 |  |  |  |  |  |  |  | 
| 4143 | 0 | 0 |  |  |  | 0 | if (sysread $fh, my $block, 512) { | 
| 4144 | 0 | 0 |  |  |  | 0 | if ($block =~ /[\000\377]/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 4145 | 0 |  |  |  |  | 0 | $B = 1; | 
| 4146 |  |  |  |  |  |  | } | 
| 4147 |  |  |  |  |  |  | elsif (($block =~ tr/\000-\007\013\016-\032\034-\037\377//) * 10 > CORE::length $block) { | 
| 4148 | 0 |  |  |  |  | 0 | $B = 1; | 
| 4149 |  |  |  |  |  |  | } | 
| 4150 |  |  |  |  |  |  | } | 
| 4151 |  |  |  |  |  |  |  | 
| 4152 |  |  |  |  |  |  | # 0 byte or eof | 
| 4153 |  |  |  |  |  |  | else { | 
| 4154 | 0 |  |  |  |  | 0 | $B = 1; | 
| 4155 |  |  |  |  |  |  | } | 
| 4156 | 0 |  |  |  |  | 0 | my $dummy_for_underline_cache = -B $fh; | 
| 4157 | 0 |  |  |  |  | 0 | close $fh; | 
| 4158 |  |  |  |  |  |  |  | 
| 4159 | 0 |  |  |  |  | 0 | return $B; | 
| 4160 |  |  |  |  |  |  | } | 
| 4161 |  |  |  |  |  |  |  | 
| 4162 |  |  |  |  |  |  | # | 
| 4163 |  |  |  |  |  |  | # Big5-HKSCS file test -M $_ | 
| 4164 |  |  |  |  |  |  | # | 
| 4165 |  |  |  |  |  |  | sub Ebig5hkscs::M_() { | 
| 4166 |  |  |  |  |  |  |  | 
| 4167 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 4168 | 0 |  |  |  |  | 0 | return -M _; | 
| 4169 |  |  |  |  |  |  | } | 
| 4170 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4171 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 4172 | 0 |  |  |  |  | 0 | return -M _; | 
| 4173 |  |  |  |  |  |  | } | 
| 4174 |  |  |  |  |  |  | else { | 
| 4175 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4176 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4177 | 0 |  |  |  |  | 0 | my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh; | 
| 4178 | 0 |  |  |  |  | 0 | close $fh; | 
| 4179 | 0 |  |  |  |  | 0 | my $M = ($^T - $mtime) / (24*60*60); | 
| 4180 | 0 |  |  |  |  | 0 | return $M; | 
| 4181 |  |  |  |  |  |  | } | 
| 4182 |  |  |  |  |  |  | } | 
| 4183 |  |  |  |  |  |  | } | 
| 4184 | 0 |  |  |  |  | 0 | return undef; | 
| 4185 |  |  |  |  |  |  | } | 
| 4186 |  |  |  |  |  |  |  | 
| 4187 |  |  |  |  |  |  | # | 
| 4188 |  |  |  |  |  |  | # Big5-HKSCS file test -A $_ | 
| 4189 |  |  |  |  |  |  | # | 
| 4190 |  |  |  |  |  |  | sub Ebig5hkscs::A_() { | 
| 4191 |  |  |  |  |  |  |  | 
| 4192 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 4193 | 0 |  |  |  |  | 0 | return -A _; | 
| 4194 |  |  |  |  |  |  | } | 
| 4195 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4196 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 4197 | 0 |  |  |  |  | 0 | return -A _; | 
| 4198 |  |  |  |  |  |  | } | 
| 4199 |  |  |  |  |  |  | else { | 
| 4200 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4201 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4202 | 0 |  |  |  |  | 0 | my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh; | 
| 4203 | 0 |  |  |  |  | 0 | close $fh; | 
| 4204 | 0 |  |  |  |  | 0 | my $A = ($^T - $atime) / (24*60*60); | 
| 4205 | 0 |  |  |  |  | 0 | return $A; | 
| 4206 |  |  |  |  |  |  | } | 
| 4207 |  |  |  |  |  |  | } | 
| 4208 |  |  |  |  |  |  | } | 
| 4209 | 0 |  |  |  |  | 0 | return undef; | 
| 4210 |  |  |  |  |  |  | } | 
| 4211 |  |  |  |  |  |  |  | 
| 4212 |  |  |  |  |  |  | # | 
| 4213 |  |  |  |  |  |  | # Big5-HKSCS file test -C $_ | 
| 4214 |  |  |  |  |  |  | # | 
| 4215 |  |  |  |  |  |  | sub Ebig5hkscs::C_() { | 
| 4216 |  |  |  |  |  |  |  | 
| 4217 | 0 | 0 |  | 0 | 0 | 0 | if (-e $_) { | 
|  |  | 0 |  |  |  |  |  | 
| 4218 | 0 |  |  |  |  | 0 | return -C _; | 
| 4219 |  |  |  |  |  |  | } | 
| 4220 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4221 | 0 | 0 |  |  |  | 0 | if (-d "$_/.") { | 
| 4222 | 0 |  |  |  |  | 0 | return -C _; | 
| 4223 |  |  |  |  |  |  | } | 
| 4224 |  |  |  |  |  |  | else { | 
| 4225 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4226 | 0 | 0 |  |  |  | 0 | if (_open_r($fh, $_)) { | 
| 4227 | 0 |  |  |  |  | 0 | my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = CORE::stat $fh; | 
| 4228 | 0 |  |  |  |  | 0 | close $fh; | 
| 4229 | 0 |  |  |  |  | 0 | my $C = ($^T - $ctime) / (24*60*60); | 
| 4230 | 0 |  |  |  |  | 0 | return $C; | 
| 4231 |  |  |  |  |  |  | } | 
| 4232 |  |  |  |  |  |  | } | 
| 4233 |  |  |  |  |  |  | } | 
| 4234 | 0 |  |  |  |  | 0 | return undef; | 
| 4235 |  |  |  |  |  |  | } | 
| 4236 |  |  |  |  |  |  |  | 
| 4237 |  |  |  |  |  |  | # | 
| 4238 |  |  |  |  |  |  | # Big5-HKSCS path globbing (with parameter) | 
| 4239 |  |  |  |  |  |  | # | 
| 4240 |  |  |  |  |  |  | sub Ebig5hkscs::glob($) { | 
| 4241 |  |  |  |  |  |  |  | 
| 4242 | 0 | 0 |  | 0 | 0 | 0 | if (wantarray) { | 
| 4243 | 0 |  |  |  |  | 0 | my @glob = _DOS_like_glob(@_); | 
| 4244 | 0 |  |  |  |  | 0 | for my $glob (@glob) { | 
| 4245 | 0 |  |  |  |  | 0 | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 4246 |  |  |  |  |  |  | } | 
| 4247 | 0 |  |  |  |  | 0 | return @glob; | 
| 4248 |  |  |  |  |  |  | } | 
| 4249 |  |  |  |  |  |  | else { | 
| 4250 | 0 |  |  |  |  | 0 | my $glob = _DOS_like_glob(@_); | 
| 4251 | 0 |  |  |  |  | 0 | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 4252 | 0 |  |  |  |  | 0 | return $glob; | 
| 4253 |  |  |  |  |  |  | } | 
| 4254 |  |  |  |  |  |  | } | 
| 4255 |  |  |  |  |  |  |  | 
| 4256 |  |  |  |  |  |  | # | 
| 4257 |  |  |  |  |  |  | # Big5-HKSCS path globbing (without parameter) | 
| 4258 |  |  |  |  |  |  | # | 
| 4259 |  |  |  |  |  |  | sub Ebig5hkscs::glob_() { | 
| 4260 |  |  |  |  |  |  |  | 
| 4261 | 0 | 0 |  | 0 | 0 | 0 | if (wantarray) { | 
| 4262 | 0 |  |  |  |  | 0 | my @glob = _DOS_like_glob(); | 
| 4263 | 0 |  |  |  |  | 0 | for my $glob (@glob) { | 
| 4264 | 0 |  |  |  |  | 0 | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 4265 |  |  |  |  |  |  | } | 
| 4266 | 0 |  |  |  |  | 0 | return @glob; | 
| 4267 |  |  |  |  |  |  | } | 
| 4268 |  |  |  |  |  |  | else { | 
| 4269 | 0 |  |  |  |  | 0 | my $glob = _DOS_like_glob(); | 
| 4270 | 0 |  |  |  |  | 0 | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 4271 | 0 |  |  |  |  | 0 | return $glob; | 
| 4272 |  |  |  |  |  |  | } | 
| 4273 |  |  |  |  |  |  | } | 
| 4274 |  |  |  |  |  |  |  | 
| 4275 |  |  |  |  |  |  | # | 
| 4276 |  |  |  |  |  |  | # Big5-HKSCS path globbing via File::DosGlob 1.10 | 
| 4277 |  |  |  |  |  |  | # | 
| 4278 |  |  |  |  |  |  | # Often I confuse "_dosglob" and "_doglob". | 
| 4279 |  |  |  |  |  |  | # So, I renamed "_dosglob" to "_DOS_like_glob". | 
| 4280 |  |  |  |  |  |  | # | 
| 4281 |  |  |  |  |  |  | my %iter; | 
| 4282 |  |  |  |  |  |  | my %entries; | 
| 4283 |  |  |  |  |  |  | sub _DOS_like_glob { | 
| 4284 |  |  |  |  |  |  |  | 
| 4285 |  |  |  |  |  |  | # context (keyed by second cxix argument provided by core) | 
| 4286 | 0 |  |  | 0 |  | 0 | my($expr,$cxix) = @_; | 
| 4287 |  |  |  |  |  |  |  | 
| 4288 |  |  |  |  |  |  | # glob without args defaults to $_ | 
| 4289 | 0 | 0 |  |  |  | 0 | $expr = $_ if not defined $expr; | 
| 4290 |  |  |  |  |  |  |  | 
| 4291 |  |  |  |  |  |  | # represents the current user's home directory | 
| 4292 |  |  |  |  |  |  | # | 
| 4293 |  |  |  |  |  |  | # 7.3. Expanding Tildes in Filenames | 
| 4294 |  |  |  |  |  |  | # in Chapter 7. File Access | 
| 4295 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 4296 |  |  |  |  |  |  | # | 
| 4297 |  |  |  |  |  |  | # and File::HomeDir, File::HomeDir::Windows module | 
| 4298 |  |  |  |  |  |  |  | 
| 4299 |  |  |  |  |  |  | # DOS-like system | 
| 4300 | 0 | 0 |  |  |  | 0 | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 4301 | 0 |  |  |  |  | 0 | $expr =~ s{ \A ~ (?= [^/\\] ) } | 
|  | 0 |  |  |  |  | 0 |  | 
| 4302 |  |  |  |  |  |  | { my_home_MSWin32() }oxmse; | 
| 4303 |  |  |  |  |  |  | } | 
| 4304 |  |  |  |  |  |  |  | 
| 4305 |  |  |  |  |  |  | # UNIX-like system | 
| 4306 | 0 | 0 | 0 |  |  | 0 | else { | 
|  | 0 |  |  |  |  | 0 |  | 
| 4307 |  |  |  |  |  |  | $expr =~ s{ \A ~ ( (?:[^\x81-\xFE/]|[\x81-\xFE][\x00-\xFF])* ) } | 
| 4308 |  |  |  |  |  |  | { $1 ? (CORE::eval(q{(getpwnam($1))[7]})||my_home()) : my_home() }oxmse; | 
| 4309 |  |  |  |  |  |  | } | 
| 4310 | 0 | 0 |  |  |  | 0 |  | 
| 4311 | 0 | 0 |  |  |  | 0 | # assume global context if not provided one | 
| 4312 |  |  |  |  |  |  | $cxix = '_G_' if not defined $cxix; | 
| 4313 |  |  |  |  |  |  | $iter{$cxix} = 0 if not exists $iter{$cxix}; | 
| 4314 | 0 | 0 |  |  |  | 0 |  | 
| 4315 | 0 |  |  |  |  | 0 | # if we're just beginning, do it all first | 
| 4316 |  |  |  |  |  |  | if ($iter{$cxix} == 0) { | 
| 4317 |  |  |  |  |  |  | $entries{$cxix} = [ _do_glob(1, _parse_line($expr)) ]; | 
| 4318 |  |  |  |  |  |  | } | 
| 4319 | 0 | 0 |  |  |  | 0 |  | 
| 4320 | 0 |  |  |  |  | 0 | # chuck it all out, quick or slow | 
| 4321 | 0 |  |  |  |  | 0 | if (wantarray) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 4322 |  |  |  |  |  |  | delete $iter{$cxix}; | 
| 4323 |  |  |  |  |  |  | return @{delete $entries{$cxix}}; | 
| 4324 | 0 | 0 |  |  |  | 0 | } | 
|  | 0 |  |  |  |  | 0 |  | 
| 4325 | 0 |  |  |  |  | 0 | else { | 
|  | 0 |  |  |  |  | 0 |  | 
| 4326 |  |  |  |  |  |  | if ($iter{$cxix} = scalar @{$entries{$cxix}}) { | 
| 4327 |  |  |  |  |  |  | return shift @{$entries{$cxix}}; | 
| 4328 |  |  |  |  |  |  | } | 
| 4329 | 0 |  |  |  |  | 0 | else { | 
| 4330 | 0 |  |  |  |  | 0 | # return undef for EOL | 
| 4331 | 0 |  |  |  |  | 0 | delete $iter{$cxix}; | 
| 4332 |  |  |  |  |  |  | delete $entries{$cxix}; | 
| 4333 |  |  |  |  |  |  | return undef; | 
| 4334 |  |  |  |  |  |  | } | 
| 4335 |  |  |  |  |  |  | } | 
| 4336 |  |  |  |  |  |  | } | 
| 4337 |  |  |  |  |  |  |  | 
| 4338 |  |  |  |  |  |  | # | 
| 4339 |  |  |  |  |  |  | # Big5-HKSCS path globbing subroutine | 
| 4340 |  |  |  |  |  |  | # | 
| 4341 | 0 |  |  | 0 |  | 0 | sub _do_glob { | 
| 4342 | 0 |  |  |  |  | 0 |  | 
| 4343 | 0 |  |  |  |  | 0 | my($cond,@expr) = @_; | 
| 4344 |  |  |  |  |  |  | my @glob = (); | 
| 4345 |  |  |  |  |  |  | my $fix_drive_relative_paths = 0; | 
| 4346 | 0 |  |  |  |  | 0 |  | 
| 4347 | 0 | 0 |  |  |  | 0 | OUTER: | 
| 4348 | 0 | 0 |  |  |  | 0 | for my $expr (@expr) { | 
| 4349 |  |  |  |  |  |  | next OUTER if not defined $expr; | 
| 4350 | 0 |  |  |  |  | 0 | next OUTER if $expr eq ''; | 
| 4351 | 0 |  |  |  |  | 0 |  | 
| 4352 | 0 |  |  |  |  | 0 | my @matched = (); | 
| 4353 | 0 |  |  |  |  | 0 | my @globdir = (); | 
| 4354 | 0 |  |  |  |  | 0 | my $head    = '.'; | 
| 4355 |  |  |  |  |  |  | my $pathsep = '/'; | 
| 4356 |  |  |  |  |  |  | my $tail; | 
| 4357 | 0 | 0 |  |  |  | 0 |  | 
| 4358 | 0 |  |  |  |  | 0 | # if argument is within quotes strip em and do no globbing | 
| 4359 | 0 | 0 |  |  |  | 0 | if ($expr =~ /\A " ((?:$q_char)*?) " \z/oxms) { | 
| 4360 | 0 | 0 |  |  |  | 0 | $expr = $1; | 
| 4361 | 0 |  |  |  |  | 0 | if ($cond eq 'd') { | 
| 4362 |  |  |  |  |  |  | if (Ebig5hkscs::d $expr) { | 
| 4363 |  |  |  |  |  |  | push @glob, $expr; | 
| 4364 |  |  |  |  |  |  | } | 
| 4365 | 0 | 0 |  |  |  | 0 | } | 
| 4366 | 0 |  |  |  |  | 0 | else { | 
| 4367 |  |  |  |  |  |  | if (Ebig5hkscs::e $expr) { | 
| 4368 |  |  |  |  |  |  | push @glob, $expr; | 
| 4369 | 0 |  |  |  |  | 0 | } | 
| 4370 |  |  |  |  |  |  | } | 
| 4371 |  |  |  |  |  |  | next OUTER; | 
| 4372 |  |  |  |  |  |  | } | 
| 4373 |  |  |  |  |  |  |  | 
| 4374 | 0 | 0 |  |  |  | 0 | # wildcards with a drive prefix such as h:*.pm must be changed | 
| 4375 | 0 | 0 |  |  |  | 0 | # to h:./*.pm to expand correctly | 
| 4376 | 0 |  |  |  |  | 0 | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 4377 |  |  |  |  |  |  | if ($expr =~ s# \A ((?:[A-Za-z]:)?) ([^\x81-\xFE/\\]|[\x81-\xFE][\x00-\xFF]) #$1./$2#oxms) { | 
| 4378 |  |  |  |  |  |  | $fix_drive_relative_paths = 1; | 
| 4379 |  |  |  |  |  |  | } | 
| 4380 | 0 | 0 |  |  |  | 0 | } | 
| 4381 | 0 | 0 |  |  |  | 0 |  | 
| 4382 | 0 |  |  |  |  | 0 | if (($head, $tail) = _parse_path($expr,$pathsep)) { | 
| 4383 | 0 |  |  |  |  | 0 | if ($tail eq '') { | 
| 4384 |  |  |  |  |  |  | push @glob, $expr; | 
| 4385 | 0 | 0 |  |  |  | 0 | next OUTER; | 
| 4386 | 0 | 0 |  |  |  | 0 | } | 
| 4387 | 0 |  |  |  |  | 0 | if ($head =~ / \A (?:$q_char)*? [*?] /oxms) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 4388 | 0 |  |  |  |  | 0 | if (@globdir = _do_glob('d', $head)) { | 
| 4389 |  |  |  |  |  |  | push @glob, _do_glob($cond, map {"$_$pathsep$tail"} @globdir); | 
| 4390 |  |  |  |  |  |  | next OUTER; | 
| 4391 | 0 | 0 | 0 |  |  | 0 | } | 
| 4392 | 0 |  |  |  |  | 0 | } | 
| 4393 |  |  |  |  |  |  | if ($head eq '' or $head =~ /\A [A-Za-z]: \z/oxms) { | 
| 4394 | 0 |  |  |  |  | 0 | $head .= $pathsep; | 
| 4395 |  |  |  |  |  |  | } | 
| 4396 |  |  |  |  |  |  | $expr = $tail; | 
| 4397 |  |  |  |  |  |  | } | 
| 4398 | 0 | 0 |  |  |  | 0 |  | 
| 4399 | 0 | 0 |  |  |  | 0 | # If file component has no wildcards, we can avoid opendir | 
| 4400 | 0 |  |  |  |  | 0 | if ($expr !~ / \A (?:$q_char)*? [*?] /oxms) { | 
| 4401 |  |  |  |  |  |  | if ($head eq '.') { | 
| 4402 | 0 | 0 | 0 |  |  | 0 | $head = ''; | 
| 4403 | 0 |  |  |  |  | 0 | } | 
| 4404 |  |  |  |  |  |  | if ($head ne '' and ($head =~ / \G ($q_char) /oxmsg)[-1] ne $pathsep) { | 
| 4405 | 0 |  |  |  |  | 0 | $head .= $pathsep; | 
| 4406 | 0 | 0 |  |  |  | 0 | } | 
| 4407 | 0 | 0 |  |  |  | 0 | $head .= $expr; | 
| 4408 | 0 |  |  |  |  | 0 | if ($cond eq 'd') { | 
| 4409 |  |  |  |  |  |  | if (Ebig5hkscs::d $head) { | 
| 4410 |  |  |  |  |  |  | push @glob, $head; | 
| 4411 |  |  |  |  |  |  | } | 
| 4412 | 0 | 0 |  |  |  | 0 | } | 
| 4413 | 0 |  |  |  |  | 0 | else { | 
| 4414 |  |  |  |  |  |  | if (Ebig5hkscs::e $head) { | 
| 4415 |  |  |  |  |  |  | push @glob, $head; | 
| 4416 | 0 |  |  |  |  | 0 | } | 
| 4417 |  |  |  |  |  |  | } | 
| 4418 | 0 | 0 |  |  |  | 0 | next OUTER; | 
| 4419 | 0 |  |  |  |  | 0 | } | 
| 4420 | 0 |  |  |  |  | 0 | Ebig5hkscs::opendir(*DIR, $head) or next OUTER; | 
| 4421 |  |  |  |  |  |  | my @leaf = readdir DIR; | 
| 4422 | 0 | 0 |  |  |  | 0 | closedir DIR; | 
| 4423 | 0 |  |  |  |  | 0 |  | 
| 4424 |  |  |  |  |  |  | if ($head eq '.') { | 
| 4425 | 0 | 0 | 0 |  |  | 0 | $head = ''; | 
| 4426 | 0 |  |  |  |  | 0 | } | 
| 4427 |  |  |  |  |  |  | if ($head ne '' and ($head =~ / \G ($q_char) /oxmsg)[-1] ne $pathsep) { | 
| 4428 |  |  |  |  |  |  | $head .= $pathsep; | 
| 4429 | 0 |  |  |  |  | 0 | } | 
| 4430 | 0 |  |  |  |  | 0 |  | 
| 4431 | 0 |  |  |  |  | 0 | my $pattern = ''; | 
| 4432 |  |  |  |  |  |  | while ($expr =~ / \G ($q_char) /oxgc) { | 
| 4433 |  |  |  |  |  |  | my $char = $1; | 
| 4434 |  |  |  |  |  |  |  | 
| 4435 |  |  |  |  |  |  | # 6.9. Matching Shell Globs as Regular Expressions | 
| 4436 |  |  |  |  |  |  | # in Chapter 6. Pattern Matching | 
| 4437 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 4438 | 0 | 0 |  |  |  | 0 | # (and so on) | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4439 | 0 |  |  |  |  | 0 |  | 
| 4440 |  |  |  |  |  |  | if ($char eq '*') { | 
| 4441 |  |  |  |  |  |  | $pattern .= "(?:$your_char)*", | 
| 4442 | 0 |  |  |  |  | 0 | } | 
| 4443 |  |  |  |  |  |  | elsif ($char eq '?') { | 
| 4444 |  |  |  |  |  |  | $pattern .= "(?:$your_char)?",  # DOS style | 
| 4445 |  |  |  |  |  |  | #               $pattern .= "(?:$your_char)",   # UNIX style | 
| 4446 | 0 |  |  |  |  | 0 | } | 
| 4447 |  |  |  |  |  |  | elsif ((my $fc = Ebig5hkscs::fc($char)) ne $char) { | 
| 4448 |  |  |  |  |  |  | $pattern .= $fc; | 
| 4449 | 0 |  |  |  |  | 0 | } | 
| 4450 |  |  |  |  |  |  | else { | 
| 4451 |  |  |  |  |  |  | $pattern .= quotemeta $char; | 
| 4452 | 0 |  |  | 0 |  | 0 | } | 
|  | 0 |  |  |  |  | 0 |  | 
| 4453 |  |  |  |  |  |  | } | 
| 4454 |  |  |  |  |  |  | my $matchsub = sub { Ebig5hkscs::fc($_[0]) =~ /\A $pattern \z/xms }; | 
| 4455 |  |  |  |  |  |  |  | 
| 4456 |  |  |  |  |  |  | #       if ($@) { | 
| 4457 |  |  |  |  |  |  | #           print STDERR "$0: $@\n"; | 
| 4458 |  |  |  |  |  |  | #           next OUTER; | 
| 4459 |  |  |  |  |  |  | #       } | 
| 4460 | 0 |  |  |  |  | 0 |  | 
| 4461 | 0 | 0 | 0 |  |  | 0 | INNER: | 
| 4462 | 0 |  |  |  |  | 0 | for my $leaf (@leaf) { | 
| 4463 |  |  |  |  |  |  | if ($leaf eq '.' or $leaf eq '..') { | 
| 4464 | 0 | 0 | 0 |  |  | 0 | next INNER; | 
| 4465 | 0 |  |  |  |  | 0 | } | 
| 4466 |  |  |  |  |  |  | if ($cond eq 'd' and not Ebig5hkscs::d "$head$leaf") { | 
| 4467 |  |  |  |  |  |  | next INNER; | 
| 4468 | 0 | 0 |  |  |  | 0 | } | 
| 4469 | 0 |  |  |  |  | 0 |  | 
| 4470 | 0 |  |  |  |  | 0 | if (&$matchsub($leaf)) { | 
| 4471 |  |  |  |  |  |  | push @matched, "$head$leaf"; | 
| 4472 |  |  |  |  |  |  | next INNER; | 
| 4473 |  |  |  |  |  |  | } | 
| 4474 |  |  |  |  |  |  |  | 
| 4475 |  |  |  |  |  |  | # [DOS compatibility special case] | 
| 4476 | 0 | 0 | 0 |  |  | 0 | # Failed, add a trailing dot and try again, but only... | 
|  |  |  | 0 |  |  |  |  | 
| 4477 |  |  |  |  |  |  |  | 
| 4478 |  |  |  |  |  |  | if (Ebig5hkscs::index($leaf,'.') == -1 and   # if name does not have a dot in it *and* | 
| 4479 |  |  |  |  |  |  | CORE::length($leaf) <= 8 and        # name is shorter than or equal to 8 chars *and* | 
| 4480 | 0 | 0 |  |  |  | 0 | Ebig5hkscs::index($pattern,'\\.') != -1  # pattern has a dot. | 
| 4481 | 0 |  |  |  |  | 0 | ) { | 
| 4482 | 0 |  |  |  |  | 0 | if (&$matchsub("$leaf.")) { | 
| 4483 |  |  |  |  |  |  | push @matched, "$head$leaf"; | 
| 4484 |  |  |  |  |  |  | next INNER; | 
| 4485 |  |  |  |  |  |  | } | 
| 4486 | 0 | 0 |  |  |  | 0 | } | 
| 4487 | 0 |  |  |  |  | 0 | } | 
| 4488 |  |  |  |  |  |  | if (@matched) { | 
| 4489 |  |  |  |  |  |  | push @glob, @matched; | 
| 4490 | 0 | 0 |  |  |  | 0 | } | 
| 4491 | 0 |  |  |  |  | 0 | } | 
| 4492 | 0 |  |  |  |  | 0 | if ($fix_drive_relative_paths) { | 
| 4493 |  |  |  |  |  |  | for my $glob (@glob) { | 
| 4494 |  |  |  |  |  |  | $glob =~ s# \A ([A-Za-z]:) \./ #$1#oxms; | 
| 4495 | 0 |  |  |  |  | 0 | } | 
| 4496 |  |  |  |  |  |  | } | 
| 4497 |  |  |  |  |  |  | return @glob; | 
| 4498 |  |  |  |  |  |  | } | 
| 4499 |  |  |  |  |  |  |  | 
| 4500 |  |  |  |  |  |  | # | 
| 4501 |  |  |  |  |  |  | # Big5-HKSCS parse line | 
| 4502 |  |  |  |  |  |  | # | 
| 4503 | 0 |  |  | 0 |  | 0 | sub _parse_line { | 
| 4504 |  |  |  |  |  |  |  | 
| 4505 | 0 |  |  |  |  | 0 | my($line) = @_; | 
| 4506 | 0 |  |  |  |  | 0 |  | 
| 4507 | 0 |  |  |  |  | 0 | $line .= ' '; | 
| 4508 |  |  |  |  |  |  | my @piece = (); | 
| 4509 |  |  |  |  |  |  | while ($line =~ / | 
| 4510 |  |  |  |  |  |  | " ( (?>(?: [^\x81-\xFE"]  |[\x81-\xFE][\x00-\xFF] )* ) ) " (?>\s+) | | 
| 4511 |  |  |  |  |  |  | ( (?>(?: [^\x81-\xFE"\s]|[\x81-\xFE][\x00-\xFF] )* ) )   (?>\s+) | 
| 4512 | 0 | 0 |  |  |  | 0 | /oxmsg | 
| 4513 |  |  |  |  |  |  | ) { | 
| 4514 | 0 |  |  |  |  | 0 | push @piece, defined($1) ? $1 : $2; | 
| 4515 |  |  |  |  |  |  | } | 
| 4516 |  |  |  |  |  |  | return @piece; | 
| 4517 |  |  |  |  |  |  | } | 
| 4518 |  |  |  |  |  |  |  | 
| 4519 |  |  |  |  |  |  | # | 
| 4520 |  |  |  |  |  |  | # Big5-HKSCS parse path | 
| 4521 |  |  |  |  |  |  | # | 
| 4522 | 0 |  |  | 0 |  | 0 | sub _parse_path { | 
| 4523 |  |  |  |  |  |  |  | 
| 4524 | 0 |  |  |  |  | 0 | my($path,$pathsep) = @_; | 
| 4525 | 0 |  |  |  |  | 0 |  | 
| 4526 | 0 |  |  |  |  | 0 | $path .= '/'; | 
| 4527 |  |  |  |  |  |  | my @subpath = (); | 
| 4528 |  |  |  |  |  |  | while ($path =~ / | 
| 4529 |  |  |  |  |  |  | ((?: [^\x81-\xFE\/\\]|[\x81-\xFE][\x00-\xFF] )+?) [\/\\] | 
| 4530 | 0 |  |  |  |  | 0 | /oxmsg | 
| 4531 |  |  |  |  |  |  | ) { | 
| 4532 |  |  |  |  |  |  | push @subpath, $1; | 
| 4533 | 0 |  |  |  |  | 0 | } | 
| 4534 | 0 |  |  |  |  | 0 |  | 
| 4535 | 0 |  |  |  |  | 0 | my $tail = pop @subpath; | 
| 4536 |  |  |  |  |  |  | my $head = join $pathsep, @subpath; | 
| 4537 |  |  |  |  |  |  | return $head, $tail; | 
| 4538 |  |  |  |  |  |  | } | 
| 4539 |  |  |  |  |  |  |  | 
| 4540 |  |  |  |  |  |  | # | 
| 4541 |  |  |  |  |  |  | # via File::HomeDir::Windows 1.00 | 
| 4542 |  |  |  |  |  |  | # | 
| 4543 |  |  |  |  |  |  | sub my_home_MSWin32 { | 
| 4544 |  |  |  |  |  |  |  | 
| 4545 |  |  |  |  |  |  | # A lot of unix people and unix-derived tools rely on | 
| 4546 | 0 | 0 | 0 | 0 | 0 | 0 | # the ability to overload HOME. We will support it too | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 4547 | 0 |  |  |  |  | 0 | # so that they can replace raw HOME calls with File::HomeDir. | 
| 4548 |  |  |  |  |  |  | if (exists $ENV{'HOME'} and $ENV{'HOME'}) { | 
| 4549 |  |  |  |  |  |  | return $ENV{'HOME'}; | 
| 4550 |  |  |  |  |  |  | } | 
| 4551 |  |  |  |  |  |  |  | 
| 4552 | 0 |  |  |  |  | 0 | # Do we have a user profile? | 
| 4553 |  |  |  |  |  |  | elsif (exists $ENV{'USERPROFILE'} and $ENV{'USERPROFILE'}) { | 
| 4554 |  |  |  |  |  |  | return $ENV{'USERPROFILE'}; | 
| 4555 |  |  |  |  |  |  | } | 
| 4556 |  |  |  |  |  |  |  | 
| 4557 | 0 |  |  |  |  | 0 | # Some Windows use something like $ENV{'HOME'} | 
| 4558 |  |  |  |  |  |  | elsif (exists $ENV{'HOMEDRIVE'} and exists $ENV{'HOMEPATH'} and $ENV{'HOMEDRIVE'} and $ENV{'HOMEPATH'}) { | 
| 4559 |  |  |  |  |  |  | return join '', $ENV{'HOMEDRIVE'}, $ENV{'HOMEPATH'}; | 
| 4560 | 0 |  |  |  |  | 0 | } | 
| 4561 |  |  |  |  |  |  |  | 
| 4562 |  |  |  |  |  |  | return undef; | 
| 4563 |  |  |  |  |  |  | } | 
| 4564 |  |  |  |  |  |  |  | 
| 4565 |  |  |  |  |  |  | # | 
| 4566 |  |  |  |  |  |  | # via File::HomeDir::Unix 1.00 | 
| 4567 | 0 |  |  | 0 | 0 | 0 | # | 
| 4568 |  |  |  |  |  |  | sub my_home { | 
| 4569 | 0 | 0 | 0 |  |  | 0 | my $home; | 
|  |  | 0 | 0 |  |  |  |  | 
| 4570 | 0 |  |  |  |  | 0 |  | 
| 4571 |  |  |  |  |  |  | if (exists $ENV{'HOME'} and defined $ENV{'HOME'}) { | 
| 4572 |  |  |  |  |  |  | $home = $ENV{'HOME'}; | 
| 4573 |  |  |  |  |  |  | } | 
| 4574 |  |  |  |  |  |  |  | 
| 4575 |  |  |  |  |  |  | # This is from the original code, but I'm guessing | 
| 4576 | 0 |  |  |  |  | 0 | # it means "login directory" and exists on some Unixes. | 
| 4577 |  |  |  |  |  |  | elsif (exists $ENV{'LOGDIR'} and $ENV{'LOGDIR'}) { | 
| 4578 |  |  |  |  |  |  | $home = $ENV{'LOGDIR'}; | 
| 4579 |  |  |  |  |  |  | } | 
| 4580 |  |  |  |  |  |  |  | 
| 4581 |  |  |  |  |  |  | ### More-desperate methods | 
| 4582 |  |  |  |  |  |  |  | 
| 4583 | 0 |  |  |  |  | 0 | # Light desperation on any (Unixish) platform | 
| 4584 |  |  |  |  |  |  | else { | 
| 4585 |  |  |  |  |  |  | $home = CORE::eval q{ (getpwuid($<))[7] }; | 
| 4586 |  |  |  |  |  |  | } | 
| 4587 |  |  |  |  |  |  |  | 
| 4588 | 0 | 0 | 0 |  |  | 0 | # On Unix in general, a non-existant home means "no home" | 
| 4589 | 0 |  |  |  |  | 0 | # For example, "nobody"-like users might use /nonexistant | 
| 4590 |  |  |  |  |  |  | if (defined $home and ! Ebig5hkscs::d($home)) { | 
| 4591 | 0 |  |  |  |  | 0 | $home = undef; | 
| 4592 |  |  |  |  |  |  | } | 
| 4593 |  |  |  |  |  |  | return $home; | 
| 4594 |  |  |  |  |  |  | } | 
| 4595 |  |  |  |  |  |  |  | 
| 4596 |  |  |  |  |  |  | # | 
| 4597 |  |  |  |  |  |  | # Big5-HKSCS file lstat (with parameter) | 
| 4598 |  |  |  |  |  |  | # | 
| 4599 | 0 | 0 |  | 0 | 0 | 0 | sub Ebig5hkscs::lstat(*) { | 
| 4600 |  |  |  |  |  |  |  | 
| 4601 | 0 | 0 |  |  |  | 0 | local $_ = shift if @_; | 
|  |  | 0 |  |  |  |  |  | 
| 4602 | 0 |  |  |  |  | 0 |  | 
| 4603 |  |  |  |  |  |  | if (-e $_) { | 
| 4604 |  |  |  |  |  |  | return CORE::lstat _; | 
| 4605 |  |  |  |  |  |  | } | 
| 4606 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4607 |  |  |  |  |  |  |  | 
| 4608 |  |  |  |  |  |  | # Even if ${^WIN32_SLOPPY_STAT} is set to a true value, Ebig5hkscs::lstat() | 
| 4609 |  |  |  |  |  |  | # on Windows opens the file for the path which has 5c at end. | 
| 4610 | 0 |  |  |  |  | 0 | # (and so on) | 
| 4611 | 0 | 0 |  |  |  | 0 |  | 
| 4612 | 0 | 0 |  |  |  | 0 | local *MUST_BE_BAREWORD_AT_HERE; | 
| 4613 | 0 |  |  |  |  | 0 | if (CORE::open(MUST_BE_BAREWORD_AT_HERE, $_)) { | 
| 4614 | 0 |  |  |  |  | 0 | if (wantarray) { | 
| 4615 | 0 |  |  |  |  | 0 | my @stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; # not CORE::lstat | 
| 4616 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4617 |  |  |  |  |  |  | return @stat; | 
| 4618 | 0 |  |  |  |  | 0 | } | 
| 4619 | 0 |  |  |  |  | 0 | else { | 
| 4620 | 0 |  |  |  |  | 0 | my $stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; # not CORE::lstat | 
| 4621 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4622 |  |  |  |  |  |  | return $stat; | 
| 4623 |  |  |  |  |  |  | } | 
| 4624 | 0 | 0 |  |  |  | 0 | } | 
| 4625 |  |  |  |  |  |  | } | 
| 4626 |  |  |  |  |  |  | return wantarray ? () : undef; | 
| 4627 |  |  |  |  |  |  | } | 
| 4628 |  |  |  |  |  |  |  | 
| 4629 |  |  |  |  |  |  | # | 
| 4630 |  |  |  |  |  |  | # Big5-HKSCS file lstat (without parameter) | 
| 4631 |  |  |  |  |  |  | # | 
| 4632 | 0 | 0 |  | 0 | 0 | 0 | sub Ebig5hkscs::lstat_() { | 
|  |  | 0 |  |  |  |  |  | 
| 4633 | 0 |  |  |  |  | 0 |  | 
| 4634 |  |  |  |  |  |  | if (-e $_) { | 
| 4635 |  |  |  |  |  |  | return CORE::lstat _; | 
| 4636 | 0 |  |  |  |  | 0 | } | 
| 4637 | 0 | 0 |  |  |  | 0 | elsif (_MSWin32_5Cended_path($_)) { | 
| 4638 | 0 | 0 |  |  |  | 0 | local *MUST_BE_BAREWORD_AT_HERE; | 
| 4639 | 0 |  |  |  |  | 0 | if (CORE::open(MUST_BE_BAREWORD_AT_HERE, $_)) { | 
| 4640 | 0 |  |  |  |  | 0 | if (wantarray) { | 
| 4641 | 0 |  |  |  |  | 0 | my @stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; # not CORE::lstat | 
| 4642 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4643 |  |  |  |  |  |  | return @stat; | 
| 4644 | 0 |  |  |  |  | 0 | } | 
| 4645 | 0 |  |  |  |  | 0 | else { | 
| 4646 | 0 |  |  |  |  | 0 | my $stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; # not CORE::lstat | 
| 4647 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4648 |  |  |  |  |  |  | return $stat; | 
| 4649 |  |  |  |  |  |  | } | 
| 4650 | 0 | 0 |  |  |  | 0 | } | 
| 4651 |  |  |  |  |  |  | } | 
| 4652 |  |  |  |  |  |  | return wantarray ? () : undef; | 
| 4653 |  |  |  |  |  |  | } | 
| 4654 |  |  |  |  |  |  |  | 
| 4655 |  |  |  |  |  |  | # | 
| 4656 |  |  |  |  |  |  | # Big5-HKSCS path opendir | 
| 4657 |  |  |  |  |  |  | # | 
| 4658 | 0 |  |  | 0 | 0 | 0 | sub Ebig5hkscs::opendir(*$) { | 
| 4659 | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
| 4660 | 0 |  |  |  |  | 0 | my $dh = qualify_to_ref $_[0]; | 
| 4661 |  |  |  |  |  |  | if (CORE::opendir $dh, $_[1]) { | 
| 4662 |  |  |  |  |  |  | return 1; | 
| 4663 | 0 | 0 |  |  |  | 0 | } | 
| 4664 | 0 |  |  |  |  | 0 | elsif (_MSWin32_5Cended_path($_[1])) { | 
| 4665 |  |  |  |  |  |  | if (CORE::opendir $dh, "$_[1]/.") { | 
| 4666 |  |  |  |  |  |  | return 1; | 
| 4667 | 0 |  |  |  |  | 0 | } | 
| 4668 |  |  |  |  |  |  | } | 
| 4669 |  |  |  |  |  |  | return undef; | 
| 4670 |  |  |  |  |  |  | } | 
| 4671 |  |  |  |  |  |  |  | 
| 4672 |  |  |  |  |  |  | # | 
| 4673 |  |  |  |  |  |  | # Big5-HKSCS file stat (with parameter) | 
| 4674 |  |  |  |  |  |  | # | 
| 4675 | 0 | 50 |  | 384 | 0 | 0 | sub Ebig5hkscs::stat(*) { | 
| 4676 |  |  |  |  |  |  |  | 
| 4677 | 384 |  |  |  |  | 3306 | local $_ = shift if @_; | 
| 4678 | 384 | 50 |  |  |  | 2715 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4679 | 384 |  |  |  |  | 29240 | my $fh = qualify_to_ref $_; | 
| 4680 |  |  |  |  |  |  | if (defined fileno $fh) { | 
| 4681 |  |  |  |  |  |  | return CORE::stat $fh; | 
| 4682 | 0 |  |  |  |  | 0 | } | 
| 4683 |  |  |  |  |  |  | elsif (-e $_) { | 
| 4684 |  |  |  |  |  |  | return CORE::stat _; | 
| 4685 |  |  |  |  |  |  | } | 
| 4686 |  |  |  |  |  |  | elsif (_MSWin32_5Cended_path($_)) { | 
| 4687 |  |  |  |  |  |  |  | 
| 4688 |  |  |  |  |  |  | # Even if ${^WIN32_SLOPPY_STAT} is set to a true value, Ebig5hkscs::stat() | 
| 4689 |  |  |  |  |  |  | # on Windows opens the file for the path which has 5c at end. | 
| 4690 | 384 |  |  |  |  | 2889 | # (and so on) | 
| 4691 | 0 | 0 |  |  |  | 0 |  | 
| 4692 | 0 | 0 |  |  |  | 0 | local *MUST_BE_BAREWORD_AT_HERE; | 
| 4693 | 0 |  |  |  |  | 0 | if (CORE::open(MUST_BE_BAREWORD_AT_HERE, $_)) { | 
| 4694 | 0 |  |  |  |  | 0 | if (wantarray) { | 
| 4695 | 0 |  |  |  |  | 0 | my @stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; | 
| 4696 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4697 |  |  |  |  |  |  | return @stat; | 
| 4698 | 0 |  |  |  |  | 0 | } | 
| 4699 | 0 |  |  |  |  | 0 | else { | 
| 4700 | 0 |  |  |  |  | 0 | my $stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; | 
| 4701 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4702 |  |  |  |  |  |  | return $stat; | 
| 4703 |  |  |  |  |  |  | } | 
| 4704 | 0 | 0 |  |  |  | 0 | } | 
| 4705 |  |  |  |  |  |  | } | 
| 4706 |  |  |  |  |  |  | return wantarray ? () : undef; | 
| 4707 |  |  |  |  |  |  | } | 
| 4708 |  |  |  |  |  |  |  | 
| 4709 |  |  |  |  |  |  | # | 
| 4710 |  |  |  |  |  |  | # Big5-HKSCS file stat (without parameter) | 
| 4711 |  |  |  |  |  |  | # | 
| 4712 | 0 |  |  | 0 | 0 | 0 | sub Ebig5hkscs::stat_() { | 
| 4713 | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4714 | 0 |  |  |  |  | 0 | my $fh = qualify_to_ref $_; | 
| 4715 |  |  |  |  |  |  | if (defined fileno $fh) { | 
| 4716 |  |  |  |  |  |  | return CORE::stat $fh; | 
| 4717 | 0 |  |  |  |  | 0 | } | 
| 4718 |  |  |  |  |  |  | elsif (-e $_) { | 
| 4719 |  |  |  |  |  |  | return CORE::stat _; | 
| 4720 | 0 |  |  |  |  | 0 | } | 
| 4721 | 0 | 0 |  |  |  | 0 | elsif (_MSWin32_5Cended_path($_)) { | 
| 4722 | 0 | 0 |  |  |  | 0 | local *MUST_BE_BAREWORD_AT_HERE; | 
| 4723 | 0 |  |  |  |  | 0 | if (CORE::open(MUST_BE_BAREWORD_AT_HERE, $_)) { | 
| 4724 | 0 |  |  |  |  | 0 | if (wantarray) { | 
| 4725 | 0 |  |  |  |  | 0 | my @stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; | 
| 4726 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4727 |  |  |  |  |  |  | return @stat; | 
| 4728 | 0 |  |  |  |  | 0 | } | 
| 4729 | 0 |  |  |  |  | 0 | else { | 
| 4730 | 0 |  |  |  |  | 0 | my $stat = CORE::stat MUST_BE_BAREWORD_AT_HERE; | 
| 4731 |  |  |  |  |  |  | close MUST_BE_BAREWORD_AT_HERE; | 
| 4732 |  |  |  |  |  |  | return $stat; | 
| 4733 |  |  |  |  |  |  | } | 
| 4734 | 0 | 0 |  |  |  | 0 | } | 
| 4735 |  |  |  |  |  |  | } | 
| 4736 |  |  |  |  |  |  | return wantarray ? () : undef; | 
| 4737 |  |  |  |  |  |  | } | 
| 4738 |  |  |  |  |  |  |  | 
| 4739 |  |  |  |  |  |  | # | 
| 4740 |  |  |  |  |  |  | # Big5-HKSCS path unlink | 
| 4741 |  |  |  |  |  |  | # | 
| 4742 | 0 | 0 |  | 0 | 0 | 0 | sub Ebig5hkscs::unlink(@) { | 
| 4743 |  |  |  |  |  |  |  | 
| 4744 | 0 |  |  |  |  | 0 | local @_ = ($_) unless @_; | 
| 4745 | 0 |  |  |  |  | 0 |  | 
| 4746 | 0 | 0 |  |  |  | 0 | my $unlink = 0; | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4747 | 0 |  |  |  |  | 0 | for (@_) { | 
| 4748 |  |  |  |  |  |  | if (CORE::unlink) { | 
| 4749 |  |  |  |  |  |  | $unlink++; | 
| 4750 |  |  |  |  |  |  | } | 
| 4751 |  |  |  |  |  |  | elsif (Ebig5hkscs::d($_)) { | 
| 4752 | 0 |  |  |  |  | 0 | } | 
| 4753 | 0 | 0 |  |  |  | 0 | elsif (_MSWin32_5Cended_path($_)) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 4754 | 0 | 0 |  |  |  | 0 | my @char = /\G (?>$q_char) /oxmsg; | 
| 4755 | 0 |  |  |  |  | 0 | my $file = join '', map {{'/' => '\\'}->{$_} || $_} @char; | 
| 4756 |  |  |  |  |  |  | if ($file =~ / \A (?:$q_char)*? [ ] /oxms) { | 
| 4757 | 0 |  |  |  |  | 0 | $file = qq{"$file"}; | 
| 4758 | 0 | 0 |  |  |  | 0 | } | 
| 4759 | 0 |  |  |  |  | 0 | my $fh = gensym(); | 
| 4760 |  |  |  |  |  |  | if (_open_r($fh, $_)) { | 
| 4761 |  |  |  |  |  |  | close $fh; | 
| 4762 | 0 | 0 | 0 |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
| 4763 | 0 |  |  |  |  | 0 | # cmd.exe on Windows NT, Windows 2000, Windows XP, Windows Vista, Windows 7, Windows 8, Windows 8.1, Windows 10 or later | 
| 4764 |  |  |  |  |  |  | if ((defined $ENV{'OS'}) and ($ENV{'OS'} eq 'Windows_NT')) { | 
| 4765 |  |  |  |  |  |  | CORE::system 'DEL', '/F', $file, '2>NUL'; | 
| 4766 |  |  |  |  |  |  | } | 
| 4767 |  |  |  |  |  |  |  | 
| 4768 | 0 |  |  |  |  | 0 | # Win95Cmd.exe on any Windows (when SET PERL5SHELL=Win95Cmd.exe /c, `var` returns "Windows 2000") | 
| 4769 |  |  |  |  |  |  | elsif (qx{ver} =~ /\b(?:Windows 2000)\b/oms) { | 
| 4770 |  |  |  |  |  |  | CORE::system 'DEL', '/F', $file, '2>NUL'; | 
| 4771 |  |  |  |  |  |  | } | 
| 4772 |  |  |  |  |  |  |  | 
| 4773 |  |  |  |  |  |  | # COMMAND.COM on Windows 95, Windows 98, Windows 98 Second Edition, Windows Millennium Edition | 
| 4774 | 0 |  |  |  |  | 0 | # command.com can not "2>NUL" | 
| 4775 | 0 |  |  |  |  | 0 | else { | 
| 4776 |  |  |  |  |  |  | CORE::system 'ATTRIB', '-R', $file; # clears Read-only file attribute | 
| 4777 |  |  |  |  |  |  | CORE::system 'DEL',          $file; | 
| 4778 | 0 | 0 |  |  |  | 0 | } | 
| 4779 | 0 |  |  |  |  | 0 |  | 
| 4780 |  |  |  |  |  |  | if (_open_r($fh, $_)) { | 
| 4781 |  |  |  |  |  |  | close $fh; | 
| 4782 | 0 |  |  |  |  | 0 | } | 
| 4783 |  |  |  |  |  |  | else { | 
| 4784 |  |  |  |  |  |  | $unlink++; | 
| 4785 |  |  |  |  |  |  | } | 
| 4786 |  |  |  |  |  |  | } | 
| 4787 | 0 |  |  |  |  | 0 | } | 
| 4788 |  |  |  |  |  |  | } | 
| 4789 |  |  |  |  |  |  | return $unlink; | 
| 4790 |  |  |  |  |  |  | } | 
| 4791 |  |  |  |  |  |  |  | 
| 4792 |  |  |  |  |  |  | # | 
| 4793 |  |  |  |  |  |  | # Big5-HKSCS chdir | 
| 4794 |  |  |  |  |  |  | # | 
| 4795 | 0 | 0 |  | 0 | 0 | 0 | sub Ebig5hkscs::chdir(;$) { | 
| 4796 | 0 |  |  |  |  | 0 |  | 
| 4797 |  |  |  |  |  |  | if (@_ == 0) { | 
| 4798 |  |  |  |  |  |  | return CORE::chdir; | 
| 4799 | 0 |  |  |  |  | 0 | } | 
| 4800 |  |  |  |  |  |  |  | 
| 4801 | 0 | 0 |  |  |  | 0 | my($dir) = @_; | 
| 4802 | 0 | 0 |  |  |  | 0 |  | 
| 4803 | 0 |  |  |  |  | 0 | if (_MSWin32_5Cended_path($dir)) { | 
| 4804 |  |  |  |  |  |  | if (not Ebig5hkscs::d $dir) { | 
| 4805 |  |  |  |  |  |  | return 0; | 
| 4806 | 0 | 0 | 0 |  |  | 0 | } | 
|  |  | 0 |  |  |  |  |  | 
| 4807 | 0 |  |  |  |  | 0 |  | 
| 4808 |  |  |  |  |  |  | if ($] =~ /^5\.005/oxms) { | 
| 4809 |  |  |  |  |  |  | return CORE::chdir $dir; | 
| 4810 | 0 |  |  |  |  | 0 | } | 
| 4811 | 0 |  |  |  |  | 0 | elsif (($] =~ /^(?:5\.006|5\.008000)/oxms) and ($^O eq 'MSWin32')) { | 
| 4812 |  |  |  |  |  |  | local $@; | 
| 4813 |  |  |  |  |  |  | my $chdir = CORE::eval q{ | 
| 4814 |  |  |  |  |  |  | CORE::require 'jacode.pl'; | 
| 4815 |  |  |  |  |  |  |  | 
| 4816 |  |  |  |  |  |  | # P.676 ${^WIDE_SYSTEM_CALLS} | 
| 4817 |  |  |  |  |  |  | # in Chapter 28: Special Names | 
| 4818 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 4819 |  |  |  |  |  |  |  | 
| 4820 |  |  |  |  |  |  | # P.790 ${^WIDE_SYSTEM_CALLS} | 
| 4821 |  |  |  |  |  |  | # in Chapter 25: Special Names | 
| 4822 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 4823 |  |  |  |  |  |  |  | 
| 4824 |  |  |  |  |  |  | local ${^WIDE_SYSTEM_CALLS} = 1; | 
| 4825 | 0 | 0 |  |  |  | 0 | return CORE::chdir jcode::utf8($dir,'sjis'); | 
| 4826 | 0 |  |  |  |  | 0 | }; | 
| 4827 |  |  |  |  |  |  | if (not $@) { | 
| 4828 |  |  |  |  |  |  | return $chdir; | 
| 4829 |  |  |  |  |  |  | } | 
| 4830 |  |  |  |  |  |  | } | 
| 4831 |  |  |  |  |  |  |  | 
| 4832 |  |  |  |  |  |  | # old idea (Win32 module required) | 
| 4833 |  |  |  |  |  |  | elsif (0) { | 
| 4834 |  |  |  |  |  |  | local $@; | 
| 4835 |  |  |  |  |  |  | my $shortdir = ''; | 
| 4836 |  |  |  |  |  |  | my $chdir = CORE::eval q{ | 
| 4837 |  |  |  |  |  |  | use Win32; | 
| 4838 |  |  |  |  |  |  | $shortdir = Win32::GetShortPathName($dir); | 
| 4839 |  |  |  |  |  |  | if ($shortdir ne $dir) { | 
| 4840 |  |  |  |  |  |  | return CORE::chdir $shortdir; | 
| 4841 |  |  |  |  |  |  | } | 
| 4842 |  |  |  |  |  |  | else { | 
| 4843 |  |  |  |  |  |  | return 0; | 
| 4844 |  |  |  |  |  |  | } | 
| 4845 |  |  |  |  |  |  | }; | 
| 4846 |  |  |  |  |  |  | if ($@) { | 
| 4847 |  |  |  |  |  |  | my @char = $dir =~ /\G (?>$q_char) /oxmsg; | 
| 4848 |  |  |  |  |  |  | while ($char[-1] eq "\x5C") { | 
| 4849 |  |  |  |  |  |  | pop @char; | 
| 4850 |  |  |  |  |  |  | } | 
| 4851 |  |  |  |  |  |  | $dir = join '', @char; | 
| 4852 |  |  |  |  |  |  | croak "Perl$] can't chdir to $dir (chr(0x5C) ended path), Win32.pm module may help you"; | 
| 4853 |  |  |  |  |  |  | } | 
| 4854 |  |  |  |  |  |  | elsif ($shortdir eq $dir) { | 
| 4855 |  |  |  |  |  |  | my @char = $dir =~ /\G (?>$q_char) /oxmsg; | 
| 4856 |  |  |  |  |  |  | while ($char[-1] eq "\x5C") { | 
| 4857 |  |  |  |  |  |  | pop @char; | 
| 4858 |  |  |  |  |  |  | } | 
| 4859 |  |  |  |  |  |  | $dir = join '', @char; | 
| 4860 |  |  |  |  |  |  | croak "Perl$] can't chdir to $dir (chr(0x5C) ended path)"; | 
| 4861 |  |  |  |  |  |  | } | 
| 4862 |  |  |  |  |  |  | return $chdir; | 
| 4863 |  |  |  |  |  |  | } | 
| 4864 | 0 |  |  |  |  | 0 |  | 
| 4865 |  |  |  |  |  |  | # rejected idea ... | 
| 4866 |  |  |  |  |  |  | elsif (0) { | 
| 4867 |  |  |  |  |  |  |  | 
| 4868 |  |  |  |  |  |  | # MSDN SetCurrentDirectory function | 
| 4869 |  |  |  |  |  |  | # http://msdn.microsoft.com/ja-jp/library/windows/desktop/aa365530(v=vs.85).aspx | 
| 4870 |  |  |  |  |  |  | # | 
| 4871 |  |  |  |  |  |  | # Data Execution Prevention (DEP) | 
| 4872 |  |  |  |  |  |  | # http://vlaurie.com/computers2/Articles/dep.htm | 
| 4873 |  |  |  |  |  |  | # | 
| 4874 |  |  |  |  |  |  | # Learning x86 assembler with Perl -- Shibuya.pm#11 | 
| 4875 |  |  |  |  |  |  | # http://developer.cybozu.co.jp/takesako/2009/06/perl-x86-shibuy.html | 
| 4876 |  |  |  |  |  |  | # | 
| 4877 |  |  |  |  |  |  | # Introduction to Win32::API programming in Perl | 
| 4878 |  |  |  |  |  |  | # http://d.hatena.ne.jp/TAKESAKO/20090324/1237879559 | 
| 4879 |  |  |  |  |  |  | # | 
| 4880 |  |  |  |  |  |  | # DynaLoader - Dynamically load C libraries into Perl code | 
| 4881 |  |  |  |  |  |  | # http://perldoc.perl.org/DynaLoader.html | 
| 4882 |  |  |  |  |  |  | # | 
| 4883 |  |  |  |  |  |  | # Basic knowledge of DynaLoader | 
| 4884 |  |  |  |  |  |  | # http://blog.64p.org/entry/20090313/1236934042 | 
| 4885 |  |  |  |  |  |  |  | 
| 4886 |  |  |  |  |  |  | if (($] =~ /^5\.006/oxms)                     and | 
| 4887 |  |  |  |  |  |  | ($^O eq 'MSWin32')                        and | 
| 4888 |  |  |  |  |  |  | ($ENV{'PROCESSOR_ARCHITECTURE'} eq 'x86') and | 
| 4889 |  |  |  |  |  |  | CORE::eval(q{CORE::require 'Dyna'.'Loader'}) | 
| 4890 |  |  |  |  |  |  | ) { | 
| 4891 |  |  |  |  |  |  | my $x86 = join('', | 
| 4892 |  |  |  |  |  |  |  | 
| 4893 |  |  |  |  |  |  | # PUSH Iv | 
| 4894 |  |  |  |  |  |  | "\x68", pack('P', "$dir\\\0"), | 
| 4895 |  |  |  |  |  |  |  | 
| 4896 |  |  |  |  |  |  | # MOV eAX, Iv | 
| 4897 |  |  |  |  |  |  | "\xb8", pack('L', | 
| 4898 |  |  |  |  |  |  | *{'Dyna'.'Loader::dl_find_symbol'}{'CODE'}->( | 
| 4899 |  |  |  |  |  |  | *{'Dyna'.'Loader::dl_load_file'}{'CODE'}->("$ENV{'SystemRoot'}\\system32\\kernel32.dll"), | 
| 4900 |  |  |  |  |  |  | 'SetCurrentDirectoryA' | 
| 4901 |  |  |  |  |  |  | ) | 
| 4902 |  |  |  |  |  |  | ), | 
| 4903 |  |  |  |  |  |  |  | 
| 4904 |  |  |  |  |  |  | # CALL eAX | 
| 4905 |  |  |  |  |  |  | "\xff\xd0", | 
| 4906 |  |  |  |  |  |  |  | 
| 4907 |  |  |  |  |  |  | # RETN | 
| 4908 |  |  |  |  |  |  | "\xc3", | 
| 4909 |  |  |  |  |  |  | ); | 
| 4910 |  |  |  |  |  |  | *{'Dyna'.'Loader::dl_install_xsub'}{'CODE'}->('_SetCurrentDirectoryA', unpack('L', pack 'P', $x86)); | 
| 4911 |  |  |  |  |  |  | _SetCurrentDirectoryA(); | 
| 4912 |  |  |  |  |  |  | chomp(my $chdir = qx{chdir}); | 
| 4913 |  |  |  |  |  |  | if (Ebig5hkscs::fc($chdir) eq Ebig5hkscs::fc($dir)) { | 
| 4914 |  |  |  |  |  |  | return 1; | 
| 4915 |  |  |  |  |  |  | } | 
| 4916 |  |  |  |  |  |  | else { | 
| 4917 |  |  |  |  |  |  | return 0; | 
| 4918 |  |  |  |  |  |  | } | 
| 4919 |  |  |  |  |  |  | } | 
| 4920 |  |  |  |  |  |  | } | 
| 4921 |  |  |  |  |  |  |  | 
| 4922 |  |  |  |  |  |  | # COMMAND.COM's unhelpful tips: | 
| 4923 |  |  |  |  |  |  | # Displays a list of files and subdirectories in a directory. | 
| 4924 |  |  |  |  |  |  | # http://www.lagmonster.org/docs/DOS7/z-dir.html | 
| 4925 |  |  |  |  |  |  | # | 
| 4926 |  |  |  |  |  |  | # Syntax: | 
| 4927 |  |  |  |  |  |  | # | 
| 4928 |  |  |  |  |  |  | #   DIR [drive:] [path] [filename] [/Switches] | 
| 4929 |  |  |  |  |  |  | # | 
| 4930 |  |  |  |  |  |  | #   /Z Long file names are not displayed in the file listing | 
| 4931 |  |  |  |  |  |  | # | 
| 4932 |  |  |  |  |  |  | #  Limitations | 
| 4933 |  |  |  |  |  |  | #   The undocumented /Z switch (no long names) would appear to | 
| 4934 |  |  |  |  |  |  | #   have been not fully developed and has a couple of problems: | 
| 4935 |  |  |  |  |  |  | # | 
| 4936 |  |  |  |  |  |  | #  1. It will only work if: | 
| 4937 |  |  |  |  |  |  | #   There is no path specified (ie. for the current directory in | 
| 4938 |  |  |  |  |  |  | #   the current drive) | 
| 4939 |  |  |  |  |  |  | #   The path is specified as the root directory of any drive | 
| 4940 |  |  |  |  |  |  | #   (eg. C:\, D:\, etc.) | 
| 4941 |  |  |  |  |  |  | #   The path is specified as the current directory of any drive | 
| 4942 |  |  |  |  |  |  | #   by using the drive letter only (eg. C:, D:, etc.) | 
| 4943 |  |  |  |  |  |  | #   The path is specified as the parent directory using the .. | 
| 4944 |  |  |  |  |  |  | #   notation (eg. DIR .. /Z) | 
| 4945 |  |  |  |  |  |  | #   Any other syntax results in a "File Not Found" error message. | 
| 4946 |  |  |  |  |  |  | # | 
| 4947 |  |  |  |  |  |  | #  2. The /Z switch is compatable with the /S switch to show | 
| 4948 |  |  |  |  |  |  | #   subdirectories (as long as the above rules are followed) and | 
| 4949 |  |  |  |  |  |  | #   all the files are shown with short names only. The | 
| 4950 |  |  |  |  |  |  | #   subdirectories are also shown with short names only. However, | 
| 4951 |  |  |  |  |  |  | #   the header for each subdirectory after the first level gives | 
| 4952 |  |  |  |  |  |  | #   the subdirectory's long name. | 
| 4953 |  |  |  |  |  |  | # | 
| 4954 |  |  |  |  |  |  | #  3. The /Z switch is also compatable with the /B switch to give | 
| 4955 |  |  |  |  |  |  | #   a simple list of files with short names only. When used with | 
| 4956 |  |  |  |  |  |  | #   the /S switch as well, all files are listed with their full | 
| 4957 |  |  |  |  |  |  | #   paths. The file names themselves are all in short form, and | 
| 4958 |  |  |  |  |  |  | #   the path of those files in the current directory are in short | 
| 4959 |  |  |  |  |  |  | #   form, but the paths of any files in subdirectories are in | 
| 4960 | 0 |  |  |  |  | 0 | #   long filename form. | 
| 4961 | 0 |  |  |  |  | 0 |  | 
| 4962 | 0 |  |  |  |  | 0 | my $shortdir = ''; | 
| 4963 | 0 |  |  |  |  | 0 | my $i = 0; | 
| 4964 | 0 |  |  |  |  | 0 | my @subdir = (); | 
| 4965 | 0 | 0 | 0 |  |  | 0 | while ($dir =~ / \G ($q_char) /oxgc) { | 
| 4966 | 0 |  |  |  |  | 0 | my $char = $1; | 
| 4967 | 0 |  |  |  |  | 0 | if (($char eq '\\') or ($char eq '/')) { | 
| 4968 | 0 |  |  |  |  | 0 | $i++; | 
| 4969 |  |  |  |  |  |  | $subdir[$i] = $char; | 
| 4970 |  |  |  |  |  |  | $i++; | 
| 4971 | 0 |  |  |  |  | 0 | } | 
| 4972 |  |  |  |  |  |  | else { | 
| 4973 |  |  |  |  |  |  | $subdir[$i] .= $char; | 
| 4974 | 0 | 0 | 0 |  |  | 0 | } | 
| 4975 | 0 |  |  |  |  | 0 | } | 
| 4976 |  |  |  |  |  |  | if (($subdir[-1] eq '\\') or ($subdir[-1] eq '/')) { | 
| 4977 |  |  |  |  |  |  | pop @subdir; | 
| 4978 |  |  |  |  |  |  | } | 
| 4979 |  |  |  |  |  |  |  | 
| 4980 |  |  |  |  |  |  | # P.504 PERL5SHELL (Microsoft ports only) | 
| 4981 |  |  |  |  |  |  | # in Chapter 19: The Command-Line Interface | 
| 4982 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 4983 |  |  |  |  |  |  |  | 
| 4984 |  |  |  |  |  |  | # P.597 PERL5SHELL (Microsoft ports only) | 
| 4985 |  |  |  |  |  |  | # in Chapter 17: The Command-Line Interface | 
| 4986 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 4987 |  |  |  |  |  |  |  | 
| 4988 | 0 | 0 | 0 |  |  | 0 | # Win95Cmd.exe on any Windows (when SET PERL5SHELL=Win95Cmd.exe /c, `var` returns "Windows 2000") | 
|  |  | 0 |  |  |  |  |  | 
| 4989 | 0 |  |  |  |  | 0 | # cmd.exe on Windows NT, Windows 2000 | 
| 4990 | 0 |  |  |  |  | 0 | if (qx{ver} =~ /\b(?:Windows NT|Windows 2000)\b/oms) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 4991 | 0 | 0 |  |  |  | 0 | chomp(my @dirx = grep //oxms, qx{dir /ad /x "$dir*" 2>NUL}); | 
| 4992 |  |  |  |  |  |  | for my $dirx (sort { CORE::length($a) <=> CORE::length($b) } @dirx) { | 
| 4993 |  |  |  |  |  |  | if (Ebig5hkscs::fc(CORE::substr $dirx,-CORE::length($subdir[-1]),CORE::length($subdir[-1])) eq Ebig5hkscs::fc($subdir[-1])) { | 
| 4994 | 0 |  |  |  |  | 0 |  | 
| 4995 | 0 |  |  |  |  | 0 | # short file name (8dot3name) here-----vv | 
| 4996 | 0 |  |  |  |  | 0 | my $shortleafdir = CORE::substr $dirx, 39, 8+1+3; | 
| 4997 | 0 |  |  |  |  | 0 | $shortleafdir =~ s/ [ ]+ \z//oxms; | 
| 4998 |  |  |  |  |  |  | $shortdir = join '', @subdir[0..$#subdir-1], $shortleafdir; | 
| 4999 |  |  |  |  |  |  | last; | 
| 5000 |  |  |  |  |  |  | } | 
| 5001 |  |  |  |  |  |  | } | 
| 5002 |  |  |  |  |  |  | } | 
| 5003 |  |  |  |  |  |  |  | 
| 5004 |  |  |  |  |  |  | # an idea (not so portable, only Windows 2000 or later) | 
| 5005 |  |  |  |  |  |  | elsif (0) { | 
| 5006 |  |  |  |  |  |  | chomp($shortdir = qx{for %I in ("$dir") do \@echo %~sI 2>NUL}); | 
| 5007 |  |  |  |  |  |  | } | 
| 5008 |  |  |  |  |  |  |  | 
| 5009 | 0 |  |  |  |  | 0 | # cmd.exe on Windows XP, Windows Vista, Windows 7, Windows 8, Windows 8.1, Windows 10 or later | 
| 5010 | 0 |  |  |  |  | 0 | elsif ((defined $ENV{'OS'}) and ($ENV{'OS'} eq 'Windows_NT')) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 5011 | 0 | 0 |  |  |  | 0 | chomp(my @dirx = grep //oxms, qx{dir /ad /x "$dir*" 2>NUL}); | 
| 5012 |  |  |  |  |  |  | for my $dirx (sort { CORE::length($a) <=> CORE::length($b) } @dirx) { | 
| 5013 |  |  |  |  |  |  | if (Ebig5hkscs::fc(CORE::substr $dirx,-CORE::length($subdir[-1]),CORE::length($subdir[-1])) eq Ebig5hkscs::fc($subdir[-1])) { | 
| 5014 | 0 |  |  |  |  | 0 |  | 
| 5015 | 0 |  |  |  |  | 0 | # short file name (8dot3name) here-----vv | 
| 5016 | 0 |  |  |  |  | 0 | my $shortleafdir = CORE::substr $dirx, 36, 8+1+3; | 
| 5017 | 0 |  |  |  |  | 0 | $shortleafdir =~ s/ [ ]+ \z//oxms; | 
| 5018 |  |  |  |  |  |  | $shortdir = join '', @subdir[0..$#subdir-1], $shortleafdir; | 
| 5019 |  |  |  |  |  |  | last; | 
| 5020 |  |  |  |  |  |  | } | 
| 5021 |  |  |  |  |  |  | } | 
| 5022 |  |  |  |  |  |  | } | 
| 5023 |  |  |  |  |  |  |  | 
| 5024 | 0 |  |  |  |  | 0 | # COMMAND.COM on Windows 95, Windows 98, Windows 98 Second Edition, Windows Millennium Edition | 
| 5025 | 0 |  |  |  |  | 0 | else { | 
|  | 0 |  |  |  |  | 0 |  | 
| 5026 | 0 | 0 |  |  |  | 0 | chomp(my @dirx = grep //oxms, qx{dir /ad "$dir*"}); | 
| 5027 |  |  |  |  |  |  | for my $dirx (sort { CORE::length($a) <=> CORE::length($b) } @dirx) { | 
| 5028 |  |  |  |  |  |  | if (Ebig5hkscs::fc(CORE::substr $dirx,-CORE::length($subdir[-1]),CORE::length($subdir[-1])) eq Ebig5hkscs::fc($subdir[-1])) { | 
| 5029 | 0 |  |  |  |  | 0 |  | 
| 5030 | 0 |  |  |  |  | 0 | # short file name (8dot3name) here-----v | 
| 5031 | 0 |  |  |  |  | 0 | my $shortleafdir = CORE::substr $dirx, 0, 8+1+3; | 
| 5032 | 0 |  |  |  |  | 0 | CORE::substr($shortleafdir,8,1) = '.'; | 
| 5033 | 0 |  |  |  |  | 0 | $shortleafdir =~ s/ \. [ ]+ \z//oxms; | 
| 5034 |  |  |  |  |  |  | $shortdir = join '', @subdir[0..$#subdir-1], $shortleafdir; | 
| 5035 |  |  |  |  |  |  | last; | 
| 5036 |  |  |  |  |  |  | } | 
| 5037 |  |  |  |  |  |  | } | 
| 5038 | 0 | 0 |  |  |  | 0 | } | 
|  |  | 0 |  |  |  |  |  | 
| 5039 | 0 |  |  |  |  | 0 |  | 
| 5040 |  |  |  |  |  |  | if ($shortdir eq '') { | 
| 5041 |  |  |  |  |  |  | return 0; | 
| 5042 | 0 |  |  |  |  | 0 | } | 
| 5043 |  |  |  |  |  |  | elsif (Ebig5hkscs::fc($shortdir) eq Ebig5hkscs::fc($dir)) { | 
| 5044 | 0 |  |  |  |  | 0 | return 0; | 
| 5045 |  |  |  |  |  |  | } | 
| 5046 |  |  |  |  |  |  | return CORE::chdir $shortdir; | 
| 5047 | 0 |  |  |  |  | 0 | } | 
| 5048 |  |  |  |  |  |  | else { | 
| 5049 |  |  |  |  |  |  | return CORE::chdir $dir; | 
| 5050 |  |  |  |  |  |  | } | 
| 5051 |  |  |  |  |  |  | } | 
| 5052 |  |  |  |  |  |  |  | 
| 5053 |  |  |  |  |  |  | # | 
| 5054 |  |  |  |  |  |  | # Big5-HKSCS chr(0x5C) ended path on MSWin32 | 
| 5055 |  |  |  |  |  |  | # | 
| 5056 | 0 | 50 | 33 | 768 |  | 0 | sub _MSWin32_5Cended_path { | 
| 5057 | 768 | 50 |  |  |  | 5374 |  | 
| 5058 | 768 |  |  |  |  | 4289 | if ((@_ >= 1) and ($_[0] ne '')) { | 
| 5059 | 0 | 0 |  |  |  | 0 | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 5060 | 0 |  |  |  |  | 0 | my @char = $_[0] =~ /\G (?>$q_char) /oxmsg; | 
| 5061 |  |  |  |  |  |  | if ($char[-1] =~ / \x5C \z/oxms) { | 
| 5062 |  |  |  |  |  |  | return 1; | 
| 5063 |  |  |  |  |  |  | } | 
| 5064 | 0 |  |  |  |  | 0 | } | 
| 5065 |  |  |  |  |  |  | } | 
| 5066 |  |  |  |  |  |  | return undef; | 
| 5067 |  |  |  |  |  |  | } | 
| 5068 |  |  |  |  |  |  |  | 
| 5069 |  |  |  |  |  |  | # | 
| 5070 |  |  |  |  |  |  | # do Big5-HKSCS file | 
| 5071 |  |  |  |  |  |  | # | 
| 5072 | 768 |  |  | 0 | 0 | 2104 | sub Ebig5hkscs::do($) { | 
| 5073 |  |  |  |  |  |  |  | 
| 5074 | 0 |  |  |  |  | 0 | my($filename) = @_; | 
| 5075 |  |  |  |  |  |  |  | 
| 5076 |  |  |  |  |  |  | my $realfilename; | 
| 5077 |  |  |  |  |  |  | my $result; | 
| 5078 | 0 |  |  |  |  | 0 | ITER_DO: | 
|  | 0 |  |  |  |  | 0 |  | 
| 5079 | 0 | 0 |  |  |  | 0 | { | 
| 5080 | 0 |  |  |  |  | 0 | for my $prefix (@INC) { | 
| 5081 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5082 |  |  |  |  |  |  | $realfilename = "$prefix$filename"; | 
| 5083 | 0 |  |  |  |  | 0 | } | 
| 5084 |  |  |  |  |  |  | else { | 
| 5085 |  |  |  |  |  |  | $realfilename = "$prefix/$filename"; | 
| 5086 | 0 | 0 |  |  |  | 0 | } | 
| 5087 |  |  |  |  |  |  |  | 
| 5088 | 0 |  |  |  |  | 0 | if (Ebig5hkscs::f($realfilename)) { | 
| 5089 |  |  |  |  |  |  |  | 
| 5090 | 0 | 0 |  |  |  | 0 | my $script = ''; | 
| 5091 | 0 |  |  |  |  | 0 |  | 
| 5092 | 0 |  |  |  |  | 0 | if (Ebig5hkscs::e("$realfilename.e")) { | 
| 5093 | 0 |  |  |  |  | 0 | my $e_mtime      = (Ebig5hkscs::stat("$realfilename.e"))[9]; | 
| 5094 | 0 | 0 | 0 |  |  | 0 | my $mtime        = (Ebig5hkscs::stat($realfilename))[9]; | 
| 5095 | 0 |  |  |  |  | 0 | my $module_mtime = (Ebig5hkscs::stat(__FILE__))[9]; | 
| 5096 |  |  |  |  |  |  | if (($e_mtime < $mtime) or ($mtime < $module_mtime)) { | 
| 5097 |  |  |  |  |  |  | Ebig5hkscs::unlink "$realfilename.e"; | 
| 5098 |  |  |  |  |  |  | } | 
| 5099 | 0 | 0 |  |  |  | 0 | } | 
| 5100 | 0 |  |  |  |  | 0 |  | 
| 5101 | 0 | 0 |  |  |  | 0 | if (Ebig5hkscs::e("$realfilename.e")) { | 
| 5102 | 0 | 0 |  |  |  | 0 | my $fh = gensym(); | 
|  |  | 0 |  |  |  |  |  | 
| 5103 | 0 |  |  |  |  | 0 | if (_open_r($fh, "$realfilename.e")) { | 
| 5104 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5105 |  |  |  |  |  |  | CORE::eval q{ | 
| 5106 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5107 |  |  |  |  |  |  | Mac::Files::FSpSetFLock("$realfilename.e"); | 
| 5108 |  |  |  |  |  |  | }; | 
| 5109 |  |  |  |  |  |  | } | 
| 5110 |  |  |  |  |  |  | elsif (exists $ENV{'CHAR_NONBLOCK'}) { | 
| 5111 |  |  |  |  |  |  |  | 
| 5112 |  |  |  |  |  |  | # P.419 File Locking | 
| 5113 |  |  |  |  |  |  | # in Chapter 16: Interprocess Communication | 
| 5114 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 5115 |  |  |  |  |  |  |  | 
| 5116 |  |  |  |  |  |  | # P.524 File Locking | 
| 5117 |  |  |  |  |  |  | # in Chapter 15: Interprocess Communication | 
| 5118 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 5119 |  |  |  |  |  |  |  | 
| 5120 | 0 |  |  |  |  | 0 | # (and so on) | 
| 5121 | 0 | 0 |  |  |  | 0 |  | 
| 5122 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH | LOCK_NB) }; | 
| 5123 |  |  |  |  |  |  | if ($@) { | 
| 5124 |  |  |  |  |  |  | carp "Can't immediately read-lock the file: $realfilename.e"; | 
| 5125 |  |  |  |  |  |  | } | 
| 5126 | 0 |  |  |  |  | 0 | } | 
| 5127 |  |  |  |  |  |  | else { | 
| 5128 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH) }; | 
| 5129 | 0 |  |  |  |  | 0 | } | 
| 5130 | 0 | 0 |  |  |  | 0 | local $/ = undef; # slurp mode | 
| 5131 | 0 |  |  |  |  | 0 | $script = <$fh>; | 
| 5132 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5133 |  |  |  |  |  |  | CORE::eval q{ | 
| 5134 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5135 |  |  |  |  |  |  | Mac::Files::FSpRstFLock("$realfilename.e"); | 
| 5136 | 0 |  |  |  |  | 0 | }; | 
| 5137 |  |  |  |  |  |  | } | 
| 5138 |  |  |  |  |  |  | close $fh; | 
| 5139 |  |  |  |  |  |  | } | 
| 5140 | 0 |  |  |  |  | 0 | } | 
| 5141 | 0 | 0 |  |  |  | 0 | else { | 
| 5142 | 0 | 0 |  |  |  | 0 | my $fh = gensym(); | 
|  |  | 0 |  |  |  |  |  | 
| 5143 | 0 |  |  |  |  | 0 | if (_open_r($fh, $realfilename)) { | 
| 5144 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5145 |  |  |  |  |  |  | CORE::eval q{ | 
| 5146 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5147 |  |  |  |  |  |  | Mac::Files::FSpSetFLock($realfilename); | 
| 5148 |  |  |  |  |  |  | }; | 
| 5149 | 0 |  |  |  |  | 0 | } | 
| 5150 | 0 | 0 |  |  |  | 0 | elsif (exists $ENV{'CHAR_NONBLOCK'}) { | 
| 5151 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH | LOCK_NB) }; | 
| 5152 |  |  |  |  |  |  | if ($@) { | 
| 5153 |  |  |  |  |  |  | carp "Can't immediately read-lock the file: $realfilename"; | 
| 5154 |  |  |  |  |  |  | } | 
| 5155 | 0 |  |  |  |  | 0 | } | 
| 5156 |  |  |  |  |  |  | else { | 
| 5157 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH) }; | 
| 5158 | 0 |  |  |  |  | 0 | } | 
| 5159 | 0 | 0 |  |  |  | 0 | local $/ = undef; # slurp mode | 
| 5160 | 0 |  |  |  |  | 0 | $script = <$fh>; | 
| 5161 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5162 |  |  |  |  |  |  | CORE::eval q{ | 
| 5163 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5164 |  |  |  |  |  |  | Mac::Files::FSpRstFLock($realfilename); | 
| 5165 | 0 |  |  |  |  | 0 | }; | 
| 5166 |  |  |  |  |  |  | } | 
| 5167 |  |  |  |  |  |  | close $fh; | 
| 5168 | 0 | 0 |  |  |  | 0 | } | 
| 5169 | 0 |  |  |  |  | 0 |  | 
| 5170 | 0 |  |  |  |  | 0 | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 5171 | 0 |  |  |  |  | 0 | CORE::require Big5HKSCS; | 
| 5172 | 0 | 0 |  |  |  | 0 | $script = Big5HKSCS::escape_script($script); | 
| 5173 | 0 | 0 |  |  |  | 0 | my $fh = gensym(); | 
|  |  | 0 |  |  |  |  |  | 
| 5174 | 0 |  |  |  |  | 0 | open($fh, ">$realfilename.e") or die __FILE__, ": Can't write open file: $realfilename.e\n"; | 
| 5175 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5176 |  |  |  |  |  |  | CORE::eval q{ | 
| 5177 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5178 |  |  |  |  |  |  | Mac::Files::FSpSetFLock("$realfilename.e"); | 
| 5179 |  |  |  |  |  |  | }; | 
| 5180 | 0 |  |  |  |  | 0 | } | 
| 5181 | 0 | 0 |  |  |  | 0 | elsif (exists $ENV{'CHAR_NONBLOCK'}) { | 
| 5182 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_EX | LOCK_NB) }; | 
| 5183 |  |  |  |  |  |  | if ($@) { | 
| 5184 |  |  |  |  |  |  | carp "Can't immediately write-lock the file: $realfilename.e"; | 
| 5185 |  |  |  |  |  |  | } | 
| 5186 | 0 |  |  |  |  | 0 | } | 
| 5187 |  |  |  |  |  |  | else { | 
| 5188 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_EX) }; | 
| 5189 | 0 | 0 |  |  |  | 0 | } | 
| 5190 | 0 |  |  |  |  | 0 | CORE::eval q{ truncate($fh, 0) }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 5191 | 0 | 0 |  |  |  | 0 | seek($fh, 0, 0) or croak "Can't seek file: $realfilename.e"; | 
| 5192 | 0 |  |  |  |  | 0 | print {$fh} $script; | 
| 5193 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5194 |  |  |  |  |  |  | CORE::eval q{ | 
| 5195 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5196 |  |  |  |  |  |  | Mac::Files::FSpRstFLock("$realfilename.e"); | 
| 5197 | 0 |  |  |  |  | 0 | }; | 
| 5198 |  |  |  |  |  |  | } | 
| 5199 |  |  |  |  |  |  | close $fh; | 
| 5200 |  |  |  |  |  |  | } | 
| 5201 |  |  |  |  |  |  | } | 
| 5202 | 389 |  |  | 389 |  | 12925 |  | 
|  | 389 |  |  |  |  | 2903 |  | 
|  | 389 |  |  |  |  | 365333 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 5203 | 0 |  |  |  |  | 0 | { | 
| 5204 |  |  |  |  |  |  | no strict; | 
| 5205 | 0 |  |  |  |  | 0 | $result = scalar CORE::eval $script; | 
| 5206 |  |  |  |  |  |  | } | 
| 5207 |  |  |  |  |  |  | last ITER_DO; | 
| 5208 |  |  |  |  |  |  | } | 
| 5209 |  |  |  |  |  |  | } | 
| 5210 | 0 | 0 |  |  |  | 0 | } | 
|  |  | 0 |  |  |  |  |  | 
| 5211 | 0 |  |  |  |  | 0 |  | 
| 5212 | 0 |  |  |  |  | 0 | if ($@) { | 
| 5213 |  |  |  |  |  |  | $INC{$filename} = undef; | 
| 5214 |  |  |  |  |  |  | return undef; | 
| 5215 | 0 |  |  |  |  | 0 | } | 
| 5216 |  |  |  |  |  |  | elsif (not $result) { | 
| 5217 |  |  |  |  |  |  | return undef; | 
| 5218 | 0 |  |  |  |  | 0 | } | 
| 5219 | 0 |  |  |  |  | 0 | else { | 
| 5220 |  |  |  |  |  |  | $INC{$filename} = $realfilename; | 
| 5221 |  |  |  |  |  |  | return $result; | 
| 5222 |  |  |  |  |  |  | } | 
| 5223 |  |  |  |  |  |  | } | 
| 5224 |  |  |  |  |  |  |  | 
| 5225 |  |  |  |  |  |  | # | 
| 5226 |  |  |  |  |  |  | # require Big5-HKSCS file | 
| 5227 |  |  |  |  |  |  | # | 
| 5228 |  |  |  |  |  |  |  | 
| 5229 |  |  |  |  |  |  | # require | 
| 5230 |  |  |  |  |  |  | # in Chapter 3: Functions | 
| 5231 |  |  |  |  |  |  | # of ISBN 1-56592-149-6 Programming Perl, Second Edition. | 
| 5232 |  |  |  |  |  |  | # | 
| 5233 |  |  |  |  |  |  | # sub require { | 
| 5234 |  |  |  |  |  |  | #     my($filename) = @_; | 
| 5235 |  |  |  |  |  |  | #     return 1 if $INC{$filename}; | 
| 5236 |  |  |  |  |  |  | #     my($realfilename, $result); | 
| 5237 |  |  |  |  |  |  | #     ITER: { | 
| 5238 |  |  |  |  |  |  | #         foreach $prefix (@INC) { | 
| 5239 |  |  |  |  |  |  | #             $realfilename = "$prefix/$filename"; | 
| 5240 |  |  |  |  |  |  | #             if (-f $realfilename) { | 
| 5241 |  |  |  |  |  |  | #                 $result = CORE::eval `cat $realfilename`; | 
| 5242 |  |  |  |  |  |  | #                 last ITER; | 
| 5243 |  |  |  |  |  |  | #             } | 
| 5244 |  |  |  |  |  |  | #         } | 
| 5245 |  |  |  |  |  |  | #         die "Can't find $filename in \@INC"; | 
| 5246 |  |  |  |  |  |  | #     } | 
| 5247 |  |  |  |  |  |  | #     die $@ if $@; | 
| 5248 |  |  |  |  |  |  | #     die "$filename did not return true value" unless $result; | 
| 5249 |  |  |  |  |  |  | #     $INC{$filename} = $realfilename; | 
| 5250 |  |  |  |  |  |  | #     return $result; | 
| 5251 |  |  |  |  |  |  | # } | 
| 5252 |  |  |  |  |  |  |  | 
| 5253 |  |  |  |  |  |  | # require | 
| 5254 |  |  |  |  |  |  | # in Chapter 9: perlfunc: Perl builtin functions | 
| 5255 |  |  |  |  |  |  | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
| 5256 |  |  |  |  |  |  | # | 
| 5257 |  |  |  |  |  |  | # sub require { | 
| 5258 |  |  |  |  |  |  | #     my($filename) = @_; | 
| 5259 |  |  |  |  |  |  | #     if (exists $INC{$filename}) { | 
| 5260 |  |  |  |  |  |  | #         return 1 if $INC{$filename}; | 
| 5261 |  |  |  |  |  |  | #         die "Compilation failed in require"; | 
| 5262 |  |  |  |  |  |  | #     } | 
| 5263 |  |  |  |  |  |  | #     my($realfilename, $result); | 
| 5264 |  |  |  |  |  |  | #     ITER: { | 
| 5265 |  |  |  |  |  |  | #         foreach $prefix (@INC) { | 
| 5266 |  |  |  |  |  |  | #             $realfilename = "$prefix/$filename"; | 
| 5267 |  |  |  |  |  |  | #             if (-f $realfilename) { | 
| 5268 |  |  |  |  |  |  | #                 $INC{$filename} = $realfilename; | 
| 5269 |  |  |  |  |  |  | #                 $result = do $realfilename; | 
| 5270 |  |  |  |  |  |  | #                 last ITER; | 
| 5271 |  |  |  |  |  |  | #             } | 
| 5272 |  |  |  |  |  |  | #         } | 
| 5273 |  |  |  |  |  |  | #         die "Can't find $filename in \@INC"; | 
| 5274 |  |  |  |  |  |  | #     } | 
| 5275 |  |  |  |  |  |  | #     if ($@) { | 
| 5276 |  |  |  |  |  |  | #         $INC{$filename} = undef; | 
| 5277 |  |  |  |  |  |  | #         die $@; | 
| 5278 |  |  |  |  |  |  | #     } | 
| 5279 |  |  |  |  |  |  | #     elsif (!$result) { | 
| 5280 |  |  |  |  |  |  | #         delete $INC{$filename}; | 
| 5281 |  |  |  |  |  |  | #         die "$filename did not return true value"; | 
| 5282 |  |  |  |  |  |  | #     } | 
| 5283 |  |  |  |  |  |  | #     else { | 
| 5284 |  |  |  |  |  |  | #         return $result; | 
| 5285 |  |  |  |  |  |  | #     } | 
| 5286 |  |  |  |  |  |  | # } | 
| 5287 |  |  |  |  |  |  |  | 
| 5288 | 0 | 0 |  | 0 | 0 | 0 | sub Ebig5hkscs::require(;$) { | 
| 5289 |  |  |  |  |  |  |  | 
| 5290 | 0 | 0 |  |  |  | 0 | local $_ = shift if @_; | 
| 5291 | 0 | 0 |  |  |  | 0 |  | 
| 5292 | 0 |  |  |  |  | 0 | if (exists $INC{$_}) { | 
| 5293 |  |  |  |  |  |  | return 1 if $INC{$_}; | 
| 5294 |  |  |  |  |  |  | croak "Compilation failed in require: $_"; | 
| 5295 |  |  |  |  |  |  | } | 
| 5296 |  |  |  |  |  |  |  | 
| 5297 |  |  |  |  |  |  | # jcode.pl | 
| 5298 |  |  |  |  |  |  | # ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/ | 
| 5299 |  |  |  |  |  |  |  | 
| 5300 |  |  |  |  |  |  | # jacode.pl | 
| 5301 | 0 | 0 |  |  |  | 0 | # http://search.cpan.org/dist/jacode/ | 
| 5302 | 0 |  |  |  |  | 0 |  | 
| 5303 |  |  |  |  |  |  | if (/ \b (?: jcode\.pl | jacode(?>[0-9]*)\.pl ) \z /oxms) { | 
| 5304 |  |  |  |  |  |  | return CORE::require($_); | 
| 5305 | 0 |  |  |  |  | 0 | } | 
| 5306 |  |  |  |  |  |  |  | 
| 5307 |  |  |  |  |  |  | my $realfilename; | 
| 5308 |  |  |  |  |  |  | my $result; | 
| 5309 | 0 |  |  |  |  | 0 | ITER_REQUIRE: | 
|  | 0 |  |  |  |  | 0 |  | 
| 5310 | 0 | 0 |  |  |  | 0 | { | 
| 5311 | 0 |  |  |  |  | 0 | for my $prefix (@INC) { | 
| 5312 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5313 |  |  |  |  |  |  | $realfilename = "$prefix$_"; | 
| 5314 | 0 |  |  |  |  | 0 | } | 
| 5315 |  |  |  |  |  |  | else { | 
| 5316 |  |  |  |  |  |  | $realfilename = "$prefix/$_"; | 
| 5317 | 0 | 0 |  |  |  | 0 | } | 
| 5318 | 0 |  |  |  |  | 0 |  | 
| 5319 |  |  |  |  |  |  | if (Ebig5hkscs::f($realfilename)) { | 
| 5320 | 0 |  |  |  |  | 0 | $INC{$_} = $realfilename; | 
| 5321 |  |  |  |  |  |  |  | 
| 5322 | 0 | 0 |  |  |  | 0 | my $script = ''; | 
| 5323 | 0 |  |  |  |  | 0 |  | 
| 5324 | 0 |  |  |  |  | 0 | if (Ebig5hkscs::e("$realfilename.e")) { | 
| 5325 | 0 |  |  |  |  | 0 | my $e_mtime      = (Ebig5hkscs::stat("$realfilename.e"))[9]; | 
| 5326 | 0 | 0 | 0 |  |  | 0 | my $mtime        = (Ebig5hkscs::stat($realfilename))[9]; | 
| 5327 | 0 |  |  |  |  | 0 | my $module_mtime = (Ebig5hkscs::stat(__FILE__))[9]; | 
| 5328 |  |  |  |  |  |  | if (($e_mtime < $mtime) or ($mtime < $module_mtime)) { | 
| 5329 |  |  |  |  |  |  | Ebig5hkscs::unlink "$realfilename.e"; | 
| 5330 |  |  |  |  |  |  | } | 
| 5331 | 0 | 0 |  |  |  | 0 | } | 
| 5332 | 0 |  |  |  |  | 0 |  | 
| 5333 | 0 | 0 |  |  |  | 0 | if (Ebig5hkscs::e("$realfilename.e")) { | 
| 5334 | 0 | 0 |  |  |  | 0 | my $fh = gensym(); | 
|  |  | 0 |  |  |  |  |  | 
| 5335 | 0 |  |  |  |  | 0 | _open_r($fh, "$realfilename.e") or croak "Can't open file: $realfilename.e"; | 
| 5336 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5337 |  |  |  |  |  |  | CORE::eval q{ | 
| 5338 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5339 |  |  |  |  |  |  | Mac::Files::FSpSetFLock("$realfilename.e"); | 
| 5340 |  |  |  |  |  |  | }; | 
| 5341 | 0 |  |  |  |  | 0 | } | 
| 5342 | 0 | 0 |  |  |  | 0 | elsif (exists $ENV{'CHAR_NONBLOCK'}) { | 
| 5343 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH | LOCK_NB) }; | 
| 5344 |  |  |  |  |  |  | if ($@) { | 
| 5345 |  |  |  |  |  |  | carp "Can't immediately read-lock the file: $realfilename.e"; | 
| 5346 |  |  |  |  |  |  | } | 
| 5347 | 0 |  |  |  |  | 0 | } | 
| 5348 |  |  |  |  |  |  | else { | 
| 5349 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH) }; | 
| 5350 | 0 |  |  |  |  | 0 | } | 
| 5351 | 0 | 0 |  |  |  | 0 | local $/ = undef; # slurp mode | 
| 5352 | 0 |  |  |  |  | 0 | $script = <$fh>; | 
| 5353 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5354 |  |  |  |  |  |  | CORE::eval q{ | 
| 5355 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5356 |  |  |  |  |  |  | Mac::Files::FSpRstFLock("$realfilename.e"); | 
| 5357 | 0 | 0 |  |  |  | 0 | }; | 
| 5358 |  |  |  |  |  |  | } | 
| 5359 |  |  |  |  |  |  | close($fh) or croak "Can't close file: $realfilename"; | 
| 5360 | 0 |  |  |  |  | 0 | } | 
| 5361 | 0 | 0 |  |  |  | 0 | else { | 
| 5362 | 0 | 0 |  |  |  | 0 | my $fh = gensym(); | 
|  |  | 0 |  |  |  |  |  | 
| 5363 | 0 |  |  |  |  | 0 | _open_r($fh, $realfilename) or croak "Can't open file: $realfilename"; | 
| 5364 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5365 |  |  |  |  |  |  | CORE::eval q{ | 
| 5366 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5367 |  |  |  |  |  |  | Mac::Files::FSpSetFLock($realfilename); | 
| 5368 |  |  |  |  |  |  | }; | 
| 5369 | 0 |  |  |  |  | 0 | } | 
| 5370 | 0 | 0 |  |  |  | 0 | elsif (exists $ENV{'CHAR_NONBLOCK'}) { | 
| 5371 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH | LOCK_NB) }; | 
| 5372 |  |  |  |  |  |  | if ($@) { | 
| 5373 |  |  |  |  |  |  | carp "Can't immediately read-lock the file: $realfilename"; | 
| 5374 |  |  |  |  |  |  | } | 
| 5375 | 0 |  |  |  |  | 0 | } | 
| 5376 |  |  |  |  |  |  | else { | 
| 5377 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_SH) }; | 
| 5378 | 0 |  |  |  |  | 0 | } | 
| 5379 | 0 | 0 |  |  |  | 0 | local $/ = undef; # slurp mode | 
| 5380 | 0 |  |  |  |  | 0 | $script = <$fh>; | 
| 5381 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5382 |  |  |  |  |  |  | CORE::eval q{ | 
| 5383 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5384 |  |  |  |  |  |  | Mac::Files::FSpRstFLock($realfilename); | 
| 5385 | 0 | 0 |  |  |  | 0 | }; | 
| 5386 |  |  |  |  |  |  | } | 
| 5387 | 0 | 0 |  |  |  | 0 | close($fh) or croak "Can't close file: $realfilename"; | 
| 5388 | 0 |  |  |  |  | 0 |  | 
| 5389 | 0 |  |  |  |  | 0 | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 5390 | 0 |  |  |  |  | 0 | CORE::require Big5HKSCS; | 
| 5391 | 0 | 0 |  |  |  | 0 | $script = Big5HKSCS::escape_script($script); | 
| 5392 | 0 | 0 |  |  |  | 0 | my $fh = gensym(); | 
|  |  | 0 |  |  |  |  |  | 
| 5393 | 0 |  |  |  |  | 0 | open($fh, ">$realfilename.e") or croak "Can't write open file: $realfilename.e"; | 
| 5394 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5395 |  |  |  |  |  |  | CORE::eval q{ | 
| 5396 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5397 |  |  |  |  |  |  | Mac::Files::FSpSetFLock("$realfilename.e"); | 
| 5398 |  |  |  |  |  |  | }; | 
| 5399 | 0 |  |  |  |  | 0 | } | 
| 5400 | 0 | 0 |  |  |  | 0 | elsif (exists $ENV{'CHAR_NONBLOCK'}) { | 
| 5401 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_EX | LOCK_NB) }; | 
| 5402 |  |  |  |  |  |  | if ($@) { | 
| 5403 |  |  |  |  |  |  | carp "Can't immediately write-lock the file: $realfilename.e"; | 
| 5404 |  |  |  |  |  |  | } | 
| 5405 | 0 |  |  |  |  | 0 | } | 
| 5406 |  |  |  |  |  |  | else { | 
| 5407 | 0 |  |  |  |  | 0 | CORE::eval q{ flock($fh, LOCK_EX) }; | 
| 5408 | 0 | 0 |  |  |  | 0 | } | 
| 5409 | 0 |  |  |  |  | 0 | CORE::eval q{ truncate($fh, 0) }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 5410 | 0 | 0 |  |  |  | 0 | seek($fh, 0, 0) or croak "Can't seek file: $realfilename.e"; | 
| 5411 | 0 |  |  |  |  | 0 | print {$fh} $script; | 
| 5412 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 5413 |  |  |  |  |  |  | CORE::eval q{ | 
| 5414 |  |  |  |  |  |  | CORE::require Mac::Files; | 
| 5415 |  |  |  |  |  |  | Mac::Files::FSpRstFLock("$realfilename.e"); | 
| 5416 | 0 | 0 |  |  |  | 0 | }; | 
| 5417 |  |  |  |  |  |  | } | 
| 5418 |  |  |  |  |  |  | close($fh) or croak "Can't close file: $realfilename"; | 
| 5419 |  |  |  |  |  |  | } | 
| 5420 |  |  |  |  |  |  | } | 
| 5421 | 389 |  |  | 389 |  | 4322 |  | 
|  | 389 |  |  |  |  | 2231 |  | 
|  | 389 |  |  |  |  | 392638 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 5422 | 0 |  |  |  |  | 0 | { | 
| 5423 |  |  |  |  |  |  | no strict; | 
| 5424 | 0 |  |  |  |  | 0 | $result = scalar CORE::eval $script; | 
| 5425 |  |  |  |  |  |  | } | 
| 5426 |  |  |  |  |  |  | last ITER_REQUIRE; | 
| 5427 | 0 |  |  |  |  | 0 | } | 
| 5428 |  |  |  |  |  |  | } | 
| 5429 |  |  |  |  |  |  | croak "Can't find $_ in \@INC"; | 
| 5430 | 0 | 0 |  |  |  | 0 | } | 
|  |  | 0 |  |  |  |  |  | 
| 5431 | 0 |  |  |  |  | 0 |  | 
| 5432 | 0 |  |  |  |  | 0 | if ($@) { | 
| 5433 |  |  |  |  |  |  | $INC{$_} = undef; | 
| 5434 |  |  |  |  |  |  | croak $@; | 
| 5435 | 0 |  |  |  |  | 0 | } | 
| 5436 | 0 |  |  |  |  | 0 | elsif (not $result) { | 
| 5437 |  |  |  |  |  |  | delete $INC{$_}; | 
| 5438 |  |  |  |  |  |  | croak "$_ did not return true value"; | 
| 5439 | 0 |  |  |  |  | 0 | } | 
| 5440 |  |  |  |  |  |  | else { | 
| 5441 |  |  |  |  |  |  | return $result; | 
| 5442 |  |  |  |  |  |  | } | 
| 5443 |  |  |  |  |  |  | } | 
| 5444 |  |  |  |  |  |  |  | 
| 5445 |  |  |  |  |  |  | # | 
| 5446 |  |  |  |  |  |  | # Big5-HKSCS telldir avoid warning | 
| 5447 |  |  |  |  |  |  | # | 
| 5448 | 0 |  |  | 768 | 0 | 0 | sub Ebig5hkscs::telldir(*) { | 
| 5449 |  |  |  |  |  |  |  | 
| 5450 | 768 |  |  |  |  | 2424 | local $^W = 0; | 
| 5451 |  |  |  |  |  |  |  | 
| 5452 |  |  |  |  |  |  | return CORE::telldir $_[0]; | 
| 5453 |  |  |  |  |  |  | } | 
| 5454 |  |  |  |  |  |  |  | 
| 5455 |  |  |  |  |  |  | # | 
| 5456 |  |  |  |  |  |  | # ${^PREMATCH}, $PREMATCH, $` the string preceding what was matched | 
| 5457 | 768 | 0 |  | 0 | 0 | 34023 | # | 
| 5458 | 0 | 0 | 0 |  |  | 0 | sub Ebig5hkscs::PREMATCH { | 
| 5459 | 0 |  |  |  |  | 0 | if (defined($&)) { | 
| 5460 |  |  |  |  |  |  | if (defined($1) and (CORE::substr($&,-CORE::length($1),CORE::length($1)) eq $1)) { | 
| 5461 |  |  |  |  |  |  | return CORE::substr($&,0,CORE::length($&)-CORE::length($1)); | 
| 5462 | 0 |  |  |  |  | 0 | } | 
| 5463 |  |  |  |  |  |  | else { | 
| 5464 |  |  |  |  |  |  | croak 'Use of "$`", $PREMATCH, and ${^PREMATCH} need to /( capture all )/ in regexp'; | 
| 5465 |  |  |  |  |  |  | } | 
| 5466 | 0 |  |  |  |  | 0 | } | 
| 5467 |  |  |  |  |  |  | else { | 
| 5468 | 0 |  |  |  |  | 0 | return ''; | 
| 5469 |  |  |  |  |  |  | } | 
| 5470 |  |  |  |  |  |  | return $`; | 
| 5471 |  |  |  |  |  |  | } | 
| 5472 |  |  |  |  |  |  |  | 
| 5473 |  |  |  |  |  |  | # | 
| 5474 |  |  |  |  |  |  | # ${^MATCH}, $MATCH, $& the string that matched | 
| 5475 | 0 | 0 |  | 0 | 0 | 0 | # | 
| 5476 | 0 | 0 |  |  |  | 0 | sub Ebig5hkscs::MATCH { | 
| 5477 | 0 |  |  |  |  | 0 | if (defined($&)) { | 
| 5478 |  |  |  |  |  |  | if (defined($1)) { | 
| 5479 |  |  |  |  |  |  | return $1; | 
| 5480 | 0 |  |  |  |  | 0 | } | 
| 5481 |  |  |  |  |  |  | else { | 
| 5482 |  |  |  |  |  |  | croak 'Use of "$&", $MATCH, and ${^MATCH} need to /( capture all )/ in regexp'; | 
| 5483 |  |  |  |  |  |  | } | 
| 5484 | 0 |  |  |  |  | 0 | } | 
| 5485 |  |  |  |  |  |  | else { | 
| 5486 | 0 |  |  |  |  | 0 | return ''; | 
| 5487 |  |  |  |  |  |  | } | 
| 5488 |  |  |  |  |  |  | return $&; | 
| 5489 |  |  |  |  |  |  | } | 
| 5490 |  |  |  |  |  |  |  | 
| 5491 |  |  |  |  |  |  | # | 
| 5492 |  |  |  |  |  |  | # ${^POSTMATCH}, $POSTMATCH, $' the string following what was matched | 
| 5493 | 0 |  |  | 0 | 0 | 0 | # | 
| 5494 |  |  |  |  |  |  | sub Ebig5hkscs::POSTMATCH { | 
| 5495 |  |  |  |  |  |  | return $'; | 
| 5496 |  |  |  |  |  |  | } | 
| 5497 |  |  |  |  |  |  |  | 
| 5498 |  |  |  |  |  |  | # | 
| 5499 |  |  |  |  |  |  | # Big5-HKSCS character to order (with parameter) | 
| 5500 |  |  |  |  |  |  | # | 
| 5501 | 0 | 0 |  | 0 | 1 | 0 | sub Big5HKSCS::ord(;$) { | 
| 5502 |  |  |  |  |  |  |  | 
| 5503 | 0 | 0 |  |  |  | 0 | local $_ = shift if @_; | 
| 5504 | 0 |  |  |  |  | 0 |  | 
| 5505 | 0 |  |  |  |  | 0 | if (/\A ($q_char) /oxms) { | 
| 5506 | 0 |  |  |  |  | 0 | my @ord = unpack 'C*', $1; | 
| 5507 | 0 |  |  |  |  | 0 | my $ord = 0; | 
| 5508 |  |  |  |  |  |  | while (my $o = shift @ord) { | 
| 5509 | 0 |  |  |  |  | 0 | $ord = $ord * 0x100 + $o; | 
| 5510 |  |  |  |  |  |  | } | 
| 5511 |  |  |  |  |  |  | return $ord; | 
| 5512 | 0 |  |  |  |  | 0 | } | 
| 5513 |  |  |  |  |  |  | else { | 
| 5514 |  |  |  |  |  |  | return CORE::ord $_; | 
| 5515 |  |  |  |  |  |  | } | 
| 5516 |  |  |  |  |  |  | } | 
| 5517 |  |  |  |  |  |  |  | 
| 5518 |  |  |  |  |  |  | # | 
| 5519 |  |  |  |  |  |  | # Big5-HKSCS character to order (without parameter) | 
| 5520 |  |  |  |  |  |  | # | 
| 5521 | 0 | 0 |  | 0 | 0 | 0 | sub Big5HKSCS::ord_() { | 
| 5522 | 0 |  |  |  |  | 0 |  | 
| 5523 | 0 |  |  |  |  | 0 | if (/\A ($q_char) /oxms) { | 
| 5524 | 0 |  |  |  |  | 0 | my @ord = unpack 'C*', $1; | 
| 5525 | 0 |  |  |  |  | 0 | my $ord = 0; | 
| 5526 |  |  |  |  |  |  | while (my $o = shift @ord) { | 
| 5527 | 0 |  |  |  |  | 0 | $ord = $ord * 0x100 + $o; | 
| 5528 |  |  |  |  |  |  | } | 
| 5529 |  |  |  |  |  |  | return $ord; | 
| 5530 | 0 |  |  |  |  | 0 | } | 
| 5531 |  |  |  |  |  |  | else { | 
| 5532 |  |  |  |  |  |  | return CORE::ord $_; | 
| 5533 |  |  |  |  |  |  | } | 
| 5534 |  |  |  |  |  |  | } | 
| 5535 |  |  |  |  |  |  |  | 
| 5536 |  |  |  |  |  |  | # | 
| 5537 |  |  |  |  |  |  | # Big5-HKSCS reverse | 
| 5538 |  |  |  |  |  |  | # | 
| 5539 | 0 | 0 |  | 0 | 0 | 0 | sub Big5HKSCS::reverse(@) { | 
| 5540 | 0 |  |  |  |  | 0 |  | 
| 5541 |  |  |  |  |  |  | if (wantarray) { | 
| 5542 |  |  |  |  |  |  | return CORE::reverse @_; | 
| 5543 |  |  |  |  |  |  | } | 
| 5544 |  |  |  |  |  |  | else { | 
| 5545 |  |  |  |  |  |  |  | 
| 5546 |  |  |  |  |  |  | # One of us once cornered Larry in an elevator and asked him what | 
| 5547 |  |  |  |  |  |  | # problem he was solving with this, but he looked as far off into | 
| 5548 |  |  |  |  |  |  | # the distance as he could in an elevator and said, "It seemed like | 
| 5549 | 0 |  |  |  |  | 0 | # a good idea at the time." | 
| 5550 |  |  |  |  |  |  |  | 
| 5551 |  |  |  |  |  |  | return join '', CORE::reverse(join('',@_) =~ /\G ($q_char) /oxmsg); | 
| 5552 |  |  |  |  |  |  | } | 
| 5553 |  |  |  |  |  |  | } | 
| 5554 |  |  |  |  |  |  |  | 
| 5555 |  |  |  |  |  |  | # | 
| 5556 |  |  |  |  |  |  | # Big5-HKSCS getc (with parameter, without parameter) | 
| 5557 |  |  |  |  |  |  | # | 
| 5558 | 0 |  |  | 0 | 0 | 0 | sub Big5HKSCS::getc(;*@) { | 
| 5559 | 0 | 0 |  |  |  | 0 |  | 
| 5560 | 0 | 0 | 0 |  |  | 0 | my($package) = caller; | 
| 5561 |  |  |  |  |  |  | my $fh = @_ ? qualify_to_ref(shift,$package) : \*STDIN; | 
| 5562 | 0 |  |  |  |  | 0 | croak 'Too many arguments for Big5HKSCS::getc' if @_ and not wantarray; | 
|  | 0 |  |  |  |  | 0 |  | 
| 5563 | 0 |  |  |  |  | 0 |  | 
| 5564 | 0 |  |  |  |  | 0 | my @length = sort { $a <=> $b } keys %range_tr; | 
| 5565 | 0 |  |  |  |  | 0 | my $getc = ''; | 
| 5566 | 0 | 0 |  |  |  | 0 | for my $length ($length[0] .. $length[-1]) { | 
| 5567 | 0 | 0 |  |  |  | 0 | $getc .= CORE::getc($fh); | 
| 5568 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{CORE::length($getc)}) { | 
| 5569 |  |  |  |  |  |  | if ($getc =~ /\A ${Ebig5hkscs::dot_s} \z/oxms) { | 
| 5570 |  |  |  |  |  |  | return wantarray ? ($getc,@_) : $getc; | 
| 5571 |  |  |  |  |  |  | } | 
| 5572 | 0 | 0 |  |  |  | 0 | } | 
| 5573 |  |  |  |  |  |  | } | 
| 5574 |  |  |  |  |  |  | return wantarray ? ($getc,@_) : $getc; | 
| 5575 |  |  |  |  |  |  | } | 
| 5576 |  |  |  |  |  |  |  | 
| 5577 |  |  |  |  |  |  | # | 
| 5578 |  |  |  |  |  |  | # Big5-HKSCS length by character | 
| 5579 |  |  |  |  |  |  | # | 
| 5580 | 0 | 0 |  | 0 | 1 | 0 | sub Big5HKSCS::length(;$) { | 
| 5581 |  |  |  |  |  |  |  | 
| 5582 | 0 |  |  |  |  | 0 | local $_ = shift if @_; | 
| 5583 | 0 |  |  |  |  | 0 |  | 
| 5584 |  |  |  |  |  |  | local @_ = /\G ($q_char) /oxmsg; | 
| 5585 |  |  |  |  |  |  | return scalar @_; | 
| 5586 |  |  |  |  |  |  | } | 
| 5587 |  |  |  |  |  |  |  | 
| 5588 |  |  |  |  |  |  | # | 
| 5589 |  |  |  |  |  |  | # Big5-HKSCS substr by character | 
| 5590 |  |  |  |  |  |  | # | 
| 5591 |  |  |  |  |  |  | BEGIN { | 
| 5592 |  |  |  |  |  |  |  | 
| 5593 |  |  |  |  |  |  | # P.232 The lvalue Attribute | 
| 5594 |  |  |  |  |  |  | # in Chapter 6: Subroutines | 
| 5595 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 5596 |  |  |  |  |  |  |  | 
| 5597 |  |  |  |  |  |  | # P.336 The lvalue Attribute | 
| 5598 |  |  |  |  |  |  | # in Chapter 7: Subroutines | 
| 5599 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 5600 |  |  |  |  |  |  |  | 
| 5601 |  |  |  |  |  |  | # P.144 8.4 Lvalue subroutines | 
| 5602 |  |  |  |  |  |  | # in Chapter 8: perlsub: Perl subroutines | 
| 5603 | 389 | 50 | 0 | 389 | 1 | 228711 | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
|  | 0 | 0 |  | 0 |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 5604 |  |  |  |  |  |  |  | 
| 5605 |  |  |  |  |  |  | CORE::eval sprintf(<<'END', ($] >= 5.014000) ? ':lvalue' : ''); | 
| 5606 |  |  |  |  |  |  | #                       vv----------------------******* | 
| 5607 |  |  |  |  |  |  | sub Big5HKSCS::substr($$;$$) %s { | 
| 5608 |  |  |  |  |  |  |  | 
| 5609 |  |  |  |  |  |  | my @char = $_[0] =~ /\G (?>$q_char) /oxmsg; | 
| 5610 |  |  |  |  |  |  |  | 
| 5611 |  |  |  |  |  |  | # If the substring is beyond either end of the string, substr() returns the undefined | 
| 5612 |  |  |  |  |  |  | # value and produces a warning. When used as an lvalue, specifying a substring that | 
| 5613 |  |  |  |  |  |  | # is entirely outside the string raises an exception. | 
| 5614 |  |  |  |  |  |  | # http://perldoc.perl.org/functions/substr.html | 
| 5615 |  |  |  |  |  |  |  | 
| 5616 |  |  |  |  |  |  | # A return with no argument returns the scalar value undef in scalar context, | 
| 5617 |  |  |  |  |  |  | # an empty list () in list context, and (naturally) nothing at all in void | 
| 5618 |  |  |  |  |  |  | # context. | 
| 5619 |  |  |  |  |  |  |  | 
| 5620 |  |  |  |  |  |  | my $offset = $_[1]; | 
| 5621 |  |  |  |  |  |  | if (($offset > scalar(@char)) or ($offset < (-1 * scalar(@char)))) { | 
| 5622 |  |  |  |  |  |  | return; | 
| 5623 |  |  |  |  |  |  | } | 
| 5624 |  |  |  |  |  |  |  | 
| 5625 |  |  |  |  |  |  | # substr($string,$offset,$length,$replacement) | 
| 5626 |  |  |  |  |  |  | if (@_ == 4) { | 
| 5627 |  |  |  |  |  |  | my(undef,undef,$length,$replacement) = @_; | 
| 5628 |  |  |  |  |  |  | my $substr = join '', splice(@char, $offset, $length, $replacement); | 
| 5629 |  |  |  |  |  |  | $_[0] = join '', @char; | 
| 5630 |  |  |  |  |  |  |  | 
| 5631 |  |  |  |  |  |  | # return $substr; this doesn't work, don't say "return" | 
| 5632 |  |  |  |  |  |  | $substr; | 
| 5633 |  |  |  |  |  |  | } | 
| 5634 |  |  |  |  |  |  |  | 
| 5635 |  |  |  |  |  |  | # substr($string,$offset,$length) | 
| 5636 |  |  |  |  |  |  | elsif (@_ == 3) { | 
| 5637 |  |  |  |  |  |  | my(undef,undef,$length) = @_; | 
| 5638 |  |  |  |  |  |  | my $octet_offset = 0; | 
| 5639 |  |  |  |  |  |  | my $octet_length = 0; | 
| 5640 |  |  |  |  |  |  | if ($offset == 0) { | 
| 5641 |  |  |  |  |  |  | $octet_offset = 0; | 
| 5642 |  |  |  |  |  |  | } | 
| 5643 |  |  |  |  |  |  | elsif ($offset > 0) { | 
| 5644 |  |  |  |  |  |  | $octet_offset =      CORE::length(join '', @char[0..$offset-1]); | 
| 5645 |  |  |  |  |  |  | } | 
| 5646 |  |  |  |  |  |  | else { | 
| 5647 |  |  |  |  |  |  | $octet_offset = -1 * CORE::length(join '', @char[$#char+$offset+1..$#char]); | 
| 5648 |  |  |  |  |  |  | } | 
| 5649 |  |  |  |  |  |  | if ($length == 0) { | 
| 5650 |  |  |  |  |  |  | $octet_length = 0; | 
| 5651 |  |  |  |  |  |  | } | 
| 5652 |  |  |  |  |  |  | elsif ($length > 0) { | 
| 5653 |  |  |  |  |  |  | $octet_length =      CORE::length(join '', @char[$offset..$offset+$length-1]); | 
| 5654 |  |  |  |  |  |  | } | 
| 5655 |  |  |  |  |  |  | else { | 
| 5656 |  |  |  |  |  |  | $octet_length = -1 * CORE::length(join '', @char[$#char+$length+1..$#char]); | 
| 5657 |  |  |  |  |  |  | } | 
| 5658 |  |  |  |  |  |  | CORE::substr($_[0], $octet_offset, $octet_length); | 
| 5659 |  |  |  |  |  |  | } | 
| 5660 |  |  |  |  |  |  |  | 
| 5661 |  |  |  |  |  |  | # substr($string,$offset) | 
| 5662 |  |  |  |  |  |  | else { | 
| 5663 |  |  |  |  |  |  | my $octet_offset = 0; | 
| 5664 |  |  |  |  |  |  | if ($offset == 0) { | 
| 5665 |  |  |  |  |  |  | $octet_offset = 0; | 
| 5666 |  |  |  |  |  |  | } | 
| 5667 |  |  |  |  |  |  | elsif ($offset > 0) { | 
| 5668 |  |  |  |  |  |  | $octet_offset =      CORE::length(join '', @char[0..$offset-1]); | 
| 5669 |  |  |  |  |  |  | } | 
| 5670 |  |  |  |  |  |  | else { | 
| 5671 |  |  |  |  |  |  | $octet_offset = -1 * CORE::length(join '', @char[$#char+$offset+1..$#char]); | 
| 5672 |  |  |  |  |  |  | } | 
| 5673 |  |  |  |  |  |  | CORE::substr($_[0], $octet_offset); | 
| 5674 |  |  |  |  |  |  | } | 
| 5675 |  |  |  |  |  |  | } | 
| 5676 |  |  |  |  |  |  | END | 
| 5677 |  |  |  |  |  |  | } | 
| 5678 |  |  |  |  |  |  |  | 
| 5679 |  |  |  |  |  |  | # | 
| 5680 |  |  |  |  |  |  | # Big5-HKSCS index by character | 
| 5681 |  |  |  |  |  |  | # | 
| 5682 | 0 |  |  | 0 | 1 | 0 | sub Big5HKSCS::index($$;$) { | 
| 5683 | 0 | 0 |  |  |  | 0 |  | 
| 5684 | 0 |  |  |  |  | 0 | my $index; | 
| 5685 |  |  |  |  |  |  | if (@_ == 3) { | 
| 5686 |  |  |  |  |  |  | $index = Ebig5hkscs::index($_[0], $_[1], CORE::length(Big5HKSCS::substr($_[0], 0, $_[2]))); | 
| 5687 | 0 |  |  |  |  | 0 | } | 
| 5688 |  |  |  |  |  |  | else { | 
| 5689 |  |  |  |  |  |  | $index = Ebig5hkscs::index($_[0], $_[1]); | 
| 5690 | 0 | 0 |  |  |  | 0 | } | 
| 5691 | 0 |  |  |  |  | 0 |  | 
| 5692 |  |  |  |  |  |  | if ($index == -1) { | 
| 5693 |  |  |  |  |  |  | return -1; | 
| 5694 | 0 |  |  |  |  | 0 | } | 
| 5695 |  |  |  |  |  |  | else { | 
| 5696 |  |  |  |  |  |  | return Big5HKSCS::length(CORE::substr $_[0], 0, $index); | 
| 5697 |  |  |  |  |  |  | } | 
| 5698 |  |  |  |  |  |  | } | 
| 5699 |  |  |  |  |  |  |  | 
| 5700 |  |  |  |  |  |  | # | 
| 5701 |  |  |  |  |  |  | # Big5-HKSCS rindex by character | 
| 5702 |  |  |  |  |  |  | # | 
| 5703 | 0 |  |  | 0 | 1 | 0 | sub Big5HKSCS::rindex($$;$) { | 
| 5704 | 0 | 0 |  |  |  | 0 |  | 
| 5705 | 0 |  |  |  |  | 0 | my $rindex; | 
| 5706 |  |  |  |  |  |  | if (@_ == 3) { | 
| 5707 |  |  |  |  |  |  | $rindex = Ebig5hkscs::rindex($_[0], $_[1], CORE::length(Big5HKSCS::substr($_[0], 0, $_[2]))); | 
| 5708 | 0 |  |  |  |  | 0 | } | 
| 5709 |  |  |  |  |  |  | else { | 
| 5710 |  |  |  |  |  |  | $rindex = Ebig5hkscs::rindex($_[0], $_[1]); | 
| 5711 | 0 | 0 |  |  |  | 0 | } | 
| 5712 | 0 |  |  |  |  | 0 |  | 
| 5713 |  |  |  |  |  |  | if ($rindex == -1) { | 
| 5714 |  |  |  |  |  |  | return -1; | 
| 5715 | 0 |  |  |  |  | 0 | } | 
| 5716 |  |  |  |  |  |  | else { | 
| 5717 |  |  |  |  |  |  | return Big5HKSCS::length(CORE::substr $_[0], 0, $rindex); | 
| 5718 |  |  |  |  |  |  | } | 
| 5719 |  |  |  |  |  |  | } | 
| 5720 |  |  |  |  |  |  |  | 
| 5721 | 389 |  |  | 389 |  | 6512 | # when 'm//', '/' means regexp match 'm//' and '?' means regexp match '??' | 
|  | 389 |  |  |  |  | 2900 |  | 
|  | 389 |  |  |  |  | 37796 |  | 
| 5722 |  |  |  |  |  |  | # when 'div', '/' means division operator and '?' means conditional operator (condition ? then : else) | 
| 5723 |  |  |  |  |  |  | use vars qw($slash); $slash = 'm//'; | 
| 5724 |  |  |  |  |  |  |  | 
| 5725 |  |  |  |  |  |  | # ord() to ord() or Big5HKSCS::ord() | 
| 5726 |  |  |  |  |  |  | my $function_ord = 'ord'; | 
| 5727 |  |  |  |  |  |  |  | 
| 5728 |  |  |  |  |  |  | # ord to ord or Big5HKSCS::ord_ | 
| 5729 |  |  |  |  |  |  | my $function_ord_ = 'ord'; | 
| 5730 |  |  |  |  |  |  |  | 
| 5731 |  |  |  |  |  |  | # reverse to reverse or Big5HKSCS::reverse | 
| 5732 |  |  |  |  |  |  | my $function_reverse = 'reverse'; | 
| 5733 |  |  |  |  |  |  |  | 
| 5734 |  |  |  |  |  |  | # getc to getc or Big5HKSCS::getc | 
| 5735 |  |  |  |  |  |  | my $function_getc = 'getc'; | 
| 5736 |  |  |  |  |  |  |  | 
| 5737 |  |  |  |  |  |  | # P.1023 Appendix W.9 Multibyte Anchoring | 
| 5738 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 5739 |  |  |  |  |  |  |  | 
| 5740 |  |  |  |  |  |  | my $anchor = ''; | 
| 5741 | 389 |  |  | 389 |  | 5736 | $anchor = q{${Ebig5hkscs::anchor}}; | 
|  | 389 |  |  | 0 |  | 2608 |  | 
|  | 389 |  |  |  |  | 22852061 |  | 
| 5742 |  |  |  |  |  |  |  | 
| 5743 |  |  |  |  |  |  | use vars qw($nest); | 
| 5744 |  |  |  |  |  |  |  | 
| 5745 |  |  |  |  |  |  | # regexp of nested parens in qqXX | 
| 5746 |  |  |  |  |  |  |  | 
| 5747 |  |  |  |  |  |  | # P.340 Matching Nested Constructs with Embedded Code | 
| 5748 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 5749 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 5750 |  |  |  |  |  |  |  | 
| 5751 |  |  |  |  |  |  | my $qq_paren   = qr{(?{local $nest=0}) (?>(?: | 
| 5752 |  |  |  |  |  |  | [^\x81-\xFE\\()] | | 
| 5753 |  |  |  |  |  |  | \(  (?{$nest++}) | | 
| 5754 |  |  |  |  |  |  | \)  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5755 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5756 |  |  |  |  |  |  | \\ [^\x81-\xFEc] | | 
| 5757 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 5758 |  |  |  |  |  |  | \\ [\x81-\xFE][\x00-\xFF] | | 
| 5759 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5760 |  |  |  |  |  |  | }xms; | 
| 5761 |  |  |  |  |  |  |  | 
| 5762 |  |  |  |  |  |  | my $qq_brace   = qr{(?{local $nest=0}) (?>(?: | 
| 5763 |  |  |  |  |  |  | [^\x81-\xFE\\{}] | | 
| 5764 |  |  |  |  |  |  | \{  (?{$nest++}) | | 
| 5765 |  |  |  |  |  |  | \}  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5766 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5767 |  |  |  |  |  |  | \\ [^\x81-\xFEc] | | 
| 5768 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 5769 |  |  |  |  |  |  | \\ [\x81-\xFE][\x00-\xFF] | | 
| 5770 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5771 |  |  |  |  |  |  | }xms; | 
| 5772 |  |  |  |  |  |  |  | 
| 5773 |  |  |  |  |  |  | my $qq_bracket = qr{(?{local $nest=0}) (?>(?: | 
| 5774 |  |  |  |  |  |  | [^\x81-\xFE\\\[\]] | | 
| 5775 |  |  |  |  |  |  | \[  (?{$nest++}) | | 
| 5776 |  |  |  |  |  |  | \]  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5777 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5778 |  |  |  |  |  |  | \\ [^\x81-\xFEc] | | 
| 5779 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 5780 |  |  |  |  |  |  | \\ [\x81-\xFE][\x00-\xFF] | | 
| 5781 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5782 |  |  |  |  |  |  | }xms; | 
| 5783 |  |  |  |  |  |  |  | 
| 5784 |  |  |  |  |  |  | my $qq_angle   = qr{(?{local $nest=0}) (?>(?: | 
| 5785 |  |  |  |  |  |  | [^\x81-\xFE\\<>] | | 
| 5786 |  |  |  |  |  |  | \<  (?{$nest++}) | | 
| 5787 |  |  |  |  |  |  | \>  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5788 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5789 |  |  |  |  |  |  | \\ [^\x81-\xFEc] | | 
| 5790 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 5791 |  |  |  |  |  |  | \\ [\x81-\xFE][\x00-\xFF] | | 
| 5792 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5793 |  |  |  |  |  |  | }xms; | 
| 5794 |  |  |  |  |  |  |  | 
| 5795 |  |  |  |  |  |  | my $qq_scalar  = qr{(?: \{ (?:$qq_brace)*? \} | | 
| 5796 |  |  |  |  |  |  | (?: ::)? (?: | 
| 5797 |  |  |  |  |  |  | (?> [a-zA-Z_][a-zA-Z_0-9]* (?: ::[a-zA-Z_][a-zA-Z_0-9]*)* ) | 
| 5798 |  |  |  |  |  |  | (?>(?:                                   \[ (?: \$\[ | \$\] | $qq_char )*? \] |           \{ (?:$qq_brace)*? \} )*) | 
| 5799 |  |  |  |  |  |  | (?>(?: (?: -> )? (?: [\$\@\%\&\*]\* | \$\#\* | [\@\%]? \[ (?: \$\[ | \$\] | $qq_char )*? \] | [\@\%\*]? \{ (?:$qq_brace)*? \} ) )*) | 
| 5800 |  |  |  |  |  |  | )) | 
| 5801 |  |  |  |  |  |  | }xms; | 
| 5802 |  |  |  |  |  |  |  | 
| 5803 |  |  |  |  |  |  | my $qq_variable = qr{(?: \{ (?:$qq_brace)*? \}                    | | 
| 5804 |  |  |  |  |  |  | (?: ::)? (?: | 
| 5805 |  |  |  |  |  |  | (?>[0-9]+)                          | | 
| 5806 |  |  |  |  |  |  | [^\x81-\xFEa-zA-Z_0-9\[\]] | | 
| 5807 |  |  |  |  |  |  | ^[A-Z]                              | | 
| 5808 |  |  |  |  |  |  | (?> [a-zA-Z_][a-zA-Z_0-9]* (?: ::[a-zA-Z_][a-zA-Z_0-9]*)* ) | 
| 5809 |  |  |  |  |  |  | (?>(?:                                   \[ (?: \$\[ | \$\] | $qq_char )*? \] |           \{ (?:$qq_brace)*? \} )*) | 
| 5810 |  |  |  |  |  |  | (?>(?: (?: -> )? (?: [\$\@\%\&\*]\* | \$\#\* | [\@\%]? \[ (?: \$\[ | \$\] | $qq_char )*? \] | [\@\%\*]? \{ (?:$qq_brace)*? \} ) )*) | 
| 5811 |  |  |  |  |  |  | )) | 
| 5812 |  |  |  |  |  |  | }xms; | 
| 5813 |  |  |  |  |  |  |  | 
| 5814 |  |  |  |  |  |  | my $qq_substr  = qr{(?> Char::substr | Big5HKSCS::substr | CORE::substr | substr ) (?>\s*) \( $qq_paren \) | 
| 5815 |  |  |  |  |  |  | }xms; | 
| 5816 |  |  |  |  |  |  |  | 
| 5817 |  |  |  |  |  |  | # regexp of nested parens in qXX | 
| 5818 |  |  |  |  |  |  | my $q_paren    = qr{(?{local $nest=0}) (?>(?: | 
| 5819 |  |  |  |  |  |  | [^\x81-\xFE()] | | 
| 5820 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5821 |  |  |  |  |  |  | \(  (?{$nest++}) | | 
| 5822 |  |  |  |  |  |  | \)  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5823 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5824 |  |  |  |  |  |  | }xms; | 
| 5825 |  |  |  |  |  |  |  | 
| 5826 |  |  |  |  |  |  | my $q_brace    = qr{(?{local $nest=0}) (?>(?: | 
| 5827 |  |  |  |  |  |  | [^\x81-\xFE\{\}] | | 
| 5828 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5829 |  |  |  |  |  |  | \{  (?{$nest++}) | | 
| 5830 |  |  |  |  |  |  | \}  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5831 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5832 |  |  |  |  |  |  | }xms; | 
| 5833 |  |  |  |  |  |  |  | 
| 5834 |  |  |  |  |  |  | my $q_bracket  = qr{(?{local $nest=0}) (?>(?: | 
| 5835 |  |  |  |  |  |  | [^\x81-\xFE\[\]] | | 
| 5836 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5837 |  |  |  |  |  |  | \[  (?{$nest++}) | | 
| 5838 |  |  |  |  |  |  | \]  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5839 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5840 |  |  |  |  |  |  | }xms; | 
| 5841 |  |  |  |  |  |  |  | 
| 5842 |  |  |  |  |  |  | my $q_angle    = qr{(?{local $nest=0}) (?>(?: | 
| 5843 |  |  |  |  |  |  | [^\x81-\xFE<>] | | 
| 5844 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 5845 |  |  |  |  |  |  | \<  (?{$nest++}) | | 
| 5846 |  |  |  |  |  |  | \>  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 5847 |  |  |  |  |  |  | [\x00-\xFF] | 
| 5848 |  |  |  |  |  |  | }xms; | 
| 5849 |  |  |  |  |  |  |  | 
| 5850 |  |  |  |  |  |  | my $matched     = ''; | 
| 5851 |  |  |  |  |  |  | my $s_matched   = ''; | 
| 5852 |  |  |  |  |  |  | $matched        = q{$Ebig5hkscs::matched}; | 
| 5853 |  |  |  |  |  |  | $s_matched      = q{ Ebig5hkscs::s_matched();}; | 
| 5854 |  |  |  |  |  |  |  | 
| 5855 |  |  |  |  |  |  | my $tr_variable   = '';   # variable of tr/// | 
| 5856 |  |  |  |  |  |  | my $sub_variable  = '';   # variable of s/// | 
| 5857 |  |  |  |  |  |  | my $bind_operator = '';   # =~ or !~ | 
| 5858 |  |  |  |  |  |  |  | 
| 5859 |  |  |  |  |  |  | my @heredoc = ();         # here document | 
| 5860 |  |  |  |  |  |  | my @heredoc_delimiter = (); | 
| 5861 |  |  |  |  |  |  | my $here_script = '';     # here script | 
| 5862 |  |  |  |  |  |  |  | 
| 5863 |  |  |  |  |  |  | # | 
| 5864 |  |  |  |  |  |  | # escape Big5-HKSCS script | 
| 5865 | 0 | 50 |  | 384 | 0 | 0 | # | 
| 5866 |  |  |  |  |  |  | sub Big5HKSCS::escape(;$) { | 
| 5867 |  |  |  |  |  |  | local($_) = $_[0] if @_; | 
| 5868 |  |  |  |  |  |  |  | 
| 5869 |  |  |  |  |  |  | # P.359 The Study Function | 
| 5870 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 5871 | 384 |  |  |  |  | 1401 | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 5872 |  |  |  |  |  |  |  | 
| 5873 |  |  |  |  |  |  | study $_; # Yes, I studied study yesterday. | 
| 5874 |  |  |  |  |  |  |  | 
| 5875 |  |  |  |  |  |  | # while all script | 
| 5876 |  |  |  |  |  |  |  | 
| 5877 |  |  |  |  |  |  | # 6.14. Matching from Where the Last Pattern Left Off | 
| 5878 |  |  |  |  |  |  | # in Chapter 6. Pattern Matching | 
| 5879 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 5880 |  |  |  |  |  |  | # (and so on) | 
| 5881 |  |  |  |  |  |  |  | 
| 5882 |  |  |  |  |  |  | # one member of Tag-team | 
| 5883 |  |  |  |  |  |  | # | 
| 5884 |  |  |  |  |  |  | # P.128 Start of match (or end of previous match): \G | 
| 5885 |  |  |  |  |  |  | # P.130 Advanced Use of \G with Perl | 
| 5886 |  |  |  |  |  |  | # in Chapter 3: Overview of Regular Expression Features and Flavors | 
| 5887 |  |  |  |  |  |  | # P.255 Use leading anchors | 
| 5888 |  |  |  |  |  |  | # P.256 Expose ^ and \G at the front expressions | 
| 5889 |  |  |  |  |  |  | # in Chapter 6: Crafting an Efficient Expression | 
| 5890 |  |  |  |  |  |  | # P.315 "Tag-team" matching with /gc | 
| 5891 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 5892 | 384 |  |  |  |  | 841 | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 5893 | 384 |  |  |  |  | 728 |  | 
| 5894 | 384 |  |  |  |  | 1661 | my $e_script = ''; | 
| 5895 |  |  |  |  |  |  | while (not /\G \z/oxgc) { # member | 
| 5896 |  |  |  |  |  |  | $e_script .= Big5HKSCS::escape_token(); | 
| 5897 | 187258 |  |  |  |  | 338749 | } | 
| 5898 |  |  |  |  |  |  |  | 
| 5899 |  |  |  |  |  |  | return $e_script; | 
| 5900 |  |  |  |  |  |  | } | 
| 5901 |  |  |  |  |  |  |  | 
| 5902 |  |  |  |  |  |  | # | 
| 5903 |  |  |  |  |  |  | # escape Big5-HKSCS token of script | 
| 5904 |  |  |  |  |  |  | # | 
| 5905 |  |  |  |  |  |  | sub Big5HKSCS::escape_token { | 
| 5906 |  |  |  |  |  |  |  | 
| 5907 | 384 |  |  | 187258 | 0 | 5834 | # \n output here document | 
| 5908 |  |  |  |  |  |  |  | 
| 5909 |  |  |  |  |  |  | my $ignore_modules = join('|', qw( | 
| 5910 |  |  |  |  |  |  | utf8 | 
| 5911 |  |  |  |  |  |  | bytes | 
| 5912 |  |  |  |  |  |  | charnames | 
| 5913 |  |  |  |  |  |  | I18N::Japanese | 
| 5914 |  |  |  |  |  |  | I18N::Collate | 
| 5915 |  |  |  |  |  |  | I18N::JExt | 
| 5916 |  |  |  |  |  |  | File::DosGlob | 
| 5917 |  |  |  |  |  |  | Wild | 
| 5918 |  |  |  |  |  |  | Wildcard | 
| 5919 |  |  |  |  |  |  | Japanese | 
| 5920 |  |  |  |  |  |  | )); | 
| 5921 |  |  |  |  |  |  |  | 
| 5922 |  |  |  |  |  |  | # another member of Tag-team | 
| 5923 |  |  |  |  |  |  | # | 
| 5924 |  |  |  |  |  |  | # P.315 "Tag-team" matching with /gc | 
| 5925 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 5926 | 187258 | 100 | 100 |  |  | 240983 | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 5927 | 187258 |  |  |  |  | 14704313 |  | 
| 5928 | 31404 | 100 |  |  |  | 42244 | if (/\G ( \n ) /oxgc) { # another member (and so on) | 
| 5929 | 31404 |  |  |  |  | 56118 | my $heredoc = ''; | 
| 5930 |  |  |  |  |  |  | if (scalar(@heredoc_delimiter) >= 1) { | 
| 5931 | 197 |  |  |  |  | 280 | $slash = 'm//'; | 
| 5932 | 197 |  |  |  |  | 462 |  | 
| 5933 |  |  |  |  |  |  | $heredoc = join '', @heredoc; | 
| 5934 |  |  |  |  |  |  | @heredoc = (); | 
| 5935 | 197 |  |  |  |  | 379 |  | 
| 5936 | 197 |  |  |  |  | 405 | # skip here document | 
| 5937 |  |  |  |  |  |  | for my $heredoc_delimiter (@heredoc_delimiter) { | 
| 5938 | 205 |  |  |  |  | 1328 | /\G .*? \n $heredoc_delimiter \n/xmsgc; | 
| 5939 |  |  |  |  |  |  | } | 
| 5940 | 197 |  |  |  |  | 401 | @heredoc_delimiter = (); | 
| 5941 |  |  |  |  |  |  |  | 
| 5942 | 197 |  |  |  |  | 325 | $here_script = ''; | 
| 5943 |  |  |  |  |  |  | } | 
| 5944 |  |  |  |  |  |  | return "\n" . $heredoc; | 
| 5945 |  |  |  |  |  |  | } | 
| 5946 | 31404 |  |  |  |  | 93489 |  | 
| 5947 |  |  |  |  |  |  | # ignore space, comment | 
| 5948 |  |  |  |  |  |  | elsif (/\G ((?>\s+)|\#.*) /oxgc) { return $1; } | 
| 5949 |  |  |  |  |  |  |  | 
| 5950 |  |  |  |  |  |  | # if (, elsif (, unless (, while (, until (, given (, and when ( | 
| 5951 |  |  |  |  |  |  |  | 
| 5952 |  |  |  |  |  |  | # given, when | 
| 5953 |  |  |  |  |  |  |  | 
| 5954 |  |  |  |  |  |  | # P.225 The given Statement | 
| 5955 |  |  |  |  |  |  | # in Chapter 15: Smart Matching and given-when | 
| 5956 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 5957 |  |  |  |  |  |  |  | 
| 5958 |  |  |  |  |  |  | # P.133 The given Statement | 
| 5959 |  |  |  |  |  |  | # in Chapter 4: Statements and Declarations | 
| 5960 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 5961 | 42620 |  |  |  |  | 133006 |  | 
| 5962 | 3773 |  |  |  |  | 6691 | elsif (/\G ( (?: if | elsif | unless | while | until | given | when ) (?>\s*) \( ) /oxgc) { | 
| 5963 |  |  |  |  |  |  | $slash = 'm//'; | 
| 5964 |  |  |  |  |  |  | return $1; | 
| 5965 |  |  |  |  |  |  | } | 
| 5966 |  |  |  |  |  |  |  | 
| 5967 |  |  |  |  |  |  | # scalar variable ($scalar = ...) =~ tr///; | 
| 5968 |  |  |  |  |  |  | # scalar variable ($scalar = ...) =~ s///; | 
| 5969 |  |  |  |  |  |  |  | 
| 5970 |  |  |  |  |  |  | # state | 
| 5971 |  |  |  |  |  |  |  | 
| 5972 |  |  |  |  |  |  | # P.68 Persistent, Private Variables | 
| 5973 |  |  |  |  |  |  | # in Chapter 4: Subroutines | 
| 5974 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 5975 |  |  |  |  |  |  |  | 
| 5976 |  |  |  |  |  |  | # P.160 Persistent Lexically Scoped Variables: state | 
| 5977 |  |  |  |  |  |  | # in Chapter 4: Statements and Declarations | 
| 5978 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 5979 |  |  |  |  |  |  |  | 
| 5980 |  |  |  |  |  |  | # (and so on) | 
| 5981 | 3773 |  |  |  |  | 22770 |  | 
| 5982 |  |  |  |  |  |  | elsif (/\G ( \( (?>\s*) (?: local \b | my \b | our \b | state \b )? (?>\s*) \$ $qq_scalar ) /oxgc) { | 
| 5983 | 170 | 50 |  |  |  | 468 | my $e_string = e_string($1); | 
|  |  | 50 |  |  |  |  |  | 
| 5984 | 170 |  |  |  |  | 6356 |  | 
| 5985 | 0 |  |  |  |  | 0 | if (/\G ( (?>\s*) = $qq_paren \) ) ( (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= (?: tr | y ) \b ) /oxgc) { | 
| 5986 | 0 |  |  |  |  | 0 | $tr_variable = $e_string . e_string($1); | 
| 5987 | 0 |  |  |  |  | 0 | $bind_operator = $2; | 
| 5988 |  |  |  |  |  |  | $slash = 'm//'; | 
| 5989 |  |  |  |  |  |  | return ''; | 
| 5990 | 0 |  |  |  |  | 0 | } | 
| 5991 | 0 |  |  |  |  | 0 | elsif (/\G ( (?>\s*) = $qq_paren \) ) ( (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= s \b ) /oxgc) { | 
| 5992 | 0 |  |  |  |  | 0 | $sub_variable = $e_string . e_string($1); | 
| 5993 | 0 |  |  |  |  | 0 | $bind_operator = $2; | 
| 5994 |  |  |  |  |  |  | $slash = 'm//'; | 
| 5995 |  |  |  |  |  |  | return ''; | 
| 5996 | 0 |  |  |  |  | 0 | } | 
| 5997 | 170 |  |  |  |  | 384 | else { | 
| 5998 |  |  |  |  |  |  | $slash = 'div'; | 
| 5999 |  |  |  |  |  |  | return $e_string; | 
| 6000 |  |  |  |  |  |  | } | 
| 6001 |  |  |  |  |  |  | } | 
| 6002 |  |  |  |  |  |  |  | 
| 6003 | 170 |  |  |  |  | 659 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5hkscs::PREMATCH() | 
| 6004 | 4 |  |  |  |  | 8 | elsif (/\G ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  \b | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) /oxmsgc) { | 
| 6005 |  |  |  |  |  |  | $slash = 'div'; | 
| 6006 |  |  |  |  |  |  | return q{Ebig5hkscs::PREMATCH()}; | 
| 6007 |  |  |  |  |  |  | } | 
| 6008 |  |  |  |  |  |  |  | 
| 6009 | 4 |  |  |  |  | 16 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5hkscs::MATCH() | 
| 6010 | 28 |  |  |  |  | 61 | elsif (/\G ( \$& | \$\{&\} | \$ (?>\s*) MATCH     \b | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) /oxmsgc) { | 
| 6011 |  |  |  |  |  |  | $slash = 'div'; | 
| 6012 |  |  |  |  |  |  | return q{Ebig5hkscs::MATCH()}; | 
| 6013 |  |  |  |  |  |  | } | 
| 6014 |  |  |  |  |  |  |  | 
| 6015 | 28 |  |  |  |  | 90 | # $', ${'} --> $', ${'} | 
| 6016 | 1 |  |  |  |  | 2 | elsif (/\G ( \$' | \$\{'\}                                                                                                     ) /oxmsgc) { | 
| 6017 |  |  |  |  |  |  | $slash = 'div'; | 
| 6018 |  |  |  |  |  |  | return $1; | 
| 6019 |  |  |  |  |  |  | } | 
| 6020 |  |  |  |  |  |  |  | 
| 6021 | 1 |  |  |  |  | 4 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5hkscs::POSTMATCH() | 
| 6022 | 3 |  |  |  |  | 16 | elsif (/\G (                 \$ (?>\s*) POSTMATCH \b | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) /oxmsgc) { | 
| 6023 |  |  |  |  |  |  | $slash = 'div'; | 
| 6024 |  |  |  |  |  |  | return q{Ebig5hkscs::POSTMATCH()}; | 
| 6025 |  |  |  |  |  |  | } | 
| 6026 |  |  |  |  |  |  |  | 
| 6027 |  |  |  |  |  |  | # scalar variable $scalar =~ tr///; | 
| 6028 |  |  |  |  |  |  | # scalar variable $scalar =~ s///; | 
| 6029 |  |  |  |  |  |  | # substr() =~ tr///; | 
| 6030 | 3 |  |  |  |  | 12 | # substr() =~ s///; | 
| 6031 |  |  |  |  |  |  | elsif (/\G ( \$ $qq_scalar | $qq_substr ) /oxgc) { | 
| 6032 | 2878 | 100 |  |  |  | 11530 | my $scalar = e_string($1); | 
|  |  | 100 |  |  |  |  |  | 
| 6033 | 2878 |  |  |  |  | 11499 |  | 
| 6034 | 9 |  |  |  |  | 20 | if (/\G (    (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= (?: tr | y ) \b ) /oxgc) { | 
| 6035 | 9 |  |  |  |  | 21 | $tr_variable = $scalar; | 
| 6036 | 9 |  |  |  |  | 14 | $bind_operator = $1; | 
| 6037 |  |  |  |  |  |  | $slash = 'm//'; | 
| 6038 |  |  |  |  |  |  | return ''; | 
| 6039 | 9 |  |  |  |  | 29 | } | 
| 6040 | 253 |  |  |  |  | 449 | elsif (/\G ( (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= s            \b ) /oxgc) { | 
| 6041 | 253 |  |  |  |  | 598 | $sub_variable = $scalar; | 
| 6042 | 253 |  |  |  |  | 341 | $bind_operator = $1; | 
| 6043 |  |  |  |  |  |  | $slash = 'm//'; | 
| 6044 |  |  |  |  |  |  | return ''; | 
| 6045 | 253 |  |  |  |  | 710 | } | 
| 6046 | 2616 |  |  |  |  | 4536 | else { | 
| 6047 |  |  |  |  |  |  | $slash = 'div'; | 
| 6048 |  |  |  |  |  |  | return $scalar; | 
| 6049 |  |  |  |  |  |  | } | 
| 6050 |  |  |  |  |  |  | } | 
| 6051 |  |  |  |  |  |  |  | 
| 6052 | 2616 |  |  |  |  | 7852 | # end of statement | 
| 6053 |  |  |  |  |  |  | elsif (/\G ( [,;] ) /oxgc) { | 
| 6054 |  |  |  |  |  |  | $slash = 'm//'; | 
| 6055 | 12209 |  |  |  |  | 19077 |  | 
| 6056 |  |  |  |  |  |  | # clear tr/// variable | 
| 6057 |  |  |  |  |  |  | $tr_variable  = ''; | 
| 6058 | 12209 |  |  |  |  | 15200 |  | 
| 6059 |  |  |  |  |  |  | # clear s/// variable | 
| 6060 | 12209 |  |  |  |  | 14604 | $sub_variable  = ''; | 
| 6061 |  |  |  |  |  |  |  | 
| 6062 | 12209 |  |  |  |  | 13987 | $bind_operator = ''; | 
| 6063 |  |  |  |  |  |  |  | 
| 6064 |  |  |  |  |  |  | return $1; | 
| 6065 |  |  |  |  |  |  | } | 
| 6066 |  |  |  |  |  |  |  | 
| 6067 | 12209 |  |  |  |  | 43042 | # bareword | 
| 6068 |  |  |  |  |  |  | elsif (/\G ( \{ (?>\s*) (?: tr | index | rindex | reverse ) (?>\s*) \} ) /oxmsgc) { | 
| 6069 |  |  |  |  |  |  | return $1; | 
| 6070 |  |  |  |  |  |  | } | 
| 6071 |  |  |  |  |  |  |  | 
| 6072 | 0 |  |  |  |  | 0 | # $0 --> $0 | 
| 6073 | 2 |  |  |  |  | 5 | elsif (/\G ( \$ 0 ) /oxmsgc) { | 
| 6074 |  |  |  |  |  |  | $slash = 'div'; | 
| 6075 |  |  |  |  |  |  | return $1; | 
| 6076 | 2 |  |  |  |  | 6 | } | 
| 6077 | 0 |  |  |  |  | 0 | elsif (/\G ( \$ \{ (?>\s*) 0 (?>\s*) \} ) /oxmsgc) { | 
| 6078 |  |  |  |  |  |  | $slash = 'div'; | 
| 6079 |  |  |  |  |  |  | return $1; | 
| 6080 |  |  |  |  |  |  | } | 
| 6081 |  |  |  |  |  |  |  | 
| 6082 | 0 |  |  |  |  | 0 | # $$ --> $$ | 
| 6083 | 1 |  |  |  |  | 3 | elsif (/\G ( \$ \$ ) (?![\w\{]) /oxmsgc) { | 
| 6084 |  |  |  |  |  |  | $slash = 'div'; | 
| 6085 |  |  |  |  |  |  | return $1; | 
| 6086 |  |  |  |  |  |  | } | 
| 6087 |  |  |  |  |  |  |  | 
| 6088 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 6089 | 1 |  |  |  |  | 8 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 6090 | 219 |  |  |  |  | 375 | elsif (/\G \$ ((?>[1-9][0-9]*)) /oxmsgc) { | 
| 6091 |  |  |  |  |  |  | $slash = 'div'; | 
| 6092 |  |  |  |  |  |  | return e_capture($1); | 
| 6093 | 219 |  |  |  |  | 493 | } | 
| 6094 | 0 |  |  |  |  | 0 | elsif (/\G \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} /oxmsgc) { | 
| 6095 |  |  |  |  |  |  | $slash = 'div'; | 
| 6096 |  |  |  |  |  |  | return e_capture($1); | 
| 6097 |  |  |  |  |  |  | } | 
| 6098 |  |  |  |  |  |  |  | 
| 6099 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 6100 | 0 |  |  |  |  | 0 | elsif (/\G \$ ( \$ (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ .+? \] ) /oxmsgc) { | 
| 6101 |  |  |  |  |  |  | $slash = 'div'; | 
| 6102 |  |  |  |  |  |  | return e_capture($1.'->'.$2); | 
| 6103 |  |  |  |  |  |  | } | 
| 6104 |  |  |  |  |  |  |  | 
| 6105 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 6106 | 0 |  |  |  |  | 0 | elsif (/\G \$ ( \$ (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ .+? \} ) /oxmsgc) { | 
| 6107 |  |  |  |  |  |  | $slash = 'div'; | 
| 6108 |  |  |  |  |  |  | return e_capture($1.'->'.$2); | 
| 6109 |  |  |  |  |  |  | } | 
| 6110 |  |  |  |  |  |  |  | 
| 6111 | 0 |  |  |  |  | 0 | # $$foo | 
| 6112 | 0 |  |  |  |  | 0 | elsif (/\G \$ ( \$ (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) /oxmsgc) { | 
| 6113 |  |  |  |  |  |  | $slash = 'div'; | 
| 6114 |  |  |  |  |  |  | return e_capture($1); | 
| 6115 |  |  |  |  |  |  | } | 
| 6116 |  |  |  |  |  |  |  | 
| 6117 | 0 |  |  |  |  | 0 | # ${ foo } | 
| 6118 | 0 |  |  |  |  | 0 | elsif (/\G \$ (?>\s*) \{ ( (?>\s*) (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) (?>\s*) ) \} /oxmsgc) { | 
| 6119 |  |  |  |  |  |  | $slash = 'div'; | 
| 6120 |  |  |  |  |  |  | return '${' . $1 . '}'; | 
| 6121 |  |  |  |  |  |  | } | 
| 6122 |  |  |  |  |  |  |  | 
| 6123 | 0 |  |  |  |  | 0 | # ${ ... } | 
| 6124 | 0 |  |  |  |  | 0 | elsif (/\G \$ (?>\s*) \{ (?>\s*) ( $qq_brace ) (?>\s*) \} /oxmsgc) { | 
| 6125 |  |  |  |  |  |  | $slash = 'div'; | 
| 6126 |  |  |  |  |  |  | return e_capture($1); | 
| 6127 |  |  |  |  |  |  | } | 
| 6128 |  |  |  |  |  |  |  | 
| 6129 |  |  |  |  |  |  | # variable or function | 
| 6130 | 0 |  |  |  |  | 0 | #                  $ @ % & *     $ # | 
| 6131 | 605 |  |  |  |  | 1019 | elsif (/\G ( (?: [\$\@\%\&\*] | \$\# | -> | \b sub \b) (?>\s*) (?: split | chop | index | rindex | lc | uc | fc | chr | ord | reverse | getc | tr | y | q | qq | qx | qw | m | s | qr | glob | lstat | opendir | stat | unlink | chdir ) ) \b /oxmsgc) { | 
| 6132 |  |  |  |  |  |  | $slash = 'div'; | 
| 6133 |  |  |  |  |  |  | return $1; | 
| 6134 |  |  |  |  |  |  | } | 
| 6135 |  |  |  |  |  |  | #                $ $ $ $ $ $ $ $ $ $ $ $ $ $ | 
| 6136 | 605 |  |  |  |  | 2035 | #                $ @ # \ ' " / ? ( ) [ ] < > | 
| 6137 | 103 |  |  |  |  | 205 | elsif (/\G ( \$[\$\@\#\\\'\"\/\?\(\)\[\]\<\>] ) /oxmsgc) { | 
| 6138 |  |  |  |  |  |  | $slash = 'div'; | 
| 6139 |  |  |  |  |  |  | return $1; | 
| 6140 |  |  |  |  |  |  | } | 
| 6141 |  |  |  |  |  |  |  | 
| 6142 | 103 |  |  |  |  | 355 | # while () | 
| 6143 |  |  |  |  |  |  | elsif (/\G \b (while (?>\s*) \( (?>\s*) <[\$]?[A-Za-z_][A-Za-z_0-9]*> (?>\s*) \)) \b /oxgc) { | 
| 6144 |  |  |  |  |  |  | return $1; | 
| 6145 |  |  |  |  |  |  | } | 
| 6146 |  |  |  |  |  |  |  | 
| 6147 |  |  |  |  |  |  | # while () --- glob | 
| 6148 |  |  |  |  |  |  |  | 
| 6149 |  |  |  |  |  |  | # avoid "Error: Runtime exception" of perl version 5.005_03 | 
| 6150 | 0 |  |  |  |  | 0 |  | 
| 6151 |  |  |  |  |  |  | elsif (/\G \b while (?>\s*) \( (?>\s*) < ((?:[^\x81-\xFE>\0\a\e\f\n\r\t]|[\x81-\xFE][\x00-\xFF])+?) > (?>\s*) \) \b /oxgc) { | 
| 6152 |  |  |  |  |  |  | return 'while ($_ = Ebig5hkscs::glob("' . $1 . '"))'; | 
| 6153 |  |  |  |  |  |  | } | 
| 6154 |  |  |  |  |  |  |  | 
| 6155 | 0 |  |  |  |  | 0 | # while (glob) | 
| 6156 |  |  |  |  |  |  | elsif (/\G \b while (?>\s*) \( (?>\s*) glob (?>\s*) \) /oxgc) { | 
| 6157 |  |  |  |  |  |  | return 'while ($_ = Ebig5hkscs::glob_)'; | 
| 6158 |  |  |  |  |  |  | } | 
| 6159 |  |  |  |  |  |  |  | 
| 6160 | 0 |  |  |  |  | 0 | # while (glob(WILDCARD)) | 
| 6161 |  |  |  |  |  |  | elsif (/\G \b while (?>\s*) \( (?>\s*) glob \b /oxgc) { | 
| 6162 |  |  |  |  |  |  | return 'while ($_ = Ebig5hkscs::glob'; | 
| 6163 |  |  |  |  |  |  | } | 
| 6164 | 0 |  |  |  |  | 0 |  | 
|  | 482 |  |  |  |  | 1174 |  | 
| 6165 |  |  |  |  |  |  | # doit if, doit unless, doit while, doit until, doit for, doit when | 
| 6166 |  |  |  |  |  |  | elsif (/\G \b ( if | unless | while | until | for | when ) \b /oxgc) { $slash = 'm//'; return $1; } | 
| 6167 | 482 |  |  |  |  | 1942 |  | 
|  | 19 |  |  |  |  | 39 |  | 
| 6168 | 19 |  |  |  |  | 66 | # subroutines of package Ebig5hkscs | 
|  | 0 |  |  |  |  | 0 |  | 
| 6169 | 0 |  |  |  |  | 0 | elsif (/\G \b (CORE:: | ->(>?\s*) (?: atan2 | [a-z]{2,})) \b       /oxgc) { $slash = 'm//'; return $1;                  } | 
|  | 13 |  |  |  |  | 16 |  | 
| 6170 | 13 |  |  |  |  | 40 | elsif (/\G \b Char::eval       (?= (?>\s*) \{ )                    /oxgc) { $slash = 'm//'; return 'eval';              } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6171 | 0 |  |  |  |  | 0 | elsif (/\G \b Big5HKSCS::eval       (?= (?>\s*) \{ )                    /oxgc) { $slash = 'm//'; return 'eval';              } | 
|  | 114 |  |  |  |  | 183 |  | 
| 6172 | 114 |  |  |  |  | 359 | elsif (/\G \b Char::eval    \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'eval Char::escape'; } | 
|  | 2 |  |  |  |  | 5 |  | 
| 6173 | 2 |  |  |  |  | 6 | elsif (/\G \b Big5HKSCS::eval    \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'eval Big5HKSCS::escape'; } | 
|  | 2 |  |  |  |  | 4 |  | 
| 6174 | 2 |  |  |  |  | 6 | elsif (/\G \b bytes::substr \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'substr';            } | 
|  | 2 |  |  |  |  | 3 |  | 
| 6175 | 2 |  |  |  |  | 7 | elsif (/\G \b chop \b          (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::chop';       } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6176 | 0 |  |  |  |  | 0 | elsif (/\G \b bytes::index \b  (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'index';             } | 
|  | 2 |  |  |  |  | 3 |  | 
| 6177 | 2 |  |  |  |  | 7 | elsif (/\G \b Char::index \b   (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Char::index';       } | 
|  | 2 |  |  |  |  | 3 |  | 
| 6178 | 2 |  |  |  |  | 7 | elsif (/\G \b Big5HKSCS::index \b   (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Big5HKSCS::index';       } | 
|  | 2 |  |  |  |  | 4 |  | 
| 6179 | 2 |  |  |  |  | 5 | elsif (/\G \b index \b         (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::index';      } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6180 | 0 |  |  |  |  | 0 | elsif (/\G \b bytes::rindex \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'rindex';            } | 
|  | 2 |  |  |  |  | 5 |  | 
| 6181 | 2 |  |  |  |  | 5 | elsif (/\G \b Char::rindex \b  (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Char::rindex';      } | 
|  | 2 |  |  |  |  | 4 |  | 
| 6182 | 2 |  |  |  |  | 5 | elsif (/\G \b Big5HKSCS::rindex \b  (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Big5HKSCS::rindex';      } | 
|  | 1 |  |  |  |  | 3 |  | 
| 6183 | 1 |  |  |  |  | 5 | elsif (/\G \b rindex \b        (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::rindex';     } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6184 | 0 |  |  |  |  | 0 | elsif (/\G \b lc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::lc';         } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6185 | 0 |  |  |  |  | 0 | elsif (/\G \b lcfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::lcfirst';    } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6186 | 0 |  |  |  |  | 0 | elsif (/\G \b uc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::uc';         } | 
|  | 3 |  |  |  |  | 4 |  | 
| 6187 |  |  |  |  |  |  | elsif (/\G \b ucfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::ucfirst';    } | 
| 6188 |  |  |  |  |  |  | elsif (/\G \b fc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::fc';         } | 
| 6189 |  |  |  |  |  |  |  | 
| 6190 |  |  |  |  |  |  | # stacked file test operators | 
| 6191 |  |  |  |  |  |  |  | 
| 6192 |  |  |  |  |  |  | # P.179 File Test Operators | 
| 6193 |  |  |  |  |  |  | # in Chapter 12: File Tests | 
| 6194 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 6195 |  |  |  |  |  |  |  | 
| 6196 |  |  |  |  |  |  | # P.106 Named Unary and File Test Operators | 
| 6197 |  |  |  |  |  |  | # in Chapter 3: Unary and Binary Operators | 
| 6198 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 6199 |  |  |  |  |  |  |  | 
| 6200 |  |  |  |  |  |  | # (and so on) | 
| 6201 | 3 |  |  |  |  | 10 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6202 | 0 |  |  |  |  | 0 | elsif (/\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) | 
|  | 0 |  |  |  |  | 0 |  | 
| 6203 | 0 |  |  |  |  | 0 | (?>\s*) (\") ((?:$qq_char)+?)             (\") /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('',  $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6204 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\#) ((?:$qq_char)+?)             (\#) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6205 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\() ((?:$qq_paren)+?)            (\)) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6206 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\{) ((?:$qq_brace)+?)            (\}) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6207 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\[) ((?:$qq_bracket)+?)          (\]) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 1 |  |  |  |  | 3 |  | 
| 6208 |  |  |  |  |  |  | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\<) ((?:$qq_angle)+?)            (\>) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; } | 
| 6209 |  |  |  |  |  |  | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\S) ((?:$qq_char)+?)             (\2) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; } | 
| 6210 | 1 |  |  |  |  | 5 |  | 
|  | 5 |  |  |  |  | 15 |  | 
| 6211 | 5 |  |  |  |  | 21 | elsif (/\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) | 
|  | 0 |  |  |  |  | 0 |  | 
| 6212 | 0 |  |  |  |  | 0 | (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)    (\') /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('',  $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6213 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)    (\#) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6214 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)   (\)) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6215 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)   (\}) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6216 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 1 |  |  |  |  | 3 |  | 
| 6217 |  |  |  |  |  |  | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)   (\>) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; } | 
| 6218 |  |  |  |  |  |  | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\S) ((?:\\\2|\\\\|$q_char)+?)    (\2) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; } | 
| 6219 | 1 |  |  |  |  | 5 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6220 | 0 |  |  |  |  | 0 | elsif (/\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) (\$ (?> \w+ (?: ::\w+)* ) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ) )*) /oxgc) | 
|  | 0 |  |  |  |  | 0 |  | 
| 6221 | 0 |  |  |  |  | 0 | { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1),$2)"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6222 | 0 |  |  |  |  | 0 | elsif (/\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) \( ((?:$qq_paren)*?) \)   /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1),$2)"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6223 |  |  |  |  |  |  | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) (?= [a-z]+)                                       /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest qw($1),";    } | 
| 6224 | 0 |  |  |  |  | 0 | elsif (/\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) ((?>\w+))                                         /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest(qw($1),$2)"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6225 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6226 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC])            (?>\s*) (\") ((?:$qq_char)+?)                (\") /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('',  $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6227 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\#) ((?:$qq_char)+?)                (\#) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6228 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\() ((?:$qq_paren)+?)               (\)) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6229 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\{) ((?:$qq_brace)+?)               (\}) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6230 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\[) ((?:$qq_bracket)+?)             (\]) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 2 |  |  |  |  | 5 |  | 
| 6231 |  |  |  |  |  |  | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\<) ((?:$qq_angle)+?)               (\>) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; } | 
| 6232 | 2 |  |  |  |  | 8 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\S) ((?:$qq_char)+?)                (\2) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; } | 
|  | 103 |  |  |  |  | 212 |  | 
| 6233 | 103 |  |  |  |  | 372 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6234 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC])            (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)       (\') /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('',  $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6235 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)       (\#) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6236 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)      (\)) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6237 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)      (\}) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6238 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?)    (\]) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; } | 
|  | 2 |  |  |  |  | 6 |  | 
| 6239 |  |  |  |  |  |  | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)      (\>) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; } | 
| 6240 |  |  |  |  |  |  | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\S) ((?:\\\2|\\\\|$q_char)+?)       (\2) /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; } | 
| 6241 | 2 |  |  |  |  | 30 |  | 
|  | 6 |  |  |  |  | 13 |  | 
| 6242 | 6 |  |  |  |  | 30 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s*) (\$ (?> \w+ (?: ::\w+)* ) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ) )*) /oxgc) | 
|  | 0 |  |  |  |  | 0 |  | 
| 6243 | 0 |  |  |  |  | 0 | { $slash = 'm//'; return "Ebig5hkscs::$1($2)";             } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6244 | 0 |  |  |  |  | 0 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s*) \( ((?:$qq_paren)*?) \)                              /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1($2)";             } | 
|  | 50 |  |  |  |  | 113 |  | 
| 6245 | 50 |  |  |  |  | 272 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?= (?>\s+) [a-z]+)                                          /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1";                 } | 
|  | 2 |  |  |  |  | 8 |  | 
| 6246 | 2 |  |  |  |  | 149 | elsif (/\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) ((?>\w+))                                            /oxgc) { $slash = 'm//'; return "Ebig5hkscs::$1(::"."$2)";        } | 
|  | 1 |  |  |  |  | 3 |  | 
| 6247 | 1 |  |  |  |  | 4 | elsif (/\G -(t)                            (?>\s+) ((?>\w+))                                            /oxgc) { $slash = 'm//'; return "-t $2";                     } | 
|  | 3 |  |  |  |  | 7 |  | 
| 6248 |  |  |  |  |  |  | elsif (/\G \b lstat         (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(])                                /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::lstat';              } | 
| 6249 |  |  |  |  |  |  | elsif (/\G \b stat          (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(])                                /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::stat';               } | 
| 6250 | 3 |  |  |  |  | 12 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6251 | 0 |  |  |  |  | 0 | # "-s '' ..." means file test "-s 'filename' ..." (not means "- s/// ...") | 
|  | 0 |  |  |  |  | 0 |  | 
| 6252 | 0 |  |  |  |  | 0 | elsif (/\G -s                                          (?>\s*) (\") ((?:$qq_char)+?)               (\") /oxgc) { $slash = 'm//'; return '-s ' . e_qq('',  $1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6253 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\#) ((?:$qq_char)+?)               (\#) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6254 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\() ((?:$qq_paren)+?)              (\)) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6255 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\{) ((?:$qq_brace)+?)              (\}) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6256 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\[) ((?:$qq_bracket)+?)            (\]) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6257 |  |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\<) ((?:$qq_angle)+?)              (\>) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
| 6258 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\S) ((?:$qq_char)+?)               (\1) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6259 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6260 | 0 |  |  |  |  | 0 | elsif (/\G -s                                          (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)      (\') /oxgc) { $slash = 'm//'; return '-s ' . e_q ('',  $1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6261 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)      (\#) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6262 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)     (\)) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6263 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)     (\}) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6264 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?)   (\]) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6265 |  |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)     (\>) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
| 6266 |  |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\S) ((?:\\\1|\\\\|$q_char)+?)      (\1) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
| 6267 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6268 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s*) (\$ (?> \w+ (?: ::\w+)* ) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ) )*) /oxgc) | 
|  | 0 |  |  |  |  | 0 |  | 
| 6269 | 0 |  |  |  |  | 0 | { $slash = 'm//'; return "-s $1";   } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6270 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s*) \( ((?:$qq_paren)*?) \)                             /oxgc) { $slash = 'm//'; return "-s ($1)"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6271 |  |  |  |  |  |  | elsif (/\G -s                               (?= (?>\s+) [a-z]+)                                         /oxgc) { $slash = 'm//'; return '-s';      } | 
| 6272 | 0 |  |  |  |  | 0 | elsif (/\G -s                               (?>\s+) ((?>\w+))                                           /oxgc) { $slash = 'm//'; return "-s $1";   } | 
|  | 2 |  |  |  |  | 5 |  | 
| 6273 | 2 |  |  |  |  | 9 |  | 
|  | 2 |  |  |  |  | 5 |  | 
| 6274 | 2 |  |  |  |  | 6 | elsif (/\G \b bytes::length (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'length';                   } | 
|  | 36 |  |  |  |  | 80 |  | 
| 6275 | 36 |  |  |  |  | 137 | elsif (/\G \b bytes::chr    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'chr';                      } | 
|  | 2 |  |  |  |  | 6 |  | 
| 6276 | 2 |  |  |  |  | 8 | elsif (/\G \b chr           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::chr';               } | 
|  | 2 |  |  |  |  | 5 |  | 
| 6277 | 2 |  |  |  |  | 8 | elsif (/\G \b bytes::ord    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'div'; return 'ord';                      } | 
|  | 8 |  |  |  |  | 24 |  | 
| 6278 | 8 |  |  |  |  | 36 | elsif (/\G \b ord           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'div'; return $function_ord;              } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6279 | 0 |  |  |  |  | 0 | elsif (/\G \b glob          (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::glob';              } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6280 | 0 |  |  |  |  | 0 | elsif (/\G \b lc \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::lc_';               } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6281 | 0 |  |  |  |  | 0 | elsif (/\G \b lcfirst \b       (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::lcfirst_';          } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6282 | 0 |  |  |  |  | 0 | elsif (/\G \b uc \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::uc_';               } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6283 | 0 |  |  |  |  | 0 | elsif (/\G \b ucfirst \b       (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::ucfirst_';          } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6284 | 0 |  |  |  |  | 0 | elsif (/\G \b fc \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::fc_';               } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6285 |  |  |  |  |  |  | elsif (/\G \b lstat \b         (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::lstat_';            } | 
| 6286 | 0 |  |  |  |  | 0 | elsif (/\G \b stat \b          (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::stat_';             } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6287 |  |  |  |  |  |  | elsif (/\G    (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) | 
| 6288 | 0 |  |  |  |  | 0 | \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return "Ebig5hkscs::filetest_(qw($1))"; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6289 |  |  |  |  |  |  | elsif (/\G    -([rwxoRWXOezsfdlpSbcugkTBMAC]) | 
| 6290 | 0 |  |  |  |  | 0 | \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return "Ebig5hkscs::${1}_";             } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6291 |  |  |  |  |  |  |  | 
| 6292 | 0 |  |  |  |  | 0 | elsif (/\G    -s \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return '-s ';                      } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6293 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 6294 | 0 |  |  |  |  | 0 | elsif (/\G \b bytes::length \b (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'length';                   } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6295 | 0 |  |  |  |  | 0 | elsif (/\G \b bytes::chr \b    (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'chr';                      } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6296 | 0 |  |  |  |  | 0 | elsif (/\G \b chr \b           (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::chr_';              } | 
|  | 2 |  |  |  |  | 7 |  | 
| 6297 | 2 |  |  |  |  | 9 | elsif (/\G \b bytes::ord \b    (?! (?>\s*) => )                          /oxgc) { $slash = 'div'; return 'ord';                      } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6298 | 0 |  |  |  |  | 0 | elsif (/\G \b ord \b           (?! (?>\s*) => )                          /oxgc) { $slash = 'div'; return $function_ord_;             } | 
|  | 4 |  |  |  |  | 11 |  | 
| 6299 | 4 |  |  |  |  | 19 | elsif (/\G \b glob \b          (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::glob_';             } | 
|  | 8 |  |  |  |  | 23 |  | 
| 6300 | 8 |  |  |  |  | 36 | elsif (/\G \b reverse \b       (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return $function_reverse;          } | 
|  | 2 |  |  |  |  | 7 |  | 
| 6301 | 2 |  |  |  |  | 13 | elsif (/\G \b getc \b          (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return $function_getc;             } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6302 | 0 |  |  |  |  | 0 | elsif (/\G \b opendir ((?>\s*) \( (?>\s*)) (?=[A-Za-z_])                 /oxgc) { $slash = 'm//'; return "Ebig5hkscs::opendir$1*";        } | 
|  | 87 |  |  |  |  | 245 |  | 
| 6303 |  |  |  |  |  |  | elsif (/\G \b opendir ((?>\s+))            (?=[A-Za-z_])                 /oxgc) { $slash = 'm//'; return "Ebig5hkscs::opendir$1*";        } | 
| 6304 |  |  |  |  |  |  | elsif (/\G \b unlink \b       (?! (?>\s*) => )                           /oxgc) { $slash = 'm//'; return 'Ebig5hkscs::unlink';            } | 
| 6305 |  |  |  |  |  |  |  | 
| 6306 | 87 |  |  |  |  | 355 | # chdir | 
| 6307 |  |  |  |  |  |  | elsif (/\G \b (chdir) \b       (?! (?>\s*) => ) /oxgc) { | 
| 6308 | 3 |  |  |  |  | 8 | $slash = 'm//'; | 
| 6309 |  |  |  |  |  |  |  | 
| 6310 | 3 |  |  |  |  | 4 | my $e = 'Ebig5hkscs::chdir'; | 
| 6311 | 3 |  |  |  |  | 13 |  | 
| 6312 |  |  |  |  |  |  | while (/\G ( (?>\s+) | \( | \#.* ) /oxgc) { | 
| 6313 |  |  |  |  |  |  | $e .= $1; | 
| 6314 |  |  |  |  |  |  | } | 
| 6315 | 3 | 50 |  |  |  | 12 |  | 
|  | 3 | 100 |  |  |  | 214 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6316 |  |  |  |  |  |  | # end of chdir | 
| 6317 |  |  |  |  |  |  | if    (/\G (?= [,;\)\}\]] )          /oxgc) { return $e;                 } | 
| 6318 | 0 |  |  |  |  | 0 |  | 
| 6319 |  |  |  |  |  |  | # chdir scalar value | 
| 6320 |  |  |  |  |  |  | elsif (/\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { return $e . e_string($1);  } | 
| 6321 |  |  |  |  |  |  |  | 
| 6322 | 1 | 0 |  |  |  | 4 | # chdir qq// | 
|  | 0 |  |  |  |  | 0 |  | 
| 6323 |  |  |  |  |  |  | elsif (/\G \b (qq) \b /oxgc) { | 
| 6324 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc)                        { return $e . e_chdir('qq',$1,$3,$2);   } # qq# #  --> qr # # | 
| 6325 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6326 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6327 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                         /oxgc) { $e .= $1; } | 
| 6328 | 0 |  |  |  |  | 0 | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) /oxgc) { return $e . e_chdir('qq',$1,$3,$2);   } # qq ( ) --> qr ( ) | 
| 6329 | 0 |  |  |  |  | 0 | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) /oxgc) { return $e . e_chdir('qq',$1,$3,$2);   } # qq { } --> qr { } | 
| 6330 | 0 |  |  |  |  | 0 | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_chdir('qq',$1,$3,$2);   } # qq [ ] --> qr [ ] | 
| 6331 | 0 |  |  |  |  | 0 | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) /oxgc) { return $e . e_chdir('qq',$1,$3,$2);   } # qq < > --> qr < > | 
| 6332 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) /oxgc) { return $e . e_chdir('qq','{','}',$2); } # qq | | --> qr { } | 
| 6333 | 0 |  |  |  |  | 0 | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) /oxgc) { return $e . e_chdir('qq',$1,$3,$2);   } # qq * * --> qr * * | 
| 6334 |  |  |  |  |  |  | } | 
| 6335 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6336 |  |  |  |  |  |  | } | 
| 6337 |  |  |  |  |  |  | } | 
| 6338 |  |  |  |  |  |  |  | 
| 6339 | 0 | 0 |  |  |  | 0 | # chdir q// | 
|  | 0 |  |  |  |  | 0 |  | 
| 6340 |  |  |  |  |  |  | elsif (/\G \b (q) \b /oxgc) { | 
| 6341 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc)                    { return $e . e_chdir_q('q',$1,$3,$2);   } # q# #  --> qr # # | 
| 6342 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6343 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6344 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                              /oxgc) { $e .= $1; } | 
| 6345 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { return $e . e_chdir_q('q',$1,$3,$2);   } # q ( ) --> qr ( ) | 
| 6346 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { return $e . e_chdir_q('q',$1,$3,$2);   } # q { } --> qr { } | 
| 6347 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { return $e . e_chdir_q('q',$1,$3,$2);   } # q [ ] --> qr [ ] | 
| 6348 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { return $e . e_chdir_q('q',$1,$3,$2);   } # q < > --> qr < > | 
| 6349 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|])       ((?:$q_char)*?)    (\1) /oxgc) { return $e . e_chdir_q('q','{','}',$2); } # q | | --> qr { } | 
| 6350 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { return $e . e_chdir_q('q',$1,$3,$2);   } # q * * --> qr * * | 
| 6351 |  |  |  |  |  |  | } | 
| 6352 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6353 |  |  |  |  |  |  | } | 
| 6354 |  |  |  |  |  |  | } | 
| 6355 |  |  |  |  |  |  |  | 
| 6356 | 0 |  |  |  |  | 0 | # chdir '' | 
| 6357 | 2 |  |  |  |  | 5 | elsif (/\G (\') /oxgc) { | 
| 6358 | 2 | 50 |  |  |  | 7 | my $q_string = ''; | 
|  | 13 | 50 |  |  |  | 72 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6359 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6360 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1; } | 
| 6361 | 2 |  |  |  |  | 7 | elsif (/\G (\\\')    /oxgc) { $q_string .= $1; } | 
| 6362 |  |  |  |  |  |  | elsif (/\G \'        /oxgc)                                       { return $e . e_chdir_q('',"'","'",$q_string); } | 
| 6363 | 11 |  |  |  |  | 22 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1; } | 
| 6364 |  |  |  |  |  |  | } | 
| 6365 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6366 |  |  |  |  |  |  | } | 
| 6367 |  |  |  |  |  |  |  | 
| 6368 | 0 |  |  |  |  | 0 | # chdir "" | 
| 6369 | 0 |  |  |  |  | 0 | elsif (/\G (\") /oxgc) { | 
| 6370 | 0 | 0 |  |  |  | 0 | my $qq_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6371 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6372 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $qq_string .= $1; } | 
| 6373 | 0 |  |  |  |  | 0 | elsif (/\G (\\\")    /oxgc) { $qq_string .= $1; } | 
| 6374 |  |  |  |  |  |  | elsif (/\G \"        /oxgc)                                       { return $e . e_chdir('','"','"',$qq_string); } | 
| 6375 | 0 |  |  |  |  | 0 | elsif (/\G ($q_char) /oxgc) { $qq_string .= $1; } | 
| 6376 |  |  |  |  |  |  | } | 
| 6377 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6378 |  |  |  |  |  |  | } | 
| 6379 |  |  |  |  |  |  | } | 
| 6380 |  |  |  |  |  |  |  | 
| 6381 | 0 |  |  |  |  | 0 | # split | 
| 6382 |  |  |  |  |  |  | elsif (/\G \b (split) \b (?! (?>\s*) => ) /oxgc) { | 
| 6383 | 404 |  |  |  |  | 1029 | $slash = 'm//'; | 
| 6384 | 404 |  |  |  |  | 651 |  | 
| 6385 | 404 |  |  |  |  | 1568 | my $e = ''; | 
| 6386 |  |  |  |  |  |  | while (/\G ( (?>\s+) | \( | \#.* ) /oxgc) { | 
| 6387 |  |  |  |  |  |  | $e .= $1; | 
| 6388 |  |  |  |  |  |  | } | 
| 6389 | 401 | 100 |  |  |  | 1747 |  | 
|  | 404 | 100 |  |  |  | 19911 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6390 |  |  |  |  |  |  | # end of split | 
| 6391 |  |  |  |  |  |  | if    (/\G (?= [,;\)\}\]] )          /oxgc) { return 'Ebig5hkscs::split' . $e;                 } | 
| 6392 | 3 |  |  |  |  | 20 |  | 
| 6393 |  |  |  |  |  |  | # split scalar value | 
| 6394 |  |  |  |  |  |  | elsif (/\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { return 'Ebig5hkscs::split' . $e . e_string($1);  } | 
| 6395 | 1 |  |  |  |  | 6 |  | 
| 6396 | 0 |  |  |  |  | 0 | # split literal space | 
| 6397 | 0 |  |  |  |  | 0 | elsif (/\G \b qq           (\#) [ ] (\#) /oxgc) { return 'Ebig5hkscs::split' . $e . qq  {qq$1 $2}; } | 
| 6398 | 0 |  |  |  |  | 0 | elsif (/\G \b qq ((?>\s*)) (\() [ ] (\)) /oxgc) { return 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; } | 
| 6399 | 0 |  |  |  |  | 0 | elsif (/\G \b qq ((?>\s*)) (\{) [ ] (\}) /oxgc) { return 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; } | 
| 6400 | 0 |  |  |  |  | 0 | elsif (/\G \b qq ((?>\s*)) (\[) [ ] (\]) /oxgc) { return 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; } | 
| 6401 | 0 |  |  |  |  | 0 | elsif (/\G \b qq ((?>\s*)) (\<) [ ] (\>) /oxgc) { return 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; } | 
| 6402 | 0 |  |  |  |  | 0 | elsif (/\G \b qq ((?>\s*)) (\S) [ ] (\2) /oxgc) { return 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; } | 
| 6403 | 0 |  |  |  |  | 0 | elsif (/\G \b q            (\#) [ ] (\#) /oxgc) { return 'Ebig5hkscs::split' . $e . qq   {q$1 $2}; } | 
| 6404 | 0 |  |  |  |  | 0 | elsif (/\G \b q  ((?>\s*)) (\() [ ] (\)) /oxgc) { return 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; } | 
| 6405 | 0 |  |  |  |  | 0 | elsif (/\G \b q  ((?>\s*)) (\{) [ ] (\}) /oxgc) { return 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; } | 
| 6406 | 0 |  |  |  |  | 0 | elsif (/\G \b q  ((?>\s*)) (\[) [ ] (\]) /oxgc) { return 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; } | 
| 6407 | 0 |  |  |  |  | 0 | elsif (/\G \b q  ((?>\s*)) (\<) [ ] (\>) /oxgc) { return 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; } | 
| 6408 | 13 |  |  |  |  | 91 | elsif (/\G \b q  ((?>\s*)) (\S) [ ] (\2) /oxgc) { return 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; } | 
| 6409 |  |  |  |  |  |  | elsif (/\G                    ' [ ] '    /oxgc) { return 'Ebig5hkscs::split' . $e . qq     {' '};  } | 
| 6410 |  |  |  |  |  |  | elsif (/\G                    " [ ] "    /oxgc) { return 'Ebig5hkscs::split' . $e . qq     {" "};  } | 
| 6411 |  |  |  |  |  |  |  | 
| 6412 | 2 | 0 |  |  |  | 12 | # split qq// | 
|  | 0 |  |  |  |  | 0 |  | 
| 6413 |  |  |  |  |  |  | elsif (/\G \b (qq) \b /oxgc) { | 
| 6414 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc)                        { return e_split($e.'qr',$1,$3,$2,'');   } # qq# #  --> qr # # | 
| 6415 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6416 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6417 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                         /oxgc) { $e .= $1; } | 
| 6418 | 0 |  |  |  |  | 0 | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq ( ) --> qr ( ) | 
| 6419 | 0 |  |  |  |  | 0 | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq { } --> qr { } | 
| 6420 | 0 |  |  |  |  | 0 | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq [ ] --> qr [ ] | 
| 6421 | 0 |  |  |  |  | 0 | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq < > --> qr < > | 
| 6422 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) /oxgc) { return e_split($e.'qr','{','}',$2,''); } # qq | | --> qr { } | 
| 6423 | 0 |  |  |  |  | 0 | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq * * --> qr * * | 
| 6424 |  |  |  |  |  |  | } | 
| 6425 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6426 |  |  |  |  |  |  | } | 
| 6427 |  |  |  |  |  |  | } | 
| 6428 |  |  |  |  |  |  |  | 
| 6429 | 0 | 50 |  |  |  | 0 | # split qr// | 
|  | 124 |  |  |  |  | 951 |  | 
| 6430 |  |  |  |  |  |  | elsif (/\G \b (qr) \b /oxgc) { | 
| 6431 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:$qq_char)*?) (\#) ([imosxpadlunbB]*) /oxgc)                        { return e_split  ($e.'qr',$1,$3,$2,$4);   } # qr# # | 
| 6432 | 124 | 50 |  |  |  | 465 | else { | 
|  | 124 | 50 |  |  |  | 6309 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6433 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6434 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                            /oxgc) { $e .= $1; } | 
| 6435 | 0 |  |  |  |  | 0 | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr ( ) | 
| 6436 | 0 |  |  |  |  | 0 | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr { } | 
| 6437 | 0 |  |  |  |  | 0 | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr [ ] | 
| 6438 | 56 |  |  |  |  | 392 | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr < > | 
| 6439 | 0 |  |  |  |  | 0 | elsif (/\G (\')          ((?:$qq_char)*?)    (\') ([imosxpadlunbB]*) /oxgc) { return e_split_q($e.'qr',$1, $3, $2,$4); } # qr ' ' | 
| 6440 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr','{','}',$2,$4); } # qr | | --> qr { } | 
| 6441 | 68 |  |  |  |  | 324 | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr * * | 
| 6442 |  |  |  |  |  |  | } | 
| 6443 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6444 |  |  |  |  |  |  | } | 
| 6445 |  |  |  |  |  |  | } | 
| 6446 |  |  |  |  |  |  |  | 
| 6447 | 0 | 0 |  |  |  | 0 | # split q// | 
|  | 0 |  |  |  |  | 0 |  | 
| 6448 |  |  |  |  |  |  | elsif (/\G \b (q) \b /oxgc) { | 
| 6449 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc)                    { return e_split_q($e.'qr',$1,$3,$2,'');   } # q# #  --> qr # # | 
| 6450 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6451 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6452 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                              /oxgc) { $e .= $1; } | 
| 6453 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q ( ) --> qr ( ) | 
| 6454 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q { } --> qr { } | 
| 6455 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q [ ] --> qr [ ] | 
| 6456 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q < > --> qr < > | 
| 6457 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|])       ((?:$q_char)*?)    (\1) /oxgc) { return e_split_q($e.'qr','{','}',$2,''); } # q | | --> qr { } | 
| 6458 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q * * --> qr * * | 
| 6459 |  |  |  |  |  |  | } | 
| 6460 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6461 |  |  |  |  |  |  | } | 
| 6462 |  |  |  |  |  |  | } | 
| 6463 |  |  |  |  |  |  |  | 
| 6464 | 0 | 50 |  |  |  | 0 | # split m// | 
|  | 136 |  |  |  |  | 1028 |  | 
| 6465 |  |  |  |  |  |  | elsif (/\G \b (m) \b /oxgc) { | 
| 6466 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc)                        { return e_split  ($e.'qr',$1,$3,$2,$4);   } # m# #  --> qr # # | 
| 6467 | 136 | 50 |  |  |  | 516 | else { | 
|  | 136 | 50 |  |  |  | 6531 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6468 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6469 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                              /oxgc) { $e .= $1; } | 
| 6470 | 0 |  |  |  |  | 0 | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m ( ) --> qr ( ) | 
| 6471 | 0 |  |  |  |  | 0 | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m { } --> qr { } | 
| 6472 | 0 |  |  |  |  | 0 | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m [ ] --> qr [ ] | 
| 6473 | 56 |  |  |  |  | 214 | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m < > --> qr < > | 
| 6474 | 0 |  |  |  |  | 0 | elsif (/\G (\')          ((?:$qq_char)*?)    (\') ([cgimosxpadlunbB]*) /oxgc) { return e_split_q($e.'qr',$1, $3, $2,$4); } # m ' ' --> qr ' ' | 
| 6475 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr','{','}',$2,$4); } # m | | --> qr { } | 
| 6476 | 80 |  |  |  |  | 360 | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m * * --> qr * * | 
| 6477 |  |  |  |  |  |  | } | 
| 6478 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 6479 |  |  |  |  |  |  | } | 
| 6480 |  |  |  |  |  |  | } | 
| 6481 |  |  |  |  |  |  |  | 
| 6482 | 0 |  |  |  |  | 0 | # split '' | 
| 6483 | 0 |  |  |  |  | 0 | elsif (/\G (\') /oxgc) { | 
| 6484 | 0 | 0 |  |  |  | 0 | my $q_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6485 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6486 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1; } | 
| 6487 | 0 |  |  |  |  | 0 | elsif (/\G (\\\')    /oxgc) { $q_string .= $1; }                               # splitqr'' --> split qr'' | 
| 6488 |  |  |  |  |  |  | elsif (/\G \'        /oxgc)                                                    { return e_split_q($e.q{ qr},"'","'",$q_string,''); } # ' ' --> qr ' ' | 
| 6489 | 0 |  |  |  |  | 0 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1; } | 
| 6490 |  |  |  |  |  |  | } | 
| 6491 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6492 |  |  |  |  |  |  | } | 
| 6493 |  |  |  |  |  |  |  | 
| 6494 | 0 |  |  |  |  | 0 | # split "" | 
| 6495 | 0 |  |  |  |  | 0 | elsif (/\G (\") /oxgc) { | 
| 6496 | 0 | 0 |  |  |  | 0 | my $qq_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6497 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6498 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $qq_string .= $1; } | 
| 6499 | 0 |  |  |  |  | 0 | elsif (/\G (\\\")    /oxgc) { $qq_string .= $1; }                              # splitqr"" --> split qr"" | 
| 6500 |  |  |  |  |  |  | elsif (/\G \"        /oxgc)                                                    { return e_split($e.q{ qr},'"','"',$qq_string,''); } # " " --> qr " " | 
| 6501 | 0 |  |  |  |  | 0 | elsif (/\G ($q_char) /oxgc) { $qq_string .= $1; } | 
| 6502 |  |  |  |  |  |  | } | 
| 6503 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6504 |  |  |  |  |  |  | } | 
| 6505 |  |  |  |  |  |  |  | 
| 6506 | 0 |  |  |  |  | 0 | # split // | 
| 6507 | 125 |  |  |  |  | 373 | elsif (/\G (\/) /oxgc) { | 
| 6508 | 125 | 50 |  |  |  | 390 | my $regexp = ''; | 
|  | 558 | 50 |  |  |  | 3487 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6509 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6510 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)                  /oxgc) { $regexp .= $1; } | 
| 6511 | 125 |  |  |  |  | 587 | elsif (/\G (\\\/)                  /oxgc) { $regexp .= $1; }                   # splitqr// --> split qr// | 
| 6512 |  |  |  |  |  |  | elsif (/\G \/ ([cgimosxpadlunbB]*) /oxgc)                                      { return e_split($e.q{ qr}, '/','/',$regexp,$1); } # / / --> qr / / | 
| 6513 | 433 |  |  |  |  | 1140 | elsif (/\G ($q_char)               /oxgc) { $regexp .= $1; } | 
| 6514 |  |  |  |  |  |  | } | 
| 6515 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 6516 |  |  |  |  |  |  | } | 
| 6517 |  |  |  |  |  |  | } | 
| 6518 |  |  |  |  |  |  |  | 
| 6519 |  |  |  |  |  |  | # tr/// or y/// | 
| 6520 |  |  |  |  |  |  |  | 
| 6521 |  |  |  |  |  |  | # about [cdsrbB]* (/B modifier) | 
| 6522 |  |  |  |  |  |  | # | 
| 6523 |  |  |  |  |  |  | # P.559 appendix C | 
| 6524 |  |  |  |  |  |  | # of ISBN 4-89052-384-7 Programming perl | 
| 6525 |  |  |  |  |  |  | # (Japanese title is: Perl puroguramingu) | 
| 6526 | 0 |  |  |  |  | 0 |  | 
| 6527 |  |  |  |  |  |  | elsif (/\G \b ( tr | y ) \b /oxgc) { | 
| 6528 |  |  |  |  |  |  | my $ope = $1; | 
| 6529 | 11 | 50 |  |  |  | 136 |  | 
| 6530 | 11 |  |  |  |  | 283 | #        $1   $2               $3   $4               $5   $6 | 
| 6531 | 0 |  |  |  |  | 0 | if (/\G (\#) ((?:$qq_char)*?) (\#) ((?:$qq_char)*?) (\#) ([cdsrbB]*) /oxgc) { # tr# # # | 
| 6532 |  |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 6533 |  |  |  |  |  |  | return e_tr(@tr,'',$4,$6); | 
| 6534 | 0 |  |  |  |  | 0 | } | 
| 6535 | 11 |  |  |  |  | 23 | else { | 
| 6536 | 11 | 50 |  |  |  | 34 | my $e = ''; | 
|  | 11 | 50 |  |  |  | 2142 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6537 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6538 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)              /oxgc) { $e .= $1; } | 
| 6539 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { | 
| 6540 | 0 | 0 |  |  |  | 0 | my @tr = ($tr_variable,$2); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6541 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6542 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
| 6543 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) ( ) | 
| 6544 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) { } | 
| 6545 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) [ ] | 
| 6546 |  |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) < > | 
| 6547 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) * * | 
| 6548 |  |  |  |  |  |  | } | 
| 6549 |  |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 6550 | 0 |  |  |  |  | 0 | } | 
| 6551 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { | 
| 6552 | 0 | 0 |  |  |  | 0 | my @tr = ($tr_variable,$2); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6553 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6554 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
| 6555 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } ( ) | 
| 6556 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } { } | 
| 6557 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } [ ] | 
| 6558 |  |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } < > | 
| 6559 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } * * | 
| 6560 |  |  |  |  |  |  | } | 
| 6561 |  |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 6562 | 0 |  |  |  |  | 0 | } | 
| 6563 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { | 
| 6564 | 0 | 0 |  |  |  | 0 | my @tr = ($tr_variable,$2); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6565 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6566 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
| 6567 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] ( ) | 
| 6568 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] { } | 
| 6569 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] [ ] | 
| 6570 |  |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] < > | 
| 6571 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] * * | 
| 6572 |  |  |  |  |  |  | } | 
| 6573 |  |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 6574 | 0 |  |  |  |  | 0 | } | 
| 6575 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { | 
| 6576 | 0 | 0 |  |  |  | 0 | my @tr = ($tr_variable,$2); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6577 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6578 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
| 6579 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > ( ) | 
| 6580 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > { } | 
| 6581 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > [ ] | 
| 6582 |  |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > < > | 
| 6583 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > * * | 
| 6584 |  |  |  |  |  |  | } | 
| 6585 |  |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 6586 |  |  |  |  |  |  | } | 
| 6587 | 0 |  |  |  |  | 0 | #           $1   $2               $3   $4               $5   $6 | 
| 6588 | 11 |  |  |  |  | 47 | elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) { # tr * * * | 
| 6589 |  |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 6590 |  |  |  |  |  |  | return e_tr(@tr,'',$4,$6); | 
| 6591 | 11 |  |  |  |  | 37 | } | 
| 6592 |  |  |  |  |  |  | } | 
| 6593 |  |  |  |  |  |  | die __FILE__, ": Transliteration pattern not terminated\n"; | 
| 6594 |  |  |  |  |  |  | } | 
| 6595 |  |  |  |  |  |  | } | 
| 6596 |  |  |  |  |  |  |  | 
| 6597 | 0 |  |  |  |  | 0 | # qq// | 
| 6598 |  |  |  |  |  |  | elsif (/\G \b (qq) \b /oxgc) { | 
| 6599 |  |  |  |  |  |  | my $ope = $1; | 
| 6600 | 5897 | 100 |  |  |  | 16202 |  | 
| 6601 | 5897 |  |  |  |  | 12480 | #       if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { return e_qq($ope,$1,$3,$2); } # qq# # | 
| 6602 | 40 |  |  |  |  | 56 | if (/\G (\#) /oxgc) {                                                     # qq# # | 
| 6603 | 40 | 100 |  |  |  | 105 | my $qq_string = ''; | 
|  | 1948 | 50 |  |  |  | 5821 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6604 | 80 |  |  |  |  | 266 | while (not /\G \z/oxgc) { | 
| 6605 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                     } | 
| 6606 | 40 |  |  |  |  | 94 | elsif (/\G (\\\#)     /oxgc) { $qq_string .= $1;                     } | 
| 6607 |  |  |  |  |  |  | elsif (/\G (\#)       /oxgc) { return e_qq($ope,'#','#',$qq_string); } | 
| 6608 | 1828 |  |  |  |  | 3510 | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                     } | 
| 6609 |  |  |  |  |  |  | } | 
| 6610 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6611 |  |  |  |  |  |  | } | 
| 6612 | 0 |  |  |  |  | 0 |  | 
| 6613 | 5857 |  |  |  |  | 7959 | else { | 
| 6614 | 5857 | 50 |  |  |  | 14301 | my $e = ''; | 
|  | 5857 | 50 |  |  |  | 22747 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6615 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6616 |  |  |  |  |  |  | if    (/\G ((?>\s+)|\#.*)              /oxgc) { $e .= $1; } | 
| 6617 |  |  |  |  |  |  |  | 
| 6618 | 0 |  |  |  |  | 0 | #               elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq ( ) | 
| 6619 | 0 |  |  |  |  | 0 | elsif (/\G (\() /oxgc) {                                                           # qq ( ) | 
| 6620 | 0 |  |  |  |  | 0 | my $qq_string = ''; | 
| 6621 | 0 | 0 |  |  |  | 0 | local $nest = 1; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6622 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6623 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6624 |  |  |  |  |  |  | elsif (/\G (\\\))     /oxgc) { $qq_string .= $1;                          } | 
| 6625 | 0 | 0 |  |  |  | 0 | elsif (/\G (\()       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6626 | 0 |  |  |  |  | 0 | elsif (/\G (\))       /oxgc) { | 
| 6627 |  |  |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'(',')',$qq_string); } | 
| 6628 | 0 |  |  |  |  | 0 | else                     { $qq_string .= $1;                          } | 
| 6629 |  |  |  |  |  |  | } | 
| 6630 | 0 |  |  |  |  | 0 | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 6631 |  |  |  |  |  |  | } | 
| 6632 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6633 |  |  |  |  |  |  | } | 
| 6634 |  |  |  |  |  |  |  | 
| 6635 | 0 |  |  |  |  | 0 | #               elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq { } | 
| 6636 | 5775 |  |  |  |  | 8353 | elsif (/\G (\{) /oxgc) {                                                           # qq { } | 
| 6637 | 5775 |  |  |  |  | 8527 | my $qq_string = ''; | 
| 6638 | 5775 | 100 |  |  |  | 12704 | local $nest = 1; | 
|  | 246229 | 50 |  |  |  | 791315 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6639 | 720 |  |  |  |  | 1478 | while (not /\G \z/oxgc) { | 
| 6640 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 1384 |  |  |  |  | 1886 |  | 
| 6641 |  |  |  |  |  |  | elsif (/\G (\\\})     /oxgc) { $qq_string .= $1;                          } | 
| 6642 | 1384 | 100 |  |  |  | 2430 | elsif (/\G (\{)       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 7159 |  |  |  |  | 11327 |  | 
| 6643 | 5775 |  |  |  |  | 12712 | elsif (/\G (\})       /oxgc) { | 
| 6644 |  |  |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'{','}',$qq_string); } | 
| 6645 | 1384 |  |  |  |  | 2825 | else                     { $qq_string .= $1;                          } | 
| 6646 |  |  |  |  |  |  | } | 
| 6647 | 236966 |  |  |  |  | 488682 | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 6648 |  |  |  |  |  |  | } | 
| 6649 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6650 |  |  |  |  |  |  | } | 
| 6651 |  |  |  |  |  |  |  | 
| 6652 | 0 |  |  |  |  | 0 | #               elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq [ ] | 
| 6653 | 0 |  |  |  |  | 0 | elsif (/\G (\[) /oxgc) {                                                             # qq [ ] | 
| 6654 | 0 |  |  |  |  | 0 | my $qq_string = ''; | 
| 6655 | 0 | 0 |  |  |  | 0 | local $nest = 1; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6656 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6657 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6658 |  |  |  |  |  |  | elsif (/\G (\\\])     /oxgc) { $qq_string .= $1;                          } | 
| 6659 | 0 | 0 |  |  |  | 0 | elsif (/\G (\[)       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6660 | 0 |  |  |  |  | 0 | elsif (/\G (\])       /oxgc) { | 
| 6661 |  |  |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'[',']',$qq_string); } | 
| 6662 | 0 |  |  |  |  | 0 | else                     { $qq_string .= $1;                          } | 
| 6663 |  |  |  |  |  |  | } | 
| 6664 | 0 |  |  |  |  | 0 | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 6665 |  |  |  |  |  |  | } | 
| 6666 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6667 |  |  |  |  |  |  | } | 
| 6668 |  |  |  |  |  |  |  | 
| 6669 | 0 |  |  |  |  | 0 | #               elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq < > | 
| 6670 | 62 |  |  |  |  | 104 | elsif (/\G (\<) /oxgc) {                                                           # qq < > | 
| 6671 | 62 |  |  |  |  | 108 | my $qq_string = ''; | 
| 6672 | 62 | 100 |  |  |  | 173 | local $nest = 1; | 
|  | 2040 | 50 |  |  |  | 7464 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6673 | 22 |  |  |  |  | 51 | while (not /\G \z/oxgc) { | 
| 6674 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 2 |  |  |  |  | 5 |  | 
| 6675 |  |  |  |  |  |  | elsif (/\G (\\\>)     /oxgc) { $qq_string .= $1;                          } | 
| 6676 | 2 | 100 |  |  |  | 3 | elsif (/\G (\<)       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 64 |  |  |  |  | 149 |  | 
| 6677 | 62 |  |  |  |  | 170 | elsif (/\G (\>)       /oxgc) { | 
| 6678 |  |  |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'<','>',$qq_string); } | 
| 6679 | 2 |  |  |  |  | 4 | else                     { $qq_string .= $1;                          } | 
| 6680 |  |  |  |  |  |  | } | 
| 6681 | 1952 |  |  |  |  | 4217 | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 6682 |  |  |  |  |  |  | } | 
| 6683 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6684 |  |  |  |  |  |  | } | 
| 6685 |  |  |  |  |  |  |  | 
| 6686 | 0 |  |  |  |  | 0 | #               elsif (/\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq * * | 
| 6687 | 20 |  |  |  |  | 33 | elsif (/\G (\S) /oxgc) {                                                          # qq * * | 
| 6688 | 20 |  |  |  |  | 28 | my $delimiter = $1; | 
| 6689 | 20 | 50 |  |  |  | 43 | my $qq_string = ''; | 
|  | 840 | 50 |  |  |  | 3049 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6690 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6691 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)             /oxgc) { $qq_string .= $1;                                        } | 
| 6692 | 20 |  |  |  |  | 50 | elsif (/\G (\\\Q$delimiter\E) /oxgc) { $qq_string .= $1;                                        } | 
| 6693 |  |  |  |  |  |  | elsif (/\G (\Q$delimiter\E)   /oxgc) { return $e . e_qq($ope,$delimiter,$delimiter,$qq_string); } | 
| 6694 | 820 |  |  |  |  | 18179 | elsif (/\G ($qq_char)         /oxgc) { $qq_string .= $1;                                        } | 
| 6695 |  |  |  |  |  |  | } | 
| 6696 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6697 | 0 |  |  |  |  | 0 | } | 
| 6698 |  |  |  |  |  |  | } | 
| 6699 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6700 |  |  |  |  |  |  | } | 
| 6701 |  |  |  |  |  |  | } | 
| 6702 |  |  |  |  |  |  |  | 
| 6703 | 0 |  |  |  |  | 0 | # qr// | 
| 6704 | 184 | 50 |  |  |  | 503 | elsif (/\G \b (qr) \b /oxgc) { | 
| 6705 | 184 |  |  |  |  | 751 | my $ope = $1; | 
| 6706 |  |  |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ([imosxpadlunbB]*) /oxgc) { # qr# # # | 
| 6707 |  |  |  |  |  |  | return e_qr($ope,$1,$3,$2,$4); | 
| 6708 | 0 |  |  |  |  | 0 | } | 
| 6709 | 184 |  |  |  |  | 266 | else { | 
| 6710 | 184 | 50 |  |  |  | 486 | my $e = ''; | 
|  | 184 | 50 |  |  |  | 4916 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6711 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6712 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                            /oxgc) { $e .= $1; } | 
| 6713 | 1 |  |  |  |  | 5 | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr ( ) | 
| 6714 | 0 |  |  |  |  | 0 | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr { } | 
| 6715 | 0 |  |  |  |  | 0 | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr [ ] | 
| 6716 | 76 |  |  |  |  | 252 | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr < > | 
| 6717 | 0 |  |  |  |  | 0 | elsif (/\G (\')          ((?:$qq_char)*?)    (\') ([imosxpadlunbB]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # qr ' ' | 
| 6718 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,'{','}',$2,$4); } # qr | | --> qr { } | 
| 6719 | 107 |  |  |  |  | 304 | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr * * | 
| 6720 |  |  |  |  |  |  | } | 
| 6721 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6722 |  |  |  |  |  |  | } | 
| 6723 |  |  |  |  |  |  | } | 
| 6724 |  |  |  |  |  |  |  | 
| 6725 | 0 |  |  |  |  | 0 | # qw// | 
| 6726 | 34 | 50 |  |  |  | 101 | elsif (/\G \b (qw) \b /oxgc) { | 
| 6727 | 34 |  |  |  |  | 100 | my $ope = $1; | 
| 6728 |  |  |  |  |  |  | if (/\G (\#) (.*?) (\#) /oxmsgc) { # qw# # | 
| 6729 |  |  |  |  |  |  | return e_qw($ope,$1,$3,$2); | 
| 6730 | 0 |  |  |  |  | 0 | } | 
| 6731 | 34 |  |  |  |  | 66 | else { | 
| 6732 | 34 | 50 |  |  |  | 115 | my $e = ''; | 
|  | 34 | 50 |  |  |  | 274 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6733 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6734 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                        /oxgc)   { $e .= $1; } | 
| 6735 | 34 |  |  |  |  | 135 |  | 
| 6736 |  |  |  |  |  |  | elsif (/\G (\()          ([^(]*?)           (\)) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw ( ) | 
| 6737 | 0 |  |  |  |  | 0 | elsif (/\G (\()          ((?:$q_paren)*?)   (\)) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw ( ) | 
| 6738 | 0 |  |  |  |  | 0 |  | 
| 6739 |  |  |  |  |  |  | elsif (/\G (\{)          ([^{]*?)           (\}) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw { } | 
| 6740 | 0 |  |  |  |  | 0 | elsif (/\G (\{)          ((?:$q_brace)*?)   (\}) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw { } | 
| 6741 | 0 |  |  |  |  | 0 |  | 
| 6742 |  |  |  |  |  |  | elsif (/\G (\[)          ([^[]*?)           (\]) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw [ ] | 
| 6743 | 0 |  |  |  |  | 0 | elsif (/\G (\[)          ((?:$q_bracket)*?) (\]) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw [ ] | 
| 6744 | 0 |  |  |  |  | 0 |  | 
| 6745 |  |  |  |  |  |  | elsif (/\G (\<)          ([^<]*?)           (\>) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw < > | 
| 6746 | 0 |  |  |  |  | 0 | elsif (/\G (\<)          ((?:$q_angle)*?)   (\>) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw < > | 
| 6747 | 0 |  |  |  |  | 0 |  | 
| 6748 |  |  |  |  |  |  | elsif (/\G ([\x21-\x3F]) (.*?)              (\1) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw * * | 
| 6749 | 0 |  |  |  |  | 0 | elsif (/\G (\S)          ((?:$q_char)*?)    (\1) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw * * | 
| 6750 |  |  |  |  |  |  | } | 
| 6751 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6752 |  |  |  |  |  |  | } | 
| 6753 |  |  |  |  |  |  | } | 
| 6754 |  |  |  |  |  |  |  | 
| 6755 | 0 |  |  |  |  | 0 | # qx// | 
| 6756 | 3 | 50 |  |  |  | 9 | elsif (/\G \b (qx) \b /oxgc) { | 
| 6757 | 3 |  |  |  |  | 71 | my $ope = $1; | 
| 6758 |  |  |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { # qx# # | 
| 6759 |  |  |  |  |  |  | return e_qq($ope,$1,$3,$2); | 
| 6760 | 0 |  |  |  |  | 0 | } | 
| 6761 | 3 |  |  |  |  | 8 | else { | 
| 6762 | 3 | 50 |  |  |  | 13 | my $e = ''; | 
|  | 3 | 50 |  |  |  | 364 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6763 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6764 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                /oxgc) { $e .= $1; } | 
| 6765 | 2 |  |  |  |  | 6 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx ( ) | 
| 6766 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx { } | 
| 6767 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx [ ] | 
| 6768 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx < > | 
| 6769 |  |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?)    (\') /oxgc) { return $e . e_q ($ope,$1,$3,$2); } # qx ' ' | 
| 6770 | 1 |  |  |  |  | 4 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx * * | 
| 6771 |  |  |  |  |  |  | } | 
| 6772 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6773 |  |  |  |  |  |  | } | 
| 6774 |  |  |  |  |  |  | } | 
| 6775 |  |  |  |  |  |  |  | 
| 6776 | 0 |  |  |  |  | 0 | # q// | 
| 6777 |  |  |  |  |  |  | elsif (/\G \b (q) \b /oxgc) { | 
| 6778 |  |  |  |  |  |  | my $ope = $1; | 
| 6779 |  |  |  |  |  |  |  | 
| 6780 |  |  |  |  |  |  | #       if (/\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc) { return e_q($ope,$1,$3,$2); } # q# # | 
| 6781 |  |  |  |  |  |  |  | 
| 6782 |  |  |  |  |  |  | # avoid "Error: Runtime exception" of perl version 5.005_03 | 
| 6783 | 606 | 50 |  |  |  | 2049 | # (and so on) | 
| 6784 | 606 |  |  |  |  | 1946 |  | 
| 6785 | 0 |  |  |  |  | 0 | if (/\G (\#) /oxgc) {                                                             # q# # | 
| 6786 | 0 | 0 |  |  |  | 0 | my $q_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6787 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6788 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                    } | 
| 6789 | 0 |  |  |  |  | 0 | elsif (/\G (\\\#)    /oxgc) { $q_string .= $1;                    } | 
| 6790 |  |  |  |  |  |  | elsif (/\G (\#)      /oxgc) { return e_q($ope,'#','#',$q_string); } | 
| 6791 | 0 |  |  |  |  | 0 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                    } | 
| 6792 |  |  |  |  |  |  | } | 
| 6793 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6794 |  |  |  |  |  |  | } | 
| 6795 | 0 |  |  |  |  | 0 |  | 
| 6796 | 606 |  |  |  |  | 1168 | else { | 
| 6797 | 606 | 50 |  |  |  | 3451 | my $e = ''; | 
|  | 606 | 100 |  |  |  | 4094 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6798 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6799 |  |  |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                       /oxgc) { $e .= $1; } | 
| 6800 |  |  |  |  |  |  |  | 
| 6801 | 0 |  |  |  |  | 0 | #               elsif (/\G (\() ((?:\\\)|\\\\|$q_paren)*?) (\)) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q ( ) | 
| 6802 | 1 |  |  |  |  | 3 | elsif (/\G (\() /oxgc) {                                                                   # q ( ) | 
| 6803 | 1 |  |  |  |  | 2 | my $q_string = ''; | 
| 6804 | 1 | 50 |  |  |  | 5 | local $nest = 1; | 
|  | 7 | 50 |  |  |  | 53 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6805 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6806 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
| 6807 | 0 |  |  |  |  | 0 | elsif (/\G (\\\))    /oxgc) { $q_string .= $1;                         } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6808 |  |  |  |  |  |  | elsif (/\G (\\\()    /oxgc) { $q_string .= $1;                         } | 
| 6809 | 0 | 50 |  |  |  | 0 | elsif (/\G (\()      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 1 |  |  |  |  | 3 |  | 
| 6810 | 1 |  |  |  |  | 3 | elsif (/\G (\))      /oxgc) { | 
| 6811 |  |  |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'(',')',$q_string); } | 
| 6812 | 0 |  |  |  |  | 0 | else                    { $q_string .= $1;                         } | 
| 6813 |  |  |  |  |  |  | } | 
| 6814 | 6 |  |  |  |  | 17 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 6815 |  |  |  |  |  |  | } | 
| 6816 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6817 |  |  |  |  |  |  | } | 
| 6818 |  |  |  |  |  |  |  | 
| 6819 | 0 |  |  |  |  | 0 | #               elsif (/\G (\{) ((?:\\\}|\\\\|$q_brace)*?) (\}) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q { } | 
| 6820 | 599 |  |  |  |  | 1138 | elsif (/\G (\{) /oxgc) {                                                                   # q { } | 
| 6821 | 599 |  |  |  |  | 1128 | my $q_string = ''; | 
| 6822 | 599 | 50 |  |  |  | 1811 | local $nest = 1; | 
|  | 8267 | 50 |  |  |  | 37719 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6823 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6824 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
| 6825 | 0 |  |  |  |  | 0 | elsif (/\G (\\\})    /oxgc) { $q_string .= $1;                         } | 
|  | 114 |  |  |  |  | 185 |  | 
| 6826 |  |  |  |  |  |  | elsif (/\G (\\\{)    /oxgc) { $q_string .= $1;                         } | 
| 6827 | 114 | 100 |  |  |  | 280 | elsif (/\G (\{)      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 713 |  |  |  |  | 1774 |  | 
| 6828 | 599 |  |  |  |  | 2225 | elsif (/\G (\})      /oxgc) { | 
| 6829 |  |  |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'{','}',$q_string); } | 
| 6830 | 114 |  |  |  |  | 244 | else                    { $q_string .= $1;                         } | 
| 6831 |  |  |  |  |  |  | } | 
| 6832 | 7440 |  |  |  |  | 15501 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 6833 |  |  |  |  |  |  | } | 
| 6834 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6835 |  |  |  |  |  |  | } | 
| 6836 |  |  |  |  |  |  |  | 
| 6837 | 0 |  |  |  |  | 0 | #               elsif (/\G (\[) ((?:\\\]|\\\\|$q_bracket)*?) (\]) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q [ ] | 
| 6838 | 0 |  |  |  |  | 0 | elsif (/\G (\[) /oxgc) {                                                                     # q [ ] | 
| 6839 | 0 |  |  |  |  | 0 | my $q_string = ''; | 
| 6840 | 0 | 0 |  |  |  | 0 | local $nest = 1; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6841 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6842 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
| 6843 | 0 |  |  |  |  | 0 | elsif (/\G (\\\])    /oxgc) { $q_string .= $1;                         } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6844 |  |  |  |  |  |  | elsif (/\G (\\\[)    /oxgc) { $q_string .= $1;                         } | 
| 6845 | 0 | 0 |  |  |  | 0 | elsif (/\G (\[)      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6846 | 0 |  |  |  |  | 0 | elsif (/\G (\])      /oxgc) { | 
| 6847 |  |  |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'[',']',$q_string); } | 
| 6848 | 0 |  |  |  |  | 0 | else                    { $q_string .= $1;                         } | 
| 6849 |  |  |  |  |  |  | } | 
| 6850 | 0 |  |  |  |  | 0 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 6851 |  |  |  |  |  |  | } | 
| 6852 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6853 |  |  |  |  |  |  | } | 
| 6854 |  |  |  |  |  |  |  | 
| 6855 | 0 |  |  |  |  | 0 | #               elsif (/\G (\<) ((?:\\\>|\\\\|$q_angle)*?) (\>) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q < > | 
| 6856 | 5 |  |  |  |  | 10 | elsif (/\G (\<) /oxgc) {                                                                   # q < > | 
| 6857 | 5 |  |  |  |  | 11 | my $q_string = ''; | 
| 6858 | 5 | 50 |  |  |  | 16 | local $nest = 1; | 
|  | 82 | 50 |  |  |  | 394 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6859 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6860 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
| 6861 | 0 |  |  |  |  | 0 | elsif (/\G (\\\>)    /oxgc) { $q_string .= $1;                         } | 
|  | 0 |  |  |  |  | 0 |  | 
| 6862 |  |  |  |  |  |  | elsif (/\G (\\\<)    /oxgc) { $q_string .= $1;                         } | 
| 6863 | 0 | 50 |  |  |  | 0 | elsif (/\G (\<)      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 5 |  |  |  |  | 14 |  | 
| 6864 | 5 |  |  |  |  | 15 | elsif (/\G (\>)      /oxgc) { | 
| 6865 |  |  |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'<','>',$q_string); } | 
| 6866 | 0 |  |  |  |  | 0 | else                    { $q_string .= $1;                         } | 
| 6867 |  |  |  |  |  |  | } | 
| 6868 | 77 |  |  |  |  | 155 | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 6869 |  |  |  |  |  |  | } | 
| 6870 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6871 |  |  |  |  |  |  | } | 
| 6872 |  |  |  |  |  |  |  | 
| 6873 | 0 |  |  |  |  | 0 | #               elsif (/\G (\S) ((?:\\\1|\\\\|$q_char)*?) (\1) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q * * | 
| 6874 | 1 |  |  |  |  | 3 | elsif (/\G (\S) /oxgc) {                                                                  # q * * | 
| 6875 | 1 |  |  |  |  | 2 | my $delimiter = $1; | 
| 6876 | 1 | 50 |  |  |  | 5 | my $q_string = ''; | 
|  | 14 | 50 |  |  |  | 76 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6877 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6878 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)             /oxgc) { $q_string .= $1;                                       } | 
| 6879 | 1 |  |  |  |  | 3 | elsif (/\G (\\\Q$delimiter\E) /oxgc) { $q_string .= $1;                                       } | 
| 6880 |  |  |  |  |  |  | elsif (/\G (\Q$delimiter\E)   /oxgc) { return $e . e_q($ope,$delimiter,$delimiter,$q_string); } | 
| 6881 | 13 |  |  |  |  | 27 | elsif (/\G ($q_char)          /oxgc) { $q_string .= $1;                                       } | 
| 6882 |  |  |  |  |  |  | } | 
| 6883 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6884 | 0 |  |  |  |  | 0 | } | 
| 6885 |  |  |  |  |  |  | } | 
| 6886 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 6887 |  |  |  |  |  |  | } | 
| 6888 |  |  |  |  |  |  | } | 
| 6889 |  |  |  |  |  |  |  | 
| 6890 | 0 |  |  |  |  | 0 | # m// | 
| 6891 | 491 | 50 |  |  |  | 1509 | elsif (/\G \b (m) \b /oxgc) { | 
| 6892 | 491 |  |  |  |  | 2971 | my $ope = $1; | 
| 6893 |  |  |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc) { # m# # | 
| 6894 |  |  |  |  |  |  | return e_qr($ope,$1,$3,$2,$4); | 
| 6895 | 0 |  |  |  |  | 0 | } | 
| 6896 | 491 |  |  |  |  | 815 | else { | 
| 6897 | 491 | 50 |  |  |  | 1345 | my $e = ''; | 
|  | 491 | 50 |  |  |  | 21129 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6898 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 6899 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                             /oxgc) { $e .= $1; } | 
| 6900 | 0 |  |  |  |  | 0 | elsif (/\G (\()         ((?:$qq_paren)*?)   (\)) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m ( ) | 
| 6901 | 0 |  |  |  |  | 0 | elsif (/\G (\{)         ((?:$qq_brace)*?)   (\}) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m { } | 
| 6902 | 0 |  |  |  |  | 0 | elsif (/\G (\[)         ((?:$qq_bracket)*?) (\]) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m [ ] | 
| 6903 | 92 |  |  |  |  | 288 | elsif (/\G (\<)         ((?:$qq_angle)*?)   (\>) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m < > | 
| 6904 | 87 |  |  |  |  | 321 | elsif (/\G (\?)         ((?:$qq_char)*?)    (\?) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m ? ? | 
| 6905 | 0 |  |  |  |  | 0 | elsif (/\G (\')         ((?:$qq_char)*?)    (\') ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # m ' ' | 
| 6906 |  |  |  |  |  |  | elsif (/\G ([*\-:\\^|]) ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,'{','}',$2,$4); } # m | | --> m { } | 
| 6907 | 312 |  |  |  |  | 1121 | elsif (/\G (\S)         ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m * * | 
| 6908 |  |  |  |  |  |  | } | 
| 6909 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 6910 |  |  |  |  |  |  | } | 
| 6911 |  |  |  |  |  |  | } | 
| 6912 |  |  |  |  |  |  |  | 
| 6913 |  |  |  |  |  |  | # s/// | 
| 6914 |  |  |  |  |  |  |  | 
| 6915 |  |  |  |  |  |  | # about [cegimosxpradlunbB]* (/cg modifier) | 
| 6916 |  |  |  |  |  |  | # | 
| 6917 |  |  |  |  |  |  | # P.67 Pattern-Matching Operators | 
| 6918 |  |  |  |  |  |  | # of ISBN 0-596-00241-6 Perl in a Nutshell, Second Edition. | 
| 6919 | 0 |  |  |  |  | 0 |  | 
| 6920 |  |  |  |  |  |  | elsif (/\G \b (s) \b /oxgc) { | 
| 6921 |  |  |  |  |  |  | my $ope = $1; | 
| 6922 | 290 | 100 |  |  |  | 873 |  | 
| 6923 | 290 |  |  |  |  | 4624 | #        $1   $2               $3   $4               $5   $6 | 
| 6924 |  |  |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ((?:$qq_char)*?) (\#) ([cegimosxpradlunbB]*) /oxgc) { # s# # # | 
| 6925 |  |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 6926 | 1 |  |  |  |  | 5 | } | 
| 6927 | 289 |  |  |  |  | 498 | else { | 
| 6928 | 289 | 50 |  |  |  | 873 | my $e = ''; | 
|  | 289 | 50 |  |  |  | 30915 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 6929 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6930 | 0 |  |  |  |  | 0 | if (/\G ((?>\s+)|\#.*) /oxgc) { $e .= $1; } | 
| 6931 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { | 
| 6932 | 0 | 0 |  |  |  | 0 | my @s = ($1,$2,$3); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6933 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6934 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
| 6935 | 0 |  |  |  |  | 0 | #           $1   $2                  $3   $4 | 
| 6936 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6937 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6938 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6939 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6940 | 0 |  |  |  |  | 0 | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6941 | 0 |  |  |  |  | 0 | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6942 | 0 |  |  |  |  | 0 | elsif (/\G (\:) ((?:$qq_char)*?)    (\:) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6943 |  |  |  |  |  |  | elsif (/\G (\@) ((?:$qq_char)*?)    (\@) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6944 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6945 |  |  |  |  |  |  | } | 
| 6946 |  |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 6947 | 0 |  |  |  |  | 0 | } | 
| 6948 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { | 
| 6949 | 0 | 0 |  |  |  | 0 | my @s = ($1,$2,$3); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6950 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6951 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
| 6952 | 0 |  |  |  |  | 0 | #           $1   $2                  $3   $4 | 
| 6953 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6954 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6955 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6956 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6957 | 0 |  |  |  |  | 0 | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6958 | 0 |  |  |  |  | 0 | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6959 | 0 |  |  |  |  | 0 | elsif (/\G (\:) ((?:$qq_char)*?)    (\:) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6960 |  |  |  |  |  |  | elsif (/\G (\@) ((?:$qq_char)*?)    (\@) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6961 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6962 |  |  |  |  |  |  | } | 
| 6963 |  |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 6964 | 0 |  |  |  |  | 0 | } | 
| 6965 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { | 
| 6966 | 0 | 0 |  |  |  | 0 | my @s = ($1,$2,$3); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6967 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6968 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
| 6969 | 0 |  |  |  |  | 0 | #           $1   $2                  $3   $4 | 
| 6970 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6971 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6972 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6973 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6974 | 0 |  |  |  |  | 0 | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6975 |  |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6976 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6977 |  |  |  |  |  |  | } | 
| 6978 |  |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 6979 | 0 |  |  |  |  | 0 | } | 
| 6980 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { | 
| 6981 | 0 | 0 |  |  |  | 0 | my @s = ($1,$2,$3); | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6982 |  |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 6983 | 0 |  |  |  |  | 0 | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
| 6984 | 0 |  |  |  |  | 0 | #           $1   $2                  $3   $4 | 
| 6985 | 0 |  |  |  |  | 0 | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6986 | 0 |  |  |  |  | 0 | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6987 | 0 |  |  |  |  | 0 | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6988 | 0 |  |  |  |  | 0 | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6989 | 0 |  |  |  |  | 0 | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6990 | 0 |  |  |  |  | 0 | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6991 | 0 |  |  |  |  | 0 | elsif (/\G (\:) ((?:$qq_char)*?)    (\:) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6992 |  |  |  |  |  |  | elsif (/\G (\@) ((?:$qq_char)*?)    (\@) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6993 | 0 |  |  |  |  | 0 | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 6994 |  |  |  |  |  |  | } | 
| 6995 |  |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 6996 |  |  |  |  |  |  | } | 
| 6997 | 0 |  |  |  |  | 0 | #           $1   $2               $3   $4               $5   $6 | 
| 6998 |  |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?) (\') ((?:$qq_char)*?) (\') ([cegimosxpradlunbB]*) /oxgc) { | 
| 6999 |  |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 7000 |  |  |  |  |  |  | } | 
| 7001 | 96 |  |  |  |  | 284 | #           $1            $2               $3   $4               $5   $6 | 
| 7002 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlunbB]*) /oxgc) { | 
| 7003 |  |  |  |  |  |  | return e_sub($sub_variable,'{',$2,'}','{',$4,'}',$6); # s | | | --> s { } { } | 
| 7004 |  |  |  |  |  |  | } | 
| 7005 | 2 |  |  |  |  | 31 | #           $1   $2               $3   $4               $5   $6 | 
| 7006 |  |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlunbB]*) /oxgc) { | 
| 7007 |  |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 7008 |  |  |  |  |  |  | } | 
| 7009 | 0 |  |  |  |  | 0 | #           $1   $2               $3   $4               $5   $6 | 
| 7010 |  |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlunbB]*) /oxgc) { | 
| 7011 |  |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 7012 | 191 |  |  |  |  | 770 | } | 
| 7013 |  |  |  |  |  |  | } | 
| 7014 |  |  |  |  |  |  | die __FILE__, ": Substitution pattern not terminated\n"; | 
| 7015 |  |  |  |  |  |  | } | 
| 7016 |  |  |  |  |  |  | } | 
| 7017 | 0 |  |  |  |  | 0 |  | 
| 7018 | 1 |  |  |  |  | 6 | # do | 
| 7019 | 0 |  |  |  |  | 0 | elsif (/\G \b do (?= (?>\s*) \{ )                                                         /oxmsgc) { return 'do';                } | 
| 7020 | 0 |  |  |  |  | 0 | elsif (/\G \b do (?= (?>\s+) (?: q | qq | qx ) \b)                                        /oxmsgc) { return 'Ebig5hkscs::do';         } | 
| 7021 | 0 |  |  |  |  | 0 | elsif (/\G \b do (?= (?>\s+) (?>\w+))                                                     /oxmsgc) { return 'do';                } | 
| 7022 |  |  |  |  |  |  | elsif (/\G \b do (?= (?>\s*) \$ (?> \w+ (?: ::\w+)* ) \( )                                /oxmsgc) { return 'do';                } | 
| 7023 |  |  |  |  |  |  | elsif (/\G \b do \b                                                                       /oxmsgc) { return 'Ebig5hkscs::do';         } | 
| 7024 | 2 |  |  |  |  | 8 |  | 
| 7025 | 0 |  |  |  |  | 0 | # require ignore module | 
| 7026 | 0 |  |  |  |  | 0 | elsif (/\G \b require ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [#\n])                  /oxmsgc) { return "# require$1$2";     } | 
| 7027 |  |  |  |  |  |  | elsif (/\G \b require ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [^\x81-\xFE#]) /oxmsgc) { return "# require$1\n$2";   } | 
| 7028 |  |  |  |  |  |  | elsif (/\G \b require ((?>\s+) (?:$ignore_modules)) \b                                    /oxmsgc) { return "# require$1";       } | 
| 7029 | 0 |  |  |  |  | 0 |  | 
| 7030 | 0 |  |  |  |  | 0 | # require version number | 
| 7031 | 0 |  |  |  |  | 0 | elsif (/\G \b require (?>\s+) ((?>0[0-7_]*))                    (?>\s*) ;                 /oxmsgc) { return "require $1;";       } | 
| 7032 |  |  |  |  |  |  | elsif (/\G \b require (?>\s+) ((?>[1-9][0-9_]*(?:\.[0-9_]+)*))  (?>\s*) ;                 /oxmsgc) { return "require $1;";       } | 
| 7033 |  |  |  |  |  |  | elsif (/\G \b require (?>\s+) ((?>v[0-9][0-9_]*(?:\.[0-9_]+)*)) (?>\s*) ;                 /oxmsgc) { return "require $1;";       } | 
| 7034 | 0 |  |  |  |  | 0 |  | 
| 7035 |  |  |  |  |  |  | # require bare package name | 
| 7036 |  |  |  |  |  |  | elsif (/\G \b require (?>\s+) ((?>[A-Za-z_]\w* (?: :: [A-Za-z_]\w*)*)) (?>\s*) ;          /oxmsgc) { return "require $1;";       } | 
| 7037 | 18 |  |  |  |  | 129 |  | 
| 7038 | 0 |  |  |  |  | 0 | # require else | 
| 7039 |  |  |  |  |  |  | elsif (/\G \b require                                       (?>\s*) ;                     /oxmsgc) { return 'Ebig5hkscs::require;';   } | 
| 7040 |  |  |  |  |  |  | elsif (/\G \b require \b                                                                  /oxmsgc) { return 'Ebig5hkscs::require';    } | 
| 7041 | 1 |  |  |  |  | 5 |  | 
| 7042 | 70 |  |  |  |  | 656 | # use strict; --> use strict; no strict qw(refs); | 
| 7043 | 0 |  |  |  |  | 0 | elsif (/\G \b use ((?>\s+) strict .*? ;) ([ \t]* [#\n])                                   /oxmsgc) { return "use$1 no strict qw(refs);$2";   } | 
| 7044 |  |  |  |  |  |  | elsif (/\G \b use ((?>\s+) strict .*? ;) ([ \t]* [^\x81-\xFE#])                  /oxmsgc) { return "use$1 no strict qw(refs);\n$2"; } | 
| 7045 |  |  |  |  |  |  | elsif (/\G \b use ((?>\s+) strict) \b                                                     /oxmsgc) { return "use$1; no strict qw(refs)";     } | 
| 7046 |  |  |  |  |  |  |  | 
| 7047 | 0 | 50 | 33 |  |  | 0 | # use 5.12.0; --> use 5.12.0; no strict qw(refs); | 
|  |  |  | 33 |  |  |  |  | 
| 7048 | 3 |  |  |  |  | 41 | elsif (/\G \b use (?>\s+) ((?>([1-9][0-9_]*)(?:\.([0-9_]+))*))  (?>\s*) ; /oxmsgc) { | 
| 7049 |  |  |  |  |  |  | if (($2 >= 6) or (($2 == 5) and ($3 ge '012'))) { | 
| 7050 |  |  |  |  |  |  | return "use $1; no strict qw(refs);"; | 
| 7051 | 0 |  |  |  |  | 0 | } | 
| 7052 |  |  |  |  |  |  | else { | 
| 7053 |  |  |  |  |  |  | return "use $1;"; | 
| 7054 |  |  |  |  |  |  | } | 
| 7055 | 3 | 0 | 0 |  |  | 16 | } | 
|  |  |  | 0 |  |  |  |  | 
| 7056 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>v([0-9][0-9_]*)(?:\.([0-9_]+))*)) (?>\s*) ; /oxmsgc) { | 
| 7057 |  |  |  |  |  |  | if (($2 >= 6) or (($2 == 5) and ($3 >= 12))) { | 
| 7058 |  |  |  |  |  |  | return "use $1; no strict qw(refs);"; | 
| 7059 | 0 |  |  |  |  | 0 | } | 
| 7060 |  |  |  |  |  |  | else { | 
| 7061 |  |  |  |  |  |  | return "use $1;"; | 
| 7062 |  |  |  |  |  |  | } | 
| 7063 |  |  |  |  |  |  | } | 
| 7064 | 0 |  |  |  |  | 0 |  | 
| 7065 | 2 |  |  |  |  | 17 | # ignore use module | 
| 7066 | 0 |  |  |  |  | 0 | elsif (/\G \b use ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [#\n])                  /oxmsgc) { return "# use$1$2";         } | 
| 7067 |  |  |  |  |  |  | elsif (/\G \b use ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [^\x81-\xFE#]) /oxmsgc) { return "# use$1\n$2";       } | 
| 7068 |  |  |  |  |  |  | elsif (/\G \b use ((?>\s+) (?:$ignore_modules)) \b                                    /oxmsgc) { return "# use$1";           } | 
| 7069 | 0 |  |  |  |  | 0 |  | 
| 7070 | 0 |  |  |  |  | 0 | # ignore no module | 
| 7071 | 0 |  |  |  |  | 0 | elsif (/\G \b no  ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [#\n])                  /oxmsgc) { return "# no$1$2";          } | 
| 7072 |  |  |  |  |  |  | elsif (/\G \b no  ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [^\x81-\xFE#]) /oxmsgc) { return "# no$1\n$2";        } | 
| 7073 |  |  |  |  |  |  | elsif (/\G \b no  ((?>\s+) (?:$ignore_modules)) \b                                    /oxmsgc) { return "# no$1";            } | 
| 7074 | 0 |  |  |  |  | 0 |  | 
| 7075 | 0 |  |  |  |  | 0 | # use without import | 
| 7076 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>0[0-7_]*))                                                        (?>\s*) ; /oxmsgc) { return "use $1;";           } | 
| 7077 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[1-9][0-9_]*(?:\.[0-9_]+)*))                                      (?>\s*) ; /oxmsgc) { return "use $1;";           } | 
| 7078 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>v[0-9][0-9_]*(?:\.[0-9_]+)*))                                     (?>\s*) ; /oxmsgc) { return "use $1;";           } | 
| 7079 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*)            (\()          (?>\s*) \) (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7080 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\()          (?>\s*) \) (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7081 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\{)          (?>\s*) \} (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7082 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\[)          (?>\s*) \] (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7083 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\<)          (?>\s*) \> (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7084 |  |  |  |  |  |  | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) ([\x21-\x3F]) (?>\s*) \2 (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7085 |  |  |  |  |  |  | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\S)          (?>\s*) \2 (?>\s*) ; /oxmsgc) { return e_use_noimport($1);  } | 
| 7086 | 0 |  |  |  |  | 0 |  | 
| 7087 |  |  |  |  |  |  | # use with import no parameter | 
| 7088 |  |  |  |  |  |  | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*))                                             (?>\s*) ; /oxmsgc) { return e_use_noparam($1);   } | 
| 7089 | 0 |  |  |  |  | 0 |  | 
| 7090 | 0 |  |  |  |  | 0 | # use with import parameters | 
| 7091 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*) (                          (\()    [^\x81-\xFE)]* \)) (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7092 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*) (                          (\')    [^\x81-\xFE']* \') (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7093 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*) (                          (\")    [^\x81-\xFE"]* \") (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7094 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\()    [^\x81-\xFE)]* \)) (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7095 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\{)    (?:$q_char)*?           \}) (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7096 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\[)    (?:$q_char)*?           \]) (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7097 | 0 |  |  |  |  | 0 | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\<)    [^\x81-\xFE>]* \>) (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7098 |  |  |  |  |  |  | elsif (/\G \b use (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) ([\x21-\x3F]) .*?               \3) (?>\s*) ; /oxmsgc) { return e_use($1,$2); } | 
| 7099 |  |  |  |  |  |  | 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); } | 
| 7100 | 0 |  |  |  |  | 0 |  | 
| 7101 | 0 |  |  |  |  | 0 | # no without unimport | 
| 7102 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>0[0-7_]*))                                                        (?>\s*) ; /oxmsgc) { return "no $1;";            } | 
| 7103 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[1-9][0-9_]*(?:\.[0-9_]+)*))                                      (?>\s*) ; /oxmsgc) { return "no $1;";            } | 
| 7104 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>v[0-9][0-9_]*(?:\.[0-9_]+)*))                                     (?>\s*) ; /oxmsgc) { return "no $1;";            } | 
| 7105 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*)            (\()          (?>\s*) \) (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7106 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\()          (?>\s*) \) (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7107 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\{)          (?>\s*) \} (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7108 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\[)          (?>\s*) \] (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7109 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\<)          (?>\s*) \> (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7110 |  |  |  |  |  |  | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) ([\x21-\x3F]) (?>\s*) \2 (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7111 |  |  |  |  |  |  | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) qw (?>\s*) (\S)          (?>\s*) \2 (?>\s*) ; /oxmsgc) { return e_no_nounimport($1); } | 
| 7112 | 0 |  |  |  |  | 0 |  | 
| 7113 |  |  |  |  |  |  | # no with unimport no parameter | 
| 7114 |  |  |  |  |  |  | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*))                                             (?>\s*) ; /oxmsgc) { return e_no_noparam($1);    } | 
| 7115 | 0 |  |  |  |  | 0 |  | 
| 7116 | 0 |  |  |  |  | 0 | # no with unimport parameters | 
| 7117 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*) (                          (\()    [^\x81-\xFE)]* \)) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7118 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*) (                          (\')    [^\x81-\xFE']* \') (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7119 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s*) (                          (\")    [^\x81-\xFE"]* \") (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7120 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\()    [^\x81-\xFE)]* \)) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7121 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\{)    (?:$q_char)*?           \}) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7122 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\[)    (?:$q_char)*?           \]) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7123 | 0 |  |  |  |  | 0 | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\<)    [^\x81-\xFE>]* \>) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7124 |  |  |  |  |  |  | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) ([\x21-\x3F]) .*?               \3) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7125 |  |  |  |  |  |  | elsif (/\G \b no  (?>\s+) ((?>[A-Z]\w*(?: ::\w+)*)) (?>\s+) ((?: q | qq | qw ) (?>\s*) (\S)    (?:$q_char)*?           \3) (?>\s*) ; /oxmsgc) { return e_no($1,$2);  } | 
| 7126 | 0 |  |  |  |  | 0 |  | 
| 7127 |  |  |  |  |  |  | # use else | 
| 7128 |  |  |  |  |  |  | elsif (/\G \b use \b /oxmsgc) { return "use"; } | 
| 7129 | 0 |  |  |  |  | 0 |  | 
| 7130 |  |  |  |  |  |  | # use else | 
| 7131 |  |  |  |  |  |  | elsif (/\G \b no  \b /oxmsgc) { return "no";  } | 
| 7132 |  |  |  |  |  |  |  | 
| 7133 | 2 |  |  |  |  | 9 | # '' | 
| 7134 | 3177 |  |  |  |  | 10230 | elsif (/\G (? | 
| 7135 | 3177 | 100 |  |  |  | 8726 | my $q_string = ''; | 
|  | 15708 | 100 |  |  |  | 55757 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 7136 | 8 |  |  |  |  | 19 | while (not /\G \z/oxgc) { | 
| 7137 | 48 |  |  |  |  | 91 | if    (/\G (\\\\)                  /oxgc) { $q_string .= $1;                   } | 
| 7138 | 3177 |  |  |  |  | 7875 | elsif (/\G (\\\')                  /oxgc) { $q_string .= $1;                   } | 
| 7139 |  |  |  |  |  |  | elsif (/\G \'                      /oxgc) { return e_q('', "'","'",$q_string); } | 
| 7140 | 12475 |  |  |  |  | 27725 | elsif (/\G ($q_char)               /oxgc) { $q_string .= $1;                   } | 
| 7141 |  |  |  |  |  |  | } | 
| 7142 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7143 |  |  |  |  |  |  | } | 
| 7144 |  |  |  |  |  |  |  | 
| 7145 | 0 |  |  |  |  | 0 | # "" | 
| 7146 | 3404 |  |  |  |  | 8332 | elsif (/\G (\") /oxgc) { | 
| 7147 | 3404 | 100 |  |  |  | 10724 | my $qq_string = ''; | 
|  | 72029 | 100 |  |  |  | 213172 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 7148 | 109 |  |  |  |  | 241 | while (not /\G \z/oxgc) { | 
| 7149 | 14 |  |  |  |  | 33 | if    (/\G (\\\\)                  /oxgc) { $qq_string .= $1;                    } | 
| 7150 | 3404 |  |  |  |  | 9103 | elsif (/\G (\\\")                  /oxgc) { $qq_string .= $1;                    } | 
| 7151 |  |  |  |  |  |  | elsif (/\G \"                      /oxgc) { return e_qq('', '"','"',$qq_string); } | 
| 7152 | 68502 |  |  |  |  | 138092 | elsif (/\G ($q_char)               /oxgc) { $qq_string .= $1;                    } | 
| 7153 |  |  |  |  |  |  | } | 
| 7154 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7155 |  |  |  |  |  |  | } | 
| 7156 |  |  |  |  |  |  |  | 
| 7157 | 0 |  |  |  |  | 0 | # `` | 
| 7158 | 37 |  |  |  |  | 122 | elsif (/\G (\`) /oxgc) { | 
| 7159 | 37 | 50 |  |  |  | 149 | my $qx_string = ''; | 
|  | 313 | 50 |  |  |  | 1965 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 7160 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 7161 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)                  /oxgc) { $qx_string .= $1;                    } | 
| 7162 | 37 |  |  |  |  | 152 | elsif (/\G (\\\`)                  /oxgc) { $qx_string .= $1;                    } | 
| 7163 |  |  |  |  |  |  | elsif (/\G \`                      /oxgc) { return e_qq('', '`','`',$qx_string); } | 
| 7164 | 276 |  |  |  |  | 645 | elsif (/\G ($q_char)               /oxgc) { $qx_string .= $1;                    } | 
| 7165 |  |  |  |  |  |  | } | 
| 7166 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7167 |  |  |  |  |  |  | } | 
| 7168 |  |  |  |  |  |  |  | 
| 7169 | 0 |  |  |  |  | 0 | # //   --- not divide operator (num / num), not defined-or | 
| 7170 | 1231 |  |  |  |  | 3106 | elsif (($slash eq 'm//') and /\G (\/) /oxgc) { | 
| 7171 | 1231 | 100 |  |  |  | 4447 | my $regexp = ''; | 
|  | 12602 | 50 |  |  |  | 42612 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 7172 | 11 |  |  |  |  | 37 | while (not /\G \z/oxgc) { | 
| 7173 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)                  /oxgc) { $regexp .= $1;                       } | 
| 7174 | 1231 |  |  |  |  | 3274 | elsif (/\G (\\\/)                  /oxgc) { $regexp .= $1;                       } | 
| 7175 |  |  |  |  |  |  | elsif (/\G \/ ([cgimosxpadlunbB]*) /oxgc) { return e_qr('', '/','/',$regexp,$1); } | 
| 7176 | 11360 |  |  |  |  | 23626 | elsif (/\G ($q_char)               /oxgc) { $regexp .= $1;                       } | 
| 7177 |  |  |  |  |  |  | } | 
| 7178 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 7179 |  |  |  |  |  |  | } | 
| 7180 |  |  |  |  |  |  |  | 
| 7181 | 0 |  |  |  |  | 0 | # ??   --- not conditional operator (condition ? then : else) | 
| 7182 | 92 |  |  |  |  | 252 | elsif (($slash eq 'm//') and /\G (\?) /oxgc) { | 
| 7183 | 92 | 50 |  |  |  | 243 | my $regexp = ''; | 
|  | 266 | 50 |  |  |  | 1044 |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 7184 | 0 |  |  |  |  | 0 | while (not /\G \z/oxgc) { | 
| 7185 | 0 |  |  |  |  | 0 | if    (/\G (\\\\)                  /oxgc) { $regexp .= $1;                       } | 
| 7186 | 92 |  |  |  |  | 233 | elsif (/\G (\\\?)                  /oxgc) { $regexp .= $1;                       } | 
| 7187 |  |  |  |  |  |  | elsif (/\G \? ([cgimosxpadlunbB]*) /oxgc) { return e_qr('m','?','?',$regexp,$1); } | 
| 7188 | 174 |  |  |  |  | 466 | elsif (/\G ($q_char)               /oxgc) { $regexp .= $1;                       } | 
| 7189 |  |  |  |  |  |  | } | 
| 7190 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 7191 |  |  |  |  |  |  | } | 
| 7192 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7193 |  |  |  |  |  |  | # <<>> (a safer ARGV) | 
| 7194 |  |  |  |  |  |  | elsif (/\G ( <<>> ) /oxgc)                         { $slash = 'm//'; return $1;          } | 
| 7195 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7196 |  |  |  |  |  |  | # << (bit shift)   --- not here document | 
| 7197 |  |  |  |  |  |  | elsif (/\G ( << (?>\s*) ) (?= [0-9\$\@\&] ) /oxgc) { $slash = 'm//'; return $1;          } | 
| 7198 |  |  |  |  |  |  |  | 
| 7199 | 0 |  |  |  |  | 0 | # <<~'HEREDOC' | 
| 7200 | 6 |  |  |  |  | 14 | elsif (/\G ( <<~ [\t ]* '([a-zA-Z_0-9]*)' ) /oxgc) { | 
| 7201 | 6 |  |  |  |  | 15 | $slash = 'm//'; | 
| 7202 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7203 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7204 | 6 | 50 |  |  |  | 10 |  | 
| 7205 | 6 |  |  |  |  | 17 | # get here document | 
| 7206 | 6 |  |  |  |  | 27 | if ($here_script eq '') { | 
| 7207 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7208 | 6 | 50 |  |  |  | 30 | $here_script =~ s/.*?\n//oxm; | 
| 7209 | 6 |  |  |  |  | 70 | } | 
| 7210 | 6 |  |  |  |  | 18 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 7211 | 6 |  |  |  |  | 8 | my $heredoc = $1; | 
| 7212 | 6 |  |  |  |  | 49 | my $indent  = $2; | 
| 7213 | 6 |  |  |  |  | 20 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 7214 |  |  |  |  |  |  | push @heredoc, $heredoc . qq{\n$delimiter\n}; | 
| 7215 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 7216 | 6 |  |  |  |  | 13 | } | 
| 7217 |  |  |  |  |  |  | else { | 
| 7218 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7219 |  |  |  |  |  |  | } | 
| 7220 |  |  |  |  |  |  | return qq{<<'$delimiter'}; | 
| 7221 |  |  |  |  |  |  | } | 
| 7222 |  |  |  |  |  |  |  | 
| 7223 |  |  |  |  |  |  | # <<~\HEREDOC | 
| 7224 |  |  |  |  |  |  |  | 
| 7225 |  |  |  |  |  |  | # P.66 2.6.6. "Here" Documents | 
| 7226 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 7227 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 7228 |  |  |  |  |  |  |  | 
| 7229 |  |  |  |  |  |  | # P.73 "Here" Documents | 
| 7230 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 7231 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 7232 | 6 |  |  |  |  | 25 |  | 
| 7233 | 3 |  |  |  |  | 8 | elsif (/\G ( <<~ \\([a-zA-Z_0-9]+) ) /oxgc) { | 
| 7234 | 3 |  |  |  |  | 7 | $slash = 'm//'; | 
| 7235 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7236 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7237 | 3 | 50 |  |  |  | 9 |  | 
| 7238 | 3 |  |  |  |  | 9 | # get here document | 
| 7239 | 3 |  |  |  |  | 25 | if ($here_script eq '') { | 
| 7240 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7241 | 3 | 50 |  |  |  | 20 | $here_script =~ s/.*?\n//oxm; | 
| 7242 | 3 |  |  |  |  | 38 | } | 
| 7243 | 3 |  |  |  |  | 9 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 7244 | 3 |  |  |  |  | 6 | my $heredoc = $1; | 
| 7245 | 3 |  |  |  |  | 36 | my $indent  = $2; | 
| 7246 | 3 |  |  |  |  | 14 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 7247 |  |  |  |  |  |  | push @heredoc, $heredoc . qq{\n$delimiter\n}; | 
| 7248 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 7249 | 3 |  |  |  |  | 10 | } | 
| 7250 |  |  |  |  |  |  | else { | 
| 7251 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7252 |  |  |  |  |  |  | } | 
| 7253 |  |  |  |  |  |  | return qq{<<\\$delimiter}; | 
| 7254 |  |  |  |  |  |  | } | 
| 7255 |  |  |  |  |  |  |  | 
| 7256 | 3 |  |  |  |  | 13 | # <<~"HEREDOC" | 
| 7257 | 6 |  |  |  |  | 13 | elsif (/\G ( <<~ [\t ]* "([a-zA-Z_0-9]*)" ) /oxgc) { | 
| 7258 | 6 |  |  |  |  | 14 | $slash = 'm//'; | 
| 7259 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7260 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7261 | 6 | 50 |  |  |  | 26 |  | 
| 7262 | 6 |  |  |  |  | 18 | # get here document | 
| 7263 | 6 |  |  |  |  | 31 | if ($here_script eq '') { | 
| 7264 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7265 | 6 | 50 |  |  |  | 34 | $here_script =~ s/.*?\n//oxm; | 
| 7266 | 6 |  |  |  |  | 66 | } | 
| 7267 | 6 |  |  |  |  | 14 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 7268 | 6 |  |  |  |  | 11 | my $heredoc = $1; | 
| 7269 | 6 |  |  |  |  | 49 | my $indent  = $2; | 
| 7270 | 6 |  |  |  |  | 18 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 7271 |  |  |  |  |  |  | push @heredoc, e_heredoc($heredoc) . qq{\n$delimiter\n}; | 
| 7272 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 7273 | 6 |  |  |  |  | 15 | } | 
| 7274 |  |  |  |  |  |  | else { | 
| 7275 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7276 |  |  |  |  |  |  | } | 
| 7277 |  |  |  |  |  |  | return qq{<<"$delimiter"}; | 
| 7278 |  |  |  |  |  |  | } | 
| 7279 |  |  |  |  |  |  |  | 
| 7280 | 6 |  |  |  |  | 24 | # <<~HEREDOC | 
| 7281 | 3 |  |  |  |  | 10 | elsif (/\G ( <<~ ([a-zA-Z_0-9]+) ) /oxgc) { | 
| 7282 | 3 |  |  |  |  | 10 | $slash = 'm//'; | 
| 7283 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7284 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7285 | 3 | 50 |  |  |  | 6 |  | 
| 7286 | 3 |  |  |  |  | 9 | # get here document | 
| 7287 | 3 |  |  |  |  | 15 | if ($here_script eq '') { | 
| 7288 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7289 | 3 | 50 |  |  |  | 16 | $here_script =~ s/.*?\n//oxm; | 
| 7290 | 3 |  |  |  |  | 38 | } | 
| 7291 | 3 |  |  |  |  | 10 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 7292 | 3 |  |  |  |  | 5 | my $heredoc = $1; | 
| 7293 | 3 |  |  |  |  | 41 | my $indent  = $2; | 
| 7294 | 3 |  |  |  |  | 10 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 7295 |  |  |  |  |  |  | push @heredoc, e_heredoc($heredoc) . qq{\n$delimiter\n}; | 
| 7296 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 7297 | 3 |  |  |  |  | 8 | } | 
| 7298 |  |  |  |  |  |  | else { | 
| 7299 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7300 |  |  |  |  |  |  | } | 
| 7301 |  |  |  |  |  |  | return qq{<<$delimiter}; | 
| 7302 |  |  |  |  |  |  | } | 
| 7303 |  |  |  |  |  |  |  | 
| 7304 | 3 |  |  |  |  | 15 | # <<~`HEREDOC` | 
| 7305 | 6 |  |  |  |  | 13 | elsif (/\G ( <<~ [\t ]* `([a-zA-Z_0-9]*)` ) /oxgc) { | 
| 7306 | 6 |  |  |  |  | 12 | $slash = 'm//'; | 
| 7307 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7308 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7309 | 6 | 50 |  |  |  | 11 |  | 
| 7310 | 6 |  |  |  |  | 12 | # get here document | 
| 7311 | 6 |  |  |  |  | 20 | if ($here_script eq '') { | 
| 7312 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7313 | 6 | 50 |  |  |  | 41 | $here_script =~ s/.*?\n//oxm; | 
| 7314 | 6 |  |  |  |  | 59 | } | 
| 7315 | 6 |  |  |  |  | 13 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 7316 | 6 |  |  |  |  | 14 | my $heredoc = $1; | 
| 7317 | 6 |  |  |  |  | 53 | my $indent  = $2; | 
| 7318 | 6 |  |  |  |  | 18 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 7319 |  |  |  |  |  |  | push @heredoc, e_heredoc($heredoc) . qq{\n$delimiter\n}; | 
| 7320 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 7321 | 6 |  |  |  |  | 15 | } | 
| 7322 |  |  |  |  |  |  | else { | 
| 7323 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7324 |  |  |  |  |  |  | } | 
| 7325 |  |  |  |  |  |  | return qq{<<`$delimiter`}; | 
| 7326 |  |  |  |  |  |  | } | 
| 7327 |  |  |  |  |  |  |  | 
| 7328 | 6 |  |  |  |  | 25 | # <<'HEREDOC' | 
| 7329 | 86 |  |  |  |  | 205 | elsif (/\G ( << '([a-zA-Z_0-9]*)' ) /oxgc) { | 
| 7330 | 86 |  |  |  |  | 271 | $slash = 'm//'; | 
| 7331 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7332 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7333 | 86 | 100 |  |  |  | 163 |  | 
| 7334 | 86 |  |  |  |  | 204 | # get here document | 
| 7335 | 83 |  |  |  |  | 525 | if ($here_script eq '') { | 
| 7336 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7337 | 83 | 50 |  |  |  | 510 | $here_script =~ s/.*?\n//oxm; | 
| 7338 | 86 |  |  |  |  | 695 | } | 
| 7339 | 86 |  |  |  |  | 325 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 7340 |  |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 7341 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 7342 | 86 |  |  |  |  | 150 | } | 
| 7343 |  |  |  |  |  |  | else { | 
| 7344 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7345 |  |  |  |  |  |  | } | 
| 7346 |  |  |  |  |  |  | return $here_quote; | 
| 7347 |  |  |  |  |  |  | } | 
| 7348 |  |  |  |  |  |  |  | 
| 7349 |  |  |  |  |  |  | # <<\HEREDOC | 
| 7350 |  |  |  |  |  |  |  | 
| 7351 |  |  |  |  |  |  | # P.66 2.6.6. "Here" Documents | 
| 7352 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 7353 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 7354 |  |  |  |  |  |  |  | 
| 7355 |  |  |  |  |  |  | # P.73 "Here" Documents | 
| 7356 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 7357 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 7358 | 86 |  |  |  |  | 336 |  | 
| 7359 | 2 |  |  |  |  | 7 | elsif (/\G ( << \\([a-zA-Z_0-9]+) ) /oxgc) { | 
| 7360 | 2 |  |  |  |  | 4 | $slash = 'm//'; | 
| 7361 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7362 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7363 | 2 | 100 |  |  |  | 5 |  | 
| 7364 | 2 |  |  |  |  | 5 | # get here document | 
| 7365 | 1 |  |  |  |  | 7 | if ($here_script eq '') { | 
| 7366 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7367 | 1 | 50 |  |  |  | 6 | $here_script =~ s/.*?\n//oxm; | 
| 7368 | 2 |  |  |  |  | 36 | } | 
| 7369 | 2 |  |  |  |  | 9 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 7370 |  |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 7371 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 7372 | 2 |  |  |  |  | 5 | } | 
| 7373 |  |  |  |  |  |  | else { | 
| 7374 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7375 |  |  |  |  |  |  | } | 
| 7376 |  |  |  |  |  |  | return $here_quote; | 
| 7377 |  |  |  |  |  |  | } | 
| 7378 |  |  |  |  |  |  |  | 
| 7379 | 2 |  |  |  |  | 8 | # <<"HEREDOC" | 
| 7380 | 39 |  |  |  |  | 111 | elsif (/\G ( << "([a-zA-Z_0-9]*)" ) /oxgc) { | 
| 7381 | 39 |  |  |  |  | 145 | $slash = 'm//'; | 
| 7382 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7383 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7384 | 39 | 100 |  |  |  | 88 |  | 
| 7385 | 39 |  |  |  |  | 105 | # get here document | 
| 7386 | 38 |  |  |  |  | 239 | if ($here_script eq '') { | 
| 7387 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7388 | 38 | 50 |  |  |  | 280 | $here_script =~ s/.*?\n//oxm; | 
| 7389 | 39 |  |  |  |  | 514 | } | 
| 7390 | 39 |  |  |  |  | 142 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 7391 |  |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 7392 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 7393 | 39 |  |  |  |  | 114 | } | 
| 7394 |  |  |  |  |  |  | else { | 
| 7395 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7396 |  |  |  |  |  |  | } | 
| 7397 |  |  |  |  |  |  | return $here_quote; | 
| 7398 |  |  |  |  |  |  | } | 
| 7399 |  |  |  |  |  |  |  | 
| 7400 | 39 |  |  |  |  | 169 | # < | 
| 7401 | 54 |  |  |  |  | 147 | elsif (/\G ( << ([a-zA-Z_0-9]+) ) /oxgc) { | 
| 7402 | 54 |  |  |  |  | 127 | $slash = 'm//'; | 
| 7403 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7404 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7405 | 54 | 100 |  |  |  | 117 |  | 
| 7406 | 54 |  |  |  |  | 177 | # get here document | 
| 7407 | 51 |  |  |  |  | 363 | if ($here_script eq '') { | 
| 7408 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7409 | 51 | 50 |  |  |  | 448 | $here_script =~ s/.*?\n//oxm; | 
| 7410 | 54 |  |  |  |  | 758 | } | 
| 7411 | 54 |  |  |  |  | 220 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 7412 |  |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 7413 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 7414 | 54 |  |  |  |  | 143 | } | 
| 7415 |  |  |  |  |  |  | else { | 
| 7416 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7417 |  |  |  |  |  |  | } | 
| 7418 |  |  |  |  |  |  | return $here_quote; | 
| 7419 |  |  |  |  |  |  | } | 
| 7420 |  |  |  |  |  |  |  | 
| 7421 | 54 |  |  |  |  | 237 | # <<`HEREDOC` | 
| 7422 | 0 |  |  |  |  | 0 | elsif (/\G ( << `([a-zA-Z_0-9]*)` ) /oxgc) { | 
| 7423 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 7424 |  |  |  |  |  |  | my $here_quote = $1; | 
| 7425 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 7426 | 0 | 0 |  |  |  | 0 |  | 
| 7427 | 0 |  |  |  |  | 0 | # get here document | 
| 7428 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 7429 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 7430 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 7431 | 0 |  |  |  |  | 0 | } | 
| 7432 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 7433 |  |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 7434 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 7435 | 0 |  |  |  |  | 0 | } | 
| 7436 |  |  |  |  |  |  | else { | 
| 7437 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 7438 |  |  |  |  |  |  | } | 
| 7439 |  |  |  |  |  |  | return $here_quote; | 
| 7440 |  |  |  |  |  |  | } | 
| 7441 |  |  |  |  |  |  |  | 
| 7442 | 0 |  |  |  |  | 0 | # <<= <=> <= < operator | 
| 7443 |  |  |  |  |  |  | elsif (/\G ( <<= | <=> | <= | < ) (?= (?>\s*) [A-Za-z_0-9'"`\$\@\&\*\(\+\-] )/oxgc) { | 
| 7444 |  |  |  |  |  |  | return $1; | 
| 7445 |  |  |  |  |  |  | } | 
| 7446 |  |  |  |  |  |  |  | 
| 7447 | 13 |  |  |  |  | 93 | # | 
| 7448 |  |  |  |  |  |  | elsif (/\G (<[\$]?[A-Za-z_][A-Za-z_0-9]*>) /oxgc) { | 
| 7449 |  |  |  |  |  |  | return $1; | 
| 7450 |  |  |  |  |  |  | } | 
| 7451 |  |  |  |  |  |  |  | 
| 7452 |  |  |  |  |  |  | #  --- glob | 
| 7453 |  |  |  |  |  |  |  | 
| 7454 |  |  |  |  |  |  | # avoid "Error: Runtime exception" of perl version 5.005_03 | 
| 7455 | 0 |  |  |  |  | 0 |  | 
| 7456 |  |  |  |  |  |  | elsif (/\G < ((?:[^\x81-\xFE>\0\a\e\f\n\r\t]|[\x81-\xFE][\x00-\xFF])+?) > /oxgc) { | 
| 7457 |  |  |  |  |  |  | return 'Ebig5hkscs::glob("' . $1 . '")'; | 
| 7458 |  |  |  |  |  |  | } | 
| 7459 | 0 |  |  |  |  | 0 |  | 
| 7460 |  |  |  |  |  |  | # __DATA__ | 
| 7461 |  |  |  |  |  |  | elsif (/\G ^ ( __DATA__ \n .*) \z /oxmsgc) { return $1; } | 
| 7462 | 0 |  |  |  |  | 0 |  | 
| 7463 |  |  |  |  |  |  | # __END__ | 
| 7464 |  |  |  |  |  |  | elsif (/\G ^ ( __END__  \n .*) \z /oxmsgc) { return $1; } | 
| 7465 |  |  |  |  |  |  |  | 
| 7466 |  |  |  |  |  |  | # \cD Control-D | 
| 7467 |  |  |  |  |  |  |  | 
| 7468 |  |  |  |  |  |  | # P.68 2.6.8. Other Literal Tokens | 
| 7469 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 7470 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 7471 |  |  |  |  |  |  |  | 
| 7472 |  |  |  |  |  |  | # P.76 Other Literal Tokens | 
| 7473 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 7474 | 384 |  |  |  |  | 3137 | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 7475 |  |  |  |  |  |  |  | 
| 7476 |  |  |  |  |  |  | elsif (/\G   ( \cD         .*) \z /oxmsgc) { return $1; } | 
| 7477 | 0 |  |  |  |  | 0 |  | 
| 7478 |  |  |  |  |  |  | # \cZ Control-Z | 
| 7479 |  |  |  |  |  |  | elsif (/\G   ( \cZ         .*) \z /oxmsgc) { return $1; } | 
| 7480 |  |  |  |  |  |  |  | 
| 7481 |  |  |  |  |  |  | # any operator before div | 
| 7482 |  |  |  |  |  |  | elsif (/\G ( | 
| 7483 |  |  |  |  |  |  | -- | \+\+ | | 
| 7484 | 0 |  |  |  |  | 0 | [\)\}\]] | 
|  | 14161 |  |  |  |  | 33034 |  | 
| 7485 |  |  |  |  |  |  |  | 
| 7486 |  |  |  |  |  |  | ) /oxgc) { $slash = 'div'; return $1; } | 
| 7487 |  |  |  |  |  |  |  | 
| 7488 |  |  |  |  |  |  | # yada-yada or triple-dot operator | 
| 7489 |  |  |  |  |  |  | elsif (/\G ( | 
| 7490 | 14161 |  |  |  |  | 71390 | \.\.\. | 
|  | 7 |  |  |  |  | 16 |  | 
| 7491 |  |  |  |  |  |  |  | 
| 7492 |  |  |  |  |  |  | ) /oxgc) { $slash = 'm//'; return q{die('Unimplemented')}; } | 
| 7493 |  |  |  |  |  |  |  | 
| 7494 |  |  |  |  |  |  | # any operator before m// | 
| 7495 |  |  |  |  |  |  |  | 
| 7496 |  |  |  |  |  |  | # //, //= (defined-or) | 
| 7497 |  |  |  |  |  |  |  | 
| 7498 |  |  |  |  |  |  | # P.164 Logical Operators | 
| 7499 |  |  |  |  |  |  | # in Chapter 10: More Control Structures | 
| 7500 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 7501 |  |  |  |  |  |  |  | 
| 7502 |  |  |  |  |  |  | # P.119 C-Style Logical (Short-Circuit) Operators | 
| 7503 |  |  |  |  |  |  | # in Chapter 3: Unary and Binary Operators | 
| 7504 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 7505 |  |  |  |  |  |  |  | 
| 7506 |  |  |  |  |  |  | # (and so on) | 
| 7507 |  |  |  |  |  |  |  | 
| 7508 |  |  |  |  |  |  | # ~~ | 
| 7509 |  |  |  |  |  |  |  | 
| 7510 |  |  |  |  |  |  | # P.221 The Smart Match Operator | 
| 7511 |  |  |  |  |  |  | # in Chapter 15: Smart Matching and given-when | 
| 7512 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 7513 |  |  |  |  |  |  |  | 
| 7514 |  |  |  |  |  |  | # P.112 Smartmatch Operator | 
| 7515 |  |  |  |  |  |  | # in Chapter 3: Unary and Binary Operators | 
| 7516 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 7517 |  |  |  |  |  |  |  | 
| 7518 |  |  |  |  |  |  | # (and so on) | 
| 7519 |  |  |  |  |  |  |  | 
| 7520 |  |  |  |  |  |  | elsif (/\G ((?> | 
| 7521 |  |  |  |  |  |  |  | 
| 7522 |  |  |  |  |  |  | !~~ | !~ | != | ! | | 
| 7523 |  |  |  |  |  |  | %= | % | | 
| 7524 |  |  |  |  |  |  | &&= | && | &= | &\.= | &\. | & | | 
| 7525 |  |  |  |  |  |  | -= | -> | - | | 
| 7526 |  |  |  |  |  |  | :(?>\s*)= | | 
| 7527 |  |  |  |  |  |  | : | | 
| 7528 |  |  |  |  |  |  | <<>> | | 
| 7529 |  |  |  |  |  |  | <<= | <=> | <= | < | | 
| 7530 |  |  |  |  |  |  | == | => | =~ | = | | 
| 7531 |  |  |  |  |  |  | >>= | >> | >= | > | | 
| 7532 |  |  |  |  |  |  | \*\*= | \*\* | \*= | \* | | 
| 7533 |  |  |  |  |  |  | \+= | \+ | | 
| 7534 |  |  |  |  |  |  | \.\. | \.= | \. | | 
| 7535 |  |  |  |  |  |  | \/\/= | \/\/ | | 
| 7536 |  |  |  |  |  |  | \/= | \/ | | 
| 7537 |  |  |  |  |  |  | \? | | 
| 7538 |  |  |  |  |  |  | \\ | | 
| 7539 |  |  |  |  |  |  | \^= | \^\.= | \^\. | \^ | | 
| 7540 |  |  |  |  |  |  | \b x= | | 
| 7541 |  |  |  |  |  |  | \|\|= | \|\| | \|= | \|\.= | \|\. | \| | | 
| 7542 |  |  |  |  |  |  | ~~ | ~\. | ~ | | 
| 7543 |  |  |  |  |  |  | \b(?: and | cmp | eq | ge | gt | le | lt | ne | not | or | xor | x )\b | | 
| 7544 |  |  |  |  |  |  | \b(?: print )\b | | 
| 7545 |  |  |  |  |  |  |  | 
| 7546 | 7 |  |  |  |  | 26 | [,;\(\{\[] | 
|  | 23792 |  |  |  |  | 54272 |  | 
| 7547 |  |  |  |  |  |  |  | 
| 7548 |  |  |  |  |  |  | )) /oxgc) { $slash = 'm//'; return $1; } | 
| 7549 | 23792 |  |  |  |  | 115716 |  | 
|  | 37734 |  |  |  |  | 81053 |  | 
| 7550 |  |  |  |  |  |  | # other any character | 
| 7551 |  |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $slash = 'div'; return $1; } | 
| 7552 |  |  |  |  |  |  |  | 
| 7553 | 37734 |  |  |  |  | 201832 | # system error | 
| 7554 |  |  |  |  |  |  | else { | 
| 7555 |  |  |  |  |  |  | die __FILE__, ": Oops, this shouldn't happen!\n"; | 
| 7556 |  |  |  |  |  |  | } | 
| 7557 |  |  |  |  |  |  | } | 
| 7558 |  |  |  |  |  |  |  | 
| 7559 | 0 |  |  | 3097 | 0 | 0 | # escape Big5-HKSCS string | 
| 7560 | 3097 |  |  |  |  | 8604 | sub e_string { | 
| 7561 |  |  |  |  |  |  | my($string) = @_; | 
| 7562 | 3097 |  |  |  |  | 4505 | my $e_string = ''; | 
| 7563 |  |  |  |  |  |  |  | 
| 7564 |  |  |  |  |  |  | local $slash = 'm//'; | 
| 7565 |  |  |  |  |  |  |  | 
| 7566 |  |  |  |  |  |  | # P.1024 Appendix W.10 Multibyte Processing | 
| 7567 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 7568 | 3097 |  |  |  |  | 4745 | # (and so on) | 
| 7569 |  |  |  |  |  |  |  | 
| 7570 |  |  |  |  |  |  | my @char = $string =~ / \G (?>[^\x81-\xFE\\]|\\$q_char|$q_char) /oxmsg; | 
| 7571 | 3097 | 100 | 66 |  |  | 28018 |  | 
| 7572 | 3097 | 50 |  |  |  | 15210 | # without { ... } | 
| 7573 | 3018 |  |  |  |  | 11530 | if (not (grep(/\A \{ \z/xms, @char) and grep(/\A \} \z/xms, @char))) { | 
| 7574 |  |  |  |  |  |  | if ($string !~ /< | 
| 7575 |  |  |  |  |  |  | return $string; | 
| 7576 |  |  |  |  |  |  | } | 
| 7577 |  |  |  |  |  |  | } | 
| 7578 | 3018 |  |  |  |  | 7830 |  | 
| 7579 | 79 | 50 |  |  |  | 242 | E_STRING_LOOP: | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 7580 |  |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 7581 |  |  |  |  |  |  | if (0) { | 
| 7582 |  |  |  |  |  |  | } | 
| 7583 | 606 |  |  |  |  | 83033 |  | 
| 7584 | 0 |  |  |  |  | 0 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> @{[Ebig5hkscs::PREMATCH()]} | 
| 7585 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  \b | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) /oxmsgc) { | 
| 7586 |  |  |  |  |  |  | $e_string .= q{Ebig5hkscs::PREMATCH()}; | 
| 7587 |  |  |  |  |  |  | $slash = 'div'; | 
| 7588 |  |  |  |  |  |  | } | 
| 7589 |  |  |  |  |  |  |  | 
| 7590 | 0 |  |  |  |  | 0 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> @{[Ebig5hkscs::MATCH()]} | 
| 7591 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$& | \$\{&\} | \$ (?>\s*) MATCH     \b | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) /oxmsgc) { | 
| 7592 |  |  |  |  |  |  | $e_string .= q{Ebig5hkscs::MATCH()}; | 
| 7593 |  |  |  |  |  |  | $slash = 'div'; | 
| 7594 |  |  |  |  |  |  | } | 
| 7595 |  |  |  |  |  |  |  | 
| 7596 | 0 |  |  |  |  | 0 | # $', ${'} --> $', ${'} | 
| 7597 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$' | \$\{'\}                                                                                                     ) /oxmsgc) { | 
| 7598 |  |  |  |  |  |  | $e_string .= $1; | 
| 7599 |  |  |  |  |  |  | $slash = 'div'; | 
| 7600 |  |  |  |  |  |  | } | 
| 7601 |  |  |  |  |  |  |  | 
| 7602 | 0 |  |  |  |  | 0 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> @{[Ebig5hkscs::POSTMATCH()]} | 
| 7603 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (                 \$ (?>\s*) POSTMATCH \b | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) /oxmsgc) { | 
| 7604 |  |  |  |  |  |  | $e_string .= q{Ebig5hkscs::POSTMATCH()}; | 
| 7605 |  |  |  |  |  |  | $slash = 'div'; | 
| 7606 |  |  |  |  |  |  | } | 
| 7607 |  |  |  |  |  |  |  | 
| 7608 | 0 |  |  |  |  | 0 | # bareword | 
| 7609 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \{ (?>\s*) (?: tr | index | rindex | reverse ) (?>\s*) \} ) /oxmsgc) { | 
| 7610 |  |  |  |  |  |  | $e_string .= $1; | 
| 7611 |  |  |  |  |  |  | $slash = 'div'; | 
| 7612 |  |  |  |  |  |  | } | 
| 7613 |  |  |  |  |  |  |  | 
| 7614 | 0 |  |  |  |  | 0 | # $0 --> $0 | 
| 7615 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$ 0 ) /oxmsgc) { | 
| 7616 |  |  |  |  |  |  | $e_string .= $1; | 
| 7617 |  |  |  |  |  |  | $slash = 'div'; | 
| 7618 | 0 |  |  |  |  | 0 | } | 
| 7619 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$ \{ (?>\s*) 0 (?>\s*) \} ) /oxmsgc) { | 
| 7620 |  |  |  |  |  |  | $e_string .= $1; | 
| 7621 |  |  |  |  |  |  | $slash = 'div'; | 
| 7622 |  |  |  |  |  |  | } | 
| 7623 |  |  |  |  |  |  |  | 
| 7624 | 0 |  |  |  |  | 0 | # $$ --> $$ | 
| 7625 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$ \$ ) (?![\w\{]) /oxmsgc) { | 
| 7626 |  |  |  |  |  |  | $e_string .= $1; | 
| 7627 |  |  |  |  |  |  | $slash = 'div'; | 
| 7628 |  |  |  |  |  |  | } | 
| 7629 |  |  |  |  |  |  |  | 
| 7630 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 7631 | 0 |  |  |  |  | 0 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 7632 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \$ ((?>[1-9][0-9]*)) /oxmsgc) { | 
| 7633 |  |  |  |  |  |  | $e_string .= e_capture($1); | 
| 7634 |  |  |  |  |  |  | $slash = 'div'; | 
| 7635 | 0 |  |  |  |  | 0 | } | 
| 7636 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} /oxmsgc) { | 
| 7637 |  |  |  |  |  |  | $e_string .= e_capture($1); | 
| 7638 |  |  |  |  |  |  | $slash = 'div'; | 
| 7639 |  |  |  |  |  |  | } | 
| 7640 |  |  |  |  |  |  |  | 
| 7641 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 7642 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ .+? \] ) /oxmsgc) { | 
| 7643 |  |  |  |  |  |  | $e_string .= e_capture($1.'->'.$2); | 
| 7644 |  |  |  |  |  |  | $slash = 'div'; | 
| 7645 |  |  |  |  |  |  | } | 
| 7646 |  |  |  |  |  |  |  | 
| 7647 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 7648 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ .+? \} ) /oxmsgc) { | 
| 7649 |  |  |  |  |  |  | $e_string .= e_capture($1.'->'.$2); | 
| 7650 |  |  |  |  |  |  | $slash = 'div'; | 
| 7651 |  |  |  |  |  |  | } | 
| 7652 |  |  |  |  |  |  |  | 
| 7653 | 0 |  |  |  |  | 0 | # $$foo | 
| 7654 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) /oxmsgc) { | 
| 7655 |  |  |  |  |  |  | $e_string .= e_capture($1); | 
| 7656 |  |  |  |  |  |  | $slash = 'div'; | 
| 7657 |  |  |  |  |  |  | } | 
| 7658 |  |  |  |  |  |  |  | 
| 7659 | 0 |  |  |  |  | 0 | # ${ foo } | 
| 7660 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \} /oxmsgc) { | 
| 7661 |  |  |  |  |  |  | $e_string .= '${' . $1 . '}'; | 
| 7662 |  |  |  |  |  |  | $slash = 'div'; | 
| 7663 |  |  |  |  |  |  | } | 
| 7664 |  |  |  |  |  |  |  | 
| 7665 | 0 |  |  |  |  | 0 | # ${ ... } | 
| 7666 | 3 |  |  |  |  | 14 | elsif ($string =~ /\G \$ (?>\s*) \{ (?>\s*) ( $qq_brace ) (?>\s*) \} /oxmsgc) { | 
| 7667 |  |  |  |  |  |  | $e_string .= e_capture($1); | 
| 7668 |  |  |  |  |  |  | $slash = 'div'; | 
| 7669 |  |  |  |  |  |  | } | 
| 7670 |  |  |  |  |  |  |  | 
| 7671 |  |  |  |  |  |  | # variable or function | 
| 7672 | 3 |  |  |  |  | 18 | #                             $ @ % & *     $ # | 
| 7673 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( (?: [\$\@\%\&\*] | \$\# | -> | \b sub \b) (?>\s*) (?: split | chop | index | rindex | lc | uc | fc | chr | ord | reverse | getc | tr | y | q | qq | qx | qw | m | s | qr | glob | lstat | opendir | stat | unlink | chdir ) ) \b /oxmsgc) { | 
| 7674 |  |  |  |  |  |  | $e_string .= $1; | 
| 7675 |  |  |  |  |  |  | $slash = 'div'; | 
| 7676 |  |  |  |  |  |  | } | 
| 7677 |  |  |  |  |  |  | #                           $ $ $ $ $ $ $ $ $ $ $ $ $ $ | 
| 7678 | 0 |  |  |  |  | 0 | #                           $ @ # \ ' " / ? ( ) [ ] < > | 
| 7679 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( \$[\$\@\#\\\'\"\/\?\(\)\[\]\<\>] ) /oxmsgc) { | 
| 7680 |  |  |  |  |  |  | $e_string .= $1; | 
| 7681 |  |  |  |  |  |  | $slash = 'div'; | 
| 7682 |  |  |  |  |  |  | } | 
| 7683 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7684 | 0 |  |  |  |  | 0 | # subroutines of package Ebig5hkscs | 
|  | 0 |  |  |  |  | 0 |  | 
| 7685 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b (CORE:: | ->(>?\s*) (?: atan2 | [a-z]{2,})) \b       /oxgc) { $e_string .= $1;                  $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7686 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Char::eval       (?= (?>\s*) \{ )                    /oxgc) { $e_string .= 'eval';              $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7687 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Big5HKSCS::eval       (?= (?>\s*) \{ )                    /oxgc) { $e_string .= 'eval';              $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7688 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Char::eval \b                                        /oxgc) { $e_string .= 'eval Char::escape'; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7689 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Big5HKSCS::eval \b                                        /oxgc) { $e_string .= 'eval Big5HKSCS::escape'; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7690 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::substr \b                                     /oxgc) { $e_string .= 'substr';            $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7691 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b chop \b                                              /oxgc) { $e_string .= 'Ebig5hkscs::chop';       $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7692 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::index \b                                      /oxgc) { $e_string .= 'index';             $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7693 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Char::index \b                                       /oxgc) { $e_string .= 'Char::index';       $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7694 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Big5HKSCS::index \b                                       /oxgc) { $e_string .= 'Big5HKSCS::index';       $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7695 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b index \b                                             /oxgc) { $e_string .= 'Ebig5hkscs::index';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7696 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::rindex \b                                     /oxgc) { $e_string .= 'rindex';            $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7697 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Char::rindex \b                                      /oxgc) { $e_string .= 'Char::rindex';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7698 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b Big5HKSCS::rindex \b                                      /oxgc) { $e_string .= 'Big5HKSCS::rindex';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7699 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b rindex \b                                            /oxgc) { $e_string .= 'Ebig5hkscs::rindex';     $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7700 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b lc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::lc';         $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7701 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b lcfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::lcfirst';    $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7702 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b uc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::uc';         $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7703 |  |  |  |  |  |  | elsif ($string =~ /\G \b ucfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::ucfirst';    $slash = 'm//'; } | 
| 7704 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b fc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::fc';         $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7705 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7706 | 0 |  |  |  |  | 0 | (?>\s*) (\") ((?:$qq_char)+?)             (\") /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('',  $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7707 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\#) ((?:$qq_char)+?)             (\#) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7708 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\() ((?:$qq_paren)+?)            (\)) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7709 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\{) ((?:$qq_brace)+?)            (\}) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7710 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\[) ((?:$qq_bracket)+?)          (\]) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 1 |  |  |  |  | 8 |  | 
| 7711 |  |  |  |  |  |  | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\<) ((?:$qq_angle)+?)            (\>) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7712 |  |  |  |  |  |  | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) qq (?>\s*) (\S) ((?:$qq_char)+?)             (\2) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7713 | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 7 |  | 
| 7714 | 1 |  |  |  |  | 4 | elsif ($string =~ /\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7715 | 0 |  |  |  |  | 0 | (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)    (\') /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('',  $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7716 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)    (\#) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7717 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)   (\)) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7718 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)   (\}) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7719 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?) (\]) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 1 |  |  |  |  | 6 |  | 
| 7720 |  |  |  |  |  |  | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)   (\>) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7721 |  |  |  |  |  |  | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) q  (?>\s*) (\S) ((?:\\\2|\\\\|$q_char)+?)    (\2) /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1)," . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7722 | 1 |  |  |  |  | 4 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7723 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) (\$ (?> \w+ (?: ::\w+)*) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ) )*) /oxgc) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7724 | 0 |  |  |  |  | 0 | { $e_string .= "Ebig5hkscs::filetest(qw($1),$2)"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7725 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) \( ((?:$qq_paren)*?) \)   /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1),$2)"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7726 |  |  |  |  |  |  | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) (?= [a-z]+)                                       /oxgc) { $e_string .= "Ebig5hkscs::filetest qw($1),";    $slash = 'm//'; } | 
| 7727 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ((?:-[rwxoRWXOezfdlpSbcugkTB](?>\s+)){2,}) ((?>\w+))                                         /oxgc) { $e_string .= "Ebig5hkscs::filetest(qw($1),$2)"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7728 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7729 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC])            (?>\s*) (\") ((?:$qq_char)+?)                (\") /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('',  $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7730 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\#) ((?:$qq_char)+?)                (\#) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7731 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\() ((?:$qq_paren)+?)               (\)) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7732 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\{) ((?:$qq_brace)+?)               (\}) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7733 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\[) ((?:$qq_bracket)+?)             (\]) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 2 |  |  |  |  | 10 |  | 
| 7734 |  |  |  |  |  |  | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\<) ((?:$qq_angle)+?)               (\>) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7735 | 2 |  |  |  |  | 5 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) qq (?>\s*) (\S) ((?:$qq_char)+?)                (\2) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_qq('qq',$2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 1 |  |  |  |  | 7 |  | 
| 7736 | 1 |  |  |  |  | 5 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7737 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC])            (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)       (\') /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('',  $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7738 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)       (\#) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7739 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)      (\)) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7740 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)      (\}) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7741 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?)    (\]) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
|  | 2 |  |  |  |  | 19 |  | 
| 7742 |  |  |  |  |  |  | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)      (\>) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7743 |  |  |  |  |  |  | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) q  (?>\s*) (\S) ((?:\\\2|\\\\|$q_char)+?)       (\2) /oxgc) { $e_string .= "Ebig5hkscs::$1(" . e_q ('q', $2,$4,$3) . ")"; $slash = 'm//'; } | 
| 7744 | 2 |  |  |  |  | 7 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7745 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s*) (\$ (?> \w+ (?: ::\w+)*) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ) )*) /oxgc) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7746 | 0 |  |  |  |  | 0 | { $e_string .= "Ebig5hkscs::$1($2)";      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7747 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s*) \( ((?:$qq_paren)*?) \)                              /oxgc) { $e_string .= "Ebig5hkscs::$1($2)";      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7748 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?= (?>\s+) [a-z]+)                                          /oxgc) { $e_string .= "Ebig5hkscs::$1";          $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7749 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -([rwxoRWXOezsfdlpSbcugkTBMAC]) (?>\s+) ((?>\w+))                                            /oxgc) { $e_string .= "Ebig5hkscs::$1(::"."$2)"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7750 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -(t)                            (?>\s+) ((?>\w+))                                            /oxgc) { $e_string .= "-t $2";              $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7751 |  |  |  |  |  |  | elsif ($string =~ /\G \b lstat         (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(])                                /oxgc) { $e_string .= 'Ebig5hkscs::lstat';       $slash = 'm//'; } | 
| 7752 |  |  |  |  |  |  | elsif ($string =~ /\G \b stat          (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(])                                /oxgc) { $e_string .= 'Ebig5hkscs::stat';        $slash = 'm//'; } | 
| 7753 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7754 | 0 |  |  |  |  | 0 | # "-s '' ..." means file test "-s 'filename' ..." (not means "- s/// ...") | 
|  | 0 |  |  |  |  | 0 |  | 
| 7755 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                                         (?>\s*) (\") ((?:$qq_char)+?)                (\") /oxgc) { $e_string .= '-s ' . e_qq('',  $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7756 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\#) ((?:$qq_char)+?)                (\#) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7757 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\() ((?:$qq_paren)+?)               (\)) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7758 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\{) ((?:$qq_brace)+?)               (\}) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7759 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\[) ((?:$qq_bracket)+?)             (\]) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7760 |  |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\<) ((?:$qq_angle)+?)               (\>) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
| 7761 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\S) ((?:$qq_char)+?)                (\1) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7762 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7763 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                                         (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)       (\') /oxgc) { $e_string .= '-s ' . e_q ('',  $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7764 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)       (\#) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7765 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)      (\)) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7766 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)      (\}) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7767 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?)    (\]) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7768 |  |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)      (\>) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
| 7769 |  |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\S) ((?:\\\1|\\\\|$q_char)+?)       (\1) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
| 7770 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7771 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s*) (\$ (?> \w+ (?: ::\w+)*) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ))*) /oxgc) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7772 | 0 |  |  |  |  | 0 | { $e_string .= "-s $1";   $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7773 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s*) \( ((?:$qq_paren)*?) \)                              /oxgc) { $e_string .= "-s ($1)"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7774 |  |  |  |  |  |  | elsif ($string =~ /\G -s                              (?= (?>\s+) [a-z]+)                                          /oxgc) { $e_string .= '-s';      $slash = 'm//'; } | 
| 7775 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G -s                              (?>\s+) ((?>\w+))                                            /oxgc) { $e_string .= "-s $1";   $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7776 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7777 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::length (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'length';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7778 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::chr    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'chr';                  $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7779 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b chr           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::chr';           $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7780 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::ord    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'ord';                  $slash = 'div'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7781 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b ord           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= $function_ord;          $slash = 'div'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7782 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b glob          (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Ebig5hkscs::glob';          $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7783 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b lc \b                                                      /oxgc) { $e_string .= 'Ebig5hkscs::lc_';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7784 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b lcfirst \b                                                 /oxgc) { $e_string .= 'Ebig5hkscs::lcfirst_';          $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7785 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b uc \b                                                      /oxgc) { $e_string .= 'Ebig5hkscs::uc_';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7786 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b ucfirst \b                                                 /oxgc) { $e_string .= 'Ebig5hkscs::ucfirst_';          $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7787 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b fc \b                                                      /oxgc) { $e_string .= 'Ebig5hkscs::fc_';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7788 |  |  |  |  |  |  | elsif ($string =~ /\G \b lstat \b                                                   /oxgc) { $e_string .= 'Ebig5hkscs::lstat_';            $slash = 'm//'; } | 
| 7789 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b stat \b                                                    /oxgc) { $e_string .= 'Ebig5hkscs::stat_';             $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7790 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G    (-[rwxoRWXOezfdlpSbcugkTB] (?>(?:\s+ -[rwxoRWXOezfdlpSbcugkTB])+)) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7791 | 0 |  |  |  |  | 0 | \b                         /oxgc) { $e_string .= "Ebig5hkscs::filetest_(qw($1))"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7792 |  |  |  |  |  |  | elsif ($string =~ /\G    -([rwxoRWXOezsfdlpSbcugkTBMAC]) \b                         /oxgc) { $e_string .= "Ebig5hkscs::${1}_";             $slash = 'm//'; } | 
| 7793 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G    -s                              \b                         /oxgc) { $e_string .= '-s ';                      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7794 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7795 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::length \b                                           /oxgc) { $e_string .= 'length';                   $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7796 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::chr \b                                              /oxgc) { $e_string .= 'chr';                      $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7797 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b chr \b                                                     /oxgc) { $e_string .= 'Ebig5hkscs::chr_';              $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7798 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b bytes::ord \b                                              /oxgc) { $e_string .= 'ord';                      $slash = 'div'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7799 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b ord \b                                                     /oxgc) { $e_string .= $function_ord_;             $slash = 'div'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7800 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b glob \b                                                    /oxgc) { $e_string .= 'Ebig5hkscs::glob_';             $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7801 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b reverse \b                                                 /oxgc) { $e_string .= $function_reverse;          $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7802 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b getc \b                                                    /oxgc) { $e_string .= $function_getc;             $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7803 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b opendir ((?>\s*) \( (?>\s*)) (?=[A-Za-z_])                 /oxgc) { $e_string .= "Ebig5hkscs::opendir$1*";        $slash = 'm//'; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7804 |  |  |  |  |  |  | elsif ($string =~ /\G \b opendir ((?>\s+))            (?=[A-Za-z_])                 /oxgc) { $e_string .= "Ebig5hkscs::opendir$1*";        $slash = 'm//'; } | 
| 7805 |  |  |  |  |  |  | elsif ($string =~ /\G \b unlink \b                                                  /oxgc) { $e_string .= 'Ebig5hkscs::unlink';            $slash = 'm//'; } | 
| 7806 |  |  |  |  |  |  |  | 
| 7807 | 0 |  |  |  |  | 0 | # chdir | 
| 7808 |  |  |  |  |  |  | elsif ($string =~ /\G \b (chdir) \b (?! (?>\s*) => ) /oxgc) { | 
| 7809 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 7810 |  |  |  |  |  |  |  | 
| 7811 | 0 |  |  |  |  | 0 | $e_string .= 'Ebig5hkscs::chdir'; | 
| 7812 | 0 |  |  |  |  | 0 |  | 
| 7813 |  |  |  |  |  |  | while ($string =~ /\G ( (?>\s+) | \( | \#.* ) /oxgc) { | 
| 7814 |  |  |  |  |  |  | $e_string .= $1; | 
| 7815 |  |  |  |  |  |  | } | 
| 7816 | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7817 |  |  |  |  |  |  | # end of chdir | 
| 7818 |  |  |  |  |  |  | if    ($string =~ /\G (?= [,;\)\}\]] )          /oxgc) { return $e_string;                               } | 
| 7819 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7820 |  |  |  |  |  |  | # chdir scalar value | 
| 7821 |  |  |  |  |  |  | elsif ($string =~ /\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { $e_string .= e_string($1);  next E_STRING_LOOP; } | 
| 7822 |  |  |  |  |  |  |  | 
| 7823 | 0 | 0 |  |  |  | 0 | # chdir qq// | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7824 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qq) \b /oxgc) { | 
| 7825 | 0 |  |  |  |  | 0 | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc)                             { $e_string .= e_chdir('qq',$1,$3,$2);   next E_STRING_LOOP; } # qq# #  --> qr # # | 
| 7826 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7827 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 7828 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                              /oxgc) { $e_string .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7829 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\()          ((?:$qq_paren)*?)   (\))      /oxgc) { $e_string .= e_chdir('qq',$1,$3,$2);   next E_STRING_LOOP; } # qq ( ) --> qr ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7830 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{)          ((?:$qq_brace)*?)   (\})      /oxgc) { $e_string .= e_chdir('qq',$1,$3,$2);   next E_STRING_LOOP; } # qq { } --> qr { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7831 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[)          ((?:$qq_bracket)*?) (\])      /oxgc) { $e_string .= e_chdir('qq',$1,$3,$2);   next E_STRING_LOOP; } # qq [ ] --> qr [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 7832 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<)          ((?:$qq_angle)*?)   (\>)      /oxgc) { $e_string .= e_chdir('qq',$1,$3,$2);   next E_STRING_LOOP; } # qq < > --> qr < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 7833 |  |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1)      /oxgc) { $e_string .= e_chdir('qq','{','}',$2); next E_STRING_LOOP; } # qq | | --> qr { } | 
| 7834 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S)          ((?:$qq_char)*?)    (\1)      /oxgc) { $e_string .= e_chdir('qq',$1,$3,$2);   next E_STRING_LOOP; } # qq * * --> qr * * | 
| 7835 |  |  |  |  |  |  | } | 
| 7836 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7837 |  |  |  |  |  |  | } | 
| 7838 |  |  |  |  |  |  | } | 
| 7839 |  |  |  |  |  |  |  | 
| 7840 | 0 | 0 |  |  |  | 0 | # chdir q// | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7841 |  |  |  |  |  |  | elsif ($string =~ /\G \b (q) \b /oxgc) { | 
| 7842 | 0 |  |  |  |  | 0 | if ($string =~ /\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc)                    { $e_string .= e_chdir_q('q',$1,$3,$2);   next E_STRING_LOOP; } # q# #  --> qr # # | 
| 7843 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7844 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 7845 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                              /oxgc) { $e_string .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7846 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { $e_string .= e_chdir_q('q',$1,$3,$2);   next E_STRING_LOOP; } # q ( ) --> qr ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7847 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { $e_string .= e_chdir_q('q',$1,$3,$2);   next E_STRING_LOOP; } # q { } --> qr { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7848 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= e_chdir_q('q',$1,$3,$2);   next E_STRING_LOOP; } # q [ ] --> qr [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 7849 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { $e_string .= e_chdir_q('q',$1,$3,$2);   next E_STRING_LOOP; } # q < > --> qr < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 7850 |  |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|])       ((?:$q_char)*?)    (\1) /oxgc) { $e_string .= e_chdir_q('q','{','}',$2); next E_STRING_LOOP; } # q | | --> qr { } | 
| 7851 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { $e_string .= e_chdir_q('q',$1,$3,$2);   next E_STRING_LOOP; } # q * * --> qr * * | 
| 7852 |  |  |  |  |  |  | } | 
| 7853 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7854 |  |  |  |  |  |  | } | 
| 7855 |  |  |  |  |  |  | } | 
| 7856 |  |  |  |  |  |  |  | 
| 7857 | 0 |  |  |  |  | 0 | # chdir '' | 
| 7858 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\') /oxgc) { | 
| 7859 | 0 | 0 |  |  |  | 0 | my $q_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7860 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
| 7861 | 0 |  |  |  |  | 0 | if    ($string =~ /\G (\\\\)    /oxgc) { $q_string .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7862 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\\\')    /oxgc) { $q_string .= $1; } | 
| 7863 |  |  |  |  |  |  | elsif ($string =~ /\G \'        /oxgc)                                       { $e_string .= e_chdir_q('',"'","'",$q_string); next E_STRING_LOOP; } | 
| 7864 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ($q_char) /oxgc) { $q_string .= $1; } | 
| 7865 |  |  |  |  |  |  | } | 
| 7866 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7867 |  |  |  |  |  |  | } | 
| 7868 |  |  |  |  |  |  |  | 
| 7869 | 0 |  |  |  |  | 0 | # chdir "" | 
| 7870 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\") /oxgc) { | 
| 7871 | 0 | 0 |  |  |  | 0 | my $qq_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7872 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
| 7873 | 0 |  |  |  |  | 0 | if    ($string =~ /\G (\\\\)    /oxgc) { $qq_string .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7874 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\\\")    /oxgc) { $qq_string .= $1; } | 
| 7875 |  |  |  |  |  |  | elsif ($string =~ /\G \"        /oxgc)                                       { $e_string .= e_chdir('','"','"',$qq_string); next E_STRING_LOOP; } | 
| 7876 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ($q_char) /oxgc) { $qq_string .= $1; } | 
| 7877 |  |  |  |  |  |  | } | 
| 7878 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7879 |  |  |  |  |  |  | } | 
| 7880 |  |  |  |  |  |  | } | 
| 7881 |  |  |  |  |  |  |  | 
| 7882 | 0 |  |  |  |  | 0 | # split | 
| 7883 |  |  |  |  |  |  | elsif ($string =~ /\G \b (split) \b (?! (?>\s*) => ) /oxgc) { | 
| 7884 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 7885 | 0 |  |  |  |  | 0 |  | 
| 7886 | 0 |  |  |  |  | 0 | my $e = ''; | 
| 7887 |  |  |  |  |  |  | while ($string =~ /\G ( (?>\s+) | \( | \#.* ) /oxgc) { | 
| 7888 |  |  |  |  |  |  | $e .= $1; | 
| 7889 |  |  |  |  |  |  | } | 
| 7890 | 0 | 0 |  |  |  | 0 |  | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7891 |  |  |  |  |  |  | # end of split | 
| 7892 |  |  |  |  |  |  | if    ($string =~ /\G (?= [,;\)\}\]] )          /oxgc) { return 'Ebig5hkscs::split' . $e;                                           } | 
| 7893 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7894 |  |  |  |  |  |  | # split scalar value | 
| 7895 |  |  |  |  |  |  | elsif ($string =~ /\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . e_string($1);  next E_STRING_LOOP; } | 
| 7896 | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7897 | 0 |  |  |  |  | 0 | # split literal space | 
|  | 0 |  |  |  |  | 0 |  | 
| 7898 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b qq           (\#) [ ] (\#) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq  {qq$1 $2}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7899 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b qq ((?>\s*)) (\() [ ] (\)) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7900 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b qq ((?>\s*)) (\{) [ ] (\}) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7901 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b qq ((?>\s*)) (\[) [ ] (\]) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7902 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b qq ((?>\s*)) (\<) [ ] (\>) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7903 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b qq ((?>\s*)) (\S) [ ] (\2) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7904 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b q            (\#) [ ] (\#) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq   {q$1 $2}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7905 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b q  ((?>\s*)) (\() [ ] (\)) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7906 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b q  ((?>\s*)) (\{) [ ] (\}) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7907 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b q  ((?>\s*)) (\[) [ ] (\]) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7908 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b q  ((?>\s*)) (\<) [ ] (\>) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7909 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G \b q  ((?>\s*)) (\S) [ ] (\2) /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7910 |  |  |  |  |  |  | elsif ($string =~ /\G                    ' [ ] '    /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq     {' '};  next E_STRING_LOOP; } | 
| 7911 |  |  |  |  |  |  | elsif ($string =~ /\G                    " [ ] "    /oxgc) { $e_string .= 'Ebig5hkscs::split' . $e . qq     {" "};  next E_STRING_LOOP; } | 
| 7912 |  |  |  |  |  |  |  | 
| 7913 | 0 | 0 |  |  |  | 0 | # split qq// | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7914 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qq) \b /oxgc) { | 
| 7915 | 0 |  |  |  |  | 0 | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc)                        { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq# #  --> qr # # | 
| 7916 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7917 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 7918 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                         /oxgc) { $e_string .= $e . $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7919 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\()          ((?:$qq_paren)*?)   (\)) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq ( ) --> qr ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7920 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{)          ((?:$qq_brace)*?)   (\}) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq { } --> qr { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7921 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[)          ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq [ ] --> qr [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 7922 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<)          ((?:$qq_angle)*?)   (\>) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq < > --> qr < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 7923 |  |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= e_split($e.'qr','{','}',$2,''); next E_STRING_LOOP; } # qq | | --> qr { } | 
| 7924 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S)          ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq * * --> qr * * | 
| 7925 |  |  |  |  |  |  | } | 
| 7926 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7927 |  |  |  |  |  |  | } | 
| 7928 |  |  |  |  |  |  | } | 
| 7929 |  |  |  |  |  |  |  | 
| 7930 | 0 | 0 |  |  |  | 0 | # split qr// | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7931 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qr) \b /oxgc) { | 
| 7932 | 0 |  |  |  |  | 0 | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) ([imosxpadlunbB]*) /oxgc)                        { $e_string .= e_split  ($e.'qr',$1,$3,$2,$4);   next E_STRING_LOOP; } # qr# # | 
| 7933 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7934 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 7935 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                                            /oxgc) { $e_string .= $e . $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7936 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\()          ((?:$qq_paren)*?)   (\)) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7937 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{)          ((?:$qq_brace)*?)   (\}) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7938 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[)          ((?:$qq_bracket)*?) (\]) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 7939 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<)          ((?:$qq_angle)*?)   (\>) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 7940 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\')          ((?:$qq_char)*?)    (\') ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split_q($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr ' ' | 
|  | 0 |  |  |  |  | 0 |  | 
| 7941 |  |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr','{','}',$2,$4); next E_STRING_LOOP; } # qr | | --> qr { } | 
| 7942 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S)          ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr * * | 
| 7943 |  |  |  |  |  |  | } | 
| 7944 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7945 |  |  |  |  |  |  | } | 
| 7946 |  |  |  |  |  |  | } | 
| 7947 |  |  |  |  |  |  |  | 
| 7948 | 0 | 0 |  |  |  | 0 | # split q// | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7949 |  |  |  |  |  |  | elsif ($string =~ /\G \b (q) \b /oxgc) { | 
| 7950 | 0 |  |  |  |  | 0 | if ($string =~ /\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc)                    { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q# #  --> qr # # | 
| 7951 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7952 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 7953 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                              /oxgc) { $e_string .= $e . $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7954 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q ( ) --> qr ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7955 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q { } --> qr { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7956 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q [ ] --> qr [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 7957 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q < > --> qr < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 7958 |  |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|])       ((?:$q_char)*?)    (\1) /oxgc) { $e_string .= e_split_q($e.'qr','{','}',$2,''); next E_STRING_LOOP; } # q | | --> qr { } | 
| 7959 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q * * --> qr * * | 
| 7960 |  |  |  |  |  |  | } | 
| 7961 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7962 |  |  |  |  |  |  | } | 
| 7963 |  |  |  |  |  |  | } | 
| 7964 |  |  |  |  |  |  |  | 
| 7965 | 0 | 0 |  |  |  | 0 | # split m// | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 7966 |  |  |  |  |  |  | elsif ($string =~ /\G \b (m) \b /oxgc) { | 
| 7967 | 0 |  |  |  |  | 0 | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc)                        { $e_string .= e_split  ($e.'qr',$1,$3,$2,$4);   next E_STRING_LOOP; } # m# #  --> qr # # | 
| 7968 | 0 | 0 |  |  |  | 0 | else { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7969 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 7970 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                                              /oxgc) { $e_string .= $e . $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7971 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\()          ((?:$qq_paren)*?)   (\)) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m ( ) --> qr ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 7972 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{)          ((?:$qq_brace)*?)   (\}) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m { } --> qr { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7973 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[)          ((?:$qq_bracket)*?) (\]) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m [ ] --> qr [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 7974 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<)          ((?:$qq_angle)*?)   (\>) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m < > --> qr < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 7975 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\')          ((?:$qq_char)*?)    (\') ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split_q($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m ' ' --> qr ' ' | 
|  | 0 |  |  |  |  | 0 |  | 
| 7976 |  |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr','{','}',$2,$4); next E_STRING_LOOP; } # m | | --> qr { } | 
| 7977 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S)          ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # m * * --> qr * * | 
| 7978 |  |  |  |  |  |  | } | 
| 7979 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 7980 |  |  |  |  |  |  | } | 
| 7981 |  |  |  |  |  |  | } | 
| 7982 |  |  |  |  |  |  |  | 
| 7983 | 0 |  |  |  |  | 0 | # split '' | 
| 7984 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\') /oxgc) { | 
| 7985 | 0 | 0 |  |  |  | 0 | my $q_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7986 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
| 7987 | 0 |  |  |  |  | 0 | if    ($string =~ /\G (\\\\)    /oxgc) { $q_string .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 7988 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\\\')    /oxgc) { $q_string .= $1; } # splitqr'' --> split qr'' | 
| 7989 |  |  |  |  |  |  | elsif ($string =~ /\G \'        /oxgc)                      { $e_string .= e_split_q($e.q{ qr},"'","'",$q_string,''); next E_STRING_LOOP; } # ' ' --> qr ' ' | 
| 7990 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ($q_char) /oxgc) { $q_string .= $1; } | 
| 7991 |  |  |  |  |  |  | } | 
| 7992 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 7993 |  |  |  |  |  |  | } | 
| 7994 |  |  |  |  |  |  |  | 
| 7995 | 0 |  |  |  |  | 0 | # split "" | 
| 7996 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\") /oxgc) { | 
| 7997 | 0 | 0 |  |  |  | 0 | my $qq_string = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7998 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
| 7999 | 0 |  |  |  |  | 0 | if    ($string =~ /\G (\\\\)    /oxgc) { $qq_string .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8000 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\\\")    /oxgc) { $qq_string .= $1; } # splitqr"" --> split qr"" | 
| 8001 |  |  |  |  |  |  | elsif ($string =~ /\G \"        /oxgc)                       { $e_string .= e_split($e.q{ qr},'"','"',$qq_string,''); next E_STRING_LOOP; } # " " --> qr " " | 
| 8002 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ($q_char) /oxgc) { $qq_string .= $1; } | 
| 8003 |  |  |  |  |  |  | } | 
| 8004 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 8005 |  |  |  |  |  |  | } | 
| 8006 |  |  |  |  |  |  |  | 
| 8007 | 0 |  |  |  |  | 0 | # split // | 
| 8008 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\/) /oxgc) { | 
| 8009 | 0 | 0 |  |  |  | 0 | my $regexp = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8010 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
| 8011 | 0 |  |  |  |  | 0 | if    ($string =~ /\G (\\\\)                  /oxgc) { $regexp .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8012 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\\\/)                  /oxgc) { $regexp .= $1; } # splitqr// --> split qr// | 
| 8013 |  |  |  |  |  |  | elsif ($string =~ /\G \/ ([cgimosxpadlunbB]*) /oxgc)                    { $e_string .= e_split($e.q{ qr}, '/','/',$regexp,$1); next E_STRING_LOOP; } # / / --> qr / / | 
| 8014 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ($q_char)               /oxgc) { $regexp .= $1; } | 
| 8015 |  |  |  |  |  |  | } | 
| 8016 |  |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 8017 |  |  |  |  |  |  | } | 
| 8018 |  |  |  |  |  |  | } | 
| 8019 |  |  |  |  |  |  |  | 
| 8020 | 0 |  |  |  |  | 0 | # qq// | 
| 8021 | 0 | 0 |  |  |  | 0 | elsif ($string =~ /\G \b (qq) \b /oxgc) { | 
| 8022 | 0 |  |  |  |  | 0 | my $ope = $1; | 
| 8023 |  |  |  |  |  |  | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { # qq# # | 
| 8024 |  |  |  |  |  |  | $e_string .= e_qq($ope,$1,$3,$2); | 
| 8025 | 0 |  |  |  |  | 0 | } | 
| 8026 | 0 |  |  |  |  | 0 | else { | 
| 8027 | 0 | 0 |  |  |  | 0 | my $e = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8028 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 8029 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                /oxgc) { $e .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8030 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\() ((?:$qq_paren)*?)   (\)) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 8031 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{) ((?:$qq_brace)*?)   (\}) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8032 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 8033 |  |  |  |  |  |  | elsif ($string =~ /\G (\<) ((?:$qq_angle)*?)   (\>) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq < > | 
| 8034 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S) ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq * * | 
| 8035 |  |  |  |  |  |  | } | 
| 8036 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 8037 |  |  |  |  |  |  | } | 
| 8038 |  |  |  |  |  |  | } | 
| 8039 |  |  |  |  |  |  |  | 
| 8040 | 0 |  |  |  |  | 0 | # qx// | 
| 8041 | 0 | 0 |  |  |  | 0 | elsif ($string =~ /\G \b (qx) \b /oxgc) { | 
| 8042 | 0 |  |  |  |  | 0 | my $ope = $1; | 
| 8043 |  |  |  |  |  |  | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { # qx# # | 
| 8044 |  |  |  |  |  |  | $e_string .= e_qq($ope,$1,$3,$2); | 
| 8045 | 0 |  |  |  |  | 0 | } | 
| 8046 | 0 |  |  |  |  | 0 | else { | 
| 8047 | 0 | 0 |  |  |  | 0 | my $e = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8048 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 8049 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                /oxgc) { $e .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8050 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\() ((?:$qq_paren)*?)   (\)) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 8051 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{) ((?:$qq_brace)*?)   (\}) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8052 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 8053 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\<) ((?:$qq_angle)*?)   (\>) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx < > | 
|  | 0 |  |  |  |  | 0 |  | 
| 8054 |  |  |  |  |  |  | elsif ($string =~ /\G (\') ((?:$qq_char)*?)    (\') /oxgc) { $e_string .= $e . e_q ($ope,$1,$3,$2); next E_STRING_LOOP; } # qx ' ' | 
| 8055 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S) ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx * * | 
| 8056 |  |  |  |  |  |  | } | 
| 8057 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 8058 |  |  |  |  |  |  | } | 
| 8059 |  |  |  |  |  |  | } | 
| 8060 |  |  |  |  |  |  |  | 
| 8061 | 0 |  |  |  |  | 0 | # q// | 
| 8062 | 0 | 0 |  |  |  | 0 | elsif ($string =~ /\G \b (q) \b /oxgc) { | 
| 8063 | 0 |  |  |  |  | 0 | my $ope = $1; | 
| 8064 |  |  |  |  |  |  | if ($string =~ /\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc) { # q# # | 
| 8065 |  |  |  |  |  |  | $e_string .= e_q($ope,$1,$3,$2); | 
| 8066 | 0 |  |  |  |  | 0 | } | 
| 8067 | 0 |  |  |  |  | 0 | else { | 
| 8068 | 0 | 0 |  |  |  | 0 | my $e = ''; | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8069 | 0 |  |  |  |  | 0 | while ($string !~ /\G \z/oxgc) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 8070 | 0 |  |  |  |  | 0 | if    ($string =~ /\G ((?>\s+)|\#.*)                              /oxgc) { $e .= $1; } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8071 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q ( ) | 
|  | 0 |  |  |  |  | 0 |  | 
| 8072 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q { } | 
|  | 0 |  |  |  |  | 0 |  | 
| 8073 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q [ ] | 
|  | 0 |  |  |  |  | 0 |  | 
| 8074 |  |  |  |  |  |  | elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q < > | 
| 8075 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q * * | 
| 8076 |  |  |  |  |  |  | } | 
| 8077 |  |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 8078 |  |  |  |  |  |  | } | 
| 8079 |  |  |  |  |  |  | } | 
| 8080 | 0 |  |  |  |  | 0 |  | 
| 8081 |  |  |  |  |  |  | # '' | 
| 8082 |  |  |  |  |  |  | elsif ($string =~ /\G (? | 
| 8083 | 44 |  |  |  |  | 295 |  | 
| 8084 |  |  |  |  |  |  | # "" | 
| 8085 |  |  |  |  |  |  | elsif ($string =~ /\G (\") ((?:$qq_char)*?) (\")                                        /oxgc) { $e_string .= e_qq('',$1,$3,$2); } | 
| 8086 | 6 |  |  |  |  | 61 |  | 
| 8087 |  |  |  |  |  |  | # `` | 
| 8088 |  |  |  |  |  |  | elsif ($string =~ /\G (\`) ((?:$qq_char)*?) (\`)                                        /oxgc) { $e_string .= e_qq('',$1,$3,$2); } | 
| 8089 | 0 |  |  |  |  | 0 |  | 
| 8090 |  |  |  |  |  |  | # <<>> (a safer ARGV) | 
| 8091 |  |  |  |  |  |  | elsif ($string =~ /\G ( <<>> )                                                          /oxgc) { $e_string .= $1;                } | 
| 8092 | 0 |  |  |  |  | 0 |  | 
| 8093 |  |  |  |  |  |  | # <<= <=> <= < operator | 
| 8094 |  |  |  |  |  |  | elsif ($string =~ /\G ( <<= | <=> | <= | < ) (?= (?>\s*) [A-Za-z_0-9'"`\$\@\&\*\(\+\-] )/oxgc) { $e_string .= $1;                } | 
| 8095 | 0 |  |  |  |  | 0 |  | 
| 8096 |  |  |  |  |  |  | # | 
| 8097 |  |  |  |  |  |  | elsif ($string =~ /\G (<[\$]?[A-Za-z_][A-Za-z_0-9]*>)                                   /oxgc) { $e_string .= $1;                } | 
| 8098 |  |  |  |  |  |  |  | 
| 8099 | 0 |  |  |  |  | 0 | #    --- glob | 
| 8100 |  |  |  |  |  |  | elsif ($string =~ /\G < ((?:$q_char)+?) > /oxgc) { | 
| 8101 |  |  |  |  |  |  | $e_string .= 'Ebig5hkscs::glob("' . $1 . '")'; | 
| 8102 |  |  |  |  |  |  | } | 
| 8103 |  |  |  |  |  |  |  | 
| 8104 | 0 |  |  |  |  | 0 | # << (bit shift)   --- not here document | 
| 8105 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( << (?>\s*) ) (?= [0-9\$\@\&] ) /oxgc) { | 
| 8106 |  |  |  |  |  |  | $slash = 'm//'; | 
| 8107 |  |  |  |  |  |  | $e_string .= $1; | 
| 8108 |  |  |  |  |  |  | } | 
| 8109 |  |  |  |  |  |  |  | 
| 8110 | 0 |  |  |  |  | 0 | # <<~'HEREDOC' | 
| 8111 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( <<~ [\t ]* '([a-zA-Z_0-9]*)' ) /oxgc) { | 
| 8112 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8113 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8114 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8115 | 0 | 0 |  |  |  | 0 |  | 
| 8116 | 0 |  |  |  |  | 0 | # get here document | 
| 8117 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8118 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8119 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8120 | 0 |  |  |  |  | 0 | } | 
| 8121 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 8122 | 0 |  |  |  |  | 0 | my $heredoc = $1; | 
| 8123 | 0 |  |  |  |  | 0 | my $indent  = $2; | 
| 8124 | 0 |  |  |  |  | 0 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 8125 |  |  |  |  |  |  | push @heredoc, $heredoc . qq{\n$delimiter\n}; | 
| 8126 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 8127 | 0 |  |  |  |  | 0 | } | 
| 8128 |  |  |  |  |  |  | else { | 
| 8129 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8130 |  |  |  |  |  |  | } | 
| 8131 |  |  |  |  |  |  | $e_string .= qq{<<'$delimiter'}; | 
| 8132 |  |  |  |  |  |  | } | 
| 8133 |  |  |  |  |  |  |  | 
| 8134 | 0 |  |  |  |  | 0 | # <<~\HEREDOC | 
| 8135 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( <<~ \\([a-zA-Z_0-9]+) ) /oxgc) { | 
| 8136 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8137 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8138 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8139 | 0 | 0 |  |  |  | 0 |  | 
| 8140 | 0 |  |  |  |  | 0 | # get here document | 
| 8141 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8142 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8143 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8144 | 0 |  |  |  |  | 0 | } | 
| 8145 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 8146 | 0 |  |  |  |  | 0 | my $heredoc = $1; | 
| 8147 | 0 |  |  |  |  | 0 | my $indent  = $2; | 
| 8148 | 0 |  |  |  |  | 0 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 8149 |  |  |  |  |  |  | push @heredoc, $heredoc . qq{\n$delimiter\n}; | 
| 8150 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 8151 | 0 |  |  |  |  | 0 | } | 
| 8152 |  |  |  |  |  |  | else { | 
| 8153 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8154 |  |  |  |  |  |  | } | 
| 8155 |  |  |  |  |  |  | $e_string .= qq{<<\\$delimiter}; | 
| 8156 |  |  |  |  |  |  | } | 
| 8157 |  |  |  |  |  |  |  | 
| 8158 | 0 |  |  |  |  | 0 | # <<~"HEREDOC" | 
| 8159 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( <<~ [\t ]* "([a-zA-Z_0-9]*)" ) /oxgc) { | 
| 8160 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8161 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8162 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8163 | 0 | 0 |  |  |  | 0 |  | 
| 8164 | 0 |  |  |  |  | 0 | # get here document | 
| 8165 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8166 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8167 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8168 | 0 |  |  |  |  | 0 | } | 
| 8169 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 8170 | 0 |  |  |  |  | 0 | my $heredoc = $1; | 
| 8171 | 0 |  |  |  |  | 0 | my $indent  = $2; | 
| 8172 | 0 |  |  |  |  | 0 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 8173 |  |  |  |  |  |  | push @heredoc, e_heredoc($heredoc) . qq{\n$delimiter\n}; | 
| 8174 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 8175 | 0 |  |  |  |  | 0 | } | 
| 8176 |  |  |  |  |  |  | else { | 
| 8177 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8178 |  |  |  |  |  |  | } | 
| 8179 |  |  |  |  |  |  | $e_string .= qq{<<"$delimiter"}; | 
| 8180 |  |  |  |  |  |  | } | 
| 8181 |  |  |  |  |  |  |  | 
| 8182 | 0 |  |  |  |  | 0 | # <<~HEREDOC | 
| 8183 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( <<~ ([a-zA-Z_0-9]+) ) /oxgc) { | 
| 8184 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8185 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8186 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8187 | 0 | 0 |  |  |  | 0 |  | 
| 8188 | 0 |  |  |  |  | 0 | # get here document | 
| 8189 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8190 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8191 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8192 | 0 |  |  |  |  | 0 | } | 
| 8193 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 8194 | 0 |  |  |  |  | 0 | my $heredoc = $1; | 
| 8195 | 0 |  |  |  |  | 0 | my $indent  = $2; | 
| 8196 | 0 |  |  |  |  | 0 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 8197 |  |  |  |  |  |  | push @heredoc, e_heredoc($heredoc) . qq{\n$delimiter\n}; | 
| 8198 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 8199 | 0 |  |  |  |  | 0 | } | 
| 8200 |  |  |  |  |  |  | else { | 
| 8201 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8202 |  |  |  |  |  |  | } | 
| 8203 |  |  |  |  |  |  | $e_string .= qq{<<$delimiter}; | 
| 8204 |  |  |  |  |  |  | } | 
| 8205 |  |  |  |  |  |  |  | 
| 8206 | 0 |  |  |  |  | 0 | # <<~`HEREDOC` | 
| 8207 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( <<~ [\t ]* `([a-zA-Z_0-9]*)` ) /oxgc) { | 
| 8208 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8209 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8210 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8211 | 0 | 0 |  |  |  | 0 |  | 
| 8212 | 0 |  |  |  |  | 0 | # get here document | 
| 8213 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8214 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8215 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8216 | 0 |  |  |  |  | 0 | } | 
| 8217 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n ([\t ]*) $delimiter \n //xms) { | 
| 8218 | 0 |  |  |  |  | 0 | my $heredoc = $1; | 
| 8219 | 0 |  |  |  |  | 0 | my $indent  = $2; | 
| 8220 | 0 |  |  |  |  | 0 | $heredoc =~ s{^$indent}{}msg; # no /ox | 
| 8221 |  |  |  |  |  |  | push @heredoc, e_heredoc($heredoc) . qq{\n$delimiter\n}; | 
| 8222 |  |  |  |  |  |  | push @heredoc_delimiter, qq{\\s*$delimiter}; | 
| 8223 | 0 |  |  |  |  | 0 | } | 
| 8224 |  |  |  |  |  |  | else { | 
| 8225 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8226 |  |  |  |  |  |  | } | 
| 8227 |  |  |  |  |  |  | $e_string .= qq{<<`$delimiter`}; | 
| 8228 |  |  |  |  |  |  | } | 
| 8229 |  |  |  |  |  |  |  | 
| 8230 | 0 |  |  |  |  | 0 | # <<'HEREDOC' | 
| 8231 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( << '([a-zA-Z_0-9]*)' ) /oxgc) { | 
| 8232 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8233 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8234 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8235 | 0 | 0 |  |  |  | 0 |  | 
| 8236 | 0 |  |  |  |  | 0 | # get here document | 
| 8237 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8238 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8239 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8240 | 0 |  |  |  |  | 0 | } | 
| 8241 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 8242 |  |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 8243 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 8244 | 0 |  |  |  |  | 0 | } | 
| 8245 |  |  |  |  |  |  | else { | 
| 8246 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8247 |  |  |  |  |  |  | } | 
| 8248 |  |  |  |  |  |  | $e_string .= $here_quote; | 
| 8249 |  |  |  |  |  |  | } | 
| 8250 |  |  |  |  |  |  |  | 
| 8251 | 0 |  |  |  |  | 0 | # <<\HEREDOC | 
| 8252 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( << \\([a-zA-Z_0-9]+) ) /oxgc) { | 
| 8253 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8254 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8255 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8256 | 0 | 0 |  |  |  | 0 |  | 
| 8257 | 0 |  |  |  |  | 0 | # get here document | 
| 8258 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8259 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8260 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8261 | 0 |  |  |  |  | 0 | } | 
| 8262 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 8263 |  |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 8264 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 8265 | 0 |  |  |  |  | 0 | } | 
| 8266 |  |  |  |  |  |  | else { | 
| 8267 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8268 |  |  |  |  |  |  | } | 
| 8269 |  |  |  |  |  |  | $e_string .= $here_quote; | 
| 8270 |  |  |  |  |  |  | } | 
| 8271 |  |  |  |  |  |  |  | 
| 8272 | 0 |  |  |  |  | 0 | # <<"HEREDOC" | 
| 8273 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( << "([a-zA-Z_0-9]*)" ) /oxgc) { | 
| 8274 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8275 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8276 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8277 | 0 | 0 |  |  |  | 0 |  | 
| 8278 | 0 |  |  |  |  | 0 | # get here document | 
| 8279 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8280 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8281 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8282 | 0 |  |  |  |  | 0 | } | 
| 8283 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 8284 |  |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 8285 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 8286 | 0 |  |  |  |  | 0 | } | 
| 8287 |  |  |  |  |  |  | else { | 
| 8288 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8289 |  |  |  |  |  |  | } | 
| 8290 |  |  |  |  |  |  | $e_string .= $here_quote; | 
| 8291 |  |  |  |  |  |  | } | 
| 8292 |  |  |  |  |  |  |  | 
| 8293 | 0 |  |  |  |  | 0 | # < | 
| 8294 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( << ([a-zA-Z_0-9]+) ) /oxgc) { | 
| 8295 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8296 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8297 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8298 | 0 | 0 |  |  |  | 0 |  | 
| 8299 | 0 |  |  |  |  | 0 | # get here document | 
| 8300 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8301 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8302 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8303 | 0 |  |  |  |  | 0 | } | 
| 8304 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 8305 |  |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 8306 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 8307 | 0 |  |  |  |  | 0 | } | 
| 8308 |  |  |  |  |  |  | else { | 
| 8309 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8310 |  |  |  |  |  |  | } | 
| 8311 |  |  |  |  |  |  | $e_string .= $here_quote; | 
| 8312 |  |  |  |  |  |  | } | 
| 8313 |  |  |  |  |  |  |  | 
| 8314 | 0 |  |  |  |  | 0 | # <<`HEREDOC` | 
| 8315 | 0 |  |  |  |  | 0 | elsif ($string =~ /\G ( << `([a-zA-Z_0-9]*)` ) /oxgc) { | 
| 8316 | 0 |  |  |  |  | 0 | $slash = 'm//'; | 
| 8317 |  |  |  |  |  |  | my $here_quote = $1; | 
| 8318 |  |  |  |  |  |  | my $delimiter  = $2; | 
| 8319 | 0 | 0 |  |  |  | 0 |  | 
| 8320 | 0 |  |  |  |  | 0 | # get here document | 
| 8321 | 0 |  |  |  |  | 0 | if ($here_script eq '') { | 
| 8322 |  |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 8323 | 0 | 0 |  |  |  | 0 | $here_script =~ s/.*?\n//oxm; | 
| 8324 | 0 |  |  |  |  | 0 | } | 
| 8325 | 0 |  |  |  |  | 0 | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 8326 |  |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 8327 |  |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 8328 | 0 |  |  |  |  | 0 | } | 
| 8329 |  |  |  |  |  |  | else { | 
| 8330 | 0 |  |  |  |  | 0 | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 8331 |  |  |  |  |  |  | } | 
| 8332 |  |  |  |  |  |  | $e_string .= $here_quote; | 
| 8333 |  |  |  |  |  |  | } | 
| 8334 |  |  |  |  |  |  |  | 
| 8335 |  |  |  |  |  |  | # any operator before div | 
| 8336 |  |  |  |  |  |  | elsif ($string =~ /\G ( | 
| 8337 |  |  |  |  |  |  | -- | \+\+ | | 
| 8338 | 0 |  |  |  |  | 0 | [\)\}\]] | 
|  | 80 |  |  |  |  | 146 |  | 
| 8339 |  |  |  |  |  |  |  | 
| 8340 |  |  |  |  |  |  | ) /oxgc) { $slash = 'div'; $e_string .= $1; } | 
| 8341 |  |  |  |  |  |  |  | 
| 8342 |  |  |  |  |  |  | # yada-yada or triple-dot operator | 
| 8343 |  |  |  |  |  |  | elsif ($string =~ /\G ( | 
| 8344 | 80 |  |  |  |  | 280 | \.\.\. | 
|  | 0 |  |  |  |  | 0 |  | 
| 8345 |  |  |  |  |  |  |  | 
| 8346 |  |  |  |  |  |  | ) /oxgc) { $slash = 'm//'; $e_string .= q{die('Unimplemented')}; } | 
| 8347 |  |  |  |  |  |  |  | 
| 8348 |  |  |  |  |  |  | # any operator before m// | 
| 8349 |  |  |  |  |  |  | elsif ($string =~ /\G ((?> | 
| 8350 |  |  |  |  |  |  |  | 
| 8351 |  |  |  |  |  |  | !~~ | !~ | != | ! | | 
| 8352 |  |  |  |  |  |  | %= | % | | 
| 8353 |  |  |  |  |  |  | &&= | && | &= | &\.= | &\. | & | | 
| 8354 |  |  |  |  |  |  | -= | -> | - | | 
| 8355 |  |  |  |  |  |  | :(?>\s*)= | | 
| 8356 |  |  |  |  |  |  | : | | 
| 8357 |  |  |  |  |  |  | <<>> | | 
| 8358 |  |  |  |  |  |  | <<= | <=> | <= | < | | 
| 8359 |  |  |  |  |  |  | == | => | =~ | = | | 
| 8360 |  |  |  |  |  |  | >>= | >> | >= | > | | 
| 8361 |  |  |  |  |  |  | \*\*= | \*\* | \*= | \* | | 
| 8362 |  |  |  |  |  |  | \+= | \+ | | 
| 8363 |  |  |  |  |  |  | \.\. | \.= | \. | | 
| 8364 |  |  |  |  |  |  | \/\/= | \/\/ | | 
| 8365 |  |  |  |  |  |  | \/= | \/ | | 
| 8366 |  |  |  |  |  |  | \? | | 
| 8367 |  |  |  |  |  |  | \\ | | 
| 8368 |  |  |  |  |  |  | \^= | \^\.= | \^\. | \^ | | 
| 8369 |  |  |  |  |  |  | \b x= | | 
| 8370 |  |  |  |  |  |  | \|\|= | \|\| | \|= | \|\.= | \|\. | \| | | 
| 8371 |  |  |  |  |  |  | ~~ | ~\. | ~ | | 
| 8372 |  |  |  |  |  |  | \b(?: and | cmp | eq | ge | gt | le | lt | ne | not | or | xor | x )\b | | 
| 8373 |  |  |  |  |  |  | \b(?: print )\b | | 
| 8374 |  |  |  |  |  |  |  | 
| 8375 | 0 |  |  |  |  | 0 | [,;\(\{\[] | 
|  | 112 |  |  |  |  | 319 |  | 
| 8376 |  |  |  |  |  |  |  | 
| 8377 |  |  |  |  |  |  | )) /oxgc) { $slash = 'm//'; $e_string .= $1; } | 
| 8378 | 112 |  |  |  |  | 722 |  | 
| 8379 |  |  |  |  |  |  | # other any character | 
| 8380 |  |  |  |  |  |  | elsif ($string =~ /\G ($q_char) /oxgc) { $e_string .= $1; } | 
| 8381 |  |  |  |  |  |  |  | 
| 8382 | 353 |  |  |  |  | 1424 | # system error | 
| 8383 |  |  |  |  |  |  | else { | 
| 8384 |  |  |  |  |  |  | die __FILE__, ": Oops, this shouldn't happen!\n"; | 
| 8385 |  |  |  |  |  |  | } | 
| 8386 | 0 |  |  |  |  | 0 | } | 
| 8387 |  |  |  |  |  |  |  | 
| 8388 |  |  |  |  |  |  | return $e_string; | 
| 8389 |  |  |  |  |  |  | } | 
| 8390 |  |  |  |  |  |  |  | 
| 8391 |  |  |  |  |  |  | # | 
| 8392 |  |  |  |  |  |  | # character class | 
| 8393 | 79 |  |  | 5434 | 0 | 329 | # | 
| 8394 |  |  |  |  |  |  | sub character_class { | 
| 8395 | 5434 | 100 |  |  |  | 11115 | my($char,$modifier) = @_; | 
| 8396 | 5434 | 100 |  |  |  | 8870 |  | 
| 8397 | 115 |  |  |  |  | 243 | if ($char eq '.') { | 
| 8398 |  |  |  |  |  |  | if ($modifier =~ /s/) { | 
| 8399 |  |  |  |  |  |  | return '${Ebig5hkscs::dot_s}'; | 
| 8400 | 23 |  |  |  |  | 63 | } | 
| 8401 |  |  |  |  |  |  | else { | 
| 8402 |  |  |  |  |  |  | return '${Ebig5hkscs::dot}'; | 
| 8403 |  |  |  |  |  |  | } | 
| 8404 | 92 |  |  |  |  | 203 | } | 
| 8405 |  |  |  |  |  |  | else { | 
| 8406 |  |  |  |  |  |  | return Ebig5hkscs::classic_character_class($char); | 
| 8407 |  |  |  |  |  |  | } | 
| 8408 |  |  |  |  |  |  | } | 
| 8409 |  |  |  |  |  |  |  | 
| 8410 |  |  |  |  |  |  | # | 
| 8411 |  |  |  |  |  |  | # escape capture ($1, $2, $3, ...) | 
| 8412 |  |  |  |  |  |  | # | 
| 8413 | 5319 |  |  | 637 | 0 | 10207 | sub e_capture { | 
| 8414 | 637 |  |  |  |  | 2717 |  | 
| 8415 |  |  |  |  |  |  | return join '', '${Ebig5hkscs::capture(', $_[0], ')}'; | 
| 8416 |  |  |  |  |  |  | return join '', '${',                $_[0],  '}'; | 
| 8417 |  |  |  |  |  |  | } | 
| 8418 |  |  |  |  |  |  |  | 
| 8419 |  |  |  |  |  |  | # | 
| 8420 |  |  |  |  |  |  | # escape transliteration (tr/// or y///) | 
| 8421 | 0 |  |  | 11 | 0 | 0 | # | 
| 8422 | 11 |  |  |  |  | 778 | sub e_tr { | 
| 8423 | 11 |  | 100 |  |  | 25 | my($variable,$charclass,$e,$charclass2,$modifier) = @_; | 
| 8424 |  |  |  |  |  |  | my $e_tr = ''; | 
| 8425 | 11 |  |  |  |  | 32 | $modifier ||= ''; | 
| 8426 |  |  |  |  |  |  |  | 
| 8427 |  |  |  |  |  |  | $slash = 'div'; | 
| 8428 | 11 |  |  |  |  | 21 |  | 
| 8429 |  |  |  |  |  |  | # quote character class 1 | 
| 8430 |  |  |  |  |  |  | $charclass  = q_tr($charclass); | 
| 8431 | 11 |  |  |  |  | 30 |  | 
| 8432 |  |  |  |  |  |  | # quote character class 2 | 
| 8433 |  |  |  |  |  |  | $charclass2 = q_tr($charclass2); | 
| 8434 | 11 | 50 |  |  |  | 23 |  | 
| 8435 | 11 | 0 |  |  |  | 375 | # /b /B modifier | 
| 8436 | 0 |  |  |  |  | 0 | if ($modifier =~ tr/bB//d) { | 
| 8437 |  |  |  |  |  |  | if ($variable eq '') { | 
| 8438 |  |  |  |  |  |  | $e_tr = qq{tr$charclass$e$charclass2$modifier}; | 
| 8439 | 0 |  |  |  |  | 0 | } | 
| 8440 |  |  |  |  |  |  | else { | 
| 8441 |  |  |  |  |  |  | $e_tr = qq{$variable${bind_operator}tr$charclass$e$charclass2$modifier}; | 
| 8442 |  |  |  |  |  |  | } | 
| 8443 | 0 | 100 |  |  |  | 0 | } | 
| 8444 | 11 |  |  |  |  | 29 | else { | 
| 8445 |  |  |  |  |  |  | if ($variable eq '') { | 
| 8446 |  |  |  |  |  |  | $e_tr = qq{Ebig5hkscs::tr(\$_,' =~ ',$charclass,$e$charclass2,'$modifier')}; | 
| 8447 | 2 |  |  |  |  | 7 | } | 
| 8448 |  |  |  |  |  |  | else { | 
| 8449 |  |  |  |  |  |  | $e_tr = qq{Ebig5hkscs::tr($variable,'$bind_operator',$charclass,$e$charclass2,'$modifier')}; | 
| 8450 |  |  |  |  |  |  | } | 
| 8451 |  |  |  |  |  |  | } | 
| 8452 | 9 |  |  |  |  | 43 |  | 
| 8453 | 11 |  |  |  |  | 20 | # clear tr/// variable | 
| 8454 |  |  |  |  |  |  | $tr_variable = ''; | 
| 8455 | 11 |  |  |  |  | 184 | $bind_operator = ''; | 
| 8456 |  |  |  |  |  |  |  | 
| 8457 |  |  |  |  |  |  | return $e_tr; | 
| 8458 |  |  |  |  |  |  | } | 
| 8459 |  |  |  |  |  |  |  | 
| 8460 |  |  |  |  |  |  | # | 
| 8461 |  |  |  |  |  |  | # quote for escape transliteration (tr/// or y///) | 
| 8462 | 11 |  |  | 22 | 0 | 77 | # | 
| 8463 |  |  |  |  |  |  | sub q_tr { | 
| 8464 |  |  |  |  |  |  | my($charclass) = @_; | 
| 8465 | 22 | 50 |  |  |  | 144 |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8466 | 22 |  |  |  |  | 60 | # quote character class | 
| 8467 |  |  |  |  |  |  | if ($charclass !~ /'/oxms) { | 
| 8468 |  |  |  |  |  |  | return e_q('',  "'", "'", $charclass); # --> q' ' | 
| 8469 | 22 |  |  |  |  | 43 | } | 
| 8470 |  |  |  |  |  |  | elsif ($charclass !~ /\//oxms) { | 
| 8471 |  |  |  |  |  |  | return e_q('q',  '/', '/', $charclass); # --> q/ / | 
| 8472 | 0 |  |  |  |  | 0 | } | 
| 8473 |  |  |  |  |  |  | elsif ($charclass !~ /\#/oxms) { | 
| 8474 |  |  |  |  |  |  | return e_q('q',  '#', '#', $charclass); # --> q# # | 
| 8475 | 0 |  |  |  |  | 0 | } | 
| 8476 |  |  |  |  |  |  | elsif ($charclass !~ /[\<\>]/oxms) { | 
| 8477 |  |  |  |  |  |  | return e_q('q', '<', '>', $charclass); # --> q< > | 
| 8478 | 0 |  |  |  |  | 0 | } | 
| 8479 |  |  |  |  |  |  | elsif ($charclass !~ /[\(\)]/oxms) { | 
| 8480 |  |  |  |  |  |  | return e_q('q', '(', ')', $charclass); # --> q( ) | 
| 8481 | 0 |  |  |  |  | 0 | } | 
| 8482 |  |  |  |  |  |  | elsif ($charclass !~ /[\{\}]/oxms) { | 
| 8483 |  |  |  |  |  |  | return e_q('q', '{', '}', $charclass); # --> q{ } | 
| 8484 | 0 |  |  |  |  | 0 | } | 
| 8485 | 0 | 0 |  |  |  | 0 | else { | 
| 8486 | 0 |  |  |  |  | 0 | for my $char (qw( ! " $ % & * + . : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 8487 |  |  |  |  |  |  | if ($charclass !~ /\Q$char\E/xms) { | 
| 8488 |  |  |  |  |  |  | return e_q('q', $char, $char, $charclass); | 
| 8489 |  |  |  |  |  |  | } | 
| 8490 |  |  |  |  |  |  | } | 
| 8491 | 0 |  |  |  |  | 0 | } | 
| 8492 |  |  |  |  |  |  |  | 
| 8493 |  |  |  |  |  |  | return e_q('q', '{', '}', $charclass); | 
| 8494 |  |  |  |  |  |  | } | 
| 8495 |  |  |  |  |  |  |  | 
| 8496 |  |  |  |  |  |  | # | 
| 8497 |  |  |  |  |  |  | # escape q string (q//, '') | 
| 8498 | 0 |  |  | 3967 | 0 | 0 | # | 
| 8499 |  |  |  |  |  |  | sub e_q { | 
| 8500 | 3967 |  |  |  |  | 11531 | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 8501 |  |  |  |  |  |  |  | 
| 8502 | 3967 |  |  |  |  | 5969 | $slash = 'div'; | 
| 8503 | 3967 |  |  |  |  | 25682 |  | 
| 8504 |  |  |  |  |  |  | my @char = $string =~ / \G (?>$q_char) /oxmsg; | 
| 8505 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 8506 | 3967 | 100 | 100 |  |  | 11773 |  | 
|  |  | 100 | 100 |  |  |  |  | 
| 8507 | 21301 |  |  |  |  | 128738 | # escape last octet of multiple-octet | 
| 8508 |  |  |  |  |  |  | if ($char[$i] =~ /\A ([\x80-\xFF].*) (\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 8509 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 8510 | 1 |  |  |  |  | 6 | } | 
| 8511 |  |  |  |  |  |  | elsif (defined($char[$i+1]) and ($char[$i+1] eq '\\') and ($char[$i] =~ /\A ([\x80-\xFF].*) (\\) \z/xms)) { | 
| 8512 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 8513 | 22 | 100 | 100 |  |  | 89 | } | 
| 8514 | 3967 |  |  |  |  | 15863 | } | 
| 8515 |  |  |  |  |  |  | if (defined($char[-1]) and ($char[-1] =~ /\A ([\x80-\xFF].*) (\\) \z/xms)) { | 
| 8516 |  |  |  |  |  |  | $char[-1] = $1 . '\\' . $2; | 
| 8517 | 204 |  |  |  |  | 657 | } | 
| 8518 | 3967 |  |  |  |  | 23097 |  | 
| 8519 |  |  |  |  |  |  | return join '', $ope, $delimiter, @char,   $end_delimiter; | 
| 8520 |  |  |  |  |  |  | return join '', $ope, $delimiter, $string, $end_delimiter; | 
| 8521 |  |  |  |  |  |  | } | 
| 8522 |  |  |  |  |  |  |  | 
| 8523 |  |  |  |  |  |  | # | 
| 8524 |  |  |  |  |  |  | # escape qq string (qq//, "", qx//, ``) | 
| 8525 | 0 |  |  | 9552 | 0 | 0 | # | 
| 8526 |  |  |  |  |  |  | sub e_qq { | 
| 8527 | 9552 |  |  |  |  | 23021 | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 8528 |  |  |  |  |  |  |  | 
| 8529 | 9552 |  |  |  |  | 13610 | $slash = 'div'; | 
| 8530 | 9552 |  |  |  |  | 12049 |  | 
| 8531 |  |  |  |  |  |  | my $left_e  = 0; | 
| 8532 |  |  |  |  |  |  | my $right_e = 0; | 
| 8533 | 9552 |  |  |  |  | 13352 |  | 
| 8534 |  |  |  |  |  |  | # split regexp | 
| 8535 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 8536 |  |  |  |  |  |  | [^\x81-\xFE\\\$]|[\x81-\xFE][\x00-\xFF] | | 
| 8537 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}            | | 
| 8538 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}            | | 
| 8539 |  |  |  |  |  |  | \\N\{ (?>[^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} | | 
| 8540 |  |  |  |  |  |  | \\ $q_char                           | | 
| 8541 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 8542 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 8543 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 8544 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)                    | | 
| 8545 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 8546 |  |  |  |  |  |  | \$ \$ (?![\w\{])                     | | 
| 8547 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 8548 |  |  |  |  |  |  | $q_char | 
| 8549 | 9552 |  |  |  |  | 390715 | ))/oxmsg; | 
| 8550 |  |  |  |  |  |  |  | 
| 8551 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 8552 | 9552 | 50 | 66 |  |  | 31221 |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 8553 | 310109 |  |  |  |  | 1021275 | # "\L\u" --> "\u\L" | 
| 8554 |  |  |  |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
| 8555 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 8556 |  |  |  |  |  |  | } | 
| 8557 |  |  |  |  |  |  |  | 
| 8558 | 0 |  |  |  |  | 0 | # "\U\l" --> "\l\U" | 
| 8559 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 8560 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 8561 |  |  |  |  |  |  | } | 
| 8562 |  |  |  |  |  |  |  | 
| 8563 | 0 |  |  |  |  | 0 | # octal escape sequence | 
| 8564 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 8565 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::octchr($1); | 
| 8566 |  |  |  |  |  |  | } | 
| 8567 |  |  |  |  |  |  |  | 
| 8568 | 1 |  |  |  |  | 5 | # hexadecimal escape sequence | 
| 8569 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 8570 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::hexchr($1); | 
| 8571 |  |  |  |  |  |  | } | 
| 8572 |  |  |  |  |  |  |  | 
| 8573 | 1 |  |  |  |  | 6 | # \N{CHARNAME} --> N{CHARNAME} | 
| 8574 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( N\{ ([^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} ) \z/oxms) { | 
| 8575 |  |  |  |  |  |  | $char[$i] = $1; | 
| 8576 | 0 | 100 |  |  |  | 0 | } | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 8577 |  |  |  |  |  |  |  | 
| 8578 |  |  |  |  |  |  | if (0) { | 
| 8579 |  |  |  |  |  |  | } | 
| 8580 |  |  |  |  |  |  |  | 
| 8581 |  |  |  |  |  |  | # escape last octet of multiple-octet | 
| 8582 | 310109 |  |  |  |  | 2902470 | # my $metachar = qr/[\@\\\|]/oxms; # '|' is for qx//, ``, open(), and system() | 
| 8583 | 0 |  |  |  |  | 0 | # variable $delimiter and $end_delimiter can be '' | 
| 8584 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\@\\\|$delimiter$end_delimiter]) \z/xms) { | 
| 8585 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 8586 |  |  |  |  |  |  | } | 
| 8587 |  |  |  |  |  |  |  | 
| 8588 |  |  |  |  |  |  | # \F | 
| 8589 |  |  |  |  |  |  | # | 
| 8590 |  |  |  |  |  |  | # P.69 Table 2-6. Translation escapes | 
| 8591 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 8592 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 8593 |  |  |  |  |  |  | # (and so on) | 
| 8594 |  |  |  |  |  |  |  | 
| 8595 | 1342 | 50 |  |  |  | 6075 | # \u \l \U \L \F \Q \E | 
| 8596 | 647 |  |  |  |  | 1614 | elsif ($char[$i] =~ /\A ([<>]) \z/oxms) { | 
| 8597 |  |  |  |  |  |  | if ($right_e < $left_e) { | 
| 8598 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 8599 |  |  |  |  |  |  | } | 
| 8600 |  |  |  |  |  |  | } | 
| 8601 |  |  |  |  |  |  | elsif ($char[$i] eq '\u') { | 
| 8602 |  |  |  |  |  |  |  | 
| 8603 |  |  |  |  |  |  | # "STRING @{[ LIST EXPR ]} MORE STRING" | 
| 8604 |  |  |  |  |  |  |  | 
| 8605 |  |  |  |  |  |  | # P.257 Other Tricks You Can Do with Hard References | 
| 8606 |  |  |  |  |  |  | # in Chapter 8: References | 
| 8607 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 8608 |  |  |  |  |  |  |  | 
| 8609 |  |  |  |  |  |  | # P.353 Other Tricks You Can Do with Hard References | 
| 8610 |  |  |  |  |  |  | # in Chapter 8: References | 
| 8611 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 8612 |  |  |  |  |  |  |  | 
| 8613 | 0 |  |  |  |  | 0 | # (and so on) | 
| 8614 | 0 |  |  |  |  | 0 |  | 
| 8615 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ucfirst qq<'; | 
| 8616 |  |  |  |  |  |  | $left_e++; | 
| 8617 | 0 |  |  |  |  | 0 | } | 
| 8618 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\l') { | 
| 8619 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lcfirst qq<'; | 
| 8620 |  |  |  |  |  |  | $left_e++; | 
| 8621 | 0 |  |  |  |  | 0 | } | 
| 8622 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\U') { | 
| 8623 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::uc qq<'; | 
| 8624 |  |  |  |  |  |  | $left_e++; | 
| 8625 | 0 |  |  |  |  | 0 | } | 
| 8626 | 6 |  |  |  |  | 9 | elsif ($char[$i] eq '\L') { | 
| 8627 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lc qq<'; | 
| 8628 |  |  |  |  |  |  | $left_e++; | 
| 8629 | 6 |  |  |  |  | 13 | } | 
| 8630 | 9 |  |  |  |  | 16 | elsif ($char[$i] eq '\F') { | 
| 8631 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::fc qq<'; | 
| 8632 |  |  |  |  |  |  | $left_e++; | 
| 8633 | 9 |  |  |  |  | 20 | } | 
| 8634 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 8635 |  |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 8636 |  |  |  |  |  |  | $left_e++; | 
| 8637 | 0 | 50 |  |  |  | 0 | } | 
| 8638 | 12 |  |  |  |  | 26 | elsif ($char[$i] eq '\E') { | 
| 8639 | 12 |  |  |  |  | 15 | if ($right_e < $left_e) { | 
| 8640 |  |  |  |  |  |  | $char[$i] = '>]}'; | 
| 8641 |  |  |  |  |  |  | $right_e++; | 
| 8642 | 12 |  |  |  |  | 26 | } | 
| 8643 |  |  |  |  |  |  | else { | 
| 8644 |  |  |  |  |  |  | $char[$i] = ''; | 
| 8645 |  |  |  |  |  |  | } | 
| 8646 | 0 |  |  |  |  | 0 | } | 
| 8647 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 8648 | 0 |  |  |  |  | 0 | while (1) { | 
| 8649 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 8650 | 0 | 0 |  |  |  | 0 | last; | 
| 8651 | 0 |  |  |  |  | 0 | } | 
| 8652 |  |  |  |  |  |  | if ($char[$i] eq '\E') { | 
| 8653 |  |  |  |  |  |  | last; | 
| 8654 |  |  |  |  |  |  | } | 
| 8655 |  |  |  |  |  |  | } | 
| 8656 |  |  |  |  |  |  | } | 
| 8657 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 8658 |  |  |  |  |  |  | } | 
| 8659 |  |  |  |  |  |  |  | 
| 8660 |  |  |  |  |  |  | # $0 --> $0 | 
| 8661 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 8662 |  |  |  |  |  |  | } | 
| 8663 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 8664 |  |  |  |  |  |  | } | 
| 8665 |  |  |  |  |  |  |  | 
| 8666 |  |  |  |  |  |  | # $$ --> $$ | 
| 8667 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 8668 |  |  |  |  |  |  | } | 
| 8669 |  |  |  |  |  |  |  | 
| 8670 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 8671 | 0 |  |  |  |  | 0 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 8672 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 8673 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8674 | 415 |  |  |  |  | 1104 | } | 
| 8675 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 8676 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8677 |  |  |  |  |  |  | } | 
| 8678 |  |  |  |  |  |  |  | 
| 8679 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 8680 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 8681 |  |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 8682 |  |  |  |  |  |  | } | 
| 8683 |  |  |  |  |  |  |  | 
| 8684 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 8685 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 8686 |  |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 8687 |  |  |  |  |  |  | } | 
| 8688 |  |  |  |  |  |  |  | 
| 8689 | 0 |  |  |  |  | 0 | # $$foo | 
| 8690 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 8691 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8692 |  |  |  |  |  |  | } | 
| 8693 |  |  |  |  |  |  |  | 
| 8694 | 0 |  |  |  |  | 0 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5hkscs::PREMATCH() | 
| 8695 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH (?>\s*) \}  | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 8696 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::PREMATCH()]}'; | 
| 8697 |  |  |  |  |  |  | } | 
| 8698 |  |  |  |  |  |  |  | 
| 8699 | 44 |  |  |  |  | 143 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5hkscs::MATCH() | 
| 8700 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 8701 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::MATCH()]}'; | 
| 8702 |  |  |  |  |  |  | } | 
| 8703 |  |  |  |  |  |  |  | 
| 8704 | 45 |  |  |  |  | 156 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5hkscs::POSTMATCH() | 
| 8705 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 8706 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::POSTMATCH()]}'; | 
| 8707 |  |  |  |  |  |  | } | 
| 8708 |  |  |  |  |  |  |  | 
| 8709 |  |  |  |  |  |  | # ${ foo } --> ${ foo } | 
| 8710 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ (?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \}                                \z/oxms) { | 
| 8711 |  |  |  |  |  |  | } | 
| 8712 |  |  |  |  |  |  |  | 
| 8713 | 33 |  |  |  |  | 104 | # ${ ... } | 
| 8714 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 8715 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8716 |  |  |  |  |  |  | } | 
| 8717 |  |  |  |  |  |  | } | 
| 8718 | 0 | 100 |  |  |  | 0 |  | 
| 8719 | 9552 |  |  |  |  | 20157 | # return string | 
| 8720 |  |  |  |  |  |  | if ($left_e > $right_e) { | 
| 8721 | 3 |  |  |  |  | 19 | return join '', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter; | 
| 8722 |  |  |  |  |  |  | } | 
| 8723 |  |  |  |  |  |  | return     join '', $ope, $delimiter, @char,                               $end_delimiter; | 
| 8724 |  |  |  |  |  |  | } | 
| 8725 |  |  |  |  |  |  |  | 
| 8726 |  |  |  |  |  |  | # | 
| 8727 |  |  |  |  |  |  | # escape qw string (qw//) | 
| 8728 | 9549 |  |  | 34 | 0 | 89254 | # | 
| 8729 |  |  |  |  |  |  | sub e_qw { | 
| 8730 | 34 |  |  |  |  | 168 | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 8731 |  |  |  |  |  |  |  | 
| 8732 |  |  |  |  |  |  | $slash = 'div'; | 
| 8733 | 34 |  |  |  |  | 68 |  | 
|  | 34 |  |  |  |  | 334 |  | 
| 8734 | 621 | 50 |  |  |  | 1192 | # choice again delimiter | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8735 | 34 |  |  |  |  | 172 | my %octet = map {$_ => 1} ($string =~ /\G ([\x00-\xFF]) /oxmsg); | 
| 8736 |  |  |  |  |  |  | if (not $octet{$end_delimiter}) { | 
| 8737 |  |  |  |  |  |  | return join '', $ope, $delimiter, $string, $end_delimiter; | 
| 8738 | 34 |  |  |  |  | 260 | } | 
| 8739 |  |  |  |  |  |  | elsif (not $octet{')'}) { | 
| 8740 |  |  |  |  |  |  | return join '', $ope, '(',        $string, ')'; | 
| 8741 | 0 |  |  |  |  | 0 | } | 
| 8742 |  |  |  |  |  |  | elsif (not $octet{'}'}) { | 
| 8743 |  |  |  |  |  |  | return join '', $ope, '{',        $string, '}'; | 
| 8744 | 0 |  |  |  |  | 0 | } | 
| 8745 |  |  |  |  |  |  | elsif (not $octet{']'}) { | 
| 8746 |  |  |  |  |  |  | return join '', $ope, '[',        $string, ']'; | 
| 8747 | 0 |  |  |  |  | 0 | } | 
| 8748 |  |  |  |  |  |  | elsif (not $octet{'>'}) { | 
| 8749 |  |  |  |  |  |  | return join '', $ope, '<',        $string, '>'; | 
| 8750 | 0 |  |  |  |  | 0 | } | 
| 8751 | 0 | 0 |  |  |  | 0 | else { | 
| 8752 | 0 |  |  |  |  | 0 | for my $char (qw( ! " $ % & * + - . / : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 8753 |  |  |  |  |  |  | if (not $octet{$char}) { | 
| 8754 |  |  |  |  |  |  | return join '', $ope,      $char, $string, $char; | 
| 8755 |  |  |  |  |  |  | } | 
| 8756 |  |  |  |  |  |  | } | 
| 8757 |  |  |  |  |  |  | } | 
| 8758 | 0 |  |  |  |  | 0 |  | 
| 8759 | 0 |  |  |  |  | 0 | # qw/AAA BBB C'CC/ --> ('AAA', 'BBB', 'C\'CC') | 
| 8760 | 0 |  |  |  |  | 0 | my @string = CORE::split(/\s+/, $string); | 
| 8761 | 0 |  |  |  |  | 0 | for my $string (@string) { | 
| 8762 | 0 | 0 |  |  |  | 0 | my @octet = $string =~ /\G ([\x00-\xFF]) /oxmsg; | 
| 8763 | 0 |  |  |  |  | 0 | for my $octet (@octet) { | 
| 8764 |  |  |  |  |  |  | if ($octet =~ /\A (['\\]) \z/oxms) { | 
| 8765 |  |  |  |  |  |  | $octet = '\\' . $1; | 
| 8766 | 0 |  |  |  |  | 0 | } | 
| 8767 |  |  |  |  |  |  | } | 
| 8768 | 0 |  |  |  |  | 0 | $string = join '', @octet; | 
|  | 0 |  |  |  |  | 0 |  | 
| 8769 |  |  |  |  |  |  | } | 
| 8770 |  |  |  |  |  |  | return join '', '(', (join ', ', map { "'$_'" } @string), ')'; | 
| 8771 |  |  |  |  |  |  | } | 
| 8772 |  |  |  |  |  |  |  | 
| 8773 |  |  |  |  |  |  | # | 
| 8774 |  |  |  |  |  |  | # escape here document (<<"HEREDOC", < | 
| 8775 | 0 |  |  | 108 | 0 | 0 | # | 
| 8776 |  |  |  |  |  |  | sub e_heredoc { | 
| 8777 | 108 |  |  |  |  | 326 | my($string) = @_; | 
| 8778 |  |  |  |  |  |  |  | 
| 8779 | 108 |  |  |  |  | 197 | $slash = 'm//'; | 
| 8780 |  |  |  |  |  |  |  | 
| 8781 | 108 |  |  |  |  | 381 | my $metachar = qr/[\@\\|]/oxms; # '|' is for <<`HEREDOC` | 
| 8782 | 108 |  |  |  |  | 193 |  | 
| 8783 |  |  |  |  |  |  | my $left_e  = 0; | 
| 8784 |  |  |  |  |  |  | my $right_e = 0; | 
| 8785 | 108 |  |  |  |  | 156 |  | 
| 8786 |  |  |  |  |  |  | # split regexp | 
| 8787 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 8788 |  |  |  |  |  |  | [^\x81-\xFE\\\$]|[\x81-\xFE][\x00-\xFF] | | 
| 8789 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}            | | 
| 8790 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}            | | 
| 8791 |  |  |  |  |  |  | \\N\{ (?>[^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} | | 
| 8792 |  |  |  |  |  |  | \\ $q_char                           | | 
| 8793 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 8794 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 8795 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 8796 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)                    | | 
| 8797 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 8798 |  |  |  |  |  |  | \$ \$ (?![\w\{])                     | | 
| 8799 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 8800 |  |  |  |  |  |  | $q_char | 
| 8801 | 108 |  |  |  |  | 10691 | ))/oxmsg; | 
| 8802 |  |  |  |  |  |  |  | 
| 8803 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 8804 | 108 | 50 | 66 |  |  | 615 |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 8805 | 3355 |  |  |  |  | 10567 | # "\L\u" --> "\u\L" | 
| 8806 |  |  |  |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
| 8807 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 8808 |  |  |  |  |  |  | } | 
| 8809 |  |  |  |  |  |  |  | 
| 8810 | 0 |  |  |  |  | 0 | # "\U\l" --> "\l\U" | 
| 8811 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 8812 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 8813 |  |  |  |  |  |  | } | 
| 8814 |  |  |  |  |  |  |  | 
| 8815 | 0 |  |  |  |  | 0 | # octal escape sequence | 
| 8816 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 8817 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::octchr($1); | 
| 8818 |  |  |  |  |  |  | } | 
| 8819 |  |  |  |  |  |  |  | 
| 8820 | 1 |  |  |  |  | 4 | # hexadecimal escape sequence | 
| 8821 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 8822 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::hexchr($1); | 
| 8823 |  |  |  |  |  |  | } | 
| 8824 |  |  |  |  |  |  |  | 
| 8825 | 1 |  |  |  |  | 4 | # \N{CHARNAME} --> N{CHARNAME} | 
| 8826 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( N\{ ([^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} ) \z/oxms) { | 
| 8827 |  |  |  |  |  |  | $char[$i] = $1; | 
| 8828 | 0 | 100 |  |  |  | 0 | } | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 8829 |  |  |  |  |  |  |  | 
| 8830 |  |  |  |  |  |  | if (0) { | 
| 8831 |  |  |  |  |  |  | } | 
| 8832 | 3355 |  |  |  |  | 30324 |  | 
| 8833 | 0 |  |  |  |  | 0 | # escape character | 
| 8834 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ($metachar) \z/oxms) { | 
| 8835 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 8836 |  |  |  |  |  |  | } | 
| 8837 |  |  |  |  |  |  |  | 
| 8838 | 57 | 50 |  |  |  | 224 | # \u \l \U \L \F \Q \E | 
| 8839 | 72 |  |  |  |  | 184 | elsif ($char[$i] =~ /\A ([<>]) \z/oxms) { | 
| 8840 |  |  |  |  |  |  | if ($right_e < $left_e) { | 
| 8841 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 8842 |  |  |  |  |  |  | } | 
| 8843 | 0 |  |  |  |  | 0 | } | 
| 8844 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\u') { | 
| 8845 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ucfirst qq<'; | 
| 8846 |  |  |  |  |  |  | $left_e++; | 
| 8847 | 0 |  |  |  |  | 0 | } | 
| 8848 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\l') { | 
| 8849 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lcfirst qq<'; | 
| 8850 |  |  |  |  |  |  | $left_e++; | 
| 8851 | 0 |  |  |  |  | 0 | } | 
| 8852 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\U') { | 
| 8853 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::uc qq<'; | 
| 8854 |  |  |  |  |  |  | $left_e++; | 
| 8855 | 0 |  |  |  |  | 0 | } | 
| 8856 | 6 |  |  |  |  | 9 | elsif ($char[$i] eq '\L') { | 
| 8857 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lc qq<'; | 
| 8858 |  |  |  |  |  |  | $left_e++; | 
| 8859 | 6 |  |  |  |  | 12 | } | 
| 8860 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\F') { | 
| 8861 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::fc qq<'; | 
| 8862 |  |  |  |  |  |  | $left_e++; | 
| 8863 | 0 |  |  |  |  | 0 | } | 
| 8864 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 8865 |  |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 8866 |  |  |  |  |  |  | $left_e++; | 
| 8867 | 0 | 50 |  |  |  | 0 | } | 
| 8868 | 3 |  |  |  |  | 10 | elsif ($char[$i] eq '\E') { | 
| 8869 | 3 |  |  |  |  | 5 | if ($right_e < $left_e) { | 
| 8870 |  |  |  |  |  |  | $char[$i] = '>]}'; | 
| 8871 |  |  |  |  |  |  | $right_e++; | 
| 8872 | 3 |  |  |  |  | 7 | } | 
| 8873 |  |  |  |  |  |  | else { | 
| 8874 |  |  |  |  |  |  | $char[$i] = ''; | 
| 8875 |  |  |  |  |  |  | } | 
| 8876 | 0 |  |  |  |  | 0 | } | 
| 8877 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 8878 | 0 |  |  |  |  | 0 | while (1) { | 
| 8879 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 8880 | 0 | 0 |  |  |  | 0 | last; | 
| 8881 | 0 |  |  |  |  | 0 | } | 
| 8882 |  |  |  |  |  |  | if ($char[$i] eq '\E') { | 
| 8883 |  |  |  |  |  |  | last; | 
| 8884 |  |  |  |  |  |  | } | 
| 8885 |  |  |  |  |  |  | } | 
| 8886 |  |  |  |  |  |  | } | 
| 8887 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 8888 |  |  |  |  |  |  | } | 
| 8889 |  |  |  |  |  |  |  | 
| 8890 |  |  |  |  |  |  | # $0 --> $0 | 
| 8891 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 8892 |  |  |  |  |  |  | } | 
| 8893 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 8894 |  |  |  |  |  |  | } | 
| 8895 |  |  |  |  |  |  |  | 
| 8896 |  |  |  |  |  |  | # $$ --> $$ | 
| 8897 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 8898 |  |  |  |  |  |  | } | 
| 8899 |  |  |  |  |  |  |  | 
| 8900 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 8901 | 0 |  |  |  |  | 0 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 8902 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 8903 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8904 | 0 |  |  |  |  | 0 | } | 
| 8905 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 8906 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8907 |  |  |  |  |  |  | } | 
| 8908 |  |  |  |  |  |  |  | 
| 8909 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 8910 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 8911 |  |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 8912 |  |  |  |  |  |  | } | 
| 8913 |  |  |  |  |  |  |  | 
| 8914 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 8915 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 8916 |  |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 8917 |  |  |  |  |  |  | } | 
| 8918 |  |  |  |  |  |  |  | 
| 8919 | 0 |  |  |  |  | 0 | # $$foo | 
| 8920 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 8921 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8922 |  |  |  |  |  |  | } | 
| 8923 |  |  |  |  |  |  |  | 
| 8924 | 0 |  |  |  |  | 0 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5hkscs::PREMATCH() | 
| 8925 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 8926 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::PREMATCH()]}'; | 
| 8927 |  |  |  |  |  |  | } | 
| 8928 |  |  |  |  |  |  |  | 
| 8929 | 8 |  |  |  |  | 47 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5hkscs::MATCH() | 
| 8930 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 8931 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::MATCH()]}'; | 
| 8932 |  |  |  |  |  |  | } | 
| 8933 |  |  |  |  |  |  |  | 
| 8934 | 8 |  |  |  |  | 54 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5hkscs::POSTMATCH() | 
| 8935 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 8936 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::POSTMATCH()]}'; | 
| 8937 |  |  |  |  |  |  | } | 
| 8938 |  |  |  |  |  |  |  | 
| 8939 |  |  |  |  |  |  | # ${ foo } --> ${ foo } | 
| 8940 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ (?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \}                                \z/oxms) { | 
| 8941 |  |  |  |  |  |  | } | 
| 8942 |  |  |  |  |  |  |  | 
| 8943 | 6 |  |  |  |  | 37 | # ${ ... } | 
| 8944 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 8945 |  |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 8946 |  |  |  |  |  |  | } | 
| 8947 |  |  |  |  |  |  | } | 
| 8948 | 0 | 100 |  |  |  | 0 |  | 
| 8949 | 108 |  |  |  |  | 401 | # return string | 
| 8950 |  |  |  |  |  |  | if ($left_e > $right_e) { | 
| 8951 | 3 |  |  |  |  | 26 | return join '', @char, '>]}' x ($left_e - $right_e); | 
| 8952 |  |  |  |  |  |  | } | 
| 8953 |  |  |  |  |  |  | return     join '', @char; | 
| 8954 |  |  |  |  |  |  | } | 
| 8955 |  |  |  |  |  |  |  | 
| 8956 |  |  |  |  |  |  | # | 
| 8957 |  |  |  |  |  |  | # escape regexp (m//, qr//) | 
| 8958 | 105 |  |  | 1835 | 0 | 965 | # | 
| 8959 | 1835 |  | 100 |  |  | 7636 | sub e_qr { | 
| 8960 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 8961 | 1835 |  |  |  |  | 7825 | $modifier ||= ''; | 
| 8962 | 1835 | 50 |  |  |  | 3365 |  | 
| 8963 | 1835 |  |  |  |  | 4895 | $modifier =~ tr/p//d; | 
| 8964 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 8965 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 8966 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 8967 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 8968 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 8969 |  |  |  |  |  |  | last; | 
| 8970 | 0 |  |  |  |  | 0 | } | 
| 8971 |  |  |  |  |  |  | } | 
| 8972 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 8973 | 0 |  |  |  |  | 0 | } | 
| 8974 |  |  |  |  |  |  |  | 
| 8975 |  |  |  |  |  |  | $slash = 'div'; | 
| 8976 | 1835 | 100 |  |  |  | 2939 |  | 
|  |  | 100 |  |  |  |  |  | 
| 8977 | 1835 |  |  |  |  | 5403 | # literal null string pattern | 
| 8978 | 8 |  |  |  |  | 9 | if ($string eq '') { | 
| 8979 | 8 |  |  |  |  | 10 | $modifier =~ tr/bB//d; | 
| 8980 |  |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 8981 |  |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 8982 |  |  |  |  |  |  | } | 
| 8983 |  |  |  |  |  |  |  | 
| 8984 |  |  |  |  |  |  | # /b /B modifier | 
| 8985 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 8986 | 8 | 50 |  |  |  | 38 |  | 
| 8987 | 240 |  |  |  |  | 556 | # choice again delimiter | 
| 8988 | 0 |  |  |  |  | 0 | if ($delimiter =~ / [\@:] /oxms) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 8989 | 0 | 0 |  |  |  | 0 | my @char = $string =~ /\G ([\x00-\xFF]) /oxmsg; | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 8990 | 0 |  |  |  |  | 0 | my %octet = map {$_ => 1} @char; | 
| 8991 | 0 |  |  |  |  | 0 | if (not $octet{')'}) { | 
| 8992 |  |  |  |  |  |  | $delimiter     = '('; | 
| 8993 |  |  |  |  |  |  | $end_delimiter = ')'; | 
| 8994 | 0 |  |  |  |  | 0 | } | 
| 8995 | 0 |  |  |  |  | 0 | elsif (not $octet{'}'}) { | 
| 8996 |  |  |  |  |  |  | $delimiter     = '{'; | 
| 8997 |  |  |  |  |  |  | $end_delimiter = '}'; | 
| 8998 | 0 |  |  |  |  | 0 | } | 
| 8999 | 0 |  |  |  |  | 0 | elsif (not $octet{']'}) { | 
| 9000 |  |  |  |  |  |  | $delimiter     = '['; | 
| 9001 |  |  |  |  |  |  | $end_delimiter = ']'; | 
| 9002 | 0 |  |  |  |  | 0 | } | 
| 9003 | 0 |  |  |  |  | 0 | elsif (not $octet{'>'}) { | 
| 9004 |  |  |  |  |  |  | $delimiter     = '<'; | 
| 9005 |  |  |  |  |  |  | $end_delimiter = '>'; | 
| 9006 | 0 |  |  |  |  | 0 | } | 
| 9007 | 0 | 0 |  |  |  | 0 | else { | 
| 9008 | 0 |  |  |  |  | 0 | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 9009 | 0 |  |  |  |  | 0 | if (not $octet{$char}) { | 
| 9010 | 0 |  |  |  |  | 0 | $delimiter     = $char; | 
| 9011 |  |  |  |  |  |  | $end_delimiter = $char; | 
| 9012 |  |  |  |  |  |  | last; | 
| 9013 |  |  |  |  |  |  | } | 
| 9014 |  |  |  |  |  |  | } | 
| 9015 |  |  |  |  |  |  | } | 
| 9016 | 0 | 100 | 100 |  |  | 0 | } | 
| 9017 | 240 |  |  |  |  | 1289 |  | 
| 9018 |  |  |  |  |  |  | if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 9019 |  |  |  |  |  |  | return join '', $ope, $delimiter,        $string,      $matched, $end_delimiter, $modifier; | 
| 9020 | 90 |  |  |  |  | 578 | } | 
| 9021 |  |  |  |  |  |  | else { | 
| 9022 |  |  |  |  |  |  | return join '', $ope, $delimiter, '(?:', $string, ')', $matched, $end_delimiter, $modifier; | 
| 9023 |  |  |  |  |  |  | } | 
| 9024 | 150 | 100 |  |  |  | 929 | } | 
| 9025 | 1587 |  |  |  |  | 5179 |  | 
| 9026 |  |  |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 9027 |  |  |  |  |  |  | my $metachar = qr/[\@\\|[\]{^]/oxms; | 
| 9028 | 1587 |  |  |  |  | 6414 |  | 
| 9029 |  |  |  |  |  |  | # split regexp | 
| 9030 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 9031 |  |  |  |  |  |  | [^\x81-\xFE\\\$\@\[\(]|[\x81-\xFE][\x00-\xFF] | | 
| 9032 |  |  |  |  |  |  | \\x   (?>[0-9A-Fa-f]{1,2}) | | 
| 9033 |  |  |  |  |  |  | \\    (?>[0-7]{2,3})       | | 
| 9034 |  |  |  |  |  |  | \\c   [\x40-\x5F]          | | 
| 9035 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}  | | 
| 9036 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}  | | 
| 9037 |  |  |  |  |  |  | \\[bBNpP]\{ (?>[^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} | | 
| 9038 |  |  |  |  |  |  | \\  $q_char                | | 
| 9039 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 9040 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 9041 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 9042 |  |  |  |  |  |  | [\$\@] $qq_variable        | | 
| 9043 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)          | | 
| 9044 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 9045 |  |  |  |  |  |  | \$ \$ (?![\w\{])           | | 
| 9046 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 9047 |  |  |  |  |  |  | \[\^                       | | 
| 9048 |  |  |  |  |  |  | \[\:   (?>[a-z]+) :\]      | | 
| 9049 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) :\]      | | 
| 9050 |  |  |  |  |  |  | \(\?                       | | 
| 9051 |  |  |  |  |  |  | $q_char | 
| 9052 |  |  |  |  |  |  | ))/oxmsg; | 
| 9053 | 1587 | 50 |  |  |  | 141411 |  | 
| 9054 | 1587 |  |  |  |  | 17367 | # choice again delimiter | 
|  | 0 |  |  |  |  | 0 |  | 
| 9055 | 0 | 0 |  |  |  | 0 | if ($delimiter =~ / [\@:] /oxms) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 9056 | 0 |  |  |  |  | 0 | my %octet = map {$_ => 1} @char; | 
| 9057 | 0 |  |  |  |  | 0 | if (not $octet{')'}) { | 
| 9058 |  |  |  |  |  |  | $delimiter     = '('; | 
| 9059 |  |  |  |  |  |  | $end_delimiter = ')'; | 
| 9060 | 0 |  |  |  |  | 0 | } | 
| 9061 | 0 |  |  |  |  | 0 | elsif (not $octet{'}'}) { | 
| 9062 |  |  |  |  |  |  | $delimiter     = '{'; | 
| 9063 |  |  |  |  |  |  | $end_delimiter = '}'; | 
| 9064 | 0 |  |  |  |  | 0 | } | 
| 9065 | 0 |  |  |  |  | 0 | elsif (not $octet{']'}) { | 
| 9066 |  |  |  |  |  |  | $delimiter     = '['; | 
| 9067 |  |  |  |  |  |  | $end_delimiter = ']'; | 
| 9068 | 0 |  |  |  |  | 0 | } | 
| 9069 | 0 |  |  |  |  | 0 | elsif (not $octet{'>'}) { | 
| 9070 |  |  |  |  |  |  | $delimiter     = '<'; | 
| 9071 |  |  |  |  |  |  | $end_delimiter = '>'; | 
| 9072 | 0 |  |  |  |  | 0 | } | 
| 9073 | 0 | 0 |  |  |  | 0 | else { | 
| 9074 | 0 |  |  |  |  | 0 | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 9075 | 0 |  |  |  |  | 0 | if (not $octet{$char}) { | 
| 9076 | 0 |  |  |  |  | 0 | $delimiter     = $char; | 
| 9077 |  |  |  |  |  |  | $end_delimiter = $char; | 
| 9078 |  |  |  |  |  |  | last; | 
| 9079 |  |  |  |  |  |  | } | 
| 9080 |  |  |  |  |  |  | } | 
| 9081 |  |  |  |  |  |  | } | 
| 9082 | 0 |  |  |  |  | 0 | } | 
| 9083 | 1587 |  |  |  |  | 2415 |  | 
| 9084 | 1587 |  |  |  |  | 2078 | my $left_e  = 0; | 
| 9085 |  |  |  |  |  |  | my $right_e = 0; | 
| 9086 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 9087 | 1587 | 50 | 66 |  |  | 4545 |  | 
|  |  | 50 | 66 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 9088 | 5514 |  |  |  |  | 28536 | # "\L\u" --> "\u\L" | 
| 9089 |  |  |  |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
| 9090 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 9091 |  |  |  |  |  |  | } | 
| 9092 |  |  |  |  |  |  |  | 
| 9093 | 0 |  |  |  |  | 0 | # "\U\l" --> "\l\U" | 
| 9094 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 9095 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 9096 |  |  |  |  |  |  | } | 
| 9097 |  |  |  |  |  |  |  | 
| 9098 | 0 |  |  |  |  | 0 | # octal escape sequence | 
| 9099 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 9100 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::octchr($1); | 
| 9101 |  |  |  |  |  |  | } | 
| 9102 |  |  |  |  |  |  |  | 
| 9103 | 1 |  |  |  |  | 4 | # hexadecimal escape sequence | 
| 9104 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 9105 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::hexchr($1); | 
| 9106 |  |  |  |  |  |  | } | 
| 9107 |  |  |  |  |  |  |  | 
| 9108 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 9109 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 9110 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 9111 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 9112 | 1 |  |  |  |  | 5 | # \P{PROPERTY} --> P\{PROPERTY} | 
| 9113 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} ) \z/oxms) { | 
| 9114 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 9115 |  |  |  |  |  |  | } | 
| 9116 |  |  |  |  |  |  |  | 
| 9117 | 6 |  |  |  |  | 26 | # \p, \P, \X --> p, P, X | 
| 9118 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 9119 |  |  |  |  |  |  | $char[$i] = $1; | 
| 9120 | 4 | 100 | 100 |  |  | 11 | } | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 9121 |  |  |  |  |  |  |  | 
| 9122 |  |  |  |  |  |  | if (0) { | 
| 9123 |  |  |  |  |  |  | } | 
| 9124 | 5514 |  |  |  |  | 38760 |  | 
| 9125 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 9126 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\? ([\x80-\xFF].*) ($metachar|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 9127 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 9128 |  |  |  |  |  |  | } | 
| 9129 |  |  |  |  |  |  |  | 
| 9130 | 77 | 50 | 33 |  |  | 417 | # join separated multiple-octet | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 9131 | 6 |  |  |  |  | 157 | elsif ($char[$i] =~ /\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 9132 |  |  |  |  |  |  | if (   ($i+3 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+3]) == 3) and (CORE::eval(sprintf '"%s%s%s%s"', @char[$i..$i+3]) =~ /\A $q_char \z/oxms)) { | 
| 9133 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 3; | 
| 9134 | 0 |  |  |  |  | 0 | } | 
| 9135 |  |  |  |  |  |  | elsif (($i+2 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+2]) == 2) and (CORE::eval(sprintf '"%s%s%s"',   @char[$i..$i+2]) =~ /\A $q_char \z/oxms)) { | 
| 9136 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 2; | 
| 9137 | 0 |  |  |  |  | 0 | } | 
| 9138 |  |  |  |  |  |  | elsif (($i+1 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, $char[$i+1      ]) == 1) and (CORE::eval(sprintf '"%s%s"',     @char[$i..$i+1]) =~ /\A $q_char \z/oxms)) { | 
| 9139 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 1; | 
| 9140 |  |  |  |  |  |  | } | 
| 9141 |  |  |  |  |  |  | } | 
| 9142 |  |  |  |  |  |  |  | 
| 9143 | 0 |  |  |  |  | 0 | # open character class [...] | 
| 9144 |  |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 9145 |  |  |  |  |  |  | my $left = $i; | 
| 9146 |  |  |  |  |  |  |  | 
| 9147 |  |  |  |  |  |  | # [] make die "Unmatched [] in regexp ...\n" | 
| 9148 | 586 | 100 |  |  |  | 1047 | # (and so on) | 
| 9149 | 586 |  |  |  |  | 1597 |  | 
| 9150 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 9151 |  |  |  |  |  |  | $i++; | 
| 9152 | 3 |  |  |  |  | 4 | } | 
| 9153 | 586 | 50 |  |  |  | 743 |  | 
| 9154 | 2583 |  |  |  |  | 4153 | while (1) { | 
| 9155 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9156 | 0 | 100 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 9157 | 2583 |  |  |  |  | 4027 | } | 
| 9158 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 9159 |  |  |  |  |  |  | my $right = $i; | 
| 9160 | 586 | 100 |  |  |  | 747 |  | 
| 9161 | 586 |  |  |  |  | 2997 | # [...] | 
|  | 90 |  |  |  |  | 205 |  | 
| 9162 |  |  |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 9163 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
| 9164 | 270 |  |  |  |  | 430 | } | 
| 9165 |  |  |  |  |  |  | else { | 
| 9166 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 9167 | 496 |  |  |  |  | 2112 | } | 
| 9168 | 586 |  |  |  |  | 1077 |  | 
| 9169 |  |  |  |  |  |  | $i = $left; | 
| 9170 |  |  |  |  |  |  | last; | 
| 9171 |  |  |  |  |  |  | } | 
| 9172 |  |  |  |  |  |  | } | 
| 9173 |  |  |  |  |  |  | } | 
| 9174 |  |  |  |  |  |  |  | 
| 9175 | 586 |  |  |  |  | 1933 | # open character class [^...] | 
| 9176 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 9177 |  |  |  |  |  |  | my $left = $i; | 
| 9178 |  |  |  |  |  |  |  | 
| 9179 |  |  |  |  |  |  | # [^] make die "Unmatched [] in regexp ...\n" | 
| 9180 | 328 | 100 |  |  |  | 491 | # (and so on) | 
| 9181 | 328 |  |  |  |  | 693 |  | 
| 9182 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 9183 |  |  |  |  |  |  | $i++; | 
| 9184 | 5 |  |  |  |  | 9 | } | 
| 9185 | 328 | 50 |  |  |  | 460 |  | 
| 9186 | 1447 |  |  |  |  | 2065 | while (1) { | 
| 9187 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9188 | 0 | 100 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 9189 | 1447 |  |  |  |  | 2082 | } | 
| 9190 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 9191 |  |  |  |  |  |  | my $right = $i; | 
| 9192 | 328 | 100 |  |  |  | 370 |  | 
| 9193 | 328 |  |  |  |  | 1999 | # [^...] | 
|  | 90 |  |  |  |  | 209 |  | 
| 9194 |  |  |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 9195 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
| 9196 | 270 |  |  |  |  | 452 | } | 
| 9197 |  |  |  |  |  |  | else { | 
| 9198 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 9199 | 238 |  |  |  |  | 741 | } | 
| 9200 | 328 |  |  |  |  | 689 |  | 
| 9201 |  |  |  |  |  |  | $i = $left; | 
| 9202 |  |  |  |  |  |  | last; | 
| 9203 |  |  |  |  |  |  | } | 
| 9204 |  |  |  |  |  |  | } | 
| 9205 |  |  |  |  |  |  | } | 
| 9206 |  |  |  |  |  |  |  | 
| 9207 | 328 |  |  |  |  | 911 | # rewrite character class or escape character | 
| 9208 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 9209 |  |  |  |  |  |  | $char[$i] = $char; | 
| 9210 |  |  |  |  |  |  | } | 
| 9211 |  |  |  |  |  |  |  | 
| 9212 | 215 | 50 |  |  |  | 572 | # /i modifier | 
| 9213 | 238 |  |  |  |  | 504 | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Ebig5hkscs::uc($char[$i]) ne Ebig5hkscs::fc($char[$i]))) { | 
| 9214 |  |  |  |  |  |  | if (CORE::length(Ebig5hkscs::fc($char[$i])) == 1) { | 
| 9215 |  |  |  |  |  |  | $char[$i] = '['   . Ebig5hkscs::uc($char[$i])       . Ebig5hkscs::fc($char[$i]) . ']'; | 
| 9216 | 238 |  |  |  |  | 499 | } | 
| 9217 |  |  |  |  |  |  | else { | 
| 9218 |  |  |  |  |  |  | $char[$i] = '(?:' . Ebig5hkscs::uc($char[$i]) . '|' . Ebig5hkscs::fc($char[$i]) . ')'; | 
| 9219 |  |  |  |  |  |  | } | 
| 9220 |  |  |  |  |  |  | } | 
| 9221 |  |  |  |  |  |  |  | 
| 9222 | 0 | 50 |  |  |  | 0 | # \u \l \U \L \F \Q \E | 
| 9223 | 1 |  |  |  |  | 5 | elsif ($char[$i] =~ /\A [<>] \z/oxms) { | 
| 9224 |  |  |  |  |  |  | if ($right_e < $left_e) { | 
| 9225 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 9226 |  |  |  |  |  |  | } | 
| 9227 | 0 |  |  |  |  | 0 | } | 
| 9228 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\u') { | 
| 9229 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ucfirst qq<'; | 
| 9230 |  |  |  |  |  |  | $left_e++; | 
| 9231 | 0 |  |  |  |  | 0 | } | 
| 9232 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\l') { | 
| 9233 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lcfirst qq<'; | 
| 9234 |  |  |  |  |  |  | $left_e++; | 
| 9235 | 0 |  |  |  |  | 0 | } | 
| 9236 | 1 |  |  |  |  | 3 | elsif ($char[$i] eq '\U') { | 
| 9237 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::uc qq<'; | 
| 9238 |  |  |  |  |  |  | $left_e++; | 
| 9239 | 1 |  |  |  |  | 4 | } | 
| 9240 | 1 |  |  |  |  | 2 | elsif ($char[$i] eq '\L') { | 
| 9241 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lc qq<'; | 
| 9242 |  |  |  |  |  |  | $left_e++; | 
| 9243 | 1 |  |  |  |  | 4 | } | 
| 9244 | 9 |  |  |  |  | 19 | elsif ($char[$i] eq '\F') { | 
| 9245 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::fc qq<'; | 
| 9246 |  |  |  |  |  |  | $left_e++; | 
| 9247 | 9 |  |  |  |  | 22 | } | 
| 9248 | 22 |  |  |  |  | 43 | elsif ($char[$i] eq '\Q') { | 
| 9249 |  |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 9250 |  |  |  |  |  |  | $left_e++; | 
| 9251 | 22 | 50 |  |  |  | 58 | } | 
| 9252 | 33 |  |  |  |  | 72 | elsif ($char[$i] eq '\E') { | 
| 9253 | 33 |  |  |  |  | 54 | if ($right_e < $left_e) { | 
| 9254 |  |  |  |  |  |  | $char[$i] = '>]}'; | 
| 9255 |  |  |  |  |  |  | $right_e++; | 
| 9256 | 33 |  |  |  |  | 82 | } | 
| 9257 |  |  |  |  |  |  | else { | 
| 9258 |  |  |  |  |  |  | $char[$i] = ''; | 
| 9259 |  |  |  |  |  |  | } | 
| 9260 | 0 |  |  |  |  | 0 | } | 
| 9261 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 9262 | 0 |  |  |  |  | 0 | while (1) { | 
| 9263 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9264 | 0 | 0 |  |  |  | 0 | last; | 
| 9265 | 0 |  |  |  |  | 0 | } | 
| 9266 |  |  |  |  |  |  | if ($char[$i] eq '\E') { | 
| 9267 |  |  |  |  |  |  | last; | 
| 9268 |  |  |  |  |  |  | } | 
| 9269 |  |  |  |  |  |  | } | 
| 9270 |  |  |  |  |  |  | } | 
| 9271 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 9272 |  |  |  |  |  |  | } | 
| 9273 |  |  |  |  |  |  |  | 
| 9274 | 0 | 0 |  |  |  | 0 | # $0 --> $0 | 
| 9275 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 9276 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9277 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9278 |  |  |  |  |  |  | } | 
| 9279 | 0 | 0 |  |  |  | 0 | } | 
| 9280 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 9281 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9282 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9283 |  |  |  |  |  |  | } | 
| 9284 |  |  |  |  |  |  | } | 
| 9285 |  |  |  |  |  |  |  | 
| 9286 |  |  |  |  |  |  | # $$ --> $$ | 
| 9287 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 9288 |  |  |  |  |  |  | } | 
| 9289 |  |  |  |  |  |  |  | 
| 9290 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 9291 | 0 |  |  |  |  | 0 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 9292 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 9293 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 9294 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9295 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9296 |  |  |  |  |  |  | } | 
| 9297 | 0 |  |  |  |  | 0 | } | 
| 9298 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 9299 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 9300 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9301 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9302 |  |  |  |  |  |  | } | 
| 9303 |  |  |  |  |  |  | } | 
| 9304 |  |  |  |  |  |  |  | 
| 9305 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 9306 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 9307 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1.'->'.$2); | 
| 9308 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9309 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9310 |  |  |  |  |  |  | } | 
| 9311 |  |  |  |  |  |  | } | 
| 9312 |  |  |  |  |  |  |  | 
| 9313 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 9314 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 9315 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1.'->'.$2); | 
| 9316 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9317 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9318 |  |  |  |  |  |  | } | 
| 9319 |  |  |  |  |  |  | } | 
| 9320 |  |  |  |  |  |  |  | 
| 9321 | 0 |  |  |  |  | 0 | # $$foo | 
| 9322 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 9323 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 9324 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9325 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9326 |  |  |  |  |  |  | } | 
| 9327 |  |  |  |  |  |  | } | 
| 9328 |  |  |  |  |  |  |  | 
| 9329 | 0 | 50 |  |  |  | 0 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5hkscs::PREMATCH() | 
| 9330 | 8 |  |  |  |  | 24 | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 9331 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9332 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::PREMATCH())]}'; | 
| 9333 | 0 |  |  |  |  | 0 | } | 
| 9334 |  |  |  |  |  |  | else { | 
| 9335 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::PREMATCH()]}'; | 
| 9336 |  |  |  |  |  |  | } | 
| 9337 |  |  |  |  |  |  | } | 
| 9338 |  |  |  |  |  |  |  | 
| 9339 | 8 | 50 |  |  |  | 23 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5hkscs::MATCH() | 
| 9340 | 8 |  |  |  |  | 24 | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 9341 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9342 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::MATCH())]}'; | 
| 9343 | 0 |  |  |  |  | 0 | } | 
| 9344 |  |  |  |  |  |  | else { | 
| 9345 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::MATCH()]}'; | 
| 9346 |  |  |  |  |  |  | } | 
| 9347 |  |  |  |  |  |  | } | 
| 9348 |  |  |  |  |  |  |  | 
| 9349 | 8 | 50 |  |  |  | 28 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5hkscs::POSTMATCH() | 
| 9350 | 6 |  |  |  |  | 20 | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 9351 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9352 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::POSTMATCH())]}'; | 
| 9353 | 0 |  |  |  |  | 0 | } | 
| 9354 |  |  |  |  |  |  | else { | 
| 9355 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::POSTMATCH()]}'; | 
| 9356 |  |  |  |  |  |  | } | 
| 9357 |  |  |  |  |  |  | } | 
| 9358 |  |  |  |  |  |  |  | 
| 9359 | 6 | 0 |  |  |  | 18 | # ${ foo } | 
| 9360 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \}                              \z/oxms) { | 
| 9361 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9362 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9363 |  |  |  |  |  |  | } | 
| 9364 |  |  |  |  |  |  | } | 
| 9365 |  |  |  |  |  |  |  | 
| 9366 | 0 |  |  |  |  | 0 | # ${ ... } | 
| 9367 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 9368 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 9369 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9370 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9371 |  |  |  |  |  |  | } | 
| 9372 |  |  |  |  |  |  | } | 
| 9373 |  |  |  |  |  |  |  | 
| 9374 | 0 |  |  |  |  | 0 | # $scalar or @array | 
| 9375 | 31 | 100 |  |  |  | 121 | elsif ($char[$i] =~ /\A [\$\@].+ /oxms) { | 
| 9376 | 31 |  |  |  |  | 116 | $char[$i] = e_string($char[$i]); | 
| 9377 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9378 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9379 |  |  |  |  |  |  | } | 
| 9380 |  |  |  |  |  |  | } | 
| 9381 |  |  |  |  |  |  |  | 
| 9382 | 4 | 100 | 66 |  |  | 18 | # quote character before ? + * { | 
|  |  | 50 |  |  |  |  |  | 
| 9383 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 9384 |  |  |  |  |  |  | if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) { | 
| 9385 | 188 |  |  |  |  | 1992 | } | 
| 9386 | 0 | 0 |  |  |  | 0 | elsif (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 9387 | 0 |  |  |  |  | 0 | my $char = $char[$i-1]; | 
| 9388 |  |  |  |  |  |  | if ($char[$i] eq '{') { | 
| 9389 |  |  |  |  |  |  | die __FILE__, qq{: "MULTIBYTE{n}" should be "(MULTIBYTE){n}" in m?? (and shift \$1,\$2,\$3,...) ($char){n}\n}; | 
| 9390 | 0 |  |  |  |  | 0 | } | 
| 9391 |  |  |  |  |  |  | else { | 
| 9392 |  |  |  |  |  |  | die __FILE__, qq{: "MULTIBYTE$char[$i]" should be "(MULTIBYTE)$char[$i]" in m?? (and shift \$1,\$2,\$3,...) ($char)$char[$i]\n}; | 
| 9393 |  |  |  |  |  |  | } | 
| 9394 | 0 |  |  |  |  | 0 | } | 
| 9395 |  |  |  |  |  |  | else { | 
| 9396 |  |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 9397 |  |  |  |  |  |  | } | 
| 9398 |  |  |  |  |  |  | } | 
| 9399 |  |  |  |  |  |  | } | 
| 9400 | 187 |  |  |  |  | 838 |  | 
| 9401 | 1587 | 50 |  |  |  | 3182 | # make regexp string | 
| 9402 | 1587 | 0 | 0 |  |  | 3419 | $modifier =~ tr/i//d; | 
| 9403 | 0 |  |  |  |  | 0 | if ($left_e > $right_e) { | 
| 9404 |  |  |  |  |  |  | if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 9405 |  |  |  |  |  |  | return join '', $ope, $delimiter, $anchor,        @char, '>]}' x ($left_e - $right_e),      $matched, $end_delimiter, $modifier; | 
| 9406 | 0 |  |  |  |  | 0 | } | 
| 9407 |  |  |  |  |  |  | else { | 
| 9408 |  |  |  |  |  |  | return join '', $ope, $delimiter, $anchor, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier; | 
| 9409 | 0 | 100 | 100 |  |  | 0 | } | 
| 9410 | 1587 |  |  |  |  | 8912 | } | 
| 9411 |  |  |  |  |  |  | if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 9412 |  |  |  |  |  |  | return     join '', $ope, $delimiter, $anchor,        @char,                                    $matched, $end_delimiter, $modifier; | 
| 9413 | 94 |  |  |  |  | 840 | } | 
| 9414 |  |  |  |  |  |  | else { | 
| 9415 |  |  |  |  |  |  | return     join '', $ope, $delimiter, $anchor, '(?:', @char,                               ')', $matched, $end_delimiter, $modifier; | 
| 9416 |  |  |  |  |  |  | } | 
| 9417 |  |  |  |  |  |  | } | 
| 9418 |  |  |  |  |  |  |  | 
| 9419 |  |  |  |  |  |  | # | 
| 9420 |  |  |  |  |  |  | # double quote stuff | 
| 9421 | 1493 |  |  | 540 | 0 | 12936 | # | 
| 9422 |  |  |  |  |  |  | sub qq_stuff { | 
| 9423 |  |  |  |  |  |  | my($delimiter,$end_delimiter,$stuff) = @_; | 
| 9424 | 540 | 100 |  |  |  | 948 |  | 
| 9425 | 540 |  |  |  |  | 1213 | # scalar variable or array variable | 
| 9426 |  |  |  |  |  |  | if ($stuff =~ /\A [\$\@] /oxms) { | 
| 9427 |  |  |  |  |  |  | return $stuff; | 
| 9428 |  |  |  |  |  |  | } | 
| 9429 | 300 |  |  |  |  | 1008 |  | 
|  | 240 |  |  |  |  | 629 |  | 
| 9430 | 280 |  |  |  |  | 758 | # quote by delimiter | 
| 9431 | 240 | 50 |  |  |  | 722 | my %octet = map {$_ => 1} ($stuff =~ /\G ([\x00-\xFF]) /oxmsg); | 
| 9432 | 240 | 50 |  |  |  | 395 | for my $char (qw( ! " $ % & * + - . / : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 9433 | 240 | 50 |  |  |  | 344 | next if $char eq $delimiter; | 
| 9434 | 240 |  |  |  |  | 415 | next if $char eq $end_delimiter; | 
| 9435 |  |  |  |  |  |  | if (not $octet{$char}) { | 
| 9436 |  |  |  |  |  |  | return join '', 'qq', $char, $stuff, $char; | 
| 9437 | 240 |  |  |  |  | 888 | } | 
| 9438 |  |  |  |  |  |  | } | 
| 9439 |  |  |  |  |  |  | return join '', 'qq', '<', $stuff, '>'; | 
| 9440 |  |  |  |  |  |  | } | 
| 9441 |  |  |  |  |  |  |  | 
| 9442 |  |  |  |  |  |  | # | 
| 9443 |  |  |  |  |  |  | # escape regexp (m'', qr'', and m''b, qr''b) | 
| 9444 | 0 |  |  | 163 | 0 | 0 | # | 
| 9445 | 163 |  | 100 |  |  | 840 | sub e_qr_q { | 
| 9446 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 9447 | 163 |  |  |  |  | 520 | $modifier ||= ''; | 
| 9448 | 163 | 50 |  |  |  | 285 |  | 
| 9449 | 163 |  |  |  |  | 500 | $modifier =~ tr/p//d; | 
| 9450 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 9451 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 9452 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 9453 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 9454 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 9455 |  |  |  |  |  |  | last; | 
| 9456 | 0 |  |  |  |  | 0 | } | 
| 9457 |  |  |  |  |  |  | } | 
| 9458 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 9459 | 0 |  |  |  |  | 0 | } | 
| 9460 |  |  |  |  |  |  |  | 
| 9461 |  |  |  |  |  |  | $slash = 'div'; | 
| 9462 | 163 | 100 |  |  |  | 268 |  | 
|  |  | 100 |  |  |  |  |  | 
| 9463 | 163 |  |  |  |  | 438 | # literal null string pattern | 
| 9464 | 8 |  |  |  |  | 11 | if ($string eq '') { | 
| 9465 | 8 |  |  |  |  | 9 | $modifier =~ tr/bB//d; | 
| 9466 |  |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 9467 |  |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 9468 |  |  |  |  |  |  | } | 
| 9469 |  |  |  |  |  |  |  | 
| 9470 | 8 |  |  |  |  | 38 | # with /b /B modifier | 
| 9471 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 9472 |  |  |  |  |  |  | return e_qr_qb($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 9473 |  |  |  |  |  |  | } | 
| 9474 |  |  |  |  |  |  |  | 
| 9475 | 89 |  |  |  |  | 242 | # without /b /B modifier | 
| 9476 |  |  |  |  |  |  | else { | 
| 9477 |  |  |  |  |  |  | return e_qr_qt($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 9478 |  |  |  |  |  |  | } | 
| 9479 |  |  |  |  |  |  | } | 
| 9480 |  |  |  |  |  |  |  | 
| 9481 |  |  |  |  |  |  | # | 
| 9482 |  |  |  |  |  |  | # escape regexp (m'', qr'') | 
| 9483 | 66 |  |  | 66 | 0 | 213 | # | 
| 9484 |  |  |  |  |  |  | sub e_qr_qt { | 
| 9485 | 66 | 100 |  |  |  | 171 | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 9486 |  |  |  |  |  |  |  | 
| 9487 |  |  |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 9488 | 66 |  |  |  |  | 186 |  | 
| 9489 |  |  |  |  |  |  | # split regexp | 
| 9490 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 9491 |  |  |  |  |  |  | [^\x81-\xFE\\\[\$\@\/] | | 
| 9492 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 9493 |  |  |  |  |  |  | \[\^                            | | 
| 9494 |  |  |  |  |  |  | \[\:   (?>[a-z]+) \:\]          | | 
| 9495 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) \:\]          | | 
| 9496 |  |  |  |  |  |  | [\$\@\/]                        | | 
| 9497 |  |  |  |  |  |  | \\     (?:$q_char)              | | 
| 9498 |  |  |  |  |  |  | (?:$q_char) | 
| 9499 |  |  |  |  |  |  | ))/oxmsg; | 
| 9500 | 66 |  |  |  |  | 692 |  | 
| 9501 | 66 | 100 | 100 |  |  | 241 | # unescape character | 
|  |  | 50 | 100 |  |  |  |  | 
|  |  | 50 | 66 |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 9502 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 9503 |  |  |  |  |  |  | if (0) { | 
| 9504 |  |  |  |  |  |  | } | 
| 9505 | 79 |  |  |  |  | 918 |  | 
| 9506 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 9507 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 9508 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 9509 |  |  |  |  |  |  | } | 
| 9510 |  |  |  |  |  |  |  | 
| 9511 | 2 |  |  |  |  | 13 | # open character class [...] | 
| 9512 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[') { | 
| 9513 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 9514 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 9515 | 0 |  |  |  |  | 0 | $i++; | 
| 9516 | 0 | 0 |  |  |  | 0 | } | 
| 9517 | 0 |  |  |  |  | 0 | while (1) { | 
| 9518 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9519 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 9520 | 0 |  |  |  |  | 0 | } | 
| 9521 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 9522 |  |  |  |  |  |  | my $right = $i; | 
| 9523 | 0 |  |  |  |  | 0 |  | 
| 9524 |  |  |  |  |  |  | # [...] | 
| 9525 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 9526 | 0 |  |  |  |  | 0 |  | 
| 9527 |  |  |  |  |  |  | $i = $left; | 
| 9528 |  |  |  |  |  |  | last; | 
| 9529 |  |  |  |  |  |  | } | 
| 9530 |  |  |  |  |  |  | } | 
| 9531 |  |  |  |  |  |  | } | 
| 9532 |  |  |  |  |  |  |  | 
| 9533 | 0 |  |  |  |  | 0 | # open character class [^...] | 
| 9534 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[^') { | 
| 9535 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 9536 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 9537 | 0 |  |  |  |  | 0 | $i++; | 
| 9538 | 0 | 0 |  |  |  | 0 | } | 
| 9539 | 0 |  |  |  |  | 0 | while (1) { | 
| 9540 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9541 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 9542 | 0 |  |  |  |  | 0 | } | 
| 9543 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 9544 |  |  |  |  |  |  | my $right = $i; | 
| 9545 | 0 |  |  |  |  | 0 |  | 
| 9546 |  |  |  |  |  |  | # [^...] | 
| 9547 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 9548 | 0 |  |  |  |  | 0 |  | 
| 9549 |  |  |  |  |  |  | $i = $left; | 
| 9550 |  |  |  |  |  |  | last; | 
| 9551 |  |  |  |  |  |  | } | 
| 9552 |  |  |  |  |  |  | } | 
| 9553 |  |  |  |  |  |  | } | 
| 9554 |  |  |  |  |  |  |  | 
| 9555 | 0 |  |  |  |  | 0 | # escape $ @ / and \ | 
| 9556 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 9557 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 9558 |  |  |  |  |  |  | } | 
| 9559 |  |  |  |  |  |  |  | 
| 9560 | 0 |  |  |  |  | 0 | # rewrite character class or escape character | 
| 9561 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 9562 |  |  |  |  |  |  | $char[$i] = $char; | 
| 9563 |  |  |  |  |  |  | } | 
| 9564 |  |  |  |  |  |  |  | 
| 9565 | 0 | 50 |  |  |  | 0 | # /i modifier | 
| 9566 | 16 |  |  |  |  | 41 | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Ebig5hkscs::uc($char[$i]) ne Ebig5hkscs::fc($char[$i]))) { | 
| 9567 |  |  |  |  |  |  | if (CORE::length(Ebig5hkscs::fc($char[$i])) == 1) { | 
| 9568 |  |  |  |  |  |  | $char[$i] = '['   . Ebig5hkscs::uc($char[$i])       . Ebig5hkscs::fc($char[$i]) . ']'; | 
| 9569 | 16 |  |  |  |  | 39 | } | 
| 9570 |  |  |  |  |  |  | else { | 
| 9571 |  |  |  |  |  |  | $char[$i] = '(?:' . Ebig5hkscs::uc($char[$i]) . '|' . Ebig5hkscs::fc($char[$i]) . ')'; | 
| 9572 |  |  |  |  |  |  | } | 
| 9573 |  |  |  |  |  |  | } | 
| 9574 |  |  |  |  |  |  |  | 
| 9575 | 0 | 0 |  |  |  | 0 | # quote character before ? + * { | 
| 9576 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 9577 |  |  |  |  |  |  | if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 9578 | 0 |  |  |  |  | 0 | } | 
| 9579 |  |  |  |  |  |  | else { | 
| 9580 |  |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 9581 |  |  |  |  |  |  | } | 
| 9582 |  |  |  |  |  |  | } | 
| 9583 | 0 |  |  |  |  | 0 | } | 
| 9584 | 66 |  |  |  |  | 143 |  | 
| 9585 |  |  |  |  |  |  | $delimiter     = '/'; | 
| 9586 | 66 |  |  |  |  | 83 | $end_delimiter = '/'; | 
| 9587 | 66 |  |  |  |  | 112 |  | 
| 9588 |  |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 9589 |  |  |  |  |  |  | return join '', $ope, $delimiter, $anchor, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 9590 |  |  |  |  |  |  | } | 
| 9591 |  |  |  |  |  |  |  | 
| 9592 |  |  |  |  |  |  | # | 
| 9593 |  |  |  |  |  |  | # escape regexp (m''b, qr''b) | 
| 9594 | 66 |  |  | 89 | 0 | 456 | # | 
| 9595 |  |  |  |  |  |  | sub e_qr_qb { | 
| 9596 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 9597 | 89 |  |  |  |  | 229 |  | 
| 9598 |  |  |  |  |  |  | # split regexp | 
| 9599 |  |  |  |  |  |  | my @char = $string =~ /\G ((?>[^\\]|\\\\|[\x00-\xFF])) /oxmsg; | 
| 9600 | 89 |  |  |  |  | 379 |  | 
| 9601 | 89 | 50 |  |  |  | 267 | # unescape character | 
|  |  | 50 |  |  |  |  |  | 
| 9602 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 9603 |  |  |  |  |  |  | if (0) { | 
| 9604 |  |  |  |  |  |  | } | 
| 9605 | 199 |  |  |  |  | 662 |  | 
| 9606 |  |  |  |  |  |  | # remain \\ | 
| 9607 |  |  |  |  |  |  | elsif ($char[$i] eq '\\\\') { | 
| 9608 |  |  |  |  |  |  | } | 
| 9609 |  |  |  |  |  |  |  | 
| 9610 | 0 |  |  |  |  | 0 | # escape $ @ / and \ | 
| 9611 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 9612 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 9613 |  |  |  |  |  |  | } | 
| 9614 | 0 |  |  |  |  | 0 | } | 
| 9615 | 89 |  |  |  |  | 147 |  | 
| 9616 | 89 |  |  |  |  | 114 | $delimiter     = '/'; | 
| 9617 |  |  |  |  |  |  | $end_delimiter = '/'; | 
| 9618 |  |  |  |  |  |  | return join '', $ope, $delimiter, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 9619 |  |  |  |  |  |  | } | 
| 9620 |  |  |  |  |  |  |  | 
| 9621 |  |  |  |  |  |  | # | 
| 9622 |  |  |  |  |  |  | # escape regexp (s/here//) | 
| 9623 | 89 |  |  | 194 | 0 | 523 | # | 
| 9624 | 194 |  | 100 |  |  | 563 | sub e_s1 { | 
| 9625 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 9626 | 194 |  |  |  |  | 703 | $modifier ||= ''; | 
| 9627 | 194 | 50 |  |  |  | 318 |  | 
| 9628 | 194 |  |  |  |  | 684 | $modifier =~ tr/p//d; | 
| 9629 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 9630 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 9631 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 9632 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 9633 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 9634 |  |  |  |  |  |  | last; | 
| 9635 | 0 |  |  |  |  | 0 | } | 
| 9636 |  |  |  |  |  |  | } | 
| 9637 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 9638 | 0 |  |  |  |  | 0 | } | 
| 9639 |  |  |  |  |  |  |  | 
| 9640 |  |  |  |  |  |  | $slash = 'div'; | 
| 9641 | 194 | 100 |  |  |  | 323 |  | 
|  |  | 100 |  |  |  |  |  | 
| 9642 | 194 |  |  |  |  | 707 | # literal null string pattern | 
| 9643 | 8 |  |  |  |  | 9 | if ($string eq '') { | 
| 9644 | 8 |  |  |  |  | 9 | $modifier =~ tr/bB//d; | 
| 9645 |  |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 9646 |  |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 9647 |  |  |  |  |  |  | } | 
| 9648 |  |  |  |  |  |  |  | 
| 9649 |  |  |  |  |  |  | # /b /B modifier | 
| 9650 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 9651 | 8 | 50 |  |  |  | 52 |  | 
| 9652 | 44 |  |  |  |  | 84 | # choice again delimiter | 
| 9653 | 0 |  |  |  |  | 0 | if ($delimiter =~ / [\@:] /oxms) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 9654 | 0 | 0 |  |  |  | 0 | my @char = $string =~ /\G ([\x00-\xFF]) /oxmsg; | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 9655 | 0 |  |  |  |  | 0 | my %octet = map {$_ => 1} @char; | 
| 9656 | 0 |  |  |  |  | 0 | if (not $octet{')'}) { | 
| 9657 |  |  |  |  |  |  | $delimiter     = '('; | 
| 9658 |  |  |  |  |  |  | $end_delimiter = ')'; | 
| 9659 | 0 |  |  |  |  | 0 | } | 
| 9660 | 0 |  |  |  |  | 0 | elsif (not $octet{'}'}) { | 
| 9661 |  |  |  |  |  |  | $delimiter     = '{'; | 
| 9662 |  |  |  |  |  |  | $end_delimiter = '}'; | 
| 9663 | 0 |  |  |  |  | 0 | } | 
| 9664 | 0 |  |  |  |  | 0 | elsif (not $octet{']'}) { | 
| 9665 |  |  |  |  |  |  | $delimiter     = '['; | 
| 9666 |  |  |  |  |  |  | $end_delimiter = ']'; | 
| 9667 | 0 |  |  |  |  | 0 | } | 
| 9668 | 0 |  |  |  |  | 0 | elsif (not $octet{'>'}) { | 
| 9669 |  |  |  |  |  |  | $delimiter     = '<'; | 
| 9670 |  |  |  |  |  |  | $end_delimiter = '>'; | 
| 9671 | 0 |  |  |  |  | 0 | } | 
| 9672 | 0 | 0 |  |  |  | 0 | else { | 
| 9673 | 0 |  |  |  |  | 0 | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 9674 | 0 |  |  |  |  | 0 | if (not $octet{$char}) { | 
| 9675 | 0 |  |  |  |  | 0 | $delimiter     = $char; | 
| 9676 |  |  |  |  |  |  | $end_delimiter = $char; | 
| 9677 |  |  |  |  |  |  | last; | 
| 9678 |  |  |  |  |  |  | } | 
| 9679 |  |  |  |  |  |  | } | 
| 9680 |  |  |  |  |  |  | } | 
| 9681 | 0 |  |  |  |  | 0 | } | 
| 9682 | 44 |  |  |  |  | 53 |  | 
| 9683 | 44 |  |  |  |  | 52 | my $prematch = ''; | 
| 9684 |  |  |  |  |  |  | $prematch = q{(\G[\x00-\xFF]*?)}; | 
| 9685 |  |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', $string, ')', $matched, $end_delimiter, $modifier; | 
| 9686 | 44 | 100 |  |  |  | 272 | } | 
| 9687 | 142 |  |  |  |  | 473 |  | 
| 9688 |  |  |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 9689 |  |  |  |  |  |  | my $metachar = qr/[\@\\|[\]{^]/oxms; | 
| 9690 | 142 |  |  |  |  | 601 |  | 
| 9691 |  |  |  |  |  |  | # split regexp | 
| 9692 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 9693 |  |  |  |  |  |  | [^\x81-\xFE\\\$\@\[\(]|[\x81-\xFE][\x00-\xFF] | | 
| 9694 |  |  |  |  |  |  | \\                               (?>[1-9][0-9]*)            | | 
| 9695 |  |  |  |  |  |  | \\g (?>\s*)                      (?>[1-9][0-9]*)            | | 
| 9696 |  |  |  |  |  |  | \\g (?>\s*) \{ (?>\s*)           (?>[1-9][0-9]*) (?>\s*) \} | | 
| 9697 |  |  |  |  |  |  | \\g (?>\s*) \{ (?>\s*) - (?>\s*) (?>[1-9][0-9]*) (?>\s*) \} | | 
| 9698 |  |  |  |  |  |  | \\x                              (?>[0-9A-Fa-f]{1,2})       | | 
| 9699 |  |  |  |  |  |  | \\                               (?>[0-7]{2,3})             | | 
| 9700 |  |  |  |  |  |  | \\c                              [\x40-\x5F]                | | 
| 9701 |  |  |  |  |  |  | \\x\{                            (?>[0-9A-Fa-f]+)        \} | | 
| 9702 |  |  |  |  |  |  | \\o\{                            (?>[0-7]+)              \} | | 
| 9703 |  |  |  |  |  |  | \\[bBNpP]\{                      (?>[^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} | | 
| 9704 |  |  |  |  |  |  | \\ $q_char                           | | 
| 9705 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 9706 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 9707 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 9708 |  |  |  |  |  |  | [\$\@] $qq_variable                  | | 
| 9709 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)                    | | 
| 9710 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 9711 |  |  |  |  |  |  | \$ \$ (?![\w\{])                     | | 
| 9712 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 9713 |  |  |  |  |  |  | \[\^                                 | | 
| 9714 |  |  |  |  |  |  | \[\:   (?>[a-z]+) :\]                | | 
| 9715 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) :\]                | | 
| 9716 |  |  |  |  |  |  | \(\?                                 | | 
| 9717 |  |  |  |  |  |  | $q_char | 
| 9718 |  |  |  |  |  |  | ))/oxmsg; | 
| 9719 | 142 | 50 |  |  |  | 64686 |  | 
| 9720 | 142 |  |  |  |  | 1124 | # choice again delimiter | 
|  | 0 |  |  |  |  | 0 |  | 
| 9721 | 0 | 0 |  |  |  | 0 | if ($delimiter =~ / [\@:] /oxms) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 9722 | 0 |  |  |  |  | 0 | my %octet = map {$_ => 1} @char; | 
| 9723 | 0 |  |  |  |  | 0 | if (not $octet{')'}) { | 
| 9724 |  |  |  |  |  |  | $delimiter     = '('; | 
| 9725 |  |  |  |  |  |  | $end_delimiter = ')'; | 
| 9726 | 0 |  |  |  |  | 0 | } | 
| 9727 | 0 |  |  |  |  | 0 | elsif (not $octet{'}'}) { | 
| 9728 |  |  |  |  |  |  | $delimiter     = '{'; | 
| 9729 |  |  |  |  |  |  | $end_delimiter = '}'; | 
| 9730 | 0 |  |  |  |  | 0 | } | 
| 9731 | 0 |  |  |  |  | 0 | elsif (not $octet{']'}) { | 
| 9732 |  |  |  |  |  |  | $delimiter     = '['; | 
| 9733 |  |  |  |  |  |  | $end_delimiter = ']'; | 
| 9734 | 0 |  |  |  |  | 0 | } | 
| 9735 | 0 |  |  |  |  | 0 | elsif (not $octet{'>'}) { | 
| 9736 |  |  |  |  |  |  | $delimiter     = '<'; | 
| 9737 |  |  |  |  |  |  | $end_delimiter = '>'; | 
| 9738 | 0 |  |  |  |  | 0 | } | 
| 9739 | 0 | 0 |  |  |  | 0 | else { | 
| 9740 | 0 |  |  |  |  | 0 | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 9741 | 0 |  |  |  |  | 0 | if (not $octet{$char}) { | 
| 9742 | 0 |  |  |  |  | 0 | $delimiter     = $char; | 
| 9743 |  |  |  |  |  |  | $end_delimiter = $char; | 
| 9744 |  |  |  |  |  |  | last; | 
| 9745 |  |  |  |  |  |  | } | 
| 9746 |  |  |  |  |  |  | } | 
| 9747 |  |  |  |  |  |  | } | 
| 9748 |  |  |  |  |  |  | } | 
| 9749 | 0 |  |  |  |  | 0 |  | 
|  | 142 |  |  |  |  | 324 |  | 
| 9750 |  |  |  |  |  |  | # count '(' | 
| 9751 | 476 |  |  |  |  | 925 | my $parens = grep { $_ eq '(' } @char; | 
| 9752 | 142 |  |  |  |  | 240 |  | 
| 9753 | 142 |  |  |  |  | 243 | my $left_e  = 0; | 
| 9754 |  |  |  |  |  |  | my $right_e = 0; | 
| 9755 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 9756 | 142 | 50 | 33 |  |  | 418 |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 9757 | 397 |  |  |  |  | 2506 | # "\L\u" --> "\u\L" | 
| 9758 |  |  |  |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
| 9759 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 9760 |  |  |  |  |  |  | } | 
| 9761 |  |  |  |  |  |  |  | 
| 9762 | 0 |  |  |  |  | 0 | # "\U\l" --> "\l\U" | 
| 9763 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 9764 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 9765 |  |  |  |  |  |  | } | 
| 9766 |  |  |  |  |  |  |  | 
| 9767 | 0 |  |  |  |  | 0 | # octal escape sequence | 
| 9768 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 9769 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::octchr($1); | 
| 9770 |  |  |  |  |  |  | } | 
| 9771 |  |  |  |  |  |  |  | 
| 9772 | 1 |  |  |  |  | 4 | # hexadecimal escape sequence | 
| 9773 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 9774 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::hexchr($1); | 
| 9775 |  |  |  |  |  |  | } | 
| 9776 |  |  |  |  |  |  |  | 
| 9777 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 9778 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 9779 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 9780 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 9781 | 1 |  |  |  |  | 5 | # \P{PROPERTY} --> P\{PROPERTY} | 
| 9782 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} ) \z/oxms) { | 
| 9783 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 9784 |  |  |  |  |  |  | } | 
| 9785 |  |  |  |  |  |  |  | 
| 9786 | 0 |  |  |  |  | 0 | # \p, \P, \X --> p, P, X | 
| 9787 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 9788 |  |  |  |  |  |  | $char[$i] = $1; | 
| 9789 | 0 | 100 | 100 |  |  | 0 | } | 
|  |  | 50 | 100 |  |  |  |  | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 9790 |  |  |  |  |  |  |  | 
| 9791 |  |  |  |  |  |  | if (0) { | 
| 9792 |  |  |  |  |  |  | } | 
| 9793 | 397 |  |  |  |  | 4440 |  | 
| 9794 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 9795 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\? ([\x80-\xFF].*) ($metachar|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 9796 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 9797 |  |  |  |  |  |  | } | 
| 9798 |  |  |  |  |  |  |  | 
| 9799 | 23 | 0 | 0 |  |  | 117 | # join separated multiple-octet | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 9800 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 9801 |  |  |  |  |  |  | if (   ($i+3 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+3]) == 3) and (CORE::eval(sprintf '"%s%s%s%s"', @char[$i..$i+3]) =~ /\A $q_char \z/oxms)) { | 
| 9802 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 3; | 
| 9803 | 0 |  |  |  |  | 0 | } | 
| 9804 |  |  |  |  |  |  | elsif (($i+2 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+2]) == 2) and (CORE::eval(sprintf '"%s%s%s"',   @char[$i..$i+2]) =~ /\A $q_char \z/oxms)) { | 
| 9805 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 2; | 
| 9806 | 0 |  |  |  |  | 0 | } | 
| 9807 |  |  |  |  |  |  | elsif (($i+1 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, $char[$i+1      ]) == 1) and (CORE::eval(sprintf '"%s%s"',     @char[$i..$i+1]) =~ /\A $q_char \z/oxms)) { | 
| 9808 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 1; | 
| 9809 |  |  |  |  |  |  | } | 
| 9810 |  |  |  |  |  |  | } | 
| 9811 |  |  |  |  |  |  |  | 
| 9812 | 0 |  |  |  |  | 0 | # open character class [...] | 
| 9813 | 20 | 50 |  |  |  | 44 | elsif ($char[$i] eq '[') { | 
| 9814 | 20 |  |  |  |  | 67 | my $left = $i; | 
| 9815 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 9816 | 0 |  |  |  |  | 0 | $i++; | 
| 9817 | 20 | 50 |  |  |  | 41 | } | 
| 9818 | 79 |  |  |  |  | 137 | while (1) { | 
| 9819 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9820 | 0 | 100 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 9821 | 79 |  |  |  |  | 223 | } | 
| 9822 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 9823 |  |  |  |  |  |  | my $right = $i; | 
| 9824 | 20 | 50 |  |  |  | 43 |  | 
| 9825 | 20 |  |  |  |  | 151 | # [...] | 
|  | 0 |  |  |  |  | 0 |  | 
| 9826 |  |  |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 9827 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
| 9828 | 0 |  |  |  |  | 0 | } | 
| 9829 |  |  |  |  |  |  | else { | 
| 9830 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 9831 | 20 |  |  |  |  | 155 | } | 
| 9832 | 20 |  |  |  |  | 43 |  | 
| 9833 |  |  |  |  |  |  | $i = $left; | 
| 9834 |  |  |  |  |  |  | last; | 
| 9835 |  |  |  |  |  |  | } | 
| 9836 |  |  |  |  |  |  | } | 
| 9837 |  |  |  |  |  |  | } | 
| 9838 |  |  |  |  |  |  |  | 
| 9839 | 20 |  |  |  |  | 66 | # open character class [^...] | 
| 9840 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[^') { | 
| 9841 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 9842 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 9843 | 0 |  |  |  |  | 0 | $i++; | 
| 9844 | 0 | 0 |  |  |  | 0 | } | 
| 9845 | 0 |  |  |  |  | 0 | while (1) { | 
| 9846 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9847 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 9848 | 0 |  |  |  |  | 0 | } | 
| 9849 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 9850 |  |  |  |  |  |  | my $right = $i; | 
| 9851 | 0 | 0 |  |  |  | 0 |  | 
| 9852 | 0 |  |  |  |  | 0 | # [^...] | 
|  | 0 |  |  |  |  | 0 |  | 
| 9853 |  |  |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 9854 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
| 9855 | 0 |  |  |  |  | 0 | } | 
| 9856 |  |  |  |  |  |  | else { | 
| 9857 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 9858 | 0 |  |  |  |  | 0 | } | 
| 9859 | 0 |  |  |  |  | 0 |  | 
| 9860 |  |  |  |  |  |  | $i = $left; | 
| 9861 |  |  |  |  |  |  | last; | 
| 9862 |  |  |  |  |  |  | } | 
| 9863 |  |  |  |  |  |  | } | 
| 9864 |  |  |  |  |  |  | } | 
| 9865 |  |  |  |  |  |  |  | 
| 9866 | 0 |  |  |  |  | 0 | # rewrite character class or escape character | 
| 9867 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 9868 |  |  |  |  |  |  | $char[$i] = $char; | 
| 9869 |  |  |  |  |  |  | } | 
| 9870 |  |  |  |  |  |  |  | 
| 9871 | 11 | 50 |  |  |  | 29 | # /i modifier | 
| 9872 | 11 |  |  |  |  | 25 | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Ebig5hkscs::uc($char[$i]) ne Ebig5hkscs::fc($char[$i]))) { | 
| 9873 |  |  |  |  |  |  | if (CORE::length(Ebig5hkscs::fc($char[$i])) == 1) { | 
| 9874 |  |  |  |  |  |  | $char[$i] = '['   . Ebig5hkscs::uc($char[$i])       . Ebig5hkscs::fc($char[$i]) . ']'; | 
| 9875 | 11 |  |  |  |  | 33 | } | 
| 9876 |  |  |  |  |  |  | else { | 
| 9877 |  |  |  |  |  |  | $char[$i] = '(?:' . Ebig5hkscs::uc($char[$i]) . '|' . Ebig5hkscs::fc($char[$i]) . ')'; | 
| 9878 |  |  |  |  |  |  | } | 
| 9879 |  |  |  |  |  |  | } | 
| 9880 |  |  |  |  |  |  |  | 
| 9881 | 0 | 50 |  |  |  | 0 | # \u \l \U \L \F \Q \E | 
| 9882 | 8 |  |  |  |  | 25 | elsif ($char[$i] =~ /\A [<>] \z/oxms) { | 
| 9883 |  |  |  |  |  |  | if ($right_e < $left_e) { | 
| 9884 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 9885 |  |  |  |  |  |  | } | 
| 9886 | 0 |  |  |  |  | 0 | } | 
| 9887 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\u') { | 
| 9888 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ucfirst qq<'; | 
| 9889 |  |  |  |  |  |  | $left_e++; | 
| 9890 | 0 |  |  |  |  | 0 | } | 
| 9891 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\l') { | 
| 9892 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lcfirst qq<'; | 
| 9893 |  |  |  |  |  |  | $left_e++; | 
| 9894 | 0 |  |  |  |  | 0 | } | 
| 9895 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\U') { | 
| 9896 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::uc qq<'; | 
| 9897 |  |  |  |  |  |  | $left_e++; | 
| 9898 | 0 |  |  |  |  | 0 | } | 
| 9899 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\L') { | 
| 9900 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lc qq<'; | 
| 9901 |  |  |  |  |  |  | $left_e++; | 
| 9902 | 0 |  |  |  |  | 0 | } | 
| 9903 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\F') { | 
| 9904 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::fc qq<'; | 
| 9905 |  |  |  |  |  |  | $left_e++; | 
| 9906 | 0 |  |  |  |  | 0 | } | 
| 9907 | 7 |  |  |  |  | 17 | elsif ($char[$i] eq '\Q') { | 
| 9908 |  |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 9909 |  |  |  |  |  |  | $left_e++; | 
| 9910 | 7 | 50 |  |  |  | 17 | } | 
| 9911 | 7 |  |  |  |  | 19 | elsif ($char[$i] eq '\E') { | 
| 9912 | 7 |  |  |  |  | 11 | if ($right_e < $left_e) { | 
| 9913 |  |  |  |  |  |  | $char[$i] = '>]}'; | 
| 9914 |  |  |  |  |  |  | $right_e++; | 
| 9915 | 7 |  |  |  |  | 17 | } | 
| 9916 |  |  |  |  |  |  | else { | 
| 9917 |  |  |  |  |  |  | $char[$i] = ''; | 
| 9918 |  |  |  |  |  |  | } | 
| 9919 | 0 |  |  |  |  | 0 | } | 
| 9920 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 9921 | 0 |  |  |  |  | 0 | while (1) { | 
| 9922 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 9923 | 0 | 0 |  |  |  | 0 | last; | 
| 9924 | 0 |  |  |  |  | 0 | } | 
| 9925 |  |  |  |  |  |  | if ($char[$i] eq '\E') { | 
| 9926 |  |  |  |  |  |  | last; | 
| 9927 |  |  |  |  |  |  | } | 
| 9928 |  |  |  |  |  |  | } | 
| 9929 |  |  |  |  |  |  | } | 
| 9930 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 9931 |  |  |  |  |  |  | } | 
| 9932 |  |  |  |  |  |  |  | 
| 9933 |  |  |  |  |  |  | # \0 --> \0 | 
| 9934 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ (?>\s*) 0 \z/oxms) { | 
| 9935 |  |  |  |  |  |  | } | 
| 9936 |  |  |  |  |  |  |  | 
| 9937 |  |  |  |  |  |  | # \g{N}, \g{-N} | 
| 9938 |  |  |  |  |  |  |  | 
| 9939 |  |  |  |  |  |  | # P.108 Using Simple Patterns | 
| 9940 |  |  |  |  |  |  | # in Chapter 7: In the World of Regular Expressions | 
| 9941 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 9942 |  |  |  |  |  |  |  | 
| 9943 |  |  |  |  |  |  | # P.221 Capturing | 
| 9944 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 9945 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 9946 |  |  |  |  |  |  |  | 
| 9947 |  |  |  |  |  |  | # \g{-1}, \g{-2}, \g{-3} --> \g{-1}, \g{-2}, \g{-3} | 
| 9948 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\g (?>\s*) \{ (?>\s*) - (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 9949 |  |  |  |  |  |  | } | 
| 9950 |  |  |  |  |  |  |  | 
| 9951 | 0 | 0 |  |  |  | 0 | # \g{1}, \g{2}, \g{3} --> \g{2}, \g{3}, \g{4} (only when multibyte anchoring is enable) | 
| 9952 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \\g (?>\s*) \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 9953 |  |  |  |  |  |  | if ($1 <= $parens) { | 
| 9954 |  |  |  |  |  |  | $char[$i] = '\\g{' . ($1 + 1) . '}'; | 
| 9955 |  |  |  |  |  |  | } | 
| 9956 |  |  |  |  |  |  | } | 
| 9957 |  |  |  |  |  |  |  | 
| 9958 | 0 | 0 |  |  |  | 0 | # \g1, \g2, \g3 --> \g2, \g3, \g4 (only when multibyte anchoring is enable) | 
| 9959 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \\g (?>\s*) ((?>[1-9][0-9]*)) \z/oxms) { | 
| 9960 |  |  |  |  |  |  | if ($1 <= $parens) { | 
| 9961 |  |  |  |  |  |  | $char[$i] = '\\g' . ($1 + 1); | 
| 9962 |  |  |  |  |  |  | } | 
| 9963 |  |  |  |  |  |  | } | 
| 9964 |  |  |  |  |  |  |  | 
| 9965 | 0 | 0 |  |  |  | 0 | # \1, \2, \3 --> \2, \3, \4 (only when multibyte anchoring is enable) | 
| 9966 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \\ (?>\s*) ((?>[1-9][0-9]*)) \z/oxms) { | 
| 9967 |  |  |  |  |  |  | if ($1 <= $parens) { | 
| 9968 |  |  |  |  |  |  | $char[$i] = '\\' . ($1 + 1); | 
| 9969 |  |  |  |  |  |  | } | 
| 9970 |  |  |  |  |  |  | } | 
| 9971 |  |  |  |  |  |  |  | 
| 9972 | 0 | 0 |  |  |  | 0 | # $0 --> $0 | 
| 9973 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 9974 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9975 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9976 |  |  |  |  |  |  | } | 
| 9977 | 0 | 0 |  |  |  | 0 | } | 
| 9978 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 9979 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9980 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9981 |  |  |  |  |  |  | } | 
| 9982 |  |  |  |  |  |  | } | 
| 9983 |  |  |  |  |  |  |  | 
| 9984 |  |  |  |  |  |  | # $$ --> $$ | 
| 9985 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 9986 |  |  |  |  |  |  | } | 
| 9987 |  |  |  |  |  |  |  | 
| 9988 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 9989 | 0 |  |  |  |  | 0 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 9990 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 9991 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 9992 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9993 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 9994 |  |  |  |  |  |  | } | 
| 9995 | 0 |  |  |  |  | 0 | } | 
| 9996 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 9997 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 9998 |  |  |  |  |  |  | if ($ignorecase) { | 
| 9999 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10000 |  |  |  |  |  |  | } | 
| 10001 |  |  |  |  |  |  | } | 
| 10002 |  |  |  |  |  |  |  | 
| 10003 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 10004 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 10005 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1.'->'.$2); | 
| 10006 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10007 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10008 |  |  |  |  |  |  | } | 
| 10009 |  |  |  |  |  |  | } | 
| 10010 |  |  |  |  |  |  |  | 
| 10011 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 10012 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 10013 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1.'->'.$2); | 
| 10014 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10015 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10016 |  |  |  |  |  |  | } | 
| 10017 |  |  |  |  |  |  | } | 
| 10018 |  |  |  |  |  |  |  | 
| 10019 | 0 |  |  |  |  | 0 | # $$foo | 
| 10020 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 10021 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 10022 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10023 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10024 |  |  |  |  |  |  | } | 
| 10025 |  |  |  |  |  |  | } | 
| 10026 |  |  |  |  |  |  |  | 
| 10027 | 0 | 50 |  |  |  | 0 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5hkscs::PREMATCH() | 
| 10028 | 4 |  |  |  |  | 15 | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 10029 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10030 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::PREMATCH())]}'; | 
| 10031 | 0 |  |  |  |  | 0 | } | 
| 10032 |  |  |  |  |  |  | else { | 
| 10033 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::PREMATCH()]}'; | 
| 10034 |  |  |  |  |  |  | } | 
| 10035 |  |  |  |  |  |  | } | 
| 10036 |  |  |  |  |  |  |  | 
| 10037 | 4 | 50 |  |  |  | 17 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5hkscs::MATCH() | 
| 10038 | 4 |  |  |  |  | 16 | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 10039 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10040 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::MATCH())]}'; | 
| 10041 | 0 |  |  |  |  | 0 | } | 
| 10042 |  |  |  |  |  |  | else { | 
| 10043 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::MATCH()]}'; | 
| 10044 |  |  |  |  |  |  | } | 
| 10045 |  |  |  |  |  |  | } | 
| 10046 |  |  |  |  |  |  |  | 
| 10047 | 4 | 50 |  |  |  | 17 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5hkscs::POSTMATCH() | 
| 10048 | 3 |  |  |  |  | 14 | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 10049 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10050 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::POSTMATCH())]}'; | 
| 10051 | 0 |  |  |  |  | 0 | } | 
| 10052 |  |  |  |  |  |  | else { | 
| 10053 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::POSTMATCH()]}'; | 
| 10054 |  |  |  |  |  |  | } | 
| 10055 |  |  |  |  |  |  | } | 
| 10056 |  |  |  |  |  |  |  | 
| 10057 | 3 | 0 |  |  |  | 13 | # ${ foo } | 
| 10058 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \}                              \z/oxms) { | 
| 10059 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10060 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10061 |  |  |  |  |  |  | } | 
| 10062 |  |  |  |  |  |  | } | 
| 10063 |  |  |  |  |  |  |  | 
| 10064 | 0 |  |  |  |  | 0 | # ${ ... } | 
| 10065 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 10066 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 10067 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10068 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10069 |  |  |  |  |  |  | } | 
| 10070 |  |  |  |  |  |  | } | 
| 10071 |  |  |  |  |  |  |  | 
| 10072 | 0 |  |  |  |  | 0 | # $scalar or @array | 
| 10073 | 13 | 50 |  |  |  | 52 | elsif ($char[$i] =~ /\A [\$\@].+ /oxms) { | 
| 10074 | 13 |  |  |  |  | 61 | $char[$i] = e_string($char[$i]); | 
| 10075 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10076 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10077 |  |  |  |  |  |  | } | 
| 10078 |  |  |  |  |  |  | } | 
| 10079 |  |  |  |  |  |  |  | 
| 10080 | 0 | 50 |  |  |  | 0 | # quote character before ? + * { | 
| 10081 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 10082 |  |  |  |  |  |  | if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) { | 
| 10083 | 23 |  |  |  |  | 129 | } | 
| 10084 |  |  |  |  |  |  | else { | 
| 10085 |  |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 10086 |  |  |  |  |  |  | } | 
| 10087 |  |  |  |  |  |  | } | 
| 10088 |  |  |  |  |  |  | } | 
| 10089 | 23 |  |  |  |  | 124 |  | 
| 10090 | 142 |  |  |  |  | 327 | # make regexp string | 
| 10091 | 142 |  |  |  |  | 357 | my $prematch = ''; | 
| 10092 | 142 | 50 |  |  |  | 254 | $prematch = "($anchor)"; | 
| 10093 | 142 |  |  |  |  | 370 | $modifier =~ tr/i//d; | 
| 10094 |  |  |  |  |  |  | if ($left_e > $right_e) { | 
| 10095 | 0 |  |  |  |  | 0 | return join '', $ope, $delimiter, $prematch, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier; | 
| 10096 |  |  |  |  |  |  | } | 
| 10097 |  |  |  |  |  |  | return     join '', $ope, $delimiter, $prematch, '(?:', @char,                               ')', $matched, $end_delimiter, $modifier; | 
| 10098 |  |  |  |  |  |  | } | 
| 10099 |  |  |  |  |  |  |  | 
| 10100 |  |  |  |  |  |  | # | 
| 10101 |  |  |  |  |  |  | # escape regexp (s'here'' or s'here''b) | 
| 10102 | 142 |  |  | 96 | 0 | 1545 | # | 
| 10103 | 96 |  | 100 |  |  | 212 | sub e_s1_q { | 
| 10104 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 10105 | 96 |  |  |  |  | 246 | $modifier ||= ''; | 
| 10106 | 96 | 50 |  |  |  | 136 |  | 
| 10107 | 96 |  |  |  |  | 262 | $modifier =~ tr/p//d; | 
| 10108 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 10109 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 10110 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 10111 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 10112 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 10113 |  |  |  |  |  |  | last; | 
| 10114 | 0 |  |  |  |  | 0 | } | 
| 10115 |  |  |  |  |  |  | } | 
| 10116 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 10117 | 0 |  |  |  |  | 0 | } | 
| 10118 |  |  |  |  |  |  |  | 
| 10119 |  |  |  |  |  |  | $slash = 'div'; | 
| 10120 | 96 | 100 |  |  |  | 132 |  | 
|  |  | 100 |  |  |  |  |  | 
| 10121 | 96 |  |  |  |  | 206 | # literal null string pattern | 
| 10122 | 8 |  |  |  |  | 10 | if ($string eq '') { | 
| 10123 | 8 |  |  |  |  | 9 | $modifier =~ tr/bB//d; | 
| 10124 |  |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 10125 |  |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 10126 |  |  |  |  |  |  | } | 
| 10127 |  |  |  |  |  |  |  | 
| 10128 | 8 |  |  |  |  | 42 | # with /b /B modifier | 
| 10129 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 10130 |  |  |  |  |  |  | return e_s1_qb($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 10131 |  |  |  |  |  |  | } | 
| 10132 |  |  |  |  |  |  |  | 
| 10133 | 44 |  |  |  |  | 79 | # without /b /B modifier | 
| 10134 |  |  |  |  |  |  | else { | 
| 10135 |  |  |  |  |  |  | return e_s1_qt($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 10136 |  |  |  |  |  |  | } | 
| 10137 |  |  |  |  |  |  | } | 
| 10138 |  |  |  |  |  |  |  | 
| 10139 |  |  |  |  |  |  | # | 
| 10140 |  |  |  |  |  |  | # escape regexp (s'here'') | 
| 10141 | 44 |  |  | 44 | 0 | 89 | # | 
| 10142 |  |  |  |  |  |  | sub e_s1_qt { | 
| 10143 | 44 | 100 |  |  |  | 100 | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 10144 |  |  |  |  |  |  |  | 
| 10145 |  |  |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 10146 | 44 |  |  |  |  | 102 |  | 
| 10147 |  |  |  |  |  |  | # split regexp | 
| 10148 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 10149 |  |  |  |  |  |  | [^\x81-\xFE\\\[\$\@\/] | | 
| 10150 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 10151 |  |  |  |  |  |  | \[\^                            | | 
| 10152 |  |  |  |  |  |  | \[\:   (?>[a-z]+) \:\]          | | 
| 10153 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) \:\]          | | 
| 10154 |  |  |  |  |  |  | [\$\@\/]                        | | 
| 10155 |  |  |  |  |  |  | \\     (?:$q_char)              | | 
| 10156 |  |  |  |  |  |  | (?:$q_char) | 
| 10157 |  |  |  |  |  |  | ))/oxmsg; | 
| 10158 | 44 |  |  |  |  | 465 |  | 
| 10159 | 44 | 50 | 100 |  |  | 128 | # unescape character | 
|  |  | 50 | 100 |  |  |  |  | 
|  |  | 50 | 66 |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 10160 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 10161 |  |  |  |  |  |  | if (0) { | 
| 10162 |  |  |  |  |  |  | } | 
| 10163 | 62 |  |  |  |  | 648 |  | 
| 10164 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 10165 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 10166 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 10167 |  |  |  |  |  |  | } | 
| 10168 |  |  |  |  |  |  |  | 
| 10169 | 0 |  |  |  |  | 0 | # open character class [...] | 
| 10170 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[') { | 
| 10171 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 10172 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 10173 | 0 |  |  |  |  | 0 | $i++; | 
| 10174 | 0 | 0 |  |  |  | 0 | } | 
| 10175 | 0 |  |  |  |  | 0 | while (1) { | 
| 10176 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 10177 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 10178 | 0 |  |  |  |  | 0 | } | 
| 10179 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 10180 |  |  |  |  |  |  | my $right = $i; | 
| 10181 | 0 |  |  |  |  | 0 |  | 
| 10182 |  |  |  |  |  |  | # [...] | 
| 10183 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 10184 | 0 |  |  |  |  | 0 |  | 
| 10185 |  |  |  |  |  |  | $i = $left; | 
| 10186 |  |  |  |  |  |  | last; | 
| 10187 |  |  |  |  |  |  | } | 
| 10188 |  |  |  |  |  |  | } | 
| 10189 |  |  |  |  |  |  | } | 
| 10190 |  |  |  |  |  |  |  | 
| 10191 | 0 |  |  |  |  | 0 | # open character class [^...] | 
| 10192 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[^') { | 
| 10193 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 10194 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 10195 | 0 |  |  |  |  | 0 | $i++; | 
| 10196 | 0 | 0 |  |  |  | 0 | } | 
| 10197 | 0 |  |  |  |  | 0 | while (1) { | 
| 10198 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 10199 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 10200 | 0 |  |  |  |  | 0 | } | 
| 10201 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 10202 |  |  |  |  |  |  | my $right = $i; | 
| 10203 | 0 |  |  |  |  | 0 |  | 
| 10204 |  |  |  |  |  |  | # [^...] | 
| 10205 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 10206 | 0 |  |  |  |  | 0 |  | 
| 10207 |  |  |  |  |  |  | $i = $left; | 
| 10208 |  |  |  |  |  |  | last; | 
| 10209 |  |  |  |  |  |  | } | 
| 10210 |  |  |  |  |  |  | } | 
| 10211 |  |  |  |  |  |  | } | 
| 10212 |  |  |  |  |  |  |  | 
| 10213 | 0 |  |  |  |  | 0 | # escape $ @ / and \ | 
| 10214 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 10215 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 10216 |  |  |  |  |  |  | } | 
| 10217 |  |  |  |  |  |  |  | 
| 10218 | 0 |  |  |  |  | 0 | # rewrite character class or escape character | 
| 10219 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 10220 |  |  |  |  |  |  | $char[$i] = $char; | 
| 10221 |  |  |  |  |  |  | } | 
| 10222 |  |  |  |  |  |  |  | 
| 10223 | 6 | 50 |  |  |  | 15 | # /i modifier | 
| 10224 | 8 |  |  |  |  | 20 | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Ebig5hkscs::uc($char[$i]) ne Ebig5hkscs::fc($char[$i]))) { | 
| 10225 |  |  |  |  |  |  | if (CORE::length(Ebig5hkscs::fc($char[$i])) == 1) { | 
| 10226 |  |  |  |  |  |  | $char[$i] = '['   . Ebig5hkscs::uc($char[$i])       . Ebig5hkscs::fc($char[$i]) . ']'; | 
| 10227 | 8 |  |  |  |  | 20 | } | 
| 10228 |  |  |  |  |  |  | else { | 
| 10229 |  |  |  |  |  |  | $char[$i] = '(?:' . Ebig5hkscs::uc($char[$i]) . '|' . Ebig5hkscs::fc($char[$i]) . ')'; | 
| 10230 |  |  |  |  |  |  | } | 
| 10231 |  |  |  |  |  |  | } | 
| 10232 |  |  |  |  |  |  |  | 
| 10233 | 0 | 0 |  |  |  | 0 | # quote character before ? + * { | 
| 10234 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 10235 |  |  |  |  |  |  | if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 10236 | 0 |  |  |  |  | 0 | } | 
| 10237 |  |  |  |  |  |  | else { | 
| 10238 |  |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 10239 |  |  |  |  |  |  | } | 
| 10240 |  |  |  |  |  |  | } | 
| 10241 | 0 |  |  |  |  | 0 | } | 
| 10242 | 44 |  |  |  |  | 90 |  | 
| 10243 | 44 |  |  |  |  | 61 | $modifier =~ tr/i//d; | 
| 10244 | 44 |  |  |  |  | 61 | $delimiter     = '/'; | 
| 10245 | 44 |  |  |  |  | 61 | $end_delimiter = '/'; | 
| 10246 | 44 |  |  |  |  | 86 | my $prematch = ''; | 
| 10247 |  |  |  |  |  |  | $prematch = "($anchor)"; | 
| 10248 |  |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 10249 |  |  |  |  |  |  | } | 
| 10250 |  |  |  |  |  |  |  | 
| 10251 |  |  |  |  |  |  | # | 
| 10252 |  |  |  |  |  |  | # escape regexp (s'here''b) | 
| 10253 | 44 |  |  | 44 | 0 | 316 | # | 
| 10254 |  |  |  |  |  |  | sub e_s1_qb { | 
| 10255 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 10256 | 44 |  |  |  |  | 97 |  | 
| 10257 |  |  |  |  |  |  | # split regexp | 
| 10258 |  |  |  |  |  |  | my @char = $string =~ /\G (?>[^\\]|\\\\|[\x00-\xFF]) /oxmsg; | 
| 10259 | 44 |  |  |  |  | 162 |  | 
| 10260 | 44 | 50 |  |  |  | 116 | # unescape character | 
|  |  | 50 |  |  |  |  |  | 
| 10261 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 10262 |  |  |  |  |  |  | if (0) { | 
| 10263 |  |  |  |  |  |  | } | 
| 10264 | 98 |  |  |  |  | 303 |  | 
| 10265 |  |  |  |  |  |  | # remain \\ | 
| 10266 |  |  |  |  |  |  | elsif ($char[$i] eq '\\\\') { | 
| 10267 |  |  |  |  |  |  | } | 
| 10268 |  |  |  |  |  |  |  | 
| 10269 | 0 |  |  |  |  | 0 | # escape $ @ / and \ | 
| 10270 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 10271 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 10272 |  |  |  |  |  |  | } | 
| 10273 | 0 |  |  |  |  | 0 | } | 
| 10274 | 44 |  |  |  |  | 70 |  | 
| 10275 | 44 |  |  |  |  | 60 | $delimiter     = '/'; | 
| 10276 | 44 |  |  |  |  | 65 | $end_delimiter = '/'; | 
| 10277 | 44 |  |  |  |  | 60 | my $prematch = ''; | 
| 10278 |  |  |  |  |  |  | $prematch = q{(\G[\x00-\xFF]*?)}; | 
| 10279 |  |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 10280 |  |  |  |  |  |  | } | 
| 10281 |  |  |  |  |  |  |  | 
| 10282 |  |  |  |  |  |  | # | 
| 10283 |  |  |  |  |  |  | # escape regexp (s''here') | 
| 10284 | 44 |  |  | 91 | 0 | 340 | # | 
| 10285 |  |  |  |  |  |  | sub e_s2_q { | 
| 10286 | 91 |  |  |  |  | 172 | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 10287 |  |  |  |  |  |  |  | 
| 10288 | 91 |  |  |  |  | 128 | $slash = 'div'; | 
| 10289 | 91 |  |  |  |  | 316 |  | 
| 10290 | 91 | 50 | 66 |  |  | 228 | my @char = $string =~ / \G (?>[^\x81-\xFE\\]|\\\\|$q_char) /oxmsg; | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 10291 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 10292 |  |  |  |  |  |  | if (0) { | 
| 10293 |  |  |  |  |  |  | } | 
| 10294 | 9 |  |  |  |  | 84 |  | 
| 10295 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 10296 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) (\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 10297 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 10298 | 0 |  |  |  |  | 0 | } | 
| 10299 |  |  |  |  |  |  | elsif (defined($char[$i+1]) and ($char[$i+1] eq '\\') and ($char[$i] =~ /\A ([\x80-\xFF].*) (\\) \z/xms)) { | 
| 10300 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 10301 |  |  |  |  |  |  | } | 
| 10302 |  |  |  |  |  |  |  | 
| 10303 |  |  |  |  |  |  | # not escape \\ | 
| 10304 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\\\ \z/oxms) { | 
| 10305 |  |  |  |  |  |  | } | 
| 10306 |  |  |  |  |  |  |  | 
| 10307 | 0 |  |  |  |  | 0 | # escape $ @ / and \ | 
| 10308 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 10309 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 10310 | 5 | 50 | 66 |  |  | 16 | } | 
| 10311 | 91 |  |  |  |  | 226 | } | 
| 10312 |  |  |  |  |  |  | if (defined($char[-1]) and ($char[-1] =~ /\A ([\x80-\xFF].*) (\\) \z/xms)) { | 
| 10313 |  |  |  |  |  |  | $char[-1] = $1 . '\\' . $2; | 
| 10314 | 0 |  |  |  |  | 0 | } | 
| 10315 |  |  |  |  |  |  |  | 
| 10316 |  |  |  |  |  |  | return join '', $ope, $delimiter, @char,   $end_delimiter; | 
| 10317 |  |  |  |  |  |  | } | 
| 10318 |  |  |  |  |  |  |  | 
| 10319 |  |  |  |  |  |  | # | 
| 10320 |  |  |  |  |  |  | # escape regexp (s/here/and here/modifier) | 
| 10321 | 91 |  |  | 290 | 0 | 253 | # | 
| 10322 | 290 |  | 100 |  |  | 2082 | sub e_sub { | 
| 10323 |  |  |  |  |  |  | my($variable,$delimiter1,$pattern,$end_delimiter1,$delimiter2,$replacement,$end_delimiter2,$modifier) = @_; | 
| 10324 | 290 |  |  |  |  | 1255 | $modifier ||= ''; | 
| 10325 | 290 | 50 |  |  |  | 551 |  | 
| 10326 | 290 |  |  |  |  | 980 | $modifier =~ tr/p//d; | 
| 10327 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 10328 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 10329 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 10330 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 10331 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 10332 |  |  |  |  |  |  | last; | 
| 10333 | 0 |  |  |  |  | 0 | } | 
| 10334 |  |  |  |  |  |  | } | 
| 10335 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 10336 | 0 | 100 |  |  |  | 0 | } | 
| 10337 | 290 |  |  |  |  | 676 |  | 
| 10338 | 37 |  |  |  |  | 52 | if ($variable eq '') { | 
| 10339 |  |  |  |  |  |  | $variable      = '$_'; | 
| 10340 |  |  |  |  |  |  | $bind_operator = ' =~ '; | 
| 10341 | 37 |  |  |  |  | 54 | } | 
| 10342 |  |  |  |  |  |  |  | 
| 10343 |  |  |  |  |  |  | $slash = 'div'; | 
| 10344 |  |  |  |  |  |  |  | 
| 10345 |  |  |  |  |  |  | # P.128 Start of match (or end of previous match): \G | 
| 10346 |  |  |  |  |  |  | # P.130 Advanced Use of \G with Perl | 
| 10347 |  |  |  |  |  |  | # in Chapter 3: Overview of Regular Expression Features and Flavors | 
| 10348 |  |  |  |  |  |  | # P.312 Iterative Matching: Scalar Context, with /g | 
| 10349 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 10350 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 10351 |  |  |  |  |  |  |  | 
| 10352 |  |  |  |  |  |  | # P.181 Where You Left Off: The \G Assertion | 
| 10353 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 10354 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 10355 |  |  |  |  |  |  |  | 
| 10356 |  |  |  |  |  |  | # P.220 Where You Left Off: The \G Assertion | 
| 10357 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 10358 | 290 |  |  |  |  | 462 | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 10359 | 290 |  |  |  |  | 427 |  | 
| 10360 |  |  |  |  |  |  | my $e_modifier = $modifier =~ tr/e//d; | 
| 10361 | 290 |  |  |  |  | 464 | my $r_modifier = $modifier =~ tr/r//d; | 
| 10362 | 290 | 50 |  |  |  | 419 |  | 
| 10363 | 290 |  |  |  |  | 672 | my $my = ''; | 
| 10364 | 0 |  |  |  |  | 0 | if ($variable =~ s/\A \( (?>\s*) ( (?>(?: local \b | my \b | our \b | state \b )?) .+ ) \) \z/$1/oxms) { | 
| 10365 | 0 |  |  |  |  | 0 | $my = $variable; | 
| 10366 |  |  |  |  |  |  | $variable =~ s/ (?: local \b | my \b | our \b | state \b ) (?>\s*) //oxms; | 
| 10367 |  |  |  |  |  |  | $variable =~ s/ = .+ \z//oxms; | 
| 10368 | 0 |  |  |  |  | 0 | } | 
| 10369 | 290 |  |  |  |  | 783 |  | 
| 10370 |  |  |  |  |  |  | (my $variable_basename = $variable) =~ s/ [\[\{].* \z//oxms; | 
| 10371 |  |  |  |  |  |  | $variable_basename =~ s/ \s+ \z//oxms; | 
| 10372 | 290 |  |  |  |  | 547 |  | 
| 10373 | 290 | 100 |  |  |  | 406 | # quote replacement string | 
| 10374 | 290 |  |  |  |  | 603 | my $e_replacement = ''; | 
| 10375 | 17 |  |  |  |  | 33 | if ($e_modifier >= 1) { | 
| 10376 |  |  |  |  |  |  | $e_replacement = e_qq('', '', '', $replacement); | 
| 10377 |  |  |  |  |  |  | $e_modifier--; | 
| 10378 | 17 | 100 |  |  |  | 32 | } | 
| 10379 | 273 |  |  |  |  | 551 | else { | 
| 10380 |  |  |  |  |  |  | if ($delimiter2 eq "'") { | 
| 10381 |  |  |  |  |  |  | $e_replacement = e_s2_q('qq', '/',         '/',             $replacement); | 
| 10382 | 91 |  |  |  |  | 189 | } | 
| 10383 |  |  |  |  |  |  | else { | 
| 10384 |  |  |  |  |  |  | $e_replacement = e_qq  ('qq', $delimiter2, $end_delimiter2, $replacement); | 
| 10385 |  |  |  |  |  |  | } | 
| 10386 | 182 |  |  |  |  | 436 | } | 
| 10387 |  |  |  |  |  |  |  | 
| 10388 |  |  |  |  |  |  | my $sub = ''; | 
| 10389 | 290 | 100 |  |  |  | 515 |  | 
| 10390 | 290 | 100 |  |  |  | 577 | # with /r | 
|  |  | 50 |  |  |  |  |  | 
| 10391 |  |  |  |  |  |  | if ($r_modifier) { | 
| 10392 |  |  |  |  |  |  | if (0) { | 
| 10393 |  |  |  |  |  |  | } | 
| 10394 | 8 |  |  |  |  | 24 |  | 
| 10395 | 0 | 50 |  |  |  | 0 | # s///gr with multibyte anchoring | 
| 10396 |  |  |  |  |  |  | elsif ($modifier =~ /g/oxms) { | 
| 10397 |  |  |  |  |  |  | $sub = sprintf( | 
| 10398 |  |  |  |  |  |  | #                               1                                                2   3                                  4   5 | 
| 10399 |  |  |  |  |  |  | q, | 
| 10400 |  |  |  |  |  |  |  | 
| 10401 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 10402 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 10403 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 10404 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 10405 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 10406 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 10407 |  |  |  |  |  |  | '$Ebig5hkscs::re_r=CORE::eval $Ebig5hkscs::re_r; ' x $e_modifier,          #  5 | 
| 10408 |  |  |  |  |  |  | ); | 
| 10409 |  |  |  |  |  |  | } | 
| 10410 |  |  |  |  |  |  |  | 
| 10411 | 4 | 0 |  |  |  | 15 | # s///gr without multibyte anchoring | 
| 10412 |  |  |  |  |  |  | elsif ($modifier =~ /g/oxms) { | 
| 10413 |  |  |  |  |  |  | $sub = sprintf( | 
| 10414 |  |  |  |  |  |  | #                               1                         2   3                                  4   5 | 
| 10415 |  |  |  |  |  |  | q, | 
| 10416 |  |  |  |  |  |  |  | 
| 10417 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 10418 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 10419 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 10420 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 10421 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 10422 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 10423 |  |  |  |  |  |  | '$Ebig5hkscs::re_r=CORE::eval $Ebig5hkscs::re_r; ' x $e_modifier,          #  5 | 
| 10424 |  |  |  |  |  |  | ); | 
| 10425 |  |  |  |  |  |  | } | 
| 10426 |  |  |  |  |  |  |  | 
| 10427 |  |  |  |  |  |  | # s///r | 
| 10428 | 0 |  |  |  |  | 0 | else { | 
| 10429 | 4 |  |  |  |  | 5 |  | 
| 10430 |  |  |  |  |  |  | my $prematch = q{$`}; | 
| 10431 | 4 | 50 |  |  |  | 5 | $prematch = q{${1}}; | 
| 10432 |  |  |  |  |  |  |  | 
| 10433 |  |  |  |  |  |  | $sub = sprintf( | 
| 10434 |  |  |  |  |  |  | #  1     2                3                                  4   5  6                     7 | 
| 10435 |  |  |  |  |  |  | q<(%s =~ %s) ? CORE::eval{%s local $^W=0; local $Ebig5hkscs::re_r=%s; %s"%s$Ebig5hkscs::re_r$'" } : %s>, | 
| 10436 |  |  |  |  |  |  |  | 
| 10437 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 10438 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 10439 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 10440 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 10441 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 10442 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 10443 |  |  |  |  |  |  | '$Ebig5hkscs::re_r=CORE::eval $Ebig5hkscs::re_r; ' x $e_modifier,          #  5 | 
| 10444 |  |  |  |  |  |  | $prematch,                                                       #  6 | 
| 10445 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 10446 |  |  |  |  |  |  | ); | 
| 10447 |  |  |  |  |  |  | } | 
| 10448 | 4 | 50 |  |  |  | 21 |  | 
| 10449 | 8 |  |  |  |  | 22 | # $var !~ s///r doesn't make sense | 
| 10450 |  |  |  |  |  |  | if ($bind_operator =~ / !~ /oxms) { | 
| 10451 |  |  |  |  |  |  | $sub = q{die("$0: Using !~ with s///r doesn't make sense"), } . $sub; | 
| 10452 |  |  |  |  |  |  | } | 
| 10453 |  |  |  |  |  |  | } | 
| 10454 |  |  |  |  |  |  |  | 
| 10455 | 0 | 100 |  |  |  | 0 | # without /r | 
|  |  | 50 |  |  |  |  |  | 
| 10456 |  |  |  |  |  |  | else { | 
| 10457 |  |  |  |  |  |  | if (0) { | 
| 10458 |  |  |  |  |  |  | } | 
| 10459 | 282 |  |  |  |  | 792 |  | 
| 10460 | 0 | 100 |  |  |  | 0 | # s///g with multibyte anchoring | 
|  |  | 100 |  |  |  |  |  | 
| 10461 |  |  |  |  |  |  | elsif ($modifier =~ /g/oxms) { | 
| 10462 |  |  |  |  |  |  | $sub = sprintf( | 
| 10463 |  |  |  |  |  |  | #                                                               1     2   3                                  4   5 6                                        7                                                              8        9                            10 | 
| 10464 |  |  |  |  |  |  | q, | 
| 10465 |  |  |  |  |  |  |  | 
| 10466 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 10467 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 10468 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 10469 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 10470 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 10471 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 10472 |  |  |  |  |  |  | '$Ebig5hkscs::re_r=CORE::eval $Ebig5hkscs::re_r; ' x $e_modifier,          #  5 | 
| 10473 |  |  |  |  |  |  | $variable,                                                       #  6 | 
| 10474 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 10475 |  |  |  |  |  |  | $variable,                                                       #  8 | 
| 10476 |  |  |  |  |  |  | $variable,                                                       #  9 | 
| 10477 |  |  |  |  |  |  |  | 
| 10478 |  |  |  |  |  |  | # Binary "!~" is just like "=~" except the return value is negated in the logical sense. | 
| 10479 |  |  |  |  |  |  | # It returns false if the match succeeds, and true if it fails. | 
| 10480 |  |  |  |  |  |  | # (and so on) | 
| 10481 |  |  |  |  |  |  |  | 
| 10482 |  |  |  |  |  |  | ($bind_operator =~ / !~ /oxms) ? '!' : '',                       # 10 | 
| 10483 |  |  |  |  |  |  | ); | 
| 10484 |  |  |  |  |  |  | } | 
| 10485 |  |  |  |  |  |  |  | 
| 10486 | 35 | 0 |  |  |  | 170 | # s///g without multibyte anchoring | 
|  |  | 0 |  |  |  |  |  | 
| 10487 |  |  |  |  |  |  | elsif ($modifier =~ /g/oxms) { | 
| 10488 |  |  |  |  |  |  | $sub = sprintf( | 
| 10489 |  |  |  |  |  |  | #                                        1     2   3                                  4   5 6                          7                                                   8 | 
| 10490 |  |  |  |  |  |  | q, | 
| 10491 |  |  |  |  |  |  |  | 
| 10492 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 10493 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 10494 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 10495 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 10496 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 10497 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 10498 |  |  |  |  |  |  | '$Ebig5hkscs::re_r=CORE::eval $Ebig5hkscs::re_r; ' x $e_modifier,          #  5 | 
| 10499 |  |  |  |  |  |  | $variable,                                                       #  6 | 
| 10500 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 10501 |  |  |  |  |  |  | ($bind_operator =~ / !~ /oxms) ? '!' : '',                       #  8 | 
| 10502 |  |  |  |  |  |  | ); | 
| 10503 |  |  |  |  |  |  | } | 
| 10504 |  |  |  |  |  |  |  | 
| 10505 |  |  |  |  |  |  | # s/// | 
| 10506 | 0 |  |  |  |  | 0 | else { | 
| 10507 | 247 |  |  |  |  | 445 |  | 
| 10508 |  |  |  |  |  |  | my $prematch = q{$`}; | 
| 10509 | 247 | 100 |  |  |  | 381 | $prematch = q{${1}}; | 
|  |  | 100 |  |  |  |  |  | 
| 10510 |  |  |  |  |  |  |  | 
| 10511 |  |  |  |  |  |  | $sub = sprintf( | 
| 10512 |  |  |  |  |  |  |  | 
| 10513 |  |  |  |  |  |  | ($bind_operator =~ / =~ /oxms) ? | 
| 10514 |  |  |  |  |  |  |  | 
| 10515 |  |  |  |  |  |  | #  1 2 3                4                                  5   6 7   8 | 
| 10516 |  |  |  |  |  |  | q<(%s%s%s) ? CORE::eval{%s local $^W=0; local $Ebig5hkscs::re_r=%s; %s%s="%s$Ebig5hkscs::re_r$'"; 1 } : undef> : | 
| 10517 |  |  |  |  |  |  |  | 
| 10518 |  |  |  |  |  |  | #  1 2 3                    4                                  5   6 7   8 | 
| 10519 |  |  |  |  |  |  | q<(%s%s%s) ? 1 : CORE::eval{%s local $^W=0; local $Ebig5hkscs::re_r=%s; %s%s="%s$Ebig5hkscs::re_r$'"; undef }>, | 
| 10520 |  |  |  |  |  |  |  | 
| 10521 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 10522 |  |  |  |  |  |  | $bind_operator,                                                  #  2 | 
| 10523 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  3 | 
| 10524 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 10525 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 10526 |  |  |  |  |  |  | $s_matched,                                                      #  4 | 
| 10527 |  |  |  |  |  |  | $e_replacement,                                                  #  5 | 
| 10528 |  |  |  |  |  |  | '$Ebig5hkscs::re_r=CORE::eval $Ebig5hkscs::re_r; ' x $e_modifier,          #  6 | 
| 10529 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 10530 |  |  |  |  |  |  | $prematch,                                                       #  8 | 
| 10531 |  |  |  |  |  |  | ); | 
| 10532 |  |  |  |  |  |  | } | 
| 10533 |  |  |  |  |  |  | } | 
| 10534 | 247 | 50 |  |  |  | 1104 |  | 
| 10535 | 290 |  |  |  |  | 925 | # (my $foo = $bar) =~ s///   -->   (my $foo = $bar, CORE::eval { ... })[1] | 
| 10536 |  |  |  |  |  |  | if ($my ne '') { | 
| 10537 |  |  |  |  |  |  | $sub = "($my, $sub)[1]"; | 
| 10538 |  |  |  |  |  |  | } | 
| 10539 | 0 |  |  |  |  | 0 |  | 
| 10540 | 290 |  |  |  |  | 409 | # clear s/// variable | 
| 10541 |  |  |  |  |  |  | $sub_variable = ''; | 
| 10542 | 290 |  |  |  |  | 424 | $bind_operator = ''; | 
| 10543 |  |  |  |  |  |  |  | 
| 10544 |  |  |  |  |  |  | return $sub; | 
| 10545 |  |  |  |  |  |  | } | 
| 10546 |  |  |  |  |  |  |  | 
| 10547 |  |  |  |  |  |  | # | 
| 10548 |  |  |  |  |  |  | # escape chdir (qq//, "") | 
| 10549 | 290 |  |  | 0 | 0 | 2349 | # | 
| 10550 |  |  |  |  |  |  | sub e_chdir { | 
| 10551 | 0 | 0 |  |  |  | 0 | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 10552 | 0 | 0 |  |  |  | 0 |  | 
| 10553 | 0 | 0 |  |  |  | 0 | if ($^W) { | 
| 10554 | 0 |  |  |  |  | 0 | if (Ebig5hkscs::_MSWin32_5Cended_path($string)) { | 
| 10555 | 0 |  |  |  |  | 0 | if ($] !~ /^5\.005/oxms) { | 
| 10556 |  |  |  |  |  |  | warn < | 
| 10557 |  |  |  |  |  |  | @{[__FILE__]}: Can't chdir to '$string' | 
| 10558 |  |  |  |  |  |  |  | 
| 10559 |  |  |  |  |  |  | chdir does not work with chr(0x5C) at end of path | 
| 10560 |  |  |  |  |  |  | http://bugs.activestate.com/show_bug.cgi?id=81839 | 
| 10561 |  |  |  |  |  |  | END | 
| 10562 |  |  |  |  |  |  | } | 
| 10563 |  |  |  |  |  |  | } | 
| 10564 | 0 |  |  |  |  | 0 | } | 
| 10565 |  |  |  |  |  |  |  | 
| 10566 |  |  |  |  |  |  | return e_qq($ope,$delimiter,$end_delimiter,$string); | 
| 10567 |  |  |  |  |  |  | } | 
| 10568 |  |  |  |  |  |  |  | 
| 10569 |  |  |  |  |  |  | # | 
| 10570 |  |  |  |  |  |  | # escape chdir (q//, '') | 
| 10571 | 0 |  |  | 2 | 0 | 0 | # | 
| 10572 |  |  |  |  |  |  | sub e_chdir_q { | 
| 10573 | 2 | 50 |  |  |  | 6 | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 10574 | 2 | 0 |  |  |  | 6 |  | 
| 10575 | 0 | 0 |  |  |  | 0 | if ($^W) { | 
| 10576 | 0 |  |  |  |  | 0 | if (Ebig5hkscs::_MSWin32_5Cended_path($string)) { | 
| 10577 | 0 |  |  |  |  | 0 | if ($] !~ /^5\.005/oxms) { | 
| 10578 |  |  |  |  |  |  | warn < | 
| 10579 |  |  |  |  |  |  | @{[__FILE__]}: Can't chdir to '$string' | 
| 10580 |  |  |  |  |  |  |  | 
| 10581 |  |  |  |  |  |  | chdir does not work with chr(0x5C) at end of path | 
| 10582 |  |  |  |  |  |  | http://bugs.activestate.com/show_bug.cgi?id=81839 | 
| 10583 |  |  |  |  |  |  | END | 
| 10584 |  |  |  |  |  |  | } | 
| 10585 |  |  |  |  |  |  | } | 
| 10586 | 0 |  |  |  |  | 0 | } | 
| 10587 |  |  |  |  |  |  |  | 
| 10588 |  |  |  |  |  |  | return e_q($ope,$delimiter,$end_delimiter,$string); | 
| 10589 |  |  |  |  |  |  | } | 
| 10590 |  |  |  |  |  |  |  | 
| 10591 |  |  |  |  |  |  | # | 
| 10592 |  |  |  |  |  |  | # escape regexp of split qr// | 
| 10593 | 2 |  |  | 273 | 0 | 14 | # | 
| 10594 | 273 |  | 100 |  |  | 1483 | sub e_split { | 
| 10595 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 10596 | 273 |  |  |  |  | 1254 | $modifier ||= ''; | 
| 10597 | 273 | 50 |  |  |  | 589 |  | 
| 10598 | 273 |  |  |  |  | 1156 | $modifier =~ tr/p//d; | 
| 10599 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 10600 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 10601 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 10602 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 10603 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 10604 |  |  |  |  |  |  | last; | 
| 10605 | 0 |  |  |  |  | 0 | } | 
| 10606 |  |  |  |  |  |  | } | 
| 10607 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 10608 | 0 |  |  |  |  | 0 | } | 
| 10609 |  |  |  |  |  |  |  | 
| 10610 |  |  |  |  |  |  | $slash = 'div'; | 
| 10611 | 273 | 100 |  |  |  | 484 |  | 
| 10612 | 273 |  |  |  |  | 564 | # /b /B modifier | 
| 10613 |  |  |  |  |  |  | if ($modifier =~ tr/bB//d) { | 
| 10614 |  |  |  |  |  |  | return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier; | 
| 10615 | 84 | 100 |  |  |  | 414 | } | 
| 10616 | 189 |  |  |  |  | 584 |  | 
| 10617 |  |  |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 10618 |  |  |  |  |  |  | my $metachar = qr/[\@\\|[\]{^]/oxms; | 
| 10619 | 189 |  |  |  |  | 766 |  | 
| 10620 |  |  |  |  |  |  | # split regexp | 
| 10621 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 10622 |  |  |  |  |  |  | [^\x81-\xFE\\\$\@\[\(]|[\x81-\xFE][\x00-\xFF] | | 
| 10623 |  |  |  |  |  |  | \\x   (?>[0-9A-Fa-f]{1,2}) | | 
| 10624 |  |  |  |  |  |  | \\    (?>[0-7]{2,3})       | | 
| 10625 |  |  |  |  |  |  | \\c   [\x40-\x5F]          | | 
| 10626 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}  | | 
| 10627 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}  | | 
| 10628 |  |  |  |  |  |  | \\[bBNpP]\{ (?>[^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} | | 
| 10629 |  |  |  |  |  |  | \\  $q_char                | | 
| 10630 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 10631 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 10632 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 10633 |  |  |  |  |  |  | [\$\@] $qq_variable        | | 
| 10634 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)          | | 
| 10635 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 10636 |  |  |  |  |  |  | \$ \$ (?![\w\{])           | | 
| 10637 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 10638 |  |  |  |  |  |  | \[\^                       | | 
| 10639 |  |  |  |  |  |  | \[\:   (?>[a-z]+) :\]      | | 
| 10640 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) :\]      | | 
| 10641 |  |  |  |  |  |  | \(\?                       | | 
| 10642 |  |  |  |  |  |  | $q_char | 
| 10643 | 189 |  |  |  |  | 16660 | ))/oxmsg; | 
| 10644 | 189 |  |  |  |  | 616 |  | 
| 10645 | 189 |  |  |  |  | 289 | my $left_e  = 0; | 
| 10646 |  |  |  |  |  |  | my $right_e = 0; | 
| 10647 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 10648 | 189 | 50 | 33 |  |  | 604 |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 10649 | 372 |  |  |  |  | 4037 | # "\L\u" --> "\u\L" | 
| 10650 |  |  |  |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
| 10651 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 10652 |  |  |  |  |  |  | } | 
| 10653 |  |  |  |  |  |  |  | 
| 10654 | 0 |  |  |  |  | 0 | # "\U\l" --> "\l\U" | 
| 10655 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 10656 |  |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 10657 |  |  |  |  |  |  | } | 
| 10658 |  |  |  |  |  |  |  | 
| 10659 | 0 |  |  |  |  | 0 | # octal escape sequence | 
| 10660 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 10661 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::octchr($1); | 
| 10662 |  |  |  |  |  |  | } | 
| 10663 |  |  |  |  |  |  |  | 
| 10664 | 1 |  |  |  |  | 3 | # hexadecimal escape sequence | 
| 10665 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 10666 |  |  |  |  |  |  | $char[$i] = Ebig5hkscs::hexchr($1); | 
| 10667 |  |  |  |  |  |  | } | 
| 10668 |  |  |  |  |  |  |  | 
| 10669 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 10670 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 10671 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 10672 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 10673 | 1 |  |  |  |  | 5 | # \P{PROPERTY} --> P\{PROPERTY} | 
| 10674 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^\x81-\xFE0-9\}][^\x81-\xFE\}]*) \} ) \z/oxms) { | 
| 10675 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 10676 |  |  |  |  |  |  | } | 
| 10677 |  |  |  |  |  |  |  | 
| 10678 | 0 |  |  |  |  | 0 | # \p, \P, \X --> p, P, X | 
| 10679 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 10680 |  |  |  |  |  |  | $char[$i] = $1; | 
| 10681 | 0 | 50 | 100 |  |  | 0 | } | 
|  |  | 50 | 100 |  |  |  |  | 
|  |  | 100 | 66 |  |  |  |  | 
|  |  | 100 | 100 |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 10682 |  |  |  |  |  |  |  | 
| 10683 |  |  |  |  |  |  | if (0) { | 
| 10684 |  |  |  |  |  |  | } | 
| 10685 | 372 |  |  |  |  | 4211 |  | 
| 10686 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 10687 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\? ([\x80-\xFF].*) ($metachar|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 10688 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 10689 |  |  |  |  |  |  | } | 
| 10690 |  |  |  |  |  |  |  | 
| 10691 | 0 | 0 | 0 |  |  | 0 | # join separated multiple-octet | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 10692 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 10693 |  |  |  |  |  |  | if (   ($i+3 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+3]) == 3) and (CORE::eval(sprintf '"%s%s%s%s"', @char[$i..$i+3]) =~ /\A $q_char \z/oxms)) { | 
| 10694 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 3; | 
| 10695 | 0 |  |  |  |  | 0 | } | 
| 10696 |  |  |  |  |  |  | elsif (($i+2 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, @char[$i+1..$i+2]) == 2) and (CORE::eval(sprintf '"%s%s%s"',   @char[$i..$i+2]) =~ /\A $q_char \z/oxms)) { | 
| 10697 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 2; | 
| 10698 | 0 |  |  |  |  | 0 | } | 
| 10699 |  |  |  |  |  |  | elsif (($i+1 <= $#char) and (grep(/\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms, $char[$i+1      ]) == 1) and (CORE::eval(sprintf '"%s%s"',     @char[$i..$i+1]) =~ /\A $q_char \z/oxms)) { | 
| 10700 |  |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 1; | 
| 10701 |  |  |  |  |  |  | } | 
| 10702 |  |  |  |  |  |  | } | 
| 10703 |  |  |  |  |  |  |  | 
| 10704 | 0 |  |  |  |  | 0 | # open character class [...] | 
| 10705 | 3 | 50 |  |  |  | 8 | elsif ($char[$i] eq '[') { | 
| 10706 | 3 |  |  |  |  | 11 | my $left = $i; | 
| 10707 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 10708 | 0 |  |  |  |  | 0 | $i++; | 
| 10709 | 3 | 50 |  |  |  | 6 | } | 
| 10710 | 7 |  |  |  |  | 16 | while (1) { | 
| 10711 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 10712 | 0 | 100 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 10713 | 7 |  |  |  |  | 15 | } | 
| 10714 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 10715 |  |  |  |  |  |  | my $right = $i; | 
| 10716 | 3 | 50 |  |  |  | 5 |  | 
| 10717 | 3 |  |  |  |  | 35 | # [...] | 
|  | 0 |  |  |  |  | 0 |  | 
| 10718 |  |  |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 10719 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
| 10720 | 0 |  |  |  |  | 0 | } | 
| 10721 |  |  |  |  |  |  | else { | 
| 10722 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 10723 | 3 |  |  |  |  | 20 | } | 
| 10724 | 3 |  |  |  |  | 6 |  | 
| 10725 |  |  |  |  |  |  | $i = $left; | 
| 10726 |  |  |  |  |  |  | last; | 
| 10727 |  |  |  |  |  |  | } | 
| 10728 |  |  |  |  |  |  | } | 
| 10729 |  |  |  |  |  |  | } | 
| 10730 |  |  |  |  |  |  |  | 
| 10731 | 3 |  |  |  |  | 9 | # open character class [^...] | 
| 10732 | 1 | 50 |  |  |  | 3 | elsif ($char[$i] eq '[^') { | 
| 10733 | 1 |  |  |  |  | 4 | my $left = $i; | 
| 10734 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 10735 | 0 |  |  |  |  | 0 | $i++; | 
| 10736 | 1 | 50 |  |  |  | 1 | } | 
| 10737 | 2 |  |  |  |  | 6 | while (1) { | 
| 10738 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 10739 | 0 | 100 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 10740 | 2 |  |  |  |  | 4 | } | 
| 10741 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 10742 |  |  |  |  |  |  | my $right = $i; | 
| 10743 | 1 | 50 |  |  |  | 2 |  | 
| 10744 | 1 |  |  |  |  | 7 | # [^...] | 
|  | 0 |  |  |  |  | 0 |  | 
| 10745 |  |  |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 10746 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Ebig5hkscs::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
| 10747 | 0 |  |  |  |  | 0 | } | 
| 10748 |  |  |  |  |  |  | else { | 
| 10749 |  |  |  |  |  |  | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 10750 | 1 |  |  |  |  | 13 | } | 
| 10751 | 1 |  |  |  |  | 3 |  | 
| 10752 |  |  |  |  |  |  | $i = $left; | 
| 10753 |  |  |  |  |  |  | last; | 
| 10754 |  |  |  |  |  |  | } | 
| 10755 |  |  |  |  |  |  | } | 
| 10756 |  |  |  |  |  |  | } | 
| 10757 |  |  |  |  |  |  |  | 
| 10758 | 1 |  |  |  |  | 3 | # rewrite character class or escape character | 
| 10759 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 10760 |  |  |  |  |  |  | $char[$i] = $char; | 
| 10761 |  |  |  |  |  |  | } | 
| 10762 |  |  |  |  |  |  |  | 
| 10763 |  |  |  |  |  |  | # P.794 29.2.161. split | 
| 10764 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 10765 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 10766 |  |  |  |  |  |  |  | 
| 10767 |  |  |  |  |  |  | # P.951 split | 
| 10768 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 10769 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 10770 |  |  |  |  |  |  |  | 
| 10771 |  |  |  |  |  |  | # said "The //m modifier is assumed when you split on the pattern /^/", | 
| 10772 |  |  |  |  |  |  | # but perl5.008 is not so. Therefore, this software adds //m. | 
| 10773 |  |  |  |  |  |  | # (and so on) | 
| 10774 |  |  |  |  |  |  |  | 
| 10775 | 5 |  |  |  |  | 22 | # split(m/^/) --> split(m/^/m) | 
| 10776 |  |  |  |  |  |  | elsif (($char[$i] eq '^') and ($modifier !~ /m/oxms)) { | 
| 10777 |  |  |  |  |  |  | $modifier .= 'm'; | 
| 10778 |  |  |  |  |  |  | } | 
| 10779 |  |  |  |  |  |  |  | 
| 10780 | 11 | 50 |  |  |  | 43 | # /i modifier | 
| 10781 | 18 |  |  |  |  | 40 | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Ebig5hkscs::uc($char[$i]) ne Ebig5hkscs::fc($char[$i]))) { | 
| 10782 |  |  |  |  |  |  | if (CORE::length(Ebig5hkscs::fc($char[$i])) == 1) { | 
| 10783 |  |  |  |  |  |  | $char[$i] = '['   . Ebig5hkscs::uc($char[$i])       . Ebig5hkscs::fc($char[$i]) . ']'; | 
| 10784 | 18 |  |  |  |  | 65 | } | 
| 10785 |  |  |  |  |  |  | else { | 
| 10786 |  |  |  |  |  |  | $char[$i] = '(?:' . Ebig5hkscs::uc($char[$i]) . '|' . Ebig5hkscs::fc($char[$i]) . ')'; | 
| 10787 |  |  |  |  |  |  | } | 
| 10788 |  |  |  |  |  |  | } | 
| 10789 |  |  |  |  |  |  |  | 
| 10790 | 0 | 50 |  |  |  | 0 | # \u \l \U \L \F \Q \E | 
| 10791 | 2 |  |  |  |  | 9 | elsif ($char[$i] =~ /\A ([<>]) \z/oxms) { | 
| 10792 |  |  |  |  |  |  | if ($right_e < $left_e) { | 
| 10793 |  |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 10794 |  |  |  |  |  |  | } | 
| 10795 | 0 |  |  |  |  | 0 | } | 
| 10796 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\u') { | 
| 10797 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ucfirst qq<'; | 
| 10798 |  |  |  |  |  |  | $left_e++; | 
| 10799 | 0 |  |  |  |  | 0 | } | 
| 10800 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\l') { | 
| 10801 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lcfirst qq<'; | 
| 10802 |  |  |  |  |  |  | $left_e++; | 
| 10803 | 0 |  |  |  |  | 0 | } | 
| 10804 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\U') { | 
| 10805 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::uc qq<'; | 
| 10806 |  |  |  |  |  |  | $left_e++; | 
| 10807 | 0 |  |  |  |  | 0 | } | 
| 10808 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\L') { | 
| 10809 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::lc qq<'; | 
| 10810 |  |  |  |  |  |  | $left_e++; | 
| 10811 | 0 |  |  |  |  | 0 | } | 
| 10812 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\F') { | 
| 10813 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::fc qq<'; | 
| 10814 |  |  |  |  |  |  | $left_e++; | 
| 10815 | 0 |  |  |  |  | 0 | } | 
| 10816 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 10817 |  |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 10818 |  |  |  |  |  |  | $left_e++; | 
| 10819 | 0 | 0 |  |  |  | 0 | } | 
| 10820 | 0 |  |  |  |  | 0 | elsif ($char[$i] eq '\E') { | 
| 10821 | 0 |  |  |  |  | 0 | if ($right_e < $left_e) { | 
| 10822 |  |  |  |  |  |  | $char[$i] = '>]}'; | 
| 10823 |  |  |  |  |  |  | $right_e++; | 
| 10824 | 0 |  |  |  |  | 0 | } | 
| 10825 |  |  |  |  |  |  | else { | 
| 10826 |  |  |  |  |  |  | $char[$i] = ''; | 
| 10827 |  |  |  |  |  |  | } | 
| 10828 | 0 |  |  |  |  | 0 | } | 
| 10829 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '\Q') { | 
| 10830 | 0 |  |  |  |  | 0 | while (1) { | 
| 10831 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 10832 | 0 | 0 |  |  |  | 0 | last; | 
| 10833 | 0 |  |  |  |  | 0 | } | 
| 10834 |  |  |  |  |  |  | if ($char[$i] eq '\E') { | 
| 10835 |  |  |  |  |  |  | last; | 
| 10836 |  |  |  |  |  |  | } | 
| 10837 |  |  |  |  |  |  | } | 
| 10838 |  |  |  |  |  |  | } | 
| 10839 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 10840 |  |  |  |  |  |  | } | 
| 10841 |  |  |  |  |  |  |  | 
| 10842 | 0 | 0 |  |  |  | 0 | # $0 --> $0 | 
| 10843 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 10844 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10845 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10846 |  |  |  |  |  |  | } | 
| 10847 | 0 | 0 |  |  |  | 0 | } | 
| 10848 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 10849 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10850 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10851 |  |  |  |  |  |  | } | 
| 10852 |  |  |  |  |  |  | } | 
| 10853 |  |  |  |  |  |  |  | 
| 10854 |  |  |  |  |  |  | # $$ --> $$ | 
| 10855 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 10856 |  |  |  |  |  |  | } | 
| 10857 |  |  |  |  |  |  |  | 
| 10858 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 10859 | 0 |  |  |  |  | 0 | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 10860 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 10861 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 10862 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10863 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10864 |  |  |  |  |  |  | } | 
| 10865 | 0 |  |  |  |  | 0 | } | 
| 10866 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 10867 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 10868 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10869 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10870 |  |  |  |  |  |  | } | 
| 10871 |  |  |  |  |  |  | } | 
| 10872 |  |  |  |  |  |  |  | 
| 10873 | 0 |  |  |  |  | 0 | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 10874 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 10875 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1.'->'.$2); | 
| 10876 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10877 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10878 |  |  |  |  |  |  | } | 
| 10879 |  |  |  |  |  |  | } | 
| 10880 |  |  |  |  |  |  |  | 
| 10881 | 0 |  |  |  |  | 0 | # $$foo{ ... } --> $ $foo->{ ... } | 
| 10882 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 10883 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1.'->'.$2); | 
| 10884 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10885 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10886 |  |  |  |  |  |  | } | 
| 10887 |  |  |  |  |  |  | } | 
| 10888 |  |  |  |  |  |  |  | 
| 10889 | 0 |  |  |  |  | 0 | # $$foo | 
| 10890 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 10891 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 10892 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10893 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10894 |  |  |  |  |  |  | } | 
| 10895 |  |  |  |  |  |  | } | 
| 10896 |  |  |  |  |  |  |  | 
| 10897 | 0 | 50 |  |  |  | 0 | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Ebig5hkscs::PREMATCH() | 
| 10898 | 12 |  |  |  |  | 37 | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 10899 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10900 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::PREMATCH())]}'; | 
| 10901 | 0 |  |  |  |  | 0 | } | 
| 10902 |  |  |  |  |  |  | else { | 
| 10903 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::PREMATCH()]}'; | 
| 10904 |  |  |  |  |  |  | } | 
| 10905 |  |  |  |  |  |  | } | 
| 10906 |  |  |  |  |  |  |  | 
| 10907 | 12 | 50 |  |  |  | 61 | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Ebig5hkscs::MATCH() | 
| 10908 | 12 |  |  |  |  | 43 | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 10909 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10910 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::MATCH())]}'; | 
| 10911 | 0 |  |  |  |  | 0 | } | 
| 10912 |  |  |  |  |  |  | else { | 
| 10913 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::MATCH()]}'; | 
| 10914 |  |  |  |  |  |  | } | 
| 10915 |  |  |  |  |  |  | } | 
| 10916 |  |  |  |  |  |  |  | 
| 10917 | 12 | 50 |  |  |  | 68 | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Ebig5hkscs::POSTMATCH() | 
| 10918 | 9 |  |  |  |  | 25 | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 10919 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10920 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(Ebig5hkscs::POSTMATCH())]}'; | 
| 10921 | 0 |  |  |  |  | 0 | } | 
| 10922 |  |  |  |  |  |  | else { | 
| 10923 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::POSTMATCH()]}'; | 
| 10924 |  |  |  |  |  |  | } | 
| 10925 |  |  |  |  |  |  | } | 
| 10926 |  |  |  |  |  |  |  | 
| 10927 | 9 | 0 |  |  |  | 50 | # ${ foo } | 
| 10928 | 0 |  |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \}                            \z/oxms) { | 
| 10929 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10930 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $1 . ')]}'; | 
| 10931 |  |  |  |  |  |  | } | 
| 10932 |  |  |  |  |  |  | } | 
| 10933 |  |  |  |  |  |  |  | 
| 10934 | 0 |  |  |  |  | 0 | # ${ ... } | 
| 10935 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 10936 | 0 |  |  |  |  | 0 | $char[$i] = e_capture($1); | 
| 10937 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10938 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10939 |  |  |  |  |  |  | } | 
| 10940 |  |  |  |  |  |  | } | 
| 10941 |  |  |  |  |  |  |  | 
| 10942 | 0 |  |  |  |  | 0 | # $scalar or @array | 
| 10943 | 3 | 50 |  |  |  | 10 | elsif ($char[$i] =~ /\A [\$\@].+ /oxms) { | 
| 10944 | 3 |  |  |  |  | 17 | $char[$i] = e_string($char[$i]); | 
| 10945 |  |  |  |  |  |  | if ($ignorecase) { | 
| 10946 |  |  |  |  |  |  | $char[$i] = '@{[Ebig5hkscs::ignorecase(' . $char[$i] . ')]}'; | 
| 10947 |  |  |  |  |  |  | } | 
| 10948 |  |  |  |  |  |  | } | 
| 10949 |  |  |  |  |  |  |  | 
| 10950 | 0 | 100 |  |  |  | 0 | # quote character before ? + * { | 
| 10951 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 10952 |  |  |  |  |  |  | if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) { | 
| 10953 | 7 |  |  |  |  | 51 | } | 
| 10954 |  |  |  |  |  |  | else { | 
| 10955 |  |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 10956 |  |  |  |  |  |  | } | 
| 10957 |  |  |  |  |  |  | } | 
| 10958 |  |  |  |  |  |  | } | 
| 10959 | 4 |  |  |  |  | 22 |  | 
| 10960 | 189 | 50 |  |  |  | 608 | # make regexp string | 
| 10961 | 189 |  |  |  |  | 453 | $modifier =~ tr/i//d; | 
| 10962 |  |  |  |  |  |  | if ($left_e > $right_e) { | 
| 10963 | 0 |  |  |  |  | 0 | return join '', 'Ebig5hkscs::split', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter, $modifier; | 
| 10964 |  |  |  |  |  |  | } | 
| 10965 |  |  |  |  |  |  | return     join '', 'Ebig5hkscs::split', $ope, $delimiter, @char,                               $end_delimiter, $modifier; | 
| 10966 |  |  |  |  |  |  | } | 
| 10967 |  |  |  |  |  |  |  | 
| 10968 |  |  |  |  |  |  | # | 
| 10969 |  |  |  |  |  |  | # escape regexp of split qr'' | 
| 10970 | 189 |  |  | 112 | 0 | 1759 | # | 
| 10971 | 112 |  | 100 |  |  | 1036 | sub e_split_q { | 
| 10972 |  |  |  |  |  |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 10973 | 112 |  |  |  |  | 360 | $modifier ||= ''; | 
| 10974 | 112 | 50 |  |  |  | 269 |  | 
| 10975 | 112 |  |  |  |  | 356 | $modifier =~ tr/p//d; | 
| 10976 | 0 |  |  |  |  | 0 | if ($modifier =~ /([adlu])/oxms) { | 
| 10977 | 0 | 0 |  |  |  | 0 | my $line = 0; | 
| 10978 | 0 |  |  |  |  | 0 | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 10979 | 0 |  |  |  |  | 0 | if ($filename ne __FILE__) { | 
| 10980 |  |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 10981 |  |  |  |  |  |  | last; | 
| 10982 | 0 |  |  |  |  | 0 | } | 
| 10983 |  |  |  |  |  |  | } | 
| 10984 |  |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 10985 | 0 |  |  |  |  | 0 | } | 
| 10986 |  |  |  |  |  |  |  | 
| 10987 |  |  |  |  |  |  | $slash = 'div'; | 
| 10988 | 112 | 100 |  |  |  | 311 |  | 
| 10989 | 112 |  |  |  |  | 413 | # /b /B modifier | 
| 10990 |  |  |  |  |  |  | if ($modifier =~ tr/bB//d) { | 
| 10991 |  |  |  |  |  |  | return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier; | 
| 10992 | 56 | 100 |  |  |  | 316 | } | 
| 10993 |  |  |  |  |  |  |  | 
| 10994 |  |  |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 10995 | 56 |  |  |  |  | 154 |  | 
| 10996 |  |  |  |  |  |  | # split regexp | 
| 10997 |  |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 10998 |  |  |  |  |  |  | [^\x81-\xFE\\\[]       | | 
| 10999 |  |  |  |  |  |  | [\x81-\xFE][\x00-\xFF] | | 
| 11000 |  |  |  |  |  |  | \[\^                            | | 
| 11001 |  |  |  |  |  |  | \[\:   (?>[a-z]+) \:\]          | | 
| 11002 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) \:\]          | | 
| 11003 |  |  |  |  |  |  | \\     (?:$q_char)              | | 
| 11004 |  |  |  |  |  |  | (?:$q_char) | 
| 11005 |  |  |  |  |  |  | ))/oxmsg; | 
| 11006 | 56 |  |  |  |  | 516 |  | 
| 11007 | 56 | 50 | 33 |  |  | 188 | # unescape character | 
|  |  | 50 | 100 |  |  |  |  | 
|  |  | 50 | 66 |  |  |  |  | 
|  |  | 50 | 33 |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 11008 |  |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 11009 |  |  |  |  |  |  | if (0) { | 
| 11010 |  |  |  |  |  |  | } | 
| 11011 | 56 |  |  |  |  | 567 |  | 
| 11012 | 0 |  |  |  |  | 0 | # escape last octet of multiple-octet | 
| 11013 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([\x80-\xFF].*) ([\\|\[\{\^]|\Q$delimiter\E|\Q$end_delimiter\E) \z/xms) { | 
| 11014 |  |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 11015 |  |  |  |  |  |  | } | 
| 11016 |  |  |  |  |  |  |  | 
| 11017 | 0 |  |  |  |  | 0 | # open character class [...] | 
| 11018 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[') { | 
| 11019 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 11020 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 11021 | 0 |  |  |  |  | 0 | $i++; | 
| 11022 | 0 | 0 |  |  |  | 0 | } | 
| 11023 | 0 |  |  |  |  | 0 | while (1) { | 
| 11024 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 11025 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 11026 | 0 |  |  |  |  | 0 | } | 
| 11027 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 11028 |  |  |  |  |  |  | my $right = $i; | 
| 11029 | 0 |  |  |  |  | 0 |  | 
| 11030 |  |  |  |  |  |  | # [...] | 
| 11031 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 11032 | 0 |  |  |  |  | 0 |  | 
| 11033 |  |  |  |  |  |  | $i = $left; | 
| 11034 |  |  |  |  |  |  | last; | 
| 11035 |  |  |  |  |  |  | } | 
| 11036 |  |  |  |  |  |  | } | 
| 11037 |  |  |  |  |  |  | } | 
| 11038 |  |  |  |  |  |  |  | 
| 11039 | 0 |  |  |  |  | 0 | # open character class [^...] | 
| 11040 | 0 | 0 |  |  |  | 0 | elsif ($char[$i] eq '[^') { | 
| 11041 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 11042 |  |  |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 11043 | 0 |  |  |  |  | 0 | $i++; | 
| 11044 | 0 | 0 |  |  |  | 0 | } | 
| 11045 | 0 |  |  |  |  | 0 | while (1) { | 
| 11046 |  |  |  |  |  |  | if (++$i > $#char) { | 
| 11047 | 0 | 0 |  |  |  | 0 | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 11048 | 0 |  |  |  |  | 0 | } | 
| 11049 |  |  |  |  |  |  | if ($char[$i] eq ']') { | 
| 11050 |  |  |  |  |  |  | my $right = $i; | 
| 11051 | 0 |  |  |  |  | 0 |  | 
| 11052 |  |  |  |  |  |  | # [^...] | 
| 11053 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, Ebig5hkscs::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 11054 | 0 |  |  |  |  | 0 |  | 
| 11055 |  |  |  |  |  |  | $i = $left; | 
| 11056 |  |  |  |  |  |  | last; | 
| 11057 |  |  |  |  |  |  | } | 
| 11058 |  |  |  |  |  |  | } | 
| 11059 |  |  |  |  |  |  | } | 
| 11060 |  |  |  |  |  |  |  | 
| 11061 | 0 |  |  |  |  | 0 | # rewrite character class or escape character | 
| 11062 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 11063 |  |  |  |  |  |  | $char[$i] = $char; | 
| 11064 |  |  |  |  |  |  | } | 
| 11065 |  |  |  |  |  |  |  | 
| 11066 | 0 |  |  |  |  | 0 | # split(m/^/) --> split(m/^/m) | 
| 11067 |  |  |  |  |  |  | elsif (($char[$i] eq '^') and ($modifier !~ /m/oxms)) { | 
| 11068 |  |  |  |  |  |  | $modifier .= 'm'; | 
| 11069 |  |  |  |  |  |  | } | 
| 11070 |  |  |  |  |  |  |  | 
| 11071 | 0 | 50 |  |  |  | 0 | # /i modifier | 
| 11072 | 12 |  |  |  |  | 35 | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Ebig5hkscs::uc($char[$i]) ne Ebig5hkscs::fc($char[$i]))) { | 
| 11073 |  |  |  |  |  |  | if (CORE::length(Ebig5hkscs::fc($char[$i])) == 1) { | 
| 11074 |  |  |  |  |  |  | $char[$i] = '['   . Ebig5hkscs::uc($char[$i])       . Ebig5hkscs::fc($char[$i]) . ']'; | 
| 11075 | 12 |  |  |  |  | 32 | } | 
| 11076 |  |  |  |  |  |  | else { | 
| 11077 |  |  |  |  |  |  | $char[$i] = '(?:' . Ebig5hkscs::uc($char[$i]) . '|' . Ebig5hkscs::fc($char[$i]) . ')'; | 
| 11078 |  |  |  |  |  |  | } | 
| 11079 |  |  |  |  |  |  | } | 
| 11080 |  |  |  |  |  |  |  | 
| 11081 | 0 | 0 |  |  |  | 0 | # quote character before ? + * { | 
| 11082 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 11083 |  |  |  |  |  |  | if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 11084 | 0 |  |  |  |  | 0 | } | 
| 11085 |  |  |  |  |  |  | else { | 
| 11086 |  |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 11087 |  |  |  |  |  |  | } | 
| 11088 |  |  |  |  |  |  | } | 
| 11089 | 0 |  |  |  |  | 0 | } | 
| 11090 | 56 |  |  |  |  | 121 |  | 
| 11091 |  |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 11092 |  |  |  |  |  |  | return join '', 'Ebig5hkscs::split', $ope, $delimiter, @char, $end_delimiter, $modifier; | 
| 11093 |  |  |  |  |  |  | } | 
| 11094 |  |  |  |  |  |  |  | 
| 11095 |  |  |  |  |  |  | # | 
| 11096 |  |  |  |  |  |  | # escape use without import | 
| 11097 | 56 |  |  | 0 | 0 | 309 | # | 
| 11098 |  |  |  |  |  |  | sub e_use_noimport { | 
| 11099 | 0 |  |  |  |  |  | my($module) = @_; | 
| 11100 |  |  |  |  |  |  |  | 
| 11101 | 0 |  |  |  |  |  | my $expr = _pathof($module); | 
| 11102 | 0 |  |  |  |  |  |  | 
| 11103 |  |  |  |  |  |  | my $fh = gensym(); | 
| 11104 | 0 | 0 |  |  |  |  | for my $realfilename (_realfilename($expr)) { | 
| 11105 | 0 |  |  |  |  |  |  | 
| 11106 | 0 |  |  |  |  |  | if (Ebig5hkscs::_open_r($fh, $realfilename)) { | 
| 11107 | 0 | 0 |  |  |  |  | local $/ = undef; # slurp mode | 
| 11108 |  |  |  |  |  |  | my $script = <$fh>; | 
| 11109 | 0 | 0 |  |  |  |  | close($fh) or die __FILE__, ": Can't close file: $realfilename\n"; | 
| 11110 | 0 |  |  |  |  |  |  | 
| 11111 |  |  |  |  |  |  | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 11112 | 0 |  |  |  |  |  | return qq; | 
| 11113 |  |  |  |  |  |  | } | 
| 11114 |  |  |  |  |  |  | last; | 
| 11115 |  |  |  |  |  |  | } | 
| 11116 | 0 |  |  |  |  |  | } | 
| 11117 |  |  |  |  |  |  |  | 
| 11118 |  |  |  |  |  |  | return qq | 
| 11119 |  |  |  |  |  |  | } | 
| 11120 |  |  |  |  |  |  |  | 
| 11121 |  |  |  |  |  |  | # | 
| 11122 |  |  |  |  |  |  | # escape no without unimport | 
| 11123 | 0 |  |  | 0 | 0 |  | # | 
| 11124 |  |  |  |  |  |  | sub e_no_nounimport { | 
| 11125 | 0 |  |  |  |  |  | my($module) = @_; | 
| 11126 |  |  |  |  |  |  |  | 
| 11127 | 0 |  |  |  |  |  | my $expr = _pathof($module); | 
| 11128 | 0 |  |  |  |  |  |  | 
| 11129 |  |  |  |  |  |  | my $fh = gensym(); | 
| 11130 | 0 | 0 |  |  |  |  | for my $realfilename (_realfilename($expr)) { | 
| 11131 | 0 |  |  |  |  |  |  | 
| 11132 | 0 |  |  |  |  |  | if (Ebig5hkscs::_open_r($fh, $realfilename)) { | 
| 11133 | 0 | 0 |  |  |  |  | local $/ = undef; # slurp mode | 
| 11134 |  |  |  |  |  |  | my $script = <$fh>; | 
| 11135 | 0 | 0 |  |  |  |  | close($fh) or die __FILE__, ": Can't close file: $realfilename\n"; | 
| 11136 | 0 |  |  |  |  |  |  | 
| 11137 |  |  |  |  |  |  | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 11138 | 0 |  |  |  |  |  | return qq; | 
| 11139 |  |  |  |  |  |  | } | 
| 11140 |  |  |  |  |  |  | last; | 
| 11141 |  |  |  |  |  |  | } | 
| 11142 | 0 |  |  |  |  |  | } | 
| 11143 |  |  |  |  |  |  |  | 
| 11144 |  |  |  |  |  |  | return qq; | 
| 11145 |  |  |  |  |  |  | } | 
| 11146 |  |  |  |  |  |  |  | 
| 11147 |  |  |  |  |  |  | # | 
| 11148 |  |  |  |  |  |  | # escape use with import no parameter | 
| 11149 | 0 |  |  | 0 | 0 |  | # | 
| 11150 |  |  |  |  |  |  | sub e_use_noparam { | 
| 11151 | 0 |  |  |  |  |  | my($module) = @_; | 
| 11152 |  |  |  |  |  |  |  | 
| 11153 | 0 |  |  |  |  |  | my $expr = _pathof($module); | 
| 11154 | 0 |  |  |  |  |  |  | 
| 11155 |  |  |  |  |  |  | my $fh = gensym(); | 
| 11156 | 0 | 0 |  |  |  |  | for my $realfilename (_realfilename($expr)) { | 
| 11157 | 0 |  |  |  |  |  |  | 
| 11158 | 0 |  |  |  |  |  | if (Ebig5hkscs::_open_r($fh, $realfilename)) { | 
| 11159 | 0 | 0 |  |  |  |  | local $/ = undef; # slurp mode | 
| 11160 |  |  |  |  |  |  | my $script = <$fh>; | 
| 11161 | 0 | 0 |  |  |  |  | close($fh) or die __FILE__, ": Can't close file: $realfilename\n"; | 
| 11162 |  |  |  |  |  |  |  | 
| 11163 |  |  |  |  |  |  | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 11164 |  |  |  |  |  |  |  | 
| 11165 |  |  |  |  |  |  | # P.326 UNIVERSAL: The Ultimate Ancestor Class | 
| 11166 |  |  |  |  |  |  | # in Chapter 12: Objects | 
| 11167 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 11168 |  |  |  |  |  |  |  | 
| 11169 |  |  |  |  |  |  | # P.435 UNIVERSAL: The Ultimate Ancestor Class | 
| 11170 |  |  |  |  |  |  | # in Chapter 12: Objects | 
| 11171 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 11172 |  |  |  |  |  |  |  | 
| 11173 | 0 |  |  |  |  |  | # (and so on) | 
| 11174 |  |  |  |  |  |  |  | 
| 11175 | 0 |  |  |  |  |  | return qq[BEGIN { Ebig5hkscs::require '$expr'; $module->import() if $module->can('import'); }]; | 
| 11176 |  |  |  |  |  |  | } | 
| 11177 |  |  |  |  |  |  | last; | 
| 11178 |  |  |  |  |  |  | } | 
| 11179 | 0 |  |  |  |  |  | } | 
| 11180 |  |  |  |  |  |  |  | 
| 11181 |  |  |  |  |  |  | return qq | 
| 11182 |  |  |  |  |  |  | } | 
| 11183 |  |  |  |  |  |  |  | 
| 11184 |  |  |  |  |  |  | # | 
| 11185 |  |  |  |  |  |  | # escape no with unimport no parameter | 
| 11186 | 0 |  |  | 0 | 0 |  | # | 
| 11187 |  |  |  |  |  |  | sub e_no_noparam { | 
| 11188 | 0 |  |  |  |  |  | my($module) = @_; | 
| 11189 |  |  |  |  |  |  |  | 
| 11190 | 0 |  |  |  |  |  | my $expr = _pathof($module); | 
| 11191 | 0 |  |  |  |  |  |  | 
| 11192 |  |  |  |  |  |  | my $fh = gensym(); | 
| 11193 | 0 | 0 |  |  |  |  | for my $realfilename (_realfilename($expr)) { | 
| 11194 | 0 |  |  |  |  |  |  | 
| 11195 | 0 |  |  |  |  |  | if (Ebig5hkscs::_open_r($fh, $realfilename)) { | 
| 11196 | 0 | 0 |  |  |  |  | local $/ = undef; # slurp mode | 
| 11197 |  |  |  |  |  |  | my $script = <$fh>; | 
| 11198 | 0 | 0 |  |  |  |  | close($fh) or die __FILE__, ": Can't close file: $realfilename\n"; | 
| 11199 | 0 |  |  |  |  |  |  | 
| 11200 |  |  |  |  |  |  | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 11201 | 0 |  |  |  |  |  | return qq[BEGIN { Ebig5hkscs::require '$expr'; $module->unimport() if $module->can('unimport'); }]; | 
| 11202 |  |  |  |  |  |  | } | 
| 11203 |  |  |  |  |  |  | last; | 
| 11204 |  |  |  |  |  |  | } | 
| 11205 | 0 |  |  |  |  |  | } | 
| 11206 |  |  |  |  |  |  |  | 
| 11207 |  |  |  |  |  |  | return qq; | 
| 11208 |  |  |  |  |  |  | } | 
| 11209 |  |  |  |  |  |  |  | 
| 11210 |  |  |  |  |  |  | # | 
| 11211 |  |  |  |  |  |  | # escape use with import parameters | 
| 11212 | 0 |  |  | 0 | 0 |  | # | 
| 11213 |  |  |  |  |  |  | sub e_use { | 
| 11214 | 0 |  |  |  |  |  | my($module,$list) = @_; | 
| 11215 |  |  |  |  |  |  |  | 
| 11216 | 0 |  |  |  |  |  | my $expr = _pathof($module); | 
| 11217 | 0 |  |  |  |  |  |  | 
| 11218 |  |  |  |  |  |  | my $fh = gensym(); | 
| 11219 | 0 | 0 |  |  |  |  | for my $realfilename (_realfilename($expr)) { | 
| 11220 | 0 |  |  |  |  |  |  | 
| 11221 | 0 |  |  |  |  |  | if (Ebig5hkscs::_open_r($fh, $realfilename)) { | 
| 11222 | 0 | 0 |  |  |  |  | local $/ = undef; # slurp mode | 
| 11223 |  |  |  |  |  |  | my $script = <$fh>; | 
| 11224 | 0 | 0 |  |  |  |  | close($fh) or die __FILE__, ": Can't close file: $realfilename\n"; | 
| 11225 | 0 |  |  |  |  |  |  | 
| 11226 |  |  |  |  |  |  | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 11227 | 0 |  |  |  |  |  | return qq[BEGIN { Ebig5hkscs::require '$expr'; $module->import($list) if $module->can('import'); }]; | 
| 11228 |  |  |  |  |  |  | } | 
| 11229 |  |  |  |  |  |  | last; | 
| 11230 |  |  |  |  |  |  | } | 
| 11231 | 0 |  |  |  |  |  | } | 
| 11232 |  |  |  |  |  |  |  | 
| 11233 |  |  |  |  |  |  | return qq | 
| 11234 |  |  |  |  |  |  | } | 
| 11235 |  |  |  |  |  |  |  | 
| 11236 |  |  |  |  |  |  | # | 
| 11237 |  |  |  |  |  |  | # escape no with unimport parameters | 
| 11238 | 0 |  |  | 0 | 0 |  | # | 
| 11239 |  |  |  |  |  |  | sub e_no { | 
| 11240 | 0 |  |  |  |  |  | my($module,$list) = @_; | 
| 11241 |  |  |  |  |  |  |  | 
| 11242 | 0 |  |  |  |  |  | my $expr = _pathof($module); | 
| 11243 | 0 |  |  |  |  |  |  | 
| 11244 |  |  |  |  |  |  | my $fh = gensym(); | 
| 11245 | 0 | 0 |  |  |  |  | for my $realfilename (_realfilename($expr)) { | 
| 11246 | 0 |  |  |  |  |  |  | 
| 11247 | 0 |  |  |  |  |  | if (Ebig5hkscs::_open_r($fh, $realfilename)) { | 
| 11248 | 0 | 0 |  |  |  |  | local $/ = undef; # slurp mode | 
| 11249 |  |  |  |  |  |  | my $script = <$fh>; | 
| 11250 | 0 | 0 |  |  |  |  | close($fh) or die __FILE__, ": Can't close file: $realfilename\n"; | 
| 11251 | 0 |  |  |  |  |  |  | 
| 11252 |  |  |  |  |  |  | if ($script =~ /^ (?>\s*) use (?>\s+) Big5HKSCS (?>\s*) ([^\x81-\xFE;]*) ; (?>\s*) \n? $/oxms) { | 
| 11253 | 0 |  |  |  |  |  | return qq[BEGIN { Ebig5hkscs::require '$expr'; $module->unimport($list) if $module->can('unimport'); }]; | 
| 11254 |  |  |  |  |  |  | } | 
| 11255 |  |  |  |  |  |  | last; | 
| 11256 |  |  |  |  |  |  | } | 
| 11257 | 0 |  |  |  |  |  | } | 
| 11258 |  |  |  |  |  |  |  | 
| 11259 |  |  |  |  |  |  | return qq; | 
| 11260 |  |  |  |  |  |  | } | 
| 11261 |  |  |  |  |  |  |  | 
| 11262 |  |  |  |  |  |  | # | 
| 11263 |  |  |  |  |  |  | # file path of module | 
| 11264 | 0 |  |  | 0 |  |  | # | 
| 11265 |  |  |  |  |  |  | sub _pathof { | 
| 11266 | 0 | 0 |  |  |  |  | my($expr) = @_; | 
| 11267 | 0 |  |  |  |  |  |  | 
| 11268 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 11269 |  |  |  |  |  |  | $expr =~ s#::#:#g; | 
| 11270 | 0 |  |  |  |  |  | } | 
| 11271 |  |  |  |  |  |  | else { | 
| 11272 | 0 | 0 |  |  |  |  | $expr =~ s#::#/#g; | 
| 11273 |  |  |  |  |  |  | } | 
| 11274 | 0 |  |  |  |  |  | $expr .= '.pm' if $expr !~ / \.pm \z/oxmsi; | 
| 11275 |  |  |  |  |  |  |  | 
| 11276 |  |  |  |  |  |  | return $expr; | 
| 11277 |  |  |  |  |  |  | } | 
| 11278 |  |  |  |  |  |  |  | 
| 11279 |  |  |  |  |  |  | # | 
| 11280 |  |  |  |  |  |  | # real file name of module | 
| 11281 | 0 |  |  | 0 |  |  | # | 
| 11282 |  |  |  |  |  |  | sub _realfilename { | 
| 11283 | 0 | 0 |  |  |  |  | my($expr) = @_; | 
| 11284 | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 11285 |  |  |  |  |  |  | if ($^O eq 'MacOS') { | 
| 11286 |  |  |  |  |  |  | return map {"$_$expr"} @INC; | 
| 11287 | 0 |  |  |  |  |  | } | 
|  | 0 |  |  |  |  |  |  | 
| 11288 |  |  |  |  |  |  | else { | 
| 11289 |  |  |  |  |  |  | return map {"$_/$expr"} @INC; | 
| 11290 |  |  |  |  |  |  | } | 
| 11291 |  |  |  |  |  |  | } | 
| 11292 |  |  |  |  |  |  |  | 
| 11293 |  |  |  |  |  |  | # | 
| 11294 |  |  |  |  |  |  | # instead of Carp::carp | 
| 11295 | 0 |  |  | 0 | 0 |  | # | 
| 11296 | 0 |  |  |  |  |  | sub carp { | 
| 11297 |  |  |  |  |  |  | my($package,$filename,$line) = caller(1); | 
| 11298 |  |  |  |  |  |  | print STDERR "@_ at $filename line $line.\n"; | 
| 11299 |  |  |  |  |  |  | } | 
| 11300 |  |  |  |  |  |  |  | 
| 11301 |  |  |  |  |  |  | # | 
| 11302 |  |  |  |  |  |  | # instead of Carp::croak | 
| 11303 | 0 |  |  | 0 | 0 |  | # | 
| 11304 | 0 |  |  |  |  |  | sub croak { | 
| 11305 | 0 |  |  |  |  |  | my($package,$filename,$line) = caller(1); | 
| 11306 |  |  |  |  |  |  | print STDERR "@_ at $filename line $line.\n"; | 
| 11307 |  |  |  |  |  |  | die "\n"; | 
| 11308 |  |  |  |  |  |  | } | 
| 11309 |  |  |  |  |  |  |  | 
| 11310 |  |  |  |  |  |  | # | 
| 11311 |  |  |  |  |  |  | # instead of Carp::cluck | 
| 11312 | 0 |  |  | 0 | 0 |  | # | 
| 11313 | 0 |  |  |  |  |  | sub cluck { | 
| 11314 | 0 |  |  |  |  |  | my $i = 0; | 
| 11315 | 0 |  |  |  |  |  | my @cluck = (); | 
| 11316 | 0 |  |  |  |  |  | while (my($package,$filename,$line,$subroutine) = caller($i)) { | 
| 11317 |  |  |  |  |  |  | push @cluck, "[$i] $filename($line) $package::$subroutine\n"; | 
| 11318 | 0 |  |  |  |  |  | $i++; | 
| 11319 | 0 |  |  |  |  |  | } | 
| 11320 | 0 |  |  |  |  |  | print STDERR CORE::reverse @cluck; | 
| 11321 |  |  |  |  |  |  | print STDERR "\n"; | 
| 11322 |  |  |  |  |  |  | print STDERR @_; | 
| 11323 |  |  |  |  |  |  | } | 
| 11324 |  |  |  |  |  |  |  | 
| 11325 |  |  |  |  |  |  | # | 
| 11326 |  |  |  |  |  |  | # instead of Carp::confess | 
| 11327 | 0 |  |  | 0 | 0 |  | # | 
| 11328 | 0 |  |  |  |  |  | sub confess { | 
| 11329 | 0 |  |  |  |  |  | my $i = 0; | 
| 11330 | 0 |  |  |  |  |  | my @confess = (); | 
| 11331 | 0 |  |  |  |  |  | while (my($package,$filename,$line,$subroutine) = caller($i)) { | 
| 11332 |  |  |  |  |  |  | push @confess, "[$i] $filename($line) $package::$subroutine\n"; | 
| 11333 | 0 |  |  |  |  |  | $i++; | 
| 11334 | 0 |  |  |  |  |  | } | 
| 11335 | 0 |  |  |  |  |  | print STDERR CORE::reverse @confess; | 
| 11336 | 0 |  |  |  |  |  | print STDERR "\n"; | 
| 11337 |  |  |  |  |  |  | print STDERR @_; | 
| 11338 |  |  |  |  |  |  | die "\n"; | 
| 11339 |  |  |  |  |  |  | } | 
| 11340 |  |  |  |  |  |  |  | 
| 11341 |  |  |  |  |  |  | 1; | 
| 11342 |  |  |  |  |  |  |  | 
| 11343 |  |  |  |  |  |  | __END__ |