| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Elatin6; | 
| 2 |  |  |  |  |  |  | ###################################################################### | 
| 3 |  |  |  |  |  |  | # | 
| 4 |  |  |  |  |  |  | # Elatin6 - Run-time routines for Latin6.pm | 
| 5 |  |  |  |  |  |  | # | 
| 6 |  |  |  |  |  |  | # http://search.cpan.org/dist/Char-Latin6/ | 
| 7 |  |  |  |  |  |  | # | 
| 8 |  |  |  |  |  |  | # Copyright (c) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 INABA Hitoshi | 
| 9 |  |  |  |  |  |  | ###################################################################### | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 200 |  |  | 200 |  | 5124 | use 5.00503;    # Galapagos Consensus 1998 for primetools | 
|  | 200 |  |  |  |  | 630 |  | 
|  | 200 |  |  |  |  | 11784 |  | 
| 12 |  |  |  |  |  |  | # use 5.008001; # Lancaster Consensus 2013 for toolchains | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | # 12.3. Delaying use Until Runtime | 
| 15 |  |  |  |  |  |  | # in Chapter 12. Packages, Libraries, and Modules | 
| 16 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 17 |  |  |  |  |  |  | # (and so on) | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | # Version numbers should be boring | 
| 20 |  |  |  |  |  |  | # http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/ | 
| 21 |  |  |  |  |  |  | # For the impatient, the disinterested or those who just want to follow | 
| 22 |  |  |  |  |  |  | # a recipe, my advice for all modules is this: | 
| 23 |  |  |  |  |  |  | # our $VERSION = "0.001"; # or "0.001_001" for a dev release | 
| 24 |  |  |  |  |  |  | # $VERSION = eval $VERSION; | 
| 25 |  |  |  |  |  |  |  | 
| 26 | 200 |  |  | 200 |  | 15782 | BEGIN { CORE::eval q{ use vars qw($VERSION) } } | 
|  | 200 |  |  | 200 |  | 1227 |  | 
|  | 200 |  |  |  |  | 349 |  | 
|  | 200 |  |  |  |  | 34127 |  | 
| 27 |  |  |  |  |  |  | $VERSION = '1.05'; | 
| 28 |  |  |  |  |  |  | $VERSION = CORE::eval $VERSION; | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | BEGIN { | 
| 31 | 200 | 50 |  | 200 |  | 1771 | if ($^X =~ / jperl /oxmsi) { | 
| 32 | 0 |  |  |  |  | 0 | die __FILE__, ": needs perl(not jperl) 5.00503 or later. (\$^X==$^X)\n"; | 
| 33 |  |  |  |  |  |  | } | 
| 34 | 200 |  |  |  |  | 450 | if (CORE::ord('A') == 193) { | 
| 35 |  |  |  |  |  |  | die __FILE__, ": is not US-ASCII script (may be EBCDIC or EBCDIK script).\n"; | 
| 36 |  |  |  |  |  |  | } | 
| 37 | 200 |  |  |  |  | 34176 | if (CORE::ord('A') != 0x41) { | 
| 38 |  |  |  |  |  |  | die __FILE__, ": is not US-ASCII script (must be US-ASCII script).\n"; | 
| 39 |  |  |  |  |  |  | } | 
| 40 |  |  |  |  |  |  | } | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | BEGIN { | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | # instead of utf8.pm | 
| 45 | 200 |  |  | 200 |  | 16486 | CORE::eval q{ | 
|  | 200 |  |  | 200 |  | 1451 |  | 
|  | 200 |  |  | 60 |  | 332 |  | 
|  | 200 |  |  |  |  | 30026 |  | 
|  | 60 |  |  |  |  | 11902 |  | 
|  | 64 |  |  |  |  | 13720 |  | 
|  | 61 |  |  |  |  | 12272 |  | 
|  | 62 |  |  |  |  | 11375 |  | 
|  | 81 |  |  |  |  | 15029 |  | 
|  | 72 |  |  |  |  | 13333 |  | 
| 46 |  |  |  |  |  |  | no warnings qw(redefine); | 
| 47 |  |  |  |  |  |  | *utf8::upgrade   = sub { CORE::length $_[0] }; | 
| 48 |  |  |  |  |  |  | *utf8::downgrade = sub { 1 }; | 
| 49 |  |  |  |  |  |  | *utf8::encode    = sub {   }; | 
| 50 |  |  |  |  |  |  | *utf8::decode    = sub { 1 }; | 
| 51 |  |  |  |  |  |  | *utf8::is_utf8   = sub {   }; | 
| 52 |  |  |  |  |  |  | *utf8::valid     = sub { 1 }; | 
| 53 |  |  |  |  |  |  | }; | 
| 54 | 200 | 50 |  |  |  | 121660 | if ($@) { | 
| 55 | 0 |  |  |  |  | 0 | *utf8::upgrade   = sub { CORE::length $_[0] }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 56 | 0 |  |  |  |  | 0 | *utf8::downgrade = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 57 | 0 |  |  |  |  | 0 | *utf8::encode    = sub {   }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 58 | 0 |  |  |  |  | 0 | *utf8::decode    = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 59 | 0 |  |  |  |  | 0 | *utf8::is_utf8   = sub {   }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 60 | 0 |  |  |  |  | 0 | *utf8::valid     = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 61 |  |  |  |  |  |  | } | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | # instead of Symbol.pm | 
| 65 |  |  |  |  |  |  | BEGIN { | 
| 66 | 200 |  |  | 200 |  | 615 | my $genpkg = "Symbol::"; | 
| 67 | 200 |  |  |  |  | 10109 | my $genseq = 0; | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | sub gensym () { | 
| 70 | 0 |  |  | 0 | 0 | 0 | my $name = "GEN" . $genseq++; | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | # here, no strict qw(refs); if strict.pm exists | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 0 |  |  |  |  | 0 | my $ref = \*{$genpkg . $name}; | 
|  | 0 |  |  |  |  | 0 |  | 
| 75 | 0 |  |  |  |  | 0 | delete $$genpkg{$name}; | 
| 76 | 0 |  |  |  |  | 0 | return $ref; | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub qualify ($;$) { | 
| 80 | 0 |  |  | 0 | 0 | 0 | my ($name) = @_; | 
| 81 | 0 | 0 | 0 |  |  | 0 | if (!ref($name) && (Elatin6::index($name, '::') == -1) && (Elatin6::index($name, "'") == -1)) { | 
|  |  |  | 0 |  |  |  |  | 
| 82 | 0 |  |  |  |  | 0 | my $pkg; | 
| 83 | 0 |  |  |  |  | 0 | my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT DATA); | 
|  | 0 |  |  |  |  | 0 |  | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | # Global names: special character, "^xyz", or other. | 
| 86 | 0 | 0 | 0 |  |  | 0 | if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) { | 
| 87 |  |  |  |  |  |  | # RGS 2001-11-05 : translate leading ^X to control-char | 
| 88 | 0 |  |  |  |  | 0 | $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei; | 
|  | 0 |  |  |  |  | 0 |  | 
| 89 | 0 |  |  |  |  | 0 | $pkg = "main"; | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  | else { | 
| 92 | 0 | 0 |  |  |  | 0 | $pkg = (@_ > 1) ? $_[1] : caller; | 
| 93 |  |  |  |  |  |  | } | 
| 94 | 0 |  |  |  |  | 0 | $name = $pkg . "::" . $name; | 
| 95 |  |  |  |  |  |  | } | 
| 96 | 0 |  |  |  |  | 0 | return $name; | 
| 97 |  |  |  |  |  |  | } | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | sub qualify_to_ref ($;$) { | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | # here, no strict qw(refs); if strict.pm exists | 
| 102 |  |  |  |  |  |  |  | 
| 103 | 0 | 0 |  | 0 | 0 | 0 | return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 104 |  |  |  |  |  |  | } | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | # Column: local $@ | 
| 108 |  |  |  |  |  |  | # in Chapter 9. Osaete okitai Perl no kiso | 
| 109 |  |  |  |  |  |  | # of ISBN 10: 4798119172 | ISBN 13: 978-4798119175 MODAN Perl NYUMON | 
| 110 |  |  |  |  |  |  | # (and so on) | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | # use strict; if strict.pm exists | 
| 113 |  |  |  |  |  |  | BEGIN { | 
| 114 | 200 | 50 |  | 200 |  | 408 | if (CORE::eval { local $@; CORE::require strict }) { | 
|  | 200 |  |  |  |  | 595 |  | 
|  | 200 |  |  |  |  | 2178 |  | 
| 115 | 200 |  |  |  |  | 27386 | strict::->import; | 
| 116 |  |  |  |  |  |  | } | 
| 117 |  |  |  |  |  |  | } | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | # P.714 29.2.39. flock | 
| 120 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 121 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | # P.863 flock | 
| 124 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 125 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | sub LOCK_SH() {1} | 
| 128 |  |  |  |  |  |  | sub LOCK_EX() {2} | 
| 129 |  |  |  |  |  |  | sub LOCK_UN() {8} | 
| 130 |  |  |  |  |  |  | sub LOCK_NB() {4} | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | # instead of Carp.pm | 
| 133 |  |  |  |  |  |  | sub carp; | 
| 134 |  |  |  |  |  |  | sub croak; | 
| 135 |  |  |  |  |  |  | sub cluck; | 
| 136 |  |  |  |  |  |  | sub confess; | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | # 6.18. Matching Multiple-Byte Characters | 
| 139 |  |  |  |  |  |  | # in Chapter 6. Pattern Matching | 
| 140 |  |  |  |  |  |  | # of ISBN 978-1-56592-243-3 Perl Perl Cookbook. | 
| 141 |  |  |  |  |  |  | # (and so on) | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | # regexp of character | 
| 144 | 200 |  |  | 200 |  | 15520 | BEGIN { CORE::eval q{ use vars qw($your_char) } } $your_char = q{[\x00-\xFF]}; | 
|  | 200 |  |  | 200 |  | 1387 |  | 
|  | 200 |  |  |  |  | 346 |  | 
|  | 200 |  |  |  |  | 14273 |  | 
| 145 | 200 |  |  | 200 |  | 14369 | BEGIN { CORE::eval q{ use vars qw($qq_char  ) } } $qq_char   = qr/\\c[\x40-\x5F]|\\?(?:$your_char)/oxms; | 
|  | 200 |  |  | 200 |  | 1219 |  | 
|  | 200 |  |  |  |  | 289 |  | 
|  | 200 |  |  |  |  | 15752 |  | 
| 146 | 200 |  |  | 200 |  | 13729 | BEGIN { CORE::eval q{ use vars qw($q_char   ) } } $q_char    = qr/$your_char/oxms; | 
|  | 200 |  |  | 200 |  | 1119 |  | 
|  | 200 |  |  |  |  | 317 |  | 
|  | 200 |  |  |  |  | 15993 |  | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | # | 
| 149 |  |  |  |  |  |  | # Latin-6 character range per length | 
| 150 |  |  |  |  |  |  | # | 
| 151 |  |  |  |  |  |  | my %range_tr = (); | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | # | 
| 154 |  |  |  |  |  |  | # alias of encoding name | 
| 155 |  |  |  |  |  |  | # | 
| 156 | 200 |  |  | 200 |  | 15250 | BEGIN { CORE::eval q{ use vars qw($encoding_alias) } } | 
|  | 200 |  |  | 200 |  | 1107 |  | 
|  | 200 |  |  |  |  | 325 |  | 
|  | 200 |  |  |  |  | 487489 |  | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | # | 
| 159 |  |  |  |  |  |  | # Latin-6 case conversion | 
| 160 |  |  |  |  |  |  | # | 
| 161 |  |  |  |  |  |  | my %lc = (); | 
| 162 |  |  |  |  |  |  | @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)} = | 
| 163 |  |  |  |  |  |  | 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 |  |  |  |  |  |  | my %uc = (); | 
| 165 |  |  |  |  |  |  | @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)} = | 
| 166 |  |  |  |  |  |  | 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 |  |  |  |  |  |  | my %fc = (); | 
| 168 |  |  |  |  |  |  | @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)} = | 
| 169 |  |  |  |  |  |  | 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); | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | if (0) { | 
| 172 |  |  |  |  |  |  | } | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  | elsif (__PACKAGE__ =~ / \b Elatin6 \z/oxms) { | 
| 175 |  |  |  |  |  |  | %range_tr = ( | 
| 176 |  |  |  |  |  |  | 1 => [ [0x00..0xFF], | 
| 177 |  |  |  |  |  |  | ], | 
| 178 |  |  |  |  |  |  | ); | 
| 179 |  |  |  |  |  |  | $encoding_alias = qr/ \b (?: iso[-_ ]?8859-10 | iec[- ]?8859-10 | latin-?6 ) \b /oxmsi; | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | %lc = (%lc, | 
| 182 |  |  |  |  |  |  | "\xA1" => "\xB1",     # LATIN LETTER A WITH OGONEK | 
| 183 |  |  |  |  |  |  | "\xA2" => "\xB2",     # LATIN LETTER E WITH MACRON | 
| 184 |  |  |  |  |  |  | "\xA3" => "\xB3",     # LATIN LETTER G WITH CEDILLA | 
| 185 |  |  |  |  |  |  | "\xA4" => "\xB4",     # LATIN LETTER I WITH MACRON | 
| 186 |  |  |  |  |  |  | "\xA5" => "\xB5",     # LATIN LETTER I WITH TILDE | 
| 187 |  |  |  |  |  |  | "\xA6" => "\xB6",     # LATIN LETTER K WITH CEDILLA | 
| 188 |  |  |  |  |  |  | "\xA8" => "\xB8",     # LATIN LETTER L WITH CEDILLA | 
| 189 |  |  |  |  |  |  | "\xA9" => "\xB9",     # LATIN LETTER D WITH STROKE | 
| 190 |  |  |  |  |  |  | "\xAA" => "\xBA",     # LATIN LETTER S WITH CARON | 
| 191 |  |  |  |  |  |  | "\xAB" => "\xBB",     # LATIN LETTER T WITH STROKE | 
| 192 |  |  |  |  |  |  | "\xAC" => "\xBC",     # LATIN LETTER Z WITH CARON | 
| 193 |  |  |  |  |  |  | "\xAE" => "\xBE",     # LATIN LETTER U WITH MACRON | 
| 194 |  |  |  |  |  |  | "\xAF" => "\xBF",     # LATIN LETTER ENG | 
| 195 |  |  |  |  |  |  | "\xC0" => "\xE0",     # LATIN LETTER A WITH MACRON | 
| 196 |  |  |  |  |  |  | "\xC1" => "\xE1",     # LATIN LETTER A WITH ACUTE | 
| 197 |  |  |  |  |  |  | "\xC2" => "\xE2",     # LATIN LETTER A WITH CIRCUMFLEX | 
| 198 |  |  |  |  |  |  | "\xC3" => "\xE3",     # LATIN LETTER A WITH TILDE | 
| 199 |  |  |  |  |  |  | "\xC4" => "\xE4",     # LATIN LETTER A WITH DIAERESIS | 
| 200 |  |  |  |  |  |  | "\xC5" => "\xE5",     # LATIN LETTER A WITH RING ABOVE | 
| 201 |  |  |  |  |  |  | "\xC6" => "\xE6",     # LATIN LETTER AE | 
| 202 |  |  |  |  |  |  | "\xC7" => "\xE7",     # LATIN LETTER I WITH OGONEK | 
| 203 |  |  |  |  |  |  | "\xC8" => "\xE8",     # LATIN LETTER C WITH CARON | 
| 204 |  |  |  |  |  |  | "\xC9" => "\xE9",     # LATIN LETTER E WITH ACUTE | 
| 205 |  |  |  |  |  |  | "\xCA" => "\xEA",     # LATIN LETTER E WITH OGONEK | 
| 206 |  |  |  |  |  |  | "\xCB" => "\xEB",     # LATIN LETTER E WITH DIAERESIS | 
| 207 |  |  |  |  |  |  | "\xCC" => "\xEC",     # LATIN LETTER E WITH DOT ABOVE | 
| 208 |  |  |  |  |  |  | "\xCD" => "\xED",     # LATIN LETTER I WITH ACUTE | 
| 209 |  |  |  |  |  |  | "\xCE" => "\xEE",     # LATIN LETTER I WITH CIRCUMFLEX | 
| 210 |  |  |  |  |  |  | "\xCF" => "\xEF",     # LATIN LETTER I WITH DIAERESIS | 
| 211 |  |  |  |  |  |  | "\xD0" => "\xF0",     # LATIN LETTER ETH (Icelandic) | 
| 212 |  |  |  |  |  |  | "\xD1" => "\xF1",     # LATIN LETTER N WITH CEDILLA | 
| 213 |  |  |  |  |  |  | "\xD2" => "\xF2",     # LATIN LETTER O WITH MACRON | 
| 214 |  |  |  |  |  |  | "\xD3" => "\xF3",     # LATIN LETTER O WITH ACUTE | 
| 215 |  |  |  |  |  |  | "\xD4" => "\xF4",     # LATIN LETTER O WITH CIRCUMFLEX | 
| 216 |  |  |  |  |  |  | "\xD5" => "\xF5",     # LATIN LETTER O WITH TILDE | 
| 217 |  |  |  |  |  |  | "\xD6" => "\xF6",     # LATIN LETTER O WITH DIAERESIS | 
| 218 |  |  |  |  |  |  | "\xD7" => "\xF7",     # LATIN LETTER U WITH TILDE | 
| 219 |  |  |  |  |  |  | "\xD8" => "\xF8",     # LATIN LETTER O WITH STROKE | 
| 220 |  |  |  |  |  |  | "\xD9" => "\xF9",     # LATIN LETTER U WITH OGONEK | 
| 221 |  |  |  |  |  |  | "\xDA" => "\xFA",     # LATIN LETTER U WITH ACUTE | 
| 222 |  |  |  |  |  |  | "\xDB" => "\xFB",     # LATIN LETTER U WITH CIRCUMFLEX | 
| 223 |  |  |  |  |  |  | "\xDC" => "\xFC",     # LATIN LETTER U WITH DIAERESIS | 
| 224 |  |  |  |  |  |  | "\xDD" => "\xFD",     # LATIN LETTER Y WITH ACUTE | 
| 225 |  |  |  |  |  |  | "\xDE" => "\xFE",     # LATIN LETTER THORN (Icelandic) | 
| 226 |  |  |  |  |  |  | ); | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | %uc = (%uc, | 
| 229 |  |  |  |  |  |  | "\xB1" => "\xA1",     # LATIN LETTER A WITH OGONEK | 
| 230 |  |  |  |  |  |  | "\xB2" => "\xA2",     # LATIN LETTER E WITH MACRON | 
| 231 |  |  |  |  |  |  | "\xB3" => "\xA3",     # LATIN LETTER G WITH CEDILLA | 
| 232 |  |  |  |  |  |  | "\xB4" => "\xA4",     # LATIN LETTER I WITH MACRON | 
| 233 |  |  |  |  |  |  | "\xB5" => "\xA5",     # LATIN LETTER I WITH TILDE | 
| 234 |  |  |  |  |  |  | "\xB6" => "\xA6",     # LATIN LETTER K WITH CEDILLA | 
| 235 |  |  |  |  |  |  | "\xB8" => "\xA8",     # LATIN LETTER L WITH CEDILLA | 
| 236 |  |  |  |  |  |  | "\xB9" => "\xA9",     # LATIN LETTER D WITH STROKE | 
| 237 |  |  |  |  |  |  | "\xBA" => "\xAA",     # LATIN LETTER S WITH CARON | 
| 238 |  |  |  |  |  |  | "\xBB" => "\xAB",     # LATIN LETTER T WITH STROKE | 
| 239 |  |  |  |  |  |  | "\xBC" => "\xAC",     # LATIN LETTER Z WITH CARON | 
| 240 |  |  |  |  |  |  | "\xBE" => "\xAE",     # LATIN LETTER U WITH MACRON | 
| 241 |  |  |  |  |  |  | "\xBF" => "\xAF",     # LATIN LETTER ENG | 
| 242 |  |  |  |  |  |  | "\xE0" => "\xC0",     # LATIN LETTER A WITH MACRON | 
| 243 |  |  |  |  |  |  | "\xE1" => "\xC1",     # LATIN LETTER A WITH ACUTE | 
| 244 |  |  |  |  |  |  | "\xE2" => "\xC2",     # LATIN LETTER A WITH CIRCUMFLEX | 
| 245 |  |  |  |  |  |  | "\xE3" => "\xC3",     # LATIN LETTER A WITH TILDE | 
| 246 |  |  |  |  |  |  | "\xE4" => "\xC4",     # LATIN LETTER A WITH DIAERESIS | 
| 247 |  |  |  |  |  |  | "\xE5" => "\xC5",     # LATIN LETTER A WITH RING ABOVE | 
| 248 |  |  |  |  |  |  | "\xE6" => "\xC6",     # LATIN LETTER AE | 
| 249 |  |  |  |  |  |  | "\xE7" => "\xC7",     # LATIN LETTER I WITH OGONEK | 
| 250 |  |  |  |  |  |  | "\xE8" => "\xC8",     # LATIN LETTER C WITH CARON | 
| 251 |  |  |  |  |  |  | "\xE9" => "\xC9",     # LATIN LETTER E WITH ACUTE | 
| 252 |  |  |  |  |  |  | "\xEA" => "\xCA",     # LATIN LETTER E WITH OGONEK | 
| 253 |  |  |  |  |  |  | "\xEB" => "\xCB",     # LATIN LETTER E WITH DIAERESIS | 
| 254 |  |  |  |  |  |  | "\xEC" => "\xCC",     # LATIN LETTER E WITH DOT ABOVE | 
| 255 |  |  |  |  |  |  | "\xED" => "\xCD",     # LATIN LETTER I WITH ACUTE | 
| 256 |  |  |  |  |  |  | "\xEE" => "\xCE",     # LATIN LETTER I WITH CIRCUMFLEX | 
| 257 |  |  |  |  |  |  | "\xEF" => "\xCF",     # LATIN LETTER I WITH DIAERESIS | 
| 258 |  |  |  |  |  |  | "\xF0" => "\xD0",     # LATIN LETTER ETH (Icelandic) | 
| 259 |  |  |  |  |  |  | "\xF1" => "\xD1",     # LATIN LETTER N WITH CEDILLA | 
| 260 |  |  |  |  |  |  | "\xF2" => "\xD2",     # LATIN LETTER O WITH MACRON | 
| 261 |  |  |  |  |  |  | "\xF3" => "\xD3",     # LATIN LETTER O WITH ACUTE | 
| 262 |  |  |  |  |  |  | "\xF4" => "\xD4",     # LATIN LETTER O WITH CIRCUMFLEX | 
| 263 |  |  |  |  |  |  | "\xF5" => "\xD5",     # LATIN LETTER O WITH TILDE | 
| 264 |  |  |  |  |  |  | "\xF6" => "\xD6",     # LATIN LETTER O WITH DIAERESIS | 
| 265 |  |  |  |  |  |  | "\xF7" => "\xD7",     # LATIN LETTER U WITH TILDE | 
| 266 |  |  |  |  |  |  | "\xF8" => "\xD8",     # LATIN LETTER O WITH STROKE | 
| 267 |  |  |  |  |  |  | "\xF9" => "\xD9",     # LATIN LETTER U WITH OGONEK | 
| 268 |  |  |  |  |  |  | "\xFA" => "\xDA",     # LATIN LETTER U WITH ACUTE | 
| 269 |  |  |  |  |  |  | "\xFB" => "\xDB",     # LATIN LETTER U WITH CIRCUMFLEX | 
| 270 |  |  |  |  |  |  | "\xFC" => "\xDC",     # LATIN LETTER U WITH DIAERESIS | 
| 271 |  |  |  |  |  |  | "\xFD" => "\xDD",     # LATIN LETTER Y WITH ACUTE | 
| 272 |  |  |  |  |  |  | "\xFE" => "\xDE",     # LATIN LETTER THORN (Icelandic) | 
| 273 |  |  |  |  |  |  | ); | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | %fc = (%fc, | 
| 276 |  |  |  |  |  |  | "\xA1" => "\xB1",     # LATIN CAPITAL LETTER A WITH OGONEK --> LATIN SMALL LETTER A WITH OGONEK | 
| 277 |  |  |  |  |  |  | "\xA2" => "\xB2",     # LATIN CAPITAL LETTER E WITH MACRON --> LATIN SMALL LETTER E WITH MACRON | 
| 278 |  |  |  |  |  |  | "\xA3" => "\xB3",     # LATIN CAPITAL LETTER G WITH CEDILLA --> LATIN SMALL LETTER G WITH CEDILLA | 
| 279 |  |  |  |  |  |  | "\xA4" => "\xB4",     # LATIN CAPITAL LETTER I WITH MACRON --> LATIN SMALL LETTER I WITH MACRON | 
| 280 |  |  |  |  |  |  | "\xA5" => "\xB5",     # LATIN CAPITAL LETTER I WITH TILDE --> LATIN SMALL LETTER I WITH TILDE | 
| 281 |  |  |  |  |  |  | "\xA6" => "\xB6",     # LATIN CAPITAL LETTER K WITH CEDILLA --> LATIN SMALL LETTER K WITH CEDILLA | 
| 282 |  |  |  |  |  |  | "\xA8" => "\xB8",     # LATIN CAPITAL LETTER L WITH CEDILLA --> LATIN SMALL LETTER L WITH CEDILLA | 
| 283 |  |  |  |  |  |  | "\xA9" => "\xB9",     # LATIN CAPITAL LETTER D WITH STROKE --> LATIN SMALL LETTER D WITH STROKE | 
| 284 |  |  |  |  |  |  | "\xAA" => "\xBA",     # LATIN CAPITAL LETTER S WITH CARON --> LATIN SMALL LETTER S WITH CARON | 
| 285 |  |  |  |  |  |  | "\xAB" => "\xBB",     # LATIN CAPITAL LETTER T WITH STROKE --> LATIN SMALL LETTER T WITH STROKE | 
| 286 |  |  |  |  |  |  | "\xAC" => "\xBC",     # LATIN CAPITAL LETTER Z WITH CARON --> LATIN SMALL LETTER Z WITH CARON | 
| 287 |  |  |  |  |  |  | "\xAE" => "\xBE",     # LATIN CAPITAL LETTER U WITH MACRON --> LATIN SMALL LETTER U WITH MACRON | 
| 288 |  |  |  |  |  |  | "\xAF" => "\xBF",     # LATIN CAPITAL LETTER ENG --> LATIN SMALL LETTER ENG | 
| 289 |  |  |  |  |  |  | "\xC0" => "\xE0",     # LATIN CAPITAL LETTER A WITH MACRON --> LATIN SMALL LETTER A WITH MACRON | 
| 290 |  |  |  |  |  |  | "\xC1" => "\xE1",     # LATIN CAPITAL LETTER A WITH ACUTE --> LATIN SMALL LETTER A WITH ACUTE | 
| 291 |  |  |  |  |  |  | "\xC2" => "\xE2",     # LATIN CAPITAL LETTER A WITH CIRCUMFLEX --> LATIN SMALL LETTER A WITH CIRCUMFLEX | 
| 292 |  |  |  |  |  |  | "\xC3" => "\xE3",     # LATIN CAPITAL LETTER A WITH TILDE --> LATIN SMALL LETTER A WITH TILDE | 
| 293 |  |  |  |  |  |  | "\xC4" => "\xE4",     # LATIN CAPITAL LETTER A WITH DIAERESIS --> LATIN SMALL LETTER A WITH DIAERESIS | 
| 294 |  |  |  |  |  |  | "\xC5" => "\xE5",     # LATIN CAPITAL LETTER A WITH RING ABOVE --> LATIN SMALL LETTER A WITH RING ABOVE | 
| 295 |  |  |  |  |  |  | "\xC6" => "\xE6",     # LATIN CAPITAL LETTER AE --> LATIN SMALL LETTER AE | 
| 296 |  |  |  |  |  |  | "\xC7" => "\xE7",     # LATIN CAPITAL LETTER I WITH OGONEK --> LATIN SMALL LETTER I WITH OGONEK | 
| 297 |  |  |  |  |  |  | "\xC8" => "\xE8",     # LATIN CAPITAL LETTER C WITH CARON --> LATIN SMALL LETTER C WITH CARON | 
| 298 |  |  |  |  |  |  | "\xC9" => "\xE9",     # LATIN CAPITAL LETTER E WITH ACUTE --> LATIN SMALL LETTER E WITH ACUTE | 
| 299 |  |  |  |  |  |  | "\xCA" => "\xEA",     # LATIN CAPITAL LETTER E WITH OGONEK --> LATIN SMALL LETTER E WITH OGONEK | 
| 300 |  |  |  |  |  |  | "\xCB" => "\xEB",     # LATIN CAPITAL LETTER E WITH DIAERESIS --> LATIN SMALL LETTER E WITH DIAERESIS | 
| 301 |  |  |  |  |  |  | "\xCC" => "\xEC",     # LATIN CAPITAL LETTER E WITH DOT ABOVE --> LATIN SMALL LETTER E WITH DOT ABOVE | 
| 302 |  |  |  |  |  |  | "\xCD" => "\xED",     # LATIN CAPITAL LETTER I WITH ACUTE --> LATIN SMALL LETTER I WITH ACUTE | 
| 303 |  |  |  |  |  |  | "\xCE" => "\xEE",     # LATIN CAPITAL LETTER I WITH CIRCUMFLEX --> LATIN SMALL LETTER I WITH CIRCUMFLEX | 
| 304 |  |  |  |  |  |  | "\xCF" => "\xEF",     # LATIN CAPITAL LETTER I WITH DIAERESIS --> LATIN SMALL LETTER I WITH DIAERESIS | 
| 305 |  |  |  |  |  |  | "\xD0" => "\xF0",     # LATIN CAPITAL LETTER ETH --> LATIN SMALL LETTER ETH | 
| 306 |  |  |  |  |  |  | "\xD1" => "\xF1",     # LATIN CAPITAL LETTER N WITH CEDILLA --> LATIN SMALL LETTER N WITH CEDILLA | 
| 307 |  |  |  |  |  |  | "\xD2" => "\xF2",     # LATIN CAPITAL LETTER O WITH MACRON --> LATIN SMALL LETTER O WITH MACRON | 
| 308 |  |  |  |  |  |  | "\xD3" => "\xF3",     # LATIN CAPITAL LETTER O WITH ACUTE --> LATIN SMALL LETTER O WITH ACUTE | 
| 309 |  |  |  |  |  |  | "\xD4" => "\xF4",     # LATIN CAPITAL LETTER O WITH CIRCUMFLEX --> LATIN SMALL LETTER O WITH CIRCUMFLEX | 
| 310 |  |  |  |  |  |  | "\xD5" => "\xF5",     # LATIN CAPITAL LETTER O WITH TILDE --> LATIN SMALL LETTER O WITH TILDE | 
| 311 |  |  |  |  |  |  | "\xD6" => "\xF6",     # LATIN CAPITAL LETTER O WITH DIAERESIS --> LATIN SMALL LETTER O WITH DIAERESIS | 
| 312 |  |  |  |  |  |  | "\xD7" => "\xF7",     # LATIN CAPITAL LETTER U WITH TILDE --> LATIN SMALL LETTER U WITH TILDE | 
| 313 |  |  |  |  |  |  | "\xD8" => "\xF8",     # LATIN CAPITAL LETTER O WITH STROKE --> LATIN SMALL LETTER O WITH STROKE | 
| 314 |  |  |  |  |  |  | "\xD9" => "\xF9",     # LATIN CAPITAL LETTER U WITH OGONEK --> LATIN SMALL LETTER U WITH OGONEK | 
| 315 |  |  |  |  |  |  | "\xDA" => "\xFA",     # LATIN CAPITAL LETTER U WITH ACUTE --> LATIN SMALL LETTER U WITH ACUTE | 
| 316 |  |  |  |  |  |  | "\xDB" => "\xFB",     # LATIN CAPITAL LETTER U WITH CIRCUMFLEX --> LATIN SMALL LETTER U WITH CIRCUMFLEX | 
| 317 |  |  |  |  |  |  | "\xDC" => "\xFC",     # LATIN CAPITAL LETTER U WITH DIAERESIS --> LATIN SMALL LETTER U WITH DIAERESIS | 
| 318 |  |  |  |  |  |  | "\xDD" => "\xFD",     # LATIN CAPITAL LETTER Y WITH ACUTE --> LATIN SMALL LETTER Y WITH ACUTE | 
| 319 |  |  |  |  |  |  | "\xDE" => "\xFE",     # LATIN CAPITAL LETTER THORN --> LATIN SMALL LETTER THORN | 
| 320 |  |  |  |  |  |  | "\xDF" => "\x73\x73", # LATIN SMALL LETTER SHARP S --> LATIN SMALL LETTER S, LATIN SMALL LETTER S | 
| 321 |  |  |  |  |  |  | ); | 
| 322 |  |  |  |  |  |  | } | 
| 323 |  |  |  |  |  |  |  | 
| 324 |  |  |  |  |  |  | else { | 
| 325 |  |  |  |  |  |  | croak "Don't know my package name '@{[__PACKAGE__]}'"; | 
| 326 |  |  |  |  |  |  | } | 
| 327 |  |  |  |  |  |  |  | 
| 328 |  |  |  |  |  |  | # | 
| 329 |  |  |  |  |  |  | # @ARGV wildcard globbing | 
| 330 |  |  |  |  |  |  | # | 
| 331 |  |  |  |  |  |  | sub import { | 
| 332 |  |  |  |  |  |  |  | 
| 333 | 0 | 0 |  | 0 |  | 0 | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 334 | 0 |  |  |  |  | 0 | my @argv = (); | 
| 335 | 0 |  |  |  |  | 0 | for (@ARGV) { | 
| 336 |  |  |  |  |  |  |  | 
| 337 |  |  |  |  |  |  | # has space | 
| 338 | 0 | 0 |  |  |  | 0 | if (/\A (?:$q_char)*? [ ] /oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 339 | 0 | 0 |  |  |  | 0 | if (my @glob = Elatin6::glob(qq{"$_"})) { | 
| 340 | 0 |  |  |  |  | 0 | push @argv, @glob; | 
| 341 |  |  |  |  |  |  | } | 
| 342 |  |  |  |  |  |  | else { | 
| 343 | 0 |  |  |  |  | 0 | push @argv, $_; | 
| 344 |  |  |  |  |  |  | } | 
| 345 |  |  |  |  |  |  | } | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | # has wildcard metachar | 
| 348 |  |  |  |  |  |  | elsif (/\A (?:$q_char)*? [*?] /oxms) { | 
| 349 | 0 | 0 |  |  |  | 0 | if (my @glob = Elatin6::glob($_)) { | 
| 350 | 0 |  |  |  |  | 0 | push @argv, @glob; | 
| 351 |  |  |  |  |  |  | } | 
| 352 |  |  |  |  |  |  | else { | 
| 353 | 0 |  |  |  |  | 0 | push @argv, $_; | 
| 354 |  |  |  |  |  |  | } | 
| 355 |  |  |  |  |  |  | } | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | # no wildcard globbing | 
| 358 |  |  |  |  |  |  | else { | 
| 359 | 0 |  |  |  |  | 0 | push @argv, $_; | 
| 360 |  |  |  |  |  |  | } | 
| 361 |  |  |  |  |  |  | } | 
| 362 | 0 |  |  |  |  | 0 | @ARGV = @argv; | 
| 363 |  |  |  |  |  |  | } | 
| 364 |  |  |  |  |  |  |  | 
| 365 | 0 |  |  |  |  | 0 | *Char::ord           = \&Latin6::ord; | 
| 366 | 0 |  |  |  |  | 0 | *Char::ord_          = \&Latin6::ord_; | 
| 367 | 0 |  |  |  |  | 0 | *Char::reverse       = \&Latin6::reverse; | 
| 368 | 0 |  |  |  |  | 0 | *Char::getc          = \&Latin6::getc; | 
| 369 | 0 |  |  |  |  | 0 | *Char::length        = \&Latin6::length; | 
| 370 | 0 |  |  |  |  | 0 | *Char::substr        = \&Latin6::substr; | 
| 371 | 0 |  |  |  |  | 0 | *Char::index         = \&Latin6::index; | 
| 372 | 0 |  |  |  |  | 0 | *Char::rindex        = \&Latin6::rindex; | 
| 373 | 0 |  |  |  |  | 0 | *Char::eval          = \&Latin6::eval; | 
| 374 | 0 |  |  |  |  | 0 | *Char::escape        = \&Latin6::escape; | 
| 375 | 0 |  |  |  |  | 0 | *Char::escape_token  = \&Latin6::escape_token; | 
| 376 | 0 |  |  |  |  | 0 | *Char::escape_script = \&Latin6::escape_script; | 
| 377 |  |  |  |  |  |  | } | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  | # P.230 Care with Prototypes | 
| 380 |  |  |  |  |  |  | # in Chapter 6: Subroutines | 
| 381 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 382 |  |  |  |  |  |  | # | 
| 383 |  |  |  |  |  |  | # If you aren't careful, you can get yourself into trouble with prototypes. | 
| 384 |  |  |  |  |  |  | # But if you are careful, you can do a lot of neat things with them. This is | 
| 385 |  |  |  |  |  |  | # all very powerful, of course, and should only be used in moderation to make | 
| 386 |  |  |  |  |  |  | # the world a better place. | 
| 387 |  |  |  |  |  |  |  | 
| 388 |  |  |  |  |  |  | # P.332 Care with Prototypes | 
| 389 |  |  |  |  |  |  | # in Chapter 7: Subroutines | 
| 390 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 391 |  |  |  |  |  |  | # | 
| 392 |  |  |  |  |  |  | # If you aren't careful, you can get yourself into trouble with prototypes. | 
| 393 |  |  |  |  |  |  | # But if you are careful, you can do a lot of neat things with them. This is | 
| 394 |  |  |  |  |  |  | # all very powerful, of course, and should only be used in moderation to make | 
| 395 |  |  |  |  |  |  | # the world a better place. | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | # | 
| 398 |  |  |  |  |  |  | # Prototypes of subroutines | 
| 399 |  |  |  |  |  |  | # | 
| 400 | 0 |  |  | 0 |  | 0 | sub unimport {} | 
| 401 |  |  |  |  |  |  | sub Elatin6::split(;$$$); | 
| 402 |  |  |  |  |  |  | sub Elatin6::tr($$$$;$); | 
| 403 |  |  |  |  |  |  | sub Elatin6::chop(@); | 
| 404 |  |  |  |  |  |  | sub Elatin6::index($$;$); | 
| 405 |  |  |  |  |  |  | sub Elatin6::rindex($$;$); | 
| 406 |  |  |  |  |  |  | sub Elatin6::lcfirst(@); | 
| 407 |  |  |  |  |  |  | sub Elatin6::lcfirst_(); | 
| 408 |  |  |  |  |  |  | sub Elatin6::lc(@); | 
| 409 |  |  |  |  |  |  | sub Elatin6::lc_(); | 
| 410 |  |  |  |  |  |  | sub Elatin6::ucfirst(@); | 
| 411 |  |  |  |  |  |  | sub Elatin6::ucfirst_(); | 
| 412 |  |  |  |  |  |  | sub Elatin6::uc(@); | 
| 413 |  |  |  |  |  |  | sub Elatin6::uc_(); | 
| 414 |  |  |  |  |  |  | sub Elatin6::fc(@); | 
| 415 |  |  |  |  |  |  | sub Elatin6::fc_(); | 
| 416 |  |  |  |  |  |  | sub Elatin6::ignorecase; | 
| 417 |  |  |  |  |  |  | sub Elatin6::classic_character_class; | 
| 418 |  |  |  |  |  |  | sub Elatin6::capture; | 
| 419 |  |  |  |  |  |  | sub Elatin6::chr(;$); | 
| 420 |  |  |  |  |  |  | sub Elatin6::chr_(); | 
| 421 |  |  |  |  |  |  | sub Elatin6::glob($); | 
| 422 |  |  |  |  |  |  | sub Elatin6::glob_(); | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | sub Latin6::ord(;$); | 
| 425 |  |  |  |  |  |  | sub Latin6::ord_(); | 
| 426 |  |  |  |  |  |  | sub Latin6::reverse(@); | 
| 427 |  |  |  |  |  |  | sub Latin6::getc(;*@); | 
| 428 |  |  |  |  |  |  | sub Latin6::length(;$); | 
| 429 |  |  |  |  |  |  | sub Latin6::substr($$;$$); | 
| 430 |  |  |  |  |  |  | sub Latin6::index($$;$); | 
| 431 |  |  |  |  |  |  | sub Latin6::rindex($$;$); | 
| 432 |  |  |  |  |  |  | sub Latin6::escape(;$); | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | # | 
| 435 |  |  |  |  |  |  | # Regexp work | 
| 436 |  |  |  |  |  |  | # | 
| 437 | 200 |  |  | 200 |  | 16986 | BEGIN { CORE::eval q{ use vars qw( | 
|  | 200 |  |  | 200 |  | 1667 |  | 
|  | 200 |  |  |  |  | 382 |  | 
|  | 200 |  |  |  |  | 85581 |  | 
| 438 |  |  |  |  |  |  | $Latin6::re_a | 
| 439 |  |  |  |  |  |  | $Latin6::re_t | 
| 440 |  |  |  |  |  |  | $Latin6::re_n | 
| 441 |  |  |  |  |  |  | $Latin6::re_r | 
| 442 |  |  |  |  |  |  | ) } } | 
| 443 |  |  |  |  |  |  |  | 
| 444 |  |  |  |  |  |  | # | 
| 445 |  |  |  |  |  |  | # Character class | 
| 446 |  |  |  |  |  |  | # | 
| 447 | 200 |  |  | 200 |  | 17678 | BEGIN { CORE::eval q{ use vars qw( | 
|  | 200 |  |  | 200 |  | 1231 |  | 
|  | 200 |  |  |  |  | 371 |  | 
|  | 200 |  |  |  |  | 3204822 |  | 
| 448 |  |  |  |  |  |  | $dot | 
| 449 |  |  |  |  |  |  | $dot_s | 
| 450 |  |  |  |  |  |  | $eD | 
| 451 |  |  |  |  |  |  | $eS | 
| 452 |  |  |  |  |  |  | $eW | 
| 453 |  |  |  |  |  |  | $eH | 
| 454 |  |  |  |  |  |  | $eV | 
| 455 |  |  |  |  |  |  | $eR | 
| 456 |  |  |  |  |  |  | $eN | 
| 457 |  |  |  |  |  |  | $not_alnum | 
| 458 |  |  |  |  |  |  | $not_alpha | 
| 459 |  |  |  |  |  |  | $not_ascii | 
| 460 |  |  |  |  |  |  | $not_blank | 
| 461 |  |  |  |  |  |  | $not_cntrl | 
| 462 |  |  |  |  |  |  | $not_digit | 
| 463 |  |  |  |  |  |  | $not_graph | 
| 464 |  |  |  |  |  |  | $not_lower | 
| 465 |  |  |  |  |  |  | $not_lower_i | 
| 466 |  |  |  |  |  |  | $not_print | 
| 467 |  |  |  |  |  |  | $not_punct | 
| 468 |  |  |  |  |  |  | $not_space | 
| 469 |  |  |  |  |  |  | $not_upper | 
| 470 |  |  |  |  |  |  | $not_upper_i | 
| 471 |  |  |  |  |  |  | $not_word | 
| 472 |  |  |  |  |  |  | $not_xdigit | 
| 473 |  |  |  |  |  |  | $eb | 
| 474 |  |  |  |  |  |  | $eB | 
| 475 |  |  |  |  |  |  | ) } } | 
| 476 |  |  |  |  |  |  |  | 
| 477 |  |  |  |  |  |  | ${Elatin6::dot}         = qr{(?>[^\x0A])}; | 
| 478 |  |  |  |  |  |  | ${Elatin6::dot_s}       = qr{(?>[\x00-\xFF])}; | 
| 479 |  |  |  |  |  |  | ${Elatin6::eD}          = qr{(?>[^0-9])}; | 
| 480 |  |  |  |  |  |  |  | 
| 481 |  |  |  |  |  |  | # Vertical tabs are now whitespace | 
| 482 |  |  |  |  |  |  | # \s in a regex now matches a vertical tab in all circumstances. | 
| 483 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace | 
| 484 |  |  |  |  |  |  | # ${Elatin6::eS}          = qr{(?>[^\x09\x0A    \x0C\x0D\x20])}; | 
| 485 |  |  |  |  |  |  | # ${Elatin6::eS}          = qr{(?>[^\x09\x0A\x0B\x0C\x0D\x20])}; | 
| 486 |  |  |  |  |  |  | ${Elatin6::eS}            = qr{(?>[^\s])}; | 
| 487 |  |  |  |  |  |  |  | 
| 488 |  |  |  |  |  |  | ${Elatin6::eW}            = qr{(?>[^0-9A-Z_a-z])}; | 
| 489 |  |  |  |  |  |  | ${Elatin6::eH}            = qr{(?>[^\x09\x20])}; | 
| 490 |  |  |  |  |  |  | ${Elatin6::eV}            = qr{(?>[^\x0A\x0B\x0C\x0D])}; | 
| 491 |  |  |  |  |  |  | ${Elatin6::eR}            = qr{(?>\x0D\x0A|[\x0A\x0D])}; | 
| 492 |  |  |  |  |  |  | ${Elatin6::eN}            = qr{(?>[^\x0A])}; | 
| 493 |  |  |  |  |  |  | ${Elatin6::not_alnum}     = qr{(?>[^\x30-\x39\x41-\x5A\x61-\x7A])}; | 
| 494 |  |  |  |  |  |  | ${Elatin6::not_alpha}     = qr{(?>[^\x41-\x5A\x61-\x7A])}; | 
| 495 |  |  |  |  |  |  | ${Elatin6::not_ascii}     = qr{(?>[^\x00-\x7F])}; | 
| 496 |  |  |  |  |  |  | ${Elatin6::not_blank}     = qr{(?>[^\x09\x20])}; | 
| 497 |  |  |  |  |  |  | ${Elatin6::not_cntrl}     = qr{(?>[^\x00-\x1F\x7F])}; | 
| 498 |  |  |  |  |  |  | ${Elatin6::not_digit}     = qr{(?>[^\x30-\x39])}; | 
| 499 |  |  |  |  |  |  | ${Elatin6::not_graph}     = qr{(?>[^\x21-\x7F])}; | 
| 500 |  |  |  |  |  |  | ${Elatin6::not_lower}     = qr{(?>[^\x61-\x7A])}; | 
| 501 |  |  |  |  |  |  | ${Elatin6::not_lower_i}   = qr{(?>[^\x41-\x5A\x61-\x7A])}; # Perl 5.16 compatible | 
| 502 |  |  |  |  |  |  | # ${Elatin6::not_lower_i} = qr{(?>[\x00-\xFF])};                   # older Perl compatible | 
| 503 |  |  |  |  |  |  | ${Elatin6::not_print}     = qr{(?>[^\x20-\x7F])}; | 
| 504 |  |  |  |  |  |  | ${Elatin6::not_punct}     = qr{(?>[^\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E])}; | 
| 505 |  |  |  |  |  |  | ${Elatin6::not_space}     = qr{(?>[^\s\x0B])}; | 
| 506 |  |  |  |  |  |  | ${Elatin6::not_upper}     = qr{(?>[^\x41-\x5A])}; | 
| 507 |  |  |  |  |  |  | ${Elatin6::not_upper_i}   = qr{(?>[^\x41-\x5A\x61-\x7A])}; # Perl 5.16 compatible | 
| 508 |  |  |  |  |  |  | # ${Elatin6::not_upper_i} = qr{(?>[\x00-\xFF])};                   # older Perl compatible | 
| 509 |  |  |  |  |  |  | ${Elatin6::not_word}      = qr{(?>[^\x30-\x39\x41-\x5A\x5F\x61-\x7A])}; | 
| 510 |  |  |  |  |  |  | ${Elatin6::not_xdigit}    = qr{(?>[^\x30-\x39\x41-\x46\x61-\x66])}; | 
| 511 |  |  |  |  |  |  | ${Elatin6::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))}; | 
| 512 |  |  |  |  |  |  | ${Elatin6::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]))}; | 
| 513 |  |  |  |  |  |  |  | 
| 514 |  |  |  |  |  |  | # avoid: Name "Elatin6::foo" used only once: possible typo at here. | 
| 515 |  |  |  |  |  |  | ${Elatin6::dot}         = ${Elatin6::dot}; | 
| 516 |  |  |  |  |  |  | ${Elatin6::dot_s}       = ${Elatin6::dot_s}; | 
| 517 |  |  |  |  |  |  | ${Elatin6::eD}          = ${Elatin6::eD}; | 
| 518 |  |  |  |  |  |  | ${Elatin6::eS}          = ${Elatin6::eS}; | 
| 519 |  |  |  |  |  |  | ${Elatin6::eW}          = ${Elatin6::eW}; | 
| 520 |  |  |  |  |  |  | ${Elatin6::eH}          = ${Elatin6::eH}; | 
| 521 |  |  |  |  |  |  | ${Elatin6::eV}          = ${Elatin6::eV}; | 
| 522 |  |  |  |  |  |  | ${Elatin6::eR}          = ${Elatin6::eR}; | 
| 523 |  |  |  |  |  |  | ${Elatin6::eN}          = ${Elatin6::eN}; | 
| 524 |  |  |  |  |  |  | ${Elatin6::not_alnum}   = ${Elatin6::not_alnum}; | 
| 525 |  |  |  |  |  |  | ${Elatin6::not_alpha}   = ${Elatin6::not_alpha}; | 
| 526 |  |  |  |  |  |  | ${Elatin6::not_ascii}   = ${Elatin6::not_ascii}; | 
| 527 |  |  |  |  |  |  | ${Elatin6::not_blank}   = ${Elatin6::not_blank}; | 
| 528 |  |  |  |  |  |  | ${Elatin6::not_cntrl}   = ${Elatin6::not_cntrl}; | 
| 529 |  |  |  |  |  |  | ${Elatin6::not_digit}   = ${Elatin6::not_digit}; | 
| 530 |  |  |  |  |  |  | ${Elatin6::not_graph}   = ${Elatin6::not_graph}; | 
| 531 |  |  |  |  |  |  | ${Elatin6::not_lower}   = ${Elatin6::not_lower}; | 
| 532 |  |  |  |  |  |  | ${Elatin6::not_lower_i} = ${Elatin6::not_lower_i}; | 
| 533 |  |  |  |  |  |  | ${Elatin6::not_print}   = ${Elatin6::not_print}; | 
| 534 |  |  |  |  |  |  | ${Elatin6::not_punct}   = ${Elatin6::not_punct}; | 
| 535 |  |  |  |  |  |  | ${Elatin6::not_space}   = ${Elatin6::not_space}; | 
| 536 |  |  |  |  |  |  | ${Elatin6::not_upper}   = ${Elatin6::not_upper}; | 
| 537 |  |  |  |  |  |  | ${Elatin6::not_upper_i} = ${Elatin6::not_upper_i}; | 
| 538 |  |  |  |  |  |  | ${Elatin6::not_word}    = ${Elatin6::not_word}; | 
| 539 |  |  |  |  |  |  | ${Elatin6::not_xdigit}  = ${Elatin6::not_xdigit}; | 
| 540 |  |  |  |  |  |  | ${Elatin6::eb}          = ${Elatin6::eb}; | 
| 541 |  |  |  |  |  |  | ${Elatin6::eB}          = ${Elatin6::eB}; | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | # | 
| 544 |  |  |  |  |  |  | # Latin-6 split | 
| 545 |  |  |  |  |  |  | # | 
| 546 |  |  |  |  |  |  | sub Elatin6::split(;$$$) { | 
| 547 |  |  |  |  |  |  |  | 
| 548 |  |  |  |  |  |  | # P.794 29.2.161. split | 
| 549 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 550 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 551 |  |  |  |  |  |  |  | 
| 552 |  |  |  |  |  |  | # P.951 split | 
| 553 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 554 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 555 |  |  |  |  |  |  |  | 
| 556 | 0 |  |  | 0 | 0 | 0 | my $pattern = $_[0]; | 
| 557 | 0 |  |  |  |  | 0 | my $string  = $_[1]; | 
| 558 | 0 |  |  |  |  | 0 | my $limit   = $_[2]; | 
| 559 |  |  |  |  |  |  |  | 
| 560 |  |  |  |  |  |  | # if $pattern is also omitted or is the literal space, " " | 
| 561 | 0 | 0 |  |  |  | 0 | if (not defined $pattern) { | 
| 562 | 0 |  |  |  |  | 0 | $pattern = ' '; | 
| 563 |  |  |  |  |  |  | } | 
| 564 |  |  |  |  |  |  |  | 
| 565 |  |  |  |  |  |  | # if $string is omitted, the function splits the $_ string | 
| 566 | 0 | 0 |  |  |  | 0 | if (not defined $string) { | 
| 567 | 0 | 0 |  |  |  | 0 | if (defined $_) { | 
| 568 | 0 |  |  |  |  | 0 | $string = $_; | 
| 569 |  |  |  |  |  |  | } | 
| 570 |  |  |  |  |  |  | else { | 
| 571 | 0 |  |  |  |  | 0 | $string = ''; | 
| 572 |  |  |  |  |  |  | } | 
| 573 |  |  |  |  |  |  | } | 
| 574 |  |  |  |  |  |  |  | 
| 575 | 0 |  |  |  |  | 0 | my @split = (); | 
| 576 |  |  |  |  |  |  |  | 
| 577 |  |  |  |  |  |  | # when string is empty | 
| 578 | 0 | 0 |  |  |  | 0 | if ($string eq '') { | 
|  |  | 0 |  |  |  |  |  | 
| 579 |  |  |  |  |  |  |  | 
| 580 |  |  |  |  |  |  | # resulting list value in list context | 
| 581 | 0 | 0 |  |  |  | 0 | if (wantarray) { | 
| 582 | 0 |  |  |  |  | 0 | return @split; | 
| 583 |  |  |  |  |  |  | } | 
| 584 |  |  |  |  |  |  |  | 
| 585 |  |  |  |  |  |  | # count of substrings in scalar context | 
| 586 |  |  |  |  |  |  | else { | 
| 587 | 0 | 0 |  |  |  | 0 | carp "Use of implicit split to \@_ is deprecated" if $^W; | 
| 588 | 0 |  |  |  |  | 0 | @_ = @split; | 
| 589 | 0 |  |  |  |  | 0 | return scalar @_; | 
| 590 |  |  |  |  |  |  | } | 
| 591 |  |  |  |  |  |  | } | 
| 592 |  |  |  |  |  |  |  | 
| 593 |  |  |  |  |  |  | # split's first argument is more consistently interpreted | 
| 594 |  |  |  |  |  |  | # | 
| 595 |  |  |  |  |  |  | # After some changes earlier in v5.17, split's behavior has been simplified: | 
| 596 |  |  |  |  |  |  | # if the PATTERN argument evaluates to a string containing one space, it is | 
| 597 |  |  |  |  |  |  | # treated the way that a literal string containing one space once was. | 
| 598 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#split's_first_argument_is_more_consistently_interpreted | 
| 599 |  |  |  |  |  |  |  | 
| 600 |  |  |  |  |  |  | # if $pattern is also omitted or is the literal space, " ", the function splits | 
| 601 |  |  |  |  |  |  | # on whitespace, /\s+/, after skipping any leading whitespace | 
| 602 |  |  |  |  |  |  | # (and so on) | 
| 603 |  |  |  |  |  |  |  | 
| 604 |  |  |  |  |  |  | elsif ($pattern eq ' ') { | 
| 605 | 0 | 0 |  |  |  | 0 | if (not defined $limit) { | 
| 606 | 0 |  |  |  |  | 0 | return CORE::split(' ', $string); | 
| 607 |  |  |  |  |  |  | } | 
| 608 |  |  |  |  |  |  | else { | 
| 609 | 0 |  |  |  |  | 0 | return CORE::split(' ', $string, $limit); | 
| 610 |  |  |  |  |  |  | } | 
| 611 |  |  |  |  |  |  | } | 
| 612 |  |  |  |  |  |  |  | 
| 613 |  |  |  |  |  |  | # if $limit is negative, it is treated as if an arbitrarily large $limit has been specified | 
| 614 | 0 | 0 | 0 |  |  | 0 | if ((not defined $limit) or ($limit <= 0)) { | 
|  |  | 0 |  |  |  |  |  | 
| 615 |  |  |  |  |  |  |  | 
| 616 |  |  |  |  |  |  | # a pattern capable of matching either the null string or something longer than the | 
| 617 |  |  |  |  |  |  | # null string will split the value of $string into separate characters wherever it | 
| 618 |  |  |  |  |  |  | # matches the null string between characters | 
| 619 |  |  |  |  |  |  | # (and so on) | 
| 620 |  |  |  |  |  |  |  | 
| 621 | 0 | 0 |  |  |  | 0 | if ('' =~ / \A $pattern \z /xms) { | 
| 622 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 623 | 0 |  |  |  |  | 0 | my $limit = scalar(() = $string =~ /($pattern)/oxmsg); | 
| 624 |  |  |  |  |  |  |  | 
| 625 |  |  |  |  |  |  | # P.1024 Appendix W.10 Multibyte Processing | 
| 626 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 627 |  |  |  |  |  |  | # (and so on) | 
| 628 |  |  |  |  |  |  |  | 
| 629 |  |  |  |  |  |  | # the //m modifier is assumed when you split on the pattern /^/ | 
| 630 |  |  |  |  |  |  | # (and so on) | 
| 631 |  |  |  |  |  |  |  | 
| 632 |  |  |  |  |  |  | #                                                     V | 
| 633 | 0 |  | 0 |  |  | 0 | while ((--$limit > 0) and ($string =~ s/\A((?:$q_char)+?)$pattern//m)) { | 
| 634 |  |  |  |  |  |  |  | 
| 635 |  |  |  |  |  |  | # if the $pattern contains parentheses, then the substring matched by each pair of parentheses | 
| 636 |  |  |  |  |  |  | # is included in the resulting list, interspersed with the fields that are ordinarily returned | 
| 637 |  |  |  |  |  |  | # (and so on) | 
| 638 |  |  |  |  |  |  |  | 
| 639 | 0 |  |  |  |  | 0 | local $@; | 
| 640 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 641 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 642 |  |  |  |  |  |  | } | 
| 643 |  |  |  |  |  |  | } | 
| 644 |  |  |  |  |  |  | } | 
| 645 |  |  |  |  |  |  |  | 
| 646 |  |  |  |  |  |  | else { | 
| 647 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 648 |  |  |  |  |  |  |  | 
| 649 |  |  |  |  |  |  | #                                 V | 
| 650 | 0 |  |  |  |  | 0 | while ($string =~ s/\A((?:$q_char)*?)$pattern//m) { | 
| 651 | 0 |  |  |  |  | 0 | local $@; | 
| 652 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 653 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 654 |  |  |  |  |  |  | } | 
| 655 |  |  |  |  |  |  | } | 
| 656 |  |  |  |  |  |  | } | 
| 657 |  |  |  |  |  |  | } | 
| 658 |  |  |  |  |  |  |  | 
| 659 |  |  |  |  |  |  | elsif ($limit > 0) { | 
| 660 | 0 | 0 |  |  |  | 0 | if ('' =~ / \A $pattern \z /xms) { | 
| 661 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 662 | 0 |  | 0 |  |  | 0 | while ((--$limit > 0) and (CORE::length($string) > 0)) { | 
| 663 |  |  |  |  |  |  |  | 
| 664 |  |  |  |  |  |  | #                              V | 
| 665 | 0 | 0 |  |  |  | 0 | if ($string =~ s/\A((?:$q_char)+?)$pattern//m) { | 
| 666 | 0 |  |  |  |  | 0 | local $@; | 
| 667 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 668 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 669 |  |  |  |  |  |  | } | 
| 670 |  |  |  |  |  |  | } | 
| 671 |  |  |  |  |  |  | } | 
| 672 |  |  |  |  |  |  | } | 
| 673 |  |  |  |  |  |  | else { | 
| 674 | 0 |  |  |  |  | 0 | my $last_subexpression_offsets = _last_subexpression_offsets($pattern); | 
| 675 | 0 |  | 0 |  |  | 0 | while ((--$limit > 0) and (CORE::length($string) > 0)) { | 
| 676 |  |  |  |  |  |  |  | 
| 677 |  |  |  |  |  |  | #                              V | 
| 678 | 0 | 0 |  |  |  | 0 | if ($string =~ s/\A((?:$q_char)*?)$pattern//m) { | 
| 679 | 0 |  |  |  |  | 0 | local $@; | 
| 680 | 0 |  |  |  |  | 0 | for (my $digit=1; $digit <= ($last_subexpression_offsets + 1); $digit++) { | 
| 681 | 0 |  |  |  |  | 0 | push @split, CORE::eval('$' . $digit); | 
| 682 |  |  |  |  |  |  | } | 
| 683 |  |  |  |  |  |  | } | 
| 684 |  |  |  |  |  |  | } | 
| 685 |  |  |  |  |  |  | } | 
| 686 |  |  |  |  |  |  | } | 
| 687 |  |  |  |  |  |  |  | 
| 688 | 0 | 0 |  |  |  | 0 | if (CORE::length($string) > 0) { | 
| 689 | 0 |  |  |  |  | 0 | push @split, $string; | 
| 690 |  |  |  |  |  |  | } | 
| 691 |  |  |  |  |  |  |  | 
| 692 |  |  |  |  |  |  | # if $_[2] (NOT "$limit") is omitted or zero, trailing null fields are stripped from the result | 
| 693 | 0 | 0 | 0 |  |  | 0 | if ((not defined $_[2]) or ($_[2] == 0)) { | 
| 694 | 0 |  | 0 |  |  | 0 | while ((scalar(@split) >= 1) and ($split[-1] eq '')) { | 
| 695 | 0 |  |  |  |  | 0 | pop @split; | 
| 696 |  |  |  |  |  |  | } | 
| 697 |  |  |  |  |  |  | } | 
| 698 |  |  |  |  |  |  |  | 
| 699 |  |  |  |  |  |  | # resulting list value in list context | 
| 700 | 0 | 0 |  |  |  | 0 | if (wantarray) { | 
| 701 | 0 |  |  |  |  | 0 | return @split; | 
| 702 |  |  |  |  |  |  | } | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | # count of substrings in scalar context | 
| 705 |  |  |  |  |  |  | else { | 
| 706 | 0 | 0 |  |  |  | 0 | carp "Use of implicit split to \@_ is deprecated" if $^W; | 
| 707 | 0 |  |  |  |  | 0 | @_ = @split; | 
| 708 | 0 |  |  |  |  | 0 | return scalar @_; | 
| 709 |  |  |  |  |  |  | } | 
| 710 |  |  |  |  |  |  | } | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  | # | 
| 713 |  |  |  |  |  |  | # get last subexpression offsets | 
| 714 |  |  |  |  |  |  | # | 
| 715 |  |  |  |  |  |  | sub _last_subexpression_offsets { | 
| 716 | 0 |  |  | 0 |  | 0 | my $pattern = $_[0]; | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  | # remove comment | 
| 719 | 0 |  |  |  |  | 0 | $pattern =~ s/\(\?\# .*? \)//oxmsg; | 
| 720 |  |  |  |  |  |  |  | 
| 721 | 0 |  |  |  |  | 0 | my $modifier = ''; | 
| 722 | 0 | 0 |  |  |  | 0 | if ($pattern =~ /\(\?\^? ([\-A-Za-z]+) :/oxms) { | 
| 723 | 0 |  |  |  |  | 0 | $modifier = $1; | 
| 724 | 0 |  |  |  |  | 0 | $modifier =~ s/-[A-Za-z]*//; | 
| 725 |  |  |  |  |  |  | } | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | # with /x modifier | 
| 728 | 0 |  |  |  |  | 0 | my @char = (); | 
| 729 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /x/oxms) { | 
| 730 | 0 |  |  |  |  | 0 | @char = $pattern =~ /\G((?> | 
| 731 |  |  |  |  |  |  | [^\\\#\[\(] | | 
| 732 |  |  |  |  |  |  | \\ $q_char      | | 
| 733 |  |  |  |  |  |  | \# (?>[^\n]*) $ | | 
| 734 |  |  |  |  |  |  | \[ (?>(?:[^\\\]]|\\\\|\\\]|$q_char)+) \] | | 
| 735 |  |  |  |  |  |  | \(\?            | | 
| 736 |  |  |  |  |  |  | $q_char | 
| 737 |  |  |  |  |  |  | ))/oxmsg; | 
| 738 |  |  |  |  |  |  | } | 
| 739 |  |  |  |  |  |  |  | 
| 740 |  |  |  |  |  |  | # without /x modifier | 
| 741 |  |  |  |  |  |  | else { | 
| 742 | 0 |  |  |  |  | 0 | @char = $pattern =~ /\G((?> | 
| 743 |  |  |  |  |  |  | [^\\\[\(] | | 
| 744 |  |  |  |  |  |  | \\ $q_char      | | 
| 745 |  |  |  |  |  |  | \[ (?>(?:[^\\\]]|\\\\|\\\]|$q_char)+) \] | | 
| 746 |  |  |  |  |  |  | \(\?            | | 
| 747 |  |  |  |  |  |  | $q_char | 
| 748 |  |  |  |  |  |  | ))/oxmsg; | 
| 749 |  |  |  |  |  |  | } | 
| 750 |  |  |  |  |  |  |  | 
| 751 | 0 |  |  |  |  | 0 | return scalar grep { $_ eq '(' } @char; | 
|  | 0 |  |  |  |  | 0 |  | 
| 752 |  |  |  |  |  |  | } | 
| 753 |  |  |  |  |  |  |  | 
| 754 |  |  |  |  |  |  | # | 
| 755 |  |  |  |  |  |  | # Latin-6 transliteration (tr///) | 
| 756 |  |  |  |  |  |  | # | 
| 757 |  |  |  |  |  |  | sub Elatin6::tr($$$$;$) { | 
| 758 |  |  |  |  |  |  |  | 
| 759 | 0 |  |  | 0 | 0 | 0 | my $bind_operator   = $_[1]; | 
| 760 | 0 |  |  |  |  | 0 | my $searchlist      = $_[2]; | 
| 761 | 0 |  |  |  |  | 0 | my $replacementlist = $_[3]; | 
| 762 | 0 |  | 0 |  |  | 0 | my $modifier        = $_[4] || ''; | 
| 763 |  |  |  |  |  |  |  | 
| 764 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /r/oxms) { | 
| 765 | 0 | 0 |  |  |  | 0 | if ($bind_operator =~ / !~ /oxms) { | 
| 766 | 0 |  |  |  |  | 0 | croak "Using !~ with tr///r doesn't make sense"; | 
| 767 |  |  |  |  |  |  | } | 
| 768 |  |  |  |  |  |  | } | 
| 769 |  |  |  |  |  |  |  | 
| 770 | 0 |  |  |  |  | 0 | my @char            = $_[0] =~ /\G (?>$q_char) /oxmsg; | 
| 771 | 0 |  |  |  |  | 0 | my @searchlist      = _charlist_tr($searchlist); | 
| 772 | 0 |  |  |  |  | 0 | my @replacementlist = _charlist_tr($replacementlist); | 
| 773 |  |  |  |  |  |  |  | 
| 774 | 0 |  |  |  |  | 0 | my %tr = (); | 
| 775 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#searchlist; $i++) { | 
| 776 | 0 | 0 |  |  |  | 0 | if (not exists $tr{$searchlist[$i]}) { | 
| 777 | 0 | 0 | 0 |  |  | 0 | if (defined $replacementlist[$i] and ($replacementlist[$i] ne '')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 778 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = $replacementlist[$i]; | 
| 779 |  |  |  |  |  |  | } | 
| 780 |  |  |  |  |  |  | elsif ($modifier =~ /d/oxms) { | 
| 781 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = ''; | 
| 782 |  |  |  |  |  |  | } | 
| 783 |  |  |  |  |  |  | elsif (defined $replacementlist[-1] and ($replacementlist[-1] ne '')) { | 
| 784 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = $replacementlist[-1]; | 
| 785 |  |  |  |  |  |  | } | 
| 786 |  |  |  |  |  |  | else { | 
| 787 | 0 |  |  |  |  | 0 | $tr{$searchlist[$i]} = $searchlist[$i]; | 
| 788 |  |  |  |  |  |  | } | 
| 789 |  |  |  |  |  |  | } | 
| 790 |  |  |  |  |  |  | } | 
| 791 |  |  |  |  |  |  |  | 
| 792 | 0 |  |  |  |  | 0 | my $tr = 0; | 
| 793 | 0 |  |  |  |  | 0 | my $replaced = ''; | 
| 794 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /c/oxms) { | 
| 795 | 0 |  |  |  |  | 0 | while (defined(my $char = shift @char)) { | 
| 796 | 0 | 0 |  |  |  | 0 | if (not exists $tr{$char}) { | 
| 797 | 0 | 0 |  |  |  | 0 | if (defined $replacementlist[0]) { | 
| 798 | 0 |  |  |  |  | 0 | $replaced .= $replacementlist[0]; | 
| 799 |  |  |  |  |  |  | } | 
| 800 | 0 |  |  |  |  | 0 | $tr++; | 
| 801 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /s/oxms) { | 
| 802 | 0 |  | 0 |  |  | 0 | while (@char and (not exists $tr{$char[0]})) { | 
| 803 | 0 |  |  |  |  | 0 | shift @char; | 
| 804 | 0 |  |  |  |  | 0 | $tr++; | 
| 805 |  |  |  |  |  |  | } | 
| 806 |  |  |  |  |  |  | } | 
| 807 |  |  |  |  |  |  | } | 
| 808 |  |  |  |  |  |  | else { | 
| 809 | 0 |  |  |  |  | 0 | $replaced .= $char; | 
| 810 |  |  |  |  |  |  | } | 
| 811 |  |  |  |  |  |  | } | 
| 812 |  |  |  |  |  |  | } | 
| 813 |  |  |  |  |  |  | else { | 
| 814 | 0 |  |  |  |  | 0 | while (defined(my $char = shift @char)) { | 
| 815 | 0 | 0 |  |  |  | 0 | if (exists $tr{$char}) { | 
| 816 | 0 |  |  |  |  | 0 | $replaced .= $tr{$char}; | 
| 817 | 0 |  |  |  |  | 0 | $tr++; | 
| 818 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /s/oxms) { | 
| 819 | 0 |  | 0 |  |  | 0 | while (@char and (exists $tr{$char[0]}) and ($tr{$char[0]} eq $tr{$char})) { | 
|  |  |  | 0 |  |  |  |  | 
| 820 | 0 |  |  |  |  | 0 | shift @char; | 
| 821 | 0 |  |  |  |  | 0 | $tr++; | 
| 822 |  |  |  |  |  |  | } | 
| 823 |  |  |  |  |  |  | } | 
| 824 |  |  |  |  |  |  | } | 
| 825 |  |  |  |  |  |  | else { | 
| 826 | 0 |  |  |  |  | 0 | $replaced .= $char; | 
| 827 |  |  |  |  |  |  | } | 
| 828 |  |  |  |  |  |  | } | 
| 829 |  |  |  |  |  |  | } | 
| 830 |  |  |  |  |  |  |  | 
| 831 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /r/oxms) { | 
| 832 | 0 |  |  |  |  | 0 | return $replaced; | 
| 833 |  |  |  |  |  |  | } | 
| 834 |  |  |  |  |  |  | else { | 
| 835 | 0 |  |  |  |  | 0 | $_[0] = $replaced; | 
| 836 | 0 | 0 |  |  |  | 0 | if ($bind_operator =~ / !~ /oxms) { | 
| 837 | 0 |  |  |  |  | 0 | return not $tr; | 
| 838 |  |  |  |  |  |  | } | 
| 839 |  |  |  |  |  |  | else { | 
| 840 | 0 |  |  |  |  | 0 | return $tr; | 
| 841 |  |  |  |  |  |  | } | 
| 842 |  |  |  |  |  |  | } | 
| 843 |  |  |  |  |  |  | } | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | # | 
| 846 |  |  |  |  |  |  | # Latin-6 chop | 
| 847 |  |  |  |  |  |  | # | 
| 848 |  |  |  |  |  |  | sub Elatin6::chop(@) { | 
| 849 |  |  |  |  |  |  |  | 
| 850 | 0 |  |  | 0 | 0 | 0 | my $chop; | 
| 851 | 0 | 0 |  |  |  | 0 | if (@_ == 0) { | 
| 852 | 0 |  |  |  |  | 0 | my @char = /\G (?>$q_char) /oxmsg; | 
| 853 | 0 |  |  |  |  | 0 | $chop = pop @char; | 
| 854 | 0 |  |  |  |  | 0 | $_ = join '', @char; | 
| 855 |  |  |  |  |  |  | } | 
| 856 |  |  |  |  |  |  | else { | 
| 857 | 0 |  |  |  |  | 0 | for (@_) { | 
| 858 | 0 |  |  |  |  | 0 | my @char = /\G (?>$q_char) /oxmsg; | 
| 859 | 0 |  |  |  |  | 0 | $chop = pop @char; | 
| 860 | 0 |  |  |  |  | 0 | $_ = join '', @char; | 
| 861 |  |  |  |  |  |  | } | 
| 862 |  |  |  |  |  |  | } | 
| 863 | 0 |  |  |  |  | 0 | return $chop; | 
| 864 |  |  |  |  |  |  | } | 
| 865 |  |  |  |  |  |  |  | 
| 866 |  |  |  |  |  |  | # | 
| 867 |  |  |  |  |  |  | # Latin-6 index by octet | 
| 868 |  |  |  |  |  |  | # | 
| 869 |  |  |  |  |  |  | sub Elatin6::index($$;$) { | 
| 870 |  |  |  |  |  |  |  | 
| 871 | 0 |  |  | 0 | 1 | 0 | my($str,$substr,$position) = @_; | 
| 872 | 0 |  | 0 |  |  | 0 | $position ||= 0; | 
| 873 | 0 |  |  |  |  | 0 | my $pos = 0; | 
| 874 |  |  |  |  |  |  |  | 
| 875 | 0 |  |  |  |  | 0 | while ($pos < CORE::length($str)) { | 
| 876 | 0 | 0 |  |  |  | 0 | if (CORE::substr($str,$pos,CORE::length($substr)) eq $substr) { | 
| 877 | 0 | 0 |  |  |  | 0 | if ($pos >= $position) { | 
| 878 | 0 |  |  |  |  | 0 | return $pos; | 
| 879 |  |  |  |  |  |  | } | 
| 880 |  |  |  |  |  |  | } | 
| 881 | 0 | 0 |  |  |  | 0 | if (CORE::substr($str,$pos) =~ /\A ($q_char) /oxms) { | 
| 882 | 0 |  |  |  |  | 0 | $pos += CORE::length($1); | 
| 883 |  |  |  |  |  |  | } | 
| 884 |  |  |  |  |  |  | else { | 
| 885 | 0 |  |  |  |  | 0 | $pos += 1; | 
| 886 |  |  |  |  |  |  | } | 
| 887 |  |  |  |  |  |  | } | 
| 888 | 0 |  |  |  |  | 0 | return -1; | 
| 889 |  |  |  |  |  |  | } | 
| 890 |  |  |  |  |  |  |  | 
| 891 |  |  |  |  |  |  | # | 
| 892 |  |  |  |  |  |  | # Latin-6 reverse index | 
| 893 |  |  |  |  |  |  | # | 
| 894 |  |  |  |  |  |  | sub Elatin6::rindex($$;$) { | 
| 895 |  |  |  |  |  |  |  | 
| 896 | 0 |  |  | 0 | 0 | 0 | my($str,$substr,$position) = @_; | 
| 897 | 0 |  | 0 |  |  | 0 | $position ||= CORE::length($str) - 1; | 
| 898 | 0 |  |  |  |  | 0 | my $pos = 0; | 
| 899 | 0 |  |  |  |  | 0 | my $rindex = -1; | 
| 900 |  |  |  |  |  |  |  | 
| 901 | 0 |  | 0 |  |  | 0 | while (($pos < CORE::length($str)) and ($pos <= $position)) { | 
| 902 | 0 | 0 |  |  |  | 0 | if (CORE::substr($str,$pos,CORE::length($substr)) eq $substr) { | 
| 903 | 0 |  |  |  |  | 0 | $rindex = $pos; | 
| 904 |  |  |  |  |  |  | } | 
| 905 | 0 | 0 |  |  |  | 0 | if (CORE::substr($str,$pos) =~ /\A ($q_char) /oxms) { | 
| 906 | 0 |  |  |  |  | 0 | $pos += CORE::length($1); | 
| 907 |  |  |  |  |  |  | } | 
| 908 |  |  |  |  |  |  | else { | 
| 909 | 0 |  |  |  |  | 0 | $pos += 1; | 
| 910 |  |  |  |  |  |  | } | 
| 911 |  |  |  |  |  |  | } | 
| 912 | 0 |  |  |  |  | 0 | return $rindex; | 
| 913 |  |  |  |  |  |  | } | 
| 914 |  |  |  |  |  |  |  | 
| 915 |  |  |  |  |  |  | # | 
| 916 |  |  |  |  |  |  | # Latin-6 lower case first with parameter | 
| 917 |  |  |  |  |  |  | # | 
| 918 |  |  |  |  |  |  | sub Elatin6::lcfirst(@) { | 
| 919 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 920 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 921 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 922 | 0 |  |  |  |  | 0 | return Elatin6::lc(CORE::substr($s,0,1)) . CORE::substr($s,1), @_; | 
| 923 |  |  |  |  |  |  | } | 
| 924 |  |  |  |  |  |  | else { | 
| 925 | 0 |  |  |  |  | 0 | return Elatin6::lc(CORE::substr($s,0,1)) . CORE::substr($s,1); | 
| 926 |  |  |  |  |  |  | } | 
| 927 |  |  |  |  |  |  | } | 
| 928 |  |  |  |  |  |  | else { | 
| 929 | 0 |  |  |  |  | 0 | return Elatin6::lc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 930 |  |  |  |  |  |  | } | 
| 931 |  |  |  |  |  |  | } | 
| 932 |  |  |  |  |  |  |  | 
| 933 |  |  |  |  |  |  | # | 
| 934 |  |  |  |  |  |  | # Latin-6 lower case first without parameter | 
| 935 |  |  |  |  |  |  | # | 
| 936 |  |  |  |  |  |  | sub Elatin6::lcfirst_() { | 
| 937 | 0 |  |  | 0 | 0 | 0 | return Elatin6::lc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 938 |  |  |  |  |  |  | } | 
| 939 |  |  |  |  |  |  |  | 
| 940 |  |  |  |  |  |  | # | 
| 941 |  |  |  |  |  |  | # Latin-6 lower case with parameter | 
| 942 |  |  |  |  |  |  | # | 
| 943 |  |  |  |  |  |  | sub Elatin6::lc(@) { | 
| 944 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 945 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 946 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 947 | 0 | 0 |  |  |  | 0 | return join('', map {defined($lc{$_}) ? $lc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)), @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 948 |  |  |  |  |  |  | } | 
| 949 |  |  |  |  |  |  | else { | 
| 950 | 0 | 0 |  |  |  | 0 | return join('', map {defined($lc{$_}) ? $lc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)); | 
|  | 0 |  |  |  |  | 0 |  | 
| 951 |  |  |  |  |  |  | } | 
| 952 |  |  |  |  |  |  | } | 
| 953 |  |  |  |  |  |  | else { | 
| 954 | 0 |  |  |  |  | 0 | return Elatin6::lc_(); | 
| 955 |  |  |  |  |  |  | } | 
| 956 |  |  |  |  |  |  | } | 
| 957 |  |  |  |  |  |  |  | 
| 958 |  |  |  |  |  |  | # | 
| 959 |  |  |  |  |  |  | # Latin-6 lower case without parameter | 
| 960 |  |  |  |  |  |  | # | 
| 961 |  |  |  |  |  |  | sub Elatin6::lc_() { | 
| 962 | 0 |  |  | 0 | 0 | 0 | my $s = $_; | 
| 963 | 0 | 0 |  |  |  | 0 | return join '', map {defined($lc{$_}) ? $lc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg); | 
|  | 0 |  |  |  |  | 0 |  | 
| 964 |  |  |  |  |  |  | } | 
| 965 |  |  |  |  |  |  |  | 
| 966 |  |  |  |  |  |  | # | 
| 967 |  |  |  |  |  |  | # Latin-6 upper case first with parameter | 
| 968 |  |  |  |  |  |  | # | 
| 969 |  |  |  |  |  |  | sub Elatin6::ucfirst(@) { | 
| 970 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 971 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 972 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 973 | 0 |  |  |  |  | 0 | return Elatin6::uc(CORE::substr($s,0,1)) . CORE::substr($s,1), @_; | 
| 974 |  |  |  |  |  |  | } | 
| 975 |  |  |  |  |  |  | else { | 
| 976 | 0 |  |  |  |  | 0 | return Elatin6::uc(CORE::substr($s,0,1)) . CORE::substr($s,1); | 
| 977 |  |  |  |  |  |  | } | 
| 978 |  |  |  |  |  |  | } | 
| 979 |  |  |  |  |  |  | else { | 
| 980 | 0 |  |  |  |  | 0 | return Elatin6::uc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 981 |  |  |  |  |  |  | } | 
| 982 |  |  |  |  |  |  | } | 
| 983 |  |  |  |  |  |  |  | 
| 984 |  |  |  |  |  |  | # | 
| 985 |  |  |  |  |  |  | # Latin-6 upper case first without parameter | 
| 986 |  |  |  |  |  |  | # | 
| 987 |  |  |  |  |  |  | sub Elatin6::ucfirst_() { | 
| 988 | 0 |  |  | 0 | 0 | 0 | return Elatin6::uc(CORE::substr($_,0,1)) . CORE::substr($_,1); | 
| 989 |  |  |  |  |  |  | } | 
| 990 |  |  |  |  |  |  |  | 
| 991 |  |  |  |  |  |  | # | 
| 992 |  |  |  |  |  |  | # Latin-6 upper case with parameter | 
| 993 |  |  |  |  |  |  | # | 
| 994 |  |  |  |  |  |  | sub Elatin6::uc(@) { | 
| 995 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 996 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 997 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 998 | 0 | 0 |  |  |  | 0 | return join('', map {defined($uc{$_}) ? $uc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)), @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 999 |  |  |  |  |  |  | } | 
| 1000 |  |  |  |  |  |  | else { | 
| 1001 | 0 | 0 |  |  |  | 0 | return join('', map {defined($uc{$_}) ? $uc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1002 |  |  |  |  |  |  | } | 
| 1003 |  |  |  |  |  |  | } | 
| 1004 |  |  |  |  |  |  | else { | 
| 1005 | 0 |  |  |  |  | 0 | return Elatin6::uc_(); | 
| 1006 |  |  |  |  |  |  | } | 
| 1007 |  |  |  |  |  |  | } | 
| 1008 |  |  |  |  |  |  |  | 
| 1009 |  |  |  |  |  |  | # | 
| 1010 |  |  |  |  |  |  | # Latin-6 upper case without parameter | 
| 1011 |  |  |  |  |  |  | # | 
| 1012 |  |  |  |  |  |  | sub Elatin6::uc_() { | 
| 1013 | 0 |  |  | 0 | 0 | 0 | my $s = $_; | 
| 1014 | 0 | 0 |  |  |  | 0 | return join '', map {defined($uc{$_}) ? $uc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1015 |  |  |  |  |  |  | } | 
| 1016 |  |  |  |  |  |  |  | 
| 1017 |  |  |  |  |  |  | # | 
| 1018 |  |  |  |  |  |  | # Latin-6 fold case with parameter | 
| 1019 |  |  |  |  |  |  | # | 
| 1020 |  |  |  |  |  |  | sub Elatin6::fc(@) { | 
| 1021 | 0 | 0 |  | 0 | 0 | 0 | if (@_) { | 
| 1022 | 0 |  |  |  |  | 0 | my $s = shift @_; | 
| 1023 | 0 | 0 | 0 |  |  | 0 | if (@_ and wantarray) { | 
| 1024 | 0 | 0 |  |  |  | 0 | return join('', map {defined($fc{$_}) ? $fc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)), @_; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1025 |  |  |  |  |  |  | } | 
| 1026 |  |  |  |  |  |  | else { | 
| 1027 | 0 | 0 |  |  |  | 0 | return join('', map {defined($fc{$_}) ? $fc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg)); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1028 |  |  |  |  |  |  | } | 
| 1029 |  |  |  |  |  |  | } | 
| 1030 |  |  |  |  |  |  | else { | 
| 1031 | 0 |  |  |  |  | 0 | return Elatin6::fc_(); | 
| 1032 |  |  |  |  |  |  | } | 
| 1033 |  |  |  |  |  |  | } | 
| 1034 |  |  |  |  |  |  |  | 
| 1035 |  |  |  |  |  |  | # | 
| 1036 |  |  |  |  |  |  | # Latin-6 fold case without parameter | 
| 1037 |  |  |  |  |  |  | # | 
| 1038 |  |  |  |  |  |  | sub Elatin6::fc_() { | 
| 1039 | 0 |  |  | 0 | 0 | 0 | my $s = $_; | 
| 1040 | 0 | 0 |  |  |  | 0 | return join '', map {defined($fc{$_}) ? $fc{$_} : $_} ($s =~ /\G ($q_char) /oxmsg); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1041 |  |  |  |  |  |  | } | 
| 1042 |  |  |  |  |  |  |  | 
| 1043 |  |  |  |  |  |  | # | 
| 1044 |  |  |  |  |  |  | # Latin-6 regexp capture | 
| 1045 |  |  |  |  |  |  | # | 
| 1046 |  |  |  |  |  |  | { | 
| 1047 |  |  |  |  |  |  | sub Elatin6::capture { | 
| 1048 | 0 |  |  | 0 | 1 | 0 | return $_[0]; | 
| 1049 |  |  |  |  |  |  | } | 
| 1050 |  |  |  |  |  |  | } | 
| 1051 |  |  |  |  |  |  |  | 
| 1052 |  |  |  |  |  |  | # | 
| 1053 |  |  |  |  |  |  | # Latin-6 regexp ignore case modifier | 
| 1054 |  |  |  |  |  |  | # | 
| 1055 |  |  |  |  |  |  | sub Elatin6::ignorecase { | 
| 1056 |  |  |  |  |  |  |  | 
| 1057 | 0 |  |  | 0 | 0 | 0 | my @string = @_; | 
| 1058 | 0 |  |  |  |  | 0 | my $metachar = qr/[\@\\|[\]{]/oxms; | 
| 1059 |  |  |  |  |  |  |  | 
| 1060 |  |  |  |  |  |  | # ignore case of $scalar or @array | 
| 1061 | 0 |  |  |  |  | 0 | for my $string (@string) { | 
| 1062 |  |  |  |  |  |  |  | 
| 1063 |  |  |  |  |  |  | # split regexp | 
| 1064 | 0 |  |  |  |  | 0 | my @char = $string =~ /\G (?>\[\^|\\$q_char|$q_char) /oxmsg; | 
| 1065 |  |  |  |  |  |  |  | 
| 1066 |  |  |  |  |  |  | # unescape character | 
| 1067 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#char; $i++) { | 
| 1068 | 0 | 0 |  |  |  | 0 | next if not defined $char[$i]; | 
| 1069 |  |  |  |  |  |  |  | 
| 1070 |  |  |  |  |  |  | # open character class [...] | 
| 1071 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq '[') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1072 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 1073 |  |  |  |  |  |  |  | 
| 1074 |  |  |  |  |  |  | # [] make die "unmatched [] in regexp ...\n" | 
| 1075 |  |  |  |  |  |  |  | 
| 1076 | 0 | 0 |  |  |  | 0 | if ($char[$i+1] eq ']') { | 
| 1077 | 0 |  |  |  |  | 0 | $i++; | 
| 1078 |  |  |  |  |  |  | } | 
| 1079 |  |  |  |  |  |  |  | 
| 1080 | 0 |  |  |  |  | 0 | while (1) { | 
| 1081 | 0 | 0 |  |  |  | 0 | if (++$i > $#char) { | 
| 1082 | 0 |  |  |  |  | 0 | croak "Unmatched [] in regexp"; | 
| 1083 |  |  |  |  |  |  | } | 
| 1084 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq ']') { | 
| 1085 | 0 |  |  |  |  | 0 | my $right = $i; | 
| 1086 | 0 |  |  |  |  | 0 | my @charlist = charlist_qr(@char[$left+1..$right-1], 'i'); | 
| 1087 |  |  |  |  |  |  |  | 
| 1088 |  |  |  |  |  |  | # escape character | 
| 1089 | 0 |  |  |  |  | 0 | for my $char (@charlist) { | 
| 1090 | 0 | 0 |  |  |  | 0 | if (0) { | 
| 1091 |  |  |  |  |  |  | } | 
| 1092 |  |  |  |  |  |  |  | 
| 1093 | 0 |  |  |  |  | 0 | elsif ($char =~ /\A [.|)] \z/oxms) { | 
| 1094 | 0 |  |  |  |  | 0 | $char = '\\' . $char; | 
| 1095 |  |  |  |  |  |  | } | 
| 1096 |  |  |  |  |  |  | } | 
| 1097 |  |  |  |  |  |  |  | 
| 1098 |  |  |  |  |  |  | # [...] | 
| 1099 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, '(?:' . join('|', @charlist) . ')'; | 
| 1100 |  |  |  |  |  |  |  | 
| 1101 | 0 |  |  |  |  | 0 | $i = $left; | 
| 1102 | 0 |  |  |  |  | 0 | last; | 
| 1103 |  |  |  |  |  |  | } | 
| 1104 |  |  |  |  |  |  | } | 
| 1105 |  |  |  |  |  |  | } | 
| 1106 |  |  |  |  |  |  |  | 
| 1107 |  |  |  |  |  |  | # open character class [^...] | 
| 1108 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 1109 | 0 |  |  |  |  | 0 | my $left = $i; | 
| 1110 |  |  |  |  |  |  |  | 
| 1111 |  |  |  |  |  |  | # [^] make die "unmatched [] in regexp ...\n" | 
| 1112 |  |  |  |  |  |  |  | 
| 1113 | 0 | 0 |  |  |  | 0 | if ($char[$i+1] eq ']') { | 
| 1114 | 0 |  |  |  |  | 0 | $i++; | 
| 1115 |  |  |  |  |  |  | } | 
| 1116 |  |  |  |  |  |  |  | 
| 1117 | 0 |  |  |  |  | 0 | while (1) { | 
| 1118 | 0 | 0 |  |  |  | 0 | if (++$i > $#char) { | 
| 1119 | 0 |  |  |  |  | 0 | croak "Unmatched [] in regexp"; | 
| 1120 |  |  |  |  |  |  | } | 
| 1121 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq ']') { | 
| 1122 | 0 |  |  |  |  | 0 | my $right = $i; | 
| 1123 | 0 |  |  |  |  | 0 | my @charlist = charlist_not_qr(@char[$left+1..$right-1], 'i'); | 
| 1124 |  |  |  |  |  |  |  | 
| 1125 |  |  |  |  |  |  | # escape character | 
| 1126 | 0 |  |  |  |  | 0 | for my $char (@charlist) { | 
| 1127 | 0 | 0 |  |  |  | 0 | if (0) { | 
| 1128 |  |  |  |  |  |  | } | 
| 1129 |  |  |  |  |  |  |  | 
| 1130 | 0 |  |  |  |  | 0 | elsif ($char =~ /\A [.|)] \z/oxms) { | 
| 1131 | 0 |  |  |  |  | 0 | $char = '\\' . $char; | 
| 1132 |  |  |  |  |  |  | } | 
| 1133 |  |  |  |  |  |  | } | 
| 1134 |  |  |  |  |  |  |  | 
| 1135 |  |  |  |  |  |  | # [^...] | 
| 1136 | 0 |  |  |  |  | 0 | splice @char, $left, $right-$left+1, '(?!' . join('|', @charlist) . ")(?:$your_char)"; | 
| 1137 |  |  |  |  |  |  |  | 
| 1138 | 0 |  |  |  |  | 0 | $i = $left; | 
| 1139 | 0 |  |  |  |  | 0 | last; | 
| 1140 |  |  |  |  |  |  | } | 
| 1141 |  |  |  |  |  |  | } | 
| 1142 |  |  |  |  |  |  | } | 
| 1143 |  |  |  |  |  |  |  | 
| 1144 |  |  |  |  |  |  | # rewrite classic character class or escape character | 
| 1145 |  |  |  |  |  |  | elsif (my $char = classic_character_class($char[$i])) { | 
| 1146 | 0 |  |  |  |  | 0 | $char[$i] = $char; | 
| 1147 |  |  |  |  |  |  | } | 
| 1148 |  |  |  |  |  |  |  | 
| 1149 |  |  |  |  |  |  | # with /i modifier | 
| 1150 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 1151 | 0 |  |  |  |  | 0 | my $uc = Elatin6::uc($char[$i]); | 
| 1152 | 0 |  |  |  |  | 0 | my $fc = Elatin6::fc($char[$i]); | 
| 1153 | 0 | 0 |  |  |  | 0 | if ($uc ne $fc) { | 
| 1154 | 0 | 0 |  |  |  | 0 | if (CORE::length($fc) == 1) { | 
| 1155 | 0 |  |  |  |  | 0 | $char[$i] = '['   . $uc       . $fc . ']'; | 
| 1156 |  |  |  |  |  |  | } | 
| 1157 |  |  |  |  |  |  | else { | 
| 1158 | 0 |  |  |  |  | 0 | $char[$i] = '(?:' . $uc . '|' . $fc . ')'; | 
| 1159 |  |  |  |  |  |  | } | 
| 1160 |  |  |  |  |  |  | } | 
| 1161 |  |  |  |  |  |  | } | 
| 1162 |  |  |  |  |  |  | } | 
| 1163 |  |  |  |  |  |  |  | 
| 1164 |  |  |  |  |  |  | # characterize | 
| 1165 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#char; $i++) { | 
| 1166 | 0 | 0 |  |  |  | 0 | next if not defined $char[$i]; | 
| 1167 |  |  |  |  |  |  |  | 
| 1168 | 0 | 0 |  |  |  | 0 | if (0) { | 
| 1169 |  |  |  |  |  |  | } | 
| 1170 |  |  |  |  |  |  |  | 
| 1171 |  |  |  |  |  |  | # quote character before ? + * { | 
| 1172 | 0 | 0 |  |  |  | 0 | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 1173 | 0 | 0 |  |  |  | 0 | if ($char[$i-1] !~ /\A [\x00-\xFF] \z/oxms) { | 
| 1174 | 0 |  |  |  |  | 0 | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 1175 |  |  |  |  |  |  | } | 
| 1176 |  |  |  |  |  |  | } | 
| 1177 |  |  |  |  |  |  | } | 
| 1178 |  |  |  |  |  |  |  | 
| 1179 | 0 |  |  |  |  | 0 | $string = join '', @char; | 
| 1180 |  |  |  |  |  |  | } | 
| 1181 |  |  |  |  |  |  |  | 
| 1182 |  |  |  |  |  |  | # make regexp string | 
| 1183 | 0 |  |  |  |  | 0 | return @string; | 
| 1184 |  |  |  |  |  |  | } | 
| 1185 |  |  |  |  |  |  |  | 
| 1186 |  |  |  |  |  |  | # | 
| 1187 |  |  |  |  |  |  | # classic character class ( \D \S \W \d \s \w \C \X \H \V \h \v \R \N \b \B ) | 
| 1188 |  |  |  |  |  |  | # | 
| 1189 |  |  |  |  |  |  | sub Elatin6::classic_character_class { | 
| 1190 | 0 |  |  | 0 | 0 | 0 | my($char) = @_; | 
| 1191 |  |  |  |  |  |  |  | 
| 1192 |  |  |  |  |  |  | return { | 
| 1193 | 0 |  | 0 |  |  | 0 | '\D' => '${Elatin6::eD}', | 
| 1194 |  |  |  |  |  |  | '\S' => '${Elatin6::eS}', | 
| 1195 |  |  |  |  |  |  | '\W' => '${Elatin6::eW}', | 
| 1196 |  |  |  |  |  |  | '\d' => '[0-9]', | 
| 1197 |  |  |  |  |  |  |  | 
| 1198 |  |  |  |  |  |  | # Before Perl 5.6, \s only matched the five whitespace characters | 
| 1199 |  |  |  |  |  |  | # tab, newline, form-feed, carriage return, and the space character | 
| 1200 |  |  |  |  |  |  | # itself, which, taken together, is the character class [\t\n\f\r ]. | 
| 1201 |  |  |  |  |  |  |  | 
| 1202 |  |  |  |  |  |  | # Vertical tabs are now whitespace | 
| 1203 |  |  |  |  |  |  | # \s in a regex now matches a vertical tab in all circumstances. | 
| 1204 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace | 
| 1205 |  |  |  |  |  |  | #            \t  \n  \v  \f  \r space | 
| 1206 |  |  |  |  |  |  | # '\s' => '[\x09\x0A    \x0C\x0D\x20]', | 
| 1207 |  |  |  |  |  |  | # '\s' => '[\x09\x0A\x0B\x0C\x0D\x20]', | 
| 1208 |  |  |  |  |  |  | '\s'   => '\s', | 
| 1209 |  |  |  |  |  |  |  | 
| 1210 |  |  |  |  |  |  | '\w' => '[0-9A-Z_a-z]', | 
| 1211 |  |  |  |  |  |  | '\C' => '[\x00-\xFF]', | 
| 1212 |  |  |  |  |  |  | '\X' => 'X', | 
| 1213 |  |  |  |  |  |  |  | 
| 1214 |  |  |  |  |  |  | # \h \v \H \V | 
| 1215 |  |  |  |  |  |  |  | 
| 1216 |  |  |  |  |  |  | # P.114 Character Class Shortcuts | 
| 1217 |  |  |  |  |  |  | # in Chapter 7: In the World of Regular Expressions | 
| 1218 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 1219 |  |  |  |  |  |  |  | 
| 1220 |  |  |  |  |  |  | # P.357 13.2.3 Whitespace | 
| 1221 |  |  |  |  |  |  | # in Chapter 13: perlrecharclass: Perl Regular Expression Character Classes | 
| 1222 |  |  |  |  |  |  | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
| 1223 |  |  |  |  |  |  | # | 
| 1224 |  |  |  |  |  |  | # 0x00009   CHARACTER TABULATION  h s | 
| 1225 |  |  |  |  |  |  | # 0x0000a         LINE FEED (LF)   vs | 
| 1226 |  |  |  |  |  |  | # 0x0000b        LINE TABULATION   v | 
| 1227 |  |  |  |  |  |  | # 0x0000c         FORM FEED (FF)   vs | 
| 1228 |  |  |  |  |  |  | # 0x0000d   CARRIAGE RETURN (CR)   vs | 
| 1229 |  |  |  |  |  |  | # 0x00020                  SPACE  h s | 
| 1230 |  |  |  |  |  |  |  | 
| 1231 |  |  |  |  |  |  | # P.196 Table 5-9. Alphanumeric regex metasymbols | 
| 1232 |  |  |  |  |  |  | # in Chapter 5. Pattern Matching | 
| 1233 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 1234 |  |  |  |  |  |  |  | 
| 1235 |  |  |  |  |  |  | # (and so on) | 
| 1236 |  |  |  |  |  |  |  | 
| 1237 |  |  |  |  |  |  | '\H' => '${Elatin6::eH}', | 
| 1238 |  |  |  |  |  |  | '\V' => '${Elatin6::eV}', | 
| 1239 |  |  |  |  |  |  | '\h' => '[\x09\x20]', | 
| 1240 |  |  |  |  |  |  | '\v' => '[\x0A\x0B\x0C\x0D]', | 
| 1241 |  |  |  |  |  |  | '\R' => '${Elatin6::eR}', | 
| 1242 |  |  |  |  |  |  |  | 
| 1243 |  |  |  |  |  |  | # \N | 
| 1244 |  |  |  |  |  |  | # | 
| 1245 |  |  |  |  |  |  | # http://perldoc.perl.org/perlre.html | 
| 1246 |  |  |  |  |  |  | # Character Classes and other Special Escapes | 
| 1247 |  |  |  |  |  |  | # Any character but \n (experimental). Not affected by /s modifier | 
| 1248 |  |  |  |  |  |  |  | 
| 1249 |  |  |  |  |  |  | '\N' => '${Elatin6::eN}', | 
| 1250 |  |  |  |  |  |  |  | 
| 1251 |  |  |  |  |  |  | # \b \B | 
| 1252 |  |  |  |  |  |  |  | 
| 1253 |  |  |  |  |  |  | # P.180 Boundaries: The \b and \B Assertions | 
| 1254 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 1255 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 1256 |  |  |  |  |  |  |  | 
| 1257 |  |  |  |  |  |  | # P.219 Boundaries: The \b and \B Assertions | 
| 1258 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 1259 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 1260 |  |  |  |  |  |  |  | 
| 1261 |  |  |  |  |  |  | # \b really means (?:(?<=\w)(?!\w)|(? | 
| 1262 |  |  |  |  |  |  | #           or (?:(?<=\A|\W)(?=\w)|(?<=\w)(?=\W|\z)) | 
| 1263 |  |  |  |  |  |  | '\b' => '${Elatin6::eb}', | 
| 1264 |  |  |  |  |  |  |  | 
| 1265 |  |  |  |  |  |  | # \B really means (?:(?<=\w)(?=\w)|(? | 
| 1266 |  |  |  |  |  |  | #              or (?:(?<=\w)(?=\w)|(?<=\W)(?=\W)) | 
| 1267 |  |  |  |  |  |  | '\B' => '${Elatin6::eB}', | 
| 1268 |  |  |  |  |  |  |  | 
| 1269 |  |  |  |  |  |  | }->{$char} || ''; | 
| 1270 |  |  |  |  |  |  | } | 
| 1271 |  |  |  |  |  |  |  | 
| 1272 |  |  |  |  |  |  | # | 
| 1273 |  |  |  |  |  |  | # prepare Latin-6 characters per length | 
| 1274 |  |  |  |  |  |  | # | 
| 1275 |  |  |  |  |  |  |  | 
| 1276 |  |  |  |  |  |  | # 1 octet characters | 
| 1277 |  |  |  |  |  |  | my @chars1 = (); | 
| 1278 |  |  |  |  |  |  | sub chars1 { | 
| 1279 | 0 | 0 |  | 0 | 0 | 0 | if (@chars1) { | 
| 1280 | 0 |  |  |  |  | 0 | return @chars1; | 
| 1281 |  |  |  |  |  |  | } | 
| 1282 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{1}) { | 
| 1283 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{1} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1284 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,1)) { | 
| 1285 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1286 | 0 |  |  |  |  | 0 | push @chars1, pack 'C', $oct0; | 
| 1287 |  |  |  |  |  |  | } | 
| 1288 |  |  |  |  |  |  | } | 
| 1289 |  |  |  |  |  |  | } | 
| 1290 | 0 |  |  |  |  | 0 | return @chars1; | 
| 1291 |  |  |  |  |  |  | } | 
| 1292 |  |  |  |  |  |  |  | 
| 1293 |  |  |  |  |  |  | # 2 octets characters | 
| 1294 |  |  |  |  |  |  | my @chars2 = (); | 
| 1295 |  |  |  |  |  |  | sub chars2 { | 
| 1296 | 0 | 0 |  | 0 | 0 | 0 | if (@chars2) { | 
| 1297 | 0 |  |  |  |  | 0 | return @chars2; | 
| 1298 |  |  |  |  |  |  | } | 
| 1299 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{2}) { | 
| 1300 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{2} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1301 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,2)) { | 
| 1302 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1303 | 0 |  |  |  |  | 0 | for my $oct1 (@{$range[1]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1304 | 0 |  |  |  |  | 0 | push @chars2, pack 'CC', $oct0,$oct1; | 
| 1305 |  |  |  |  |  |  | } | 
| 1306 |  |  |  |  |  |  | } | 
| 1307 |  |  |  |  |  |  | } | 
| 1308 |  |  |  |  |  |  | } | 
| 1309 | 0 |  |  |  |  | 0 | return @chars2; | 
| 1310 |  |  |  |  |  |  | } | 
| 1311 |  |  |  |  |  |  |  | 
| 1312 |  |  |  |  |  |  | # 3 octets characters | 
| 1313 |  |  |  |  |  |  | my @chars3 = (); | 
| 1314 |  |  |  |  |  |  | sub chars3 { | 
| 1315 | 0 | 0 |  | 0 | 0 | 0 | if (@chars3) { | 
| 1316 | 0 |  |  |  |  | 0 | return @chars3; | 
| 1317 |  |  |  |  |  |  | } | 
| 1318 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{3}) { | 
| 1319 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{3} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1320 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,3)) { | 
| 1321 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1322 | 0 |  |  |  |  | 0 | for my $oct1 (@{$range[1]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1323 | 0 |  |  |  |  | 0 | for my $oct2 (@{$range[2]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1324 | 0 |  |  |  |  | 0 | push @chars3, pack 'CCC', $oct0,$oct1,$oct2; | 
| 1325 |  |  |  |  |  |  | } | 
| 1326 |  |  |  |  |  |  | } | 
| 1327 |  |  |  |  |  |  | } | 
| 1328 |  |  |  |  |  |  | } | 
| 1329 |  |  |  |  |  |  | } | 
| 1330 | 0 |  |  |  |  | 0 | return @chars3; | 
| 1331 |  |  |  |  |  |  | } | 
| 1332 |  |  |  |  |  |  |  | 
| 1333 |  |  |  |  |  |  | # 4 octets characters | 
| 1334 |  |  |  |  |  |  | my @chars4 = (); | 
| 1335 |  |  |  |  |  |  | sub chars4 { | 
| 1336 | 0 | 0 |  | 0 | 0 | 0 | if (@chars4) { | 
| 1337 | 0 |  |  |  |  | 0 | return @chars4; | 
| 1338 |  |  |  |  |  |  | } | 
| 1339 | 0 | 0 |  |  |  | 0 | if (exists $range_tr{4}) { | 
| 1340 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{4} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1341 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,4)) { | 
| 1342 | 0 |  |  |  |  | 0 | for my $oct0 (@{$range[0]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1343 | 0 |  |  |  |  | 0 | for my $oct1 (@{$range[1]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1344 | 0 |  |  |  |  | 0 | for my $oct2 (@{$range[2]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1345 | 0 |  |  |  |  | 0 | for my $oct3 (@{$range[3]}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 1346 | 0 |  |  |  |  | 0 | push @chars4, pack 'CCCC', $oct0,$oct1,$oct2,$oct3; | 
| 1347 |  |  |  |  |  |  | } | 
| 1348 |  |  |  |  |  |  | } | 
| 1349 |  |  |  |  |  |  | } | 
| 1350 |  |  |  |  |  |  | } | 
| 1351 |  |  |  |  |  |  | } | 
| 1352 |  |  |  |  |  |  | } | 
| 1353 | 0 |  |  |  |  | 0 | return @chars4; | 
| 1354 |  |  |  |  |  |  | } | 
| 1355 |  |  |  |  |  |  |  | 
| 1356 |  |  |  |  |  |  | # | 
| 1357 |  |  |  |  |  |  | # Latin-6 open character list for tr | 
| 1358 |  |  |  |  |  |  | # | 
| 1359 |  |  |  |  |  |  | sub _charlist_tr { | 
| 1360 |  |  |  |  |  |  |  | 
| 1361 | 0 |  |  | 0 |  | 0 | local $_ = shift @_; | 
| 1362 |  |  |  |  |  |  |  | 
| 1363 |  |  |  |  |  |  | # unescape character | 
| 1364 | 0 |  |  |  |  | 0 | my @char = (); | 
| 1365 | 0 |  |  |  |  | 0 | while (not /\G \z/oxmsgc) { | 
| 1366 | 0 | 0 |  |  |  | 0 | if (/\G (\\0?55|\\x2[Dd]|\\-) /oxmsgc) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1367 | 0 |  |  |  |  | 0 | push @char, '\-'; | 
| 1368 |  |  |  |  |  |  | } | 
| 1369 |  |  |  |  |  |  | elsif (/\G \\ ([0-7]{2,3}) /oxmsgc) { | 
| 1370 | 0 |  |  |  |  | 0 | push @char, CORE::chr(oct $1); | 
| 1371 |  |  |  |  |  |  | } | 
| 1372 |  |  |  |  |  |  | elsif (/\G \\x ([0-9A-Fa-f]{1,2}) /oxmsgc) { | 
| 1373 | 0 |  |  |  |  | 0 | push @char, CORE::chr(hex $1); | 
| 1374 |  |  |  |  |  |  | } | 
| 1375 |  |  |  |  |  |  | elsif (/\G \\c ([\x40-\x5F]) /oxmsgc) { | 
| 1376 | 0 |  |  |  |  | 0 | push @char, CORE::chr(CORE::ord($1) & 0x1F); | 
| 1377 |  |  |  |  |  |  | } | 
| 1378 |  |  |  |  |  |  | elsif (/\G (\\ [0nrtfbae]) /oxmsgc) { | 
| 1379 | 0 |  |  |  |  | 0 | push @char, { | 
| 1380 |  |  |  |  |  |  | '\0' => "\0", | 
| 1381 |  |  |  |  |  |  | '\n' => "\n", | 
| 1382 |  |  |  |  |  |  | '\r' => "\r", | 
| 1383 |  |  |  |  |  |  | '\t' => "\t", | 
| 1384 |  |  |  |  |  |  | '\f' => "\f", | 
| 1385 |  |  |  |  |  |  | '\b' => "\x08", # \b means backspace in character class | 
| 1386 |  |  |  |  |  |  | '\a' => "\a", | 
| 1387 |  |  |  |  |  |  | '\e' => "\e", | 
| 1388 |  |  |  |  |  |  | }->{$1}; | 
| 1389 |  |  |  |  |  |  | } | 
| 1390 |  |  |  |  |  |  | elsif (/\G \\ ($q_char) /oxmsgc) { | 
| 1391 | 0 |  |  |  |  | 0 | push @char, $1; | 
| 1392 |  |  |  |  |  |  | } | 
| 1393 |  |  |  |  |  |  | elsif (/\G ($q_char) /oxmsgc) { | 
| 1394 | 0 |  |  |  |  | 0 | push @char, $1; | 
| 1395 |  |  |  |  |  |  | } | 
| 1396 |  |  |  |  |  |  | } | 
| 1397 |  |  |  |  |  |  |  | 
| 1398 |  |  |  |  |  |  | # join separated multiple-octet | 
| 1399 | 0 |  |  |  |  | 0 | @char = join('',@char) =~ /\G (?>\\-|$q_char) /oxmsg; | 
| 1400 |  |  |  |  |  |  |  | 
| 1401 |  |  |  |  |  |  | # unescape '-' | 
| 1402 | 0 |  |  |  |  | 0 | my @i = (); | 
| 1403 | 0 |  |  |  |  | 0 | for my $i (0 .. $#char) { | 
| 1404 | 0 | 0 |  |  |  | 0 | if ($char[$i] eq '\-') { | 
|  |  | 0 |  |  |  |  |  | 
| 1405 | 0 |  |  |  |  | 0 | $char[$i] = '-'; | 
| 1406 |  |  |  |  |  |  | } | 
| 1407 |  |  |  |  |  |  | elsif ($char[$i] eq '-') { | 
| 1408 | 0 | 0 | 0 |  |  | 0 | if ((0 < $i) and ($i < $#char)) { | 
| 1409 | 0 |  |  |  |  | 0 | push @i, $i; | 
| 1410 |  |  |  |  |  |  | } | 
| 1411 |  |  |  |  |  |  | } | 
| 1412 |  |  |  |  |  |  | } | 
| 1413 |  |  |  |  |  |  |  | 
| 1414 |  |  |  |  |  |  | # open character list (reverse for splice) | 
| 1415 | 0 |  |  |  |  | 0 | for my $i (CORE::reverse @i) { | 
| 1416 | 0 |  |  |  |  | 0 | my @range = (); | 
| 1417 |  |  |  |  |  |  |  | 
| 1418 |  |  |  |  |  |  | # range error | 
| 1419 | 0 | 0 | 0 |  |  | 0 | if ((CORE::length($char[$i-1]) > CORE::length($char[$i+1])) or ($char[$i-1] gt $char[$i+1])) { | 
| 1420 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1421 |  |  |  |  |  |  | } | 
| 1422 |  |  |  |  |  |  |  | 
| 1423 |  |  |  |  |  |  | # range of multiple-octet code | 
| 1424 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i-1]) == 1) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1425 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 1) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1426 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1427 |  |  |  |  |  |  | } | 
| 1428 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 2) { | 
| 1429 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1430 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1431 |  |  |  |  |  |  | } | 
| 1432 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 3) { | 
| 1433 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1434 | 0 |  |  |  |  | 0 | push @range,                                                    chars2(); | 
| 1435 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1436 |  |  |  |  |  |  | } | 
| 1437 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 4) { | 
| 1438 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars1(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1439 | 0 |  |  |  |  | 0 | push @range,                                                    chars2(); | 
| 1440 | 0 |  |  |  |  | 0 | push @range,                                                    chars3(); | 
| 1441 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1442 |  |  |  |  |  |  | } | 
| 1443 |  |  |  |  |  |  | else { | 
| 1444 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1445 |  |  |  |  |  |  | } | 
| 1446 |  |  |  |  |  |  | } | 
| 1447 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == 2) { | 
| 1448 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 2) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1449 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1450 |  |  |  |  |  |  | } | 
| 1451 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 3) { | 
| 1452 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1453 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1454 |  |  |  |  |  |  | } | 
| 1455 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 4) { | 
| 1456 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars2(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1457 | 0 |  |  |  |  | 0 | push @range,                                                    chars3(); | 
| 1458 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1459 |  |  |  |  |  |  | } | 
| 1460 |  |  |  |  |  |  | else { | 
| 1461 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1462 |  |  |  |  |  |  | } | 
| 1463 |  |  |  |  |  |  | } | 
| 1464 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == 3) { | 
| 1465 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 3) { | 
|  |  | 0 |  |  |  |  |  | 
| 1466 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1467 |  |  |  |  |  |  | } | 
| 1468 |  |  |  |  |  |  | elsif (CORE::length($char[$i+1]) == 4) { | 
| 1469 | 0 |  |  |  |  | 0 | push @range, grep {$char[$i-1] le $_}                           chars3(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1470 | 0 |  |  |  |  | 0 | push @range, grep {$_ le $char[$i+1]}                           chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1471 |  |  |  |  |  |  | } | 
| 1472 |  |  |  |  |  |  | else { | 
| 1473 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1474 |  |  |  |  |  |  | } | 
| 1475 |  |  |  |  |  |  | } | 
| 1476 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == 4) { | 
| 1477 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i+1]) == 4) { | 
| 1478 | 0 | 0 |  |  |  | 0 | push @range, grep {($char[$i-1] le $_) and ($_ le $char[$i+1])} chars4(); | 
|  | 0 |  |  |  |  | 0 |  | 
| 1479 |  |  |  |  |  |  | } | 
| 1480 |  |  |  |  |  |  | else { | 
| 1481 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1482 |  |  |  |  |  |  | } | 
| 1483 |  |  |  |  |  |  | } | 
| 1484 |  |  |  |  |  |  | else { | 
| 1485 | 0 |  |  |  |  | 0 | croak "Invalid tr/// range (over 4octets) \"\\x" . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]) . '"'; | 
| 1486 |  |  |  |  |  |  | } | 
| 1487 |  |  |  |  |  |  |  | 
| 1488 | 0 |  |  |  |  | 0 | splice @char, $i-1, 3, @range; | 
| 1489 |  |  |  |  |  |  | } | 
| 1490 |  |  |  |  |  |  |  | 
| 1491 | 0 |  |  |  |  | 0 | return @char; | 
| 1492 |  |  |  |  |  |  | } | 
| 1493 |  |  |  |  |  |  |  | 
| 1494 |  |  |  |  |  |  | # | 
| 1495 |  |  |  |  |  |  | # Latin-6 open character class | 
| 1496 |  |  |  |  |  |  | # | 
| 1497 |  |  |  |  |  |  | sub _cc { | 
| 1498 | 0 | 0 |  | 0 |  | 0 | if (scalar(@_) == 0) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1499 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine cc got no parameter.\n"; | 
| 1500 |  |  |  |  |  |  | } | 
| 1501 |  |  |  |  |  |  | elsif (scalar(@_) == 1) { | 
| 1502 | 0 |  |  |  |  | 0 | return sprintf('\x%02X',$_[0]); | 
| 1503 |  |  |  |  |  |  | } | 
| 1504 |  |  |  |  |  |  | elsif (scalar(@_) == 2) { | 
| 1505 | 0 | 0 |  |  |  | 0 | if ($_[0] > $_[1]) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1506 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine cc got \$_[0] > \$_[1] parameters).\n"; | 
| 1507 |  |  |  |  |  |  | } | 
| 1508 |  |  |  |  |  |  | elsif ($_[0] == $_[1]) { | 
| 1509 | 0 |  |  |  |  | 0 | return sprintf('\x%02X',$_[0]); | 
| 1510 |  |  |  |  |  |  | } | 
| 1511 |  |  |  |  |  |  | elsif (($_[0]+1) == $_[1]) { | 
| 1512 | 0 |  |  |  |  | 0 | return sprintf('[\\x%02X\\x%02X]',$_[0],$_[1]); | 
| 1513 |  |  |  |  |  |  | } | 
| 1514 |  |  |  |  |  |  | else { | 
| 1515 | 0 |  |  |  |  | 0 | return sprintf('[\\x%02X-\\x%02X]',$_[0],$_[1]); | 
| 1516 |  |  |  |  |  |  | } | 
| 1517 |  |  |  |  |  |  | } | 
| 1518 |  |  |  |  |  |  | else { | 
| 1519 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine cc got 3 or more parameters (@{[scalar(@_)]} parameters).\n"; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1520 |  |  |  |  |  |  | } | 
| 1521 |  |  |  |  |  |  | } | 
| 1522 |  |  |  |  |  |  |  | 
| 1523 |  |  |  |  |  |  | # | 
| 1524 |  |  |  |  |  |  | # Latin-6 octet range | 
| 1525 |  |  |  |  |  |  | # | 
| 1526 |  |  |  |  |  |  | sub _octets { | 
| 1527 | 0 |  |  | 0 |  | 0 | my $length = shift @_; | 
| 1528 |  |  |  |  |  |  |  | 
| 1529 | 0 | 0 |  |  |  | 0 | if ($length == 1) { | 
| 1530 | 0 |  |  |  |  | 0 | my($a1) = unpack 'C', $_[0]; | 
| 1531 | 0 |  |  |  |  | 0 | my($z1) = unpack 'C', $_[1]; | 
| 1532 |  |  |  |  |  |  |  | 
| 1533 | 0 | 0 |  |  |  | 0 | if ($a1 > $z1) { | 
| 1534 | 0 |  |  |  |  | 0 | croak 'Invalid [] range in regexp (CORE::ord(A) > CORE::ord(B)) ' . '\x' . unpack('H*',$a1) . '-\x' . unpack('H*',$z1); | 
| 1535 |  |  |  |  |  |  | } | 
| 1536 |  |  |  |  |  |  |  | 
| 1537 | 0 | 0 |  |  |  | 0 | if ($a1 == $z1) { | 
|  |  | 0 |  |  |  |  |  | 
| 1538 | 0 |  |  |  |  | 0 | return sprintf('\x%02X',$a1); | 
| 1539 |  |  |  |  |  |  | } | 
| 1540 |  |  |  |  |  |  | elsif (($a1+1) == $z1) { | 
| 1541 | 0 |  |  |  |  | 0 | return sprintf('\x%02X\x%02X',$a1,$z1); | 
| 1542 |  |  |  |  |  |  | } | 
| 1543 |  |  |  |  |  |  | else { | 
| 1544 | 0 |  |  |  |  | 0 | return sprintf('\x%02X-\x%02X',$a1,$z1); | 
| 1545 |  |  |  |  |  |  | } | 
| 1546 |  |  |  |  |  |  | } | 
| 1547 |  |  |  |  |  |  | else { | 
| 1548 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine _octets got invalid length ($length).\n"; | 
| 1549 |  |  |  |  |  |  | } | 
| 1550 |  |  |  |  |  |  | } | 
| 1551 |  |  |  |  |  |  |  | 
| 1552 |  |  |  |  |  |  | # | 
| 1553 |  |  |  |  |  |  | # Latin-6 range regexp | 
| 1554 |  |  |  |  |  |  | # | 
| 1555 |  |  |  |  |  |  | sub _range_regexp { | 
| 1556 | 0 |  |  | 0 |  | 0 | my($length,$first,$last) = @_; | 
| 1557 |  |  |  |  |  |  |  | 
| 1558 | 0 |  |  |  |  | 0 | my @range_regexp = (); | 
| 1559 | 0 | 0 |  |  |  | 0 | if (not exists $range_tr{$length}) { | 
| 1560 | 0 |  |  |  |  | 0 | return @range_regexp; | 
| 1561 |  |  |  |  |  |  | } | 
| 1562 |  |  |  |  |  |  |  | 
| 1563 | 0 |  |  |  |  | 0 | my @ranges = @{ $range_tr{$length} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1564 | 0 |  |  |  |  | 0 | while (my @range = splice(@ranges,0,$length)) { | 
| 1565 | 0 |  |  |  |  | 0 | my $min = ''; | 
| 1566 | 0 |  |  |  |  | 0 | my $max = ''; | 
| 1567 | 0 |  |  |  |  | 0 | for (my $i=0; $i < $length; $i++) { | 
| 1568 | 0 |  |  |  |  | 0 | $min .= pack 'C', $range[$i][0]; | 
| 1569 | 0 |  |  |  |  | 0 | $max .= pack 'C', $range[$i][-1]; | 
| 1570 |  |  |  |  |  |  | } | 
| 1571 |  |  |  |  |  |  |  | 
| 1572 |  |  |  |  |  |  | # min___max | 
| 1573 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1574 |  |  |  |  |  |  | #       (nothing) | 
| 1575 |  |  |  |  |  |  |  | 
| 1576 | 0 | 0 | 0 |  |  | 0 | if ($max lt $first) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
| 1577 |  |  |  |  |  |  | } | 
| 1578 |  |  |  |  |  |  |  | 
| 1579 |  |  |  |  |  |  | #            ********** | 
| 1580 |  |  |  |  |  |  | #       min_________max | 
| 1581 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1582 |  |  |  |  |  |  | #            ********** | 
| 1583 |  |  |  |  |  |  |  | 
| 1584 |  |  |  |  |  |  | elsif (($min le $first) and ($first le $max) and ($max le $last)) { | 
| 1585 | 0 |  |  |  |  | 0 | push @range_regexp, _octets($length,$first,$max,$min,$max); | 
| 1586 |  |  |  |  |  |  | } | 
| 1587 |  |  |  |  |  |  |  | 
| 1588 |  |  |  |  |  |  | #            ********************** | 
| 1589 |  |  |  |  |  |  | #            min________________max | 
| 1590 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1591 |  |  |  |  |  |  | #            ********************** | 
| 1592 |  |  |  |  |  |  |  | 
| 1593 |  |  |  |  |  |  | elsif (($min eq $first) and ($max eq $last)) { | 
| 1594 | 0 |  |  |  |  | 0 | push @range_regexp, _octets($length,$first,$last,$min,$max); | 
| 1595 |  |  |  |  |  |  | } | 
| 1596 |  |  |  |  |  |  |  | 
| 1597 |  |  |  |  |  |  | #                   ********* | 
| 1598 |  |  |  |  |  |  | #                   min___max | 
| 1599 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1600 |  |  |  |  |  |  | #                   ********* | 
| 1601 |  |  |  |  |  |  |  | 
| 1602 |  |  |  |  |  |  | elsif (($first le $min) and ($max le $last)) { | 
| 1603 | 0 |  |  |  |  | 0 | push @range_regexp, _octets($length,$min,$max,$min,$max); | 
| 1604 |  |  |  |  |  |  | } | 
| 1605 |  |  |  |  |  |  |  | 
| 1606 |  |  |  |  |  |  | #            ********************** | 
| 1607 |  |  |  |  |  |  | #       min__________________________max | 
| 1608 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1609 |  |  |  |  |  |  | #            ********************** | 
| 1610 |  |  |  |  |  |  |  | 
| 1611 |  |  |  |  |  |  | elsif (($min le $first) and ($last le $max)) { | 
| 1612 | 0 |  |  |  |  | 0 | push @range_regexp, _octets($length,$first,$last,$min,$max); | 
| 1613 |  |  |  |  |  |  | } | 
| 1614 |  |  |  |  |  |  |  | 
| 1615 |  |  |  |  |  |  | #                         ********* | 
| 1616 |  |  |  |  |  |  | #                         min________max | 
| 1617 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1618 |  |  |  |  |  |  | #                         ********* | 
| 1619 |  |  |  |  |  |  |  | 
| 1620 |  |  |  |  |  |  | elsif (($first le $min) and ($min le $last) and ($last le $max)) { | 
| 1621 | 0 |  |  |  |  | 0 | push @range_regexp, _octets($length,$min,$last,$min,$max); | 
| 1622 |  |  |  |  |  |  | } | 
| 1623 |  |  |  |  |  |  |  | 
| 1624 |  |  |  |  |  |  | #                                    min___max | 
| 1625 |  |  |  |  |  |  | #            FIRST_____________LAST | 
| 1626 |  |  |  |  |  |  | #                              (nothing) | 
| 1627 |  |  |  |  |  |  |  | 
| 1628 |  |  |  |  |  |  | elsif ($last lt $min) { | 
| 1629 |  |  |  |  |  |  | } | 
| 1630 |  |  |  |  |  |  |  | 
| 1631 |  |  |  |  |  |  | else { | 
| 1632 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine _range_regexp panic.\n"; | 
| 1633 |  |  |  |  |  |  | } | 
| 1634 |  |  |  |  |  |  | } | 
| 1635 |  |  |  |  |  |  |  | 
| 1636 | 0 |  |  |  |  | 0 | return @range_regexp; | 
| 1637 |  |  |  |  |  |  | } | 
| 1638 |  |  |  |  |  |  |  | 
| 1639 |  |  |  |  |  |  | # | 
| 1640 |  |  |  |  |  |  | # Latin-6 open character list for qr and not qr | 
| 1641 |  |  |  |  |  |  | # | 
| 1642 |  |  |  |  |  |  | sub _charlist { | 
| 1643 |  |  |  |  |  |  |  | 
| 1644 | 0 |  |  | 0 |  | 0 | my $modifier = pop @_; | 
| 1645 | 0 |  |  |  |  | 0 | my @char = @_; | 
| 1646 |  |  |  |  |  |  |  | 
| 1647 | 0 | 0 |  |  |  | 0 | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 1648 |  |  |  |  |  |  |  | 
| 1649 |  |  |  |  |  |  | # unescape character | 
| 1650 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#char; $i++) { | 
| 1651 |  |  |  |  |  |  |  | 
| 1652 |  |  |  |  |  |  | # escape - to ... | 
| 1653 | 0 | 0 | 0 |  |  | 0 | if ($char[$i] eq '-') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1654 | 0 | 0 | 0 |  |  | 0 | if ((0 < $i) and ($i < $#char)) { | 
| 1655 | 0 |  |  |  |  | 0 | $char[$i] = '...'; | 
| 1656 |  |  |  |  |  |  | } | 
| 1657 |  |  |  |  |  |  | } | 
| 1658 |  |  |  |  |  |  |  | 
| 1659 |  |  |  |  |  |  | # octal escape sequence | 
| 1660 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 1661 | 0 |  |  |  |  | 0 | $char[$i] = octchr($1); | 
| 1662 |  |  |  |  |  |  | } | 
| 1663 |  |  |  |  |  |  |  | 
| 1664 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 1665 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 1666 | 0 |  |  |  |  | 0 | $char[$i] = hexchr($1); | 
| 1667 |  |  |  |  |  |  | } | 
| 1668 |  |  |  |  |  |  |  | 
| 1669 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 1670 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 1671 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 1672 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 1673 |  |  |  |  |  |  | # \P{PROPERTY} --> P\{PROPERTY} | 
| 1674 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^0-9\}][^\}]*) \} ) \z/oxms) { | 
| 1675 | 0 |  |  |  |  | 0 | $char[$i] = $1 . '\\' . $2; | 
| 1676 |  |  |  |  |  |  | } | 
| 1677 |  |  |  |  |  |  |  | 
| 1678 |  |  |  |  |  |  | # \p, \P, \X --> p, P, X | 
| 1679 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 1680 | 0 |  |  |  |  | 0 | $char[$i] = $1; | 
| 1681 |  |  |  |  |  |  | } | 
| 1682 |  |  |  |  |  |  |  | 
| 1683 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([0-7]{2,3}) \z/oxms) { | 
| 1684 | 0 |  |  |  |  | 0 | $char[$i] = CORE::chr oct $1; | 
| 1685 |  |  |  |  |  |  | } | 
| 1686 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x ([0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 1687 | 0 |  |  |  |  | 0 | $char[$i] = CORE::chr hex $1; | 
| 1688 |  |  |  |  |  |  | } | 
| 1689 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\c ([\x40-\x5F]) \z/oxms) { | 
| 1690 | 0 |  |  |  |  | 0 | $char[$i] = CORE::chr(CORE::ord($1) & 0x1F); | 
| 1691 |  |  |  |  |  |  | } | 
| 1692 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (\\ [0nrtfbaedswDSWHVhvR]) \z/oxms) { | 
| 1693 | 0 |  |  |  |  | 0 | $char[$i] = { | 
| 1694 |  |  |  |  |  |  | '\0' => "\0", | 
| 1695 |  |  |  |  |  |  | '\n' => "\n", | 
| 1696 |  |  |  |  |  |  | '\r' => "\r", | 
| 1697 |  |  |  |  |  |  | '\t' => "\t", | 
| 1698 |  |  |  |  |  |  | '\f' => "\f", | 
| 1699 |  |  |  |  |  |  | '\b' => "\x08", # \b means backspace in character class | 
| 1700 |  |  |  |  |  |  | '\a' => "\a", | 
| 1701 |  |  |  |  |  |  | '\e' => "\e", | 
| 1702 |  |  |  |  |  |  | '\d' => '[0-9]', | 
| 1703 |  |  |  |  |  |  |  | 
| 1704 |  |  |  |  |  |  | # Vertical tabs are now whitespace | 
| 1705 |  |  |  |  |  |  | # \s in a regex now matches a vertical tab in all circumstances. | 
| 1706 |  |  |  |  |  |  | # http://search.cpan.org/dist/perl-5.18.0/pod/perldelta.pod#Vertical_tabs_are_now_whitespace | 
| 1707 |  |  |  |  |  |  | #            \t  \n  \v  \f  \r space | 
| 1708 |  |  |  |  |  |  | # '\s' => '[\x09\x0A    \x0C\x0D\x20]', | 
| 1709 |  |  |  |  |  |  | # '\s' => '[\x09\x0A\x0B\x0C\x0D\x20]', | 
| 1710 |  |  |  |  |  |  | '\s'   => '\s', | 
| 1711 |  |  |  |  |  |  |  | 
| 1712 |  |  |  |  |  |  | '\w' => '[0-9A-Z_a-z]', | 
| 1713 |  |  |  |  |  |  | '\D' => '${Elatin6::eD}', | 
| 1714 |  |  |  |  |  |  | '\S' => '${Elatin6::eS}', | 
| 1715 |  |  |  |  |  |  | '\W' => '${Elatin6::eW}', | 
| 1716 |  |  |  |  |  |  |  | 
| 1717 |  |  |  |  |  |  | '\H' => '${Elatin6::eH}', | 
| 1718 |  |  |  |  |  |  | '\V' => '${Elatin6::eV}', | 
| 1719 |  |  |  |  |  |  | '\h' => '[\x09\x20]', | 
| 1720 |  |  |  |  |  |  | '\v' => '[\x0A\x0B\x0C\x0D]', | 
| 1721 |  |  |  |  |  |  | '\R' => '${Elatin6::eR}', | 
| 1722 |  |  |  |  |  |  |  | 
| 1723 |  |  |  |  |  |  | }->{$1}; | 
| 1724 |  |  |  |  |  |  | } | 
| 1725 |  |  |  |  |  |  |  | 
| 1726 |  |  |  |  |  |  | # POSIX-style character classes | 
| 1727 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A ( \[\: \^? (?:lower|upper) :\] ) \z/oxms)) { | 
| 1728 | 0 |  |  |  |  | 0 | $char[$i] = { | 
| 1729 |  |  |  |  |  |  |  | 
| 1730 |  |  |  |  |  |  | '[:lower:]'   => '[\x41-\x5A\x61-\x7A]', | 
| 1731 |  |  |  |  |  |  | '[:upper:]'   => '[\x41-\x5A\x61-\x7A]', | 
| 1732 |  |  |  |  |  |  | '[:^lower:]'  => '${Elatin6::not_lower_i}', | 
| 1733 |  |  |  |  |  |  | '[:^upper:]'  => '${Elatin6::not_upper_i}', | 
| 1734 |  |  |  |  |  |  |  | 
| 1735 |  |  |  |  |  |  | }->{$1}; | 
| 1736 |  |  |  |  |  |  | } | 
| 1737 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \[\: \^? (?:alnum|alpha|ascii|blank|cntrl|digit|graph|lower|print|punct|space|upper|word|xdigit) :\] ) \z/oxms) { | 
| 1738 | 0 |  |  |  |  | 0 | $char[$i] = { | 
| 1739 |  |  |  |  |  |  |  | 
| 1740 |  |  |  |  |  |  | '[:alnum:]'   => '[\x30-\x39\x41-\x5A\x61-\x7A]', | 
| 1741 |  |  |  |  |  |  | '[:alpha:]'   => '[\x41-\x5A\x61-\x7A]', | 
| 1742 |  |  |  |  |  |  | '[:ascii:]'   => '[\x00-\x7F]', | 
| 1743 |  |  |  |  |  |  | '[:blank:]'   => '[\x09\x20]', | 
| 1744 |  |  |  |  |  |  | '[:cntrl:]'   => '[\x00-\x1F\x7F]', | 
| 1745 |  |  |  |  |  |  | '[:digit:]'   => '[\x30-\x39]', | 
| 1746 |  |  |  |  |  |  | '[:graph:]'   => '[\x21-\x7F]', | 
| 1747 |  |  |  |  |  |  | '[:lower:]'   => '[\x61-\x7A]', | 
| 1748 |  |  |  |  |  |  | '[:print:]'   => '[\x20-\x7F]', | 
| 1749 |  |  |  |  |  |  | '[:punct:]'   => '[\x21-\x2F\x3A-\x3F\x40\x5B-\x5F\x60\x7B-\x7E]', | 
| 1750 |  |  |  |  |  |  |  | 
| 1751 |  |  |  |  |  |  | # P.174 POSIX-Style Character Classes | 
| 1752 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 1753 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 1754 |  |  |  |  |  |  |  | 
| 1755 |  |  |  |  |  |  | # P.311 11.2.4 Character Classes and other Special Escapes | 
| 1756 |  |  |  |  |  |  | # in Chapter 11: perlre: Perl regular expressions | 
| 1757 |  |  |  |  |  |  | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
| 1758 |  |  |  |  |  |  |  | 
| 1759 |  |  |  |  |  |  | # P.210 POSIX-Style Character Classes | 
| 1760 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 1761 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 1762 |  |  |  |  |  |  |  | 
| 1763 |  |  |  |  |  |  | '[:space:]'   => '[\s\x0B]', # "\s" plus vertical tab ("\cK") | 
| 1764 |  |  |  |  |  |  |  | 
| 1765 |  |  |  |  |  |  | '[:upper:]'   => '[\x41-\x5A]', | 
| 1766 |  |  |  |  |  |  | '[:word:]'    => '[\x30-\x39\x41-\x5A\x5F\x61-\x7A]', | 
| 1767 |  |  |  |  |  |  | '[:xdigit:]'  => '[\x30-\x39\x41-\x46\x61-\x66]', | 
| 1768 |  |  |  |  |  |  | '[:^alnum:]'  => '${Elatin6::not_alnum}', | 
| 1769 |  |  |  |  |  |  | '[:^alpha:]'  => '${Elatin6::not_alpha}', | 
| 1770 |  |  |  |  |  |  | '[:^ascii:]'  => '${Elatin6::not_ascii}', | 
| 1771 |  |  |  |  |  |  | '[:^blank:]'  => '${Elatin6::not_blank}', | 
| 1772 |  |  |  |  |  |  | '[:^cntrl:]'  => '${Elatin6::not_cntrl}', | 
| 1773 |  |  |  |  |  |  | '[:^digit:]'  => '${Elatin6::not_digit}', | 
| 1774 |  |  |  |  |  |  | '[:^graph:]'  => '${Elatin6::not_graph}', | 
| 1775 |  |  |  |  |  |  | '[:^lower:]'  => '${Elatin6::not_lower}', | 
| 1776 |  |  |  |  |  |  | '[:^print:]'  => '${Elatin6::not_print}', | 
| 1777 |  |  |  |  |  |  | '[:^punct:]'  => '${Elatin6::not_punct}', | 
| 1778 |  |  |  |  |  |  | '[:^space:]'  => '${Elatin6::not_space}', | 
| 1779 |  |  |  |  |  |  | '[:^upper:]'  => '${Elatin6::not_upper}', | 
| 1780 |  |  |  |  |  |  | '[:^word:]'   => '${Elatin6::not_word}', | 
| 1781 |  |  |  |  |  |  | '[:^xdigit:]' => '${Elatin6::not_xdigit}', | 
| 1782 |  |  |  |  |  |  |  | 
| 1783 |  |  |  |  |  |  | }->{$1}; | 
| 1784 |  |  |  |  |  |  | } | 
| 1785 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ($q_char) \z/oxms) { | 
| 1786 | 0 |  |  |  |  | 0 | $char[$i] = $1; | 
| 1787 |  |  |  |  |  |  | } | 
| 1788 |  |  |  |  |  |  | } | 
| 1789 |  |  |  |  |  |  |  | 
| 1790 |  |  |  |  |  |  | # open character list | 
| 1791 | 0 |  |  |  |  | 0 | my @singleoctet   = (); | 
| 1792 | 0 |  |  |  |  | 0 | my @multipleoctet = (); | 
| 1793 | 0 |  |  |  |  | 0 | for (my $i=0; $i <= $#char; ) { | 
| 1794 |  |  |  |  |  |  |  | 
| 1795 |  |  |  |  |  |  | # escaped - | 
| 1796 | 0 | 0 | 0 |  |  | 0 | if (defined($char[$i+1]) and ($char[$i+1] eq '...')) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1797 | 0 |  |  |  |  | 0 | $i += 1; | 
| 1798 | 0 |  |  |  |  | 0 | next; | 
| 1799 |  |  |  |  |  |  | } | 
| 1800 |  |  |  |  |  |  |  | 
| 1801 |  |  |  |  |  |  | # make range regexp | 
| 1802 |  |  |  |  |  |  | elsif ($char[$i] eq '...') { | 
| 1803 |  |  |  |  |  |  |  | 
| 1804 |  |  |  |  |  |  | # range error | 
| 1805 | 0 | 0 |  |  |  | 0 | if (CORE::length($char[$i-1]) > CORE::length($char[$i+1])) { | 
|  |  | 0 |  |  |  |  |  | 
| 1806 | 0 |  |  |  |  | 0 | croak 'Invalid [] range in regexp (length(A) > length(B)) ' . '\x' . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]); | 
| 1807 |  |  |  |  |  |  | } | 
| 1808 |  |  |  |  |  |  | elsif (CORE::length($char[$i-1]) == CORE::length($char[$i+1])) { | 
| 1809 | 0 | 0 |  |  |  | 0 | if ($char[$i-1] gt $char[$i+1]) { | 
| 1810 | 0 |  |  |  |  | 0 | croak 'Invalid [] range in regexp (CORE::ord(A) > CORE::ord(B)) ' . '\x' . unpack('H*',$char[$i-1]) . '-\x' . unpack('H*',$char[$i+1]); | 
| 1811 |  |  |  |  |  |  | } | 
| 1812 |  |  |  |  |  |  | } | 
| 1813 |  |  |  |  |  |  |  | 
| 1814 |  |  |  |  |  |  | # make range regexp per length | 
| 1815 | 0 |  |  |  |  | 0 | for my $length (CORE::length($char[$i-1]) .. CORE::length($char[$i+1])) { | 
| 1816 | 0 |  |  |  |  | 0 | my @regexp = (); | 
| 1817 |  |  |  |  |  |  |  | 
| 1818 |  |  |  |  |  |  | # is first and last | 
| 1819 | 0 | 0 | 0 |  |  | 0 | if (($length == CORE::length($char[$i-1])) and ($length == CORE::length($char[$i+1]))) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1820 | 0 |  |  |  |  | 0 | push @regexp, _range_regexp($length, $char[$i-1], $char[$i+1]); | 
| 1821 |  |  |  |  |  |  | } | 
| 1822 |  |  |  |  |  |  |  | 
| 1823 |  |  |  |  |  |  | # is first | 
| 1824 |  |  |  |  |  |  | elsif ($length == CORE::length($char[$i-1])) { | 
| 1825 | 0 |  |  |  |  | 0 | push @regexp, _range_regexp($length, $char[$i-1], "\xFF" x $length); | 
| 1826 |  |  |  |  |  |  | } | 
| 1827 |  |  |  |  |  |  |  | 
| 1828 |  |  |  |  |  |  | # is inside in first and last | 
| 1829 |  |  |  |  |  |  | elsif ((CORE::length($char[$i-1]) < $length) and ($length < CORE::length($char[$i+1]))) { | 
| 1830 | 0 |  |  |  |  | 0 | push @regexp, _range_regexp($length, "\x00" x $length, "\xFF" x $length); | 
| 1831 |  |  |  |  |  |  | } | 
| 1832 |  |  |  |  |  |  |  | 
| 1833 |  |  |  |  |  |  | # is last | 
| 1834 |  |  |  |  |  |  | elsif ($length == CORE::length($char[$i+1])) { | 
| 1835 | 0 |  |  |  |  | 0 | push @regexp, _range_regexp($length, "\x00" x $length, $char[$i+1]); | 
| 1836 |  |  |  |  |  |  | } | 
| 1837 |  |  |  |  |  |  |  | 
| 1838 |  |  |  |  |  |  | else { | 
| 1839 | 0 |  |  |  |  | 0 | die __FILE__, ": subroutine make_regexp panic.\n"; | 
| 1840 |  |  |  |  |  |  | } | 
| 1841 |  |  |  |  |  |  |  | 
| 1842 | 0 | 0 |  |  |  | 0 | if ($length == 1) { | 
| 1843 | 0 |  |  |  |  | 0 | push @singleoctet, @regexp; | 
| 1844 |  |  |  |  |  |  | } | 
| 1845 |  |  |  |  |  |  | else { | 
| 1846 | 0 |  |  |  |  | 0 | push @multipleoctet, @regexp; | 
| 1847 |  |  |  |  |  |  | } | 
| 1848 |  |  |  |  |  |  | } | 
| 1849 |  |  |  |  |  |  |  | 
| 1850 | 0 |  |  |  |  | 0 | $i += 2; | 
| 1851 |  |  |  |  |  |  | } | 
| 1852 |  |  |  |  |  |  |  | 
| 1853 |  |  |  |  |  |  | # with /i modifier | 
| 1854 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 1855 | 0 | 0 |  |  |  | 0 | if ($modifier =~ /i/oxms) { | 
| 1856 | 0 |  |  |  |  | 0 | my $uc = Elatin6::uc($char[$i]); | 
| 1857 | 0 |  |  |  |  | 0 | my $fc = Elatin6::fc($char[$i]); | 
| 1858 | 0 | 0 |  |  |  | 0 | if ($uc ne $fc) { | 
| 1859 | 0 | 0 |  |  |  | 0 | if (CORE::length($fc) == 1) { | 
| 1860 | 0 |  |  |  |  | 0 | push @singleoctet, $uc, $fc; | 
| 1861 |  |  |  |  |  |  | } | 
| 1862 |  |  |  |  |  |  | else { | 
| 1863 | 0 |  |  |  |  | 0 | push @singleoctet,   $uc; | 
| 1864 | 0 |  |  |  |  | 0 | push @multipleoctet, $fc; | 
| 1865 |  |  |  |  |  |  | } | 
| 1866 |  |  |  |  |  |  | } | 
| 1867 |  |  |  |  |  |  | else { | 
| 1868 | 0 |  |  |  |  | 0 | push @singleoctet, $char[$i]; | 
| 1869 |  |  |  |  |  |  | } | 
| 1870 |  |  |  |  |  |  | } | 
| 1871 |  |  |  |  |  |  | else { | 
| 1872 | 0 |  |  |  |  | 0 | push @singleoctet, $char[$i]; | 
| 1873 |  |  |  |  |  |  | } | 
| 1874 | 0 |  |  |  |  | 0 | $i += 1; | 
| 1875 |  |  |  |  |  |  | } | 
| 1876 |  |  |  |  |  |  |  | 
| 1877 |  |  |  |  |  |  | # single character of single octet code | 
| 1878 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\h ) \z/oxms) { | 
| 1879 | 0 |  |  |  |  | 0 | push @singleoctet, "\t", "\x20"; | 
| 1880 | 0 |  |  |  |  | 0 | $i += 1; | 
| 1881 |  |  |  |  |  |  | } | 
| 1882 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\v ) \z/oxms) { | 
| 1883 | 0 |  |  |  |  | 0 | push @singleoctet, "\x0A", "\x0B", "\x0C", "\x0D"; | 
| 1884 | 0 |  |  |  |  | 0 | $i += 1; | 
| 1885 |  |  |  |  |  |  | } | 
| 1886 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\d | \\s | \\w ) \z/oxms) { | 
| 1887 | 0 |  |  |  |  | 0 | push @singleoctet, $char[$i]; | 
| 1888 | 0 |  |  |  |  | 0 | $i += 1; | 
| 1889 |  |  |  |  |  |  | } | 
| 1890 |  |  |  |  |  |  |  | 
| 1891 |  |  |  |  |  |  | # single character of multiple-octet code | 
| 1892 |  |  |  |  |  |  | else { | 
| 1893 | 0 |  |  |  |  | 0 | push @multipleoctet, $char[$i]; | 
| 1894 | 0 |  |  |  |  | 0 | $i += 1; | 
| 1895 |  |  |  |  |  |  | } | 
| 1896 |  |  |  |  |  |  | } | 
| 1897 |  |  |  |  |  |  |  | 
| 1898 |  |  |  |  |  |  | # quote metachar | 
| 1899 | 0 |  |  |  |  | 0 | for (@singleoctet) { | 
| 1900 | 0 | 0 |  |  |  | 0 | if ($_ eq '...') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 1901 | 0 |  |  |  |  | 0 | $_ = '-'; | 
| 1902 |  |  |  |  |  |  | } | 
| 1903 |  |  |  |  |  |  | elsif (/\A \n \z/oxms) { | 
| 1904 | 0 |  |  |  |  | 0 | $_ = '\n'; | 
| 1905 |  |  |  |  |  |  | } | 
| 1906 |  |  |  |  |  |  | elsif (/\A \r \z/oxms) { | 
| 1907 | 0 |  |  |  |  | 0 | $_ = '\r'; | 
| 1908 |  |  |  |  |  |  | } | 
| 1909 |  |  |  |  |  |  | elsif (/\A ([\x00-\x20\x7F-\xFF]) \z/oxms) { | 
| 1910 | 0 |  |  |  |  | 0 | $_ = sprintf('\x%02X', CORE::ord $1); | 
| 1911 |  |  |  |  |  |  | } | 
| 1912 |  |  |  |  |  |  | elsif (/\A [\x00-\xFF] \z/oxms) { | 
| 1913 | 0 |  |  |  |  | 0 | $_ = quotemeta $_; | 
| 1914 |  |  |  |  |  |  | } | 
| 1915 |  |  |  |  |  |  | } | 
| 1916 |  |  |  |  |  |  |  | 
| 1917 |  |  |  |  |  |  | # return character list | 
| 1918 | 0 |  |  |  |  | 0 | return \@singleoctet, \@multipleoctet; | 
| 1919 |  |  |  |  |  |  | } | 
| 1920 |  |  |  |  |  |  |  | 
| 1921 |  |  |  |  |  |  | # | 
| 1922 |  |  |  |  |  |  | # Latin-6 octal escape sequence | 
| 1923 |  |  |  |  |  |  | # | 
| 1924 |  |  |  |  |  |  | sub octchr { | 
| 1925 | 0 |  |  | 0 | 0 | 0 | my($octdigit) = @_; | 
| 1926 |  |  |  |  |  |  |  | 
| 1927 | 0 |  |  |  |  | 0 | my @binary = (); | 
| 1928 | 0 |  |  |  |  | 0 | for my $octal (split(//,$octdigit)) { | 
| 1929 | 0 |  |  |  |  | 0 | push @binary, { | 
| 1930 |  |  |  |  |  |  | '0' => '000', | 
| 1931 |  |  |  |  |  |  | '1' => '001', | 
| 1932 |  |  |  |  |  |  | '2' => '010', | 
| 1933 |  |  |  |  |  |  | '3' => '011', | 
| 1934 |  |  |  |  |  |  | '4' => '100', | 
| 1935 |  |  |  |  |  |  | '5' => '101', | 
| 1936 |  |  |  |  |  |  | '6' => '110', | 
| 1937 |  |  |  |  |  |  | '7' => '111', | 
| 1938 |  |  |  |  |  |  | }->{$octal}; | 
| 1939 |  |  |  |  |  |  | } | 
| 1940 | 0 |  |  |  |  | 0 | my $binary = join '', @binary; | 
| 1941 |  |  |  |  |  |  |  | 
| 1942 | 0 |  |  |  |  | 0 | my $octchr = { | 
| 1943 |  |  |  |  |  |  | #                1234567 | 
| 1944 |  |  |  |  |  |  | 1 => pack('B*', "0000000$binary"), | 
| 1945 |  |  |  |  |  |  | 2 => pack('B*', "000000$binary"), | 
| 1946 |  |  |  |  |  |  | 3 => pack('B*', "00000$binary"), | 
| 1947 |  |  |  |  |  |  | 4 => pack('B*', "0000$binary"), | 
| 1948 |  |  |  |  |  |  | 5 => pack('B*', "000$binary"), | 
| 1949 |  |  |  |  |  |  | 6 => pack('B*', "00$binary"), | 
| 1950 |  |  |  |  |  |  | 7 => pack('B*', "0$binary"), | 
| 1951 |  |  |  |  |  |  | 0 => pack('B*', "$binary"), | 
| 1952 |  |  |  |  |  |  |  | 
| 1953 |  |  |  |  |  |  | }->{CORE::length($binary) % 8}; | 
| 1954 |  |  |  |  |  |  |  | 
| 1955 | 0 |  |  |  |  | 0 | return $octchr; | 
| 1956 |  |  |  |  |  |  | } | 
| 1957 |  |  |  |  |  |  |  | 
| 1958 |  |  |  |  |  |  | # | 
| 1959 |  |  |  |  |  |  | # Latin-6 hexadecimal escape sequence | 
| 1960 |  |  |  |  |  |  | # | 
| 1961 |  |  |  |  |  |  | sub hexchr { | 
| 1962 | 0 |  |  | 0 | 0 | 0 | my($hexdigit) = @_; | 
| 1963 |  |  |  |  |  |  |  | 
| 1964 | 0 |  |  |  |  | 0 | my $hexchr = { | 
| 1965 |  |  |  |  |  |  | 1 => pack('H*', "0$hexdigit"), | 
| 1966 |  |  |  |  |  |  | 0 => pack('H*', "$hexdigit"), | 
| 1967 |  |  |  |  |  |  |  | 
| 1968 |  |  |  |  |  |  | }->{CORE::length($_[0]) % 2}; | 
| 1969 |  |  |  |  |  |  |  | 
| 1970 | 0 |  |  |  |  | 0 | return $hexchr; | 
| 1971 |  |  |  |  |  |  | } | 
| 1972 |  |  |  |  |  |  |  | 
| 1973 |  |  |  |  |  |  | # | 
| 1974 |  |  |  |  |  |  | # Latin-6 open character list for qr | 
| 1975 |  |  |  |  |  |  | # | 
| 1976 |  |  |  |  |  |  | sub charlist_qr { | 
| 1977 |  |  |  |  |  |  |  | 
| 1978 | 0 |  |  | 0 | 0 | 0 | my $modifier = pop @_; | 
| 1979 | 0 |  |  |  |  | 0 | my @char = @_; | 
| 1980 |  |  |  |  |  |  |  | 
| 1981 | 0 |  |  |  |  | 0 | my($singleoctet, $multipleoctet) = _charlist(@char, $modifier); | 
| 1982 | 0 |  |  |  |  | 0 | my @singleoctet   = @$singleoctet; | 
| 1983 | 0 |  |  |  |  | 0 | my @multipleoctet = @$multipleoctet; | 
| 1984 |  |  |  |  |  |  |  | 
| 1985 |  |  |  |  |  |  | # return character list | 
| 1986 | 0 | 0 |  |  |  | 0 | if (scalar(@singleoctet) >= 1) { | 
| 1987 |  |  |  |  |  |  |  | 
| 1988 |  |  |  |  |  |  | # with /i modifier | 
| 1989 | 0 | 0 |  |  |  | 0 | if ($modifier =~ m/i/oxms) { | 
| 1990 | 0 |  |  |  |  | 0 | my %singleoctet_ignorecase = (); | 
| 1991 | 0 |  |  |  |  | 0 | for (@singleoctet) { | 
| 1992 | 0 |  | 0 |  |  | 0 | while (s/ \A \\x(..) - \\x(..) //oxms or s/ \A \\x((..)) //oxms) { | 
| 1993 | 0 |  |  |  |  | 0 | for my $ord (hex($1) .. hex($2)) { | 
| 1994 | 0 |  |  |  |  | 0 | my $char = CORE::chr($ord); | 
| 1995 | 0 |  |  |  |  | 0 | my $uc = Elatin6::uc($char); | 
| 1996 | 0 |  |  |  |  | 0 | my $fc = Elatin6::fc($char); | 
| 1997 | 0 | 0 |  |  |  | 0 | if ($uc eq $fc) { | 
| 1998 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $char} = 1; | 
| 1999 |  |  |  |  |  |  | } | 
| 2000 |  |  |  |  |  |  | else { | 
| 2001 | 0 | 0 |  |  |  | 0 | if (CORE::length($fc) == 1) { | 
| 2002 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2003 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $fc} = 1; | 
| 2004 |  |  |  |  |  |  | } | 
| 2005 |  |  |  |  |  |  | else { | 
| 2006 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2007 | 0 |  |  |  |  | 0 | push @multipleoctet, join '', map {sprintf('\x%02X',$_)} unpack 'C*', $fc; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2008 |  |  |  |  |  |  | } | 
| 2009 |  |  |  |  |  |  | } | 
| 2010 |  |  |  |  |  |  | } | 
| 2011 |  |  |  |  |  |  | } | 
| 2012 | 0 | 0 |  |  |  | 0 | if ($_ ne '') { | 
| 2013 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $_} = 1; | 
| 2014 |  |  |  |  |  |  | } | 
| 2015 |  |  |  |  |  |  | } | 
| 2016 | 0 |  |  |  |  | 0 | my $i = 0; | 
| 2017 | 0 |  |  |  |  | 0 | my @singleoctet_ignorecase = (); | 
| 2018 | 0 |  |  |  |  | 0 | for my $ord (0 .. 255) { | 
| 2019 | 0 | 0 |  |  |  | 0 | if (exists $singleoctet_ignorecase{$ord}) { | 
| 2020 | 0 |  |  |  |  | 0 | push @{$singleoctet_ignorecase[$i]}, $ord; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2021 |  |  |  |  |  |  | } | 
| 2022 |  |  |  |  |  |  | else { | 
| 2023 | 0 |  |  |  |  | 0 | $i++; | 
| 2024 |  |  |  |  |  |  | } | 
| 2025 |  |  |  |  |  |  | } | 
| 2026 | 0 |  |  |  |  | 0 | @singleoctet = (); | 
| 2027 | 0 |  |  |  |  | 0 | for my $range (@singleoctet_ignorecase) { | 
| 2028 | 0 | 0 |  |  |  | 0 | if (ref $range) { | 
| 2029 | 0 | 0 |  |  |  | 0 | if (scalar(@{$range}) == 1) { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2030 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X', @{$range}[0]); | 
|  | 0 |  |  |  |  | 0 |  | 
| 2031 |  |  |  |  |  |  | } | 
| 2032 |  |  |  |  |  |  | elsif (scalar(@{$range}) == 2) { | 
| 2033 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2034 |  |  |  |  |  |  | } | 
| 2035 |  |  |  |  |  |  | else { | 
| 2036 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X-\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2037 |  |  |  |  |  |  | } | 
| 2038 |  |  |  |  |  |  | } | 
| 2039 |  |  |  |  |  |  | } | 
| 2040 |  |  |  |  |  |  | } | 
| 2041 |  |  |  |  |  |  |  | 
| 2042 | 0 |  |  |  |  | 0 | my $not_anchor = ''; | 
| 2043 |  |  |  |  |  |  |  | 
| 2044 | 0 |  |  |  |  | 0 | push @multipleoctet, join('', $not_anchor, '[', @singleoctet, ']' ); | 
| 2045 |  |  |  |  |  |  | } | 
| 2046 | 0 | 0 |  |  |  | 0 | if (scalar(@multipleoctet) >= 2) { | 
| 2047 | 0 |  |  |  |  | 0 | return '(?:' . join('|', @multipleoctet) . ')'; | 
| 2048 |  |  |  |  |  |  | } | 
| 2049 |  |  |  |  |  |  | else { | 
| 2050 | 0 |  |  |  |  | 0 | return $multipleoctet[0]; | 
| 2051 |  |  |  |  |  |  | } | 
| 2052 |  |  |  |  |  |  | } | 
| 2053 |  |  |  |  |  |  |  | 
| 2054 |  |  |  |  |  |  | # | 
| 2055 |  |  |  |  |  |  | # Latin-6 open character list for not qr | 
| 2056 |  |  |  |  |  |  | # | 
| 2057 |  |  |  |  |  |  | sub charlist_not_qr { | 
| 2058 |  |  |  |  |  |  |  | 
| 2059 | 0 |  |  | 0 | 0 | 0 | my $modifier = pop @_; | 
| 2060 | 0 |  |  |  |  | 0 | my @char = @_; | 
| 2061 |  |  |  |  |  |  |  | 
| 2062 | 0 |  |  |  |  | 0 | my($singleoctet, $multipleoctet) = _charlist(@char, $modifier); | 
| 2063 | 0 |  |  |  |  | 0 | my @singleoctet   = @$singleoctet; | 
| 2064 | 0 |  |  |  |  | 0 | my @multipleoctet = @$multipleoctet; | 
| 2065 |  |  |  |  |  |  |  | 
| 2066 |  |  |  |  |  |  | # with /i modifier | 
| 2067 | 0 | 0 |  |  |  | 0 | if ($modifier =~ m/i/oxms) { | 
| 2068 | 0 |  |  |  |  | 0 | my %singleoctet_ignorecase = (); | 
| 2069 | 0 |  |  |  |  | 0 | for (@singleoctet) { | 
| 2070 | 0 |  | 0 |  |  | 0 | while (s/ \A \\x(..) - \\x(..) //oxms or s/ \A \\x((..)) //oxms) { | 
| 2071 | 0 |  |  |  |  | 0 | for my $ord (hex($1) .. hex($2)) { | 
| 2072 | 0 |  |  |  |  | 0 | my $char = CORE::chr($ord); | 
| 2073 | 0 |  |  |  |  | 0 | my $uc = Elatin6::uc($char); | 
| 2074 | 0 |  |  |  |  | 0 | my $fc = Elatin6::fc($char); | 
| 2075 | 0 | 0 |  |  |  | 0 | if ($uc eq $fc) { | 
| 2076 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $char} = 1; | 
| 2077 |  |  |  |  |  |  | } | 
| 2078 |  |  |  |  |  |  | else { | 
| 2079 | 0 | 0 |  |  |  | 0 | if (CORE::length($fc) == 1) { | 
| 2080 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2081 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $fc} = 1; | 
| 2082 |  |  |  |  |  |  | } | 
| 2083 |  |  |  |  |  |  | else { | 
| 2084 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $uc} = 1; | 
| 2085 | 0 |  |  |  |  | 0 | push @multipleoctet, join '', map {sprintf('\x%02X',$_)} unpack 'C*', $fc; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2086 |  |  |  |  |  |  | } | 
| 2087 |  |  |  |  |  |  | } | 
| 2088 |  |  |  |  |  |  | } | 
| 2089 |  |  |  |  |  |  | } | 
| 2090 | 0 | 0 |  |  |  | 0 | if ($_ ne '') { | 
| 2091 | 0 |  |  |  |  | 0 | $singleoctet_ignorecase{unpack 'C*', $_} = 1; | 
| 2092 |  |  |  |  |  |  | } | 
| 2093 |  |  |  |  |  |  | } | 
| 2094 | 0 |  |  |  |  | 0 | my $i = 0; | 
| 2095 | 0 |  |  |  |  | 0 | my @singleoctet_ignorecase = (); | 
| 2096 | 0 |  |  |  |  | 0 | for my $ord (0 .. 255) { | 
| 2097 | 0 | 0 |  |  |  | 0 | if (exists $singleoctet_ignorecase{$ord}) { | 
| 2098 | 0 |  |  |  |  | 0 | push @{$singleoctet_ignorecase[$i]}, $ord; | 
|  | 0 |  |  |  |  | 0 |  | 
| 2099 |  |  |  |  |  |  | } | 
| 2100 |  |  |  |  |  |  | else { | 
| 2101 | 0 |  |  |  |  | 0 | $i++; | 
| 2102 |  |  |  |  |  |  | } | 
| 2103 |  |  |  |  |  |  | } | 
| 2104 | 0 |  |  |  |  | 0 | @singleoctet = (); | 
| 2105 | 0 |  |  |  |  | 0 | for my $range (@singleoctet_ignorecase) { | 
| 2106 | 0 | 0 |  |  |  | 0 | if (ref $range) { | 
| 2107 | 0 | 0 |  |  |  | 0 | if (scalar(@{$range}) == 1) { | 
|  | 0 | 0 |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2108 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X', @{$range}[0]); | 
|  | 0 |  |  |  |  | 0 |  | 
| 2109 |  |  |  |  |  |  | } | 
| 2110 |  |  |  |  |  |  | elsif (scalar(@{$range}) == 2) { | 
| 2111 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2112 |  |  |  |  |  |  | } | 
| 2113 |  |  |  |  |  |  | else { | 
| 2114 | 0 |  |  |  |  | 0 | push @singleoctet, sprintf('\x%02X-\x%02X', @{$range}[0], @{$range}[-1]); | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 2115 |  |  |  |  |  |  | } | 
| 2116 |  |  |  |  |  |  | } | 
| 2117 |  |  |  |  |  |  | } | 
| 2118 |  |  |  |  |  |  | } | 
| 2119 |  |  |  |  |  |  |  | 
| 2120 |  |  |  |  |  |  | # return character list | 
| 2121 | 0 | 0 |  |  |  | 0 | if (scalar(@multipleoctet) >= 1) { | 
| 2122 | 0 | 0 |  |  |  | 0 | if (scalar(@singleoctet) >= 1) { | 
| 2123 |  |  |  |  |  |  |  | 
| 2124 |  |  |  |  |  |  | # any character other than multiple-octet and single octet character class | 
| 2125 | 0 |  |  |  |  | 0 | return '(?!' . join('|', @multipleoctet) . ')(?:[^' . join('', @singleoctet) . '])'; | 
| 2126 |  |  |  |  |  |  | } | 
| 2127 |  |  |  |  |  |  | else { | 
| 2128 |  |  |  |  |  |  |  | 
| 2129 |  |  |  |  |  |  | # any character other than multiple-octet character class | 
| 2130 | 0 |  |  |  |  | 0 | return '(?!' . join('|', @multipleoctet) . ")(?:$your_char)"; | 
| 2131 |  |  |  |  |  |  | } | 
| 2132 |  |  |  |  |  |  | } | 
| 2133 |  |  |  |  |  |  | else { | 
| 2134 | 0 | 0 |  |  |  | 0 | if (scalar(@singleoctet) >= 1) { | 
| 2135 |  |  |  |  |  |  |  | 
| 2136 |  |  |  |  |  |  | # any character other than single octet character class | 
| 2137 | 0 |  |  |  |  | 0 | return                                      '(?:[^' . join('', @singleoctet) . '])'; | 
| 2138 |  |  |  |  |  |  | } | 
| 2139 |  |  |  |  |  |  | else { | 
| 2140 |  |  |  |  |  |  |  | 
| 2141 |  |  |  |  |  |  | # any character | 
| 2142 | 0 |  |  |  |  | 0 | return                                      "(?:$your_char)"; | 
| 2143 |  |  |  |  |  |  | } | 
| 2144 |  |  |  |  |  |  | } | 
| 2145 |  |  |  |  |  |  | } | 
| 2146 |  |  |  |  |  |  |  | 
| 2147 |  |  |  |  |  |  | # | 
| 2148 |  |  |  |  |  |  | # open file in read mode | 
| 2149 |  |  |  |  |  |  | # | 
| 2150 |  |  |  |  |  |  | sub _open_r { | 
| 2151 | 200 |  |  | 200 |  | 627 | my(undef,$file) = @_; | 
| 2152 | 200 |  |  |  |  | 819 | $file =~ s#\A (\s) #./$1#oxms; | 
| 2153 | 200 |  | 33 |  |  | 18297 | return CORE::eval(q{open($_[0],'<',$_[1])}) || | 
| 2154 |  |  |  |  |  |  | open($_[0],"< $file\0"); | 
| 2155 |  |  |  |  |  |  | } | 
| 2156 |  |  |  |  |  |  |  | 
| 2157 |  |  |  |  |  |  | # | 
| 2158 |  |  |  |  |  |  | # open file in write mode | 
| 2159 |  |  |  |  |  |  | # | 
| 2160 |  |  |  |  |  |  | sub _open_w { | 
| 2161 | 0 |  |  | 0 |  | 0 | my(undef,$file) = @_; | 
| 2162 | 0 |  |  |  |  | 0 | $file =~ s#\A (\s) #./$1#oxms; | 
| 2163 | 0 |  | 0 |  |  | 0 | return CORE::eval(q{open($_[0],'>',$_[1])}) || | 
| 2164 |  |  |  |  |  |  | open($_[0],"> $file\0"); | 
| 2165 |  |  |  |  |  |  | } | 
| 2166 |  |  |  |  |  |  |  | 
| 2167 |  |  |  |  |  |  | # | 
| 2168 |  |  |  |  |  |  | # open file in append mode | 
| 2169 |  |  |  |  |  |  | # | 
| 2170 |  |  |  |  |  |  | sub _open_a { | 
| 2171 | 0 |  |  | 0 |  | 0 | my(undef,$file) = @_; | 
| 2172 | 0 |  |  |  |  | 0 | $file =~ s#\A (\s) #./$1#oxms; | 
| 2173 | 0 |  | 0 |  |  | 0 | return CORE::eval(q{open($_[0],'>>',$_[1])}) || | 
| 2174 |  |  |  |  |  |  | open($_[0],">> $file\0"); | 
| 2175 |  |  |  |  |  |  | } | 
| 2176 |  |  |  |  |  |  |  | 
| 2177 |  |  |  |  |  |  | # | 
| 2178 |  |  |  |  |  |  | # safe system | 
| 2179 |  |  |  |  |  |  | # | 
| 2180 |  |  |  |  |  |  | sub _systemx { | 
| 2181 |  |  |  |  |  |  |  | 
| 2182 |  |  |  |  |  |  | # P.707 29.2.33. exec | 
| 2183 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 2184 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2185 |  |  |  |  |  |  | # | 
| 2186 |  |  |  |  |  |  | # Be aware that in older releases of Perl, exec (and system) did not flush | 
| 2187 |  |  |  |  |  |  | # your output buffer, so you needed to enable command buffering by setting $| | 
| 2188 |  |  |  |  |  |  | # on one or more filehandles to avoid lost output in the case of exec, or | 
| 2189 |  |  |  |  |  |  | # misordererd output in the case of system. This situation was largely remedied | 
| 2190 |  |  |  |  |  |  | # in the 5.6 release of Perl. (So, 5.005 release not yet.) | 
| 2191 |  |  |  |  |  |  |  | 
| 2192 |  |  |  |  |  |  | # P.855 exec | 
| 2193 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 2194 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2195 |  |  |  |  |  |  | # | 
| 2196 |  |  |  |  |  |  | # In very old release of Perl (before v5.6), exec (and system) did not flush | 
| 2197 |  |  |  |  |  |  | # your output buffer, so you needed to enable command buffering by setting $| | 
| 2198 |  |  |  |  |  |  | # on one or more filehandles to avoid lost output with exec or misordered | 
| 2199 |  |  |  |  |  |  | # output with system. | 
| 2200 |  |  |  |  |  |  |  | 
| 2201 | 200 |  |  | 200 |  | 749 | $| = 1; | 
| 2202 |  |  |  |  |  |  |  | 
| 2203 |  |  |  |  |  |  | # P.565 23.1.2. Cleaning Up Your Environment | 
| 2204 |  |  |  |  |  |  | # in Chapter 23: Security | 
| 2205 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2206 |  |  |  |  |  |  |  | 
| 2207 |  |  |  |  |  |  | # P.656 Cleaning Up Your Environment | 
| 2208 |  |  |  |  |  |  | # in Chapter 20: Security | 
| 2209 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2210 |  |  |  |  |  |  |  | 
| 2211 |  |  |  |  |  |  | # local $ENV{'PATH'} = '.'; | 
| 2212 | 200 |  |  |  |  | 2166 | local @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer | 
| 2213 |  |  |  |  |  |  |  | 
| 2214 |  |  |  |  |  |  | # P.707 29.2.33. exec | 
| 2215 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 2216 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2217 |  |  |  |  |  |  | # | 
| 2218 |  |  |  |  |  |  | # As we mentioned earlier, exec treats a discrete list of arguments as an | 
| 2219 |  |  |  |  |  |  | # indication that it should bypass shell processing. However, there is one | 
| 2220 |  |  |  |  |  |  | # place where you might still get tripped up. The exec call (and system, too) | 
| 2221 |  |  |  |  |  |  | # will not distinguish between a single scalar argument and an array containing | 
| 2222 |  |  |  |  |  |  | # only one element. | 
| 2223 |  |  |  |  |  |  | # | 
| 2224 |  |  |  |  |  |  | #     @args = ("echo surprise");  # just one element in list | 
| 2225 |  |  |  |  |  |  | #     exec @args                  # still subject to shell escapes | 
| 2226 |  |  |  |  |  |  | #         or die "exec: $!";      #   because @args == 1 | 
| 2227 |  |  |  |  |  |  | # | 
| 2228 |  |  |  |  |  |  | # To avoid this, you can use the PATHNAME syntax, explicitly duplicating the | 
| 2229 |  |  |  |  |  |  | # first argument as the pathname, which forces the rest of the arguments to be | 
| 2230 |  |  |  |  |  |  | # interpreted as a list, even if there is only one of them: | 
| 2231 |  |  |  |  |  |  | # | 
| 2232 |  |  |  |  |  |  | #     exec { $args[0] } @args  # safe even with one-argument list | 
| 2233 |  |  |  |  |  |  | #         or die "can't exec @args: $!"; | 
| 2234 |  |  |  |  |  |  |  | 
| 2235 |  |  |  |  |  |  | # P.855 exec | 
| 2236 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 2237 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2238 |  |  |  |  |  |  | # | 
| 2239 |  |  |  |  |  |  | # As we mentioned earlier, exec treats a discrete list of arguments as a | 
| 2240 |  |  |  |  |  |  | # directive to bypass shell processing. However, there is one place where | 
| 2241 |  |  |  |  |  |  | # you might still get tripped up. The exec call (and system, too) cannot | 
| 2242 |  |  |  |  |  |  | # distinguish between a single scalar argument and an array containing | 
| 2243 |  |  |  |  |  |  | # only one element. | 
| 2244 |  |  |  |  |  |  | # | 
| 2245 |  |  |  |  |  |  | #     @args = ("echo surprise");  # just one element in list | 
| 2246 |  |  |  |  |  |  | #     exec @args                  # still subject to shell escapes | 
| 2247 |  |  |  |  |  |  | #         || die "exec: $!";      #   because @args == 1 | 
| 2248 |  |  |  |  |  |  | # | 
| 2249 |  |  |  |  |  |  | # To avoid this, use the PATHNAME syntax, explicitly duplicating the first | 
| 2250 |  |  |  |  |  |  | # argument as the pathname, which forces the rest of the arguments to be | 
| 2251 |  |  |  |  |  |  | # interpreted as a list, even if there is only one of them: | 
| 2252 |  |  |  |  |  |  | # | 
| 2253 |  |  |  |  |  |  | #     exec { $args[0] } @args  # safe even with one-argument list | 
| 2254 |  |  |  |  |  |  | #         || die "can't exec @args: $!"; | 
| 2255 |  |  |  |  |  |  |  | 
| 2256 | 200 |  |  |  |  | 419 | return CORE::system { $_[0] } @_; # safe even with one-argument list | 
|  | 200 |  |  |  |  | 23194354 |  | 
| 2257 |  |  |  |  |  |  | } | 
| 2258 |  |  |  |  |  |  |  | 
| 2259 |  |  |  |  |  |  | # | 
| 2260 |  |  |  |  |  |  | # Latin-6 order to character (with parameter) | 
| 2261 |  |  |  |  |  |  | # | 
| 2262 |  |  |  |  |  |  | sub Elatin6::chr(;$) { | 
| 2263 |  |  |  |  |  |  |  | 
| 2264 | 0 | 0 |  | 0 | 0 |  | my $c = @_ ? $_[0] : $_; | 
| 2265 |  |  |  |  |  |  |  | 
| 2266 | 0 | 0 |  |  |  |  | if ($c == 0x00) { | 
| 2267 | 0 |  |  |  |  |  | return "\x00"; | 
| 2268 |  |  |  |  |  |  | } | 
| 2269 |  |  |  |  |  |  | else { | 
| 2270 | 0 |  |  |  |  |  | my @chr = (); | 
| 2271 | 0 |  |  |  |  |  | while ($c > 0) { | 
| 2272 | 0 |  |  |  |  |  | unshift @chr, ($c % 0x100); | 
| 2273 | 0 |  |  |  |  |  | $c = int($c / 0x100); | 
| 2274 |  |  |  |  |  |  | } | 
| 2275 | 0 |  |  |  |  |  | return pack 'C*', @chr; | 
| 2276 |  |  |  |  |  |  | } | 
| 2277 |  |  |  |  |  |  | } | 
| 2278 |  |  |  |  |  |  |  | 
| 2279 |  |  |  |  |  |  | # | 
| 2280 |  |  |  |  |  |  | # Latin-6 order to character (without parameter) | 
| 2281 |  |  |  |  |  |  | # | 
| 2282 |  |  |  |  |  |  | sub Elatin6::chr_() { | 
| 2283 |  |  |  |  |  |  |  | 
| 2284 | 0 |  |  | 0 | 0 |  | my $c = $_; | 
| 2285 |  |  |  |  |  |  |  | 
| 2286 | 0 | 0 |  |  |  |  | if ($c == 0x00) { | 
| 2287 | 0 |  |  |  |  |  | return "\x00"; | 
| 2288 |  |  |  |  |  |  | } | 
| 2289 |  |  |  |  |  |  | else { | 
| 2290 | 0 |  |  |  |  |  | my @chr = (); | 
| 2291 | 0 |  |  |  |  |  | while ($c > 0) { | 
| 2292 | 0 |  |  |  |  |  | unshift @chr, ($c % 0x100); | 
| 2293 | 0 |  |  |  |  |  | $c = int($c / 0x100); | 
| 2294 |  |  |  |  |  |  | } | 
| 2295 | 0 |  |  |  |  |  | return pack 'C*', @chr; | 
| 2296 |  |  |  |  |  |  | } | 
| 2297 |  |  |  |  |  |  | } | 
| 2298 |  |  |  |  |  |  |  | 
| 2299 |  |  |  |  |  |  | # | 
| 2300 |  |  |  |  |  |  | # Latin-6 path globbing (with parameter) | 
| 2301 |  |  |  |  |  |  | # | 
| 2302 |  |  |  |  |  |  | sub Elatin6::glob($) { | 
| 2303 |  |  |  |  |  |  |  | 
| 2304 | 0 | 0 |  | 0 | 0 |  | if (wantarray) { | 
| 2305 | 0 |  |  |  |  |  | my @glob = _DOS_like_glob(@_); | 
| 2306 | 0 |  |  |  |  |  | for my $glob (@glob) { | 
| 2307 | 0 |  |  |  |  |  | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 2308 |  |  |  |  |  |  | } | 
| 2309 | 0 |  |  |  |  |  | return @glob; | 
| 2310 |  |  |  |  |  |  | } | 
| 2311 |  |  |  |  |  |  | else { | 
| 2312 | 0 |  |  |  |  |  | my $glob = _DOS_like_glob(@_); | 
| 2313 | 0 |  |  |  |  |  | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 2314 | 0 |  |  |  |  |  | return $glob; | 
| 2315 |  |  |  |  |  |  | } | 
| 2316 |  |  |  |  |  |  | } | 
| 2317 |  |  |  |  |  |  |  | 
| 2318 |  |  |  |  |  |  | # | 
| 2319 |  |  |  |  |  |  | # Latin-6 path globbing (without parameter) | 
| 2320 |  |  |  |  |  |  | # | 
| 2321 |  |  |  |  |  |  | sub Elatin6::glob_() { | 
| 2322 |  |  |  |  |  |  |  | 
| 2323 | 0 | 0 |  | 0 | 0 |  | if (wantarray) { | 
| 2324 | 0 |  |  |  |  |  | my @glob = _DOS_like_glob(); | 
| 2325 | 0 |  |  |  |  |  | for my $glob (@glob) { | 
| 2326 | 0 |  |  |  |  |  | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 2327 |  |  |  |  |  |  | } | 
| 2328 | 0 |  |  |  |  |  | return @glob; | 
| 2329 |  |  |  |  |  |  | } | 
| 2330 |  |  |  |  |  |  | else { | 
| 2331 | 0 |  |  |  |  |  | my $glob = _DOS_like_glob(); | 
| 2332 | 0 |  |  |  |  |  | $glob =~ s{ \A (?:\./)+ }{}oxms; | 
| 2333 | 0 |  |  |  |  |  | return $glob; | 
| 2334 |  |  |  |  |  |  | } | 
| 2335 |  |  |  |  |  |  | } | 
| 2336 |  |  |  |  |  |  |  | 
| 2337 |  |  |  |  |  |  | # | 
| 2338 |  |  |  |  |  |  | # Latin-6 path globbing via File::DosGlob 1.10 | 
| 2339 |  |  |  |  |  |  | # | 
| 2340 |  |  |  |  |  |  | # Often I confuse "_dosglob" and "_doglob". | 
| 2341 |  |  |  |  |  |  | # So, I renamed "_dosglob" to "_DOS_like_glob". | 
| 2342 |  |  |  |  |  |  | # | 
| 2343 |  |  |  |  |  |  | my %iter; | 
| 2344 |  |  |  |  |  |  | my %entries; | 
| 2345 |  |  |  |  |  |  | sub _DOS_like_glob { | 
| 2346 |  |  |  |  |  |  |  | 
| 2347 |  |  |  |  |  |  | # context (keyed by second cxix argument provided by core) | 
| 2348 | 0 |  |  | 0 |  |  | my($expr,$cxix) = @_; | 
| 2349 |  |  |  |  |  |  |  | 
| 2350 |  |  |  |  |  |  | # glob without args defaults to $_ | 
| 2351 | 0 | 0 |  |  |  |  | $expr = $_ if not defined $expr; | 
| 2352 |  |  |  |  |  |  |  | 
| 2353 |  |  |  |  |  |  | # represents the current user's home directory | 
| 2354 |  |  |  |  |  |  | # | 
| 2355 |  |  |  |  |  |  | # 7.3. Expanding Tildes in Filenames | 
| 2356 |  |  |  |  |  |  | # in Chapter 7. File Access | 
| 2357 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 2358 |  |  |  |  |  |  | # | 
| 2359 |  |  |  |  |  |  | # and File::HomeDir, File::HomeDir::Windows module | 
| 2360 |  |  |  |  |  |  |  | 
| 2361 |  |  |  |  |  |  | # DOS-like system | 
| 2362 | 0 | 0 |  |  |  |  | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 2363 | 0 |  |  |  |  |  | $expr =~ s{ \A ~ (?= [^/\\] ) } | 
| 2364 | 0 |  |  |  |  |  | { my_home_MSWin32() }oxmse; | 
| 2365 |  |  |  |  |  |  | } | 
| 2366 |  |  |  |  |  |  |  | 
| 2367 |  |  |  |  |  |  | # UNIX-like system | 
| 2368 |  |  |  |  |  |  | else { | 
| 2369 | 0 |  |  |  |  |  | $expr =~ s{ \A ~ ( (?:[^/])* ) } | 
| 2370 | 0 | 0 | 0 |  |  |  | { $1 ? (CORE::eval(q{(getpwnam($1))[7]})||my_home()) : my_home() }oxmse; | 
| 2371 |  |  |  |  |  |  | } | 
| 2372 |  |  |  |  |  |  |  | 
| 2373 |  |  |  |  |  |  | # assume global context if not provided one | 
| 2374 | 0 | 0 |  |  |  |  | $cxix = '_G_' if not defined $cxix; | 
| 2375 | 0 | 0 |  |  |  |  | $iter{$cxix} = 0 if not exists $iter{$cxix}; | 
| 2376 |  |  |  |  |  |  |  | 
| 2377 |  |  |  |  |  |  | # if we're just beginning, do it all first | 
| 2378 | 0 | 0 |  |  |  |  | if ($iter{$cxix} == 0) { | 
| 2379 | 0 |  |  |  |  |  | $entries{$cxix} = [ _do_glob(1, _parse_line($expr)) ]; | 
| 2380 |  |  |  |  |  |  | } | 
| 2381 |  |  |  |  |  |  |  | 
| 2382 |  |  |  |  |  |  | # chuck it all out, quick or slow | 
| 2383 | 0 | 0 |  |  |  |  | if (wantarray) { | 
| 2384 | 0 |  |  |  |  |  | delete $iter{$cxix}; | 
| 2385 | 0 |  |  |  |  |  | return @{delete $entries{$cxix}}; | 
|  | 0 |  |  |  |  |  |  | 
| 2386 |  |  |  |  |  |  | } | 
| 2387 |  |  |  |  |  |  | else { | 
| 2388 | 0 | 0 |  |  |  |  | if ($iter{$cxix} = scalar @{$entries{$cxix}}) { | 
|  | 0 |  |  |  |  |  |  | 
| 2389 | 0 |  |  |  |  |  | return shift @{$entries{$cxix}}; | 
|  | 0 |  |  |  |  |  |  | 
| 2390 |  |  |  |  |  |  | } | 
| 2391 |  |  |  |  |  |  | else { | 
| 2392 |  |  |  |  |  |  | # return undef for EOL | 
| 2393 | 0 |  |  |  |  |  | delete $iter{$cxix}; | 
| 2394 | 0 |  |  |  |  |  | delete $entries{$cxix}; | 
| 2395 | 0 |  |  |  |  |  | return undef; | 
| 2396 |  |  |  |  |  |  | } | 
| 2397 |  |  |  |  |  |  | } | 
| 2398 |  |  |  |  |  |  | } | 
| 2399 |  |  |  |  |  |  |  | 
| 2400 |  |  |  |  |  |  | # | 
| 2401 |  |  |  |  |  |  | # Latin-6 path globbing subroutine | 
| 2402 |  |  |  |  |  |  | # | 
| 2403 |  |  |  |  |  |  | sub _do_glob { | 
| 2404 |  |  |  |  |  |  |  | 
| 2405 | 0 |  |  | 0 |  |  | my($cond,@expr) = @_; | 
| 2406 | 0 |  |  |  |  |  | my @glob = (); | 
| 2407 | 0 |  |  |  |  |  | my $fix_drive_relative_paths = 0; | 
| 2408 |  |  |  |  |  |  |  | 
| 2409 |  |  |  |  |  |  | OUTER: | 
| 2410 | 0 |  |  |  |  |  | for my $expr (@expr) { | 
| 2411 | 0 | 0 |  |  |  |  | next OUTER if not defined $expr; | 
| 2412 | 0 | 0 |  |  |  |  | next OUTER if $expr eq ''; | 
| 2413 |  |  |  |  |  |  |  | 
| 2414 | 0 |  |  |  |  |  | my @matched = (); | 
| 2415 | 0 |  |  |  |  |  | my @globdir = (); | 
| 2416 | 0 |  |  |  |  |  | my $head    = '.'; | 
| 2417 | 0 |  |  |  |  |  | my $pathsep = '/'; | 
| 2418 | 0 |  |  |  |  |  | my $tail; | 
| 2419 |  |  |  |  |  |  |  | 
| 2420 |  |  |  |  |  |  | # if argument is within quotes strip em and do no globbing | 
| 2421 | 0 | 0 |  |  |  |  | if ($expr =~ /\A " ((?:$q_char)*?) " \z/oxms) { | 
| 2422 | 0 |  |  |  |  |  | $expr = $1; | 
| 2423 | 0 | 0 |  |  |  |  | if ($cond eq 'd') { | 
| 2424 | 0 | 0 |  |  |  |  | if (-d $expr) { | 
| 2425 | 0 |  |  |  |  |  | push @glob, $expr; | 
| 2426 |  |  |  |  |  |  | } | 
| 2427 |  |  |  |  |  |  | } | 
| 2428 |  |  |  |  |  |  | else { | 
| 2429 | 0 | 0 |  |  |  |  | if (-e $expr) { | 
| 2430 | 0 |  |  |  |  |  | push @glob, $expr; | 
| 2431 |  |  |  |  |  |  | } | 
| 2432 |  |  |  |  |  |  | } | 
| 2433 | 0 |  |  |  |  |  | next OUTER; | 
| 2434 |  |  |  |  |  |  | } | 
| 2435 |  |  |  |  |  |  |  | 
| 2436 |  |  |  |  |  |  | # wildcards with a drive prefix such as h:*.pm must be changed | 
| 2437 |  |  |  |  |  |  | # to h:./*.pm to expand correctly | 
| 2438 | 0 | 0 |  |  |  |  | if ($^O =~ /\A (?: MSWin32 | NetWare | symbian | dos ) \z/oxms) { | 
| 2439 | 0 | 0 |  |  |  |  | if ($expr =~ s# \A ((?:[A-Za-z]:)?) ([^/\\]) #$1./$2#oxms) { | 
| 2440 | 0 |  |  |  |  |  | $fix_drive_relative_paths = 1; | 
| 2441 |  |  |  |  |  |  | } | 
| 2442 |  |  |  |  |  |  | } | 
| 2443 |  |  |  |  |  |  |  | 
| 2444 | 0 | 0 |  |  |  |  | if (($head, $tail) = _parse_path($expr,$pathsep)) { | 
| 2445 | 0 | 0 |  |  |  |  | if ($tail eq '') { | 
| 2446 | 0 |  |  |  |  |  | push @glob, $expr; | 
| 2447 | 0 |  |  |  |  |  | next OUTER; | 
| 2448 |  |  |  |  |  |  | } | 
| 2449 | 0 | 0 |  |  |  |  | if ($head =~ / \A (?:$q_char)*? [*?] /oxms) { | 
| 2450 | 0 | 0 |  |  |  |  | if (@globdir = _do_glob('d', $head)) { | 
| 2451 | 0 |  |  |  |  |  | push @glob, _do_glob($cond, map {"$_$pathsep$tail"} @globdir); | 
|  | 0 |  |  |  |  |  |  | 
| 2452 | 0 |  |  |  |  |  | next OUTER; | 
| 2453 |  |  |  |  |  |  | } | 
| 2454 |  |  |  |  |  |  | } | 
| 2455 | 0 | 0 | 0 |  |  |  | if ($head eq '' or $head =~ /\A [A-Za-z]: \z/oxms) { | 
| 2456 | 0 |  |  |  |  |  | $head .= $pathsep; | 
| 2457 |  |  |  |  |  |  | } | 
| 2458 | 0 |  |  |  |  |  | $expr = $tail; | 
| 2459 |  |  |  |  |  |  | } | 
| 2460 |  |  |  |  |  |  |  | 
| 2461 |  |  |  |  |  |  | # If file component has no wildcards, we can avoid opendir | 
| 2462 | 0 | 0 |  |  |  |  | if ($expr !~ / \A (?:$q_char)*? [*?] /oxms) { | 
| 2463 | 0 | 0 |  |  |  |  | if ($head eq '.') { | 
| 2464 | 0 |  |  |  |  |  | $head = ''; | 
| 2465 |  |  |  |  |  |  | } | 
| 2466 | 0 | 0 | 0 |  |  |  | if ($head ne '' and ($head =~ / \G ($q_char) /oxmsg)[-1] ne $pathsep) { | 
| 2467 | 0 |  |  |  |  |  | $head .= $pathsep; | 
| 2468 |  |  |  |  |  |  | } | 
| 2469 | 0 |  |  |  |  |  | $head .= $expr; | 
| 2470 | 0 | 0 |  |  |  |  | if ($cond eq 'd') { | 
| 2471 | 0 | 0 |  |  |  |  | if (-d $head) { | 
| 2472 | 0 |  |  |  |  |  | push @glob, $head; | 
| 2473 |  |  |  |  |  |  | } | 
| 2474 |  |  |  |  |  |  | } | 
| 2475 |  |  |  |  |  |  | else { | 
| 2476 | 0 | 0 |  |  |  |  | if (-e $head) { | 
| 2477 | 0 |  |  |  |  |  | push @glob, $head; | 
| 2478 |  |  |  |  |  |  | } | 
| 2479 |  |  |  |  |  |  | } | 
| 2480 | 0 |  |  |  |  |  | next OUTER; | 
| 2481 |  |  |  |  |  |  | } | 
| 2482 | 0 | 0 |  |  |  |  | opendir(*DIR, $head) or next OUTER; | 
| 2483 | 0 |  |  |  |  |  | my @leaf = readdir DIR; | 
| 2484 | 0 |  |  |  |  |  | closedir DIR; | 
| 2485 |  |  |  |  |  |  |  | 
| 2486 | 0 | 0 |  |  |  |  | if ($head eq '.') { | 
| 2487 | 0 |  |  |  |  |  | $head = ''; | 
| 2488 |  |  |  |  |  |  | } | 
| 2489 | 0 | 0 | 0 |  |  |  | if ($head ne '' and ($head =~ / \G ($q_char) /oxmsg)[-1] ne $pathsep) { | 
| 2490 | 0 |  |  |  |  |  | $head .= $pathsep; | 
| 2491 |  |  |  |  |  |  | } | 
| 2492 |  |  |  |  |  |  |  | 
| 2493 | 0 |  |  |  |  |  | my $pattern = ''; | 
| 2494 | 0 |  |  |  |  |  | while ($expr =~ / \G ($q_char) /oxgc) { | 
| 2495 | 0 |  |  |  |  |  | my $char = $1; | 
| 2496 |  |  |  |  |  |  |  | 
| 2497 |  |  |  |  |  |  | # 6.9. Matching Shell Globs as Regular Expressions | 
| 2498 |  |  |  |  |  |  | # in Chapter 6. Pattern Matching | 
| 2499 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 2500 |  |  |  |  |  |  | # (and so on) | 
| 2501 |  |  |  |  |  |  |  | 
| 2502 | 0 | 0 |  |  |  |  | if ($char eq '*') { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 2503 | 0 |  |  |  |  |  | $pattern .= "(?:$your_char)*", | 
| 2504 |  |  |  |  |  |  | } | 
| 2505 |  |  |  |  |  |  | elsif ($char eq '?') { | 
| 2506 | 0 |  |  |  |  |  | $pattern .= "(?:$your_char)?",  # DOS style | 
| 2507 |  |  |  |  |  |  | #               $pattern .= "(?:$your_char)",   # UNIX style | 
| 2508 |  |  |  |  |  |  | } | 
| 2509 |  |  |  |  |  |  | elsif ((my $fc = Elatin6::fc($char)) ne $char) { | 
| 2510 | 0 |  |  |  |  |  | $pattern .= $fc; | 
| 2511 |  |  |  |  |  |  | } | 
| 2512 |  |  |  |  |  |  | else { | 
| 2513 | 0 |  |  |  |  |  | $pattern .= quotemeta $char; | 
| 2514 |  |  |  |  |  |  | } | 
| 2515 |  |  |  |  |  |  | } | 
| 2516 | 0 |  |  | 0 |  |  | my $matchsub = sub { Elatin6::fc($_[0]) =~ /\A $pattern \z/xms }; | 
|  | 0 |  |  |  |  |  |  | 
| 2517 |  |  |  |  |  |  |  | 
| 2518 |  |  |  |  |  |  | #       if ($@) { | 
| 2519 |  |  |  |  |  |  | #           print STDERR "$0: $@\n"; | 
| 2520 |  |  |  |  |  |  | #           next OUTER; | 
| 2521 |  |  |  |  |  |  | #       } | 
| 2522 |  |  |  |  |  |  |  | 
| 2523 |  |  |  |  |  |  | INNER: | 
| 2524 | 0 |  |  |  |  |  | for my $leaf (@leaf) { | 
| 2525 | 0 | 0 | 0 |  |  |  | if ($leaf eq '.' or $leaf eq '..') { | 
| 2526 | 0 |  |  |  |  |  | next INNER; | 
| 2527 |  |  |  |  |  |  | } | 
| 2528 | 0 | 0 | 0 |  |  |  | if ($cond eq 'd' and not -d "$head$leaf") { | 
| 2529 | 0 |  |  |  |  |  | next INNER; | 
| 2530 |  |  |  |  |  |  | } | 
| 2531 |  |  |  |  |  |  |  | 
| 2532 | 0 | 0 |  |  |  |  | if (&$matchsub($leaf)) { | 
| 2533 | 0 |  |  |  |  |  | push @matched, "$head$leaf"; | 
| 2534 | 0 |  |  |  |  |  | next INNER; | 
| 2535 |  |  |  |  |  |  | } | 
| 2536 |  |  |  |  |  |  |  | 
| 2537 |  |  |  |  |  |  | # [DOS compatibility special case] | 
| 2538 |  |  |  |  |  |  | # Failed, add a trailing dot and try again, but only... | 
| 2539 |  |  |  |  |  |  |  | 
| 2540 | 0 | 0 | 0 |  |  |  | if (Elatin6::index($leaf,'.') == -1 and   # if name does not have a dot in it *and* | 
|  |  |  | 0 |  |  |  |  | 
| 2541 |  |  |  |  |  |  | CORE::length($leaf) <= 8 and        # name is shorter than or equal to 8 chars *and* | 
| 2542 |  |  |  |  |  |  | Elatin6::index($pattern,'\\.') != -1  # pattern has a dot. | 
| 2543 |  |  |  |  |  |  | ) { | 
| 2544 | 0 | 0 |  |  |  |  | if (&$matchsub("$leaf.")) { | 
| 2545 | 0 |  |  |  |  |  | push @matched, "$head$leaf"; | 
| 2546 | 0 |  |  |  |  |  | next INNER; | 
| 2547 |  |  |  |  |  |  | } | 
| 2548 |  |  |  |  |  |  | } | 
| 2549 |  |  |  |  |  |  | } | 
| 2550 | 0 | 0 |  |  |  |  | if (@matched) { | 
| 2551 | 0 |  |  |  |  |  | push @glob, @matched; | 
| 2552 |  |  |  |  |  |  | } | 
| 2553 |  |  |  |  |  |  | } | 
| 2554 | 0 | 0 |  |  |  |  | if ($fix_drive_relative_paths) { | 
| 2555 | 0 |  |  |  |  |  | for my $glob (@glob) { | 
| 2556 | 0 |  |  |  |  |  | $glob =~ s# \A ([A-Za-z]:) \./ #$1#oxms; | 
| 2557 |  |  |  |  |  |  | } | 
| 2558 |  |  |  |  |  |  | } | 
| 2559 | 0 |  |  |  |  |  | return @glob; | 
| 2560 |  |  |  |  |  |  | } | 
| 2561 |  |  |  |  |  |  |  | 
| 2562 |  |  |  |  |  |  | # | 
| 2563 |  |  |  |  |  |  | # Latin-6 parse line | 
| 2564 |  |  |  |  |  |  | # | 
| 2565 |  |  |  |  |  |  | sub _parse_line { | 
| 2566 |  |  |  |  |  |  |  | 
| 2567 | 0 |  |  | 0 |  |  | my($line) = @_; | 
| 2568 |  |  |  |  |  |  |  | 
| 2569 | 0 |  |  |  |  |  | $line .= ' '; | 
| 2570 | 0 |  |  |  |  |  | my @piece = (); | 
| 2571 | 0 |  |  |  |  |  | while ($line =~ / | 
| 2572 |  |  |  |  |  |  | " ( (?>(?: [^"]   )* ) ) " (?>\s+) | | 
| 2573 |  |  |  |  |  |  | ( (?>(?: [^"\s] )* ) )   (?>\s+) | 
| 2574 |  |  |  |  |  |  | /oxmsg | 
| 2575 |  |  |  |  |  |  | ) { | 
| 2576 | 0 | 0 |  |  |  |  | push @piece, defined($1) ? $1 : $2; | 
| 2577 |  |  |  |  |  |  | } | 
| 2578 | 0 |  |  |  |  |  | return @piece; | 
| 2579 |  |  |  |  |  |  | } | 
| 2580 |  |  |  |  |  |  |  | 
| 2581 |  |  |  |  |  |  | # | 
| 2582 |  |  |  |  |  |  | # Latin-6 parse path | 
| 2583 |  |  |  |  |  |  | # | 
| 2584 |  |  |  |  |  |  | sub _parse_path { | 
| 2585 |  |  |  |  |  |  |  | 
| 2586 | 0 |  |  | 0 |  |  | my($path,$pathsep) = @_; | 
| 2587 |  |  |  |  |  |  |  | 
| 2588 | 0 |  |  |  |  |  | $path .= '/'; | 
| 2589 | 0 |  |  |  |  |  | my @subpath = (); | 
| 2590 | 0 |  |  |  |  |  | while ($path =~ / | 
| 2591 |  |  |  |  |  |  | ((?: [^\/\\] )+?) [\/\\] | 
| 2592 |  |  |  |  |  |  | /oxmsg | 
| 2593 |  |  |  |  |  |  | ) { | 
| 2594 | 0 |  |  |  |  |  | push @subpath, $1; | 
| 2595 |  |  |  |  |  |  | } | 
| 2596 |  |  |  |  |  |  |  | 
| 2597 | 0 |  |  |  |  |  | my $tail = pop @subpath; | 
| 2598 | 0 |  |  |  |  |  | my $head = join $pathsep, @subpath; | 
| 2599 | 0 |  |  |  |  |  | return $head, $tail; | 
| 2600 |  |  |  |  |  |  | } | 
| 2601 |  |  |  |  |  |  |  | 
| 2602 |  |  |  |  |  |  | # | 
| 2603 |  |  |  |  |  |  | # via File::HomeDir::Windows 1.00 | 
| 2604 |  |  |  |  |  |  | # | 
| 2605 |  |  |  |  |  |  | sub my_home_MSWin32 { | 
| 2606 |  |  |  |  |  |  |  | 
| 2607 |  |  |  |  |  |  | # A lot of unix people and unix-derived tools rely on | 
| 2608 |  |  |  |  |  |  | # the ability to overload HOME. We will support it too | 
| 2609 |  |  |  |  |  |  | # so that they can replace raw HOME calls with File::HomeDir. | 
| 2610 | 0 | 0 | 0 | 0 | 0 |  | if (exists $ENV{'HOME'} and $ENV{'HOME'}) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 2611 | 0 |  |  |  |  |  | return $ENV{'HOME'}; | 
| 2612 |  |  |  |  |  |  | } | 
| 2613 |  |  |  |  |  |  |  | 
| 2614 |  |  |  |  |  |  | # Do we have a user profile? | 
| 2615 |  |  |  |  |  |  | elsif (exists $ENV{'USERPROFILE'} and $ENV{'USERPROFILE'}) { | 
| 2616 | 0 |  |  |  |  |  | return $ENV{'USERPROFILE'}; | 
| 2617 |  |  |  |  |  |  | } | 
| 2618 |  |  |  |  |  |  |  | 
| 2619 |  |  |  |  |  |  | # Some Windows use something like $ENV{'HOME'} | 
| 2620 |  |  |  |  |  |  | elsif (exists $ENV{'HOMEDRIVE'} and exists $ENV{'HOMEPATH'} and $ENV{'HOMEDRIVE'} and $ENV{'HOMEPATH'}) { | 
| 2621 | 0 |  |  |  |  |  | return join '', $ENV{'HOMEDRIVE'}, $ENV{'HOMEPATH'}; | 
| 2622 |  |  |  |  |  |  | } | 
| 2623 |  |  |  |  |  |  |  | 
| 2624 | 0 |  |  |  |  |  | return undef; | 
| 2625 |  |  |  |  |  |  | } | 
| 2626 |  |  |  |  |  |  |  | 
| 2627 |  |  |  |  |  |  | # | 
| 2628 |  |  |  |  |  |  | # via File::HomeDir::Unix 1.00 | 
| 2629 |  |  |  |  |  |  | # | 
| 2630 |  |  |  |  |  |  | sub my_home { | 
| 2631 | 0 |  |  | 0 | 0 |  | my $home; | 
| 2632 |  |  |  |  |  |  |  | 
| 2633 | 0 | 0 | 0 |  |  |  | if (exists $ENV{'HOME'} and defined $ENV{'HOME'}) { | 
|  |  | 0 | 0 |  |  |  |  | 
| 2634 | 0 |  |  |  |  |  | $home = $ENV{'HOME'}; | 
| 2635 |  |  |  |  |  |  | } | 
| 2636 |  |  |  |  |  |  |  | 
| 2637 |  |  |  |  |  |  | # This is from the original code, but I'm guessing | 
| 2638 |  |  |  |  |  |  | # it means "login directory" and exists on some Unixes. | 
| 2639 |  |  |  |  |  |  | elsif (exists $ENV{'LOGDIR'} and $ENV{'LOGDIR'}) { | 
| 2640 | 0 |  |  |  |  |  | $home = $ENV{'LOGDIR'}; | 
| 2641 |  |  |  |  |  |  | } | 
| 2642 |  |  |  |  |  |  |  | 
| 2643 |  |  |  |  |  |  | ### More-desperate methods | 
| 2644 |  |  |  |  |  |  |  | 
| 2645 |  |  |  |  |  |  | # Light desperation on any (Unixish) platform | 
| 2646 |  |  |  |  |  |  | else { | 
| 2647 | 0 |  |  |  |  |  | $home = CORE::eval q{ (getpwuid($<))[7] }; | 
| 2648 |  |  |  |  |  |  | } | 
| 2649 |  |  |  |  |  |  |  | 
| 2650 |  |  |  |  |  |  | # On Unix in general, a non-existant home means "no home" | 
| 2651 |  |  |  |  |  |  | # For example, "nobody"-like users might use /nonexistant | 
| 2652 | 0 | 0 | 0 |  |  |  | if (defined $home and ! -d($home)) { | 
| 2653 | 0 |  |  |  |  |  | $home = undef; | 
| 2654 |  |  |  |  |  |  | } | 
| 2655 | 0 |  |  |  |  |  | return $home; | 
| 2656 |  |  |  |  |  |  | } | 
| 2657 |  |  |  |  |  |  |  | 
| 2658 |  |  |  |  |  |  | # | 
| 2659 |  |  |  |  |  |  | # ${^PREMATCH}, $PREMATCH, $` the string preceding what was matched | 
| 2660 |  |  |  |  |  |  | # | 
| 2661 |  |  |  |  |  |  | sub Elatin6::PREMATCH { | 
| 2662 | 0 |  |  | 0 | 0 |  | return $`; | 
| 2663 |  |  |  |  |  |  | } | 
| 2664 |  |  |  |  |  |  |  | 
| 2665 |  |  |  |  |  |  | # | 
| 2666 |  |  |  |  |  |  | # ${^MATCH}, $MATCH, $& the string that matched | 
| 2667 |  |  |  |  |  |  | # | 
| 2668 |  |  |  |  |  |  | sub Elatin6::MATCH { | 
| 2669 | 0 |  |  | 0 | 0 |  | return $&; | 
| 2670 |  |  |  |  |  |  | } | 
| 2671 |  |  |  |  |  |  |  | 
| 2672 |  |  |  |  |  |  | # | 
| 2673 |  |  |  |  |  |  | # ${^POSTMATCH}, $POSTMATCH, $' the string following what was matched | 
| 2674 |  |  |  |  |  |  | # | 
| 2675 |  |  |  |  |  |  | sub Elatin6::POSTMATCH { | 
| 2676 | 0 |  |  | 0 | 0 |  | return $'; | 
| 2677 |  |  |  |  |  |  | } | 
| 2678 |  |  |  |  |  |  |  | 
| 2679 |  |  |  |  |  |  | # | 
| 2680 |  |  |  |  |  |  | # Latin-6 character to order (with parameter) | 
| 2681 |  |  |  |  |  |  | # | 
| 2682 |  |  |  |  |  |  | sub Latin6::ord(;$) { | 
| 2683 |  |  |  |  |  |  |  | 
| 2684 | 0 | 0 |  | 0 | 1 |  | local $_ = shift if @_; | 
| 2685 |  |  |  |  |  |  |  | 
| 2686 | 0 | 0 |  |  |  |  | if (/\A ($q_char) /oxms) { | 
| 2687 | 0 |  |  |  |  |  | my @ord = unpack 'C*', $1; | 
| 2688 | 0 |  |  |  |  |  | my $ord = 0; | 
| 2689 | 0 |  |  |  |  |  | while (my $o = shift @ord) { | 
| 2690 | 0 |  |  |  |  |  | $ord = $ord * 0x100 + $o; | 
| 2691 |  |  |  |  |  |  | } | 
| 2692 | 0 |  |  |  |  |  | return $ord; | 
| 2693 |  |  |  |  |  |  | } | 
| 2694 |  |  |  |  |  |  | else { | 
| 2695 | 0 |  |  |  |  |  | return CORE::ord $_; | 
| 2696 |  |  |  |  |  |  | } | 
| 2697 |  |  |  |  |  |  | } | 
| 2698 |  |  |  |  |  |  |  | 
| 2699 |  |  |  |  |  |  | # | 
| 2700 |  |  |  |  |  |  | # Latin-6 character to order (without parameter) | 
| 2701 |  |  |  |  |  |  | # | 
| 2702 |  |  |  |  |  |  | sub Latin6::ord_() { | 
| 2703 |  |  |  |  |  |  |  | 
| 2704 | 0 | 0 |  | 0 | 0 |  | if (/\A ($q_char) /oxms) { | 
| 2705 | 0 |  |  |  |  |  | my @ord = unpack 'C*', $1; | 
| 2706 | 0 |  |  |  |  |  | my $ord = 0; | 
| 2707 | 0 |  |  |  |  |  | while (my $o = shift @ord) { | 
| 2708 | 0 |  |  |  |  |  | $ord = $ord * 0x100 + $o; | 
| 2709 |  |  |  |  |  |  | } | 
| 2710 | 0 |  |  |  |  |  | return $ord; | 
| 2711 |  |  |  |  |  |  | } | 
| 2712 |  |  |  |  |  |  | else { | 
| 2713 | 0 |  |  |  |  |  | return CORE::ord $_; | 
| 2714 |  |  |  |  |  |  | } | 
| 2715 |  |  |  |  |  |  | } | 
| 2716 |  |  |  |  |  |  |  | 
| 2717 |  |  |  |  |  |  | # | 
| 2718 |  |  |  |  |  |  | # Latin-6 reverse | 
| 2719 |  |  |  |  |  |  | # | 
| 2720 |  |  |  |  |  |  | sub Latin6::reverse(@) { | 
| 2721 |  |  |  |  |  |  |  | 
| 2722 | 0 | 0 |  | 0 | 0 |  | if (wantarray) { | 
| 2723 | 0 |  |  |  |  |  | return CORE::reverse @_; | 
| 2724 |  |  |  |  |  |  | } | 
| 2725 |  |  |  |  |  |  | else { | 
| 2726 |  |  |  |  |  |  |  | 
| 2727 |  |  |  |  |  |  | # One of us once cornered Larry in an elevator and asked him what | 
| 2728 |  |  |  |  |  |  | # problem he was solving with this, but he looked as far off into | 
| 2729 |  |  |  |  |  |  | # the distance as he could in an elevator and said, "It seemed like | 
| 2730 |  |  |  |  |  |  | # a good idea at the time." | 
| 2731 |  |  |  |  |  |  |  | 
| 2732 | 0 |  |  |  |  |  | return join '', CORE::reverse(join('',@_) =~ /\G ($q_char) /oxmsg); | 
| 2733 |  |  |  |  |  |  | } | 
| 2734 |  |  |  |  |  |  | } | 
| 2735 |  |  |  |  |  |  |  | 
| 2736 |  |  |  |  |  |  | # | 
| 2737 |  |  |  |  |  |  | # Latin-6 getc (with parameter, without parameter) | 
| 2738 |  |  |  |  |  |  | # | 
| 2739 |  |  |  |  |  |  | sub Latin6::getc(;*@) { | 
| 2740 |  |  |  |  |  |  |  | 
| 2741 | 0 |  |  | 0 | 0 |  | my($package) = caller; | 
| 2742 | 0 | 0 |  |  |  |  | my $fh = @_ ? qualify_to_ref(shift,$package) : \*STDIN; | 
| 2743 | 0 | 0 | 0 |  |  |  | croak 'Too many arguments for Latin6::getc' if @_ and not wantarray; | 
| 2744 |  |  |  |  |  |  |  | 
| 2745 | 0 |  |  |  |  |  | my @length = sort { $a <=> $b } keys %range_tr; | 
|  | 0 |  |  |  |  |  |  | 
| 2746 | 0 |  |  |  |  |  | my $getc = ''; | 
| 2747 | 0 |  |  |  |  |  | for my $length ($length[0] .. $length[-1]) { | 
| 2748 | 0 |  |  |  |  |  | $getc .= CORE::getc($fh); | 
| 2749 | 0 | 0 |  |  |  |  | if (exists $range_tr{CORE::length($getc)}) { | 
| 2750 | 0 | 0 |  |  |  |  | if ($getc =~ /\A ${Elatin6::dot_s} \z/oxms) { | 
| 2751 | 0 | 0 |  |  |  |  | return wantarray ? ($getc,@_) : $getc; | 
| 2752 |  |  |  |  |  |  | } | 
| 2753 |  |  |  |  |  |  | } | 
| 2754 |  |  |  |  |  |  | } | 
| 2755 | 0 | 0 |  |  |  |  | return wantarray ? ($getc,@_) : $getc; | 
| 2756 |  |  |  |  |  |  | } | 
| 2757 |  |  |  |  |  |  |  | 
| 2758 |  |  |  |  |  |  | # | 
| 2759 |  |  |  |  |  |  | # Latin-6 length by character | 
| 2760 |  |  |  |  |  |  | # | 
| 2761 |  |  |  |  |  |  | sub Latin6::length(;$) { | 
| 2762 |  |  |  |  |  |  |  | 
| 2763 | 0 | 0 |  | 0 | 1 |  | local $_ = shift if @_; | 
| 2764 |  |  |  |  |  |  |  | 
| 2765 | 0 |  |  |  |  |  | local @_ = /\G ($q_char) /oxmsg; | 
| 2766 | 0 |  |  |  |  |  | return scalar @_; | 
| 2767 |  |  |  |  |  |  | } | 
| 2768 |  |  |  |  |  |  |  | 
| 2769 |  |  |  |  |  |  | # | 
| 2770 |  |  |  |  |  |  | # Latin-6 substr by character | 
| 2771 |  |  |  |  |  |  | # | 
| 2772 |  |  |  |  |  |  | BEGIN { | 
| 2773 |  |  |  |  |  |  |  | 
| 2774 |  |  |  |  |  |  | # P.232 The lvalue Attribute | 
| 2775 |  |  |  |  |  |  | # in Chapter 6: Subroutines | 
| 2776 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 2777 |  |  |  |  |  |  |  | 
| 2778 |  |  |  |  |  |  | # P.336 The lvalue Attribute | 
| 2779 |  |  |  |  |  |  | # in Chapter 7: Subroutines | 
| 2780 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 2781 |  |  |  |  |  |  |  | 
| 2782 |  |  |  |  |  |  | # P.144 8.4 Lvalue subroutines | 
| 2783 |  |  |  |  |  |  | # in Chapter 8: perlsub: Perl subroutines | 
| 2784 |  |  |  |  |  |  | # of ISBN-13: 978-1-906966-02-7 The Perl Language Reference Manual (for Perl version 5.12.1) | 
| 2785 |  |  |  |  |  |  |  | 
| 2786 | 200 | 50 | 0 | 200 | 1 | 149619 | CORE::eval sprintf(<<'END', ($] >= 5.014000) ? ':lvalue' : ''); | 
|  | 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 |  |  |  |  |  |  | 
| 2787 |  |  |  |  |  |  | #                       vv----------------------******* | 
| 2788 |  |  |  |  |  |  | sub Latin6::substr($$;$$) %s { | 
| 2789 |  |  |  |  |  |  |  | 
| 2790 |  |  |  |  |  |  | my @char = $_[0] =~ /\G (?>$q_char) /oxmsg; | 
| 2791 |  |  |  |  |  |  |  | 
| 2792 |  |  |  |  |  |  | # If the substring is beyond either end of the string, substr() returns the undefined | 
| 2793 |  |  |  |  |  |  | # value and produces a warning. When used as an lvalue, specifying a substring that | 
| 2794 |  |  |  |  |  |  | # is entirely outside the string raises an exception. | 
| 2795 |  |  |  |  |  |  | # http://perldoc.perl.org/functions/substr.html | 
| 2796 |  |  |  |  |  |  |  | 
| 2797 |  |  |  |  |  |  | # A return with no argument returns the scalar value undef in scalar context, | 
| 2798 |  |  |  |  |  |  | # an empty list () in list context, and (naturally) nothing at all in void | 
| 2799 |  |  |  |  |  |  | # context. | 
| 2800 |  |  |  |  |  |  |  | 
| 2801 |  |  |  |  |  |  | my $offset = $_[1]; | 
| 2802 |  |  |  |  |  |  | if (($offset > scalar(@char)) or ($offset < (-1 * scalar(@char)))) { | 
| 2803 |  |  |  |  |  |  | return; | 
| 2804 |  |  |  |  |  |  | } | 
| 2805 |  |  |  |  |  |  |  | 
| 2806 |  |  |  |  |  |  | # substr($string,$offset,$length,$replacement) | 
| 2807 |  |  |  |  |  |  | if (@_ == 4) { | 
| 2808 |  |  |  |  |  |  | my(undef,undef,$length,$replacement) = @_; | 
| 2809 |  |  |  |  |  |  | my $substr = join '', splice(@char, $offset, $length, $replacement); | 
| 2810 |  |  |  |  |  |  | $_[0] = join '', @char; | 
| 2811 |  |  |  |  |  |  |  | 
| 2812 |  |  |  |  |  |  | # return $substr; this doesn't work, don't say "return" | 
| 2813 |  |  |  |  |  |  | $substr; | 
| 2814 |  |  |  |  |  |  | } | 
| 2815 |  |  |  |  |  |  |  | 
| 2816 |  |  |  |  |  |  | # substr($string,$offset,$length) | 
| 2817 |  |  |  |  |  |  | elsif (@_ == 3) { | 
| 2818 |  |  |  |  |  |  | my(undef,undef,$length) = @_; | 
| 2819 |  |  |  |  |  |  | my $octet_offset = 0; | 
| 2820 |  |  |  |  |  |  | my $octet_length = 0; | 
| 2821 |  |  |  |  |  |  | if ($offset == 0) { | 
| 2822 |  |  |  |  |  |  | $octet_offset = 0; | 
| 2823 |  |  |  |  |  |  | } | 
| 2824 |  |  |  |  |  |  | elsif ($offset > 0) { | 
| 2825 |  |  |  |  |  |  | $octet_offset =      CORE::length(join '', @char[0..$offset-1]); | 
| 2826 |  |  |  |  |  |  | } | 
| 2827 |  |  |  |  |  |  | else { | 
| 2828 |  |  |  |  |  |  | $octet_offset = -1 * CORE::length(join '', @char[$#char+$offset+1..$#char]); | 
| 2829 |  |  |  |  |  |  | } | 
| 2830 |  |  |  |  |  |  | if ($length == 0) { | 
| 2831 |  |  |  |  |  |  | $octet_length = 0; | 
| 2832 |  |  |  |  |  |  | } | 
| 2833 |  |  |  |  |  |  | elsif ($length > 0) { | 
| 2834 |  |  |  |  |  |  | $octet_length =      CORE::length(join '', @char[$offset..$offset+$length-1]); | 
| 2835 |  |  |  |  |  |  | } | 
| 2836 |  |  |  |  |  |  | else { | 
| 2837 |  |  |  |  |  |  | $octet_length = -1 * CORE::length(join '', @char[$#char+$length+1..$#char]); | 
| 2838 |  |  |  |  |  |  | } | 
| 2839 |  |  |  |  |  |  | CORE::substr($_[0], $octet_offset, $octet_length); | 
| 2840 |  |  |  |  |  |  | } | 
| 2841 |  |  |  |  |  |  |  | 
| 2842 |  |  |  |  |  |  | # substr($string,$offset) | 
| 2843 |  |  |  |  |  |  | else { | 
| 2844 |  |  |  |  |  |  | my $octet_offset = 0; | 
| 2845 |  |  |  |  |  |  | if ($offset == 0) { | 
| 2846 |  |  |  |  |  |  | $octet_offset = 0; | 
| 2847 |  |  |  |  |  |  | } | 
| 2848 |  |  |  |  |  |  | elsif ($offset > 0) { | 
| 2849 |  |  |  |  |  |  | $octet_offset =      CORE::length(join '', @char[0..$offset-1]); | 
| 2850 |  |  |  |  |  |  | } | 
| 2851 |  |  |  |  |  |  | else { | 
| 2852 |  |  |  |  |  |  | $octet_offset = -1 * CORE::length(join '', @char[$#char+$offset+1..$#char]); | 
| 2853 |  |  |  |  |  |  | } | 
| 2854 |  |  |  |  |  |  | CORE::substr($_[0], $octet_offset); | 
| 2855 |  |  |  |  |  |  | } | 
| 2856 |  |  |  |  |  |  | } | 
| 2857 |  |  |  |  |  |  | END | 
| 2858 |  |  |  |  |  |  | } | 
| 2859 |  |  |  |  |  |  |  | 
| 2860 |  |  |  |  |  |  | # | 
| 2861 |  |  |  |  |  |  | # Latin-6 index by character | 
| 2862 |  |  |  |  |  |  | # | 
| 2863 |  |  |  |  |  |  | sub Latin6::index($$;$) { | 
| 2864 |  |  |  |  |  |  |  | 
| 2865 | 0 |  |  | 0 | 1 |  | my $index; | 
| 2866 | 0 | 0 |  |  |  |  | if (@_ == 3) { | 
| 2867 | 0 |  |  |  |  |  | $index = Elatin6::index($_[0], $_[1], CORE::length(Latin6::substr($_[0], 0, $_[2]))); | 
| 2868 |  |  |  |  |  |  | } | 
| 2869 |  |  |  |  |  |  | else { | 
| 2870 | 0 |  |  |  |  |  | $index = Elatin6::index($_[0], $_[1]); | 
| 2871 |  |  |  |  |  |  | } | 
| 2872 |  |  |  |  |  |  |  | 
| 2873 | 0 | 0 |  |  |  |  | if ($index == -1) { | 
| 2874 | 0 |  |  |  |  |  | return -1; | 
| 2875 |  |  |  |  |  |  | } | 
| 2876 |  |  |  |  |  |  | else { | 
| 2877 | 0 |  |  |  |  |  | return Latin6::length(CORE::substr $_[0], 0, $index); | 
| 2878 |  |  |  |  |  |  | } | 
| 2879 |  |  |  |  |  |  | } | 
| 2880 |  |  |  |  |  |  |  | 
| 2881 |  |  |  |  |  |  | # | 
| 2882 |  |  |  |  |  |  | # Latin-6 rindex by character | 
| 2883 |  |  |  |  |  |  | # | 
| 2884 |  |  |  |  |  |  | sub Latin6::rindex($$;$) { | 
| 2885 |  |  |  |  |  |  |  | 
| 2886 | 0 |  |  | 0 | 1 |  | my $rindex; | 
| 2887 | 0 | 0 |  |  |  |  | if (@_ == 3) { | 
| 2888 | 0 |  |  |  |  |  | $rindex = Elatin6::rindex($_[0], $_[1], CORE::length(Latin6::substr($_[0], 0, $_[2]))); | 
| 2889 |  |  |  |  |  |  | } | 
| 2890 |  |  |  |  |  |  | else { | 
| 2891 | 0 |  |  |  |  |  | $rindex = Elatin6::rindex($_[0], $_[1]); | 
| 2892 |  |  |  |  |  |  | } | 
| 2893 |  |  |  |  |  |  |  | 
| 2894 | 0 | 0 |  |  |  |  | if ($rindex == -1) { | 
| 2895 | 0 |  |  |  |  |  | return -1; | 
| 2896 |  |  |  |  |  |  | } | 
| 2897 |  |  |  |  |  |  | else { | 
| 2898 | 0 |  |  |  |  |  | return Latin6::length(CORE::substr $_[0], 0, $rindex); | 
| 2899 |  |  |  |  |  |  | } | 
| 2900 |  |  |  |  |  |  | } | 
| 2901 |  |  |  |  |  |  |  | 
| 2902 |  |  |  |  |  |  | # when 'm//', '/' means regexp match 'm//' and '?' means regexp match '??' | 
| 2903 |  |  |  |  |  |  | # when 'div', '/' means division operator and '?' means conditional operator (condition ? then : else) | 
| 2904 | 200 |  |  | 200 |  | 18890 | BEGIN { CORE::eval q{ use vars qw($slash) } } $slash = 'm//'; | 
|  | 200 |  |  | 200 |  | 2164 |  | 
|  | 200 |  |  |  |  | 475 |  | 
|  | 200 |  |  |  |  | 16223 |  | 
| 2905 |  |  |  |  |  |  |  | 
| 2906 |  |  |  |  |  |  | # ord() to ord() or Latin6::ord() | 
| 2907 | 200 |  |  | 200 |  | 13655 | BEGIN { CORE::eval q{ use vars qw($function_ord) } }     $function_ord     = 'ord'; | 
|  | 200 |  |  | 200 |  | 1209 |  | 
|  | 200 |  |  |  |  | 417 |  | 
|  | 200 |  |  |  |  | 12337 |  | 
| 2908 |  |  |  |  |  |  |  | 
| 2909 |  |  |  |  |  |  | # ord to ord or Latin6::ord_ | 
| 2910 | 200 |  |  | 200 |  | 14710 | BEGIN { CORE::eval q{ use vars qw($function_ord_) } }    $function_ord_    = 'ord'; | 
|  | 200 |  |  | 200 |  | 1172 |  | 
|  | 200 |  |  |  |  | 368 |  | 
|  | 200 |  |  |  |  | 12582 |  | 
| 2911 |  |  |  |  |  |  |  | 
| 2912 |  |  |  |  |  |  | # reverse to reverse or Latin6::reverse | 
| 2913 | 200 |  |  | 200 |  | 13969 | BEGIN { CORE::eval q{ use vars qw($function_reverse) } } $function_reverse = 'reverse'; | 
|  | 200 |  |  | 200 |  | 1259 |  | 
|  | 200 |  |  |  |  | 419 |  | 
|  | 200 |  |  |  |  | 13512 |  | 
| 2914 |  |  |  |  |  |  |  | 
| 2915 |  |  |  |  |  |  | # getc to getc or Latin6::getc | 
| 2916 | 200 |  |  | 200 |  | 14760 | BEGIN { CORE::eval q{ use vars qw($function_getc) } }    $function_getc    = 'getc'; | 
|  | 200 |  |  | 200 |  | 1190 |  | 
|  | 200 |  |  |  |  | 438 |  | 
|  | 200 |  |  |  |  | 16386 |  | 
| 2917 |  |  |  |  |  |  |  | 
| 2918 |  |  |  |  |  |  | # P.1023 Appendix W.9 Multibyte Anchoring | 
| 2919 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 2920 |  |  |  |  |  |  |  | 
| 2921 |  |  |  |  |  |  | my $anchor = ''; | 
| 2922 |  |  |  |  |  |  |  | 
| 2923 | 200 |  |  | 200 |  | 13867 | BEGIN { CORE::eval q{ use vars qw($nest) } } | 
|  | 200 |  |  | 200 |  | 1121 |  | 
|  | 200 |  |  |  |  | 361 |  | 
|  | 200 |  |  |  |  | 12265616 |  | 
| 2924 |  |  |  |  |  |  |  | 
| 2925 |  |  |  |  |  |  | # regexp of nested parens in qqXX | 
| 2926 |  |  |  |  |  |  |  | 
| 2927 |  |  |  |  |  |  | # P.340 Matching Nested Constructs with Embedded Code | 
| 2928 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 2929 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 2930 |  |  |  |  |  |  |  | 
| 2931 |  |  |  |  |  |  | my $qq_paren   = qr{(?{local $nest=0}) (?>(?: | 
| 2932 |  |  |  |  |  |  | [^\\()] | | 
| 2933 |  |  |  |  |  |  | \(  (?{$nest++}) | | 
| 2934 |  |  |  |  |  |  | \)  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 2935 |  |  |  |  |  |  | \\ [^c] | | 
| 2936 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 2937 |  |  |  |  |  |  | [\x00-\xFF] | 
| 2938 |  |  |  |  |  |  | }xms; | 
| 2939 |  |  |  |  |  |  |  | 
| 2940 |  |  |  |  |  |  | my $qq_brace   = qr{(?{local $nest=0}) (?>(?: | 
| 2941 |  |  |  |  |  |  | [^\\{}] | | 
| 2942 |  |  |  |  |  |  | \{  (?{$nest++}) | | 
| 2943 |  |  |  |  |  |  | \}  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 2944 |  |  |  |  |  |  | \\ [^c] | | 
| 2945 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 2946 |  |  |  |  |  |  | [\x00-\xFF] | 
| 2947 |  |  |  |  |  |  | }xms; | 
| 2948 |  |  |  |  |  |  |  | 
| 2949 |  |  |  |  |  |  | my $qq_bracket = qr{(?{local $nest=0}) (?>(?: | 
| 2950 |  |  |  |  |  |  | [^\\\[\]] | | 
| 2951 |  |  |  |  |  |  | \[  (?{$nest++}) | | 
| 2952 |  |  |  |  |  |  | \]  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 2953 |  |  |  |  |  |  | \\ [^c] | | 
| 2954 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 2955 |  |  |  |  |  |  | [\x00-\xFF] | 
| 2956 |  |  |  |  |  |  | }xms; | 
| 2957 |  |  |  |  |  |  |  | 
| 2958 |  |  |  |  |  |  | my $qq_angle   = qr{(?{local $nest=0}) (?>(?: | 
| 2959 |  |  |  |  |  |  | [^\\<>] | | 
| 2960 |  |  |  |  |  |  | \<  (?{$nest++}) | | 
| 2961 |  |  |  |  |  |  | \>  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 2962 |  |  |  |  |  |  | \\ [^c] | | 
| 2963 |  |  |  |  |  |  | \\c[\x40-\x5F] | | 
| 2964 |  |  |  |  |  |  | [\x00-\xFF] | 
| 2965 |  |  |  |  |  |  | }xms; | 
| 2966 |  |  |  |  |  |  |  | 
| 2967 |  |  |  |  |  |  | my $qq_scalar  = qr{(?: \{ (?:$qq_brace)*? \} | | 
| 2968 |  |  |  |  |  |  | (?: ::)? (?: | 
| 2969 |  |  |  |  |  |  | (?> [a-zA-Z_][a-zA-Z_0-9]* (?: ::[a-zA-Z_][a-zA-Z_0-9]*)* ) | 
| 2970 |  |  |  |  |  |  | (?>(?:                                   \[ (?: \$\[ | \$\] | $qq_char )*? \] |           \{ (?:$qq_brace)*? \} )*) | 
| 2971 |  |  |  |  |  |  | (?>(?: (?: -> )? (?: [\$\@\%\&\*]\* | \$\#\* | [\@\%]? \[ (?: \$\[ | \$\] | $qq_char )*? \] | [\@\%\*]? \{ (?:$qq_brace)*? \} ) )*) | 
| 2972 |  |  |  |  |  |  | )) | 
| 2973 |  |  |  |  |  |  | }xms; | 
| 2974 |  |  |  |  |  |  |  | 
| 2975 |  |  |  |  |  |  | my $qq_variable = qr{(?: \{ (?:$qq_brace)*? \}                    | | 
| 2976 |  |  |  |  |  |  | (?: ::)? (?: | 
| 2977 |  |  |  |  |  |  | (?>[0-9]+)                          | | 
| 2978 |  |  |  |  |  |  | [^a-zA-Z_0-9\[\]] | | 
| 2979 |  |  |  |  |  |  | ^[A-Z]                              | | 
| 2980 |  |  |  |  |  |  | (?> [a-zA-Z_][a-zA-Z_0-9]* (?: ::[a-zA-Z_][a-zA-Z_0-9]*)* ) | 
| 2981 |  |  |  |  |  |  | (?>(?:                                   \[ (?: \$\[ | \$\] | $qq_char )*? \] |           \{ (?:$qq_brace)*? \} )*) | 
| 2982 |  |  |  |  |  |  | (?>(?: (?: -> )? (?: [\$\@\%\&\*]\* | \$\#\* | [\@\%]? \[ (?: \$\[ | \$\] | $qq_char )*? \] | [\@\%\*]? \{ (?:$qq_brace)*? \} ) )*) | 
| 2983 |  |  |  |  |  |  | )) | 
| 2984 |  |  |  |  |  |  | }xms; | 
| 2985 |  |  |  |  |  |  |  | 
| 2986 |  |  |  |  |  |  | my $qq_substr  = qr{(?> Char::substr | Latin6::substr | CORE::substr | substr ) (?>\s*) \( $qq_paren \) | 
| 2987 |  |  |  |  |  |  | }xms; | 
| 2988 |  |  |  |  |  |  |  | 
| 2989 |  |  |  |  |  |  | # regexp of nested parens in qXX | 
| 2990 |  |  |  |  |  |  | my $q_paren    = qr{(?{local $nest=0}) (?>(?: | 
| 2991 |  |  |  |  |  |  | [^()] | | 
| 2992 |  |  |  |  |  |  | \(  (?{$nest++}) | | 
| 2993 |  |  |  |  |  |  | \)  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 2994 |  |  |  |  |  |  | [\x00-\xFF] | 
| 2995 |  |  |  |  |  |  | }xms; | 
| 2996 |  |  |  |  |  |  |  | 
| 2997 |  |  |  |  |  |  | my $q_brace    = qr{(?{local $nest=0}) (?>(?: | 
| 2998 |  |  |  |  |  |  | [^\{\}] | | 
| 2999 |  |  |  |  |  |  | \{  (?{$nest++}) | | 
| 3000 |  |  |  |  |  |  | \}  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 3001 |  |  |  |  |  |  | [\x00-\xFF] | 
| 3002 |  |  |  |  |  |  | }xms; | 
| 3003 |  |  |  |  |  |  |  | 
| 3004 |  |  |  |  |  |  | my $q_bracket  = qr{(?{local $nest=0}) (?>(?: | 
| 3005 |  |  |  |  |  |  | [^\[\]] | | 
| 3006 |  |  |  |  |  |  | \[  (?{$nest++}) | | 
| 3007 |  |  |  |  |  |  | \]  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 3008 |  |  |  |  |  |  | [\x00-\xFF] | 
| 3009 |  |  |  |  |  |  | }xms; | 
| 3010 |  |  |  |  |  |  |  | 
| 3011 |  |  |  |  |  |  | my $q_angle    = qr{(?{local $nest=0}) (?>(?: | 
| 3012 |  |  |  |  |  |  | [^<>] | | 
| 3013 |  |  |  |  |  |  | \<  (?{$nest++}) | | 
| 3014 |  |  |  |  |  |  | \>  (?(?{$nest>0})(?{$nest--})|(?!)))*) (?(?{$nest!=0})(?!)) | | 
| 3015 |  |  |  |  |  |  | [\x00-\xFF] | 
| 3016 |  |  |  |  |  |  | }xms; | 
| 3017 |  |  |  |  |  |  |  | 
| 3018 |  |  |  |  |  |  | my $matched     = ''; | 
| 3019 |  |  |  |  |  |  | my $s_matched   = ''; | 
| 3020 |  |  |  |  |  |  |  | 
| 3021 |  |  |  |  |  |  | my $tr_variable   = '';   # variable of tr/// | 
| 3022 |  |  |  |  |  |  | my $sub_variable  = '';   # variable of s/// | 
| 3023 |  |  |  |  |  |  | my $bind_operator = '';   # =~ or !~ | 
| 3024 |  |  |  |  |  |  |  | 
| 3025 |  |  |  |  |  |  | my @heredoc = ();         # here document | 
| 3026 |  |  |  |  |  |  | my @heredoc_delimiter = (); | 
| 3027 |  |  |  |  |  |  | my $here_script = '';     # here script | 
| 3028 |  |  |  |  |  |  |  | 
| 3029 |  |  |  |  |  |  | # | 
| 3030 |  |  |  |  |  |  | # escape Latin-6 script | 
| 3031 |  |  |  |  |  |  | # | 
| 3032 |  |  |  |  |  |  | sub Latin6::escape(;$) { | 
| 3033 | 0 | 0 |  | 0 | 0 |  | local($_) = $_[0] if @_; | 
| 3034 |  |  |  |  |  |  |  | 
| 3035 |  |  |  |  |  |  | # P.359 The Study Function | 
| 3036 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 3037 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 3038 |  |  |  |  |  |  |  | 
| 3039 | 0 |  |  |  |  |  | study $_; # Yes, I studied study yesterday. | 
| 3040 |  |  |  |  |  |  |  | 
| 3041 |  |  |  |  |  |  | # while all script | 
| 3042 |  |  |  |  |  |  |  | 
| 3043 |  |  |  |  |  |  | # 6.14. Matching from Where the Last Pattern Left Off | 
| 3044 |  |  |  |  |  |  | # in Chapter 6. Pattern Matching | 
| 3045 |  |  |  |  |  |  | # of ISBN 0-596-00313-7 Perl Cookbook, 2nd Edition. | 
| 3046 |  |  |  |  |  |  | # (and so on) | 
| 3047 |  |  |  |  |  |  |  | 
| 3048 |  |  |  |  |  |  | # one member of Tag-team | 
| 3049 |  |  |  |  |  |  | # | 
| 3050 |  |  |  |  |  |  | # P.128 Start of match (or end of previous match): \G | 
| 3051 |  |  |  |  |  |  | # P.130 Advanced Use of \G with Perl | 
| 3052 |  |  |  |  |  |  | # in Chapter 3: Overview of Regular Expression Features and Flavors | 
| 3053 |  |  |  |  |  |  | # P.255 Use leading anchors | 
| 3054 |  |  |  |  |  |  | # P.256 Expose ^ and \G at the front expressions | 
| 3055 |  |  |  |  |  |  | # in Chapter 6: Crafting an Efficient Expression | 
| 3056 |  |  |  |  |  |  | # P.315 "Tag-team" matching with /gc | 
| 3057 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 3058 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 3059 |  |  |  |  |  |  |  | 
| 3060 | 0 |  |  |  |  |  | my $e_script = ''; | 
| 3061 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { # member | 
| 3062 | 0 |  |  |  |  |  | $e_script .= Latin6::escape_token(); | 
| 3063 |  |  |  |  |  |  | } | 
| 3064 |  |  |  |  |  |  |  | 
| 3065 | 0 |  |  |  |  |  | return $e_script; | 
| 3066 |  |  |  |  |  |  | } | 
| 3067 |  |  |  |  |  |  |  | 
| 3068 |  |  |  |  |  |  | # | 
| 3069 |  |  |  |  |  |  | # escape Latin-6 token of script | 
| 3070 |  |  |  |  |  |  | # | 
| 3071 |  |  |  |  |  |  | sub Latin6::escape_token { | 
| 3072 |  |  |  |  |  |  |  | 
| 3073 |  |  |  |  |  |  | # \n output here document | 
| 3074 |  |  |  |  |  |  |  | 
| 3075 | 0 |  |  | 0 | 0 |  | my $ignore_modules = join('|', qw( | 
| 3076 |  |  |  |  |  |  | utf8 | 
| 3077 |  |  |  |  |  |  | bytes | 
| 3078 |  |  |  |  |  |  | charnames | 
| 3079 |  |  |  |  |  |  | I18N::Japanese | 
| 3080 |  |  |  |  |  |  | I18N::Collate | 
| 3081 |  |  |  |  |  |  | I18N::JExt | 
| 3082 |  |  |  |  |  |  | File::DosGlob | 
| 3083 |  |  |  |  |  |  | Wild | 
| 3084 |  |  |  |  |  |  | Wildcard | 
| 3085 |  |  |  |  |  |  | Japanese | 
| 3086 |  |  |  |  |  |  | )); | 
| 3087 |  |  |  |  |  |  |  | 
| 3088 |  |  |  |  |  |  | # another member of Tag-team | 
| 3089 |  |  |  |  |  |  | # | 
| 3090 |  |  |  |  |  |  | # P.315 "Tag-team" matching with /gc | 
| 3091 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 3092 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 3093 |  |  |  |  |  |  |  | 
| 3094 | 0 | 0 | 0 |  |  |  | if (/\G ( \n ) /oxgc) { # another member (and so on) | 
|  |  | 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 |  |  |  |  |  | 
|  |  | 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 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3095 | 0 |  |  |  |  |  | my $heredoc = ''; | 
| 3096 | 0 | 0 |  |  |  |  | if (scalar(@heredoc_delimiter) >= 1) { | 
| 3097 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3098 |  |  |  |  |  |  |  | 
| 3099 | 0 |  |  |  |  |  | $heredoc = join '', @heredoc; | 
| 3100 | 0 |  |  |  |  |  | @heredoc = (); | 
| 3101 |  |  |  |  |  |  |  | 
| 3102 |  |  |  |  |  |  | # skip here document | 
| 3103 | 0 |  |  |  |  |  | for my $heredoc_delimiter (@heredoc_delimiter) { | 
| 3104 | 0 |  |  |  |  |  | /\G .*? \n $heredoc_delimiter \n/xmsgc; | 
| 3105 |  |  |  |  |  |  | } | 
| 3106 | 0 |  |  |  |  |  | @heredoc_delimiter = (); | 
| 3107 |  |  |  |  |  |  |  | 
| 3108 | 0 |  |  |  |  |  | $here_script = ''; | 
| 3109 |  |  |  |  |  |  | } | 
| 3110 | 0 |  |  |  |  |  | return "\n" . $heredoc; | 
| 3111 |  |  |  |  |  |  | } | 
| 3112 |  |  |  |  |  |  |  | 
| 3113 |  |  |  |  |  |  | # ignore space, comment | 
| 3114 | 0 |  |  |  |  |  | elsif (/\G ((?>\s+)|\#.*) /oxgc) { return $1; } | 
| 3115 |  |  |  |  |  |  |  | 
| 3116 |  |  |  |  |  |  | # if (, elsif (, unless (, while (, until (, given (, and when ( | 
| 3117 |  |  |  |  |  |  |  | 
| 3118 |  |  |  |  |  |  | # given, when | 
| 3119 |  |  |  |  |  |  |  | 
| 3120 |  |  |  |  |  |  | # P.225 The given Statement | 
| 3121 |  |  |  |  |  |  | # in Chapter 15: Smart Matching and given-when | 
| 3122 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 3123 |  |  |  |  |  |  |  | 
| 3124 |  |  |  |  |  |  | # P.133 The given Statement | 
| 3125 |  |  |  |  |  |  | # in Chapter 4: Statements and Declarations | 
| 3126 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 3127 |  |  |  |  |  |  |  | 
| 3128 |  |  |  |  |  |  | elsif (/\G ( (?: if | elsif | unless | while | until | given | when ) (?>\s*) \( ) /oxgc) { | 
| 3129 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3130 | 0 |  |  |  |  |  | return $1; | 
| 3131 |  |  |  |  |  |  | } | 
| 3132 |  |  |  |  |  |  |  | 
| 3133 |  |  |  |  |  |  | # scalar variable ($scalar = ...) =~ tr///; | 
| 3134 |  |  |  |  |  |  | # scalar variable ($scalar = ...) =~ s///; | 
| 3135 |  |  |  |  |  |  |  | 
| 3136 |  |  |  |  |  |  | # state | 
| 3137 |  |  |  |  |  |  |  | 
| 3138 |  |  |  |  |  |  | # P.68 Persistent, Private Variables | 
| 3139 |  |  |  |  |  |  | # in Chapter 4: Subroutines | 
| 3140 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 3141 |  |  |  |  |  |  |  | 
| 3142 |  |  |  |  |  |  | # P.160 Persistent Lexically Scoped Variables: state | 
| 3143 |  |  |  |  |  |  | # in Chapter 4: Statements and Declarations | 
| 3144 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 3145 |  |  |  |  |  |  |  | 
| 3146 |  |  |  |  |  |  | # (and so on) | 
| 3147 |  |  |  |  |  |  |  | 
| 3148 |  |  |  |  |  |  | elsif (/\G ( \( (?>\s*) (?: local \b | my \b | our \b | state \b )? (?>\s*) \$ $qq_scalar ) /oxgc) { | 
| 3149 | 0 |  |  |  |  |  | my $e_string = e_string($1); | 
| 3150 |  |  |  |  |  |  |  | 
| 3151 | 0 | 0 |  |  |  |  | if (/\G ( (?>\s*) = $qq_paren \) ) ( (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= (?: tr | y ) \b ) /oxgc) { | 
|  |  | 0 |  |  |  |  |  | 
| 3152 | 0 |  |  |  |  |  | $tr_variable = $e_string . e_string($1); | 
| 3153 | 0 |  |  |  |  |  | $bind_operator = $2; | 
| 3154 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3155 | 0 |  |  |  |  |  | return ''; | 
| 3156 |  |  |  |  |  |  | } | 
| 3157 |  |  |  |  |  |  | elsif (/\G ( (?>\s*) = $qq_paren \) ) ( (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= s \b ) /oxgc) { | 
| 3158 | 0 |  |  |  |  |  | $sub_variable = $e_string . e_string($1); | 
| 3159 | 0 |  |  |  |  |  | $bind_operator = $2; | 
| 3160 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3161 | 0 |  |  |  |  |  | return ''; | 
| 3162 |  |  |  |  |  |  | } | 
| 3163 |  |  |  |  |  |  | else { | 
| 3164 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3165 | 0 |  |  |  |  |  | return $e_string; | 
| 3166 |  |  |  |  |  |  | } | 
| 3167 |  |  |  |  |  |  | } | 
| 3168 |  |  |  |  |  |  |  | 
| 3169 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Elatin6::PREMATCH() | 
| 3170 |  |  |  |  |  |  | elsif (/\G ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  \b | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) /oxmsgc) { | 
| 3171 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3172 | 0 |  |  |  |  |  | return q{Elatin6::PREMATCH()}; | 
| 3173 |  |  |  |  |  |  | } | 
| 3174 |  |  |  |  |  |  |  | 
| 3175 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Elatin6::MATCH() | 
| 3176 |  |  |  |  |  |  | elsif (/\G ( \$& | \$\{&\} | \$ (?>\s*) MATCH     \b | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) /oxmsgc) { | 
| 3177 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3178 | 0 |  |  |  |  |  | return q{Elatin6::MATCH()}; | 
| 3179 |  |  |  |  |  |  | } | 
| 3180 |  |  |  |  |  |  |  | 
| 3181 |  |  |  |  |  |  | # $', ${'} --> $', ${'} | 
| 3182 |  |  |  |  |  |  | elsif (/\G ( \$' | \$\{'\}                                                                                                     ) /oxmsgc) { | 
| 3183 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3184 | 0 |  |  |  |  |  | return $1; | 
| 3185 |  |  |  |  |  |  | } | 
| 3186 |  |  |  |  |  |  |  | 
| 3187 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Elatin6::POSTMATCH() | 
| 3188 |  |  |  |  |  |  | elsif (/\G (                 \$ (?>\s*) POSTMATCH \b | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) /oxmsgc) { | 
| 3189 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3190 | 0 |  |  |  |  |  | return q{Elatin6::POSTMATCH()}; | 
| 3191 |  |  |  |  |  |  | } | 
| 3192 |  |  |  |  |  |  |  | 
| 3193 |  |  |  |  |  |  | # scalar variable $scalar =~ tr///; | 
| 3194 |  |  |  |  |  |  | # scalar variable $scalar =~ s///; | 
| 3195 |  |  |  |  |  |  | # substr() =~ tr///; | 
| 3196 |  |  |  |  |  |  | # substr() =~ s///; | 
| 3197 |  |  |  |  |  |  | elsif (/\G ( \$ $qq_scalar | $qq_substr ) /oxgc) { | 
| 3198 | 0 |  |  |  |  |  | my $scalar = e_string($1); | 
| 3199 |  |  |  |  |  |  |  | 
| 3200 | 0 | 0 |  |  |  |  | if (/\G (    (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= (?: tr | y ) \b ) /oxgc) { | 
|  |  | 0 |  |  |  |  |  | 
| 3201 | 0 |  |  |  |  |  | $tr_variable = $scalar; | 
| 3202 | 0 |  |  |  |  |  | $bind_operator = $1; | 
| 3203 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3204 | 0 |  |  |  |  |  | return ''; | 
| 3205 |  |  |  |  |  |  | } | 
| 3206 |  |  |  |  |  |  | elsif (/\G ( (?>\s*) (?: =~ | !~ ) (?>\s*) ) (?= s            \b ) /oxgc) { | 
| 3207 | 0 |  |  |  |  |  | $sub_variable = $scalar; | 
| 3208 | 0 |  |  |  |  |  | $bind_operator = $1; | 
| 3209 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3210 | 0 |  |  |  |  |  | return ''; | 
| 3211 |  |  |  |  |  |  | } | 
| 3212 |  |  |  |  |  |  | else { | 
| 3213 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3214 | 0 |  |  |  |  |  | return $scalar; | 
| 3215 |  |  |  |  |  |  | } | 
| 3216 |  |  |  |  |  |  | } | 
| 3217 |  |  |  |  |  |  |  | 
| 3218 |  |  |  |  |  |  | # end of statement | 
| 3219 |  |  |  |  |  |  | elsif (/\G ( [,;] ) /oxgc) { | 
| 3220 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3221 |  |  |  |  |  |  |  | 
| 3222 |  |  |  |  |  |  | # clear tr/// variable | 
| 3223 | 0 |  |  |  |  |  | $tr_variable  = ''; | 
| 3224 |  |  |  |  |  |  |  | 
| 3225 |  |  |  |  |  |  | # clear s/// variable | 
| 3226 | 0 |  |  |  |  |  | $sub_variable  = ''; | 
| 3227 |  |  |  |  |  |  |  | 
| 3228 | 0 |  |  |  |  |  | $bind_operator = ''; | 
| 3229 |  |  |  |  |  |  |  | 
| 3230 | 0 |  |  |  |  |  | return $1; | 
| 3231 |  |  |  |  |  |  | } | 
| 3232 |  |  |  |  |  |  |  | 
| 3233 |  |  |  |  |  |  | # bareword | 
| 3234 |  |  |  |  |  |  | elsif (/\G ( \{ (?>\s*) (?: tr | index | rindex | reverse ) (?>\s*) \} ) /oxmsgc) { | 
| 3235 | 0 |  |  |  |  |  | return $1; | 
| 3236 |  |  |  |  |  |  | } | 
| 3237 |  |  |  |  |  |  |  | 
| 3238 |  |  |  |  |  |  | # $0 --> $0 | 
| 3239 |  |  |  |  |  |  | elsif (/\G ( \$ 0 ) /oxmsgc) { | 
| 3240 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3241 | 0 |  |  |  |  |  | return $1; | 
| 3242 |  |  |  |  |  |  | } | 
| 3243 |  |  |  |  |  |  | elsif (/\G ( \$ \{ (?>\s*) 0 (?>\s*) \} ) /oxmsgc) { | 
| 3244 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3245 | 0 |  |  |  |  |  | return $1; | 
| 3246 |  |  |  |  |  |  | } | 
| 3247 |  |  |  |  |  |  |  | 
| 3248 |  |  |  |  |  |  | # $$ --> $$ | 
| 3249 |  |  |  |  |  |  | elsif (/\G ( \$ \$ ) (?![\w\{]) /oxmsgc) { | 
| 3250 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3251 | 0 |  |  |  |  |  | return $1; | 
| 3252 |  |  |  |  |  |  | } | 
| 3253 |  |  |  |  |  |  |  | 
| 3254 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 3255 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 3256 |  |  |  |  |  |  | elsif (/\G \$ ((?>[1-9][0-9]*)) /oxmsgc) { | 
| 3257 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3258 | 0 |  |  |  |  |  | return e_capture($1); | 
| 3259 |  |  |  |  |  |  | } | 
| 3260 |  |  |  |  |  |  | elsif (/\G \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} /oxmsgc) { | 
| 3261 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3262 | 0 |  |  |  |  |  | return e_capture($1); | 
| 3263 |  |  |  |  |  |  | } | 
| 3264 |  |  |  |  |  |  |  | 
| 3265 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 3266 |  |  |  |  |  |  | elsif (/\G \$ ( \$ (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ .+? \] ) /oxmsgc) { | 
| 3267 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3268 | 0 |  |  |  |  |  | return e_capture($1.'->'.$2); | 
| 3269 |  |  |  |  |  |  | } | 
| 3270 |  |  |  |  |  |  |  | 
| 3271 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 3272 |  |  |  |  |  |  | elsif (/\G \$ ( \$ (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ .+? \} ) /oxmsgc) { | 
| 3273 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3274 | 0 |  |  |  |  |  | return e_capture($1.'->'.$2); | 
| 3275 |  |  |  |  |  |  | } | 
| 3276 |  |  |  |  |  |  |  | 
| 3277 |  |  |  |  |  |  | # $$foo | 
| 3278 |  |  |  |  |  |  | elsif (/\G \$ ( \$ (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) /oxmsgc) { | 
| 3279 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3280 | 0 |  |  |  |  |  | return e_capture($1); | 
| 3281 |  |  |  |  |  |  | } | 
| 3282 |  |  |  |  |  |  |  | 
| 3283 |  |  |  |  |  |  | # ${ foo } | 
| 3284 |  |  |  |  |  |  | elsif (/\G \$ (?>\s*) \{ ( (?>\s*) (?> [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* ) (?>\s*) ) \} /oxmsgc) { | 
| 3285 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3286 | 0 |  |  |  |  |  | return '${' . $1 . '}'; | 
| 3287 |  |  |  |  |  |  | } | 
| 3288 |  |  |  |  |  |  |  | 
| 3289 |  |  |  |  |  |  | # ${ ... } | 
| 3290 |  |  |  |  |  |  | elsif (/\G \$ (?>\s*) \{ (?>\s*) ( $qq_brace ) (?>\s*) \} /oxmsgc) { | 
| 3291 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3292 | 0 |  |  |  |  |  | return e_capture($1); | 
| 3293 |  |  |  |  |  |  | } | 
| 3294 |  |  |  |  |  |  |  | 
| 3295 |  |  |  |  |  |  | # variable or function | 
| 3296 |  |  |  |  |  |  | #                  $ @ % & *     $ # | 
| 3297 |  |  |  |  |  |  | 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) { | 
| 3298 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3299 | 0 |  |  |  |  |  | return $1; | 
| 3300 |  |  |  |  |  |  | } | 
| 3301 |  |  |  |  |  |  | #                $ $ $ $ $ $ $ $ $ $ $ $ $ $ | 
| 3302 |  |  |  |  |  |  | #                $ @ # \ ' " / ? ( ) [ ] < > | 
| 3303 |  |  |  |  |  |  | elsif (/\G ( \$[\$\@\#\\\'\"\/\?\(\)\[\]\<\>] ) /oxmsgc) { | 
| 3304 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 3305 | 0 |  |  |  |  |  | return $1; | 
| 3306 |  |  |  |  |  |  | } | 
| 3307 |  |  |  |  |  |  |  | 
| 3308 |  |  |  |  |  |  | # while () | 
| 3309 |  |  |  |  |  |  | elsif (/\G \b (while (?>\s*) \( (?>\s*) <[\$]?[A-Za-z_][A-Za-z_0-9]*> (?>\s*) \)) \b /oxgc) { | 
| 3310 | 0 |  |  |  |  |  | return $1; | 
| 3311 |  |  |  |  |  |  | } | 
| 3312 |  |  |  |  |  |  |  | 
| 3313 |  |  |  |  |  |  | # while () --- glob | 
| 3314 |  |  |  |  |  |  |  | 
| 3315 |  |  |  |  |  |  | # avoid "Error: Runtime exception" of perl version 5.005_03 | 
| 3316 |  |  |  |  |  |  |  | 
| 3317 |  |  |  |  |  |  | elsif (/\G \b while (?>\s*) \( (?>\s*) < ((?:[^>\0\a\e\f\n\r\t])+?) > (?>\s*) \) \b /oxgc) { | 
| 3318 | 0 |  |  |  |  |  | return 'while ($_ = Elatin6::glob("' . $1 . '"))'; | 
| 3319 |  |  |  |  |  |  | } | 
| 3320 |  |  |  |  |  |  |  | 
| 3321 |  |  |  |  |  |  | # while (glob) | 
| 3322 |  |  |  |  |  |  | elsif (/\G \b while (?>\s*) \( (?>\s*) glob (?>\s*) \) /oxgc) { | 
| 3323 | 0 |  |  |  |  |  | return 'while ($_ = Elatin6::glob_)'; | 
| 3324 |  |  |  |  |  |  | } | 
| 3325 |  |  |  |  |  |  |  | 
| 3326 |  |  |  |  |  |  | # while (glob(WILDCARD)) | 
| 3327 |  |  |  |  |  |  | elsif (/\G \b while (?>\s*) \( (?>\s*) glob \b /oxgc) { | 
| 3328 | 0 |  |  |  |  |  | return 'while ($_ = Elatin6::glob'; | 
| 3329 |  |  |  |  |  |  | } | 
| 3330 |  |  |  |  |  |  |  | 
| 3331 |  |  |  |  |  |  | # doit if, doit unless, doit while, doit until, doit for, doit when | 
| 3332 | 0 |  |  |  |  |  | elsif (/\G \b ( if | unless | while | until | for | when ) \b /oxgc) { $slash = 'm//'; return $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 3333 |  |  |  |  |  |  |  | 
| 3334 |  |  |  |  |  |  | # subroutines of package Elatin6 | 
| 3335 | 0 |  |  |  |  |  | elsif (/\G \b (CORE:: | ->(>?\s*) (?: atan2 | [a-z]{2,})) \b       /oxgc) { $slash = 'm//'; return $1;                  } | 
|  | 0 |  |  |  |  |  |  | 
| 3336 | 0 |  |  |  |  |  | elsif (/\G \b Char::eval       (?= (?>\s*) \{ )                    /oxgc) { $slash = 'm//'; return 'eval';              } | 
|  | 0 |  |  |  |  |  |  | 
| 3337 | 0 |  |  |  |  |  | elsif (/\G \b Latin6::eval       (?= (?>\s*) \{ )                    /oxgc) { $slash = 'm//'; return 'eval';              } | 
|  | 0 |  |  |  |  |  |  | 
| 3338 | 0 |  |  |  |  |  | elsif (/\G \b Char::eval    \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'eval Char::escape'; } | 
|  | 0 |  |  |  |  |  |  | 
| 3339 | 0 |  |  |  |  |  | elsif (/\G \b Latin6::eval    \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'eval Latin6::escape'; } | 
|  | 0 |  |  |  |  |  |  | 
| 3340 | 0 |  |  |  |  |  | elsif (/\G \b bytes::substr \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'substr';            } | 
|  | 0 |  |  |  |  |  |  | 
| 3341 | 0 |  |  |  |  |  | elsif (/\G \b chop \b          (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Elatin6::chop';       } | 
|  | 0 |  |  |  |  |  |  | 
| 3342 | 0 |  |  |  |  |  | elsif (/\G \b bytes::index \b  (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'index';             } | 
|  | 0 |  |  |  |  |  |  | 
| 3343 | 0 |  |  |  |  |  | elsif (/\G \b Char::index \b   (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Char::index';       } | 
|  | 0 |  |  |  |  |  |  | 
| 3344 | 0 |  |  |  |  |  | elsif (/\G \b Latin6::index \b   (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Latin6::index';       } | 
|  | 0 |  |  |  |  |  |  | 
| 3345 | 0 |  |  |  |  |  | elsif (/\G \b index \b         (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Elatin6::index';      } | 
|  | 0 |  |  |  |  |  |  | 
| 3346 | 0 |  |  |  |  |  | elsif (/\G \b bytes::rindex \b (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'rindex';            } | 
|  | 0 |  |  |  |  |  |  | 
| 3347 | 0 |  |  |  |  |  | elsif (/\G \b Char::rindex \b  (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Char::rindex';      } | 
|  | 0 |  |  |  |  |  |  | 
| 3348 | 0 |  |  |  |  |  | elsif (/\G \b Latin6::rindex \b  (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Latin6::rindex';      } | 
|  | 0 |  |  |  |  |  |  | 
| 3349 | 0 |  |  |  |  |  | elsif (/\G \b rindex \b        (?! (?>\s*) => )                    /oxgc) { $slash = 'm//'; return 'Elatin6::rindex';     } | 
|  | 0 |  |  |  |  |  |  | 
| 3350 | 0 |  |  |  |  |  | elsif (/\G \b lc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::lc';         } | 
|  | 0 |  |  |  |  |  |  | 
| 3351 | 0 |  |  |  |  |  | elsif (/\G \b lcfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::lcfirst';    } | 
|  | 0 |  |  |  |  |  |  | 
| 3352 | 0 |  |  |  |  |  | elsif (/\G \b uc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::uc';         } | 
|  | 0 |  |  |  |  |  |  | 
| 3353 | 0 |  |  |  |  |  | elsif (/\G \b ucfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::ucfirst';    } | 
|  | 0 |  |  |  |  |  |  | 
| 3354 | 0 |  |  |  |  |  | elsif (/\G \b fc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::fc';         } | 
|  | 0 |  |  |  |  |  |  | 
| 3355 |  |  |  |  |  |  |  | 
| 3356 |  |  |  |  |  |  | # "-s '' ..." means file test "-s 'filename' ..." (not means "- s/// ...") | 
| 3357 | 0 |  |  |  |  |  | elsif (/\G -s                                          (?>\s*) (\") ((?:$qq_char)+?)               (\") /oxgc) { $slash = 'm//'; return '-s ' . e_qq('',  $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3358 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\#) ((?:$qq_char)+?)               (\#) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3359 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\() ((?:$qq_paren)+?)              (\)) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3360 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\{) ((?:$qq_brace)+?)              (\}) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3361 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\[) ((?:$qq_bracket)+?)            (\]) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3362 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\<) ((?:$qq_angle)+?)              (\>) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3363 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) qq (?>\s*) (\S) ((?:$qq_char)+?)               (\1) /oxgc) { $slash = 'm//'; return '-s ' . e_qq('qq',$1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3364 |  |  |  |  |  |  |  | 
| 3365 | 0 |  |  |  |  |  | elsif (/\G -s                                          (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)      (\') /oxgc) { $slash = 'm//'; return '-s ' . e_q ('',  $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3366 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)      (\#) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3367 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)     (\)) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3368 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)     (\}) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3369 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?)   (\]) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3370 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)     (\>) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3371 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) q  (?>\s*) (\S) ((?:\\\1|\\\\|$q_char)+?)      (\1) /oxgc) { $slash = 'm//'; return '-s ' . e_q ('q', $1,$3,$2); } | 
|  | 0 |  |  |  |  |  |  | 
| 3372 |  |  |  |  |  |  |  | 
| 3373 |  |  |  |  |  |  | elsif (/\G -s                               (?>\s*) (\$ (?> \w+ (?: ::\w+)* ) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ) )*) /oxgc) | 
| 3374 | 0 |  |  |  |  |  | { $slash = 'm//'; return "-s $1";   } | 
|  | 0 |  |  |  |  |  |  | 
| 3375 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s*) \( ((?:$qq_paren)*?) \)                             /oxgc) { $slash = 'm//'; return "-s ($1)"; } | 
|  | 0 |  |  |  |  |  |  | 
| 3376 | 0 |  |  |  |  |  | elsif (/\G -s                               (?= (?>\s+) [a-z]+)                                         /oxgc) { $slash = 'm//'; return '-s';      } | 
|  | 0 |  |  |  |  |  |  | 
| 3377 | 0 |  |  |  |  |  | elsif (/\G -s                               (?>\s+) ((?>\w+))                                           /oxgc) { $slash = 'm//'; return "-s $1";   } | 
|  | 0 |  |  |  |  |  |  | 
| 3378 |  |  |  |  |  |  |  | 
| 3379 | 0 |  |  |  |  |  | elsif (/\G \b bytes::length (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'length';                   } | 
|  | 0 |  |  |  |  |  |  | 
| 3380 | 0 |  |  |  |  |  | elsif (/\G \b bytes::chr    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'chr';                      } | 
|  | 0 |  |  |  |  |  |  | 
| 3381 | 0 |  |  |  |  |  | elsif (/\G \b chr           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::chr';               } | 
|  | 0 |  |  |  |  |  |  | 
| 3382 | 0 |  |  |  |  |  | elsif (/\G \b bytes::ord    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'div'; return 'ord';                      } | 
|  | 0 |  |  |  |  |  |  | 
| 3383 | 0 |  |  |  |  |  | elsif (/\G \b ord           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'div'; return $function_ord;              } | 
|  | 0 |  |  |  |  |  |  | 
| 3384 | 0 |  |  |  |  |  | elsif (/\G \b glob          (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $slash = 'm//'; return 'Elatin6::glob';              } | 
|  | 0 |  |  |  |  |  |  | 
| 3385 | 0 |  |  |  |  |  | elsif (/\G \b lc \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::lc_';               } | 
|  | 0 |  |  |  |  |  |  | 
| 3386 | 0 |  |  |  |  |  | elsif (/\G \b lcfirst \b       (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::lcfirst_';          } | 
|  | 0 |  |  |  |  |  |  | 
| 3387 | 0 |  |  |  |  |  | elsif (/\G \b uc \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::uc_';               } | 
|  | 0 |  |  |  |  |  |  | 
| 3388 | 0 |  |  |  |  |  | elsif (/\G \b ucfirst \b       (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::ucfirst_';          } | 
|  | 0 |  |  |  |  |  |  | 
| 3389 | 0 |  |  |  |  |  | elsif (/\G \b fc \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::fc_';               } | 
|  | 0 |  |  |  |  |  |  | 
| 3390 | 0 |  |  |  |  |  | elsif (/\G    -s \b            (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return '-s ';                      } | 
|  | 0 |  |  |  |  |  |  | 
| 3391 |  |  |  |  |  |  |  | 
| 3392 | 0 |  |  |  |  |  | elsif (/\G \b bytes::length \b (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'length';                   } | 
|  | 0 |  |  |  |  |  |  | 
| 3393 | 0 |  |  |  |  |  | elsif (/\G \b bytes::chr \b    (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'chr';                      } | 
|  | 0 |  |  |  |  |  |  | 
| 3394 | 0 |  |  |  |  |  | elsif (/\G \b chr \b           (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::chr_';              } | 
|  | 0 |  |  |  |  |  |  | 
| 3395 | 0 |  |  |  |  |  | elsif (/\G \b bytes::ord \b    (?! (?>\s*) => )                          /oxgc) { $slash = 'div'; return 'ord';                      } | 
|  | 0 |  |  |  |  |  |  | 
| 3396 | 0 |  |  |  |  |  | elsif (/\G \b ord \b           (?! (?>\s*) => )                          /oxgc) { $slash = 'div'; return $function_ord_;             } | 
|  | 0 |  |  |  |  |  |  | 
| 3397 | 0 |  |  |  |  |  | elsif (/\G \b glob \b          (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return 'Elatin6::glob_';             } | 
|  | 0 |  |  |  |  |  |  | 
| 3398 | 0 |  |  |  |  |  | elsif (/\G \b reverse \b       (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return $function_reverse;          } | 
|  | 0 |  |  |  |  |  |  | 
| 3399 | 0 |  |  |  |  |  | elsif (/\G \b getc \b          (?! (?>\s*) => )                          /oxgc) { $slash = 'm//'; return $function_getc;             } | 
|  | 0 |  |  |  |  |  |  | 
| 3400 |  |  |  |  |  |  | # split | 
| 3401 |  |  |  |  |  |  | elsif (/\G \b (split) \b (?! (?>\s*) => ) /oxgc) { | 
| 3402 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 3403 |  |  |  |  |  |  |  | 
| 3404 | 0 |  |  |  |  |  | my $e = ''; | 
| 3405 | 0 |  |  |  |  |  | while (/\G ( (?>\s+) | \( | \#.* ) /oxgc) { | 
| 3406 | 0 |  |  |  |  |  | $e .= $1; | 
| 3407 |  |  |  |  |  |  | } | 
| 3408 |  |  |  |  |  |  |  | 
| 3409 |  |  |  |  |  |  | # end of split | 
| 3410 | 0 | 0 |  |  |  |  | if    (/\G (?= [,;\)\}\]] )          /oxgc) { return 'Elatin6::split' . $e;                 } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3411 |  |  |  |  |  |  |  | 
| 3412 |  |  |  |  |  |  | # split scalar value | 
| 3413 | 0 |  |  |  |  |  | elsif (/\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { return 'Elatin6::split' . $e . e_string($1);  } | 
| 3414 |  |  |  |  |  |  |  | 
| 3415 |  |  |  |  |  |  | # split literal space | 
| 3416 | 0 |  |  |  |  |  | elsif (/\G \b qq           (\#) [ ] (\#) /oxgc) { return 'Elatin6::split' . $e . qq  {qq$1 $2}; } | 
| 3417 | 0 |  |  |  |  |  | elsif (/\G \b qq ((?>\s*)) (\() [ ] (\)) /oxgc) { return 'Elatin6::split' . $e . qq{$1qq$2 $3}; } | 
| 3418 | 0 |  |  |  |  |  | elsif (/\G \b qq ((?>\s*)) (\{) [ ] (\}) /oxgc) { return 'Elatin6::split' . $e . qq{$1qq$2 $3}; } | 
| 3419 | 0 |  |  |  |  |  | elsif (/\G \b qq ((?>\s*)) (\[) [ ] (\]) /oxgc) { return 'Elatin6::split' . $e . qq{$1qq$2 $3}; } | 
| 3420 | 0 |  |  |  |  |  | elsif (/\G \b qq ((?>\s*)) (\<) [ ] (\>) /oxgc) { return 'Elatin6::split' . $e . qq{$1qq$2 $3}; } | 
| 3421 | 0 |  |  |  |  |  | elsif (/\G \b qq ((?>\s*)) (\S) [ ] (\2) /oxgc) { return 'Elatin6::split' . $e . qq{$1qq$2 $3}; } | 
| 3422 | 0 |  |  |  |  |  | elsif (/\G \b q            (\#) [ ] (\#) /oxgc) { return 'Elatin6::split' . $e . qq   {q$1 $2}; } | 
| 3423 | 0 |  |  |  |  |  | elsif (/\G \b q  ((?>\s*)) (\() [ ] (\)) /oxgc) { return 'Elatin6::split' . $e . qq {$1q$2 $3}; } | 
| 3424 | 0 |  |  |  |  |  | elsif (/\G \b q  ((?>\s*)) (\{) [ ] (\}) /oxgc) { return 'Elatin6::split' . $e . qq {$1q$2 $3}; } | 
| 3425 | 0 |  |  |  |  |  | elsif (/\G \b q  ((?>\s*)) (\[) [ ] (\]) /oxgc) { return 'Elatin6::split' . $e . qq {$1q$2 $3}; } | 
| 3426 | 0 |  |  |  |  |  | elsif (/\G \b q  ((?>\s*)) (\<) [ ] (\>) /oxgc) { return 'Elatin6::split' . $e . qq {$1q$2 $3}; } | 
| 3427 | 0 |  |  |  |  |  | elsif (/\G \b q  ((?>\s*)) (\S) [ ] (\2) /oxgc) { return 'Elatin6::split' . $e . qq {$1q$2 $3}; } | 
| 3428 | 0 |  |  |  |  |  | elsif (/\G                    ' [ ] '    /oxgc) { return 'Elatin6::split' . $e . qq     {' '};  } | 
| 3429 | 0 |  |  |  |  |  | elsif (/\G                    " [ ] "    /oxgc) { return 'Elatin6::split' . $e . qq     {" "};  } | 
| 3430 |  |  |  |  |  |  |  | 
| 3431 |  |  |  |  |  |  | # split qq// | 
| 3432 |  |  |  |  |  |  | elsif (/\G \b (qq) \b /oxgc) { | 
| 3433 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc)                        { return e_split($e.'qr',$1,$3,$2,'');   } # qq# #  --> qr # # | 
|  | 0 |  |  |  |  |  |  | 
| 3434 |  |  |  |  |  |  | else { | 
| 3435 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3436 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                         /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3437 | 0 |  |  |  |  |  | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq ( ) --> qr ( ) | 
| 3438 | 0 |  |  |  |  |  | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq { } --> qr { } | 
| 3439 | 0 |  |  |  |  |  | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq [ ] --> qr [ ] | 
| 3440 | 0 |  |  |  |  |  | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq < > --> qr < > | 
| 3441 | 0 |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) /oxgc) { return e_split($e.'qr','{','}',$2,''); } # qq | | --> qr { } | 
| 3442 | 0 |  |  |  |  |  | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) /oxgc) { return e_split($e.'qr',$1,$3,$2,'');   } # qq * * --> qr * * | 
| 3443 |  |  |  |  |  |  | } | 
| 3444 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3445 |  |  |  |  |  |  | } | 
| 3446 |  |  |  |  |  |  | } | 
| 3447 |  |  |  |  |  |  |  | 
| 3448 |  |  |  |  |  |  | # split qr// | 
| 3449 |  |  |  |  |  |  | elsif (/\G \b (qr) \b /oxgc) { | 
| 3450 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ([imosxpadlunbB]*) /oxgc)                        { return e_split  ($e.'qr',$1,$3,$2,$4);   } # qr# # | 
|  | 0 |  |  |  |  |  |  | 
| 3451 |  |  |  |  |  |  | else { | 
| 3452 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3453 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                            /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3454 | 0 |  |  |  |  |  | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr ( ) | 
| 3455 | 0 |  |  |  |  |  | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr { } | 
| 3456 | 0 |  |  |  |  |  | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr [ ] | 
| 3457 | 0 |  |  |  |  |  | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr < > | 
| 3458 | 0 |  |  |  |  |  | elsif (/\G (\')          ((?:$qq_char)*?)    (\') ([imosxpadlunbB]*) /oxgc) { return e_split_q($e.'qr',$1, $3, $2,$4); } # qr ' ' | 
| 3459 | 0 |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr','{','}',$2,$4); } # qr | | --> qr { } | 
| 3460 | 0 |  |  |  |  |  | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # qr * * | 
| 3461 |  |  |  |  |  |  | } | 
| 3462 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3463 |  |  |  |  |  |  | } | 
| 3464 |  |  |  |  |  |  | } | 
| 3465 |  |  |  |  |  |  |  | 
| 3466 |  |  |  |  |  |  | # split q// | 
| 3467 |  |  |  |  |  |  | elsif (/\G \b (q) \b /oxgc) { | 
| 3468 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc)                    { return e_split_q($e.'qr',$1,$3,$2,'');   } # q# #  --> qr # # | 
|  | 0 |  |  |  |  |  |  | 
| 3469 |  |  |  |  |  |  | else { | 
| 3470 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3471 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                              /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3472 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q ( ) --> qr ( ) | 
| 3473 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q { } --> qr { } | 
| 3474 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q [ ] --> qr [ ] | 
| 3475 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q < > --> qr < > | 
| 3476 | 0 |  |  |  |  |  | elsif (/\G ([*\-:?\\^|])       ((?:$q_char)*?)    (\1) /oxgc) { return e_split_q($e.'qr','{','}',$2,''); } # q | | --> qr { } | 
| 3477 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { return e_split_q($e.'qr',$1,$3,$2,'');   } # q * * --> qr * * | 
| 3478 |  |  |  |  |  |  | } | 
| 3479 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3480 |  |  |  |  |  |  | } | 
| 3481 |  |  |  |  |  |  | } | 
| 3482 |  |  |  |  |  |  |  | 
| 3483 |  |  |  |  |  |  | # split m// | 
| 3484 |  |  |  |  |  |  | elsif (/\G \b (m) \b /oxgc) { | 
| 3485 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc)                        { return e_split  ($e.'qr',$1,$3,$2,$4);   } # m# #  --> qr # # | 
|  | 0 |  |  |  |  |  |  | 
| 3486 |  |  |  |  |  |  | else { | 
| 3487 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3488 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                              /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3489 | 0 |  |  |  |  |  | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m ( ) --> qr ( ) | 
| 3490 | 0 |  |  |  |  |  | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m { } --> qr { } | 
| 3491 | 0 |  |  |  |  |  | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m [ ] --> qr [ ] | 
| 3492 | 0 |  |  |  |  |  | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m < > --> qr < > | 
| 3493 | 0 |  |  |  |  |  | elsif (/\G (\')          ((?:$qq_char)*?)    (\') ([cgimosxpadlunbB]*) /oxgc) { return e_split_q($e.'qr',$1, $3, $2,$4); } # m ' ' --> qr ' ' | 
| 3494 | 0 |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr','{','}',$2,$4); } # m | | --> qr { } | 
| 3495 | 0 |  |  |  |  |  | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return e_split  ($e.'qr',$1, $3, $2,$4); } # m * * --> qr * * | 
| 3496 |  |  |  |  |  |  | } | 
| 3497 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 3498 |  |  |  |  |  |  | } | 
| 3499 |  |  |  |  |  |  | } | 
| 3500 |  |  |  |  |  |  |  | 
| 3501 |  |  |  |  |  |  | # split '' | 
| 3502 |  |  |  |  |  |  | elsif (/\G (\') /oxgc) { | 
| 3503 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3504 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3505 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $q_string .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3506 | 0 |  |  |  |  |  | elsif (/\G (\\\')    /oxgc) { $q_string .= $1; }                               # splitqr'' --> split qr'' | 
| 3507 | 0 |  |  |  |  |  | elsif (/\G \'        /oxgc)                                                    { return e_split_q($e.q{ qr},"'","'",$q_string,''); } # ' ' --> qr ' ' | 
| 3508 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $q_string .= $1; } | 
| 3509 |  |  |  |  |  |  | } | 
| 3510 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3511 |  |  |  |  |  |  | } | 
| 3512 |  |  |  |  |  |  |  | 
| 3513 |  |  |  |  |  |  | # split "" | 
| 3514 |  |  |  |  |  |  | elsif (/\G (\") /oxgc) { | 
| 3515 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3516 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3517 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $qq_string .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3518 | 0 |  |  |  |  |  | elsif (/\G (\\\")    /oxgc) { $qq_string .= $1; }                              # splitqr"" --> split qr"" | 
| 3519 | 0 |  |  |  |  |  | elsif (/\G \"        /oxgc)                                                    { return e_split($e.q{ qr},'"','"',$qq_string,''); } # " " --> qr " " | 
| 3520 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $qq_string .= $1; } | 
| 3521 |  |  |  |  |  |  | } | 
| 3522 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3523 |  |  |  |  |  |  | } | 
| 3524 |  |  |  |  |  |  |  | 
| 3525 |  |  |  |  |  |  | # split // | 
| 3526 |  |  |  |  |  |  | elsif (/\G (\/) /oxgc) { | 
| 3527 | 0 |  |  |  |  |  | my $regexp = ''; | 
| 3528 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3529 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)                  /oxgc) { $regexp .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3530 | 0 |  |  |  |  |  | elsif (/\G (\\\/)                  /oxgc) { $regexp .= $1; }                   # splitqr// --> split qr// | 
| 3531 | 0 |  |  |  |  |  | elsif (/\G \/ ([cgimosxpadlunbB]*) /oxgc)                                      { return e_split($e.q{ qr}, '/','/',$regexp,$1); } # / / --> qr / / | 
| 3532 | 0 |  |  |  |  |  | elsif (/\G ($q_char)               /oxgc) { $regexp .= $1; } | 
| 3533 |  |  |  |  |  |  | } | 
| 3534 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 3535 |  |  |  |  |  |  | } | 
| 3536 |  |  |  |  |  |  | } | 
| 3537 |  |  |  |  |  |  |  | 
| 3538 |  |  |  |  |  |  | # tr/// or y/// | 
| 3539 |  |  |  |  |  |  |  | 
| 3540 |  |  |  |  |  |  | # about [cdsrbB]* (/B modifier) | 
| 3541 |  |  |  |  |  |  | # | 
| 3542 |  |  |  |  |  |  | # P.559 appendix C | 
| 3543 |  |  |  |  |  |  | # of ISBN 4-89052-384-7 Programming perl | 
| 3544 |  |  |  |  |  |  | # (Japanese title is: Perl puroguramingu) | 
| 3545 |  |  |  |  |  |  |  | 
| 3546 |  |  |  |  |  |  | elsif (/\G \b ( tr | y ) \b /oxgc) { | 
| 3547 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3548 |  |  |  |  |  |  |  | 
| 3549 |  |  |  |  |  |  | #        $1   $2               $3   $4               $5   $6 | 
| 3550 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ((?:$qq_char)*?) (\#) ([cdsrbB]*) /oxgc) { # tr# # # | 
| 3551 | 0 |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 3552 | 0 |  |  |  |  |  | return e_tr(@tr,'',$4,$6); | 
| 3553 |  |  |  |  |  |  | } | 
| 3554 |  |  |  |  |  |  | else { | 
| 3555 | 0 |  |  |  |  |  | my $e = ''; | 
| 3556 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3557 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)              /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3558 |  |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { | 
| 3559 | 0 |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 3560 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3561 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3562 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) ( ) | 
| 3563 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) { } | 
| 3564 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) [ ] | 
| 3565 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) < > | 
| 3566 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr ( ) * * | 
| 3567 |  |  |  |  |  |  | } | 
| 3568 | 0 |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 3569 |  |  |  |  |  |  | } | 
| 3570 |  |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { | 
| 3571 | 0 |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 3572 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3573 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3574 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } ( ) | 
| 3575 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } { } | 
| 3576 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } [ ] | 
| 3577 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } < > | 
| 3578 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr { } * * | 
| 3579 |  |  |  |  |  |  | } | 
| 3580 | 0 |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 3581 |  |  |  |  |  |  | } | 
| 3582 |  |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { | 
| 3583 | 0 |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 3584 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3585 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3586 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] ( ) | 
| 3587 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] { } | 
| 3588 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] [ ] | 
| 3589 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] < > | 
| 3590 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr [ ] * * | 
| 3591 |  |  |  |  |  |  | } | 
| 3592 | 0 |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 3593 |  |  |  |  |  |  | } | 
| 3594 |  |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { | 
| 3595 | 0 |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 3596 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3597 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                            /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3598 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > ( ) | 
| 3599 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > { } | 
| 3600 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > [ ] | 
| 3601 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > < > | 
| 3602 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cdsrbB]*) /oxgc) { return e_tr(@tr,$e,$2,$4); } # tr < > * * | 
| 3603 |  |  |  |  |  |  | } | 
| 3604 | 0 |  |  |  |  |  | die __FILE__, ": Transliteration replacement not terminated\n"; | 
| 3605 |  |  |  |  |  |  | } | 
| 3606 |  |  |  |  |  |  | #           $1   $2               $3   $4               $5   $6 | 
| 3607 |  |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cdsrbB]*) /oxgc) { # tr * * * | 
| 3608 | 0 |  |  |  |  |  | my @tr = ($tr_variable,$2); | 
| 3609 | 0 |  |  |  |  |  | return e_tr(@tr,'',$4,$6); | 
| 3610 |  |  |  |  |  |  | } | 
| 3611 |  |  |  |  |  |  | } | 
| 3612 | 0 |  |  |  |  |  | die __FILE__, ": Transliteration pattern not terminated\n"; | 
| 3613 |  |  |  |  |  |  | } | 
| 3614 |  |  |  |  |  |  | } | 
| 3615 |  |  |  |  |  |  |  | 
| 3616 |  |  |  |  |  |  | # qq// | 
| 3617 |  |  |  |  |  |  | elsif (/\G \b (qq) \b /oxgc) { | 
| 3618 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3619 |  |  |  |  |  |  |  | 
| 3620 |  |  |  |  |  |  | #       if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { return e_qq($ope,$1,$3,$2); } # qq# # | 
| 3621 | 0 | 0 |  |  |  |  | if (/\G (\#) /oxgc) {                                                     # qq# # | 
| 3622 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3623 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3624 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                     } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3625 | 0 |  |  |  |  |  | elsif (/\G (\\\#)     /oxgc) { $qq_string .= $1;                     } | 
| 3626 | 0 |  |  |  |  |  | elsif (/\G (\#)       /oxgc) { return e_qq($ope,'#','#',$qq_string); } | 
| 3627 | 0 |  |  |  |  |  | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                     } | 
| 3628 |  |  |  |  |  |  | } | 
| 3629 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3630 |  |  |  |  |  |  | } | 
| 3631 |  |  |  |  |  |  |  | 
| 3632 |  |  |  |  |  |  | else { | 
| 3633 | 0 |  |  |  |  |  | my $e = ''; | 
| 3634 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3635 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)              /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3636 |  |  |  |  |  |  |  | 
| 3637 |  |  |  |  |  |  | #               elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq ( ) | 
| 3638 |  |  |  |  |  |  | elsif (/\G (\() /oxgc) {                                                           # qq ( ) | 
| 3639 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3640 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3641 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3642 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3643 | 0 |  |  |  |  |  | elsif (/\G (\\\))     /oxgc) { $qq_string .= $1;                          } | 
| 3644 | 0 |  |  |  |  |  | elsif (/\G (\()       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 0 |  |  |  |  |  |  | 
| 3645 |  |  |  |  |  |  | elsif (/\G (\))       /oxgc) { | 
| 3646 | 0 | 0 |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'(',')',$qq_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3647 | 0 |  |  |  |  |  | else                     { $qq_string .= $1;                          } | 
| 3648 |  |  |  |  |  |  | } | 
| 3649 | 0 |  |  |  |  |  | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 3650 |  |  |  |  |  |  | } | 
| 3651 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3652 |  |  |  |  |  |  | } | 
| 3653 |  |  |  |  |  |  |  | 
| 3654 |  |  |  |  |  |  | #               elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq { } | 
| 3655 |  |  |  |  |  |  | elsif (/\G (\{) /oxgc) {                                                           # qq { } | 
| 3656 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3657 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3658 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3659 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3660 | 0 |  |  |  |  |  | elsif (/\G (\\\})     /oxgc) { $qq_string .= $1;                          } | 
| 3661 | 0 |  |  |  |  |  | elsif (/\G (\{)       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 0 |  |  |  |  |  |  | 
| 3662 |  |  |  |  |  |  | elsif (/\G (\})       /oxgc) { | 
| 3663 | 0 | 0 |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'{','}',$qq_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3664 | 0 |  |  |  |  |  | else                     { $qq_string .= $1;                          } | 
| 3665 |  |  |  |  |  |  | } | 
| 3666 | 0 |  |  |  |  |  | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 3667 |  |  |  |  |  |  | } | 
| 3668 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3669 |  |  |  |  |  |  | } | 
| 3670 |  |  |  |  |  |  |  | 
| 3671 |  |  |  |  |  |  | #               elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq [ ] | 
| 3672 |  |  |  |  |  |  | elsif (/\G (\[) /oxgc) {                                                             # qq [ ] | 
| 3673 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3674 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3675 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3676 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3677 | 0 |  |  |  |  |  | elsif (/\G (\\\])     /oxgc) { $qq_string .= $1;                          } | 
| 3678 | 0 |  |  |  |  |  | elsif (/\G (\[)       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 0 |  |  |  |  |  |  | 
| 3679 |  |  |  |  |  |  | elsif (/\G (\])       /oxgc) { | 
| 3680 | 0 | 0 |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'[',']',$qq_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3681 | 0 |  |  |  |  |  | else                     { $qq_string .= $1;                          } | 
| 3682 |  |  |  |  |  |  | } | 
| 3683 | 0 |  |  |  |  |  | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 3684 |  |  |  |  |  |  | } | 
| 3685 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3686 |  |  |  |  |  |  | } | 
| 3687 |  |  |  |  |  |  |  | 
| 3688 |  |  |  |  |  |  | #               elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq < > | 
| 3689 |  |  |  |  |  |  | elsif (/\G (\<) /oxgc) {                                                           # qq < > | 
| 3690 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3691 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3692 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3693 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)     /oxgc) { $qq_string .= $1;                          } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3694 | 0 |  |  |  |  |  | elsif (/\G (\\\>)     /oxgc) { $qq_string .= $1;                          } | 
| 3695 | 0 |  |  |  |  |  | elsif (/\G (\<)       /oxgc) { $qq_string .= $1; $nest++;                 } | 
|  | 0 |  |  |  |  |  |  | 
| 3696 |  |  |  |  |  |  | elsif (/\G (\>)       /oxgc) { | 
| 3697 | 0 | 0 |  |  |  |  | if (--$nest == 0)        { return $e . e_qq($ope,'<','>',$qq_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3698 | 0 |  |  |  |  |  | else                     { $qq_string .= $1;                          } | 
| 3699 |  |  |  |  |  |  | } | 
| 3700 | 0 |  |  |  |  |  | elsif (/\G ($qq_char) /oxgc) { $qq_string .= $1;                          } | 
| 3701 |  |  |  |  |  |  | } | 
| 3702 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3703 |  |  |  |  |  |  | } | 
| 3704 |  |  |  |  |  |  |  | 
| 3705 |  |  |  |  |  |  | #               elsif (/\G (\S) ((?:$qq_char)*?) (\1) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qq * * | 
| 3706 |  |  |  |  |  |  | elsif (/\G (\S) /oxgc) {                                                          # qq * * | 
| 3707 | 0 |  |  |  |  |  | my $delimiter = $1; | 
| 3708 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 3709 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3710 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)             /oxgc) { $qq_string .= $1;                                        } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3711 | 0 |  |  |  |  |  | elsif (/\G (\\\Q$delimiter\E) /oxgc) { $qq_string .= $1;                                        } | 
| 3712 | 0 |  |  |  |  |  | elsif (/\G (\Q$delimiter\E)   /oxgc) { return $e . e_qq($ope,$delimiter,$delimiter,$qq_string); } | 
| 3713 | 0 |  |  |  |  |  | elsif (/\G ($qq_char)         /oxgc) { $qq_string .= $1;                                        } | 
| 3714 |  |  |  |  |  |  | } | 
| 3715 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3716 |  |  |  |  |  |  | } | 
| 3717 |  |  |  |  |  |  | } | 
| 3718 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3719 |  |  |  |  |  |  | } | 
| 3720 |  |  |  |  |  |  | } | 
| 3721 |  |  |  |  |  |  |  | 
| 3722 |  |  |  |  |  |  | # qr// | 
| 3723 |  |  |  |  |  |  | elsif (/\G \b (qr) \b /oxgc) { | 
| 3724 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3725 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ([imosxpadlunbB]*) /oxgc) { # qr# # # | 
| 3726 | 0 |  |  |  |  |  | return e_qr($ope,$1,$3,$2,$4); | 
| 3727 |  |  |  |  |  |  | } | 
| 3728 |  |  |  |  |  |  | else { | 
| 3729 | 0 |  |  |  |  |  | my $e = ''; | 
| 3730 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3731 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                            /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3732 | 0 |  |  |  |  |  | elsif (/\G (\()          ((?:$qq_paren)*?)   (\)) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr ( ) | 
| 3733 | 0 |  |  |  |  |  | elsif (/\G (\{)          ((?:$qq_brace)*?)   (\}) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr { } | 
| 3734 | 0 |  |  |  |  |  | elsif (/\G (\[)          ((?:$qq_bracket)*?) (\]) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr [ ] | 
| 3735 | 0 |  |  |  |  |  | elsif (/\G (\<)          ((?:$qq_angle)*?)   (\>) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr < > | 
| 3736 | 0 |  |  |  |  |  | elsif (/\G (\')          ((?:$qq_char)*?)    (\') ([imosxpadlunbB]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # qr ' ' | 
| 3737 | 0 |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,'{','}',$2,$4); } # qr | | --> qr { } | 
| 3738 | 0 |  |  |  |  |  | elsif (/\G (\S)          ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # qr * * | 
| 3739 |  |  |  |  |  |  | } | 
| 3740 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3741 |  |  |  |  |  |  | } | 
| 3742 |  |  |  |  |  |  | } | 
| 3743 |  |  |  |  |  |  |  | 
| 3744 |  |  |  |  |  |  | # qw// | 
| 3745 |  |  |  |  |  |  | elsif (/\G \b (qw) \b /oxgc) { | 
| 3746 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3747 | 0 | 0 |  |  |  |  | if (/\G (\#) (.*?) (\#) /oxmsgc) { # qw# # | 
| 3748 | 0 |  |  |  |  |  | return e_qw($ope,$1,$3,$2); | 
| 3749 |  |  |  |  |  |  | } | 
| 3750 |  |  |  |  |  |  | else { | 
| 3751 | 0 |  |  |  |  |  | my $e = ''; | 
| 3752 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3753 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                        /oxgc)   { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3754 |  |  |  |  |  |  |  | 
| 3755 | 0 |  |  |  |  |  | elsif (/\G (\()          ([^(]*?)           (\)) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw ( ) | 
| 3756 | 0 |  |  |  |  |  | elsif (/\G (\()          ((?:$q_paren)*?)   (\)) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw ( ) | 
| 3757 |  |  |  |  |  |  |  | 
| 3758 | 0 |  |  |  |  |  | elsif (/\G (\{)          ([^{]*?)           (\}) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw { } | 
| 3759 | 0 |  |  |  |  |  | elsif (/\G (\{)          ((?:$q_brace)*?)   (\}) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw { } | 
| 3760 |  |  |  |  |  |  |  | 
| 3761 | 0 |  |  |  |  |  | elsif (/\G (\[)          ([^[]*?)           (\]) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw [ ] | 
| 3762 | 0 |  |  |  |  |  | elsif (/\G (\[)          ((?:$q_bracket)*?) (\]) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw [ ] | 
| 3763 |  |  |  |  |  |  |  | 
| 3764 | 0 |  |  |  |  |  | elsif (/\G (\<)          ([^<]*?)           (\>) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw < > | 
| 3765 | 0 |  |  |  |  |  | elsif (/\G (\<)          ((?:$q_angle)*?)   (\>) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw < > | 
| 3766 |  |  |  |  |  |  |  | 
| 3767 | 0 |  |  |  |  |  | elsif (/\G ([\x21-\x3F]) (.*?)              (\1) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw * * | 
| 3768 | 0 |  |  |  |  |  | elsif (/\G (\S)          ((?:$q_char)*?)    (\1) /oxmsgc) { return $e . e_qw($ope,$1,$3,$2); } # qw * * | 
| 3769 |  |  |  |  |  |  | } | 
| 3770 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3771 |  |  |  |  |  |  | } | 
| 3772 |  |  |  |  |  |  | } | 
| 3773 |  |  |  |  |  |  |  | 
| 3774 |  |  |  |  |  |  | # qx// | 
| 3775 |  |  |  |  |  |  | elsif (/\G \b (qx) \b /oxgc) { | 
| 3776 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3777 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { # qx# # | 
| 3778 | 0 |  |  |  |  |  | return e_qq($ope,$1,$3,$2); | 
| 3779 |  |  |  |  |  |  | } | 
| 3780 |  |  |  |  |  |  | else { | 
| 3781 | 0 |  |  |  |  |  | my $e = ''; | 
| 3782 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3783 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3784 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx ( ) | 
| 3785 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx { } | 
| 3786 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx [ ] | 
| 3787 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx < > | 
| 3788 | 0 |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?)    (\') /oxgc) { return $e . e_q ($ope,$1,$3,$2); } # qx ' ' | 
| 3789 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) /oxgc) { return $e . e_qq($ope,$1,$3,$2); } # qx * * | 
| 3790 |  |  |  |  |  |  | } | 
| 3791 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3792 |  |  |  |  |  |  | } | 
| 3793 |  |  |  |  |  |  | } | 
| 3794 |  |  |  |  |  |  |  | 
| 3795 |  |  |  |  |  |  | # q// | 
| 3796 |  |  |  |  |  |  | elsif (/\G \b (q) \b /oxgc) { | 
| 3797 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3798 |  |  |  |  |  |  |  | 
| 3799 |  |  |  |  |  |  | #       if (/\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc) { return e_q($ope,$1,$3,$2); } # q# # | 
| 3800 |  |  |  |  |  |  |  | 
| 3801 |  |  |  |  |  |  | # avoid "Error: Runtime exception" of perl version 5.005_03 | 
| 3802 |  |  |  |  |  |  | # (and so on) | 
| 3803 |  |  |  |  |  |  |  | 
| 3804 | 0 | 0 |  |  |  |  | if (/\G (\#) /oxgc) {                                                             # q# # | 
| 3805 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3806 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3807 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                    } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3808 | 0 |  |  |  |  |  | elsif (/\G (\\\#)    /oxgc) { $q_string .= $1;                    } | 
| 3809 | 0 |  |  |  |  |  | elsif (/\G (\#)      /oxgc) { return e_q($ope,'#','#',$q_string); } | 
| 3810 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                    } | 
| 3811 |  |  |  |  |  |  | } | 
| 3812 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3813 |  |  |  |  |  |  | } | 
| 3814 |  |  |  |  |  |  |  | 
| 3815 |  |  |  |  |  |  | else { | 
| 3816 | 0 |  |  |  |  |  | my $e = ''; | 
| 3817 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3818 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                       /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3819 |  |  |  |  |  |  |  | 
| 3820 |  |  |  |  |  |  | #               elsif (/\G (\() ((?:\\\)|\\\\|$q_paren)*?) (\)) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q ( ) | 
| 3821 |  |  |  |  |  |  | elsif (/\G (\() /oxgc) {                                                                   # q ( ) | 
| 3822 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3823 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3824 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3825 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3826 | 0 |  |  |  |  |  | elsif (/\G (\\\))    /oxgc) { $q_string .= $1;                         } | 
| 3827 | 0 |  |  |  |  |  | elsif (/\G (\\\()    /oxgc) { $q_string .= $1;                         } | 
| 3828 | 0 |  |  |  |  |  | elsif (/\G (\()      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 0 |  |  |  |  |  |  | 
| 3829 |  |  |  |  |  |  | elsif (/\G (\))      /oxgc) { | 
| 3830 | 0 | 0 |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'(',')',$q_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3831 | 0 |  |  |  |  |  | else                    { $q_string .= $1;                         } | 
| 3832 |  |  |  |  |  |  | } | 
| 3833 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 3834 |  |  |  |  |  |  | } | 
| 3835 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3836 |  |  |  |  |  |  | } | 
| 3837 |  |  |  |  |  |  |  | 
| 3838 |  |  |  |  |  |  | #               elsif (/\G (\{) ((?:\\\}|\\\\|$q_brace)*?) (\}) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q { } | 
| 3839 |  |  |  |  |  |  | elsif (/\G (\{) /oxgc) {                                                                   # q { } | 
| 3840 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3841 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3842 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3843 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3844 | 0 |  |  |  |  |  | elsif (/\G (\\\})    /oxgc) { $q_string .= $1;                         } | 
| 3845 | 0 |  |  |  |  |  | elsif (/\G (\\\{)    /oxgc) { $q_string .= $1;                         } | 
| 3846 | 0 |  |  |  |  |  | elsif (/\G (\{)      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 0 |  |  |  |  |  |  | 
| 3847 |  |  |  |  |  |  | elsif (/\G (\})      /oxgc) { | 
| 3848 | 0 | 0 |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'{','}',$q_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3849 | 0 |  |  |  |  |  | else                    { $q_string .= $1;                         } | 
| 3850 |  |  |  |  |  |  | } | 
| 3851 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 3852 |  |  |  |  |  |  | } | 
| 3853 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3854 |  |  |  |  |  |  | } | 
| 3855 |  |  |  |  |  |  |  | 
| 3856 |  |  |  |  |  |  | #               elsif (/\G (\[) ((?:\\\]|\\\\|$q_bracket)*?) (\]) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q [ ] | 
| 3857 |  |  |  |  |  |  | elsif (/\G (\[) /oxgc) {                                                                     # q [ ] | 
| 3858 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3859 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3860 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3861 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3862 | 0 |  |  |  |  |  | elsif (/\G (\\\])    /oxgc) { $q_string .= $1;                         } | 
| 3863 | 0 |  |  |  |  |  | elsif (/\G (\\\[)    /oxgc) { $q_string .= $1;                         } | 
| 3864 | 0 |  |  |  |  |  | elsif (/\G (\[)      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 0 |  |  |  |  |  |  | 
| 3865 |  |  |  |  |  |  | elsif (/\G (\])      /oxgc) { | 
| 3866 | 0 | 0 |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'[',']',$q_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3867 | 0 |  |  |  |  |  | else                    { $q_string .= $1;                         } | 
| 3868 |  |  |  |  |  |  | } | 
| 3869 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 3870 |  |  |  |  |  |  | } | 
| 3871 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3872 |  |  |  |  |  |  | } | 
| 3873 |  |  |  |  |  |  |  | 
| 3874 |  |  |  |  |  |  | #               elsif (/\G (\<) ((?:\\\>|\\\\|$q_angle)*?) (\>) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q < > | 
| 3875 |  |  |  |  |  |  | elsif (/\G (\<) /oxgc) {                                                                   # q < > | 
| 3876 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3877 | 0 |  |  |  |  |  | local $nest = 1; | 
| 3878 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3879 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)    /oxgc) { $q_string .= $1;                         } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3880 | 0 |  |  |  |  |  | elsif (/\G (\\\>)    /oxgc) { $q_string .= $1;                         } | 
| 3881 | 0 |  |  |  |  |  | elsif (/\G (\\\<)    /oxgc) { $q_string .= $1;                         } | 
| 3882 | 0 |  |  |  |  |  | elsif (/\G (\<)      /oxgc) { $q_string .= $1; $nest++;                } | 
|  | 0 |  |  |  |  |  |  | 
| 3883 |  |  |  |  |  |  | elsif (/\G (\>)      /oxgc) { | 
| 3884 | 0 | 0 |  |  |  |  | if (--$nest == 0)       { return $e . e_q($ope,'<','>',$q_string); } | 
|  | 0 |  |  |  |  |  |  | 
| 3885 | 0 |  |  |  |  |  | else                    { $q_string .= $1;                         } | 
| 3886 |  |  |  |  |  |  | } | 
| 3887 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $q_string .= $1;                         } | 
| 3888 |  |  |  |  |  |  | } | 
| 3889 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3890 |  |  |  |  |  |  | } | 
| 3891 |  |  |  |  |  |  |  | 
| 3892 |  |  |  |  |  |  | #               elsif (/\G (\S) ((?:\\\1|\\\\|$q_char)*?) (\1) /oxgc) { return $e . e_q($ope,$1,$3,$2); } # q * * | 
| 3893 |  |  |  |  |  |  | elsif (/\G (\S) /oxgc) {                                                                  # q * * | 
| 3894 | 0 |  |  |  |  |  | my $delimiter = $1; | 
| 3895 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 3896 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3897 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)             /oxgc) { $q_string .= $1;                                       } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3898 | 0 |  |  |  |  |  | elsif (/\G (\\\Q$delimiter\E) /oxgc) { $q_string .= $1;                                       } | 
| 3899 | 0 |  |  |  |  |  | elsif (/\G (\Q$delimiter\E)   /oxgc) { return $e . e_q($ope,$delimiter,$delimiter,$q_string); } | 
| 3900 | 0 |  |  |  |  |  | elsif (/\G ($q_char)          /oxgc) { $q_string .= $1;                                       } | 
| 3901 |  |  |  |  |  |  | } | 
| 3902 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3903 |  |  |  |  |  |  | } | 
| 3904 |  |  |  |  |  |  | } | 
| 3905 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 3906 |  |  |  |  |  |  | } | 
| 3907 |  |  |  |  |  |  | } | 
| 3908 |  |  |  |  |  |  |  | 
| 3909 |  |  |  |  |  |  | # m// | 
| 3910 |  |  |  |  |  |  | elsif (/\G \b (m) \b /oxgc) { | 
| 3911 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3912 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc) { # m# # | 
| 3913 | 0 |  |  |  |  |  | return e_qr($ope,$1,$3,$2,$4); | 
| 3914 |  |  |  |  |  |  | } | 
| 3915 |  |  |  |  |  |  | else { | 
| 3916 | 0 |  |  |  |  |  | my $e = ''; | 
| 3917 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3918 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                             /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3919 | 0 |  |  |  |  |  | elsif (/\G (\()         ((?:$qq_paren)*?)   (\)) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m ( ) | 
| 3920 | 0 |  |  |  |  |  | elsif (/\G (\{)         ((?:$qq_brace)*?)   (\}) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m { } | 
| 3921 | 0 |  |  |  |  |  | elsif (/\G (\[)         ((?:$qq_bracket)*?) (\]) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m [ ] | 
| 3922 | 0 |  |  |  |  |  | elsif (/\G (\<)         ((?:$qq_angle)*?)   (\>) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m < > | 
| 3923 | 0 |  |  |  |  |  | elsif (/\G (\?)         ((?:$qq_char)*?)    (\?) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m ? ? | 
| 3924 | 0 |  |  |  |  |  | elsif (/\G (\')         ((?:$qq_char)*?)    (\') ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr_q($ope,$1, $3, $2,$4); } # m ' ' | 
| 3925 | 0 |  |  |  |  |  | elsif (/\G ([*\-:\\^|]) ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,'{','}',$2,$4); } # m | | --> m { } | 
| 3926 | 0 |  |  |  |  |  | elsif (/\G (\S)         ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { return $e . e_qr  ($ope,$1, $3, $2,$4); } # m * * | 
| 3927 |  |  |  |  |  |  | } | 
| 3928 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 3929 |  |  |  |  |  |  | } | 
| 3930 |  |  |  |  |  |  | } | 
| 3931 |  |  |  |  |  |  |  | 
| 3932 |  |  |  |  |  |  | # s/// | 
| 3933 |  |  |  |  |  |  |  | 
| 3934 |  |  |  |  |  |  | # about [cegimosxpradlunbB]* (/cg modifier) | 
| 3935 |  |  |  |  |  |  | # | 
| 3936 |  |  |  |  |  |  | # P.67 Pattern-Matching Operators | 
| 3937 |  |  |  |  |  |  | # of ISBN 0-596-00241-6 Perl in a Nutshell, Second Edition. | 
| 3938 |  |  |  |  |  |  |  | 
| 3939 |  |  |  |  |  |  | elsif (/\G \b (s) \b /oxgc) { | 
| 3940 | 0 |  |  |  |  |  | my $ope = $1; | 
| 3941 |  |  |  |  |  |  |  | 
| 3942 |  |  |  |  |  |  | #        $1   $2               $3   $4               $5   $6 | 
| 3943 | 0 | 0 |  |  |  |  | if (/\G (\#) ((?:$qq_char)*?) (\#) ((?:$qq_char)*?) (\#) ([cegimosxpradlunbB]*) /oxgc) { # s# # # | 
| 3944 | 0 |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 3945 |  |  |  |  |  |  | } | 
| 3946 |  |  |  |  |  |  | else { | 
| 3947 | 0 |  |  |  |  |  | my $e = ''; | 
| 3948 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3949 | 0 | 0 |  |  |  |  | if (/\G ((?>\s+)|\#.*) /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3950 |  |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?) (\)) /oxgc) { | 
| 3951 | 0 |  |  |  |  |  | my @s = ($1,$2,$3); | 
| 3952 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3953 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3954 |  |  |  |  |  |  | #           $1   $2                  $3   $4 | 
| 3955 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3956 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3957 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3958 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3959 | 0 |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3960 | 0 |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3961 | 0 |  |  |  |  |  | elsif (/\G (\:) ((?:$qq_char)*?)    (\:) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3962 | 0 |  |  |  |  |  | elsif (/\G (\@) ((?:$qq_char)*?)    (\@) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3963 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3964 |  |  |  |  |  |  | } | 
| 3965 | 0 |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 3966 |  |  |  |  |  |  | } | 
| 3967 |  |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?) (\}) /oxgc) { | 
| 3968 | 0 |  |  |  |  |  | my @s = ($1,$2,$3); | 
| 3969 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3970 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3971 |  |  |  |  |  |  | #           $1   $2                  $3   $4 | 
| 3972 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3973 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3974 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3975 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3976 | 0 |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3977 | 0 |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3978 | 0 |  |  |  |  |  | elsif (/\G (\:) ((?:$qq_char)*?)    (\:) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3979 | 0 |  |  |  |  |  | elsif (/\G (\@) ((?:$qq_char)*?)    (\@) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3980 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3981 |  |  |  |  |  |  | } | 
| 3982 | 0 |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 3983 |  |  |  |  |  |  | } | 
| 3984 |  |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { | 
| 3985 | 0 |  |  |  |  |  | my @s = ($1,$2,$3); | 
| 3986 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 3987 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 3988 |  |  |  |  |  |  | #           $1   $2                  $3   $4 | 
| 3989 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3990 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3991 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3992 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3993 | 0 |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3994 | 0 |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3995 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 3996 |  |  |  |  |  |  | } | 
| 3997 | 0 |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 3998 |  |  |  |  |  |  | } | 
| 3999 |  |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?) (\>) /oxgc) { | 
| 4000 | 0 |  |  |  |  |  | my @s = ($1,$2,$3); | 
| 4001 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 4002 | 0 | 0 |  |  |  |  | if    (/\G ((?>\s+)|\#.*)                                       /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4003 |  |  |  |  |  |  | #           $1   $2                  $3   $4 | 
| 4004 | 0 |  |  |  |  |  | elsif (/\G (\() ((?:$qq_paren)*?)   (\)) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4005 | 0 |  |  |  |  |  | elsif (/\G (\{) ((?:$qq_brace)*?)   (\}) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4006 | 0 |  |  |  |  |  | elsif (/\G (\[) ((?:$qq_bracket)*?) (\]) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4007 | 0 |  |  |  |  |  | elsif (/\G (\<) ((?:$qq_angle)*?)   (\>) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4008 | 0 |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?)    (\') ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4009 | 0 |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?)    (\$) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4010 | 0 |  |  |  |  |  | elsif (/\G (\:) ((?:$qq_char)*?)    (\:) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4011 | 0 |  |  |  |  |  | elsif (/\G (\@) ((?:$qq_char)*?)    (\@) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4012 | 0 |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?)    (\1) ([cegimosxpradlunbB]*) /oxgc) { return e_sub($sub_variable,@s,$1,$2,$3,$4); } | 
| 4013 |  |  |  |  |  |  | } | 
| 4014 | 0 |  |  |  |  |  | die __FILE__, ": Substitution replacement not terminated\n"; | 
| 4015 |  |  |  |  |  |  | } | 
| 4016 |  |  |  |  |  |  | #           $1   $2               $3   $4               $5   $6 | 
| 4017 |  |  |  |  |  |  | elsif (/\G (\') ((?:$qq_char)*?) (\') ((?:$qq_char)*?) (\') ([cegimosxpradlunbB]*) /oxgc) { | 
| 4018 | 0 |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 4019 |  |  |  |  |  |  | } | 
| 4020 |  |  |  |  |  |  | #           $1            $2               $3   $4               $5   $6 | 
| 4021 |  |  |  |  |  |  | elsif (/\G ([*\-:?\\^|]) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlunbB]*) /oxgc) { | 
| 4022 | 0 |  |  |  |  |  | return e_sub($sub_variable,'{',$2,'}','{',$4,'}',$6); # s | | | --> s { } { } | 
| 4023 |  |  |  |  |  |  | } | 
| 4024 |  |  |  |  |  |  | #           $1   $2               $3   $4               $5   $6 | 
| 4025 |  |  |  |  |  |  | elsif (/\G (\$) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlunbB]*) /oxgc) { | 
| 4026 | 0 |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 4027 |  |  |  |  |  |  | } | 
| 4028 |  |  |  |  |  |  | #           $1   $2               $3   $4               $5   $6 | 
| 4029 |  |  |  |  |  |  | elsif (/\G (\S) ((?:$qq_char)*?) (\1) ((?:$qq_char)*?) (\1) ([cegimosxpradlunbB]*) /oxgc) { | 
| 4030 | 0 |  |  |  |  |  | return e_sub($sub_variable,$1,$2,$3,$3,$4,$5,$6); | 
| 4031 |  |  |  |  |  |  | } | 
| 4032 |  |  |  |  |  |  | } | 
| 4033 | 0 |  |  |  |  |  | die __FILE__, ": Substitution pattern not terminated\n"; | 
| 4034 |  |  |  |  |  |  | } | 
| 4035 |  |  |  |  |  |  | } | 
| 4036 |  |  |  |  |  |  |  | 
| 4037 |  |  |  |  |  |  | # require ignore module | 
| 4038 | 0 |  |  |  |  |  | elsif (/\G \b require ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [#\n])                  /oxmsgc) { return "# require$1$2";     } | 
| 4039 | 0 |  |  |  |  |  | elsif (/\G \b require ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [^#]) /oxmsgc) { return "# require$1\n$2";   } | 
| 4040 | 0 |  |  |  |  |  | elsif (/\G \b require ((?>\s+) (?:$ignore_modules)) \b                                    /oxmsgc) { return "# require$1";       } | 
| 4041 |  |  |  |  |  |  |  | 
| 4042 |  |  |  |  |  |  | # use strict; --> use strict; no strict qw(refs); | 
| 4043 | 0 |  |  |  |  |  | elsif (/\G \b use ((?>\s+) strict .*? ;) ([ \t]* [#\n])                                   /oxmsgc) { return "use$1 no strict qw(refs);$2";   } | 
| 4044 | 0 |  |  |  |  |  | elsif (/\G \b use ((?>\s+) strict .*? ;) ([ \t]* [^#])                  /oxmsgc) { return "use$1 no strict qw(refs);\n$2"; } | 
| 4045 | 0 |  |  |  |  |  | elsif (/\G \b use ((?>\s+) strict) \b                                                     /oxmsgc) { return "use$1; no strict qw(refs)";     } | 
| 4046 |  |  |  |  |  |  |  | 
| 4047 |  |  |  |  |  |  | # use 5.12.0; --> use 5.12.0; no strict qw(refs); | 
| 4048 |  |  |  |  |  |  | elsif (/\G \b use (?>\s+) ((?>([1-9][0-9_]*)(?:\.([0-9_]+))*))  (?>\s*) ; /oxmsgc) { | 
| 4049 | 0 | 0 | 0 |  |  |  | if (($2 >= 6) or (($2 == 5) and ($3 ge '012'))) { | 
|  |  |  | 0 |  |  |  |  | 
| 4050 | 0 |  |  |  |  |  | return "use $1; no strict qw(refs);"; | 
| 4051 |  |  |  |  |  |  | } | 
| 4052 |  |  |  |  |  |  | else { | 
| 4053 | 0 |  |  |  |  |  | return "use $1;"; | 
| 4054 |  |  |  |  |  |  | } | 
| 4055 |  |  |  |  |  |  | } | 
| 4056 |  |  |  |  |  |  | elsif (/\G \b use (?>\s+) ((?>v([0-9][0-9_]*)(?:\.([0-9_]+))*)) (?>\s*) ; /oxmsgc) { | 
| 4057 | 0 | 0 | 0 |  |  |  | if (($2 >= 6) or (($2 == 5) and ($3 >= 12))) { | 
|  |  |  | 0 |  |  |  |  | 
| 4058 | 0 |  |  |  |  |  | return "use $1; no strict qw(refs);"; | 
| 4059 |  |  |  |  |  |  | } | 
| 4060 |  |  |  |  |  |  | else { | 
| 4061 | 0 |  |  |  |  |  | return "use $1;"; | 
| 4062 |  |  |  |  |  |  | } | 
| 4063 |  |  |  |  |  |  | } | 
| 4064 |  |  |  |  |  |  |  | 
| 4065 |  |  |  |  |  |  | # ignore use module | 
| 4066 | 0 |  |  |  |  |  | elsif (/\G \b use ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [#\n])                  /oxmsgc) { return "# use$1$2";         } | 
| 4067 | 0 |  |  |  |  |  | elsif (/\G \b use ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [^#]) /oxmsgc) { return "# use$1\n$2";       } | 
| 4068 | 0 |  |  |  |  |  | elsif (/\G \b use ((?>\s+) (?:$ignore_modules)) \b                                    /oxmsgc) { return "# use$1";           } | 
| 4069 |  |  |  |  |  |  |  | 
| 4070 |  |  |  |  |  |  | # ignore no module | 
| 4071 | 0 |  |  |  |  |  | elsif (/\G \b no  ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [#\n])                  /oxmsgc) { return "# no$1$2";          } | 
| 4072 | 0 |  |  |  |  |  | elsif (/\G \b no  ((?>\s+) (?:$ignore_modules) .*? ;) ([ \t]* [^#]) /oxmsgc) { return "# no$1\n$2";        } | 
| 4073 | 0 |  |  |  |  |  | elsif (/\G \b no  ((?>\s+) (?:$ignore_modules)) \b                                    /oxmsgc) { return "# no$1";            } | 
| 4074 |  |  |  |  |  |  |  | 
| 4075 |  |  |  |  |  |  | # use else | 
| 4076 | 0 |  |  |  |  |  | elsif (/\G \b use \b /oxmsgc) { return "use"; } | 
| 4077 |  |  |  |  |  |  |  | 
| 4078 |  |  |  |  |  |  | # use else | 
| 4079 | 0 |  |  |  |  |  | elsif (/\G \b no  \b /oxmsgc) { return "no";  } | 
| 4080 |  |  |  |  |  |  |  | 
| 4081 |  |  |  |  |  |  | # '' | 
| 4082 |  |  |  |  |  |  | elsif (/\G (? | 
| 4083 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 4084 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 4085 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)                  /oxgc) { $q_string .= $1;                   } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4086 | 0 |  |  |  |  |  | elsif (/\G (\\\')                  /oxgc) { $q_string .= $1;                   } | 
| 4087 | 0 |  |  |  |  |  | elsif (/\G \'                      /oxgc) { return e_q('', "'","'",$q_string); } | 
| 4088 | 0 |  |  |  |  |  | elsif (/\G ($q_char)               /oxgc) { $q_string .= $1;                   } | 
| 4089 |  |  |  |  |  |  | } | 
| 4090 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4091 |  |  |  |  |  |  | } | 
| 4092 |  |  |  |  |  |  |  | 
| 4093 |  |  |  |  |  |  | # "" | 
| 4094 |  |  |  |  |  |  | elsif (/\G (\") /oxgc) { | 
| 4095 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 4096 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 4097 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)                  /oxgc) { $qq_string .= $1;                    } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4098 | 0 |  |  |  |  |  | elsif (/\G (\\\")                  /oxgc) { $qq_string .= $1;                    } | 
| 4099 | 0 |  |  |  |  |  | elsif (/\G \"                      /oxgc) { return e_qq('', '"','"',$qq_string); } | 
| 4100 | 0 |  |  |  |  |  | elsif (/\G ($q_char)               /oxgc) { $qq_string .= $1;                    } | 
| 4101 |  |  |  |  |  |  | } | 
| 4102 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4103 |  |  |  |  |  |  | } | 
| 4104 |  |  |  |  |  |  |  | 
| 4105 |  |  |  |  |  |  | # `` | 
| 4106 |  |  |  |  |  |  | elsif (/\G (\`) /oxgc) { | 
| 4107 | 0 |  |  |  |  |  | my $qx_string = ''; | 
| 4108 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 4109 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)                  /oxgc) { $qx_string .= $1;                    } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4110 | 0 |  |  |  |  |  | elsif (/\G (\\\`)                  /oxgc) { $qx_string .= $1;                    } | 
| 4111 | 0 |  |  |  |  |  | elsif (/\G \`                      /oxgc) { return e_qq('', '`','`',$qx_string); } | 
| 4112 | 0 |  |  |  |  |  | elsif (/\G ($q_char)               /oxgc) { $qx_string .= $1;                    } | 
| 4113 |  |  |  |  |  |  | } | 
| 4114 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4115 |  |  |  |  |  |  | } | 
| 4116 |  |  |  |  |  |  |  | 
| 4117 |  |  |  |  |  |  | # //   --- not divide operator (num / num), not defined-or | 
| 4118 |  |  |  |  |  |  | elsif (($slash eq 'm//') and /\G (\/) /oxgc) { | 
| 4119 | 0 |  |  |  |  |  | my $regexp = ''; | 
| 4120 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 4121 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)                  /oxgc) { $regexp .= $1;                       } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4122 | 0 |  |  |  |  |  | elsif (/\G (\\\/)                  /oxgc) { $regexp .= $1;                       } | 
| 4123 | 0 |  |  |  |  |  | elsif (/\G \/ ([cgimosxpadlunbB]*) /oxgc) { return e_qr('', '/','/',$regexp,$1); } | 
| 4124 | 0 |  |  |  |  |  | elsif (/\G ($q_char)               /oxgc) { $regexp .= $1;                       } | 
| 4125 |  |  |  |  |  |  | } | 
| 4126 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 4127 |  |  |  |  |  |  | } | 
| 4128 |  |  |  |  |  |  |  | 
| 4129 |  |  |  |  |  |  | # ??   --- not conditional operator (condition ? then : else) | 
| 4130 |  |  |  |  |  |  | elsif (($slash eq 'm//') and /\G (\?) /oxgc) { | 
| 4131 | 0 |  |  |  |  |  | my $regexp = ''; | 
| 4132 | 0 |  |  |  |  |  | while (not /\G \z/oxgc) { | 
| 4133 | 0 | 0 |  |  |  |  | if    (/\G (\\\\)                  /oxgc) { $regexp .= $1;                       } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4134 | 0 |  |  |  |  |  | elsif (/\G (\\\?)                  /oxgc) { $regexp .= $1;                       } | 
| 4135 | 0 |  |  |  |  |  | elsif (/\G \? ([cgimosxpadlunbB]*) /oxgc) { return e_qr('m','?','?',$regexp,$1); } | 
| 4136 | 0 |  |  |  |  |  | elsif (/\G ($q_char)               /oxgc) { $regexp .= $1;                       } | 
| 4137 |  |  |  |  |  |  | } | 
| 4138 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 4139 |  |  |  |  |  |  | } | 
| 4140 |  |  |  |  |  |  |  | 
| 4141 |  |  |  |  |  |  | # <<>> (a safer ARGV) | 
| 4142 | 0 |  |  |  |  |  | elsif (/\G ( <<>> ) /oxgc)                         { $slash = 'm//'; return $1;          } | 
|  | 0 |  |  |  |  |  |  | 
| 4143 |  |  |  |  |  |  |  | 
| 4144 |  |  |  |  |  |  | # << (bit shift)   --- not here document | 
| 4145 | 0 |  |  |  |  |  | elsif (/\G ( << (?>\s*) ) (?= [0-9\$\@\&] ) /oxgc) { $slash = 'm//'; return $1;          } | 
|  | 0 |  |  |  |  |  |  | 
| 4146 |  |  |  |  |  |  |  | 
| 4147 |  |  |  |  |  |  | # <<'HEREDOC' | 
| 4148 |  |  |  |  |  |  | elsif (/\G ( << '([a-zA-Z_0-9]*)' ) /oxgc) { | 
| 4149 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4150 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4151 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4152 |  |  |  |  |  |  |  | 
| 4153 |  |  |  |  |  |  | # get here document | 
| 4154 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4155 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4156 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4157 |  |  |  |  |  |  | } | 
| 4158 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4159 | 0 |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 4160 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4161 |  |  |  |  |  |  | } | 
| 4162 |  |  |  |  |  |  | else { | 
| 4163 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4164 |  |  |  |  |  |  | } | 
| 4165 | 0 |  |  |  |  |  | return $here_quote; | 
| 4166 |  |  |  |  |  |  | } | 
| 4167 |  |  |  |  |  |  |  | 
| 4168 |  |  |  |  |  |  | # <<\HEREDOC | 
| 4169 |  |  |  |  |  |  |  | 
| 4170 |  |  |  |  |  |  | # P.66 2.6.6. "Here" Documents | 
| 4171 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 4172 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 4173 |  |  |  |  |  |  |  | 
| 4174 |  |  |  |  |  |  | # P.73 "Here" Documents | 
| 4175 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 4176 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 4177 |  |  |  |  |  |  |  | 
| 4178 |  |  |  |  |  |  | elsif (/\G ( << \\([a-zA-Z_0-9]+) ) /oxgc) { | 
| 4179 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4180 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4181 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4182 |  |  |  |  |  |  |  | 
| 4183 |  |  |  |  |  |  | # get here document | 
| 4184 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4185 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4186 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4187 |  |  |  |  |  |  | } | 
| 4188 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4189 | 0 |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 4190 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4191 |  |  |  |  |  |  | } | 
| 4192 |  |  |  |  |  |  | else { | 
| 4193 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4194 |  |  |  |  |  |  | } | 
| 4195 | 0 |  |  |  |  |  | return $here_quote; | 
| 4196 |  |  |  |  |  |  | } | 
| 4197 |  |  |  |  |  |  |  | 
| 4198 |  |  |  |  |  |  | # <<"HEREDOC" | 
| 4199 |  |  |  |  |  |  | elsif (/\G ( << "([a-zA-Z_0-9]*)" ) /oxgc) { | 
| 4200 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4201 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4202 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4203 |  |  |  |  |  |  |  | 
| 4204 |  |  |  |  |  |  | # get here document | 
| 4205 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4206 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4207 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4208 |  |  |  |  |  |  | } | 
| 4209 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4210 | 0 |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 4211 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4212 |  |  |  |  |  |  | } | 
| 4213 |  |  |  |  |  |  | else { | 
| 4214 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4215 |  |  |  |  |  |  | } | 
| 4216 | 0 |  |  |  |  |  | return $here_quote; | 
| 4217 |  |  |  |  |  |  | } | 
| 4218 |  |  |  |  |  |  |  | 
| 4219 |  |  |  |  |  |  | # < | 
| 4220 |  |  |  |  |  |  | elsif (/\G ( << ([a-zA-Z_0-9]+) ) /oxgc) { | 
| 4221 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4222 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4223 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4224 |  |  |  |  |  |  |  | 
| 4225 |  |  |  |  |  |  | # get here document | 
| 4226 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4227 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4228 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4229 |  |  |  |  |  |  | } | 
| 4230 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4231 | 0 |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 4232 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4233 |  |  |  |  |  |  | } | 
| 4234 |  |  |  |  |  |  | else { | 
| 4235 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4236 |  |  |  |  |  |  | } | 
| 4237 | 0 |  |  |  |  |  | return $here_quote; | 
| 4238 |  |  |  |  |  |  | } | 
| 4239 |  |  |  |  |  |  |  | 
| 4240 |  |  |  |  |  |  | # <<`HEREDOC` | 
| 4241 |  |  |  |  |  |  | elsif (/\G ( << `([a-zA-Z_0-9]*)` ) /oxgc) { | 
| 4242 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4243 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4244 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4245 |  |  |  |  |  |  |  | 
| 4246 |  |  |  |  |  |  | # get here document | 
| 4247 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4248 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4249 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4250 |  |  |  |  |  |  | } | 
| 4251 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4252 | 0 |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 4253 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4254 |  |  |  |  |  |  | } | 
| 4255 |  |  |  |  |  |  | else { | 
| 4256 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4257 |  |  |  |  |  |  | } | 
| 4258 | 0 |  |  |  |  |  | return $here_quote; | 
| 4259 |  |  |  |  |  |  | } | 
| 4260 |  |  |  |  |  |  |  | 
| 4261 |  |  |  |  |  |  | # <<= <=> <= < operator | 
| 4262 |  |  |  |  |  |  | elsif (/\G ( <<= | <=> | <= | < ) (?= (?>\s*) [A-Za-z_0-9'"`\$\@\&\*\(\+\-] )/oxgc) { | 
| 4263 | 0 |  |  |  |  |  | return $1; | 
| 4264 |  |  |  |  |  |  | } | 
| 4265 |  |  |  |  |  |  |  | 
| 4266 |  |  |  |  |  |  | # | 
| 4267 |  |  |  |  |  |  | elsif (/\G (<[\$]?[A-Za-z_][A-Za-z_0-9]*>) /oxgc) { | 
| 4268 | 0 |  |  |  |  |  | return $1; | 
| 4269 |  |  |  |  |  |  | } | 
| 4270 |  |  |  |  |  |  |  | 
| 4271 |  |  |  |  |  |  | #  --- glob | 
| 4272 |  |  |  |  |  |  |  | 
| 4273 |  |  |  |  |  |  | # avoid "Error: Runtime exception" of perl version 5.005_03 | 
| 4274 |  |  |  |  |  |  |  | 
| 4275 |  |  |  |  |  |  | elsif (/\G < ((?:[^>\0\a\e\f\n\r\t])+?) > /oxgc) { | 
| 4276 | 0 |  |  |  |  |  | return 'Elatin6::glob("' . $1 . '")'; | 
| 4277 |  |  |  |  |  |  | } | 
| 4278 |  |  |  |  |  |  |  | 
| 4279 |  |  |  |  |  |  | # __DATA__ | 
| 4280 | 0 |  |  |  |  |  | elsif (/\G ^ ( __DATA__ \n .*) \z /oxmsgc) { return $1; } | 
| 4281 |  |  |  |  |  |  |  | 
| 4282 |  |  |  |  |  |  | # __END__ | 
| 4283 | 0 |  |  |  |  |  | elsif (/\G ^ ( __END__  \n .*) \z /oxmsgc) { return $1; } | 
| 4284 |  |  |  |  |  |  |  | 
| 4285 |  |  |  |  |  |  | # \cD Control-D | 
| 4286 |  |  |  |  |  |  |  | 
| 4287 |  |  |  |  |  |  | # P.68 2.6.8. Other Literal Tokens | 
| 4288 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 4289 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 4290 |  |  |  |  |  |  |  | 
| 4291 |  |  |  |  |  |  | # P.76 Other Literal Tokens | 
| 4292 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 4293 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 4294 |  |  |  |  |  |  |  | 
| 4295 | 0 |  |  |  |  |  | elsif (/\G   ( \cD         .*) \z /oxmsgc) { return $1; } | 
| 4296 |  |  |  |  |  |  |  | 
| 4297 |  |  |  |  |  |  | # \cZ Control-Z | 
| 4298 | 0 |  |  |  |  |  | elsif (/\G   ( \cZ         .*) \z /oxmsgc) { return $1; } | 
| 4299 |  |  |  |  |  |  |  | 
| 4300 |  |  |  |  |  |  | # any operator before div | 
| 4301 |  |  |  |  |  |  | elsif (/\G ( | 
| 4302 |  |  |  |  |  |  | -- | \+\+ | | 
| 4303 |  |  |  |  |  |  | [\)\}\]] | 
| 4304 |  |  |  |  |  |  |  | 
| 4305 | 0 |  |  |  |  |  | ) /oxgc) { $slash = 'div'; return $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 4306 |  |  |  |  |  |  |  | 
| 4307 |  |  |  |  |  |  | # yada-yada or triple-dot operator | 
| 4308 |  |  |  |  |  |  | elsif (/\G ( | 
| 4309 |  |  |  |  |  |  | \.\.\. | 
| 4310 |  |  |  |  |  |  |  | 
| 4311 | 0 |  |  |  |  |  | ) /oxgc) { $slash = 'm//'; return q{die('Unimplemented')}; } | 
|  | 0 |  |  |  |  |  |  | 
| 4312 |  |  |  |  |  |  |  | 
| 4313 |  |  |  |  |  |  | # any operator before m// | 
| 4314 |  |  |  |  |  |  |  | 
| 4315 |  |  |  |  |  |  | # //, //= (defined-or) | 
| 4316 |  |  |  |  |  |  |  | 
| 4317 |  |  |  |  |  |  | # P.164 Logical Operators | 
| 4318 |  |  |  |  |  |  | # in Chapter 10: More Control Structures | 
| 4319 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 4320 |  |  |  |  |  |  |  | 
| 4321 |  |  |  |  |  |  | # P.119 C-Style Logical (Short-Circuit) Operators | 
| 4322 |  |  |  |  |  |  | # in Chapter 3: Unary and Binary Operators | 
| 4323 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 4324 |  |  |  |  |  |  |  | 
| 4325 |  |  |  |  |  |  | # (and so on) | 
| 4326 |  |  |  |  |  |  |  | 
| 4327 |  |  |  |  |  |  | # ~~ | 
| 4328 |  |  |  |  |  |  |  | 
| 4329 |  |  |  |  |  |  | # P.221 The Smart Match Operator | 
| 4330 |  |  |  |  |  |  | # in Chapter 15: Smart Matching and given-when | 
| 4331 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 4332 |  |  |  |  |  |  |  | 
| 4333 |  |  |  |  |  |  | # P.112 Smartmatch Operator | 
| 4334 |  |  |  |  |  |  | # in Chapter 3: Unary and Binary Operators | 
| 4335 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 4336 |  |  |  |  |  |  |  | 
| 4337 |  |  |  |  |  |  | # (and so on) | 
| 4338 |  |  |  |  |  |  |  | 
| 4339 |  |  |  |  |  |  | elsif (/\G ((?> | 
| 4340 |  |  |  |  |  |  |  | 
| 4341 |  |  |  |  |  |  | !~~ | !~ | != | ! | | 
| 4342 |  |  |  |  |  |  | %= | % | | 
| 4343 |  |  |  |  |  |  | &&= | && | &= | &\.= | &\. | & | | 
| 4344 |  |  |  |  |  |  | -= | -> | - | | 
| 4345 |  |  |  |  |  |  | :(?>\s*)= | | 
| 4346 |  |  |  |  |  |  | : | | 
| 4347 |  |  |  |  |  |  | <<>> | | 
| 4348 |  |  |  |  |  |  | <<= | <=> | <= | < | | 
| 4349 |  |  |  |  |  |  | == | => | =~ | = | | 
| 4350 |  |  |  |  |  |  | >>= | >> | >= | > | | 
| 4351 |  |  |  |  |  |  | \*\*= | \*\* | \*= | \* | | 
| 4352 |  |  |  |  |  |  | \+= | \+ | | 
| 4353 |  |  |  |  |  |  | \.\. | \.= | \. | | 
| 4354 |  |  |  |  |  |  | \/\/= | \/\/ | | 
| 4355 |  |  |  |  |  |  | \/= | \/ | | 
| 4356 |  |  |  |  |  |  | \? | | 
| 4357 |  |  |  |  |  |  | \\ | | 
| 4358 |  |  |  |  |  |  | \^= | \^\.= | \^\. | \^ | | 
| 4359 |  |  |  |  |  |  | \b x= | | 
| 4360 |  |  |  |  |  |  | \|\|= | \|\| | \|= | \|\.= | \|\. | \| | | 
| 4361 |  |  |  |  |  |  | ~~ | ~\. | ~ | | 
| 4362 |  |  |  |  |  |  | \b(?: and | cmp | eq | ge | gt | le | lt | ne | not | or | xor | x )\b | | 
| 4363 |  |  |  |  |  |  | \b(?: print )\b | | 
| 4364 |  |  |  |  |  |  |  | 
| 4365 |  |  |  |  |  |  | [,;\(\{\[] | 
| 4366 |  |  |  |  |  |  |  | 
| 4367 | 0 |  |  |  |  |  | )) /oxgc) { $slash = 'm//'; return $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 4368 |  |  |  |  |  |  |  | 
| 4369 |  |  |  |  |  |  | # other any character | 
| 4370 | 0 |  |  |  |  |  | elsif (/\G ($q_char) /oxgc) { $slash = 'div'; return $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 4371 |  |  |  |  |  |  |  | 
| 4372 |  |  |  |  |  |  | # system error | 
| 4373 |  |  |  |  |  |  | else { | 
| 4374 | 0 |  |  |  |  |  | die __FILE__, ": Oops, this shouldn't happen!\n"; | 
| 4375 |  |  |  |  |  |  | } | 
| 4376 |  |  |  |  |  |  | } | 
| 4377 |  |  |  |  |  |  |  | 
| 4378 |  |  |  |  |  |  | # escape Latin-6 string | 
| 4379 |  |  |  |  |  |  | sub e_string { | 
| 4380 | 0 |  |  | 0 | 0 |  | my($string) = @_; | 
| 4381 | 0 |  |  |  |  |  | my $e_string = ''; | 
| 4382 |  |  |  |  |  |  |  | 
| 4383 | 0 |  |  |  |  |  | local $slash = 'm//'; | 
| 4384 |  |  |  |  |  |  |  | 
| 4385 |  |  |  |  |  |  | # P.1024 Appendix W.10 Multibyte Processing | 
| 4386 |  |  |  |  |  |  | # of ISBN 1-56592-224-7 CJKV Information Processing | 
| 4387 |  |  |  |  |  |  | # (and so on) | 
| 4388 |  |  |  |  |  |  |  | 
| 4389 | 0 |  |  |  |  |  | my @char = $string =~ / \G (?>[^\\]|\\$q_char|$q_char) /oxmsg; | 
| 4390 |  |  |  |  |  |  |  | 
| 4391 |  |  |  |  |  |  | # without { ... } | 
| 4392 | 0 | 0 | 0 |  |  |  | if (not (grep(/\A \{ \z/xms, @char) and grep(/\A \} \z/xms, @char))) { | 
| 4393 | 0 | 0 |  |  |  |  | if ($string !~ /< | 
| 4394 | 0 |  |  |  |  |  | return $string; | 
| 4395 |  |  |  |  |  |  | } | 
| 4396 |  |  |  |  |  |  | } | 
| 4397 |  |  |  |  |  |  |  | 
| 4398 |  |  |  |  |  |  | E_STRING_LOOP: | 
| 4399 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4400 | 0 | 0 |  |  |  |  | if (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 |  |  |  |  |  | 
|  |  | 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 |  |  |  |  |  | 
| 4401 |  |  |  |  |  |  | } | 
| 4402 |  |  |  |  |  |  |  | 
| 4403 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> @{[Elatin6::PREMATCH()]} | 
| 4404 | 0 |  |  |  |  |  | elsif ($string =~ /\G ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  \b | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) /oxmsgc) { | 
| 4405 | 0 |  |  |  |  |  | $e_string .= q{Elatin6::PREMATCH()}; | 
| 4406 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4407 |  |  |  |  |  |  | } | 
| 4408 |  |  |  |  |  |  |  | 
| 4409 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> @{[Elatin6::MATCH()]} | 
| 4410 |  |  |  |  |  |  | elsif ($string =~ /\G ( \$& | \$\{&\} | \$ (?>\s*) MATCH     \b | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) /oxmsgc) { | 
| 4411 | 0 |  |  |  |  |  | $e_string .= q{Elatin6::MATCH()}; | 
| 4412 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4413 |  |  |  |  |  |  | } | 
| 4414 |  |  |  |  |  |  |  | 
| 4415 |  |  |  |  |  |  | # $', ${'} --> $', ${'} | 
| 4416 |  |  |  |  |  |  | elsif ($string =~ /\G ( \$' | \$\{'\}                                                                                                     ) /oxmsgc) { | 
| 4417 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4418 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4419 |  |  |  |  |  |  | } | 
| 4420 |  |  |  |  |  |  |  | 
| 4421 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> @{[Elatin6::POSTMATCH()]} | 
| 4422 |  |  |  |  |  |  | elsif ($string =~ /\G (                 \$ (?>\s*) POSTMATCH \b | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) /oxmsgc) { | 
| 4423 | 0 |  |  |  |  |  | $e_string .= q{Elatin6::POSTMATCH()}; | 
| 4424 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4425 |  |  |  |  |  |  | } | 
| 4426 |  |  |  |  |  |  |  | 
| 4427 |  |  |  |  |  |  | # bareword | 
| 4428 |  |  |  |  |  |  | elsif ($string =~ /\G ( \{ (?>\s*) (?: tr | index | rindex | reverse ) (?>\s*) \} ) /oxmsgc) { | 
| 4429 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4430 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4431 |  |  |  |  |  |  | } | 
| 4432 |  |  |  |  |  |  |  | 
| 4433 |  |  |  |  |  |  | # $0 --> $0 | 
| 4434 |  |  |  |  |  |  | elsif ($string =~ /\G ( \$ 0 ) /oxmsgc) { | 
| 4435 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4436 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4437 |  |  |  |  |  |  | } | 
| 4438 |  |  |  |  |  |  | elsif ($string =~ /\G ( \$ \{ (?>\s*) 0 (?>\s*) \} ) /oxmsgc) { | 
| 4439 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4440 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4441 |  |  |  |  |  |  | } | 
| 4442 |  |  |  |  |  |  |  | 
| 4443 |  |  |  |  |  |  | # $$ --> $$ | 
| 4444 |  |  |  |  |  |  | elsif ($string =~ /\G ( \$ \$ ) (?![\w\{]) /oxmsgc) { | 
| 4445 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4446 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4447 |  |  |  |  |  |  | } | 
| 4448 |  |  |  |  |  |  |  | 
| 4449 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 4450 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 4451 |  |  |  |  |  |  | elsif ($string =~ /\G \$ ((?>[1-9][0-9]*)) /oxmsgc) { | 
| 4452 | 0 |  |  |  |  |  | $e_string .= e_capture($1); | 
| 4453 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4454 |  |  |  |  |  |  | } | 
| 4455 |  |  |  |  |  |  | elsif ($string =~ /\G \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} /oxmsgc) { | 
| 4456 | 0 |  |  |  |  |  | $e_string .= e_capture($1); | 
| 4457 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4458 |  |  |  |  |  |  | } | 
| 4459 |  |  |  |  |  |  |  | 
| 4460 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 4461 |  |  |  |  |  |  | elsif ($string =~ /\G \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ .+? \] ) /oxmsgc) { | 
| 4462 | 0 |  |  |  |  |  | $e_string .= e_capture($1.'->'.$2); | 
| 4463 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4464 |  |  |  |  |  |  | } | 
| 4465 |  |  |  |  |  |  |  | 
| 4466 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 4467 |  |  |  |  |  |  | elsif ($string =~ /\G \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ .+? \} ) /oxmsgc) { | 
| 4468 | 0 |  |  |  |  |  | $e_string .= e_capture($1.'->'.$2); | 
| 4469 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4470 |  |  |  |  |  |  | } | 
| 4471 |  |  |  |  |  |  |  | 
| 4472 |  |  |  |  |  |  | # $$foo | 
| 4473 |  |  |  |  |  |  | elsif ($string =~ /\G \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) /oxmsgc) { | 
| 4474 | 0 |  |  |  |  |  | $e_string .= e_capture($1); | 
| 4475 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4476 |  |  |  |  |  |  | } | 
| 4477 |  |  |  |  |  |  |  | 
| 4478 |  |  |  |  |  |  | # ${ foo } | 
| 4479 |  |  |  |  |  |  | elsif ($string =~ /\G \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \} /oxmsgc) { | 
| 4480 | 0 |  |  |  |  |  | $e_string .= '${' . $1 . '}'; | 
| 4481 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4482 |  |  |  |  |  |  | } | 
| 4483 |  |  |  |  |  |  |  | 
| 4484 |  |  |  |  |  |  | # ${ ... } | 
| 4485 |  |  |  |  |  |  | elsif ($string =~ /\G \$ (?>\s*) \{ (?>\s*) ( $qq_brace ) (?>\s*) \} /oxmsgc) { | 
| 4486 | 0 |  |  |  |  |  | $e_string .= e_capture($1); | 
| 4487 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4488 |  |  |  |  |  |  | } | 
| 4489 |  |  |  |  |  |  |  | 
| 4490 |  |  |  |  |  |  | # variable or function | 
| 4491 |  |  |  |  |  |  | #                             $ @ % & *     $ # | 
| 4492 |  |  |  |  |  |  | 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) { | 
| 4493 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4494 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4495 |  |  |  |  |  |  | } | 
| 4496 |  |  |  |  |  |  | #                           $ $ $ $ $ $ $ $ $ $ $ $ $ $ | 
| 4497 |  |  |  |  |  |  | #                           $ @ # \ ' " / ? ( ) [ ] < > | 
| 4498 |  |  |  |  |  |  | elsif ($string =~ /\G ( \$[\$\@\#\\\'\"\/\?\(\)\[\]\<\>] ) /oxmsgc) { | 
| 4499 | 0 |  |  |  |  |  | $e_string .= $1; | 
| 4500 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4501 |  |  |  |  |  |  | } | 
| 4502 |  |  |  |  |  |  |  | 
| 4503 |  |  |  |  |  |  | # subroutines of package Elatin6 | 
| 4504 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b (CORE:: | ->(>?\s*) (?: atan2 | [a-z]{2,})) \b       /oxgc) { $e_string .= $1;                  $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4505 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Char::eval       (?= (?>\s*) \{ )                    /oxgc) { $e_string .= 'eval';              $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4506 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Latin6::eval       (?= (?>\s*) \{ )                    /oxgc) { $e_string .= 'eval';              $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4507 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Char::eval \b                                        /oxgc) { $e_string .= 'eval Char::escape'; $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4508 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Latin6::eval \b                                        /oxgc) { $e_string .= 'eval Latin6::escape'; $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4509 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::substr \b                                     /oxgc) { $e_string .= 'substr';            $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4510 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b chop \b                                              /oxgc) { $e_string .= 'Elatin6::chop';       $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4511 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::index \b                                      /oxgc) { $e_string .= 'index';             $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4512 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Char::index \b                                       /oxgc) { $e_string .= 'Char::index';       $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4513 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Latin6::index \b                                       /oxgc) { $e_string .= 'Latin6::index';       $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4514 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b index \b                                             /oxgc) { $e_string .= 'Elatin6::index';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4515 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::rindex \b                                     /oxgc) { $e_string .= 'rindex';            $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4516 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Char::rindex \b                                      /oxgc) { $e_string .= 'Char::rindex';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4517 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b Latin6::rindex \b                                      /oxgc) { $e_string .= 'Latin6::rindex';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4518 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b rindex \b                                            /oxgc) { $e_string .= 'Elatin6::rindex';     $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4519 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b lc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::lc';         $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4520 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b lcfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::lcfirst';    $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4521 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b uc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::uc';         $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4522 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b ucfirst (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::ucfirst';    $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4523 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b fc      (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::fc';         $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4524 |  |  |  |  |  |  |  | 
| 4525 |  |  |  |  |  |  | # "-s '' ..." means file test "-s 'filename' ..." (not means "- s/// ...") | 
| 4526 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                                         (?>\s*) (\") ((?:$qq_char)+?)                (\") /oxgc) { $e_string .= '-s ' . e_qq('',  $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4527 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\#) ((?:$qq_char)+?)                (\#) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4528 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\() ((?:$qq_paren)+?)               (\)) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4529 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\{) ((?:$qq_brace)+?)               (\}) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4530 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\[) ((?:$qq_bracket)+?)             (\]) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4531 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) qq (?>\s*) (\<) ((?:$qq_angle)+?)               (\>) /oxgc) { $e_string .= '-s ' . e_qq('qq',$1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4532 | 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 |  |  |  |  |  |  | 
| 4533 |  |  |  |  |  |  |  | 
| 4534 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                                         (?>\s*) (\') ((?:\\\'|\\\\|$q_char)+?)       (\') /oxgc) { $e_string .= '-s ' . e_q ('',  $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4535 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\#) ((?:\\\#|\\\\|$q_char)+?)       (\#) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4536 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\() ((?:\\\)|\\\\|$q_paren)+?)      (\)) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4537 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\{) ((?:\\\}|\\\\|$q_brace)+?)      (\}) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4538 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\[) ((?:\\\]|\\\\|$q_bracket)+?)    (\]) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4539 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\<) ((?:\\\>|\\\\|$q_angle)+?)      (\>) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4540 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) q  (?>\s*) (\S) ((?:\\\1|\\\\|$q_char)+?)       (\1) /oxgc) { $e_string .= '-s ' . e_q ('q', $1,$3,$2); $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4541 |  |  |  |  |  |  |  | 
| 4542 |  |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s*) (\$ (?> \w+ (?: ::\w+)*) (?: (?: ->)? (?: [\$\@\%\&\*]\* | \$\#\* | \( (?:$qq_paren)*? \) | [\@\%\*]? \{ (?:$qq_brace)+? \} | [\@\%]? \[ (?:$qq_bracket)+? \] ))*) /oxgc) | 
| 4543 | 0 |  |  |  |  |  | { $e_string .= "-s $1";   $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4544 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s*) \( ((?:$qq_paren)*?) \)                              /oxgc) { $e_string .= "-s ($1)"; $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4545 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?= (?>\s+) [a-z]+)                                          /oxgc) { $e_string .= '-s';      $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4546 | 0 |  |  |  |  |  | elsif ($string =~ /\G -s                              (?>\s+) ((?>\w+))                                            /oxgc) { $e_string .= "-s $1";   $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4547 |  |  |  |  |  |  |  | 
| 4548 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::length (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'length';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4549 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::chr    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'chr';                  $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4550 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b chr           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::chr';           $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4551 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::ord    (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'ord';                  $slash = 'div'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4552 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b ord           (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= $function_ord;          $slash = 'div'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4553 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b glob          (?= (?>\s+)[A-Za-z_]|(?>\s*)['"`\$\@\&\*\(]) /oxgc) { $e_string .= 'Elatin6::glob';          $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4554 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b lc \b                                                      /oxgc) { $e_string .= 'Elatin6::lc_';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4555 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b lcfirst \b                                                 /oxgc) { $e_string .= 'Elatin6::lcfirst_';          $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4556 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b uc \b                                                      /oxgc) { $e_string .= 'Elatin6::uc_';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4557 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b ucfirst \b                                                 /oxgc) { $e_string .= 'Elatin6::ucfirst_';          $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4558 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b fc \b                                                      /oxgc) { $e_string .= 'Elatin6::fc_';               $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4559 | 0 |  |  |  |  |  | elsif ($string =~ /\G    -s                              \b                         /oxgc) { $e_string .= '-s ';                      $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4560 |  |  |  |  |  |  |  | 
| 4561 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::length \b                                           /oxgc) { $e_string .= 'length';                   $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4562 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::chr \b                                              /oxgc) { $e_string .= 'chr';                      $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4563 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b chr \b                                                     /oxgc) { $e_string .= 'Elatin6::chr_';              $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4564 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b bytes::ord \b                                              /oxgc) { $e_string .= 'ord';                      $slash = 'div'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4565 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b ord \b                                                     /oxgc) { $e_string .= $function_ord_;             $slash = 'div'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4566 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b glob \b                                                    /oxgc) { $e_string .= 'Elatin6::glob_';             $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4567 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b reverse \b                                                 /oxgc) { $e_string .= $function_reverse;          $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4568 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b getc \b                                                    /oxgc) { $e_string .= $function_getc;             $slash = 'm//'; } | 
|  | 0 |  |  |  |  |  |  | 
| 4569 |  |  |  |  |  |  | # split | 
| 4570 |  |  |  |  |  |  | elsif ($string =~ /\G \b (split) \b (?! (?>\s*) => ) /oxgc) { | 
| 4571 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4572 |  |  |  |  |  |  |  | 
| 4573 | 0 |  |  |  |  |  | my $e = ''; | 
| 4574 | 0 |  |  |  |  |  | while ($string =~ /\G ( (?>\s+) | \( | \#.* ) /oxgc) { | 
| 4575 | 0 |  |  |  |  |  | $e .= $1; | 
| 4576 |  |  |  |  |  |  | } | 
| 4577 |  |  |  |  |  |  |  | 
| 4578 |  |  |  |  |  |  | # end of split | 
| 4579 | 0 | 0 |  |  |  |  | if    ($string =~ /\G (?= [,;\)\}\]] )          /oxgc) { return 'Elatin6::split' . $e;                                           } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4580 |  |  |  |  |  |  |  | 
| 4581 |  |  |  |  |  |  | # split scalar value | 
| 4582 | 0 |  |  |  |  |  | elsif ($string =~ /\G ( [\$\@\&\*] $qq_scalar ) /oxgc) { $e_string .= 'Elatin6::split' . $e . e_string($1);  next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4583 |  |  |  |  |  |  |  | 
| 4584 |  |  |  |  |  |  | # split literal space | 
| 4585 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b qq           (\#) [ ] (\#) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq  {qq$1 $2}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4586 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b qq ((?>\s*)) (\() [ ] (\)) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4587 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b qq ((?>\s*)) (\{) [ ] (\}) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4588 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b qq ((?>\s*)) (\[) [ ] (\]) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4589 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b qq ((?>\s*)) (\<) [ ] (\>) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4590 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b qq ((?>\s*)) (\S) [ ] (\2) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq{$1qq$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4591 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b q            (\#) [ ] (\#) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq   {q$1 $2}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4592 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b q  ((?>\s*)) (\() [ ] (\)) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4593 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b q  ((?>\s*)) (\{) [ ] (\}) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4594 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b q  ((?>\s*)) (\[) [ ] (\]) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4595 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b q  ((?>\s*)) (\<) [ ] (\>) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4596 | 0 |  |  |  |  |  | elsif ($string =~ /\G \b q  ((?>\s*)) (\S) [ ] (\2) /oxgc) { $e_string .= 'Elatin6::split' . $e . qq {$1q$2 $3}; next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4597 | 0 |  |  |  |  |  | elsif ($string =~ /\G                    ' [ ] '    /oxgc) { $e_string .= 'Elatin6::split' . $e . qq     {' '};  next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4598 | 0 |  |  |  |  |  | elsif ($string =~ /\G                    " [ ] "    /oxgc) { $e_string .= 'Elatin6::split' . $e . qq     {" "};  next E_STRING_LOOP; } | 
|  | 0 |  |  |  |  |  |  | 
| 4599 |  |  |  |  |  |  |  | 
| 4600 |  |  |  |  |  |  | # split qq// | 
| 4601 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qq) \b /oxgc) { | 
| 4602 | 0 | 0 |  |  |  |  | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc)                        { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq# #  --> qr # # | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 4603 |  |  |  |  |  |  | else { | 
| 4604 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4605 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                         /oxgc) { $e_string .= $e . $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4606 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\()          ((?:$qq_paren)*?)   (\)) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq ( ) --> qr ( ) | 
|  | 0 |  |  |  |  |  |  | 
| 4607 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\{)          ((?:$qq_brace)*?)   (\}) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq { } --> qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4608 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\[)          ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq [ ] --> qr [ ] | 
|  | 0 |  |  |  |  |  |  | 
| 4609 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\<)          ((?:$qq_angle)*?)   (\>) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq < > --> qr < > | 
|  | 0 |  |  |  |  |  |  | 
| 4610 | 0 |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= e_split($e.'qr','{','}',$2,''); next E_STRING_LOOP; } # qq | | --> qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4611 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\S)          ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= e_split($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # qq * * --> qr * * | 
|  | 0 |  |  |  |  |  |  | 
| 4612 |  |  |  |  |  |  | } | 
| 4613 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4614 |  |  |  |  |  |  | } | 
| 4615 |  |  |  |  |  |  | } | 
| 4616 |  |  |  |  |  |  |  | 
| 4617 |  |  |  |  |  |  | # split qr// | 
| 4618 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qr) \b /oxgc) { | 
| 4619 | 0 | 0 |  |  |  |  | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) ([imosxpadlunbB]*) /oxgc)                        { $e_string .= e_split  ($e.'qr',$1,$3,$2,$4);   next E_STRING_LOOP; } # qr# # | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 4620 |  |  |  |  |  |  | else { | 
| 4621 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4622 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                                            /oxgc) { $e_string .= $e . $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4623 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\()          ((?:$qq_paren)*?)   (\)) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr ( ) | 
|  | 0 |  |  |  |  |  |  | 
| 4624 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\{)          ((?:$qq_brace)*?)   (\}) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4625 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\[)          ((?:$qq_bracket)*?) (\]) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr [ ] | 
|  | 0 |  |  |  |  |  |  | 
| 4626 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\<)          ((?:$qq_angle)*?)   (\>) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr',$1, $3, $2,$4); next E_STRING_LOOP; } # qr < > | 
|  | 0 |  |  |  |  |  |  | 
| 4627 | 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 |  |  |  |  |  |  | 
| 4628 | 0 |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([imosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr','{','}',$2,$4); next E_STRING_LOOP; } # qr | | --> qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4629 | 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 * * | 
|  | 0 |  |  |  |  |  |  | 
| 4630 |  |  |  |  |  |  | } | 
| 4631 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4632 |  |  |  |  |  |  | } | 
| 4633 |  |  |  |  |  |  | } | 
| 4634 |  |  |  |  |  |  |  | 
| 4635 |  |  |  |  |  |  | # split q// | 
| 4636 |  |  |  |  |  |  | elsif ($string =~ /\G \b (q) \b /oxgc) { | 
| 4637 | 0 | 0 |  |  |  |  | if ($string =~ /\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc)                    { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q# #  --> qr # # | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 4638 |  |  |  |  |  |  | else { | 
| 4639 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4640 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                              /oxgc) { $e_string .= $e . $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4641 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q ( ) --> qr ( ) | 
|  | 0 |  |  |  |  |  |  | 
| 4642 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q { } --> qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4643 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q [ ] --> qr [ ] | 
|  | 0 |  |  |  |  |  |  | 
| 4644 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { $e_string .= e_split_q($e.'qr',$1,$3,$2,'');   next E_STRING_LOOP; } # q < > --> qr < > | 
|  | 0 |  |  |  |  |  |  | 
| 4645 | 0 |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|])       ((?:$q_char)*?)    (\1) /oxgc) { $e_string .= e_split_q($e.'qr','{','}',$2,''); next E_STRING_LOOP; } # q | | --> qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4646 | 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 * * | 
|  | 0 |  |  |  |  |  |  | 
| 4647 |  |  |  |  |  |  | } | 
| 4648 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4649 |  |  |  |  |  |  | } | 
| 4650 |  |  |  |  |  |  | } | 
| 4651 |  |  |  |  |  |  |  | 
| 4652 |  |  |  |  |  |  | # split m// | 
| 4653 |  |  |  |  |  |  | elsif ($string =~ /\G \b (m) \b /oxgc) { | 
| 4654 | 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 # # | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 4655 |  |  |  |  |  |  | else { | 
| 4656 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4657 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                                              /oxgc) { $e_string .= $e . $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4658 | 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 |  |  |  |  |  |  | 
| 4659 | 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 |  |  |  |  |  |  | 
| 4660 | 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 |  |  |  |  |  |  | 
| 4661 | 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 |  |  |  |  |  |  | 
| 4662 | 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 |  |  |  |  |  |  | 
| 4663 | 0 |  |  |  |  |  | elsif ($string =~ /\G ([*\-:?\\^|]) ((?:$qq_char)*?)    (\1) ([cgimosxpadlunbB]*) /oxgc) { $e_string .= e_split  ($e.'qr','{','}',$2,$4); next E_STRING_LOOP; } # m | | --> qr { } | 
|  | 0 |  |  |  |  |  |  | 
| 4664 | 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 * * | 
|  | 0 |  |  |  |  |  |  | 
| 4665 |  |  |  |  |  |  | } | 
| 4666 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 4667 |  |  |  |  |  |  | } | 
| 4668 |  |  |  |  |  |  | } | 
| 4669 |  |  |  |  |  |  |  | 
| 4670 |  |  |  |  |  |  | # split '' | 
| 4671 |  |  |  |  |  |  | elsif ($string =~ /\G (\') /oxgc) { | 
| 4672 | 0 |  |  |  |  |  | my $q_string = ''; | 
| 4673 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4674 | 0 | 0 |  |  |  |  | if    ($string =~ /\G (\\\\)    /oxgc) { $q_string .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4675 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\\\')    /oxgc) { $q_string .= $1; } # splitqr'' --> split qr'' | 
| 4676 | 0 |  |  |  |  |  | elsif ($string =~ /\G \'        /oxgc)                      { $e_string .= e_split_q($e.q{ qr},"'","'",$q_string,''); next E_STRING_LOOP; } # ' ' --> qr ' ' | 
|  | 0 |  |  |  |  |  |  | 
| 4677 | 0 |  |  |  |  |  | elsif ($string =~ /\G ($q_char) /oxgc) { $q_string .= $1; } | 
| 4678 |  |  |  |  |  |  | } | 
| 4679 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4680 |  |  |  |  |  |  | } | 
| 4681 |  |  |  |  |  |  |  | 
| 4682 |  |  |  |  |  |  | # split "" | 
| 4683 |  |  |  |  |  |  | elsif ($string =~ /\G (\") /oxgc) { | 
| 4684 | 0 |  |  |  |  |  | my $qq_string = ''; | 
| 4685 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4686 | 0 | 0 |  |  |  |  | if    ($string =~ /\G (\\\\)    /oxgc) { $qq_string .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4687 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\\\")    /oxgc) { $qq_string .= $1; } # splitqr"" --> split qr"" | 
| 4688 | 0 |  |  |  |  |  | elsif ($string =~ /\G \"        /oxgc)                       { $e_string .= e_split($e.q{ qr},'"','"',$qq_string,''); next E_STRING_LOOP; } # " " --> qr " " | 
|  | 0 |  |  |  |  |  |  | 
| 4689 | 0 |  |  |  |  |  | elsif ($string =~ /\G ($q_char) /oxgc) { $qq_string .= $1; } | 
| 4690 |  |  |  |  |  |  | } | 
| 4691 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4692 |  |  |  |  |  |  | } | 
| 4693 |  |  |  |  |  |  |  | 
| 4694 |  |  |  |  |  |  | # split // | 
| 4695 |  |  |  |  |  |  | elsif ($string =~ /\G (\/) /oxgc) { | 
| 4696 | 0 |  |  |  |  |  | my $regexp = ''; | 
| 4697 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4698 | 0 | 0 |  |  |  |  | if    ($string =~ /\G (\\\\)                  /oxgc) { $regexp .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4699 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\\\/)                  /oxgc) { $regexp .= $1; } # splitqr// --> split qr// | 
| 4700 | 0 |  |  |  |  |  | elsif ($string =~ /\G \/ ([cgimosxpadlunbB]*) /oxgc)                    { $e_string .= e_split($e.q{ qr}, '/','/',$regexp,$1); next E_STRING_LOOP; } # / / --> qr / / | 
|  | 0 |  |  |  |  |  |  | 
| 4701 | 0 |  |  |  |  |  | elsif ($string =~ /\G ($q_char)               /oxgc) { $regexp .= $1; } | 
| 4702 |  |  |  |  |  |  | } | 
| 4703 | 0 |  |  |  |  |  | die __FILE__, ": Search pattern not terminated\n"; | 
| 4704 |  |  |  |  |  |  | } | 
| 4705 |  |  |  |  |  |  | } | 
| 4706 |  |  |  |  |  |  |  | 
| 4707 |  |  |  |  |  |  | # qq// | 
| 4708 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qq) \b /oxgc) { | 
| 4709 | 0 |  |  |  |  |  | my $ope = $1; | 
| 4710 | 0 | 0 |  |  |  |  | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { # qq# # | 
| 4711 | 0 |  |  |  |  |  | $e_string .= e_qq($ope,$1,$3,$2); | 
| 4712 |  |  |  |  |  |  | } | 
| 4713 |  |  |  |  |  |  | else { | 
| 4714 | 0 |  |  |  |  |  | my $e = ''; | 
| 4715 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4716 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4717 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\() ((?:$qq_paren)*?)   (\)) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq ( ) | 
|  | 0 |  |  |  |  |  |  | 
| 4718 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\{) ((?:$qq_brace)*?)   (\}) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq { } | 
|  | 0 |  |  |  |  |  |  | 
| 4719 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq [ ] | 
|  | 0 |  |  |  |  |  |  | 
| 4720 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\<) ((?:$qq_angle)*?)   (\>) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq < > | 
|  | 0 |  |  |  |  |  |  | 
| 4721 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\S) ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qq * * | 
|  | 0 |  |  |  |  |  |  | 
| 4722 |  |  |  |  |  |  | } | 
| 4723 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4724 |  |  |  |  |  |  | } | 
| 4725 |  |  |  |  |  |  | } | 
| 4726 |  |  |  |  |  |  |  | 
| 4727 |  |  |  |  |  |  | # qx// | 
| 4728 |  |  |  |  |  |  | elsif ($string =~ /\G \b (qx) \b /oxgc) { | 
| 4729 | 0 |  |  |  |  |  | my $ope = $1; | 
| 4730 | 0 | 0 |  |  |  |  | if ($string =~ /\G (\#) ((?:$qq_char)*?) (\#) /oxgc) { # qx# # | 
| 4731 | 0 |  |  |  |  |  | $e_string .= e_qq($ope,$1,$3,$2); | 
| 4732 |  |  |  |  |  |  | } | 
| 4733 |  |  |  |  |  |  | else { | 
| 4734 | 0 |  |  |  |  |  | my $e = ''; | 
| 4735 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4736 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4737 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\() ((?:$qq_paren)*?)   (\)) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx ( ) | 
|  | 0 |  |  |  |  |  |  | 
| 4738 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\{) ((?:$qq_brace)*?)   (\}) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx { } | 
|  | 0 |  |  |  |  |  |  | 
| 4739 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\[) ((?:$qq_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx [ ] | 
|  | 0 |  |  |  |  |  |  | 
| 4740 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\<) ((?:$qq_angle)*?)   (\>) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx < > | 
|  | 0 |  |  |  |  |  |  | 
| 4741 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\') ((?:$qq_char)*?)    (\') /oxgc) { $e_string .= $e . e_q ($ope,$1,$3,$2); next E_STRING_LOOP; } # qx ' ' | 
|  | 0 |  |  |  |  |  |  | 
| 4742 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\S) ((?:$qq_char)*?)    (\1) /oxgc) { $e_string .= $e . e_qq($ope,$1,$3,$2); next E_STRING_LOOP; } # qx * * | 
|  | 0 |  |  |  |  |  |  | 
| 4743 |  |  |  |  |  |  | } | 
| 4744 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4745 |  |  |  |  |  |  | } | 
| 4746 |  |  |  |  |  |  | } | 
| 4747 |  |  |  |  |  |  |  | 
| 4748 |  |  |  |  |  |  | # q// | 
| 4749 |  |  |  |  |  |  | elsif ($string =~ /\G \b (q) \b /oxgc) { | 
| 4750 | 0 |  |  |  |  |  | my $ope = $1; | 
| 4751 | 0 | 0 |  |  |  |  | if ($string =~ /\G (\#) ((?:\\\#|\\\\|$q_char)*?) (\#) /oxgc) { # q# # | 
| 4752 | 0 |  |  |  |  |  | $e_string .= e_q($ope,$1,$3,$2); | 
| 4753 |  |  |  |  |  |  | } | 
| 4754 |  |  |  |  |  |  | else { | 
| 4755 | 0 |  |  |  |  |  | my $e = ''; | 
| 4756 | 0 |  |  |  |  |  | while ($string !~ /\G \z/oxgc) { | 
| 4757 | 0 | 0 |  |  |  |  | if    ($string =~ /\G ((?>\s+)|\#.*)                              /oxgc) { $e .= $1; } | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 4758 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\() ((?:\\\\|\\\)|\\\(|$q_paren)*?)   (\)) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q ( ) | 
|  | 0 |  |  |  |  |  |  | 
| 4759 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\{) ((?:\\\\|\\\}|\\\{|$q_brace)*?)   (\}) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q { } | 
|  | 0 |  |  |  |  |  |  | 
| 4760 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\[) ((?:\\\\|\\\]|\\\[|$q_bracket)*?) (\]) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q [ ] | 
|  | 0 |  |  |  |  |  |  | 
| 4761 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\<) ((?:\\\\|\\\>|\\\<|$q_angle)*?)   (\>) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q < > | 
|  | 0 |  |  |  |  |  |  | 
| 4762 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\S) ((?:\\\\|\\\1|     $q_char)*?)    (\1) /oxgc) { $e_string .= $e . e_q($ope,$1,$3,$2); next E_STRING_LOOP; } # q * * | 
|  | 0 |  |  |  |  |  |  | 
| 4763 |  |  |  |  |  |  | } | 
| 4764 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator anywhere before EOF\n"; | 
| 4765 |  |  |  |  |  |  | } | 
| 4766 |  |  |  |  |  |  | } | 
| 4767 |  |  |  |  |  |  |  | 
| 4768 |  |  |  |  |  |  | # '' | 
| 4769 | 0 |  |  |  |  |  | elsif ($string =~ /\G (? | 
| 4770 |  |  |  |  |  |  |  | 
| 4771 |  |  |  |  |  |  | # "" | 
| 4772 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\") ((?:$qq_char)*?) (\")                                        /oxgc) { $e_string .= e_qq('',$1,$3,$2); } | 
| 4773 |  |  |  |  |  |  |  | 
| 4774 |  |  |  |  |  |  | # `` | 
| 4775 | 0 |  |  |  |  |  | elsif ($string =~ /\G (\`) ((?:$qq_char)*?) (\`)                                        /oxgc) { $e_string .= e_qq('',$1,$3,$2); } | 
| 4776 |  |  |  |  |  |  |  | 
| 4777 |  |  |  |  |  |  | # <<>> (a safer ARGV) | 
| 4778 | 0 |  |  |  |  |  | elsif ($string =~ /\G ( <<>> )                                                          /oxgc) { $e_string .= $1;                } | 
| 4779 |  |  |  |  |  |  |  | 
| 4780 |  |  |  |  |  |  | # <<= <=> <= < operator | 
| 4781 | 0 |  |  |  |  |  | elsif ($string =~ /\G ( <<= | <=> | <= | < ) (?= (?>\s*) [A-Za-z_0-9'"`\$\@\&\*\(\+\-] )/oxgc) { $e_string .= $1;                } | 
| 4782 |  |  |  |  |  |  |  | 
| 4783 |  |  |  |  |  |  | # | 
| 4784 | 0 |  |  |  |  |  | elsif ($string =~ /\G (<[\$]?[A-Za-z_][A-Za-z_0-9]*>)                         /oxgc) { $e_string .= $1;                } | 
| 4785 |  |  |  |  |  |  |  | 
| 4786 |  |  |  |  |  |  | #    --- glob | 
| 4787 |  |  |  |  |  |  | elsif ($string =~ /\G < ((?:$q_char)+?) > /oxgc) { | 
| 4788 | 0 |  |  |  |  |  | $e_string .= 'Elatin6::glob("' . $1 . '")'; | 
| 4789 |  |  |  |  |  |  | } | 
| 4790 |  |  |  |  |  |  |  | 
| 4791 |  |  |  |  |  |  | # << (bit shift)   --- not here document | 
| 4792 | 0 |  |  |  |  |  | elsif ($string =~ /\G ( << (?>\s*) ) (?= [0-9\$\@\&] ) /oxgc)                        { $slash = 'm//'; $e_string .= $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 4793 |  |  |  |  |  |  |  | 
| 4794 |  |  |  |  |  |  | # <<'HEREDOC' | 
| 4795 |  |  |  |  |  |  | elsif ($string =~ /\G ( << '([a-zA-Z_0-9]*)' ) /oxgc) { | 
| 4796 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4797 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4798 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4799 |  |  |  |  |  |  |  | 
| 4800 |  |  |  |  |  |  | # get here document | 
| 4801 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4802 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4803 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4804 |  |  |  |  |  |  | } | 
| 4805 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4806 | 0 |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 4807 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4808 |  |  |  |  |  |  | } | 
| 4809 |  |  |  |  |  |  | else { | 
| 4810 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4811 |  |  |  |  |  |  | } | 
| 4812 | 0 |  |  |  |  |  | $e_string .= $here_quote; | 
| 4813 |  |  |  |  |  |  | } | 
| 4814 |  |  |  |  |  |  |  | 
| 4815 |  |  |  |  |  |  | # <<\HEREDOC | 
| 4816 |  |  |  |  |  |  | elsif ($string =~ /\G ( << \\([a-zA-Z_0-9]+) ) /oxgc) { | 
| 4817 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4818 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4819 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4820 |  |  |  |  |  |  |  | 
| 4821 |  |  |  |  |  |  | # get here document | 
| 4822 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4823 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4824 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4825 |  |  |  |  |  |  | } | 
| 4826 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4827 | 0 |  |  |  |  |  | push @heredoc, $1 . qq{\n$delimiter\n}; | 
| 4828 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4829 |  |  |  |  |  |  | } | 
| 4830 |  |  |  |  |  |  | else { | 
| 4831 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4832 |  |  |  |  |  |  | } | 
| 4833 | 0 |  |  |  |  |  | $e_string .= $here_quote; | 
| 4834 |  |  |  |  |  |  | } | 
| 4835 |  |  |  |  |  |  |  | 
| 4836 |  |  |  |  |  |  | # <<"HEREDOC" | 
| 4837 |  |  |  |  |  |  | elsif ($string =~ /\G ( << "([a-zA-Z_0-9]*)" ) /oxgc) { | 
| 4838 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4839 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4840 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4841 |  |  |  |  |  |  |  | 
| 4842 |  |  |  |  |  |  | # get here document | 
| 4843 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4844 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4845 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4846 |  |  |  |  |  |  | } | 
| 4847 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4848 | 0 |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 4849 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4850 |  |  |  |  |  |  | } | 
| 4851 |  |  |  |  |  |  | else { | 
| 4852 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4853 |  |  |  |  |  |  | } | 
| 4854 | 0 |  |  |  |  |  | $e_string .= $here_quote; | 
| 4855 |  |  |  |  |  |  | } | 
| 4856 |  |  |  |  |  |  |  | 
| 4857 |  |  |  |  |  |  | # < | 
| 4858 |  |  |  |  |  |  | elsif ($string =~ /\G ( << ([a-zA-Z_0-9]+) ) /oxgc) { | 
| 4859 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4860 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4861 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4862 |  |  |  |  |  |  |  | 
| 4863 |  |  |  |  |  |  | # get here document | 
| 4864 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4865 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4866 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4867 |  |  |  |  |  |  | } | 
| 4868 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4869 | 0 |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 4870 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4871 |  |  |  |  |  |  | } | 
| 4872 |  |  |  |  |  |  | else { | 
| 4873 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4874 |  |  |  |  |  |  | } | 
| 4875 | 0 |  |  |  |  |  | $e_string .= $here_quote; | 
| 4876 |  |  |  |  |  |  | } | 
| 4877 |  |  |  |  |  |  |  | 
| 4878 |  |  |  |  |  |  | # <<`HEREDOC` | 
| 4879 |  |  |  |  |  |  | elsif ($string =~ /\G ( << `([a-zA-Z_0-9]*)` ) /oxgc) { | 
| 4880 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 4881 | 0 |  |  |  |  |  | my $here_quote = $1; | 
| 4882 | 0 |  |  |  |  |  | my $delimiter  = $2; | 
| 4883 |  |  |  |  |  |  |  | 
| 4884 |  |  |  |  |  |  | # get here document | 
| 4885 | 0 | 0 |  |  |  |  | if ($here_script eq '') { | 
| 4886 | 0 |  |  |  |  |  | $here_script = CORE::substr $_, pos $_; | 
| 4887 | 0 |  |  |  |  |  | $here_script =~ s/.*?\n//oxm; | 
| 4888 |  |  |  |  |  |  | } | 
| 4889 | 0 | 0 |  |  |  |  | if ($here_script =~ s/\A (.*?) \n $delimiter \n //xms) { | 
| 4890 | 0 |  |  |  |  |  | push @heredoc, e_heredoc($1) . qq{\n$delimiter\n}; | 
| 4891 | 0 |  |  |  |  |  | push @heredoc_delimiter, $delimiter; | 
| 4892 |  |  |  |  |  |  | } | 
| 4893 |  |  |  |  |  |  | else { | 
| 4894 | 0 |  |  |  |  |  | die __FILE__, ": Can't find string terminator $delimiter anywhere before EOF\n"; | 
| 4895 |  |  |  |  |  |  | } | 
| 4896 | 0 |  |  |  |  |  | $e_string .= $here_quote; | 
| 4897 |  |  |  |  |  |  | } | 
| 4898 |  |  |  |  |  |  |  | 
| 4899 |  |  |  |  |  |  | # any operator before div | 
| 4900 |  |  |  |  |  |  | elsif ($string =~ /\G ( | 
| 4901 |  |  |  |  |  |  | -- | \+\+ | | 
| 4902 |  |  |  |  |  |  | [\)\}\]] | 
| 4903 |  |  |  |  |  |  |  | 
| 4904 | 0 |  |  |  |  |  | ) /oxgc) { $slash = 'div'; $e_string .= $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 4905 |  |  |  |  |  |  |  | 
| 4906 |  |  |  |  |  |  | # yada-yada or triple-dot operator | 
| 4907 |  |  |  |  |  |  | elsif ($string =~ /\G ( | 
| 4908 |  |  |  |  |  |  | \.\.\. | 
| 4909 |  |  |  |  |  |  |  | 
| 4910 | 0 |  |  |  |  |  | ) /oxgc) { $slash = 'm//'; $e_string .= q{die('Unimplemented')}; } | 
|  | 0 |  |  |  |  |  |  | 
| 4911 |  |  |  |  |  |  |  | 
| 4912 |  |  |  |  |  |  | # any operator before m// | 
| 4913 |  |  |  |  |  |  | elsif ($string =~ /\G ((?> | 
| 4914 |  |  |  |  |  |  |  | 
| 4915 |  |  |  |  |  |  | !~~ | !~ | != | ! | | 
| 4916 |  |  |  |  |  |  | %= | % | | 
| 4917 |  |  |  |  |  |  | &&= | && | &= | &\.= | &\. | & | | 
| 4918 |  |  |  |  |  |  | -= | -> | - | | 
| 4919 |  |  |  |  |  |  | :(?>\s*)= | | 
| 4920 |  |  |  |  |  |  | : | | 
| 4921 |  |  |  |  |  |  | <<>> | | 
| 4922 |  |  |  |  |  |  | <<= | <=> | <= | < | | 
| 4923 |  |  |  |  |  |  | == | => | =~ | = | | 
| 4924 |  |  |  |  |  |  | >>= | >> | >= | > | | 
| 4925 |  |  |  |  |  |  | \*\*= | \*\* | \*= | \* | | 
| 4926 |  |  |  |  |  |  | \+= | \+ | | 
| 4927 |  |  |  |  |  |  | \.\. | \.= | \. | | 
| 4928 |  |  |  |  |  |  | \/\/= | \/\/ | | 
| 4929 |  |  |  |  |  |  | \/= | \/ | | 
| 4930 |  |  |  |  |  |  | \? | | 
| 4931 |  |  |  |  |  |  | \\ | | 
| 4932 |  |  |  |  |  |  | \^= | \^\.= | \^\. | \^ | | 
| 4933 |  |  |  |  |  |  | \b x= | | 
| 4934 |  |  |  |  |  |  | \|\|= | \|\| | \|= | \|\.= | \|\. | \| | | 
| 4935 |  |  |  |  |  |  | ~~ | ~\. | ~ | | 
| 4936 |  |  |  |  |  |  | \b(?: and | cmp | eq | ge | gt | le | lt | ne | not | or | xor | x )\b | | 
| 4937 |  |  |  |  |  |  | \b(?: print )\b | | 
| 4938 |  |  |  |  |  |  |  | 
| 4939 |  |  |  |  |  |  | [,;\(\{\[] | 
| 4940 |  |  |  |  |  |  |  | 
| 4941 | 0 |  |  |  |  |  | )) /oxgc) { $slash = 'm//'; $e_string .= $1; } | 
|  | 0 |  |  |  |  |  |  | 
| 4942 |  |  |  |  |  |  |  | 
| 4943 |  |  |  |  |  |  | # other any character | 
| 4944 | 0 |  |  |  |  |  | elsif ($string =~ /\G ($q_char) /oxgc) { $e_string .= $1; } | 
| 4945 |  |  |  |  |  |  |  | 
| 4946 |  |  |  |  |  |  | # system error | 
| 4947 |  |  |  |  |  |  | else { | 
| 4948 | 0 |  |  |  |  |  | die __FILE__, ": Oops, this shouldn't happen!\n"; | 
| 4949 |  |  |  |  |  |  | } | 
| 4950 |  |  |  |  |  |  | } | 
| 4951 |  |  |  |  |  |  |  | 
| 4952 | 0 |  |  |  |  |  | return $e_string; | 
| 4953 |  |  |  |  |  |  | } | 
| 4954 |  |  |  |  |  |  |  | 
| 4955 |  |  |  |  |  |  | # | 
| 4956 |  |  |  |  |  |  | # character class | 
| 4957 |  |  |  |  |  |  | # | 
| 4958 |  |  |  |  |  |  | sub character_class { | 
| 4959 | 0 |  |  | 0 | 0 |  | my($char,$modifier) = @_; | 
| 4960 |  |  |  |  |  |  |  | 
| 4961 | 0 | 0 |  |  |  |  | if ($char eq '.') { | 
| 4962 | 0 | 0 |  |  |  |  | if ($modifier =~ /s/) { | 
| 4963 | 0 |  |  |  |  |  | return '${Elatin6::dot_s}'; | 
| 4964 |  |  |  |  |  |  | } | 
| 4965 |  |  |  |  |  |  | else { | 
| 4966 | 0 |  |  |  |  |  | return '${Elatin6::dot}'; | 
| 4967 |  |  |  |  |  |  | } | 
| 4968 |  |  |  |  |  |  | } | 
| 4969 |  |  |  |  |  |  | else { | 
| 4970 | 0 |  |  |  |  |  | return Elatin6::classic_character_class($char); | 
| 4971 |  |  |  |  |  |  | } | 
| 4972 |  |  |  |  |  |  | } | 
| 4973 |  |  |  |  |  |  |  | 
| 4974 |  |  |  |  |  |  | # | 
| 4975 |  |  |  |  |  |  | # escape capture ($1, $2, $3, ...) | 
| 4976 |  |  |  |  |  |  | # | 
| 4977 |  |  |  |  |  |  | sub e_capture { | 
| 4978 |  |  |  |  |  |  |  | 
| 4979 | 0 |  |  | 0 | 0 |  | return join '', '${',                $_[0],  '}'; | 
| 4980 |  |  |  |  |  |  | } | 
| 4981 |  |  |  |  |  |  |  | 
| 4982 |  |  |  |  |  |  | # | 
| 4983 |  |  |  |  |  |  | # escape transliteration (tr/// or y///) | 
| 4984 |  |  |  |  |  |  | # | 
| 4985 |  |  |  |  |  |  | sub e_tr { | 
| 4986 | 0 |  |  | 0 | 0 |  | my($variable,$charclass,$e,$charclass2,$modifier) = @_; | 
| 4987 | 0 |  |  |  |  |  | my $e_tr = ''; | 
| 4988 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 4989 |  |  |  |  |  |  |  | 
| 4990 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 4991 |  |  |  |  |  |  |  | 
| 4992 |  |  |  |  |  |  | # quote character class 1 | 
| 4993 | 0 |  |  |  |  |  | $charclass  = q_tr($charclass); | 
| 4994 |  |  |  |  |  |  |  | 
| 4995 |  |  |  |  |  |  | # quote character class 2 | 
| 4996 | 0 |  |  |  |  |  | $charclass2 = q_tr($charclass2); | 
| 4997 |  |  |  |  |  |  |  | 
| 4998 |  |  |  |  |  |  | # /b /B modifier | 
| 4999 | 0 | 0 |  |  |  |  | if ($modifier =~ tr/bB//d) { | 
| 5000 | 0 | 0 |  |  |  |  | if ($variable eq '') { | 
| 5001 | 0 |  |  |  |  |  | $e_tr = qq{tr$charclass$e$charclass2$modifier}; | 
| 5002 |  |  |  |  |  |  | } | 
| 5003 |  |  |  |  |  |  | else { | 
| 5004 | 0 |  |  |  |  |  | $e_tr = qq{$variable${bind_operator}tr$charclass$e$charclass2$modifier}; | 
| 5005 |  |  |  |  |  |  | } | 
| 5006 |  |  |  |  |  |  | } | 
| 5007 |  |  |  |  |  |  | else { | 
| 5008 | 0 | 0 |  |  |  |  | if ($variable eq '') { | 
| 5009 | 0 |  |  |  |  |  | $e_tr = qq{Elatin6::tr(\$_,' =~ ',$charclass,$e$charclass2,'$modifier')}; | 
| 5010 |  |  |  |  |  |  | } | 
| 5011 |  |  |  |  |  |  | else { | 
| 5012 | 0 |  |  |  |  |  | $e_tr = qq{Elatin6::tr($variable,'$bind_operator',$charclass,$e$charclass2,'$modifier')}; | 
| 5013 |  |  |  |  |  |  | } | 
| 5014 |  |  |  |  |  |  | } | 
| 5015 |  |  |  |  |  |  |  | 
| 5016 |  |  |  |  |  |  | # clear tr/// variable | 
| 5017 | 0 |  |  |  |  |  | $tr_variable = ''; | 
| 5018 | 0 |  |  |  |  |  | $bind_operator = ''; | 
| 5019 |  |  |  |  |  |  |  | 
| 5020 | 0 |  |  |  |  |  | return $e_tr; | 
| 5021 |  |  |  |  |  |  | } | 
| 5022 |  |  |  |  |  |  |  | 
| 5023 |  |  |  |  |  |  | # | 
| 5024 |  |  |  |  |  |  | # quote for escape transliteration (tr/// or y///) | 
| 5025 |  |  |  |  |  |  | # | 
| 5026 |  |  |  |  |  |  | sub q_tr { | 
| 5027 | 0 |  |  | 0 | 0 |  | my($charclass) = @_; | 
| 5028 |  |  |  |  |  |  |  | 
| 5029 |  |  |  |  |  |  | # quote character class | 
| 5030 | 0 | 0 |  |  |  |  | if ($charclass !~ /'/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5031 | 0 |  |  |  |  |  | return e_q('',  "'", "'", $charclass); # --> q' ' | 
| 5032 |  |  |  |  |  |  | } | 
| 5033 |  |  |  |  |  |  | elsif ($charclass !~ /\//oxms) { | 
| 5034 | 0 |  |  |  |  |  | return e_q('q',  '/', '/', $charclass); # --> q/ / | 
| 5035 |  |  |  |  |  |  | } | 
| 5036 |  |  |  |  |  |  | elsif ($charclass !~ /\#/oxms) { | 
| 5037 | 0 |  |  |  |  |  | return e_q('q',  '#', '#', $charclass); # --> q# # | 
| 5038 |  |  |  |  |  |  | } | 
| 5039 |  |  |  |  |  |  | elsif ($charclass !~ /[\<\>]/oxms) { | 
| 5040 | 0 |  |  |  |  |  | return e_q('q', '<', '>', $charclass); # --> q< > | 
| 5041 |  |  |  |  |  |  | } | 
| 5042 |  |  |  |  |  |  | elsif ($charclass !~ /[\(\)]/oxms) { | 
| 5043 | 0 |  |  |  |  |  | return e_q('q', '(', ')', $charclass); # --> q( ) | 
| 5044 |  |  |  |  |  |  | } | 
| 5045 |  |  |  |  |  |  | elsif ($charclass !~ /[\{\}]/oxms) { | 
| 5046 | 0 |  |  |  |  |  | return e_q('q', '{', '}', $charclass); # --> q{ } | 
| 5047 |  |  |  |  |  |  | } | 
| 5048 |  |  |  |  |  |  | else { | 
| 5049 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + . : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 5050 | 0 | 0 |  |  |  |  | if ($charclass !~ /\Q$char\E/xms) { | 
| 5051 | 0 |  |  |  |  |  | return e_q('q', $char, $char, $charclass); | 
| 5052 |  |  |  |  |  |  | } | 
| 5053 |  |  |  |  |  |  | } | 
| 5054 |  |  |  |  |  |  | } | 
| 5055 |  |  |  |  |  |  |  | 
| 5056 | 0 |  |  |  |  |  | return e_q('q', '{', '}', $charclass); | 
| 5057 |  |  |  |  |  |  | } | 
| 5058 |  |  |  |  |  |  |  | 
| 5059 |  |  |  |  |  |  | # | 
| 5060 |  |  |  |  |  |  | # escape q string (q//, '') | 
| 5061 |  |  |  |  |  |  | # | 
| 5062 |  |  |  |  |  |  | sub e_q { | 
| 5063 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 5064 |  |  |  |  |  |  |  | 
| 5065 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 5066 |  |  |  |  |  |  |  | 
| 5067 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $string, $end_delimiter; | 
| 5068 |  |  |  |  |  |  | } | 
| 5069 |  |  |  |  |  |  |  | 
| 5070 |  |  |  |  |  |  | # | 
| 5071 |  |  |  |  |  |  | # escape qq string (qq//, "", qx//, ``) | 
| 5072 |  |  |  |  |  |  | # | 
| 5073 |  |  |  |  |  |  | sub e_qq { | 
| 5074 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 5075 |  |  |  |  |  |  |  | 
| 5076 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 5077 |  |  |  |  |  |  |  | 
| 5078 | 0 |  |  |  |  |  | my $left_e  = 0; | 
| 5079 | 0 |  |  |  |  |  | my $right_e = 0; | 
| 5080 |  |  |  |  |  |  |  | 
| 5081 |  |  |  |  |  |  | # split regexp | 
| 5082 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 5083 |  |  |  |  |  |  | [^\\\$] | | 
| 5084 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}            | | 
| 5085 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}            | | 
| 5086 |  |  |  |  |  |  | \\N\{ (?>[^0-9\}][^\}]*) \} | | 
| 5087 |  |  |  |  |  |  | \\ $q_char                           | | 
| 5088 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 5089 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 5090 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 5091 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)                    | | 
| 5092 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 5093 |  |  |  |  |  |  | \$ \$ (?![\w\{])                     | | 
| 5094 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 5095 |  |  |  |  |  |  | $q_char | 
| 5096 |  |  |  |  |  |  | ))/oxmsg; | 
| 5097 |  |  |  |  |  |  |  | 
| 5098 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 5099 |  |  |  |  |  |  |  | 
| 5100 |  |  |  |  |  |  | # "\L\u" --> "\u\L" | 
| 5101 | 0 | 0 | 0 |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5102 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 5103 |  |  |  |  |  |  | } | 
| 5104 |  |  |  |  |  |  |  | 
| 5105 |  |  |  |  |  |  | # "\U\l" --> "\l\U" | 
| 5106 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 5107 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 5108 |  |  |  |  |  |  | } | 
| 5109 |  |  |  |  |  |  |  | 
| 5110 |  |  |  |  |  |  | # octal escape sequence | 
| 5111 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 5112 | 0 |  |  |  |  |  | $char[$i] = Elatin6::octchr($1); | 
| 5113 |  |  |  |  |  |  | } | 
| 5114 |  |  |  |  |  |  |  | 
| 5115 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 5116 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 5117 | 0 |  |  |  |  |  | $char[$i] = Elatin6::hexchr($1); | 
| 5118 |  |  |  |  |  |  | } | 
| 5119 |  |  |  |  |  |  |  | 
| 5120 |  |  |  |  |  |  | # \N{CHARNAME} --> N{CHARNAME} | 
| 5121 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( N\{ ([^0-9\}][^\}]*) \} ) \z/oxms) { | 
| 5122 | 0 |  |  |  |  |  | $char[$i] = $1; | 
| 5123 |  |  |  |  |  |  | } | 
| 5124 |  |  |  |  |  |  |  | 
| 5125 | 0 | 0 |  |  |  |  | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5126 |  |  |  |  |  |  | } | 
| 5127 |  |  |  |  |  |  |  | 
| 5128 |  |  |  |  |  |  | # \F | 
| 5129 |  |  |  |  |  |  | # | 
| 5130 |  |  |  |  |  |  | # P.69 Table 2-6. Translation escapes | 
| 5131 |  |  |  |  |  |  | # in Chapter 2: Bits and Pieces | 
| 5132 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 5133 |  |  |  |  |  |  | # (and so on) | 
| 5134 |  |  |  |  |  |  |  | 
| 5135 |  |  |  |  |  |  | # \u \l \U \L \F \Q \E | 
| 5136 | 0 |  |  |  |  |  | elsif ($char[$i] =~ /\A ([<>]) \z/oxms) { | 
| 5137 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 5138 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 5139 |  |  |  |  |  |  | } | 
| 5140 |  |  |  |  |  |  | } | 
| 5141 |  |  |  |  |  |  | elsif ($char[$i] eq '\u') { | 
| 5142 |  |  |  |  |  |  |  | 
| 5143 |  |  |  |  |  |  | # "STRING @{[ LIST EXPR ]} MORE STRING" | 
| 5144 |  |  |  |  |  |  |  | 
| 5145 |  |  |  |  |  |  | # P.257 Other Tricks You Can Do with Hard References | 
| 5146 |  |  |  |  |  |  | # in Chapter 8: References | 
| 5147 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 5148 |  |  |  |  |  |  |  | 
| 5149 |  |  |  |  |  |  | # P.353 Other Tricks You Can Do with Hard References | 
| 5150 |  |  |  |  |  |  | # in Chapter 8: References | 
| 5151 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 5152 |  |  |  |  |  |  |  | 
| 5153 |  |  |  |  |  |  | # (and so on) | 
| 5154 |  |  |  |  |  |  |  | 
| 5155 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ucfirst qq<'; | 
| 5156 | 0 |  |  |  |  |  | $left_e++; | 
| 5157 |  |  |  |  |  |  | } | 
| 5158 |  |  |  |  |  |  | elsif ($char[$i] eq '\l') { | 
| 5159 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lcfirst qq<'; | 
| 5160 | 0 |  |  |  |  |  | $left_e++; | 
| 5161 |  |  |  |  |  |  | } | 
| 5162 |  |  |  |  |  |  | elsif ($char[$i] eq '\U') { | 
| 5163 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::uc qq<'; | 
| 5164 | 0 |  |  |  |  |  | $left_e++; | 
| 5165 |  |  |  |  |  |  | } | 
| 5166 |  |  |  |  |  |  | elsif ($char[$i] eq '\L') { | 
| 5167 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lc qq<'; | 
| 5168 | 0 |  |  |  |  |  | $left_e++; | 
| 5169 |  |  |  |  |  |  | } | 
| 5170 |  |  |  |  |  |  | elsif ($char[$i] eq '\F') { | 
| 5171 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::fc qq<'; | 
| 5172 | 0 |  |  |  |  |  | $left_e++; | 
| 5173 |  |  |  |  |  |  | } | 
| 5174 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 5175 | 0 |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 5176 | 0 |  |  |  |  |  | $left_e++; | 
| 5177 |  |  |  |  |  |  | } | 
| 5178 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 5179 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 5180 | 0 |  |  |  |  |  | $char[$i] = '>]}'; | 
| 5181 | 0 |  |  |  |  |  | $right_e++; | 
| 5182 |  |  |  |  |  |  | } | 
| 5183 |  |  |  |  |  |  | else { | 
| 5184 | 0 |  |  |  |  |  | $char[$i] = ''; | 
| 5185 |  |  |  |  |  |  | } | 
| 5186 |  |  |  |  |  |  | } | 
| 5187 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 5188 | 0 |  |  |  |  |  | while (1) { | 
| 5189 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 5190 | 0 |  |  |  |  |  | last; | 
| 5191 |  |  |  |  |  |  | } | 
| 5192 | 0 | 0 |  |  |  |  | if ($char[$i] eq '\E') { | 
| 5193 | 0 |  |  |  |  |  | last; | 
| 5194 |  |  |  |  |  |  | } | 
| 5195 |  |  |  |  |  |  | } | 
| 5196 |  |  |  |  |  |  | } | 
| 5197 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 5198 |  |  |  |  |  |  | } | 
| 5199 |  |  |  |  |  |  |  | 
| 5200 |  |  |  |  |  |  | # $0 --> $0 | 
| 5201 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 5202 |  |  |  |  |  |  | } | 
| 5203 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 5204 |  |  |  |  |  |  | } | 
| 5205 |  |  |  |  |  |  |  | 
| 5206 |  |  |  |  |  |  | # $$ --> $$ | 
| 5207 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 5208 |  |  |  |  |  |  | } | 
| 5209 |  |  |  |  |  |  |  | 
| 5210 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 5211 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 5212 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 5213 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5214 |  |  |  |  |  |  | } | 
| 5215 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 5216 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5217 |  |  |  |  |  |  | } | 
| 5218 |  |  |  |  |  |  |  | 
| 5219 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 5220 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 5221 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 5222 |  |  |  |  |  |  | } | 
| 5223 |  |  |  |  |  |  |  | 
| 5224 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 5225 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 5226 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 5227 |  |  |  |  |  |  | } | 
| 5228 |  |  |  |  |  |  |  | 
| 5229 |  |  |  |  |  |  | # $$foo | 
| 5230 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 5231 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5232 |  |  |  |  |  |  | } | 
| 5233 |  |  |  |  |  |  |  | 
| 5234 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Elatin6::PREMATCH() | 
| 5235 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH (?>\s*) \}  | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 5236 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::PREMATCH()]}'; | 
| 5237 |  |  |  |  |  |  | } | 
| 5238 |  |  |  |  |  |  |  | 
| 5239 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Elatin6::MATCH() | 
| 5240 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 5241 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::MATCH()]}'; | 
| 5242 |  |  |  |  |  |  | } | 
| 5243 |  |  |  |  |  |  |  | 
| 5244 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Elatin6::POSTMATCH() | 
| 5245 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 5246 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::POSTMATCH()]}'; | 
| 5247 |  |  |  |  |  |  | } | 
| 5248 |  |  |  |  |  |  |  | 
| 5249 |  |  |  |  |  |  | # ${ foo } --> ${ foo } | 
| 5250 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ (?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \}                                \z/oxms) { | 
| 5251 |  |  |  |  |  |  | } | 
| 5252 |  |  |  |  |  |  |  | 
| 5253 |  |  |  |  |  |  | # ${ ... } | 
| 5254 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 5255 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5256 |  |  |  |  |  |  | } | 
| 5257 |  |  |  |  |  |  | } | 
| 5258 |  |  |  |  |  |  |  | 
| 5259 |  |  |  |  |  |  | # return string | 
| 5260 | 0 | 0 |  |  |  |  | if ($left_e > $right_e) { | 
| 5261 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter; | 
| 5262 |  |  |  |  |  |  | } | 
| 5263 | 0 |  |  |  |  |  | return     join '', $ope, $delimiter, @char,                               $end_delimiter; | 
| 5264 |  |  |  |  |  |  | } | 
| 5265 |  |  |  |  |  |  |  | 
| 5266 |  |  |  |  |  |  | # | 
| 5267 |  |  |  |  |  |  | # escape qw string (qw//) | 
| 5268 |  |  |  |  |  |  | # | 
| 5269 |  |  |  |  |  |  | sub e_qw { | 
| 5270 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 5271 |  |  |  |  |  |  |  | 
| 5272 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 5273 |  |  |  |  |  |  |  | 
| 5274 |  |  |  |  |  |  | # choice again delimiter | 
| 5275 | 0 |  |  |  |  |  | my %octet = map {$_ => 1} ($string =~ /\G ([\x00-\xFF]) /oxmsg); | 
|  | 0 |  |  |  |  |  |  | 
| 5276 | 0 | 0 |  |  |  |  | if (not $octet{$end_delimiter}) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5277 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $string, $end_delimiter; | 
| 5278 |  |  |  |  |  |  | } | 
| 5279 |  |  |  |  |  |  | elsif (not $octet{')'}) { | 
| 5280 | 0 |  |  |  |  |  | return join '', $ope, '(',        $string, ')'; | 
| 5281 |  |  |  |  |  |  | } | 
| 5282 |  |  |  |  |  |  | elsif (not $octet{'}'}) { | 
| 5283 | 0 |  |  |  |  |  | return join '', $ope, '{',        $string, '}'; | 
| 5284 |  |  |  |  |  |  | } | 
| 5285 |  |  |  |  |  |  | elsif (not $octet{']'}) { | 
| 5286 | 0 |  |  |  |  |  | return join '', $ope, '[',        $string, ']'; | 
| 5287 |  |  |  |  |  |  | } | 
| 5288 |  |  |  |  |  |  | elsif (not $octet{'>'}) { | 
| 5289 | 0 |  |  |  |  |  | return join '', $ope, '<',        $string, '>'; | 
| 5290 |  |  |  |  |  |  | } | 
| 5291 |  |  |  |  |  |  | else { | 
| 5292 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + - . / : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 5293 | 0 | 0 |  |  |  |  | if (not $octet{$char}) { | 
| 5294 | 0 |  |  |  |  |  | return join '', $ope,      $char, $string, $char; | 
| 5295 |  |  |  |  |  |  | } | 
| 5296 |  |  |  |  |  |  | } | 
| 5297 |  |  |  |  |  |  | } | 
| 5298 |  |  |  |  |  |  |  | 
| 5299 |  |  |  |  |  |  | # qw/AAA BBB C'CC/ --> ('AAA', 'BBB', 'C\'CC') | 
| 5300 | 0 |  |  |  |  |  | my @string = CORE::split(/\s+/, $string); | 
| 5301 | 0 |  |  |  |  |  | for my $string (@string) { | 
| 5302 | 0 |  |  |  |  |  | my @octet = $string =~ /\G ([\x00-\xFF]) /oxmsg; | 
| 5303 | 0 |  |  |  |  |  | for my $octet (@octet) { | 
| 5304 | 0 | 0 |  |  |  |  | if ($octet =~ /\A (['\\]) \z/oxms) { | 
| 5305 | 0 |  |  |  |  |  | $octet = '\\' . $1; | 
| 5306 |  |  |  |  |  |  | } | 
| 5307 |  |  |  |  |  |  | } | 
| 5308 | 0 |  |  |  |  |  | $string = join '', @octet; | 
| 5309 |  |  |  |  |  |  | } | 
| 5310 | 0 |  |  |  |  |  | return join '', '(', (join ', ', map { "'$_'" } @string), ')'; | 
|  | 0 |  |  |  |  |  |  | 
| 5311 |  |  |  |  |  |  | } | 
| 5312 |  |  |  |  |  |  |  | 
| 5313 |  |  |  |  |  |  | # | 
| 5314 |  |  |  |  |  |  | # escape here document (<<"HEREDOC", < | 
| 5315 |  |  |  |  |  |  | # | 
| 5316 |  |  |  |  |  |  | sub e_heredoc { | 
| 5317 | 0 |  |  | 0 | 0 |  | my($string) = @_; | 
| 5318 |  |  |  |  |  |  |  | 
| 5319 | 0 |  |  |  |  |  | $slash = 'm//'; | 
| 5320 |  |  |  |  |  |  |  | 
| 5321 | 0 |  |  |  |  |  | my $metachar = qr/[\@\\|]/oxms; # '|' is for <<`HEREDOC` | 
| 5322 |  |  |  |  |  |  |  | 
| 5323 | 0 |  |  |  |  |  | my $left_e  = 0; | 
| 5324 | 0 |  |  |  |  |  | my $right_e = 0; | 
| 5325 |  |  |  |  |  |  |  | 
| 5326 |  |  |  |  |  |  | # split regexp | 
| 5327 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 5328 |  |  |  |  |  |  | [^\\\$] | | 
| 5329 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}            | | 
| 5330 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}            | | 
| 5331 |  |  |  |  |  |  | \\N\{ (?>[^0-9\}][^\}]*) \} | | 
| 5332 |  |  |  |  |  |  | \\ $q_char                           | | 
| 5333 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 5334 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 5335 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 5336 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)                    | | 
| 5337 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 5338 |  |  |  |  |  |  | \$ \$ (?![\w\{])                     | | 
| 5339 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 5340 |  |  |  |  |  |  | $q_char | 
| 5341 |  |  |  |  |  |  | ))/oxmsg; | 
| 5342 |  |  |  |  |  |  |  | 
| 5343 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 5344 |  |  |  |  |  |  |  | 
| 5345 |  |  |  |  |  |  | # "\L\u" --> "\u\L" | 
| 5346 | 0 | 0 | 0 |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5347 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 5348 |  |  |  |  |  |  | } | 
| 5349 |  |  |  |  |  |  |  | 
| 5350 |  |  |  |  |  |  | # "\U\l" --> "\l\U" | 
| 5351 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 5352 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 5353 |  |  |  |  |  |  | } | 
| 5354 |  |  |  |  |  |  |  | 
| 5355 |  |  |  |  |  |  | # octal escape sequence | 
| 5356 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 5357 | 0 |  |  |  |  |  | $char[$i] = Elatin6::octchr($1); | 
| 5358 |  |  |  |  |  |  | } | 
| 5359 |  |  |  |  |  |  |  | 
| 5360 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 5361 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 5362 | 0 |  |  |  |  |  | $char[$i] = Elatin6::hexchr($1); | 
| 5363 |  |  |  |  |  |  | } | 
| 5364 |  |  |  |  |  |  |  | 
| 5365 |  |  |  |  |  |  | # \N{CHARNAME} --> N{CHARNAME} | 
| 5366 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( N\{ ([^0-9\}][^\}]*) \} ) \z/oxms) { | 
| 5367 | 0 |  |  |  |  |  | $char[$i] = $1; | 
| 5368 |  |  |  |  |  |  | } | 
| 5369 |  |  |  |  |  |  |  | 
| 5370 | 0 | 0 |  |  |  |  | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5371 |  |  |  |  |  |  | } | 
| 5372 |  |  |  |  |  |  |  | 
| 5373 |  |  |  |  |  |  | # \u \l \U \L \F \Q \E | 
| 5374 | 0 |  |  |  |  |  | elsif ($char[$i] =~ /\A ([<>]) \z/oxms) { | 
| 5375 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 5376 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 5377 |  |  |  |  |  |  | } | 
| 5378 |  |  |  |  |  |  | } | 
| 5379 |  |  |  |  |  |  | elsif ($char[$i] eq '\u') { | 
| 5380 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ucfirst qq<'; | 
| 5381 | 0 |  |  |  |  |  | $left_e++; | 
| 5382 |  |  |  |  |  |  | } | 
| 5383 |  |  |  |  |  |  | elsif ($char[$i] eq '\l') { | 
| 5384 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lcfirst qq<'; | 
| 5385 | 0 |  |  |  |  |  | $left_e++; | 
| 5386 |  |  |  |  |  |  | } | 
| 5387 |  |  |  |  |  |  | elsif ($char[$i] eq '\U') { | 
| 5388 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::uc qq<'; | 
| 5389 | 0 |  |  |  |  |  | $left_e++; | 
| 5390 |  |  |  |  |  |  | } | 
| 5391 |  |  |  |  |  |  | elsif ($char[$i] eq '\L') { | 
| 5392 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lc qq<'; | 
| 5393 | 0 |  |  |  |  |  | $left_e++; | 
| 5394 |  |  |  |  |  |  | } | 
| 5395 |  |  |  |  |  |  | elsif ($char[$i] eq '\F') { | 
| 5396 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::fc qq<'; | 
| 5397 | 0 |  |  |  |  |  | $left_e++; | 
| 5398 |  |  |  |  |  |  | } | 
| 5399 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 5400 | 0 |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 5401 | 0 |  |  |  |  |  | $left_e++; | 
| 5402 |  |  |  |  |  |  | } | 
| 5403 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 5404 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 5405 | 0 |  |  |  |  |  | $char[$i] = '>]}'; | 
| 5406 | 0 |  |  |  |  |  | $right_e++; | 
| 5407 |  |  |  |  |  |  | } | 
| 5408 |  |  |  |  |  |  | else { | 
| 5409 | 0 |  |  |  |  |  | $char[$i] = ''; | 
| 5410 |  |  |  |  |  |  | } | 
| 5411 |  |  |  |  |  |  | } | 
| 5412 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 5413 | 0 |  |  |  |  |  | while (1) { | 
| 5414 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 5415 | 0 |  |  |  |  |  | last; | 
| 5416 |  |  |  |  |  |  | } | 
| 5417 | 0 | 0 |  |  |  |  | if ($char[$i] eq '\E') { | 
| 5418 | 0 |  |  |  |  |  | last; | 
| 5419 |  |  |  |  |  |  | } | 
| 5420 |  |  |  |  |  |  | } | 
| 5421 |  |  |  |  |  |  | } | 
| 5422 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 5423 |  |  |  |  |  |  | } | 
| 5424 |  |  |  |  |  |  |  | 
| 5425 |  |  |  |  |  |  | # $0 --> $0 | 
| 5426 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 5427 |  |  |  |  |  |  | } | 
| 5428 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 5429 |  |  |  |  |  |  | } | 
| 5430 |  |  |  |  |  |  |  | 
| 5431 |  |  |  |  |  |  | # $$ --> $$ | 
| 5432 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 5433 |  |  |  |  |  |  | } | 
| 5434 |  |  |  |  |  |  |  | 
| 5435 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 5436 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 5437 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 5438 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5439 |  |  |  |  |  |  | } | 
| 5440 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 5441 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5442 |  |  |  |  |  |  | } | 
| 5443 |  |  |  |  |  |  |  | 
| 5444 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 5445 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 5446 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 5447 |  |  |  |  |  |  | } | 
| 5448 |  |  |  |  |  |  |  | 
| 5449 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 5450 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 5451 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 5452 |  |  |  |  |  |  | } | 
| 5453 |  |  |  |  |  |  |  | 
| 5454 |  |  |  |  |  |  | # $$foo | 
| 5455 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 5456 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5457 |  |  |  |  |  |  | } | 
| 5458 |  |  |  |  |  |  |  | 
| 5459 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Elatin6::PREMATCH() | 
| 5460 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 5461 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::PREMATCH()]}'; | 
| 5462 |  |  |  |  |  |  | } | 
| 5463 |  |  |  |  |  |  |  | 
| 5464 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Elatin6::MATCH() | 
| 5465 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 5466 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::MATCH()]}'; | 
| 5467 |  |  |  |  |  |  | } | 
| 5468 |  |  |  |  |  |  |  | 
| 5469 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Elatin6::POSTMATCH() | 
| 5470 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 5471 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::POSTMATCH()]}'; | 
| 5472 |  |  |  |  |  |  | } | 
| 5473 |  |  |  |  |  |  |  | 
| 5474 |  |  |  |  |  |  | # ${ foo } --> ${ foo } | 
| 5475 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ (?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* ) \}                                \z/oxms) { | 
| 5476 |  |  |  |  |  |  | } | 
| 5477 |  |  |  |  |  |  |  | 
| 5478 |  |  |  |  |  |  | # ${ ... } | 
| 5479 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 5480 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5481 |  |  |  |  |  |  | } | 
| 5482 |  |  |  |  |  |  | } | 
| 5483 |  |  |  |  |  |  |  | 
| 5484 |  |  |  |  |  |  | # return string | 
| 5485 | 0 | 0 |  |  |  |  | if ($left_e > $right_e) { | 
| 5486 | 0 |  |  |  |  |  | return join '', @char, '>]}' x ($left_e - $right_e); | 
| 5487 |  |  |  |  |  |  | } | 
| 5488 | 0 |  |  |  |  |  | return     join '', @char; | 
| 5489 |  |  |  |  |  |  | } | 
| 5490 |  |  |  |  |  |  |  | 
| 5491 |  |  |  |  |  |  | # | 
| 5492 |  |  |  |  |  |  | # escape regexp (m//, qr//) | 
| 5493 |  |  |  |  |  |  | # | 
| 5494 |  |  |  |  |  |  | sub e_qr { | 
| 5495 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 5496 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 5497 |  |  |  |  |  |  |  | 
| 5498 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 5499 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 5500 | 0 |  |  |  |  |  | my $line = 0; | 
| 5501 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 5502 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 5503 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 5504 | 0 |  |  |  |  |  | last; | 
| 5505 |  |  |  |  |  |  | } | 
| 5506 |  |  |  |  |  |  | } | 
| 5507 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 5508 |  |  |  |  |  |  | } | 
| 5509 |  |  |  |  |  |  |  | 
| 5510 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 5511 |  |  |  |  |  |  |  | 
| 5512 |  |  |  |  |  |  | # literal null string pattern | 
| 5513 | 0 | 0 |  |  |  |  | if ($string eq '') { | 
|  |  | 0 |  |  |  |  |  | 
| 5514 | 0 |  |  |  |  |  | $modifier =~ tr/bB//d; | 
| 5515 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 5516 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 5517 |  |  |  |  |  |  | } | 
| 5518 |  |  |  |  |  |  |  | 
| 5519 |  |  |  |  |  |  | # /b /B modifier | 
| 5520 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 5521 |  |  |  |  |  |  |  | 
| 5522 |  |  |  |  |  |  | # choice again delimiter | 
| 5523 | 0 | 0 |  |  |  |  | if ($delimiter =~ / [\@:] /oxms) { | 
| 5524 | 0 |  |  |  |  |  | my @char = $string =~ /\G ([\x00-\xFF]) /oxmsg; | 
| 5525 | 0 |  |  |  |  |  | my %octet = map {$_ => 1} @char; | 
|  | 0 |  |  |  |  |  |  | 
| 5526 | 0 | 0 |  |  |  |  | if (not $octet{')'}) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5527 | 0 |  |  |  |  |  | $delimiter     = '('; | 
| 5528 | 0 |  |  |  |  |  | $end_delimiter = ')'; | 
| 5529 |  |  |  |  |  |  | } | 
| 5530 |  |  |  |  |  |  | elsif (not $octet{'}'}) { | 
| 5531 | 0 |  |  |  |  |  | $delimiter     = '{'; | 
| 5532 | 0 |  |  |  |  |  | $end_delimiter = '}'; | 
| 5533 |  |  |  |  |  |  | } | 
| 5534 |  |  |  |  |  |  | elsif (not $octet{']'}) { | 
| 5535 | 0 |  |  |  |  |  | $delimiter     = '['; | 
| 5536 | 0 |  |  |  |  |  | $end_delimiter = ']'; | 
| 5537 |  |  |  |  |  |  | } | 
| 5538 |  |  |  |  |  |  | elsif (not $octet{'>'}) { | 
| 5539 | 0 |  |  |  |  |  | $delimiter     = '<'; | 
| 5540 | 0 |  |  |  |  |  | $end_delimiter = '>'; | 
| 5541 |  |  |  |  |  |  | } | 
| 5542 |  |  |  |  |  |  | else { | 
| 5543 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 5544 | 0 | 0 |  |  |  |  | if (not $octet{$char}) { | 
| 5545 | 0 |  |  |  |  |  | $delimiter     = $char; | 
| 5546 | 0 |  |  |  |  |  | $end_delimiter = $char; | 
| 5547 | 0 |  |  |  |  |  | last; | 
| 5548 |  |  |  |  |  |  | } | 
| 5549 |  |  |  |  |  |  | } | 
| 5550 |  |  |  |  |  |  | } | 
| 5551 |  |  |  |  |  |  | } | 
| 5552 |  |  |  |  |  |  |  | 
| 5553 | 0 | 0 | 0 |  |  |  | if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 5554 | 0 |  |  |  |  |  | return join '', $ope, $delimiter,        $string,      $matched, $end_delimiter, $modifier; | 
| 5555 |  |  |  |  |  |  | } | 
| 5556 |  |  |  |  |  |  | else { | 
| 5557 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, '(?:', $string, ')', $matched, $end_delimiter, $modifier; | 
| 5558 |  |  |  |  |  |  | } | 
| 5559 |  |  |  |  |  |  | } | 
| 5560 |  |  |  |  |  |  |  | 
| 5561 | 0 | 0 |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 5562 | 0 |  |  |  |  |  | my $metachar = qr/[\@\\|[\]{^]/oxms; | 
| 5563 |  |  |  |  |  |  |  | 
| 5564 |  |  |  |  |  |  | # split regexp | 
| 5565 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 5566 |  |  |  |  |  |  | [^\\\$\@\[\(] | | 
| 5567 |  |  |  |  |  |  | \\x   (?>[0-9A-Fa-f]{1,2}) | | 
| 5568 |  |  |  |  |  |  | \\    (?>[0-7]{2,3})       | | 
| 5569 |  |  |  |  |  |  | \\c   [\x40-\x5F]          | | 
| 5570 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}  | | 
| 5571 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}  | | 
| 5572 |  |  |  |  |  |  | \\[bBNpP]\{ (?>[^0-9\}][^\}]*) \} | | 
| 5573 |  |  |  |  |  |  | \\  $q_char                | | 
| 5574 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 5575 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 5576 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 5577 |  |  |  |  |  |  | [\$\@] $qq_variable        | | 
| 5578 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)          | | 
| 5579 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 5580 |  |  |  |  |  |  | \$ \$ (?![\w\{])           | | 
| 5581 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 5582 |  |  |  |  |  |  | \[\^                       | | 
| 5583 |  |  |  |  |  |  | \[\:   (?>[a-z]+) :\]      | | 
| 5584 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) :\]      | | 
| 5585 |  |  |  |  |  |  | \(\?                       | | 
| 5586 |  |  |  |  |  |  | $q_char | 
| 5587 |  |  |  |  |  |  | ))/oxmsg; | 
| 5588 |  |  |  |  |  |  |  | 
| 5589 |  |  |  |  |  |  | # choice again delimiter | 
| 5590 | 0 | 0 |  |  |  |  | if ($delimiter =~ / [\@:] /oxms) { | 
| 5591 | 0 |  |  |  |  |  | my %octet = map {$_ => 1} @char; | 
|  | 0 |  |  |  |  |  |  | 
| 5592 | 0 | 0 |  |  |  |  | if (not $octet{')'}) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5593 | 0 |  |  |  |  |  | $delimiter     = '('; | 
| 5594 | 0 |  |  |  |  |  | $end_delimiter = ')'; | 
| 5595 |  |  |  |  |  |  | } | 
| 5596 |  |  |  |  |  |  | elsif (not $octet{'}'}) { | 
| 5597 | 0 |  |  |  |  |  | $delimiter     = '{'; | 
| 5598 | 0 |  |  |  |  |  | $end_delimiter = '}'; | 
| 5599 |  |  |  |  |  |  | } | 
| 5600 |  |  |  |  |  |  | elsif (not $octet{']'}) { | 
| 5601 | 0 |  |  |  |  |  | $delimiter     = '['; | 
| 5602 | 0 |  |  |  |  |  | $end_delimiter = ']'; | 
| 5603 |  |  |  |  |  |  | } | 
| 5604 |  |  |  |  |  |  | elsif (not $octet{'>'}) { | 
| 5605 | 0 |  |  |  |  |  | $delimiter     = '<'; | 
| 5606 | 0 |  |  |  |  |  | $end_delimiter = '>'; | 
| 5607 |  |  |  |  |  |  | } | 
| 5608 |  |  |  |  |  |  | else { | 
| 5609 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 5610 | 0 | 0 |  |  |  |  | if (not $octet{$char}) { | 
| 5611 | 0 |  |  |  |  |  | $delimiter     = $char; | 
| 5612 | 0 |  |  |  |  |  | $end_delimiter = $char; | 
| 5613 | 0 |  |  |  |  |  | last; | 
| 5614 |  |  |  |  |  |  | } | 
| 5615 |  |  |  |  |  |  | } | 
| 5616 |  |  |  |  |  |  | } | 
| 5617 |  |  |  |  |  |  | } | 
| 5618 |  |  |  |  |  |  |  | 
| 5619 | 0 |  |  |  |  |  | my $left_e  = 0; | 
| 5620 | 0 |  |  |  |  |  | my $right_e = 0; | 
| 5621 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 5622 |  |  |  |  |  |  |  | 
| 5623 |  |  |  |  |  |  | # "\L\u" --> "\u\L" | 
| 5624 | 0 | 0 | 0 |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 5625 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 5626 |  |  |  |  |  |  | } | 
| 5627 |  |  |  |  |  |  |  | 
| 5628 |  |  |  |  |  |  | # "\U\l" --> "\l\U" | 
| 5629 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 5630 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 5631 |  |  |  |  |  |  | } | 
| 5632 |  |  |  |  |  |  |  | 
| 5633 |  |  |  |  |  |  | # octal escape sequence | 
| 5634 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 5635 | 0 |  |  |  |  |  | $char[$i] = Elatin6::octchr($1); | 
| 5636 |  |  |  |  |  |  | } | 
| 5637 |  |  |  |  |  |  |  | 
| 5638 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 5639 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 5640 | 0 |  |  |  |  |  | $char[$i] = Elatin6::hexchr($1); | 
| 5641 |  |  |  |  |  |  | } | 
| 5642 |  |  |  |  |  |  |  | 
| 5643 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 5644 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 5645 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 5646 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 5647 |  |  |  |  |  |  | # \P{PROPERTY} --> P\{PROPERTY} | 
| 5648 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^0-9\}][^\}]*) \} ) \z/oxms) { | 
| 5649 | 0 |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 5650 |  |  |  |  |  |  | } | 
| 5651 |  |  |  |  |  |  |  | 
| 5652 |  |  |  |  |  |  | # \p, \P, \X --> p, P, X | 
| 5653 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 5654 | 0 |  |  |  |  |  | $char[$i] = $1; | 
| 5655 |  |  |  |  |  |  | } | 
| 5656 |  |  |  |  |  |  |  | 
| 5657 | 0 | 0 | 0 |  |  |  | if (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 |  |  |  |  |  | 
| 5658 |  |  |  |  |  |  | } | 
| 5659 |  |  |  |  |  |  |  | 
| 5660 |  |  |  |  |  |  | # join separated multiple-octet | 
| 5661 | 0 |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 5662 | 0 | 0 | 0 |  |  |  | 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)) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 5663 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 3; | 
| 5664 |  |  |  |  |  |  | } | 
| 5665 |  |  |  |  |  |  | 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)) { | 
| 5666 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 2; | 
| 5667 |  |  |  |  |  |  | } | 
| 5668 |  |  |  |  |  |  | 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)) { | 
| 5669 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 1; | 
| 5670 |  |  |  |  |  |  | } | 
| 5671 |  |  |  |  |  |  | } | 
| 5672 |  |  |  |  |  |  |  | 
| 5673 |  |  |  |  |  |  | # open character class [...] | 
| 5674 |  |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 5675 | 0 |  |  |  |  |  | my $left = $i; | 
| 5676 |  |  |  |  |  |  |  | 
| 5677 |  |  |  |  |  |  | # [] make die "Unmatched [] in regexp ...\n" | 
| 5678 |  |  |  |  |  |  | # (and so on) | 
| 5679 |  |  |  |  |  |  |  | 
| 5680 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 5681 | 0 |  |  |  |  |  | $i++; | 
| 5682 |  |  |  |  |  |  | } | 
| 5683 |  |  |  |  |  |  |  | 
| 5684 | 0 |  |  |  |  |  | while (1) { | 
| 5685 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 5686 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 5687 |  |  |  |  |  |  | } | 
| 5688 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 5689 | 0 |  |  |  |  |  | my $right = $i; | 
| 5690 |  |  |  |  |  |  |  | 
| 5691 |  |  |  |  |  |  | # [...] | 
| 5692 | 0 | 0 |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 5693 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Elatin6::charlist_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
|  | 0 |  |  |  |  |  |  | 
| 5694 |  |  |  |  |  |  | } | 
| 5695 |  |  |  |  |  |  | else { | 
| 5696 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 5697 |  |  |  |  |  |  | } | 
| 5698 |  |  |  |  |  |  |  | 
| 5699 | 0 |  |  |  |  |  | $i = $left; | 
| 5700 | 0 |  |  |  |  |  | last; | 
| 5701 |  |  |  |  |  |  | } | 
| 5702 |  |  |  |  |  |  | } | 
| 5703 |  |  |  |  |  |  | } | 
| 5704 |  |  |  |  |  |  |  | 
| 5705 |  |  |  |  |  |  | # open character class [^...] | 
| 5706 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 5707 | 0 |  |  |  |  |  | my $left = $i; | 
| 5708 |  |  |  |  |  |  |  | 
| 5709 |  |  |  |  |  |  | # [^] make die "Unmatched [] in regexp ...\n" | 
| 5710 |  |  |  |  |  |  | # (and so on) | 
| 5711 |  |  |  |  |  |  |  | 
| 5712 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 5713 | 0 |  |  |  |  |  | $i++; | 
| 5714 |  |  |  |  |  |  | } | 
| 5715 |  |  |  |  |  |  |  | 
| 5716 | 0 |  |  |  |  |  | while (1) { | 
| 5717 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 5718 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 5719 |  |  |  |  |  |  | } | 
| 5720 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 5721 | 0 |  |  |  |  |  | my $right = $i; | 
| 5722 |  |  |  |  |  |  |  | 
| 5723 |  |  |  |  |  |  | # [^...] | 
| 5724 | 0 | 0 |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 5725 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Elatin6::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
|  | 0 |  |  |  |  |  |  | 
| 5726 |  |  |  |  |  |  | } | 
| 5727 |  |  |  |  |  |  | else { | 
| 5728 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 5729 |  |  |  |  |  |  | } | 
| 5730 |  |  |  |  |  |  |  | 
| 5731 | 0 |  |  |  |  |  | $i = $left; | 
| 5732 | 0 |  |  |  |  |  | last; | 
| 5733 |  |  |  |  |  |  | } | 
| 5734 |  |  |  |  |  |  | } | 
| 5735 |  |  |  |  |  |  | } | 
| 5736 |  |  |  |  |  |  |  | 
| 5737 |  |  |  |  |  |  | # rewrite character class or escape character | 
| 5738 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 5739 | 0 |  |  |  |  |  | $char[$i] = $char; | 
| 5740 |  |  |  |  |  |  | } | 
| 5741 |  |  |  |  |  |  |  | 
| 5742 |  |  |  |  |  |  | # /i modifier | 
| 5743 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Elatin6::uc($char[$i]) ne Elatin6::fc($char[$i]))) { | 
| 5744 | 0 | 0 |  |  |  |  | if (CORE::length(Elatin6::fc($char[$i])) == 1) { | 
| 5745 | 0 |  |  |  |  |  | $char[$i] = '['   . Elatin6::uc($char[$i])       . Elatin6::fc($char[$i]) . ']'; | 
| 5746 |  |  |  |  |  |  | } | 
| 5747 |  |  |  |  |  |  | else { | 
| 5748 | 0 |  |  |  |  |  | $char[$i] = '(?:' . Elatin6::uc($char[$i]) . '|' . Elatin6::fc($char[$i]) . ')'; | 
| 5749 |  |  |  |  |  |  | } | 
| 5750 |  |  |  |  |  |  | } | 
| 5751 |  |  |  |  |  |  |  | 
| 5752 |  |  |  |  |  |  | # \u \l \U \L \F \Q \E | 
| 5753 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [<>] \z/oxms) { | 
| 5754 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 5755 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 5756 |  |  |  |  |  |  | } | 
| 5757 |  |  |  |  |  |  | } | 
| 5758 |  |  |  |  |  |  | elsif ($char[$i] eq '\u') { | 
| 5759 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ucfirst qq<'; | 
| 5760 | 0 |  |  |  |  |  | $left_e++; | 
| 5761 |  |  |  |  |  |  | } | 
| 5762 |  |  |  |  |  |  | elsif ($char[$i] eq '\l') { | 
| 5763 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lcfirst qq<'; | 
| 5764 | 0 |  |  |  |  |  | $left_e++; | 
| 5765 |  |  |  |  |  |  | } | 
| 5766 |  |  |  |  |  |  | elsif ($char[$i] eq '\U') { | 
| 5767 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::uc qq<'; | 
| 5768 | 0 |  |  |  |  |  | $left_e++; | 
| 5769 |  |  |  |  |  |  | } | 
| 5770 |  |  |  |  |  |  | elsif ($char[$i] eq '\L') { | 
| 5771 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lc qq<'; | 
| 5772 | 0 |  |  |  |  |  | $left_e++; | 
| 5773 |  |  |  |  |  |  | } | 
| 5774 |  |  |  |  |  |  | elsif ($char[$i] eq '\F') { | 
| 5775 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::fc qq<'; | 
| 5776 | 0 |  |  |  |  |  | $left_e++; | 
| 5777 |  |  |  |  |  |  | } | 
| 5778 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 5779 | 0 |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 5780 | 0 |  |  |  |  |  | $left_e++; | 
| 5781 |  |  |  |  |  |  | } | 
| 5782 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 5783 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 5784 | 0 |  |  |  |  |  | $char[$i] = '>]}'; | 
| 5785 | 0 |  |  |  |  |  | $right_e++; | 
| 5786 |  |  |  |  |  |  | } | 
| 5787 |  |  |  |  |  |  | else { | 
| 5788 | 0 |  |  |  |  |  | $char[$i] = ''; | 
| 5789 |  |  |  |  |  |  | } | 
| 5790 |  |  |  |  |  |  | } | 
| 5791 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 5792 | 0 |  |  |  |  |  | while (1) { | 
| 5793 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 5794 | 0 |  |  |  |  |  | last; | 
| 5795 |  |  |  |  |  |  | } | 
| 5796 | 0 | 0 |  |  |  |  | if ($char[$i] eq '\E') { | 
| 5797 | 0 |  |  |  |  |  | last; | 
| 5798 |  |  |  |  |  |  | } | 
| 5799 |  |  |  |  |  |  | } | 
| 5800 |  |  |  |  |  |  | } | 
| 5801 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 5802 |  |  |  |  |  |  | } | 
| 5803 |  |  |  |  |  |  |  | 
| 5804 |  |  |  |  |  |  | # $0 --> $0 | 
| 5805 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 5806 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5807 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5808 |  |  |  |  |  |  | } | 
| 5809 |  |  |  |  |  |  | } | 
| 5810 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 5811 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5812 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5813 |  |  |  |  |  |  | } | 
| 5814 |  |  |  |  |  |  | } | 
| 5815 |  |  |  |  |  |  |  | 
| 5816 |  |  |  |  |  |  | # $$ --> $$ | 
| 5817 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 5818 |  |  |  |  |  |  | } | 
| 5819 |  |  |  |  |  |  |  | 
| 5820 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 5821 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 5822 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 5823 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5824 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5825 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5826 |  |  |  |  |  |  | } | 
| 5827 |  |  |  |  |  |  | } | 
| 5828 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 5829 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5830 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5831 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5832 |  |  |  |  |  |  | } | 
| 5833 |  |  |  |  |  |  | } | 
| 5834 |  |  |  |  |  |  |  | 
| 5835 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 5836 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 5837 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 5838 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5839 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5840 |  |  |  |  |  |  | } | 
| 5841 |  |  |  |  |  |  | } | 
| 5842 |  |  |  |  |  |  |  | 
| 5843 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 5844 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 5845 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 5846 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5847 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5848 |  |  |  |  |  |  | } | 
| 5849 |  |  |  |  |  |  | } | 
| 5850 |  |  |  |  |  |  |  | 
| 5851 |  |  |  |  |  |  | # $$foo | 
| 5852 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 5853 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5854 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5855 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5856 |  |  |  |  |  |  | } | 
| 5857 |  |  |  |  |  |  | } | 
| 5858 |  |  |  |  |  |  |  | 
| 5859 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Elatin6::PREMATCH() | 
| 5860 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 5861 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5862 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::PREMATCH())]}'; | 
| 5863 |  |  |  |  |  |  | } | 
| 5864 |  |  |  |  |  |  | else { | 
| 5865 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::PREMATCH()]}'; | 
| 5866 |  |  |  |  |  |  | } | 
| 5867 |  |  |  |  |  |  | } | 
| 5868 |  |  |  |  |  |  |  | 
| 5869 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Elatin6::MATCH() | 
| 5870 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 5871 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5872 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::MATCH())]}'; | 
| 5873 |  |  |  |  |  |  | } | 
| 5874 |  |  |  |  |  |  | else { | 
| 5875 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::MATCH()]}'; | 
| 5876 |  |  |  |  |  |  | } | 
| 5877 |  |  |  |  |  |  | } | 
| 5878 |  |  |  |  |  |  |  | 
| 5879 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Elatin6::POSTMATCH() | 
| 5880 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 5881 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5882 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::POSTMATCH())]}'; | 
| 5883 |  |  |  |  |  |  | } | 
| 5884 |  |  |  |  |  |  | else { | 
| 5885 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::POSTMATCH()]}'; | 
| 5886 |  |  |  |  |  |  | } | 
| 5887 |  |  |  |  |  |  | } | 
| 5888 |  |  |  |  |  |  |  | 
| 5889 |  |  |  |  |  |  | # ${ foo } | 
| 5890 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \}                              \z/oxms) { | 
| 5891 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5892 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5893 |  |  |  |  |  |  | } | 
| 5894 |  |  |  |  |  |  | } | 
| 5895 |  |  |  |  |  |  |  | 
| 5896 |  |  |  |  |  |  | # ${ ... } | 
| 5897 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 5898 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 5899 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5900 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5901 |  |  |  |  |  |  | } | 
| 5902 |  |  |  |  |  |  | } | 
| 5903 |  |  |  |  |  |  |  | 
| 5904 |  |  |  |  |  |  | # $scalar or @array | 
| 5905 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@].+ /oxms) { | 
| 5906 | 0 |  |  |  |  |  | $char[$i] = e_string($char[$i]); | 
| 5907 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 5908 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 5909 |  |  |  |  |  |  | } | 
| 5910 |  |  |  |  |  |  | } | 
| 5911 |  |  |  |  |  |  |  | 
| 5912 |  |  |  |  |  |  | # quote character before ? + * { | 
| 5913 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 5914 | 0 | 0 | 0 |  |  |  | if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) { | 
|  |  | 0 |  |  |  |  |  | 
| 5915 |  |  |  |  |  |  | } | 
| 5916 |  |  |  |  |  |  | elsif (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 5917 | 0 |  |  |  |  |  | my $char = $char[$i-1]; | 
| 5918 | 0 | 0 |  |  |  |  | if ($char[$i] eq '{') { | 
| 5919 | 0 |  |  |  |  |  | die __FILE__, qq{: "MULTIBYTE{n}" should be "(MULTIBYTE){n}" in m?? (and shift \$1,\$2,\$3,...) ($char){n}\n}; | 
| 5920 |  |  |  |  |  |  | } | 
| 5921 |  |  |  |  |  |  | else { | 
| 5922 | 0 |  |  |  |  |  | die __FILE__, qq{: "MULTIBYTE$char[$i]" should be "(MULTIBYTE)$char[$i]" in m?? (and shift \$1,\$2,\$3,...) ($char)$char[$i]\n}; | 
| 5923 |  |  |  |  |  |  | } | 
| 5924 |  |  |  |  |  |  | } | 
| 5925 |  |  |  |  |  |  | else { | 
| 5926 | 0 |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 5927 |  |  |  |  |  |  | } | 
| 5928 |  |  |  |  |  |  | } | 
| 5929 |  |  |  |  |  |  | } | 
| 5930 |  |  |  |  |  |  |  | 
| 5931 |  |  |  |  |  |  | # make regexp string | 
| 5932 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 5933 | 0 | 0 |  |  |  |  | if ($left_e > $right_e) { | 
| 5934 | 0 | 0 | 0 |  |  |  | if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 5935 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $anchor,        @char, '>]}' x ($left_e - $right_e),      $matched, $end_delimiter, $modifier; | 
| 5936 |  |  |  |  |  |  | } | 
| 5937 |  |  |  |  |  |  | else { | 
| 5938 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $anchor, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier; | 
| 5939 |  |  |  |  |  |  | } | 
| 5940 |  |  |  |  |  |  | } | 
| 5941 | 0 | 0 | 0 |  |  |  | if (($ope =~ /\A m? \z/oxms) and ($delimiter eq '?')) { | 
| 5942 | 0 |  |  |  |  |  | return     join '', $ope, $delimiter, $anchor,        @char,                                    $matched, $end_delimiter, $modifier; | 
| 5943 |  |  |  |  |  |  | } | 
| 5944 |  |  |  |  |  |  | else { | 
| 5945 | 0 |  |  |  |  |  | return     join '', $ope, $delimiter, $anchor, '(?:', @char,                               ')', $matched, $end_delimiter, $modifier; | 
| 5946 |  |  |  |  |  |  | } | 
| 5947 |  |  |  |  |  |  | } | 
| 5948 |  |  |  |  |  |  |  | 
| 5949 |  |  |  |  |  |  | # | 
| 5950 |  |  |  |  |  |  | # double quote stuff | 
| 5951 |  |  |  |  |  |  | # | 
| 5952 |  |  |  |  |  |  | sub qq_stuff { | 
| 5953 | 0 |  |  | 0 | 0 |  | my($delimiter,$end_delimiter,$stuff) = @_; | 
| 5954 |  |  |  |  |  |  |  | 
| 5955 |  |  |  |  |  |  | # scalar variable or array variable | 
| 5956 | 0 | 0 |  |  |  |  | if ($stuff =~ /\A [\$\@] /oxms) { | 
| 5957 | 0 |  |  |  |  |  | return $stuff; | 
| 5958 |  |  |  |  |  |  | } | 
| 5959 |  |  |  |  |  |  |  | 
| 5960 |  |  |  |  |  |  | # quote by delimiter | 
| 5961 | 0 |  |  |  |  |  | my %octet = map {$_ => 1} ($stuff =~ /\G ([\x00-\xFF]) /oxmsg); | 
|  | 0 |  |  |  |  |  |  | 
| 5962 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + - . / : = ? @ ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 5963 | 0 | 0 |  |  |  |  | next if $char eq $delimiter; | 
| 5964 | 0 | 0 |  |  |  |  | next if $char eq $end_delimiter; | 
| 5965 | 0 | 0 |  |  |  |  | if (not $octet{$char}) { | 
| 5966 | 0 |  |  |  |  |  | return join '', 'qq', $char, $stuff, $char; | 
| 5967 |  |  |  |  |  |  | } | 
| 5968 |  |  |  |  |  |  | } | 
| 5969 | 0 |  |  |  |  |  | return join '', 'qq', '<', $stuff, '>'; | 
| 5970 |  |  |  |  |  |  | } | 
| 5971 |  |  |  |  |  |  |  | 
| 5972 |  |  |  |  |  |  | # | 
| 5973 |  |  |  |  |  |  | # escape regexp (m'', qr'', and m''b, qr''b) | 
| 5974 |  |  |  |  |  |  | # | 
| 5975 |  |  |  |  |  |  | sub e_qr_q { | 
| 5976 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 5977 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 5978 |  |  |  |  |  |  |  | 
| 5979 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 5980 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 5981 | 0 |  |  |  |  |  | my $line = 0; | 
| 5982 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 5983 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 5984 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 5985 | 0 |  |  |  |  |  | last; | 
| 5986 |  |  |  |  |  |  | } | 
| 5987 |  |  |  |  |  |  | } | 
| 5988 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 5989 |  |  |  |  |  |  | } | 
| 5990 |  |  |  |  |  |  |  | 
| 5991 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 5992 |  |  |  |  |  |  |  | 
| 5993 |  |  |  |  |  |  | # literal null string pattern | 
| 5994 | 0 | 0 |  |  |  |  | if ($string eq '') { | 
|  |  | 0 |  |  |  |  |  | 
| 5995 | 0 |  |  |  |  |  | $modifier =~ tr/bB//d; | 
| 5996 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 5997 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 5998 |  |  |  |  |  |  | } | 
| 5999 |  |  |  |  |  |  |  | 
| 6000 |  |  |  |  |  |  | # with /b /B modifier | 
| 6001 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 6002 | 0 |  |  |  |  |  | return e_qr_qb($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 6003 |  |  |  |  |  |  | } | 
| 6004 |  |  |  |  |  |  |  | 
| 6005 |  |  |  |  |  |  | # without /b /B modifier | 
| 6006 |  |  |  |  |  |  | else { | 
| 6007 | 0 |  |  |  |  |  | return e_qr_qt($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 6008 |  |  |  |  |  |  | } | 
| 6009 |  |  |  |  |  |  | } | 
| 6010 |  |  |  |  |  |  |  | 
| 6011 |  |  |  |  |  |  | # | 
| 6012 |  |  |  |  |  |  | # escape regexp (m'', qr'') | 
| 6013 |  |  |  |  |  |  | # | 
| 6014 |  |  |  |  |  |  | sub e_qr_qt { | 
| 6015 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6016 |  |  |  |  |  |  |  | 
| 6017 | 0 | 0 |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 6018 |  |  |  |  |  |  |  | 
| 6019 |  |  |  |  |  |  | # split regexp | 
| 6020 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 6021 |  |  |  |  |  |  | [^\\\[\$\@\/] | | 
| 6022 |  |  |  |  |  |  | [\x00-\xFF] | | 
| 6023 |  |  |  |  |  |  | \[\^                            | | 
| 6024 |  |  |  |  |  |  | \[\:   (?>[a-z]+) \:\]          | | 
| 6025 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) \:\]          | | 
| 6026 |  |  |  |  |  |  | [\$\@\/]                        | | 
| 6027 |  |  |  |  |  |  | \\     (?:$q_char)              | | 
| 6028 |  |  |  |  |  |  | (?:$q_char) | 
| 6029 |  |  |  |  |  |  | ))/oxmsg; | 
| 6030 |  |  |  |  |  |  |  | 
| 6031 |  |  |  |  |  |  | # unescape character | 
| 6032 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 6033 | 0 | 0 | 0 |  |  |  | if (0) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6034 |  |  |  |  |  |  | } | 
| 6035 |  |  |  |  |  |  |  | 
| 6036 |  |  |  |  |  |  | # open character class [...] | 
| 6037 | 0 |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 6038 | 0 |  |  |  |  |  | my $left = $i; | 
| 6039 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 6040 | 0 |  |  |  |  |  | $i++; | 
| 6041 |  |  |  |  |  |  | } | 
| 6042 | 0 |  |  |  |  |  | while (1) { | 
| 6043 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6044 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 6045 |  |  |  |  |  |  | } | 
| 6046 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 6047 | 0 |  |  |  |  |  | my $right = $i; | 
| 6048 |  |  |  |  |  |  |  | 
| 6049 |  |  |  |  |  |  | # [...] | 
| 6050 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 6051 |  |  |  |  |  |  |  | 
| 6052 | 0 |  |  |  |  |  | $i = $left; | 
| 6053 | 0 |  |  |  |  |  | last; | 
| 6054 |  |  |  |  |  |  | } | 
| 6055 |  |  |  |  |  |  | } | 
| 6056 |  |  |  |  |  |  | } | 
| 6057 |  |  |  |  |  |  |  | 
| 6058 |  |  |  |  |  |  | # open character class [^...] | 
| 6059 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 6060 | 0 |  |  |  |  |  | my $left = $i; | 
| 6061 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 6062 | 0 |  |  |  |  |  | $i++; | 
| 6063 |  |  |  |  |  |  | } | 
| 6064 | 0 |  |  |  |  |  | while (1) { | 
| 6065 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6066 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 6067 |  |  |  |  |  |  | } | 
| 6068 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 6069 | 0 |  |  |  |  |  | my $right = $i; | 
| 6070 |  |  |  |  |  |  |  | 
| 6071 |  |  |  |  |  |  | # [^...] | 
| 6072 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 6073 |  |  |  |  |  |  |  | 
| 6074 | 0 |  |  |  |  |  | $i = $left; | 
| 6075 | 0 |  |  |  |  |  | last; | 
| 6076 |  |  |  |  |  |  | } | 
| 6077 |  |  |  |  |  |  | } | 
| 6078 |  |  |  |  |  |  | } | 
| 6079 |  |  |  |  |  |  |  | 
| 6080 |  |  |  |  |  |  | # escape $ @ / and \ | 
| 6081 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 6082 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 6083 |  |  |  |  |  |  | } | 
| 6084 |  |  |  |  |  |  |  | 
| 6085 |  |  |  |  |  |  | # rewrite character class or escape character | 
| 6086 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 6087 | 0 |  |  |  |  |  | $char[$i] = $char; | 
| 6088 |  |  |  |  |  |  | } | 
| 6089 |  |  |  |  |  |  |  | 
| 6090 |  |  |  |  |  |  | # /i modifier | 
| 6091 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Elatin6::uc($char[$i]) ne Elatin6::fc($char[$i]))) { | 
| 6092 | 0 | 0 |  |  |  |  | if (CORE::length(Elatin6::fc($char[$i])) == 1) { | 
| 6093 | 0 |  |  |  |  |  | $char[$i] = '['   . Elatin6::uc($char[$i])       . Elatin6::fc($char[$i]) . ']'; | 
| 6094 |  |  |  |  |  |  | } | 
| 6095 |  |  |  |  |  |  | else { | 
| 6096 | 0 |  |  |  |  |  | $char[$i] = '(?:' . Elatin6::uc($char[$i]) . '|' . Elatin6::fc($char[$i]) . ')'; | 
| 6097 |  |  |  |  |  |  | } | 
| 6098 |  |  |  |  |  |  | } | 
| 6099 |  |  |  |  |  |  |  | 
| 6100 |  |  |  |  |  |  | # quote character before ? + * { | 
| 6101 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 6102 | 0 | 0 |  |  |  |  | if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 6103 |  |  |  |  |  |  | } | 
| 6104 |  |  |  |  |  |  | else { | 
| 6105 | 0 |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 6106 |  |  |  |  |  |  | } | 
| 6107 |  |  |  |  |  |  | } | 
| 6108 |  |  |  |  |  |  | } | 
| 6109 |  |  |  |  |  |  |  | 
| 6110 | 0 |  |  |  |  |  | $delimiter     = '/'; | 
| 6111 | 0 |  |  |  |  |  | $end_delimiter = '/'; | 
| 6112 |  |  |  |  |  |  |  | 
| 6113 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 6114 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $anchor, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 6115 |  |  |  |  |  |  | } | 
| 6116 |  |  |  |  |  |  |  | 
| 6117 |  |  |  |  |  |  | # | 
| 6118 |  |  |  |  |  |  | # escape regexp (m''b, qr''b) | 
| 6119 |  |  |  |  |  |  | # | 
| 6120 |  |  |  |  |  |  | sub e_qr_qb { | 
| 6121 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6122 |  |  |  |  |  |  |  | 
| 6123 |  |  |  |  |  |  | # split regexp | 
| 6124 | 0 |  |  |  |  |  | my @char = $string =~ /\G ((?>[^\\]|\\\\)) /oxmsg; | 
| 6125 |  |  |  |  |  |  |  | 
| 6126 |  |  |  |  |  |  | # unescape character | 
| 6127 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 6128 | 0 | 0 |  |  |  |  | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
| 6129 |  |  |  |  |  |  | } | 
| 6130 |  |  |  |  |  |  |  | 
| 6131 |  |  |  |  |  |  | # remain \\ | 
| 6132 | 0 |  |  |  |  |  | elsif ($char[$i] eq '\\\\') { | 
| 6133 |  |  |  |  |  |  | } | 
| 6134 |  |  |  |  |  |  |  | 
| 6135 |  |  |  |  |  |  | # escape $ @ / and \ | 
| 6136 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 6137 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 6138 |  |  |  |  |  |  | } | 
| 6139 |  |  |  |  |  |  | } | 
| 6140 |  |  |  |  |  |  |  | 
| 6141 | 0 |  |  |  |  |  | $delimiter     = '/'; | 
| 6142 | 0 |  |  |  |  |  | $end_delimiter = '/'; | 
| 6143 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 6144 |  |  |  |  |  |  | } | 
| 6145 |  |  |  |  |  |  |  | 
| 6146 |  |  |  |  |  |  | # | 
| 6147 |  |  |  |  |  |  | # escape regexp (s/here//) | 
| 6148 |  |  |  |  |  |  | # | 
| 6149 |  |  |  |  |  |  | sub e_s1 { | 
| 6150 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6151 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 6152 |  |  |  |  |  |  |  | 
| 6153 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 6154 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 6155 | 0 |  |  |  |  |  | my $line = 0; | 
| 6156 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 6157 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 6158 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 6159 | 0 |  |  |  |  |  | last; | 
| 6160 |  |  |  |  |  |  | } | 
| 6161 |  |  |  |  |  |  | } | 
| 6162 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 6163 |  |  |  |  |  |  | } | 
| 6164 |  |  |  |  |  |  |  | 
| 6165 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 6166 |  |  |  |  |  |  |  | 
| 6167 |  |  |  |  |  |  | # literal null string pattern | 
| 6168 | 0 | 0 |  |  |  |  | if ($string eq '') { | 
|  |  | 0 |  |  |  |  |  | 
| 6169 | 0 |  |  |  |  |  | $modifier =~ tr/bB//d; | 
| 6170 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 6171 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 6172 |  |  |  |  |  |  | } | 
| 6173 |  |  |  |  |  |  |  | 
| 6174 |  |  |  |  |  |  | # /b /B modifier | 
| 6175 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 6176 |  |  |  |  |  |  |  | 
| 6177 |  |  |  |  |  |  | # choice again delimiter | 
| 6178 | 0 | 0 |  |  |  |  | if ($delimiter =~ / [\@:] /oxms) { | 
| 6179 | 0 |  |  |  |  |  | my @char = $string =~ /\G ([\x00-\xFF]) /oxmsg; | 
| 6180 | 0 |  |  |  |  |  | my %octet = map {$_ => 1} @char; | 
|  | 0 |  |  |  |  |  |  | 
| 6181 | 0 | 0 |  |  |  |  | if (not $octet{')'}) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6182 | 0 |  |  |  |  |  | $delimiter     = '('; | 
| 6183 | 0 |  |  |  |  |  | $end_delimiter = ')'; | 
| 6184 |  |  |  |  |  |  | } | 
| 6185 |  |  |  |  |  |  | elsif (not $octet{'}'}) { | 
| 6186 | 0 |  |  |  |  |  | $delimiter     = '{'; | 
| 6187 | 0 |  |  |  |  |  | $end_delimiter = '}'; | 
| 6188 |  |  |  |  |  |  | } | 
| 6189 |  |  |  |  |  |  | elsif (not $octet{']'}) { | 
| 6190 | 0 |  |  |  |  |  | $delimiter     = '['; | 
| 6191 | 0 |  |  |  |  |  | $end_delimiter = ']'; | 
| 6192 |  |  |  |  |  |  | } | 
| 6193 |  |  |  |  |  |  | elsif (not $octet{'>'}) { | 
| 6194 | 0 |  |  |  |  |  | $delimiter     = '<'; | 
| 6195 | 0 |  |  |  |  |  | $end_delimiter = '>'; | 
| 6196 |  |  |  |  |  |  | } | 
| 6197 |  |  |  |  |  |  | else { | 
| 6198 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 6199 | 0 | 0 |  |  |  |  | if (not $octet{$char}) { | 
| 6200 | 0 |  |  |  |  |  | $delimiter     = $char; | 
| 6201 | 0 |  |  |  |  |  | $end_delimiter = $char; | 
| 6202 | 0 |  |  |  |  |  | last; | 
| 6203 |  |  |  |  |  |  | } | 
| 6204 |  |  |  |  |  |  | } | 
| 6205 |  |  |  |  |  |  | } | 
| 6206 |  |  |  |  |  |  | } | 
| 6207 |  |  |  |  |  |  |  | 
| 6208 | 0 |  |  |  |  |  | my $prematch = ''; | 
| 6209 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', $string, ')', $matched, $end_delimiter, $modifier; | 
| 6210 |  |  |  |  |  |  | } | 
| 6211 |  |  |  |  |  |  |  | 
| 6212 | 0 | 0 |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 6213 | 0 |  |  |  |  |  | my $metachar = qr/[\@\\|[\]{^]/oxms; | 
| 6214 |  |  |  |  |  |  |  | 
| 6215 |  |  |  |  |  |  | # split regexp | 
| 6216 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 6217 |  |  |  |  |  |  | [^\\\$\@\[\(] | | 
| 6218 |  |  |  |  |  |  | \\                               (?>[1-9][0-9]*)            | | 
| 6219 |  |  |  |  |  |  | \\g (?>\s*)                      (?>[1-9][0-9]*)            | | 
| 6220 |  |  |  |  |  |  | \\g (?>\s*) \{ (?>\s*)           (?>[1-9][0-9]*) (?>\s*) \} | | 
| 6221 |  |  |  |  |  |  | \\g (?>\s*) \{ (?>\s*) - (?>\s*) (?>[1-9][0-9]*) (?>\s*) \} | | 
| 6222 |  |  |  |  |  |  | \\x                              (?>[0-9A-Fa-f]{1,2})       | | 
| 6223 |  |  |  |  |  |  | \\                               (?>[0-7]{2,3})             | | 
| 6224 |  |  |  |  |  |  | \\c                              [\x40-\x5F]                | | 
| 6225 |  |  |  |  |  |  | \\x\{                            (?>[0-9A-Fa-f]+)        \} | | 
| 6226 |  |  |  |  |  |  | \\o\{                            (?>[0-7]+)              \} | | 
| 6227 |  |  |  |  |  |  | \\[bBNpP]\{                      (?>[^0-9\}][^\}]*) \} | | 
| 6228 |  |  |  |  |  |  | \\ $q_char                           | | 
| 6229 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 6230 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 6231 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 6232 |  |  |  |  |  |  | [\$\@] $qq_variable                  | | 
| 6233 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)                    | | 
| 6234 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 6235 |  |  |  |  |  |  | \$ \$ (?![\w\{])                     | | 
| 6236 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 6237 |  |  |  |  |  |  | \[\^                                 | | 
| 6238 |  |  |  |  |  |  | \[\:   (?>[a-z]+) :\]                | | 
| 6239 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) :\]                | | 
| 6240 |  |  |  |  |  |  | \(\?                                 | | 
| 6241 |  |  |  |  |  |  | $q_char | 
| 6242 |  |  |  |  |  |  | ))/oxmsg; | 
| 6243 |  |  |  |  |  |  |  | 
| 6244 |  |  |  |  |  |  | # choice again delimiter | 
| 6245 | 0 | 0 |  |  |  |  | if ($delimiter =~ / [\@:] /oxms) { | 
| 6246 | 0 |  |  |  |  |  | my %octet = map {$_ => 1} @char; | 
|  | 0 |  |  |  |  |  |  | 
| 6247 | 0 | 0 |  |  |  |  | if (not $octet{')'}) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6248 | 0 |  |  |  |  |  | $delimiter     = '('; | 
| 6249 | 0 |  |  |  |  |  | $end_delimiter = ')'; | 
| 6250 |  |  |  |  |  |  | } | 
| 6251 |  |  |  |  |  |  | elsif (not $octet{'}'}) { | 
| 6252 | 0 |  |  |  |  |  | $delimiter     = '{'; | 
| 6253 | 0 |  |  |  |  |  | $end_delimiter = '}'; | 
| 6254 |  |  |  |  |  |  | } | 
| 6255 |  |  |  |  |  |  | elsif (not $octet{']'}) { | 
| 6256 | 0 |  |  |  |  |  | $delimiter     = '['; | 
| 6257 | 0 |  |  |  |  |  | $end_delimiter = ']'; | 
| 6258 |  |  |  |  |  |  | } | 
| 6259 |  |  |  |  |  |  | elsif (not $octet{'>'}) { | 
| 6260 | 0 |  |  |  |  |  | $delimiter     = '<'; | 
| 6261 | 0 |  |  |  |  |  | $end_delimiter = '>'; | 
| 6262 |  |  |  |  |  |  | } | 
| 6263 |  |  |  |  |  |  | else { | 
| 6264 | 0 |  |  |  |  |  | for my $char (qw( ! " $ % & * + - . / = ? ^ ` | ~ ), "\x00".."\x1F", "\x7F", "\xFF") { | 
| 6265 | 0 | 0 |  |  |  |  | if (not $octet{$char}) { | 
| 6266 | 0 |  |  |  |  |  | $delimiter     = $char; | 
| 6267 | 0 |  |  |  |  |  | $end_delimiter = $char; | 
| 6268 | 0 |  |  |  |  |  | last; | 
| 6269 |  |  |  |  |  |  | } | 
| 6270 |  |  |  |  |  |  | } | 
| 6271 |  |  |  |  |  |  | } | 
| 6272 |  |  |  |  |  |  | } | 
| 6273 |  |  |  |  |  |  |  | 
| 6274 |  |  |  |  |  |  | # count '(' | 
| 6275 | 0 |  |  |  |  |  | my $parens = grep { $_ eq '(' } @char; | 
|  | 0 |  |  |  |  |  |  | 
| 6276 |  |  |  |  |  |  |  | 
| 6277 | 0 |  |  |  |  |  | my $left_e  = 0; | 
| 6278 | 0 |  |  |  |  |  | my $right_e = 0; | 
| 6279 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 6280 |  |  |  |  |  |  |  | 
| 6281 |  |  |  |  |  |  | # "\L\u" --> "\u\L" | 
| 6282 | 0 | 0 | 0 |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6283 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 6284 |  |  |  |  |  |  | } | 
| 6285 |  |  |  |  |  |  |  | 
| 6286 |  |  |  |  |  |  | # "\U\l" --> "\l\U" | 
| 6287 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 6288 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 6289 |  |  |  |  |  |  | } | 
| 6290 |  |  |  |  |  |  |  | 
| 6291 |  |  |  |  |  |  | # octal escape sequence | 
| 6292 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 6293 | 0 |  |  |  |  |  | $char[$i] = Elatin6::octchr($1); | 
| 6294 |  |  |  |  |  |  | } | 
| 6295 |  |  |  |  |  |  |  | 
| 6296 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 6297 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 6298 | 0 |  |  |  |  |  | $char[$i] = Elatin6::hexchr($1); | 
| 6299 |  |  |  |  |  |  | } | 
| 6300 |  |  |  |  |  |  |  | 
| 6301 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 6302 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 6303 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 6304 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 6305 |  |  |  |  |  |  | # \P{PROPERTY} --> P\{PROPERTY} | 
| 6306 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^0-9\}][^\}]*) \} ) \z/oxms) { | 
| 6307 | 0 |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 6308 |  |  |  |  |  |  | } | 
| 6309 |  |  |  |  |  |  |  | 
| 6310 |  |  |  |  |  |  | # \p, \P, \X --> p, P, X | 
| 6311 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 6312 | 0 |  |  |  |  |  | $char[$i] = $1; | 
| 6313 |  |  |  |  |  |  | } | 
| 6314 |  |  |  |  |  |  |  | 
| 6315 | 0 | 0 | 0 |  |  |  | if (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 |  |  |  |  |  | 
| 6316 |  |  |  |  |  |  | } | 
| 6317 |  |  |  |  |  |  |  | 
| 6318 |  |  |  |  |  |  | # join separated multiple-octet | 
| 6319 | 0 |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 6320 | 0 | 0 | 0 |  |  |  | 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)) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 6321 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 3; | 
| 6322 |  |  |  |  |  |  | } | 
| 6323 |  |  |  |  |  |  | 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)) { | 
| 6324 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 2; | 
| 6325 |  |  |  |  |  |  | } | 
| 6326 |  |  |  |  |  |  | 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)) { | 
| 6327 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 1; | 
| 6328 |  |  |  |  |  |  | } | 
| 6329 |  |  |  |  |  |  | } | 
| 6330 |  |  |  |  |  |  |  | 
| 6331 |  |  |  |  |  |  | # open character class [...] | 
| 6332 |  |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 6333 | 0 |  |  |  |  |  | my $left = $i; | 
| 6334 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 6335 | 0 |  |  |  |  |  | $i++; | 
| 6336 |  |  |  |  |  |  | } | 
| 6337 | 0 |  |  |  |  |  | while (1) { | 
| 6338 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6339 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 6340 |  |  |  |  |  |  | } | 
| 6341 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 6342 | 0 |  |  |  |  |  | my $right = $i; | 
| 6343 |  |  |  |  |  |  |  | 
| 6344 |  |  |  |  |  |  | # [...] | 
| 6345 | 0 | 0 |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 6346 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Elatin6::charlist_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
|  | 0 |  |  |  |  |  |  | 
| 6347 |  |  |  |  |  |  | } | 
| 6348 |  |  |  |  |  |  | else { | 
| 6349 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 6350 |  |  |  |  |  |  | } | 
| 6351 |  |  |  |  |  |  |  | 
| 6352 | 0 |  |  |  |  |  | $i = $left; | 
| 6353 | 0 |  |  |  |  |  | last; | 
| 6354 |  |  |  |  |  |  | } | 
| 6355 |  |  |  |  |  |  | } | 
| 6356 |  |  |  |  |  |  | } | 
| 6357 |  |  |  |  |  |  |  | 
| 6358 |  |  |  |  |  |  | # open character class [^...] | 
| 6359 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 6360 | 0 |  |  |  |  |  | my $left = $i; | 
| 6361 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 6362 | 0 |  |  |  |  |  | $i++; | 
| 6363 |  |  |  |  |  |  | } | 
| 6364 | 0 |  |  |  |  |  | while (1) { | 
| 6365 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6366 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 6367 |  |  |  |  |  |  | } | 
| 6368 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 6369 | 0 |  |  |  |  |  | my $right = $i; | 
| 6370 |  |  |  |  |  |  |  | 
| 6371 |  |  |  |  |  |  | # [^...] | 
| 6372 | 0 | 0 |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 6373 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Elatin6::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
|  | 0 |  |  |  |  |  |  | 
| 6374 |  |  |  |  |  |  | } | 
| 6375 |  |  |  |  |  |  | else { | 
| 6376 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 6377 |  |  |  |  |  |  | } | 
| 6378 |  |  |  |  |  |  |  | 
| 6379 | 0 |  |  |  |  |  | $i = $left; | 
| 6380 | 0 |  |  |  |  |  | last; | 
| 6381 |  |  |  |  |  |  | } | 
| 6382 |  |  |  |  |  |  | } | 
| 6383 |  |  |  |  |  |  | } | 
| 6384 |  |  |  |  |  |  |  | 
| 6385 |  |  |  |  |  |  | # rewrite character class or escape character | 
| 6386 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 6387 | 0 |  |  |  |  |  | $char[$i] = $char; | 
| 6388 |  |  |  |  |  |  | } | 
| 6389 |  |  |  |  |  |  |  | 
| 6390 |  |  |  |  |  |  | # /i modifier | 
| 6391 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Elatin6::uc($char[$i]) ne Elatin6::fc($char[$i]))) { | 
| 6392 | 0 | 0 |  |  |  |  | if (CORE::length(Elatin6::fc($char[$i])) == 1) { | 
| 6393 | 0 |  |  |  |  |  | $char[$i] = '['   . Elatin6::uc($char[$i])       . Elatin6::fc($char[$i]) . ']'; | 
| 6394 |  |  |  |  |  |  | } | 
| 6395 |  |  |  |  |  |  | else { | 
| 6396 | 0 |  |  |  |  |  | $char[$i] = '(?:' . Elatin6::uc($char[$i]) . '|' . Elatin6::fc($char[$i]) . ')'; | 
| 6397 |  |  |  |  |  |  | } | 
| 6398 |  |  |  |  |  |  | } | 
| 6399 |  |  |  |  |  |  |  | 
| 6400 |  |  |  |  |  |  | # \u \l \U \L \F \Q \E | 
| 6401 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [<>] \z/oxms) { | 
| 6402 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 6403 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 6404 |  |  |  |  |  |  | } | 
| 6405 |  |  |  |  |  |  | } | 
| 6406 |  |  |  |  |  |  | elsif ($char[$i] eq '\u') { | 
| 6407 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ucfirst qq<'; | 
| 6408 | 0 |  |  |  |  |  | $left_e++; | 
| 6409 |  |  |  |  |  |  | } | 
| 6410 |  |  |  |  |  |  | elsif ($char[$i] eq '\l') { | 
| 6411 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lcfirst qq<'; | 
| 6412 | 0 |  |  |  |  |  | $left_e++; | 
| 6413 |  |  |  |  |  |  | } | 
| 6414 |  |  |  |  |  |  | elsif ($char[$i] eq '\U') { | 
| 6415 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::uc qq<'; | 
| 6416 | 0 |  |  |  |  |  | $left_e++; | 
| 6417 |  |  |  |  |  |  | } | 
| 6418 |  |  |  |  |  |  | elsif ($char[$i] eq '\L') { | 
| 6419 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lc qq<'; | 
| 6420 | 0 |  |  |  |  |  | $left_e++; | 
| 6421 |  |  |  |  |  |  | } | 
| 6422 |  |  |  |  |  |  | elsif ($char[$i] eq '\F') { | 
| 6423 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::fc qq<'; | 
| 6424 | 0 |  |  |  |  |  | $left_e++; | 
| 6425 |  |  |  |  |  |  | } | 
| 6426 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 6427 | 0 |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 6428 | 0 |  |  |  |  |  | $left_e++; | 
| 6429 |  |  |  |  |  |  | } | 
| 6430 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 6431 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 6432 | 0 |  |  |  |  |  | $char[$i] = '>]}'; | 
| 6433 | 0 |  |  |  |  |  | $right_e++; | 
| 6434 |  |  |  |  |  |  | } | 
| 6435 |  |  |  |  |  |  | else { | 
| 6436 | 0 |  |  |  |  |  | $char[$i] = ''; | 
| 6437 |  |  |  |  |  |  | } | 
| 6438 |  |  |  |  |  |  | } | 
| 6439 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 6440 | 0 |  |  |  |  |  | while (1) { | 
| 6441 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6442 | 0 |  |  |  |  |  | last; | 
| 6443 |  |  |  |  |  |  | } | 
| 6444 | 0 | 0 |  |  |  |  | if ($char[$i] eq '\E') { | 
| 6445 | 0 |  |  |  |  |  | last; | 
| 6446 |  |  |  |  |  |  | } | 
| 6447 |  |  |  |  |  |  | } | 
| 6448 |  |  |  |  |  |  | } | 
| 6449 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 6450 |  |  |  |  |  |  | } | 
| 6451 |  |  |  |  |  |  |  | 
| 6452 |  |  |  |  |  |  | # \0 --> \0 | 
| 6453 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ (?>\s*) 0 \z/oxms) { | 
| 6454 |  |  |  |  |  |  | } | 
| 6455 |  |  |  |  |  |  |  | 
| 6456 |  |  |  |  |  |  | # \g{N}, \g{-N} | 
| 6457 |  |  |  |  |  |  |  | 
| 6458 |  |  |  |  |  |  | # P.108 Using Simple Patterns | 
| 6459 |  |  |  |  |  |  | # in Chapter 7: In the World of Regular Expressions | 
| 6460 |  |  |  |  |  |  | # of ISBN 978-0-596-52010-6 Learning Perl, Fifth Edition | 
| 6461 |  |  |  |  |  |  |  | 
| 6462 |  |  |  |  |  |  | # P.221 Capturing | 
| 6463 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 6464 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 6465 |  |  |  |  |  |  |  | 
| 6466 |  |  |  |  |  |  | # \g{-1}, \g{-2}, \g{-3} --> \g{-1}, \g{-2}, \g{-3} | 
| 6467 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\g (?>\s*) \{ (?>\s*) - (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 6468 |  |  |  |  |  |  | } | 
| 6469 |  |  |  |  |  |  |  | 
| 6470 |  |  |  |  |  |  | # \g{1}, \g{2}, \g{3} --> \g{2}, \g{3}, \g{4} (only when multibyte anchoring is enable) | 
| 6471 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\g (?>\s*) \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 6472 |  |  |  |  |  |  | } | 
| 6473 |  |  |  |  |  |  |  | 
| 6474 |  |  |  |  |  |  | # \g1, \g2, \g3 --> \g2, \g3, \g4 (only when multibyte anchoring is enable) | 
| 6475 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\g (?>\s*) ((?>[1-9][0-9]*)) \z/oxms) { | 
| 6476 |  |  |  |  |  |  | } | 
| 6477 |  |  |  |  |  |  |  | 
| 6478 |  |  |  |  |  |  | # \1, \2, \3 --> \2, \3, \4 (only when multibyte anchoring is enable) | 
| 6479 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ (?>\s*) ((?>[1-9][0-9]*)) \z/oxms) { | 
| 6480 |  |  |  |  |  |  | } | 
| 6481 |  |  |  |  |  |  |  | 
| 6482 |  |  |  |  |  |  | # $0 --> $0 | 
| 6483 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 6484 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6485 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6486 |  |  |  |  |  |  | } | 
| 6487 |  |  |  |  |  |  | } | 
| 6488 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 6489 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6490 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6491 |  |  |  |  |  |  | } | 
| 6492 |  |  |  |  |  |  | } | 
| 6493 |  |  |  |  |  |  |  | 
| 6494 |  |  |  |  |  |  | # $$ --> $$ | 
| 6495 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 6496 |  |  |  |  |  |  | } | 
| 6497 |  |  |  |  |  |  |  | 
| 6498 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 6499 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 6500 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 6501 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 6502 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6503 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6504 |  |  |  |  |  |  | } | 
| 6505 |  |  |  |  |  |  | } | 
| 6506 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 6507 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 6508 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6509 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6510 |  |  |  |  |  |  | } | 
| 6511 |  |  |  |  |  |  | } | 
| 6512 |  |  |  |  |  |  |  | 
| 6513 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 6514 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 6515 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 6516 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6517 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6518 |  |  |  |  |  |  | } | 
| 6519 |  |  |  |  |  |  | } | 
| 6520 |  |  |  |  |  |  |  | 
| 6521 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 6522 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 6523 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 6524 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6525 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6526 |  |  |  |  |  |  | } | 
| 6527 |  |  |  |  |  |  | } | 
| 6528 |  |  |  |  |  |  |  | 
| 6529 |  |  |  |  |  |  | # $$foo | 
| 6530 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 6531 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 6532 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6533 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6534 |  |  |  |  |  |  | } | 
| 6535 |  |  |  |  |  |  | } | 
| 6536 |  |  |  |  |  |  |  | 
| 6537 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Elatin6::PREMATCH() | 
| 6538 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 6539 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6540 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::PREMATCH())]}'; | 
| 6541 |  |  |  |  |  |  | } | 
| 6542 |  |  |  |  |  |  | else { | 
| 6543 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::PREMATCH()]}'; | 
| 6544 |  |  |  |  |  |  | } | 
| 6545 |  |  |  |  |  |  | } | 
| 6546 |  |  |  |  |  |  |  | 
| 6547 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Elatin6::MATCH() | 
| 6548 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 6549 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6550 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::MATCH())]}'; | 
| 6551 |  |  |  |  |  |  | } | 
| 6552 |  |  |  |  |  |  | else { | 
| 6553 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::MATCH()]}'; | 
| 6554 |  |  |  |  |  |  | } | 
| 6555 |  |  |  |  |  |  | } | 
| 6556 |  |  |  |  |  |  |  | 
| 6557 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Elatin6::POSTMATCH() | 
| 6558 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 6559 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6560 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::POSTMATCH())]}'; | 
| 6561 |  |  |  |  |  |  | } | 
| 6562 |  |  |  |  |  |  | else { | 
| 6563 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::POSTMATCH()]}'; | 
| 6564 |  |  |  |  |  |  | } | 
| 6565 |  |  |  |  |  |  | } | 
| 6566 |  |  |  |  |  |  |  | 
| 6567 |  |  |  |  |  |  | # ${ foo } | 
| 6568 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \}                              \z/oxms) { | 
| 6569 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6570 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6571 |  |  |  |  |  |  | } | 
| 6572 |  |  |  |  |  |  | } | 
| 6573 |  |  |  |  |  |  |  | 
| 6574 |  |  |  |  |  |  | # ${ ... } | 
| 6575 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 6576 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 6577 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6578 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6579 |  |  |  |  |  |  | } | 
| 6580 |  |  |  |  |  |  | } | 
| 6581 |  |  |  |  |  |  |  | 
| 6582 |  |  |  |  |  |  | # $scalar or @array | 
| 6583 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@].+ /oxms) { | 
| 6584 | 0 |  |  |  |  |  | $char[$i] = e_string($char[$i]); | 
| 6585 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 6586 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 6587 |  |  |  |  |  |  | } | 
| 6588 |  |  |  |  |  |  | } | 
| 6589 |  |  |  |  |  |  |  | 
| 6590 |  |  |  |  |  |  | # quote character before ? + * { | 
| 6591 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 6592 | 0 | 0 |  |  |  |  | if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) { | 
| 6593 |  |  |  |  |  |  | } | 
| 6594 |  |  |  |  |  |  | else { | 
| 6595 | 0 |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 6596 |  |  |  |  |  |  | } | 
| 6597 |  |  |  |  |  |  | } | 
| 6598 |  |  |  |  |  |  | } | 
| 6599 |  |  |  |  |  |  |  | 
| 6600 |  |  |  |  |  |  | # make regexp string | 
| 6601 | 0 |  |  |  |  |  | my $prematch = ''; | 
| 6602 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 6603 | 0 | 0 |  |  |  |  | if ($left_e > $right_e) { | 
| 6604 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', @char, '>]}' x ($left_e - $right_e), ')', $matched, $end_delimiter, $modifier; | 
| 6605 |  |  |  |  |  |  | } | 
| 6606 | 0 |  |  |  |  |  | return     join '', $ope, $delimiter, $prematch, '(?:', @char,                               ')', $matched, $end_delimiter, $modifier; | 
| 6607 |  |  |  |  |  |  | } | 
| 6608 |  |  |  |  |  |  |  | 
| 6609 |  |  |  |  |  |  | # | 
| 6610 |  |  |  |  |  |  | # escape regexp (s'here'' or s'here''b) | 
| 6611 |  |  |  |  |  |  | # | 
| 6612 |  |  |  |  |  |  | sub e_s1_q { | 
| 6613 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6614 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 6615 |  |  |  |  |  |  |  | 
| 6616 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 6617 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 6618 | 0 |  |  |  |  |  | my $line = 0; | 
| 6619 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 6620 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 6621 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 6622 | 0 |  |  |  |  |  | last; | 
| 6623 |  |  |  |  |  |  | } | 
| 6624 |  |  |  |  |  |  | } | 
| 6625 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 6626 |  |  |  |  |  |  | } | 
| 6627 |  |  |  |  |  |  |  | 
| 6628 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 6629 |  |  |  |  |  |  |  | 
| 6630 |  |  |  |  |  |  | # literal null string pattern | 
| 6631 | 0 | 0 |  |  |  |  | if ($string eq '') { | 
|  |  | 0 |  |  |  |  |  | 
| 6632 | 0 |  |  |  |  |  | $modifier =~ tr/bB//d; | 
| 6633 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 6634 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $end_delimiter, $modifier; | 
| 6635 |  |  |  |  |  |  | } | 
| 6636 |  |  |  |  |  |  |  | 
| 6637 |  |  |  |  |  |  | # with /b /B modifier | 
| 6638 |  |  |  |  |  |  | elsif ($modifier =~ tr/bB//d) { | 
| 6639 | 0 |  |  |  |  |  | return e_s1_qb($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 6640 |  |  |  |  |  |  | } | 
| 6641 |  |  |  |  |  |  |  | 
| 6642 |  |  |  |  |  |  | # without /b /B modifier | 
| 6643 |  |  |  |  |  |  | else { | 
| 6644 | 0 |  |  |  |  |  | return e_s1_qt($ope,$delimiter,$end_delimiter,$string,$modifier); | 
| 6645 |  |  |  |  |  |  | } | 
| 6646 |  |  |  |  |  |  | } | 
| 6647 |  |  |  |  |  |  |  | 
| 6648 |  |  |  |  |  |  | # | 
| 6649 |  |  |  |  |  |  | # escape regexp (s'here'') | 
| 6650 |  |  |  |  |  |  | # | 
| 6651 |  |  |  |  |  |  | sub e_s1_qt { | 
| 6652 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6653 |  |  |  |  |  |  |  | 
| 6654 | 0 | 0 |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 6655 |  |  |  |  |  |  |  | 
| 6656 |  |  |  |  |  |  | # split regexp | 
| 6657 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 6658 |  |  |  |  |  |  | [^\\\[\$\@\/] | | 
| 6659 |  |  |  |  |  |  | [\x00-\xFF] | | 
| 6660 |  |  |  |  |  |  | \[\^                            | | 
| 6661 |  |  |  |  |  |  | \[\:   (?>[a-z]+) \:\]          | | 
| 6662 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) \:\]          | | 
| 6663 |  |  |  |  |  |  | [\$\@\/]                        | | 
| 6664 |  |  |  |  |  |  | \\     (?:$q_char)              | | 
| 6665 |  |  |  |  |  |  | (?:$q_char) | 
| 6666 |  |  |  |  |  |  | ))/oxmsg; | 
| 6667 |  |  |  |  |  |  |  | 
| 6668 |  |  |  |  |  |  | # unescape character | 
| 6669 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 6670 | 0 | 0 | 0 |  |  |  | if (0) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 6671 |  |  |  |  |  |  | } | 
| 6672 |  |  |  |  |  |  |  | 
| 6673 |  |  |  |  |  |  | # open character class [...] | 
| 6674 | 0 |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 6675 | 0 |  |  |  |  |  | my $left = $i; | 
| 6676 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 6677 | 0 |  |  |  |  |  | $i++; | 
| 6678 |  |  |  |  |  |  | } | 
| 6679 | 0 |  |  |  |  |  | while (1) { | 
| 6680 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6681 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 6682 |  |  |  |  |  |  | } | 
| 6683 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 6684 | 0 |  |  |  |  |  | my $right = $i; | 
| 6685 |  |  |  |  |  |  |  | 
| 6686 |  |  |  |  |  |  | # [...] | 
| 6687 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 6688 |  |  |  |  |  |  |  | 
| 6689 | 0 |  |  |  |  |  | $i = $left; | 
| 6690 | 0 |  |  |  |  |  | last; | 
| 6691 |  |  |  |  |  |  | } | 
| 6692 |  |  |  |  |  |  | } | 
| 6693 |  |  |  |  |  |  | } | 
| 6694 |  |  |  |  |  |  |  | 
| 6695 |  |  |  |  |  |  | # open character class [^...] | 
| 6696 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 6697 | 0 |  |  |  |  |  | my $left = $i; | 
| 6698 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 6699 | 0 |  |  |  |  |  | $i++; | 
| 6700 |  |  |  |  |  |  | } | 
| 6701 | 0 |  |  |  |  |  | while (1) { | 
| 6702 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 6703 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 6704 |  |  |  |  |  |  | } | 
| 6705 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 6706 | 0 |  |  |  |  |  | my $right = $i; | 
| 6707 |  |  |  |  |  |  |  | 
| 6708 |  |  |  |  |  |  | # [^...] | 
| 6709 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 6710 |  |  |  |  |  |  |  | 
| 6711 | 0 |  |  |  |  |  | $i = $left; | 
| 6712 | 0 |  |  |  |  |  | last; | 
| 6713 |  |  |  |  |  |  | } | 
| 6714 |  |  |  |  |  |  | } | 
| 6715 |  |  |  |  |  |  | } | 
| 6716 |  |  |  |  |  |  |  | 
| 6717 |  |  |  |  |  |  | # escape $ @ / and \ | 
| 6718 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 6719 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 6720 |  |  |  |  |  |  | } | 
| 6721 |  |  |  |  |  |  |  | 
| 6722 |  |  |  |  |  |  | # rewrite character class or escape character | 
| 6723 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 6724 | 0 |  |  |  |  |  | $char[$i] = $char; | 
| 6725 |  |  |  |  |  |  | } | 
| 6726 |  |  |  |  |  |  |  | 
| 6727 |  |  |  |  |  |  | # /i modifier | 
| 6728 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Elatin6::uc($char[$i]) ne Elatin6::fc($char[$i]))) { | 
| 6729 | 0 | 0 |  |  |  |  | if (CORE::length(Elatin6::fc($char[$i])) == 1) { | 
| 6730 | 0 |  |  |  |  |  | $char[$i] = '['   . Elatin6::uc($char[$i])       . Elatin6::fc($char[$i]) . ']'; | 
| 6731 |  |  |  |  |  |  | } | 
| 6732 |  |  |  |  |  |  | else { | 
| 6733 | 0 |  |  |  |  |  | $char[$i] = '(?:' . Elatin6::uc($char[$i]) . '|' . Elatin6::fc($char[$i]) . ')'; | 
| 6734 |  |  |  |  |  |  | } | 
| 6735 |  |  |  |  |  |  | } | 
| 6736 |  |  |  |  |  |  |  | 
| 6737 |  |  |  |  |  |  | # quote character before ? + * { | 
| 6738 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 6739 | 0 | 0 |  |  |  |  | if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 6740 |  |  |  |  |  |  | } | 
| 6741 |  |  |  |  |  |  | else { | 
| 6742 | 0 |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 6743 |  |  |  |  |  |  | } | 
| 6744 |  |  |  |  |  |  | } | 
| 6745 |  |  |  |  |  |  | } | 
| 6746 |  |  |  |  |  |  |  | 
| 6747 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 6748 | 0 |  |  |  |  |  | $delimiter     = '/'; | 
| 6749 | 0 |  |  |  |  |  | $end_delimiter = '/'; | 
| 6750 | 0 |  |  |  |  |  | my $prematch = ''; | 
| 6751 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 6752 |  |  |  |  |  |  | } | 
| 6753 |  |  |  |  |  |  |  | 
| 6754 |  |  |  |  |  |  | # | 
| 6755 |  |  |  |  |  |  | # escape regexp (s'here''b) | 
| 6756 |  |  |  |  |  |  | # | 
| 6757 |  |  |  |  |  |  | sub e_s1_qb { | 
| 6758 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6759 |  |  |  |  |  |  |  | 
| 6760 |  |  |  |  |  |  | # split regexp | 
| 6761 | 0 |  |  |  |  |  | my @char = $string =~ /\G (?>[^\\]|\\\\) /oxmsg; | 
| 6762 |  |  |  |  |  |  |  | 
| 6763 |  |  |  |  |  |  | # unescape character | 
| 6764 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 6765 | 0 | 0 |  |  |  |  | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
| 6766 |  |  |  |  |  |  | } | 
| 6767 |  |  |  |  |  |  |  | 
| 6768 |  |  |  |  |  |  | # remain \\ | 
| 6769 | 0 |  |  |  |  |  | elsif ($char[$i] eq '\\\\') { | 
| 6770 |  |  |  |  |  |  | } | 
| 6771 |  |  |  |  |  |  |  | 
| 6772 |  |  |  |  |  |  | # escape $ @ / and \ | 
| 6773 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 6774 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 6775 |  |  |  |  |  |  | } | 
| 6776 |  |  |  |  |  |  | } | 
| 6777 |  |  |  |  |  |  |  | 
| 6778 | 0 |  |  |  |  |  | $delimiter     = '/'; | 
| 6779 | 0 |  |  |  |  |  | $end_delimiter = '/'; | 
| 6780 | 0 |  |  |  |  |  | my $prematch = ''; | 
| 6781 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, $prematch, '(?:', @char, ')', $matched, $end_delimiter, $modifier; | 
| 6782 |  |  |  |  |  |  | } | 
| 6783 |  |  |  |  |  |  |  | 
| 6784 |  |  |  |  |  |  | # | 
| 6785 |  |  |  |  |  |  | # escape regexp (s''here') | 
| 6786 |  |  |  |  |  |  | # | 
| 6787 |  |  |  |  |  |  | sub e_s2_q { | 
| 6788 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string) = @_; | 
| 6789 |  |  |  |  |  |  |  | 
| 6790 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 6791 |  |  |  |  |  |  |  | 
| 6792 | 0 |  |  |  |  |  | my @char = $string =~ / \G (?>[^\\]|\\\\|$q_char) /oxmsg; | 
| 6793 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 6794 | 0 | 0 |  |  |  |  | if (0) { | 
|  |  | 0 |  |  |  |  |  | 
| 6795 |  |  |  |  |  |  | } | 
| 6796 |  |  |  |  |  |  |  | 
| 6797 |  |  |  |  |  |  | # not escape \\ | 
| 6798 | 0 |  |  |  |  |  | elsif ($char[$i] =~ /\A \\\\ \z/oxms) { | 
| 6799 |  |  |  |  |  |  | } | 
| 6800 |  |  |  |  |  |  |  | 
| 6801 |  |  |  |  |  |  | # escape $ @ / and \ | 
| 6802 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@\/\\] \z/oxms) { | 
| 6803 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 6804 |  |  |  |  |  |  | } | 
| 6805 |  |  |  |  |  |  | } | 
| 6806 |  |  |  |  |  |  |  | 
| 6807 | 0 |  |  |  |  |  | return join '', $ope, $delimiter, @char,   $end_delimiter; | 
| 6808 |  |  |  |  |  |  | } | 
| 6809 |  |  |  |  |  |  |  | 
| 6810 |  |  |  |  |  |  | # | 
| 6811 |  |  |  |  |  |  | # escape regexp (s/here/and here/modifier) | 
| 6812 |  |  |  |  |  |  | # | 
| 6813 |  |  |  |  |  |  | sub e_sub { | 
| 6814 | 0 |  |  | 0 | 0 |  | my($variable,$delimiter1,$pattern,$end_delimiter1,$delimiter2,$replacement,$end_delimiter2,$modifier) = @_; | 
| 6815 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 6816 |  |  |  |  |  |  |  | 
| 6817 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 6818 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 6819 | 0 |  |  |  |  |  | my $line = 0; | 
| 6820 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 6821 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 6822 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 6823 | 0 |  |  |  |  |  | last; | 
| 6824 |  |  |  |  |  |  | } | 
| 6825 |  |  |  |  |  |  | } | 
| 6826 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 6827 |  |  |  |  |  |  | } | 
| 6828 |  |  |  |  |  |  |  | 
| 6829 | 0 | 0 |  |  |  |  | if ($variable eq '') { | 
| 6830 | 0 |  |  |  |  |  | $variable      = '$_'; | 
| 6831 | 0 |  |  |  |  |  | $bind_operator = ' =~ '; | 
| 6832 |  |  |  |  |  |  | } | 
| 6833 |  |  |  |  |  |  |  | 
| 6834 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 6835 |  |  |  |  |  |  |  | 
| 6836 |  |  |  |  |  |  | # P.128 Start of match (or end of previous match): \G | 
| 6837 |  |  |  |  |  |  | # P.130 Advanced Use of \G with Perl | 
| 6838 |  |  |  |  |  |  | # in Chapter 3: Overview of Regular Expression Features and Flavors | 
| 6839 |  |  |  |  |  |  | # P.312 Iterative Matching: Scalar Context, with /g | 
| 6840 |  |  |  |  |  |  | # in Chapter 7: Perl | 
| 6841 |  |  |  |  |  |  | # of ISBN 0-596-00289-0 Mastering Regular Expressions, Second edition | 
| 6842 |  |  |  |  |  |  |  | 
| 6843 |  |  |  |  |  |  | # P.181 Where You Left Off: The \G Assertion | 
| 6844 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 6845 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 6846 |  |  |  |  |  |  |  | 
| 6847 |  |  |  |  |  |  | # P.220 Where You Left Off: The \G Assertion | 
| 6848 |  |  |  |  |  |  | # in Chapter 5: Pattern Matching | 
| 6849 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 6850 |  |  |  |  |  |  |  | 
| 6851 | 0 |  |  |  |  |  | my $e_modifier = $modifier =~ tr/e//d; | 
| 6852 | 0 |  |  |  |  |  | my $r_modifier = $modifier =~ tr/r//d; | 
| 6853 |  |  |  |  |  |  |  | 
| 6854 | 0 |  |  |  |  |  | my $my = ''; | 
| 6855 | 0 | 0 |  |  |  |  | if ($variable =~ s/\A \( (?>\s*) ( (?>(?: local \b | my \b | our \b | state \b )?) .+ ) \) \z/$1/oxms) { | 
| 6856 | 0 |  |  |  |  |  | $my = $variable; | 
| 6857 | 0 |  |  |  |  |  | $variable =~ s/ (?: local \b | my \b | our \b | state \b ) (?>\s*) //oxms; | 
| 6858 | 0 |  |  |  |  |  | $variable =~ s/ = .+ \z//oxms; | 
| 6859 |  |  |  |  |  |  | } | 
| 6860 |  |  |  |  |  |  |  | 
| 6861 | 0 |  |  |  |  |  | (my $variable_basename = $variable) =~ s/ [\[\{].* \z//oxms; | 
| 6862 | 0 |  |  |  |  |  | $variable_basename =~ s/ \s+ \z//oxms; | 
| 6863 |  |  |  |  |  |  |  | 
| 6864 |  |  |  |  |  |  | # quote replacement string | 
| 6865 | 0 |  |  |  |  |  | my $e_replacement = ''; | 
| 6866 | 0 | 0 |  |  |  |  | if ($e_modifier >= 1) { | 
| 6867 | 0 |  |  |  |  |  | $e_replacement = e_qq('', '', '', $replacement); | 
| 6868 | 0 |  |  |  |  |  | $e_modifier--; | 
| 6869 |  |  |  |  |  |  | } | 
| 6870 |  |  |  |  |  |  | else { | 
| 6871 | 0 | 0 |  |  |  |  | if ($delimiter2 eq "'") { | 
| 6872 | 0 |  |  |  |  |  | $e_replacement = e_s2_q('qq', '/',         '/',             $replacement); | 
| 6873 |  |  |  |  |  |  | } | 
| 6874 |  |  |  |  |  |  | else { | 
| 6875 | 0 |  |  |  |  |  | $e_replacement = e_qq  ('qq', $delimiter2, $end_delimiter2, $replacement); | 
| 6876 |  |  |  |  |  |  | } | 
| 6877 |  |  |  |  |  |  | } | 
| 6878 |  |  |  |  |  |  |  | 
| 6879 | 0 |  |  |  |  |  | my $sub = ''; | 
| 6880 |  |  |  |  |  |  |  | 
| 6881 |  |  |  |  |  |  | # with /r | 
| 6882 | 0 | 0 |  |  |  |  | if ($r_modifier) { | 
| 6883 | 0 | 0 |  |  |  |  | if (0) { | 
| 6884 |  |  |  |  |  |  | } | 
| 6885 |  |  |  |  |  |  |  | 
| 6886 |  |  |  |  |  |  | # s///gr without multibyte anchoring | 
| 6887 | 0 |  |  |  |  |  | elsif ($modifier =~ /g/oxms) { | 
| 6888 | 0 | 0 |  |  |  |  | $sub = sprintf( | 
| 6889 |  |  |  |  |  |  | #                              1                        2   3                                 4   5 | 
| 6890 |  |  |  |  |  |  | q, | 
| 6891 |  |  |  |  |  |  |  | 
| 6892 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 6893 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 6894 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 6895 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 6896 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 6897 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 6898 |  |  |  |  |  |  | '$Latin6::re_r=CORE::eval $Latin6::re_r; ' x $e_modifier,            #  5 | 
| 6899 |  |  |  |  |  |  | ); | 
| 6900 |  |  |  |  |  |  | } | 
| 6901 |  |  |  |  |  |  |  | 
| 6902 |  |  |  |  |  |  | # s///r | 
| 6903 |  |  |  |  |  |  | else { | 
| 6904 |  |  |  |  |  |  |  | 
| 6905 | 0 |  |  |  |  |  | my $prematch = q{$`}; | 
| 6906 |  |  |  |  |  |  |  | 
| 6907 | 0 | 0 |  |  |  |  | $sub = sprintf( | 
| 6908 |  |  |  |  |  |  | #  1     2                3                                 4   5  6                    7 | 
| 6909 |  |  |  |  |  |  | q<(%s =~ %s) ? CORE::eval{%s local $^W=0; local $Latin6::re_r=%s; %s"%s$Latin6::re_r$'" } : %s>, | 
| 6910 |  |  |  |  |  |  |  | 
| 6911 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 6912 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 6913 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 6914 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 6915 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 6916 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 6917 |  |  |  |  |  |  | '$Latin6::re_r=CORE::eval $Latin6::re_r; ' x $e_modifier,            #  5 | 
| 6918 |  |  |  |  |  |  | $prematch,                                                       #  6 | 
| 6919 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 6920 |  |  |  |  |  |  | ); | 
| 6921 |  |  |  |  |  |  | } | 
| 6922 |  |  |  |  |  |  |  | 
| 6923 |  |  |  |  |  |  | # $var !~ s///r doesn't make sense | 
| 6924 | 0 | 0 |  |  |  |  | if ($bind_operator =~ / !~ /oxms) { | 
| 6925 | 0 |  |  |  |  |  | $sub = q{die("$0: Using !~ with s///r doesn't make sense"), } . $sub; | 
| 6926 |  |  |  |  |  |  | } | 
| 6927 |  |  |  |  |  |  | } | 
| 6928 |  |  |  |  |  |  |  | 
| 6929 |  |  |  |  |  |  | # without /r | 
| 6930 |  |  |  |  |  |  | else { | 
| 6931 | 0 | 0 |  |  |  |  | if (0) { | 
| 6932 |  |  |  |  |  |  | } | 
| 6933 |  |  |  |  |  |  |  | 
| 6934 |  |  |  |  |  |  | # s///g without multibyte anchoring | 
| 6935 | 0 |  |  |  |  |  | elsif ($modifier =~ /g/oxms) { | 
| 6936 | 0 | 0 |  |  |  |  | $sub = sprintf( | 
|  |  | 0 |  |  |  |  |  | 
| 6937 |  |  |  |  |  |  | #                                       1     2   3                                 4   5 6                         7                                                 8 | 
| 6938 |  |  |  |  |  |  | q, | 
| 6939 |  |  |  |  |  |  |  | 
| 6940 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 6941 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  2 | 
| 6942 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 6943 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 6944 |  |  |  |  |  |  | $s_matched,                                                      #  3 | 
| 6945 |  |  |  |  |  |  | $e_replacement,                                                  #  4 | 
| 6946 |  |  |  |  |  |  | '$Latin6::re_r=CORE::eval $Latin6::re_r; ' x $e_modifier,            #  5 | 
| 6947 |  |  |  |  |  |  | $variable,                                                       #  6 | 
| 6948 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 6949 |  |  |  |  |  |  | ($bind_operator =~ / !~ /oxms) ? '!' : '',                       #  8 | 
| 6950 |  |  |  |  |  |  | ); | 
| 6951 |  |  |  |  |  |  | } | 
| 6952 |  |  |  |  |  |  |  | 
| 6953 |  |  |  |  |  |  | # s/// | 
| 6954 |  |  |  |  |  |  | else { | 
| 6955 |  |  |  |  |  |  |  | 
| 6956 | 0 |  |  |  |  |  | my $prematch = q{$`}; | 
| 6957 |  |  |  |  |  |  |  | 
| 6958 | 0 | 0 |  |  |  |  | $sub = sprintf( | 
|  |  | 0 |  |  |  |  |  | 
| 6959 |  |  |  |  |  |  |  | 
| 6960 |  |  |  |  |  |  | ($bind_operator =~ / =~ /oxms) ? | 
| 6961 |  |  |  |  |  |  |  | 
| 6962 |  |  |  |  |  |  | #  1 2 3                4                                 5   6 7   8 | 
| 6963 |  |  |  |  |  |  | q<(%s%s%s) ? CORE::eval{%s local $^W=0; local $Latin6::re_r=%s; %s%s="%s$Latin6::re_r$'"; 1 } : undef> : | 
| 6964 |  |  |  |  |  |  |  | 
| 6965 |  |  |  |  |  |  | #  1 2 3                    4                                 5   6 7   8 | 
| 6966 |  |  |  |  |  |  | q<(%s%s%s) ? 1 : CORE::eval{%s local $^W=0; local $Latin6::re_r=%s; %s%s="%s$Latin6::re_r$'"; undef }>, | 
| 6967 |  |  |  |  |  |  |  | 
| 6968 |  |  |  |  |  |  | $variable,                                                       #  1 | 
| 6969 |  |  |  |  |  |  | $bind_operator,                                                  #  2 | 
| 6970 |  |  |  |  |  |  | ($delimiter1 eq "'") ?                                           #  3 | 
| 6971 |  |  |  |  |  |  | e_s1_q('m', $delimiter1, $end_delimiter1, $pattern, $modifier) : #  : | 
| 6972 |  |  |  |  |  |  | e_s1  ('m', $delimiter1, $end_delimiter1, $pattern, $modifier),  #  : | 
| 6973 |  |  |  |  |  |  | $s_matched,                                                      #  4 | 
| 6974 |  |  |  |  |  |  | $e_replacement,                                                  #  5 | 
| 6975 |  |  |  |  |  |  | '$Latin6::re_r=CORE::eval $Latin6::re_r; ' x $e_modifier,            #  6 | 
| 6976 |  |  |  |  |  |  | $variable,                                                       #  7 | 
| 6977 |  |  |  |  |  |  | $prematch,                                                       #  8 | 
| 6978 |  |  |  |  |  |  | ); | 
| 6979 |  |  |  |  |  |  | } | 
| 6980 |  |  |  |  |  |  | } | 
| 6981 |  |  |  |  |  |  |  | 
| 6982 |  |  |  |  |  |  | # (my $foo = $bar) =~ s///   -->   (my $foo = $bar, CORE::eval { ... })[1] | 
| 6983 | 0 | 0 |  |  |  |  | if ($my ne '') { | 
| 6984 | 0 |  |  |  |  |  | $sub = "($my, $sub)[1]"; | 
| 6985 |  |  |  |  |  |  | } | 
| 6986 |  |  |  |  |  |  |  | 
| 6987 |  |  |  |  |  |  | # clear s/// variable | 
| 6988 | 0 |  |  |  |  |  | $sub_variable = ''; | 
| 6989 | 0 |  |  |  |  |  | $bind_operator = ''; | 
| 6990 |  |  |  |  |  |  |  | 
| 6991 | 0 |  |  |  |  |  | return $sub; | 
| 6992 |  |  |  |  |  |  | } | 
| 6993 |  |  |  |  |  |  |  | 
| 6994 |  |  |  |  |  |  | # | 
| 6995 |  |  |  |  |  |  | # escape regexp of split qr// | 
| 6996 |  |  |  |  |  |  | # | 
| 6997 |  |  |  |  |  |  | sub e_split { | 
| 6998 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 6999 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 7000 |  |  |  |  |  |  |  | 
| 7001 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 7002 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 7003 | 0 |  |  |  |  |  | my $line = 0; | 
| 7004 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 7005 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 7006 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 7007 | 0 |  |  |  |  |  | last; | 
| 7008 |  |  |  |  |  |  | } | 
| 7009 |  |  |  |  |  |  | } | 
| 7010 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 7011 |  |  |  |  |  |  | } | 
| 7012 |  |  |  |  |  |  |  | 
| 7013 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 7014 |  |  |  |  |  |  |  | 
| 7015 |  |  |  |  |  |  | # /b /B modifier | 
| 7016 | 0 | 0 |  |  |  |  | if ($modifier =~ tr/bB//d) { | 
| 7017 | 0 |  |  |  |  |  | return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier; | 
| 7018 |  |  |  |  |  |  | } | 
| 7019 |  |  |  |  |  |  |  | 
| 7020 | 0 | 0 |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 7021 | 0 |  |  |  |  |  | my $metachar = qr/[\@\\|[\]{^]/oxms; | 
| 7022 |  |  |  |  |  |  |  | 
| 7023 |  |  |  |  |  |  | # split regexp | 
| 7024 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 7025 |  |  |  |  |  |  | [^\\\$\@\[\(] | | 
| 7026 |  |  |  |  |  |  | \\x   (?>[0-9A-Fa-f]{1,2}) | | 
| 7027 |  |  |  |  |  |  | \\    (?>[0-7]{2,3})       | | 
| 7028 |  |  |  |  |  |  | \\c   [\x40-\x5F]          | | 
| 7029 |  |  |  |  |  |  | \\x\{ (?>[0-9A-Fa-f]+) \}  | | 
| 7030 |  |  |  |  |  |  | \\o\{ (?>[0-7]+)       \}  | | 
| 7031 |  |  |  |  |  |  | \\[bBNpP]\{ (?>[^0-9\}][^\}]*) \} | | 
| 7032 |  |  |  |  |  |  | \\  $q_char                | | 
| 7033 |  |  |  |  |  |  | \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  | | 
| 7034 |  |  |  |  |  |  | \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     | | 
| 7035 |  |  |  |  |  |  | \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} | | 
| 7036 |  |  |  |  |  |  | [\$\@] $qq_variable        | | 
| 7037 |  |  |  |  |  |  | \$ (?>\s* [0-9]+)          | | 
| 7038 |  |  |  |  |  |  | \$ (?>\s*) \{ (?>\s* [0-9]+ \s*) \}  | | 
| 7039 |  |  |  |  |  |  | \$ \$ (?![\w\{])           | | 
| 7040 |  |  |  |  |  |  | \$ (?>\s*) \$ (?>\s*) $qq_variable   | | 
| 7041 |  |  |  |  |  |  | \[\^                       | | 
| 7042 |  |  |  |  |  |  | \[\:   (?>[a-z]+) :\]      | | 
| 7043 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) :\]      | | 
| 7044 |  |  |  |  |  |  | \(\?                       | | 
| 7045 |  |  |  |  |  |  | $q_char | 
| 7046 |  |  |  |  |  |  | ))/oxmsg; | 
| 7047 |  |  |  |  |  |  |  | 
| 7048 | 0 |  |  |  |  |  | my $left_e  = 0; | 
| 7049 | 0 |  |  |  |  |  | my $right_e = 0; | 
| 7050 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 7051 |  |  |  |  |  |  |  | 
| 7052 |  |  |  |  |  |  | # "\L\u" --> "\u\L" | 
| 7053 | 0 | 0 | 0 |  |  |  | if (($char[$i] eq '\L') and ($char[$i+1] eq '\u')) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7054 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 7055 |  |  |  |  |  |  | } | 
| 7056 |  |  |  |  |  |  |  | 
| 7057 |  |  |  |  |  |  | # "\U\l" --> "\l\U" | 
| 7058 |  |  |  |  |  |  | elsif (($char[$i] eq '\U') and ($char[$i+1] eq '\l')) { | 
| 7059 | 0 |  |  |  |  |  | @char[$i,$i+1] = @char[$i+1,$i]; | 
| 7060 |  |  |  |  |  |  | } | 
| 7061 |  |  |  |  |  |  |  | 
| 7062 |  |  |  |  |  |  | # octal escape sequence | 
| 7063 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\o \{ ([0-7]+) \} \z/oxms) { | 
| 7064 | 0 |  |  |  |  |  | $char[$i] = Elatin6::octchr($1); | 
| 7065 |  |  |  |  |  |  | } | 
| 7066 |  |  |  |  |  |  |  | 
| 7067 |  |  |  |  |  |  | # hexadecimal escape sequence | 
| 7068 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\x \{ ([0-9A-Fa-f]+) \} \z/oxms) { | 
| 7069 | 0 |  |  |  |  |  | $char[$i] = Elatin6::hexchr($1); | 
| 7070 |  |  |  |  |  |  | } | 
| 7071 |  |  |  |  |  |  |  | 
| 7072 |  |  |  |  |  |  | # \b{...}      --> b\{...} | 
| 7073 |  |  |  |  |  |  | # \B{...}      --> B\{...} | 
| 7074 |  |  |  |  |  |  | # \N{CHARNAME} --> N\{CHARNAME} | 
| 7075 |  |  |  |  |  |  | # \p{PROPERTY} --> p\{PROPERTY} | 
| 7076 |  |  |  |  |  |  | # \P{PROPERTY} --> P\{PROPERTY} | 
| 7077 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ([bBNpP]) ( \{ ([^0-9\}][^\}]*) \} ) \z/oxms) { | 
| 7078 | 0 |  |  |  |  |  | $char[$i] = $1 . '\\' . $2; | 
| 7079 |  |  |  |  |  |  | } | 
| 7080 |  |  |  |  |  |  |  | 
| 7081 |  |  |  |  |  |  | # \p, \P, \X --> p, P, X | 
| 7082 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \\ ( [pPX] ) \z/oxms) { | 
| 7083 | 0 |  |  |  |  |  | $char[$i] = $1; | 
| 7084 |  |  |  |  |  |  | } | 
| 7085 |  |  |  |  |  |  |  | 
| 7086 | 0 | 0 | 0 |  |  |  | if (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 |  |  |  |  |  | 
| 7087 |  |  |  |  |  |  | } | 
| 7088 |  |  |  |  |  |  |  | 
| 7089 |  |  |  |  |  |  | # join separated multiple-octet | 
| 7090 | 0 |  |  |  |  |  | elsif ($char[$i] =~ /\A (?: \\ [0-7]{2,3} | \\x [0-9A-Fa-f]{1,2}) \z/oxms) { | 
| 7091 | 0 | 0 | 0 |  |  |  | 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)) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 7092 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 3; | 
| 7093 |  |  |  |  |  |  | } | 
| 7094 |  |  |  |  |  |  | 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)) { | 
| 7095 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 2; | 
| 7096 |  |  |  |  |  |  | } | 
| 7097 |  |  |  |  |  |  | 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)) { | 
| 7098 | 0 |  |  |  |  |  | $char[$i] .= join '', splice @char, $i+1, 1; | 
| 7099 |  |  |  |  |  |  | } | 
| 7100 |  |  |  |  |  |  | } | 
| 7101 |  |  |  |  |  |  |  | 
| 7102 |  |  |  |  |  |  | # open character class [...] | 
| 7103 |  |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 7104 | 0 |  |  |  |  |  | my $left = $i; | 
| 7105 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 7106 | 0 |  |  |  |  |  | $i++; | 
| 7107 |  |  |  |  |  |  | } | 
| 7108 | 0 |  |  |  |  |  | while (1) { | 
| 7109 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 7110 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 7111 |  |  |  |  |  |  | } | 
| 7112 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 7113 | 0 |  |  |  |  |  | my $right = $i; | 
| 7114 |  |  |  |  |  |  |  | 
| 7115 |  |  |  |  |  |  | # [...] | 
| 7116 | 0 | 0 |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 7117 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Elatin6::charlist_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
|  | 0 |  |  |  |  |  |  | 
| 7118 |  |  |  |  |  |  | } | 
| 7119 |  |  |  |  |  |  | else { | 
| 7120 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 7121 |  |  |  |  |  |  | } | 
| 7122 |  |  |  |  |  |  |  | 
| 7123 | 0 |  |  |  |  |  | $i = $left; | 
| 7124 | 0 |  |  |  |  |  | last; | 
| 7125 |  |  |  |  |  |  | } | 
| 7126 |  |  |  |  |  |  | } | 
| 7127 |  |  |  |  |  |  | } | 
| 7128 |  |  |  |  |  |  |  | 
| 7129 |  |  |  |  |  |  | # open character class [^...] | 
| 7130 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 7131 | 0 |  |  |  |  |  | my $left = $i; | 
| 7132 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 7133 | 0 |  |  |  |  |  | $i++; | 
| 7134 |  |  |  |  |  |  | } | 
| 7135 | 0 |  |  |  |  |  | while (1) { | 
| 7136 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 7137 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 7138 |  |  |  |  |  |  | } | 
| 7139 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 7140 | 0 |  |  |  |  |  | my $right = $i; | 
| 7141 |  |  |  |  |  |  |  | 
| 7142 |  |  |  |  |  |  | # [^...] | 
| 7143 | 0 | 0 |  |  |  |  | if (grep(/\A [\$\@]/oxms,@char[$left+1..$right-1]) >= 1) { | 
| 7144 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, sprintf(q{@{[Elatin6::charlist_not_qr(%s,'%s')]}}, join(',', map {qq_stuff($delimiter,$end_delimiter,$_)} @char[$left+1..$right-1]), $modifier); | 
|  | 0 |  |  |  |  |  |  | 
| 7145 |  |  |  |  |  |  | } | 
| 7146 |  |  |  |  |  |  | else { | 
| 7147 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 7148 |  |  |  |  |  |  | } | 
| 7149 |  |  |  |  |  |  |  | 
| 7150 | 0 |  |  |  |  |  | $i = $left; | 
| 7151 | 0 |  |  |  |  |  | last; | 
| 7152 |  |  |  |  |  |  | } | 
| 7153 |  |  |  |  |  |  | } | 
| 7154 |  |  |  |  |  |  | } | 
| 7155 |  |  |  |  |  |  |  | 
| 7156 |  |  |  |  |  |  | # rewrite character class or escape character | 
| 7157 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 7158 | 0 |  |  |  |  |  | $char[$i] = $char; | 
| 7159 |  |  |  |  |  |  | } | 
| 7160 |  |  |  |  |  |  |  | 
| 7161 |  |  |  |  |  |  | # P.794 29.2.161. split | 
| 7162 |  |  |  |  |  |  | # in Chapter 29: Functions | 
| 7163 |  |  |  |  |  |  | # of ISBN 0-596-00027-8 Programming Perl Third Edition. | 
| 7164 |  |  |  |  |  |  |  | 
| 7165 |  |  |  |  |  |  | # P.951 split | 
| 7166 |  |  |  |  |  |  | # in Chapter 27: Functions | 
| 7167 |  |  |  |  |  |  | # of ISBN 978-0-596-00492-7 Programming Perl 4th Edition. | 
| 7168 |  |  |  |  |  |  |  | 
| 7169 |  |  |  |  |  |  | # said "The //m modifier is assumed when you split on the pattern /^/", | 
| 7170 |  |  |  |  |  |  | # but perl5.008 is not so. Therefore, this software adds //m. | 
| 7171 |  |  |  |  |  |  | # (and so on) | 
| 7172 |  |  |  |  |  |  |  | 
| 7173 |  |  |  |  |  |  | # split(m/^/) --> split(m/^/m) | 
| 7174 |  |  |  |  |  |  | elsif (($char[$i] eq '^') and ($modifier !~ /m/oxms)) { | 
| 7175 | 0 |  |  |  |  |  | $modifier .= 'm'; | 
| 7176 |  |  |  |  |  |  | } | 
| 7177 |  |  |  |  |  |  |  | 
| 7178 |  |  |  |  |  |  | # /i modifier | 
| 7179 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Elatin6::uc($char[$i]) ne Elatin6::fc($char[$i]))) { | 
| 7180 | 0 | 0 |  |  |  |  | if (CORE::length(Elatin6::fc($char[$i])) == 1) { | 
| 7181 | 0 |  |  |  |  |  | $char[$i] = '['   . Elatin6::uc($char[$i])       . Elatin6::fc($char[$i]) . ']'; | 
| 7182 |  |  |  |  |  |  | } | 
| 7183 |  |  |  |  |  |  | else { | 
| 7184 | 0 |  |  |  |  |  | $char[$i] = '(?:' . Elatin6::uc($char[$i]) . '|' . Elatin6::fc($char[$i]) . ')'; | 
| 7185 |  |  |  |  |  |  | } | 
| 7186 |  |  |  |  |  |  | } | 
| 7187 |  |  |  |  |  |  |  | 
| 7188 |  |  |  |  |  |  | # \u \l \U \L \F \Q \E | 
| 7189 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ([<>]) \z/oxms) { | 
| 7190 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 7191 | 0 |  |  |  |  |  | $char[$i] = '\\' . $char[$i]; | 
| 7192 |  |  |  |  |  |  | } | 
| 7193 |  |  |  |  |  |  | } | 
| 7194 |  |  |  |  |  |  | elsif ($char[$i] eq '\u') { | 
| 7195 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ucfirst qq<'; | 
| 7196 | 0 |  |  |  |  |  | $left_e++; | 
| 7197 |  |  |  |  |  |  | } | 
| 7198 |  |  |  |  |  |  | elsif ($char[$i] eq '\l') { | 
| 7199 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lcfirst qq<'; | 
| 7200 | 0 |  |  |  |  |  | $left_e++; | 
| 7201 |  |  |  |  |  |  | } | 
| 7202 |  |  |  |  |  |  | elsif ($char[$i] eq '\U') { | 
| 7203 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::uc qq<'; | 
| 7204 | 0 |  |  |  |  |  | $left_e++; | 
| 7205 |  |  |  |  |  |  | } | 
| 7206 |  |  |  |  |  |  | elsif ($char[$i] eq '\L') { | 
| 7207 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::lc qq<'; | 
| 7208 | 0 |  |  |  |  |  | $left_e++; | 
| 7209 |  |  |  |  |  |  | } | 
| 7210 |  |  |  |  |  |  | elsif ($char[$i] eq '\F') { | 
| 7211 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::fc qq<'; | 
| 7212 | 0 |  |  |  |  |  | $left_e++; | 
| 7213 |  |  |  |  |  |  | } | 
| 7214 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 7215 | 0 |  |  |  |  |  | $char[$i] = '@{[CORE::quotemeta qq<'; | 
| 7216 | 0 |  |  |  |  |  | $left_e++; | 
| 7217 |  |  |  |  |  |  | } | 
| 7218 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 7219 | 0 | 0 |  |  |  |  | if ($right_e < $left_e) { | 
| 7220 | 0 |  |  |  |  |  | $char[$i] = '>]}'; | 
| 7221 | 0 |  |  |  |  |  | $right_e++; | 
| 7222 |  |  |  |  |  |  | } | 
| 7223 |  |  |  |  |  |  | else { | 
| 7224 | 0 |  |  |  |  |  | $char[$i] = ''; | 
| 7225 |  |  |  |  |  |  | } | 
| 7226 |  |  |  |  |  |  | } | 
| 7227 |  |  |  |  |  |  | elsif ($char[$i] eq '\Q') { | 
| 7228 | 0 |  |  |  |  |  | while (1) { | 
| 7229 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 7230 | 0 |  |  |  |  |  | last; | 
| 7231 |  |  |  |  |  |  | } | 
| 7232 | 0 | 0 |  |  |  |  | if ($char[$i] eq '\E') { | 
| 7233 | 0 |  |  |  |  |  | last; | 
| 7234 |  |  |  |  |  |  | } | 
| 7235 |  |  |  |  |  |  | } | 
| 7236 |  |  |  |  |  |  | } | 
| 7237 |  |  |  |  |  |  | elsif ($char[$i] eq '\E') { | 
| 7238 |  |  |  |  |  |  | } | 
| 7239 |  |  |  |  |  |  |  | 
| 7240 |  |  |  |  |  |  | # $0 --> $0 | 
| 7241 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ 0 \z/oxms) { | 
| 7242 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7243 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7244 |  |  |  |  |  |  | } | 
| 7245 |  |  |  |  |  |  | } | 
| 7246 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) 0 (?>\s*) \} \z/oxms) { | 
| 7247 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7248 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7249 |  |  |  |  |  |  | } | 
| 7250 |  |  |  |  |  |  | } | 
| 7251 |  |  |  |  |  |  |  | 
| 7252 |  |  |  |  |  |  | # $$ --> $$ | 
| 7253 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$\$ \z/oxms) { | 
| 7254 |  |  |  |  |  |  | } | 
| 7255 |  |  |  |  |  |  |  | 
| 7256 |  |  |  |  |  |  | # $1, $2, $3 --> $2, $3, $4 after s/// with multibyte anchoring | 
| 7257 |  |  |  |  |  |  | # $1, $2, $3 --> $1, $2, $3 otherwise | 
| 7258 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?>[1-9][0-9]*)) \z/oxms) { | 
| 7259 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 7260 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7261 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7262 |  |  |  |  |  |  | } | 
| 7263 |  |  |  |  |  |  | } | 
| 7264 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ \{ (?>\s*) ((?>[1-9][0-9]*)) (?>\s*) \} \z/oxms) { | 
| 7265 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 7266 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7267 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7268 |  |  |  |  |  |  | } | 
| 7269 |  |  |  |  |  |  | } | 
| 7270 |  |  |  |  |  |  |  | 
| 7271 |  |  |  |  |  |  | # $$foo[ ... ] --> $ $foo->[ ... ] | 
| 7272 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \[ (?:$qq_bracket)*? \] ) \z/oxms) { | 
| 7273 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 7274 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7275 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7276 |  |  |  |  |  |  | } | 
| 7277 |  |  |  |  |  |  | } | 
| 7278 |  |  |  |  |  |  |  | 
| 7279 |  |  |  |  |  |  | # $$foo{ ... } --> $ $foo->{ ... } | 
| 7280 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) ( \{ (?:$qq_brace)*? \} ) \z/oxms) { | 
| 7281 | 0 |  |  |  |  |  | $char[$i] = e_capture($1.'->'.$2); | 
| 7282 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7283 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7284 |  |  |  |  |  |  | } | 
| 7285 |  |  |  |  |  |  | } | 
| 7286 |  |  |  |  |  |  |  | 
| 7287 |  |  |  |  |  |  | # $$foo | 
| 7288 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ ((?> \$ [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* )) \z/oxms) { | 
| 7289 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 7290 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7291 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7292 |  |  |  |  |  |  | } | 
| 7293 |  |  |  |  |  |  | } | 
| 7294 |  |  |  |  |  |  |  | 
| 7295 |  |  |  |  |  |  | # $`, ${`}, $PREMATCH, ${PREMATCH}, ${^PREMATCH} --> Elatin6::PREMATCH() | 
| 7296 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$` | \$\{`\} | \$ (?>\s*) PREMATCH  | \$ (?>\s*) \{ (?>\s*) PREMATCH  (?>\s*) \} | \$ (?>\s*) \{\^PREMATCH\}  ) \z/oxmsgc) { | 
| 7297 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7298 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::PREMATCH())]}'; | 
| 7299 |  |  |  |  |  |  | } | 
| 7300 |  |  |  |  |  |  | else { | 
| 7301 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::PREMATCH()]}'; | 
| 7302 |  |  |  |  |  |  | } | 
| 7303 |  |  |  |  |  |  | } | 
| 7304 |  |  |  |  |  |  |  | 
| 7305 |  |  |  |  |  |  | # $&, ${&}, $MATCH, ${MATCH}, ${^MATCH} --> Elatin6::MATCH() | 
| 7306 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A ( \$& | \$\{&\} | \$ (?>\s*) MATCH     | \$ (?>\s*) \{ (?>\s*) MATCH     (?>\s*) \} | \$ (?>\s*) \{\^MATCH\}     ) \z/oxmsgc) { | 
| 7307 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7308 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::MATCH())]}'; | 
| 7309 |  |  |  |  |  |  | } | 
| 7310 |  |  |  |  |  |  | else { | 
| 7311 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::MATCH()]}'; | 
| 7312 |  |  |  |  |  |  | } | 
| 7313 |  |  |  |  |  |  | } | 
| 7314 |  |  |  |  |  |  |  | 
| 7315 |  |  |  |  |  |  | # $POSTMATCH, ${POSTMATCH}, ${^POSTMATCH} --> Elatin6::POSTMATCH() | 
| 7316 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A (                 \$ (?>\s*) POSTMATCH | \$ (?>\s*) \{ (?>\s*) POSTMATCH (?>\s*) \} | \$ (?>\s*) \{\^POSTMATCH\} ) \z/oxmsgc) { | 
| 7317 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7318 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(Elatin6::POSTMATCH())]}'; | 
| 7319 |  |  |  |  |  |  | } | 
| 7320 |  |  |  |  |  |  | else { | 
| 7321 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::POSTMATCH()]}'; | 
| 7322 |  |  |  |  |  |  | } | 
| 7323 |  |  |  |  |  |  | } | 
| 7324 |  |  |  |  |  |  |  | 
| 7325 |  |  |  |  |  |  | # ${ foo } | 
| 7326 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ((?> \s* [A-Za-z_][A-Za-z0-9_]*(?: ::[A-Za-z_][A-Za-z0-9_]*)* \s* )) \}                            \z/oxms) { | 
| 7327 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7328 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $1 . ')]}'; | 
| 7329 |  |  |  |  |  |  | } | 
| 7330 |  |  |  |  |  |  | } | 
| 7331 |  |  |  |  |  |  |  | 
| 7332 |  |  |  |  |  |  | # ${ ... } | 
| 7333 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A \$ (?>\s*) \{ ( .+ ) \} \z/oxms) { | 
| 7334 | 0 |  |  |  |  |  | $char[$i] = e_capture($1); | 
| 7335 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7336 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7337 |  |  |  |  |  |  | } | 
| 7338 |  |  |  |  |  |  | } | 
| 7339 |  |  |  |  |  |  |  | 
| 7340 |  |  |  |  |  |  | # $scalar or @array | 
| 7341 |  |  |  |  |  |  | elsif ($char[$i] =~ /\A [\$\@].+ /oxms) { | 
| 7342 | 0 |  |  |  |  |  | $char[$i] = e_string($char[$i]); | 
| 7343 | 0 | 0 |  |  |  |  | if ($ignorecase) { | 
| 7344 | 0 |  |  |  |  |  | $char[$i] = '@{[Elatin6::ignorecase(' . $char[$i] . ')]}'; | 
| 7345 |  |  |  |  |  |  | } | 
| 7346 |  |  |  |  |  |  | } | 
| 7347 |  |  |  |  |  |  |  | 
| 7348 |  |  |  |  |  |  | # quote character before ? + * { | 
| 7349 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 7350 | 0 | 0 |  |  |  |  | if ($char[$i-1] =~ /\A (?:[\x00-\xFF]|\\[0-7]{2,3}|\\x[0-9-A-Fa-f]{1,2}) \z/oxms) { | 
| 7351 |  |  |  |  |  |  | } | 
| 7352 |  |  |  |  |  |  | else { | 
| 7353 | 0 |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 7354 |  |  |  |  |  |  | } | 
| 7355 |  |  |  |  |  |  | } | 
| 7356 |  |  |  |  |  |  | } | 
| 7357 |  |  |  |  |  |  |  | 
| 7358 |  |  |  |  |  |  | # make regexp string | 
| 7359 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 7360 | 0 | 0 |  |  |  |  | if ($left_e > $right_e) { | 
| 7361 | 0 |  |  |  |  |  | return join '', 'Elatin6::split', $ope, $delimiter, @char, '>]}' x ($left_e - $right_e), $end_delimiter, $modifier; | 
| 7362 |  |  |  |  |  |  | } | 
| 7363 | 0 |  |  |  |  |  | return     join '', 'Elatin6::split', $ope, $delimiter, @char,                               $end_delimiter, $modifier; | 
| 7364 |  |  |  |  |  |  | } | 
| 7365 |  |  |  |  |  |  |  | 
| 7366 |  |  |  |  |  |  | # | 
| 7367 |  |  |  |  |  |  | # escape regexp of split qr'' | 
| 7368 |  |  |  |  |  |  | # | 
| 7369 |  |  |  |  |  |  | sub e_split_q { | 
| 7370 | 0 |  |  | 0 | 0 |  | my($ope,$delimiter,$end_delimiter,$string,$modifier) = @_; | 
| 7371 | 0 |  | 0 |  |  |  | $modifier ||= ''; | 
| 7372 |  |  |  |  |  |  |  | 
| 7373 | 0 |  |  |  |  |  | $modifier =~ tr/p//d; | 
| 7374 | 0 | 0 |  |  |  |  | if ($modifier =~ /([adlu])/oxms) { | 
| 7375 | 0 |  |  |  |  |  | my $line = 0; | 
| 7376 | 0 |  |  |  |  |  | for (my $i=0; my($package,$filename,$use_line,$subroutine) = caller($i); $i++) { | 
| 7377 | 0 | 0 |  |  |  |  | if ($filename ne __FILE__) { | 
| 7378 | 0 |  |  |  |  |  | $line = $use_line + (CORE::substr($_,0,pos($_)) =~ tr/\n//) + 1; | 
| 7379 | 0 |  |  |  |  |  | last; | 
| 7380 |  |  |  |  |  |  | } | 
| 7381 |  |  |  |  |  |  | } | 
| 7382 | 0 |  |  |  |  |  | die qq{Unsupported modifier "$1" used at line $line.\n}; | 
| 7383 |  |  |  |  |  |  | } | 
| 7384 |  |  |  |  |  |  |  | 
| 7385 | 0 |  |  |  |  |  | $slash = 'div'; | 
| 7386 |  |  |  |  |  |  |  | 
| 7387 |  |  |  |  |  |  | # /b /B modifier | 
| 7388 | 0 | 0 |  |  |  |  | if ($modifier =~ tr/bB//d) { | 
| 7389 | 0 |  |  |  |  |  | return join '', 'split', $ope, $delimiter, $string, $end_delimiter, $modifier; | 
| 7390 |  |  |  |  |  |  | } | 
| 7391 |  |  |  |  |  |  |  | 
| 7392 | 0 | 0 |  |  |  |  | my $ignorecase = ($modifier =~ /i/oxms) ? 1 : 0; | 
| 7393 |  |  |  |  |  |  |  | 
| 7394 |  |  |  |  |  |  | # split regexp | 
| 7395 | 0 |  |  |  |  |  | my @char = $string =~ /\G((?> | 
| 7396 |  |  |  |  |  |  | [^\\\[]       | | 
| 7397 |  |  |  |  |  |  | [\x00-\xFF] | | 
| 7398 |  |  |  |  |  |  | \[\^                            | | 
| 7399 |  |  |  |  |  |  | \[\:   (?>[a-z]+) \:\]          | | 
| 7400 |  |  |  |  |  |  | \[\:\^ (?>[a-z]+) \:\]          | | 
| 7401 |  |  |  |  |  |  | \\     (?:$q_char)              | | 
| 7402 |  |  |  |  |  |  | (?:$q_char) | 
| 7403 |  |  |  |  |  |  | ))/oxmsg; | 
| 7404 |  |  |  |  |  |  |  | 
| 7405 |  |  |  |  |  |  | # unescape character | 
| 7406 | 0 |  |  |  |  |  | for (my $i=0; $i <= $#char; $i++) { | 
| 7407 | 0 | 0 | 0 |  |  |  | if (0) { | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 | 0 |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 7408 |  |  |  |  |  |  | } | 
| 7409 |  |  |  |  |  |  |  | 
| 7410 |  |  |  |  |  |  | # open character class [...] | 
| 7411 | 0 |  |  |  |  |  | elsif ($char[$i] eq '[') { | 
| 7412 | 0 |  |  |  |  |  | my $left = $i; | 
| 7413 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 7414 | 0 |  |  |  |  |  | $i++; | 
| 7415 |  |  |  |  |  |  | } | 
| 7416 | 0 |  |  |  |  |  | while (1) { | 
| 7417 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 7418 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 7419 |  |  |  |  |  |  | } | 
| 7420 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 7421 | 0 |  |  |  |  |  | my $right = $i; | 
| 7422 |  |  |  |  |  |  |  | 
| 7423 |  |  |  |  |  |  | # [...] | 
| 7424 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_qr(@char[$left+1..$right-1], $modifier); | 
| 7425 |  |  |  |  |  |  |  | 
| 7426 | 0 |  |  |  |  |  | $i = $left; | 
| 7427 | 0 |  |  |  |  |  | last; | 
| 7428 |  |  |  |  |  |  | } | 
| 7429 |  |  |  |  |  |  | } | 
| 7430 |  |  |  |  |  |  | } | 
| 7431 |  |  |  |  |  |  |  | 
| 7432 |  |  |  |  |  |  | # open character class [^...] | 
| 7433 |  |  |  |  |  |  | elsif ($char[$i] eq '[^') { | 
| 7434 | 0 |  |  |  |  |  | my $left = $i; | 
| 7435 | 0 | 0 |  |  |  |  | if ($char[$i+1] eq ']') { | 
| 7436 | 0 |  |  |  |  |  | $i++; | 
| 7437 |  |  |  |  |  |  | } | 
| 7438 | 0 |  |  |  |  |  | while (1) { | 
| 7439 | 0 | 0 |  |  |  |  | if (++$i > $#char) { | 
| 7440 | 0 |  |  |  |  |  | die __FILE__, ": Unmatched [] in regexp\n"; | 
| 7441 |  |  |  |  |  |  | } | 
| 7442 | 0 | 0 |  |  |  |  | if ($char[$i] eq ']') { | 
| 7443 | 0 |  |  |  |  |  | my $right = $i; | 
| 7444 |  |  |  |  |  |  |  | 
| 7445 |  |  |  |  |  |  | # [^...] | 
| 7446 | 0 |  |  |  |  |  | splice @char, $left, $right-$left+1, Elatin6::charlist_not_qr(@char[$left+1..$right-1], $modifier); | 
| 7447 |  |  |  |  |  |  |  | 
| 7448 | 0 |  |  |  |  |  | $i = $left; | 
| 7449 | 0 |  |  |  |  |  | last; | 
| 7450 |  |  |  |  |  |  | } | 
| 7451 |  |  |  |  |  |  | } | 
| 7452 |  |  |  |  |  |  | } | 
| 7453 |  |  |  |  |  |  |  | 
| 7454 |  |  |  |  |  |  | # rewrite character class or escape character | 
| 7455 |  |  |  |  |  |  | elsif (my $char = character_class($char[$i],$modifier)) { | 
| 7456 | 0 |  |  |  |  |  | $char[$i] = $char; | 
| 7457 |  |  |  |  |  |  | } | 
| 7458 |  |  |  |  |  |  |  | 
| 7459 |  |  |  |  |  |  | # split(m/^/) --> split(m/^/m) | 
| 7460 |  |  |  |  |  |  | elsif (($char[$i] eq '^') and ($modifier !~ /m/oxms)) { | 
| 7461 | 0 |  |  |  |  |  | $modifier .= 'm'; | 
| 7462 |  |  |  |  |  |  | } | 
| 7463 |  |  |  |  |  |  |  | 
| 7464 |  |  |  |  |  |  | # /i modifier | 
| 7465 |  |  |  |  |  |  | elsif ($ignorecase and ($char[$i] =~ /\A [\x00-\xFF] \z/oxms) and (Elatin6::uc($char[$i]) ne Elatin6::fc($char[$i]))) { | 
| 7466 | 0 | 0 |  |  |  |  | if (CORE::length(Elatin6::fc($char[$i])) == 1) { | 
| 7467 | 0 |  |  |  |  |  | $char[$i] = '['   . Elatin6::uc($char[$i])       . Elatin6::fc($char[$i]) . ']'; | 
| 7468 |  |  |  |  |  |  | } | 
| 7469 |  |  |  |  |  |  | else { | 
| 7470 | 0 |  |  |  |  |  | $char[$i] = '(?:' . Elatin6::uc($char[$i]) . '|' . Elatin6::fc($char[$i]) . ')'; | 
| 7471 |  |  |  |  |  |  | } | 
| 7472 |  |  |  |  |  |  | } | 
| 7473 |  |  |  |  |  |  |  | 
| 7474 |  |  |  |  |  |  | # quote character before ? + * { | 
| 7475 |  |  |  |  |  |  | elsif (($i >= 1) and ($char[$i] =~ /\A [\?\+\*\{] \z/oxms)) { | 
| 7476 | 0 | 0 |  |  |  |  | if ($char[$i-1] =~ /\A [\x00-\xFF] \z/oxms) { | 
| 7477 |  |  |  |  |  |  | } | 
| 7478 |  |  |  |  |  |  | else { | 
| 7479 | 0 |  |  |  |  |  | $char[$i-1] = '(?:' . $char[$i-1] . ')'; | 
| 7480 |  |  |  |  |  |  | } | 
| 7481 |  |  |  |  |  |  | } | 
| 7482 |  |  |  |  |  |  | } | 
| 7483 |  |  |  |  |  |  |  | 
| 7484 | 0 |  |  |  |  |  | $modifier =~ tr/i//d; | 
| 7485 | 0 |  |  |  |  |  | return join '', 'Elatin6::split', $ope, $delimiter, @char, $end_delimiter, $modifier; | 
| 7486 |  |  |  |  |  |  | } | 
| 7487 |  |  |  |  |  |  |  | 
| 7488 |  |  |  |  |  |  | # | 
| 7489 |  |  |  |  |  |  | # instead of Carp::carp | 
| 7490 |  |  |  |  |  |  | # | 
| 7491 |  |  |  |  |  |  | sub carp { | 
| 7492 | 0 |  |  | 0 | 0 |  | my($package,$filename,$line) = caller(1); | 
| 7493 | 0 |  |  |  |  |  | print STDERR "@_ at $filename line $line.\n"; | 
| 7494 |  |  |  |  |  |  | } | 
| 7495 |  |  |  |  |  |  |  | 
| 7496 |  |  |  |  |  |  | # | 
| 7497 |  |  |  |  |  |  | # instead of Carp::croak | 
| 7498 |  |  |  |  |  |  | # | 
| 7499 |  |  |  |  |  |  | sub croak { | 
| 7500 | 0 |  |  | 0 | 0 |  | my($package,$filename,$line) = caller(1); | 
| 7501 | 0 |  |  |  |  |  | print STDERR "@_ at $filename line $line.\n"; | 
| 7502 | 0 |  |  |  |  |  | die "\n"; | 
| 7503 |  |  |  |  |  |  | } | 
| 7504 |  |  |  |  |  |  |  | 
| 7505 |  |  |  |  |  |  | # | 
| 7506 |  |  |  |  |  |  | # instead of Carp::cluck | 
| 7507 |  |  |  |  |  |  | # | 
| 7508 |  |  |  |  |  |  | sub cluck { | 
| 7509 | 0 |  |  | 0 | 0 |  | my $i = 0; | 
| 7510 | 0 |  |  |  |  |  | my @cluck = (); | 
| 7511 | 0 |  |  |  |  |  | while (my($package,$filename,$line,$subroutine) = caller($i)) { | 
| 7512 | 0 |  |  |  |  |  | push @cluck, "[$i] $filename($line) $package::$subroutine\n"; | 
| 7513 | 0 |  |  |  |  |  | $i++; | 
| 7514 |  |  |  |  |  |  | } | 
| 7515 | 0 |  |  |  |  |  | print STDERR CORE::reverse @cluck; | 
| 7516 | 0 |  |  |  |  |  | print STDERR "\n"; | 
| 7517 | 0 |  |  |  |  |  | carp @_; | 
| 7518 |  |  |  |  |  |  | } | 
| 7519 |  |  |  |  |  |  |  | 
| 7520 |  |  |  |  |  |  | # | 
| 7521 |  |  |  |  |  |  | # instead of Carp::confess | 
| 7522 |  |  |  |  |  |  | # | 
| 7523 |  |  |  |  |  |  | sub confess { | 
| 7524 | 0 |  |  | 0 | 0 |  | my $i = 0; | 
| 7525 | 0 |  |  |  |  |  | my @confess = (); | 
| 7526 | 0 |  |  |  |  |  | while (my($package,$filename,$line,$subroutine) = caller($i)) { | 
| 7527 | 0 |  |  |  |  |  | push @confess, "[$i] $filename($line) $package::$subroutine\n"; | 
| 7528 | 0 |  |  |  |  |  | $i++; | 
| 7529 |  |  |  |  |  |  | } | 
| 7530 | 0 |  |  |  |  |  | print STDERR CORE::reverse @confess; | 
| 7531 | 0 |  |  |  |  |  | print STDERR "\n"; | 
| 7532 | 0 |  |  |  |  |  | croak @_; | 
| 7533 |  |  |  |  |  |  | } | 
| 7534 |  |  |  |  |  |  |  | 
| 7535 |  |  |  |  |  |  | 1; | 
| 7536 |  |  |  |  |  |  |  | 
| 7537 |  |  |  |  |  |  | __END__ |