lib/charnames.pm

   1 package charnames;
   2 use strict;
   3 use warnings;
   4 use File::Spec;
   5 our $VERSION = '1.17';
   6
   7 use bytes ();          # for $bytes::hint_bits
   8
   9 # The hashes are stored as utf8 strings.  This makes it easier to deal with
  10 # sequences.  I (khw) also tried making Name.pl utf8, but it slowed things
  11 # down by a factor of 7.  I then tried making Name.pl store the ut8
  12 # equivalents but not calling them utf8.  That led to similar speed as leaving
  13 # it alone, but since that is harder for a human to parse, I left it as-is.
  14
  15 my %system_aliases = (
  16     # Icky 3.2 names with parentheses.
  17     'LINE FEED'             => pack("U", 0x0A), # LINE FEED (LF)
  18     'FORM FEED'             => pack("U", 0x0C), # FORM FEED (FF)
  19     'CARRIAGE RETURN'       => pack("U", 0x0D), # CARRIAGE RETURN (CR)
  20     'NEXT LINE'             => pack("U", 0x85), # NEXT LINE (NEL)
  21
  22     # Some variant names from Wikipedia
  23     'SINGLE-SHIFT 2'                => pack("U", 0x8E),
  24     'SINGLE-SHIFT 3'                => pack("U", 0x8F),
  25     'PRIVATE USE 1'                 => pack("U", 0x91),
  26     'PRIVATE USE 2'                 => pack("U", 0x92),
  27     'START OF PROTECTED AREA'       => pack("U", 0x96),
  28     'END OF PROTECTED AREA'         => pack("U", 0x97),
  29
  30     # Convenience.  Standard abbreviations for the controls
  31     'NUL'           => pack("U", 0x00), # NULL
  32     'SOH'           => pack("U", 0x01), # START OF HEADING
  33     'STX'           => pack("U", 0x02), # START OF TEXT
  34     'ETX'           => pack("U", 0x03), # END OF TEXT
  35     'EOT'           => pack("U", 0x04), # END OF TRANSMISSION
  36     'ENQ'           => pack("U", 0x05), # ENQUIRY
  37     'ACK'           => pack("U", 0x06), # ACKNOWLEDGE
  38     'BEL'           => pack("U", 0x07), # ALERT; formerly BELL
  39     'BS'            => pack("U", 0x08), # BACKSPACE
  40     'HT'            => pack("U", 0x09), # HORIZONTAL TABULATION
  41     'LF'            => pack("U", 0x0A), # LINE FEED (LF)
  42     'VT'            => pack("U", 0x0B), # VERTICAL TABULATION
  43     'FF'            => pack("U", 0x0C), # FORM FEED (FF)
  44     'CR'            => pack("U", 0x0D), # CARRIAGE RETURN (CR)
  45     'SO'            => pack("U", 0x0E), # SHIFT OUT
  46     'SI'            => pack("U", 0x0F), # SHIFT IN
  47     'DLE'           => pack("U", 0x10), # DATA LINK ESCAPE
  48     'DC1'           => pack("U", 0x11), # DEVICE CONTROL ONE
  49     'DC2'           => pack("U", 0x12), # DEVICE CONTROL TWO
  50     'DC3'           => pack("U", 0x13), # DEVICE CONTROL THREE
  51     'DC4'           => pack("U", 0x14), # DEVICE CONTROL FOUR
  52     'NAK'           => pack("U", 0x15), # NEGATIVE ACKNOWLEDGE
  53     'SYN'           => pack("U", 0x16), # SYNCHRONOUS IDLE
  54     'ETB'           => pack("U", 0x17), # END OF TRANSMISSION BLOCK
  55     'CAN'           => pack("U", 0x18), # CANCEL
  56     'EOM'           => pack("U", 0x19), # END OF MEDIUM
  57     'SUB'           => pack("U", 0x1A), # SUBSTITUTE
  58     'ESC'           => pack("U", 0x1B), # ESCAPE
  59     'FS'            => pack("U", 0x1C), # FILE SEPARATOR
  60     'GS'            => pack("U", 0x1D), # GROUP SEPARATOR
  61     'RS'            => pack("U", 0x1E), # RECORD SEPARATOR
  62     'US'            => pack("U", 0x1F), # UNIT SEPARATOR
  63     'DEL'           => pack("U", 0x7F), # DELETE
  64     'BPH'           => pack("U", 0x82), # BREAK PERMITTED HERE
  65     'NBH'           => pack("U", 0x83), # NO BREAK HERE
  66     'NEL'           => pack("U", 0x85), # NEXT LINE (NEL)
  67     'SSA'           => pack("U", 0x86), # START OF SELECTED AREA
  68     'ESA'           => pack("U", 0x87), # END OF SELECTED AREA
  69     'HTS'           => pack("U", 0x88), # CHARACTER TABULATION SET
  70     'HTJ'           => pack("U", 0x89), # CHARACTER TABULATION WITH JUSTIFICATION
  71     'VTS'           => pack("U", 0x8A), # LINE TABULATION SET
  72     'PLD'           => pack("U", 0x8B), # PARTIAL LINE FORWARD
  73     'PLU'           => pack("U", 0x8C), # PARTIAL LINE BACKWARD
  74     'RI '           => pack("U", 0x8D), # REVERSE LINE FEED
  75     'SS2'           => pack("U", 0x8E), # SINGLE SHIFT TWO
  76     'SS3'           => pack("U", 0x8F), # SINGLE SHIFT THREE
  77     'DCS'           => pack("U", 0x90), # DEVICE CONTROL STRING
  78     'PU1'           => pack("U", 0x91), # PRIVATE USE ONE
  79     'PU2'           => pack("U", 0x92), # PRIVATE USE TWO
  80     'STS'           => pack("U", 0x93), # SET TRANSMIT STATE
  81     'CCH'           => pack("U", 0x94), # CANCEL CHARACTER
  82     'MW '           => pack("U", 0x95), # MESSAGE WAITING
  83     'SPA'           => pack("U", 0x96), # START OF GUARDED AREA
  84     'EPA'           => pack("U", 0x97), # END OF GUARDED AREA
  85     'SOS'           => pack("U", 0x98), # START OF STRING
  86     'SCI'           => pack("U", 0x9A), # SINGLE CHARACTER INTRODUCER
  87     'CSI'           => pack("U", 0x9B), # CONTROL SEQUENCE INTRODUCER
  88     'ST '           => pack("U", 0x9C), # STRING TERMINATOR
  89     'OSC'           => pack("U", 0x9D), # OPERATING SYSTEM COMMAND
  90     'PM '           => pack("U", 0x9E), # PRIVACY MESSAGE
  91     'APC'           => pack("U", 0x9F), # APPLICATION PROGRAM COMMAND
  92
  93     # There are no names for these in the Unicode standard; perhaps should be
  94     # deprecated, but then again there are no alternative names, so am not
  95     # deprecating.  And if did, the code would have to change to not recommend
  96     # an alternative for these.
  97     'PADDING CHARACTER'                     => pack("U", 0x80),
  98     'PAD'                                   => pack("U", 0x80),
  99     'HIGH OCTET PRESET'                     => pack("U", 0x81),
 100     'HOP'                                   => pack("U", 0x81),
 101     'INDEX'                                 => pack("U", 0x84),
 102     'IND'                                   => pack("U", 0x84),
 103     'SINGLE GRAPHIC CHARACTER INTRODUCER'   => pack("U", 0x99),
 104     'SGC'                                   => pack("U", 0x99),
 105
 106     # More convenience.  For further convenience, it is suggested some way of
 107     # using the NamesList aliases be implemented, but there are ambiguities in
 108     # NamesList.txt
 109     'BOM'   => pack("U", 0xFEFF), # BYTE ORDER MARK
 110     'BYTE ORDER MARK'=> pack("U", 0xFEFF),
 111     'CGJ'   => pack("U", 0x034F), # COMBINING GRAPHEME JOINER
 112     'FVS1'  => pack("U", 0x180B), # MONGOLIAN FREE VARIATION SELECTOR ONE
 113     'FVS2'  => pack("U", 0x180C), # MONGOLIAN FREE VARIATION SELECTOR TWO
 114     'FVS3'  => pack("U", 0x180D), # MONGOLIAN FREE VARIATION SELECTOR THREE
 115     'LRE'   => pack("U", 0x202A), # LEFT-TO-RIGHT EMBEDDING
 116     'LRM'   => pack("U", 0x200E), # LEFT-TO-RIGHT MARK
 117     'LRO'   => pack("U", 0x202D), # LEFT-TO-RIGHT OVERRIDE
 118     'MMSP'  => pack("U", 0x205F), # MEDIUM MATHEMATICAL SPACE
 119     'MVS'   => pack("U", 0x180E), # MONGOLIAN VOWEL SEPARATOR
 120     'NBSP'  => pack("U", 0x00A0), # NO-BREAK SPACE
 121     'NNBSP' => pack("U", 0x202F), # NARROW NO-BREAK SPACE
 122     'PDF'   => pack("U", 0x202C), # POP DIRECTIONAL FORMATTING
 123     'RLE'   => pack("U", 0x202B), # RIGHT-TO-LEFT EMBEDDING
 124     'RLM'   => pack("U", 0x200F), # RIGHT-TO-LEFT MARK
 125     'RLO'   => pack("U", 0x202E), # RIGHT-TO-LEFT OVERRIDE
 126     'SHY'   => pack("U", 0x00AD), # SOFT HYPHEN
 127     'VS1'   => pack("U", 0xFE00), # VARIATION SELECTOR-1
 128     'VS2'   => pack("U", 0xFE01), # VARIATION SELECTOR-2
 129     'VS3'   => pack("U", 0xFE02), # VARIATION SELECTOR-3
 130     'VS4'   => pack("U", 0xFE03), # VARIATION SELECTOR-4
 131     'VS5'   => pack("U", 0xFE04), # VARIATION SELECTOR-5
 132     'VS6'   => pack("U", 0xFE05), # VARIATION SELECTOR-6
 133     'VS7'   => pack("U", 0xFE06), # VARIATION SELECTOR-7
 134     'VS8'   => pack("U", 0xFE07), # VARIATION SELECTOR-8
 135     'VS9'   => pack("U", 0xFE08), # VARIATION SELECTOR-9
 136     'VS10'  => pack("U", 0xFE09), # VARIATION SELECTOR-10
 137     'VS11'  => pack("U", 0xFE0A), # VARIATION SELECTOR-11
 138     'VS12'  => pack("U", 0xFE0B), # VARIATION SELECTOR-12
 139     'VS13'  => pack("U", 0xFE0C), # VARIATION SELECTOR-13
 140     'VS14'  => pack("U", 0xFE0D), # VARIATION SELECTOR-14
 141     'VS15'  => pack("U", 0xFE0E), # VARIATION SELECTOR-15
 142     'VS16'  => pack("U", 0xFE0F), # VARIATION SELECTOR-16
 143     'VS17'  => pack("U", 0xE0100), # VARIATION SELECTOR-17
 144     'VS18'  => pack("U", 0xE0101), # VARIATION SELECTOR-18
 145     'VS19'  => pack("U", 0xE0102), # VARIATION SELECTOR-19
 146     'VS20'  => pack("U", 0xE0103), # VARIATION SELECTOR-20
 147     'VS21'  => pack("U", 0xE0104), # VARIATION SELECTOR-21
 148     'VS22'  => pack("U", 0xE0105), # VARIATION SELECTOR-22
 149     'VS23'  => pack("U", 0xE0106), # VARIATION SELECTOR-23
 150     'VS24'  => pack("U", 0xE0107), # VARIATION SELECTOR-24
 151     'VS25'  => pack("U", 0xE0108), # VARIATION SELECTOR-25
 152     'VS26'  => pack("U", 0xE0109), # VARIATION SELECTOR-26
 153     'VS27'  => pack("U", 0xE010A), # VARIATION SELECTOR-27
 154     'VS28'  => pack("U", 0xE010B), # VARIATION SELECTOR-28
 155     'VS29'  => pack("U", 0xE010C), # VARIATION SELECTOR-29
 156     'VS30'  => pack("U", 0xE010D), # VARIATION SELECTOR-30
 157     'VS31'  => pack("U", 0xE010E), # VARIATION SELECTOR-31
 158     'VS32'  => pack("U", 0xE010F), # VARIATION SELECTOR-32
 159     'VS33'  => pack("U", 0xE0110), # VARIATION SELECTOR-33
 160     'VS34'  => pack("U", 0xE0111), # VARIATION SELECTOR-34
 161     'VS35'  => pack("U", 0xE0112), # VARIATION SELECTOR-35
 162     'VS36'  => pack("U", 0xE0113), # VARIATION SELECTOR-36
 163     'VS37'  => pack("U", 0xE0114), # VARIATION SELECTOR-37
 164     'VS38'  => pack("U", 0xE0115), # VARIATION SELECTOR-38
 165     'VS39'  => pack("U", 0xE0116), # VARIATION SELECTOR-39
 166     'VS40'  => pack("U", 0xE0117), # VARIATION SELECTOR-40
 167     'VS41'  => pack("U", 0xE0118), # VARIATION SELECTOR-41
 168     'VS42'  => pack("U", 0xE0119), # VARIATION SELECTOR-42
 169     'VS43'  => pack("U", 0xE011A), # VARIATION SELECTOR-43
 170     'VS44'  => pack("U", 0xE011B), # VARIATION SELECTOR-44
 171     'VS45'  => pack("U", 0xE011C), # VARIATION SELECTOR-45
 172     'VS46'  => pack("U", 0xE011D), # VARIATION SELECTOR-46
 173     'VS47'  => pack("U", 0xE011E), # VARIATION SELECTOR-47
 174     'VS48'  => pack("U", 0xE011F), # VARIATION SELECTOR-48
 175     'VS49'  => pack("U", 0xE0120), # VARIATION SELECTOR-49
 176     'VS50'  => pack("U", 0xE0121), # VARIATION SELECTOR-50
 177     'VS51'  => pack("U", 0xE0122), # VARIATION SELECTOR-51
 178     'VS52'  => pack("U", 0xE0123), # VARIATION SELECTOR-52
 179     'VS53'  => pack("U", 0xE0124), # VARIATION SELECTOR-53
 180     'VS54'  => pack("U", 0xE0125), # VARIATION SELECTOR-54
 181     'VS55'  => pack("U", 0xE0126), # VARIATION SELECTOR-55
 182     'VS56'  => pack("U", 0xE0127), # VARIATION SELECTOR-56
 183     'VS57'  => pack("U", 0xE0128), # VARIATION SELECTOR-57
 184     'VS58'  => pack("U", 0xE0129), # VARIATION SELECTOR-58
 185     'VS59'  => pack("U", 0xE012A), # VARIATION SELECTOR-59
 186     'VS60'  => pack("U", 0xE012B), # VARIATION SELECTOR-60
 187     'VS61'  => pack("U", 0xE012C), # VARIATION SELECTOR-61
 188     'VS62'  => pack("U", 0xE012D), # VARIATION SELECTOR-62
 189     'VS63'  => pack("U", 0xE012E), # VARIATION SELECTOR-63
 190     'VS64'  => pack("U", 0xE012F), # VARIATION SELECTOR-64
 191     'VS65'  => pack("U", 0xE0130), # VARIATION SELECTOR-65
 192     'VS66'  => pack("U", 0xE0131), # VARIATION SELECTOR-66
 193     'VS67'  => pack("U", 0xE0132), # VARIATION SELECTOR-67
 194     'VS68'  => pack("U", 0xE0133), # VARIATION SELECTOR-68
 195     'VS69'  => pack("U", 0xE0134), # VARIATION SELECTOR-69
 196     'VS70'  => pack("U", 0xE0135), # VARIATION SELECTOR-70
 197     'VS71'  => pack("U", 0xE0136), # VARIATION SELECTOR-71
 198     'VS72'  => pack("U", 0xE0137), # VARIATION SELECTOR-72
 199     'VS73'  => pack("U", 0xE0138), # VARIATION SELECTOR-73
 200     'VS74'  => pack("U", 0xE0139), # VARIATION SELECTOR-74
 201     'VS75'  => pack("U", 0xE013A), # VARIATION SELECTOR-75
 202     'VS76'  => pack("U", 0xE013B), # VARIATION SELECTOR-76
 203     'VS77'  => pack("U", 0xE013C), # VARIATION SELECTOR-77
 204     'VS78'  => pack("U", 0xE013D), # VARIATION SELECTOR-78
 205     'VS79'  => pack("U", 0xE013E), # VARIATION SELECTOR-79
 206     'VS80'  => pack("U", 0xE013F), # VARIATION SELECTOR-80
 207     'VS81'  => pack("U", 0xE0140), # VARIATION SELECTOR-81
 208     'VS82'  => pack("U", 0xE0141), # VARIATION SELECTOR-82
 209     'VS83'  => pack("U", 0xE0142), # VARIATION SELECTOR-83
 210     'VS84'  => pack("U", 0xE0143), # VARIATION SELECTOR-84
 211     'VS85'  => pack("U", 0xE0144), # VARIATION SELECTOR-85
 212     'VS86'  => pack("U", 0xE0145), # VARIATION SELECTOR-86
 213     'VS87'  => pack("U", 0xE0146), # VARIATION SELECTOR-87
 214     'VS88'  => pack("U", 0xE0147), # VARIATION SELECTOR-88
 215     'VS89'  => pack("U", 0xE0148), # VARIATION SELECTOR-89
 216     'VS90'  => pack("U", 0xE0149), # VARIATION SELECTOR-90
 217     'VS91'  => pack("U", 0xE014A), # VARIATION SELECTOR-91
 218     'VS92'  => pack("U", 0xE014B), # VARIATION SELECTOR-92
 219     'VS93'  => pack("U", 0xE014C), # VARIATION SELECTOR-93
 220     'VS94'  => pack("U", 0xE014D), # VARIATION SELECTOR-94
 221     'VS95'  => pack("U", 0xE014E), # VARIATION SELECTOR-95
 222     'VS96'  => pack("U", 0xE014F), # VARIATION SELECTOR-96
 223     'VS97'  => pack("U", 0xE0150), # VARIATION SELECTOR-97
 224     'VS98'  => pack("U", 0xE0151), # VARIATION SELECTOR-98
 225     'VS99'  => pack("U", 0xE0152), # VARIATION SELECTOR-99
 226     'VS100' => pack("U", 0xE0153), # VARIATION SELECTOR-100
 227     'VS101' => pack("U", 0xE0154), # VARIATION SELECTOR-101
 228     'VS102' => pack("U", 0xE0155), # VARIATION SELECTOR-102
 229     'VS103' => pack("U", 0xE0156), # VARIATION SELECTOR-103
 230     'VS104' => pack("U", 0xE0157), # VARIATION SELECTOR-104
 231     'VS105' => pack("U", 0xE0158), # VARIATION SELECTOR-105
 232     'VS106' => pack("U", 0xE0159), # VARIATION SELECTOR-106
 233     'VS107' => pack("U", 0xE015A), # VARIATION SELECTOR-107
 234     'VS108' => pack("U", 0xE015B), # VARIATION SELECTOR-108
 235     'VS109' => pack("U", 0xE015C), # VARIATION SELECTOR-109
 236     'VS110' => pack("U", 0xE015D), # VARIATION SELECTOR-110
 237     'VS111' => pack("U", 0xE015E), # VARIATION SELECTOR-111
 238     'VS112' => pack("U", 0xE015F), # VARIATION SELECTOR-112
 239     'VS113' => pack("U", 0xE0160), # VARIATION SELECTOR-113
 240     'VS114' => pack("U", 0xE0161), # VARIATION SELECTOR-114
 241     'VS115' => pack("U", 0xE0162), # VARIATION SELECTOR-115
 242     'VS116' => pack("U", 0xE0163), # VARIATION SELECTOR-116
 243     'VS117' => pack("U", 0xE0164), # VARIATION SELECTOR-117
 244     'VS118' => pack("U", 0xE0165), # VARIATION SELECTOR-118
 245     'VS119' => pack("U", 0xE0166), # VARIATION SELECTOR-119
 246     'VS120' => pack("U", 0xE0167), # VARIATION SELECTOR-120
 247     'VS121' => pack("U", 0xE0168), # VARIATION SELECTOR-121
 248     'VS122' => pack("U", 0xE0169), # VARIATION SELECTOR-122
 249     'VS123' => pack("U", 0xE016A), # VARIATION SELECTOR-123
 250     'VS124' => pack("U", 0xE016B), # VARIATION SELECTOR-124
 251     'VS125' => pack("U", 0xE016C), # VARIATION SELECTOR-125
 252     'VS126' => pack("U", 0xE016D), # VARIATION SELECTOR-126
 253     'VS127' => pack("U", 0xE016E), # VARIATION SELECTOR-127
 254     'VS128' => pack("U", 0xE016F), # VARIATION SELECTOR-128
 255     'VS129' => pack("U", 0xE0170), # VARIATION SELECTOR-129
 256     'VS130' => pack("U", 0xE0171), # VARIATION SELECTOR-130
 257     'VS131' => pack("U", 0xE0172), # VARIATION SELECTOR-131
 258     'VS132' => pack("U", 0xE0173), # VARIATION SELECTOR-132
 259     'VS133' => pack("U", 0xE0174), # VARIATION SELECTOR-133
 260     'VS134' => pack("U", 0xE0175), # VARIATION SELECTOR-134
 261     'VS135' => pack("U", 0xE0176), # VARIATION SELECTOR-135
 262     'VS136' => pack("U", 0xE0177), # VARIATION SELECTOR-136
 263     'VS137' => pack("U", 0xE0178), # VARIATION SELECTOR-137
 264     'VS138' => pack("U", 0xE0179), # VARIATION SELECTOR-138
 265     'VS139' => pack("U", 0xE017A), # VARIATION SELECTOR-139
 266     'VS140' => pack("U", 0xE017B), # VARIATION SELECTOR-140
 267     'VS141' => pack("U", 0xE017C), # VARIATION SELECTOR-141
 268     'VS142' => pack("U", 0xE017D), # VARIATION SELECTOR-142
 269     'VS143' => pack("U", 0xE017E), # VARIATION SELECTOR-143
 270     'VS144' => pack("U", 0xE017F), # VARIATION SELECTOR-144
 271     'VS145' => pack("U", 0xE0180), # VARIATION SELECTOR-145
 272     'VS146' => pack("U", 0xE0181), # VARIATION SELECTOR-146
 273     'VS147' => pack("U", 0xE0182), # VARIATION SELECTOR-147
 274     'VS148' => pack("U", 0xE0183), # VARIATION SELECTOR-148
 275     'VS149' => pack("U", 0xE0184), # VARIATION SELECTOR-149
 276     'VS150' => pack("U", 0xE0185), # VARIATION SELECTOR-150
 277     'VS151' => pack("U", 0xE0186), # VARIATION SELECTOR-151
 278     'VS152' => pack("U", 0xE0187), # VARIATION SELECTOR-152
 279     'VS153' => pack("U", 0xE0188), # VARIATION SELECTOR-153
 280     'VS154' => pack("U", 0xE0189), # VARIATION SELECTOR-154
 281     'VS155' => pack("U", 0xE018A), # VARIATION SELECTOR-155
 282     'VS156' => pack("U", 0xE018B), # VARIATION SELECTOR-156
 283     'VS157' => pack("U", 0xE018C), # VARIATION SELECTOR-157
 284     'VS158' => pack("U", 0xE018D), # VARIATION SELECTOR-158
 285     'VS159' => pack("U", 0xE018E), # VARIATION SELECTOR-159
 286     'VS160' => pack("U", 0xE018F), # VARIATION SELECTOR-160
 287     'VS161' => pack("U", 0xE0190), # VARIATION SELECTOR-161
 288     'VS162' => pack("U", 0xE0191), # VARIATION SELECTOR-162
 289     'VS163' => pack("U", 0xE0192), # VARIATION SELECTOR-163
 290     'VS164' => pack("U", 0xE0193), # VARIATION SELECTOR-164
 291     'VS165' => pack("U", 0xE0194), # VARIATION SELECTOR-165
 292     'VS166' => pack("U", 0xE0195), # VARIATION SELECTOR-166
 293     'VS167' => pack("U", 0xE0196), # VARIATION SELECTOR-167
 294     'VS168' => pack("U", 0xE0197), # VARIATION SELECTOR-168
 295     'VS169' => pack("U", 0xE0198), # VARIATION SELECTOR-169
 296     'VS170' => pack("U", 0xE0199), # VARIATION SELECTOR-170
 297     'VS171' => pack("U", 0xE019A), # VARIATION SELECTOR-171
 298     'VS172' => pack("U", 0xE019B), # VARIATION SELECTOR-172
 299     'VS173' => pack("U", 0xE019C), # VARIATION SELECTOR-173
 300     'VS174' => pack("U", 0xE019D), # VARIATION SELECTOR-174
 301     'VS175' => pack("U", 0xE019E), # VARIATION SELECTOR-175
 302     'VS176' => pack("U", 0xE019F), # VARIATION SELECTOR-176
 303     'VS177' => pack("U", 0xE01A0), # VARIATION SELECTOR-177
 304     'VS178' => pack("U", 0xE01A1), # VARIATION SELECTOR-178
 305     'VS179' => pack("U", 0xE01A2), # VARIATION SELECTOR-179
 306     'VS180' => pack("U", 0xE01A3), # VARIATION SELECTOR-180
 307     'VS181' => pack("U", 0xE01A4), # VARIATION SELECTOR-181
 308     'VS182' => pack("U", 0xE01A5), # VARIATION SELECTOR-182
 309     'VS183' => pack("U", 0xE01A6), # VARIATION SELECTOR-183
 310     'VS184' => pack("U", 0xE01A7), # VARIATION SELECTOR-184
 311     'VS185' => pack("U", 0xE01A8), # VARIATION SELECTOR-185
 312     'VS186' => pack("U", 0xE01A9), # VARIATION SELECTOR-186
 313     'VS187' => pack("U", 0xE01AA), # VARIATION SELECTOR-187
 314     'VS188' => pack("U", 0xE01AB), # VARIATION SELECTOR-188
 315     'VS189' => pack("U", 0xE01AC), # VARIATION SELECTOR-189
 316     'VS190' => pack("U", 0xE01AD), # VARIATION SELECTOR-190
 317     'VS191' => pack("U", 0xE01AE), # VARIATION SELECTOR-191
 318     'VS192' => pack("U", 0xE01AF), # VARIATION SELECTOR-192
 319     'VS193' => pack("U", 0xE01B0), # VARIATION SELECTOR-193
 320     'VS194' => pack("U", 0xE01B1), # VARIATION SELECTOR-194
 321     'VS195' => pack("U", 0xE01B2), # VARIATION SELECTOR-195
 322     'VS196' => pack("U", 0xE01B3), # VARIATION SELECTOR-196
 323     'VS197' => pack("U", 0xE01B4), # VARIATION SELECTOR-197
 324     'VS198' => pack("U", 0xE01B5), # VARIATION SELECTOR-198
 325     'VS199' => pack("U", 0xE01B6), # VARIATION SELECTOR-199
 326     'VS200' => pack("U", 0xE01B7), # VARIATION SELECTOR-200
 327     'VS201' => pack("U", 0xE01B8), # VARIATION SELECTOR-201
 328     'VS202' => pack("U", 0xE01B9), # VARIATION SELECTOR-202
 329     'VS203' => pack("U", 0xE01BA), # VARIATION SELECTOR-203
 330     'VS204' => pack("U", 0xE01BB), # VARIATION SELECTOR-204
 331     'VS205' => pack("U", 0xE01BC), # VARIATION SELECTOR-205
 332     'VS206' => pack("U", 0xE01BD), # VARIATION SELECTOR-206
 333     'VS207' => pack("U", 0xE01BE), # VARIATION SELECTOR-207
 334     'VS208' => pack("U", 0xE01BF), # VARIATION SELECTOR-208
 335     'VS209' => pack("U", 0xE01C0), # VARIATION SELECTOR-209
 336     'VS210' => pack("U", 0xE01C1), # VARIATION SELECTOR-210
 337     'VS211' => pack("U", 0xE01C2), # VARIATION SELECTOR-211
 338     'VS212' => pack("U", 0xE01C3), # VARIATION SELECTOR-212
 339     'VS213' => pack("U", 0xE01C4), # VARIATION SELECTOR-213
 340     'VS214' => pack("U", 0xE01C5), # VARIATION SELECTOR-214
 341     'VS215' => pack("U", 0xE01C6), # VARIATION SELECTOR-215
 342     'VS216' => pack("U", 0xE01C7), # VARIATION SELECTOR-216
 343     'VS217' => pack("U", 0xE01C8), # VARIATION SELECTOR-217
 344     'VS218' => pack("U", 0xE01C9), # VARIATION SELECTOR-218
 345     'VS219' => pack("U", 0xE01CA), # VARIATION SELECTOR-219
 346     'VS220' => pack("U", 0xE01CB), # VARIATION SELECTOR-220
 347     'VS221' => pack("U", 0xE01CC), # VARIATION SELECTOR-221
 348     'VS222' => pack("U", 0xE01CD), # VARIATION SELECTOR-222
 349     'VS223' => pack("U", 0xE01CE), # VARIATION SELECTOR-223
 350     'VS224' => pack("U", 0xE01CF), # VARIATION SELECTOR-224
 351     'VS225' => pack("U", 0xE01D0), # VARIATION SELECTOR-225
 352     'VS226' => pack("U", 0xE01D1), # VARIATION SELECTOR-226
 353     'VS227' => pack("U", 0xE01D2), # VARIATION SELECTOR-227
 354     'VS228' => pack("U", 0xE01D3), # VARIATION SELECTOR-228
 355     'VS229' => pack("U", 0xE01D4), # VARIATION SELECTOR-229
 356     'VS230' => pack("U", 0xE01D5), # VARIATION SELECTOR-230
 357     'VS231' => pack("U", 0xE01D6), # VARIATION SELECTOR-231
 358     'VS232' => pack("U", 0xE01D7), # VARIATION SELECTOR-232
 359     'VS233' => pack("U", 0xE01D8), # VARIATION SELECTOR-233
 360     'VS234' => pack("U", 0xE01D9), # VARIATION SELECTOR-234
 361     'VS235' => pack("U", 0xE01DA), # VARIATION SELECTOR-235
 362     'VS236' => pack("U", 0xE01DB), # VARIATION SELECTOR-236
 363     'VS237' => pack("U", 0xE01DC), # VARIATION SELECTOR-237
 364     'VS238' => pack("U", 0xE01DD), # VARIATION SELECTOR-238
 365     'VS239' => pack("U", 0xE01DE), # VARIATION SELECTOR-239
 366     'VS240' => pack("U", 0xE01DF), # VARIATION SELECTOR-240
 367     'VS241' => pack("U", 0xE01E0), # VARIATION SELECTOR-241
 368     'VS242' => pack("U", 0xE01E1), # VARIATION SELECTOR-242
 369     'VS243' => pack("U", 0xE01E2), # VARIATION SELECTOR-243
 370     'VS244' => pack("U", 0xE01E3), # VARIATION SELECTOR-244
 371     'VS245' => pack("U", 0xE01E4), # VARIATION SELECTOR-245
 372     'VS246' => pack("U", 0xE01E5), # VARIATION SELECTOR-246
 373     'VS247' => pack("U", 0xE01E6), # VARIATION SELECTOR-247
 374     'VS248' => pack("U", 0xE01E7), # VARIATION SELECTOR-248
 375     'VS249' => pack("U", 0xE01E8), # VARIATION SELECTOR-249
 376     'VS250' => pack("U", 0xE01E9), # VARIATION SELECTOR-250
 377     'VS251' => pack("U", 0xE01EA), # VARIATION SELECTOR-251
 378     'VS252' => pack("U", 0xE01EB), # VARIATION SELECTOR-252
 379     'VS253' => pack("U", 0xE01EC), # VARIATION SELECTOR-253
 380     'VS254' => pack("U", 0xE01ED), # VARIATION SELECTOR-254
 381     'VS255' => pack("U", 0xE01EE), # VARIATION SELECTOR-255
 382     'VS256' => pack("U", 0xE01EF), # VARIATION SELECTOR-256
 383     'WJ'    => pack("U", 0x2060), # WORD JOINER
 384     'ZWJ'   => pack("U", 0x200D), # ZERO WIDTH JOINER
 385     'ZWNJ'  => pack("U", 0x200C), # ZERO WIDTH NON-JOINER
 386     'ZWSP'  => pack("U", 0x200B), # ZERO WIDTH SPACE
 387 );
 388
 389 my %deprecated_aliases = (
 390     # Pre-3.2 compatibility (only for the first 256 characters).
 391     # Use of these gives deprecated message.
 392     'HORIZONTAL TABULATION' => pack("U", 0x09), # CHARACTER TABULATION
 393     'VERTICAL TABULATION'   => pack("U", 0x0B), # LINE TABULATION
 394     'FILE SEPARATOR'        => pack("U", 0x1C), # INFORMATION SEPARATOR FOUR
 395     'GROUP SEPARATOR'       => pack("U", 0x1D), # INFORMATION SEPARATOR THREE
 396     'RECORD SEPARATOR'      => pack("U", 0x1E), # INFORMATION SEPARATOR TWO
 397     'UNIT SEPARATOR'        => pack("U", 0x1F), # INFORMATION SEPARATOR ONE
 398     'HORIZONTAL TABULATION SET' => pack("U", 0x88), # CHARACTER TABULATION SET
 399     'HORIZONTAL TABULATION WITH JUSTIFICATION' => pack("U", 0x89), # CHARACTER TABULATION WITH JUSTIFICATION
 400     'PARTIAL LINE DOWN'       => pack("U", 0x8B), # PARTIAL LINE FORWARD
 401     'PARTIAL LINE UP'         => pack("U", 0x8C), # PARTIAL LINE BACKWARD
 402     'VERTICAL TABULATION SET' => pack("U", 0x8A), # LINE TABULATION SET
 403     'REVERSE INDEX'           => pack("U", 0x8D), # REVERSE LINE FEED
 404
 405     # Unicode 6.0 co-opted this for U+1F514, so deprecate it for now.
 406     'BELL'                    => pack("U", 0x07),
 407 );
 408
 409
 410 my $txt;  # The table of official character names
 411
 412 my %full_names_cache; # Holds already-looked-up names, so don't have to
 413 # re-look them up again.  The previous versions of charnames had scoping
 414 # bugs.  For example if we use script A in one scope and find and cache
 415 # what Z resolves to, we can't use that cache in a different scope that
 416 # uses script B instead of A, as Z might be an entirely different letter
 417 # there; or there might be different aliases in effect in different
 418 # scopes, or :short may be in effect or not effect in different scopes,
 419 # or various combinations thereof.  This was solved in this version
 420 # mostly by moving things to %^H.  But some things couldn't be moved
 421 # there.  One of them was the cache of runtime looked-up names, in part
 422 # because %^H is read-only at runtime.  I (khw) don't know why the cache
 423 # was run-time only in the previous versions: perhaps oversight; perhaps
 424 # that compile time looking doesn't happen in a loop so didn't think it
 425 # was worthwhile; perhaps not wanting to make the cache too large.  But
 426 # I decided to make it compile time as well; this could easily be
 427 # changed.
 428 # Anyway, this hash is not scoped, and is added to at runtime.  It
 429 # doesn't have scoping problems because the data in it is restricted to
 430 # official names, which are always invariant, and we only set it and
 431 # look at it at during :full lookups, so is unaffected by any other
 432 # scoped options.  I put this in to maintain parity with the older
 433 # version.  If desired, a %short_names cache could also be made, as well
 434 # as one for each script, say in %script_names_cache, with each key
 435 # being a hash for a script named in a 'use charnames' statement.  I
 436 # decided not to do that for now, just because it's added complication,
 437 # and because I'm just trying to maintain parity, not extend it.
 438
 439 # Designed so that test decimal first, and then hex.  Leading zeros
 440 # imply non-decimal, as do non-[0-9]
 441 my $decimal_qr = qr/^[1-9]\d*$/;
 442
 443 # Returns the hex number in $1.
 444 my $hex_qr = qr/^(?:[Uu]\+|0[xX])?([[:xdigit:]]+)$/;
 445
 446 sub croak
 447 {
 448   require Carp; goto &Carp::croak;
 449 } # croak
 450
 451 sub carp
 452 {
 453   require Carp; goto &Carp::carp;
 454 } # carp
 455
 456 sub alias (@) # Set up a single alias
 457 {
 458   my $alias = ref $_[0] ? $_[0] : { @_ };
 459   foreach my $name (keys %$alias) {
 460     my $value = $alias->{$name};
 461     next unless defined $value;          # Omit if screwed up.
 462
 463     # Is slightly slower to just after this statement see if it is
 464     # decimal, since we already know it is after having converted from
 465     # hex, but makes the code easier to maintain, and is called
 466     # infrequently, only at compile-time
 467     if ($value !~ $decimal_qr && $value =~ $hex_qr) {
 468       $value = CORE::hex $1;
 469     }
 470     if ($value =~ $decimal_qr) {
 471         no warnings 'utf8'; # Allow even illegal characters
 472         $^H{charnames_ord_aliases}{$name} = pack("U", $value);
 473
 474         # Use a canonical form.
 475         $^H{charnames_inverse_ords}{sprintf("%05X", $value)} = $name;
 476     }
 477     else {
 478         # XXX validate syntax when deprecation cycle complete. ie. start
 479         # with an alpha only, etc.
 480         $^H{charnames_name_aliases}{$name} = $value;
 481     }
 482   }
 483 } # alias
 484
 485 sub not_legal_use_bytes_msg {
 486   my ($name, $utf8) = @_;
 487   my $return;
 488
 489   if (length($utf8) == 1) {
 490     $return = sprintf("Character 0x%04x with name '%s' is", ord $utf8, $name);
 491   } else {
 492     $return = sprintf("String with name '%s' (and ordinals %s) contains character(s)", $name, join(" ", map { sprintf "0x%04X", ord $_ } split(//, $utf8)));
 493   }
 494   return $return . " above 0xFF with 'use bytes' in effect";
 495 }
 496
 497 sub alias_file ($)  # Reads a file containing alias definitions
 498 {
 499   my ($arg, $file) = @_;
 500   if (-f $arg && File::Spec->file_name_is_absolute ($arg)) {
 501     $file = $arg;
 502   }
 503   elsif ($arg =~ m/^\w+$/) {
 504     $file = "unicore/${arg}_alias.pl";
 505   }
 506   else {
 507     croak "Charnames alias files can only have identifier characters";
 508   }
 509   if (my @alias = do $file) {
 510     @alias == 1 && !defined $alias[0] and
 511       croak "$file cannot be used as alias file for charnames";
 512     @alias % 2 and
 513       croak "$file did not return a (valid) list of alias pairs";
 514     alias (@alias);
 515     return (1);
 516   }
 517   0;
 518 } # alias_file
 519
 520 # For use when don't import anything.  This structure must be kept in
 521 # sync with the one that import() fills up.
 522 my %dummy_H = (
 523                 charnames_stringified_names => "",
 524                 charnames_stringified_ords => "",
 525                 charnames_scripts => "",
 526                 charnames_full => 1,
 527                 charnames_short => 0,
 528               );
 529
 530
 531 sub lookup_name ($$$) {
 532   my ($name, $wants_ord, $runtime) = @_;
 533
 534   # Lookup the name or sequence $name in the tables.  If $wants_ord is false,
 535   # returns the string equivalent of $name; if true, returns the ordinal value
 536   # instead, but in this case $name must not be a sequence; otherwise undef is
 537   # returned and a warning raised.  $runtime is 0 if compiletime, otherwise
 538   # gives the number of stack frames to go back to get the application caller
 539   # info.
 540   # If $name is not found, returns undef in runtime with no warning; and in
 541   # compiletime, the Unicode replacement character, with a warning.
 542
 543   # It looks first in the aliases, then in the large table of official Unicode
 544   # names.
 545
 546   my $utf8;       # The string result
 547   my $save_input;
 548
 549   if ($runtime) {
 550
 551     my $hints_ref = (caller($runtime))[10];
 552
 553     # If we didn't import anything (which happens with 'use charnames ()',
 554     # substitute a dummy structure.
 555     $hints_ref = \%dummy_H if ! defined $hints_ref
 556                               || ! defined $hints_ref->{charnames_full};
 557
 558     # At runtime, but currently not at compile time, $^H gets
 559     # stringified, so un-stringify back to the original data structures.
 560     # These get thrown away by perl before the next invocation
 561     # Also fill in the hash with the non-stringified data.
 562     # N.B.  New fields must be also added to %dummy_H
 563
 564     %{$^H{charnames_name_aliases}} = split ',',
 565                                       $hints_ref->{charnames_stringified_names};
 566     %{$^H{charnames_ord_aliases}} = split ',',
 567                                       $hints_ref->{charnames_stringified_ords};
 568     $^H{charnames_scripts} = $hints_ref->{charnames_scripts};
 569     $^H{charnames_full} = $hints_ref->{charnames_full};
 570     $^H{charnames_short} = $hints_ref->{charnames_short};
 571   }
 572
 573   # User alias should be checked first or else can't override ours, and if we
 574   # were to add any, could conflict with theirs.
 575   if (exists $^H{charnames_ord_aliases}{$name}) {
 576     $utf8 = $^H{charnames_ord_aliases}{$name};
 577   }
 578   elsif (exists $^H{charnames_name_aliases}{$name}) {
 579     $name = $^H{charnames_name_aliases}{$name};
 580     $save_input = $name;  # Cache the result for any error message
 581   }
 582   elsif (exists $system_aliases{$name}) {
 583     $utf8 = $system_aliases{$name};
 584   }
 585   elsif (exists $deprecated_aliases{$name}) {
 586     require warnings;
 587     warnings::warnif('deprecated', "Unicode character name \"$name\" is deprecated, use \"" . viacode(ord $deprecated_aliases{$name}) . "\" instead");
 588     $utf8 = $deprecated_aliases{$name};
 589   }
 590
 591   my @off;
 592
 593   if (! defined $utf8) {
 594
 595     # See if has looked this input up earlier.
 596     if ($^H{charnames_full} && exists $full_names_cache{$name}) {
 597       $utf8 = $full_names_cache{$name};
 598     }
 599     else {
 600
 601       ## Suck in the code/name list as a big string.
 602       ## Lines look like:
 603       ##     "00052\tLATIN CAPITAL LETTER R\n"
 604       # or
 605       #      "0052 0303\tLATIN CAPITAL LETTER R WITH TILDE\n"
 606       $txt = do "unicore/Name.pl" unless $txt;
 607
 608       ## @off will hold the index into the code/name string of the start and
 609       ## end of the name as we find it.
 610
 611       ## If :full, look for the name exactly; runtime implies full
 612       my $found_full_in_table = 0;  # Tells us if can cache the result
 613       if ($^H{charnames_full}) {
 614
 615         # See if the name is one which is algorithmically determinable.
 616         # The subroutine is included in Name.pl.  The table contained in
 617         # $txt doesn't contain these.  Experiments show that checking
 618         # for these before checking for the regular names has no
 619         # noticeable impact on performance for the regular names, but
 620         # the other way around slows down finding these immensely.
 621         # Algorithmically determinables are not placed in the cache (that
 622         # $found_full_in_table indicates) because that uses up memory,
 623         # and finding these again is fast.
 624         if (defined (my $ord = name_to_code_point_special($name))) {
 625           $utf8 = pack("U", $ord);
 626         }
 627         else {
 628
 629           # Not algorthmically determinable; look up in the table.
 630           if ($txt =~ /\t\Q$name\E$/m) {
 631             @off = ($-[0] + 1, $+[0]);    # The 1 is for the tab
 632             $found_full_in_table = 1;
 633           }
 634         }
 635       }
 636
 637       # If we didn't get it above, keep looking
 638       if (! $found_full_in_table && ! defined $utf8) {
 639
 640         # If :short is allowed, see if input is like "greek:Sigma".
 641         my $scripts_trie;
 642         if (($^H{charnames_short})
 643             && $name =~ /^ \s* (.+?) \s* : \s* (.+?) \s* $ /xs)
 644         {
 645             $scripts_trie = "\U\Q$1";
 646             $name = $2;
 647         }
 648         else { # Otherwise look in allowed scripts
 649             $scripts_trie = $^H{charnames_scripts};
 650         }
 651
 652         my $case = $name =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL";
 653         if ($txt !~
 654             /\t (?: $scripts_trie ) \ (?:$case\ )? LETTER \ \U\Q$name\E $/xm)
 655         {
 656           # Here we still don't have it, give up.
 657           return if $runtime;
 658
 659           # May have zapped input name, get it again.
 660           $name = (defined $save_input) ? $save_input : $_[0];
 661           carp "Unknown charname '$name'";
 662           return ($wants_ord) ? 0xFFFD : pack("U", 0xFFFD);
 663         }
 664
 665         @off = ($-[0] + 1, $+[0]);  # The 1 is for the tab
 666       }
 667
 668       if (! defined $utf8) {
 669
 670         # Here, we haven't set up the output, but we know where in the string
 671         # the name starts.  The string is set up so that for single characters
 672         # (and not named sequences), the name is preceeded immediately by a
 673         # tab and 5 hex digits for its code, with a \n before those.  Named
 674         # sequences won't have the 7th preceeding character be a \n.
 675         # (Actually, for the very first entry in the table this isn't strictly
 676         # true: subtracting 7 will yield -1, and the substr below will
 677         # therefore yield the very last character in the table, which should
 678         # also be a \n, so the statement works anyway.)
 679         if (substr($txt, $off[0] - 7, 1) eq "\n") {
 680           $utf8 = pack("U", CORE::hex substr($txt, $off[0] - 6, 5));
 681         }
 682         else {
 683
 684           # Here, is a named sequence.  Need to go looking for the beginning,
 685           # which is just after the \n from the previous entry in the table.
 686           # The +1 skips past that newline, or, if the rindex() fails, to put
 687           # us to an offset of zero.
 688           my $charstart = rindex($txt, "\n", $off[0] - 7) + 1;
 689           $utf8 = pack("U*", map { CORE::hex }
 690               split " ", substr($txt, $charstart, $off[0] - $charstart - 1));
 691         }
 692       }
 693
 694       # Cache the input so as to not have to search the large table
 695       # again, but only if it came from the one search that we cache.
 696       $full_names_cache{$name} = $utf8 if $found_full_in_table;
 697     }
 698   }
 699
 700
 701   # Here, have the utf8.  If the return is to be an ord, must be any single
 702   # character.
 703   if ($wants_ord) {
 704     return ord($utf8) if length $utf8 == 1;
 705   }
 706   else {
 707
 708     # Here, wants string output.  If utf8 is acceptable, just return what
 709     # we've got; otherwise attempt to convert it to non-utf8 and return that.
 710     my $in_bytes = ($runtime)
 711                    ? (caller $runtime)[8] & $bytes::hint_bits
 712                    : $^H & $bytes::hint_bits;
 713     return $utf8 if (! $in_bytes || utf8::downgrade($utf8, 1)) # The 1 arg
 714                                                   # means don't die on failure
 715   }
 716
 717   # Here, there is an error:  either there are too many characters, or the
 718   # result string needs to be non-utf8, and at least one character requires
 719   # utf8.  Prefer any official name over the input one for the error message.
 720   if (@off) {
 721     $name = substr($txt, $off[0], $off[1] - $off[0]) if @off;
 722   }
 723   else {
 724     $name = (defined $save_input) ? $save_input : $_[0];
 725   }
 726
 727   if ($wants_ord) {
 728     # Only way to get here in this case is if result too long.  Message
 729     # assumes that our only caller that requires single char result is
 730     # vianame.
 731     carp "charnames::vianame() doesn't handle named sequences ($name).  Use charnames::string_vianame() instead";
 732     return;
 733   }
 734
 735   # Only other possible failure here is from use bytes.
 736   if ($runtime) {
 737     carp not_legal_use_bytes_msg($name, $utf8);
 738     return;
 739   } else {
 740     croak not_legal_use_bytes_msg($name, $utf8);
 741   }
 742
 743 } # lookup_name
 744
 745 sub charnames {
 746
 747   # For \N{...}.  Looks up the character name and returns the string
 748   # representation of it.
 749
 750   # The first 0 arg means wants a string returned; the second that we are in
 751   # compile time
 752   return lookup_name($_[0], 0, 0);
 753 }
 754
 755 sub import
 756 {
 757   shift; ## ignore class name
 758
 759   if (not @_) {
 760     carp("`use charnames' needs explicit imports list");
 761   }
 762   $^H{charnames} = \&charnames ;
 763   $^H{charnames_ord_aliases} = {};
 764   $^H{charnames_name_aliases} = {};
 765   $^H{charnames_inverse_ords} = {};
 766   # New fields must be added to %dummy_H, and the code in lookup_name()
 767   # that copies fields from the runtime structure
 768
 769   ##
 770   ## fill %h keys with our @_ args.
 771   ##
 772   my ($promote, %h, @args) = (0);
 773   while (my $arg = shift) {
 774     if ($arg eq ":alias") {
 775       @_ or
 776         croak ":alias needs an argument in charnames";
 777       my $alias = shift;
 778       if (ref $alias) {
 779         ref $alias eq "HASH" or
 780           croak "Only HASH reference supported as argument to :alias";
 781         alias ($alias);
 782         next;
 783       }
 784       if ($alias =~ m{:(\w+)$}) {
 785         $1 eq "full" || $1 eq "short" and
 786           croak ":alias cannot use existing pragma :$1 (reversed order?)";
 787         alias_file ($1) and $promote = 1;
 788         next;
 789       }
 790       alias_file ($alias);
 791       next;
 792     }
 793     if (substr($arg, 0, 1) eq ':' and ! ($arg eq ":full" || $arg eq ":short")) {
 794       warn "unsupported special '$arg' in charnames";
 795       next;
 796     }
 797     push @args, $arg;
 798   }
 799   @args == 0 && $promote and @args = (":full");
 800   @h{@args} = (1) x @args;
 801
 802   $^H{charnames_full} = delete $h{':full'} || 0;  # Don't leave undefined,
 803                                                   # as tested for in
 804                                                   # lookup_names
 805   $^H{charnames_short} = delete $h{':short'} || 0;
 806   my @scripts = map uc, keys %h;
 807
 808   ##
 809   ## If utf8? warnings are enabled, and some scripts were given,
 810   ## see if at least we can find one letter from each script.
 811   ##
 812   if (warnings::enabled('utf8') && @scripts) {
 813     $txt = do "unicore/Name.pl" unless $txt;
 814
 815     for my $script (@scripts) {
 816       if (not $txt =~ m/\t$script (?:CAPITAL |SMALL )?LETTER /) {
 817         warnings::warn('utf8',  "No such script: '$script'");
 818         $script = quotemeta $script;  # Escape it, for use in the re.
 819       }
 820     }
 821   }
 822
 823   # %^H gets stringified, so serialize it ourselves so can extract the
 824   # real data back later.
 825   $^H{charnames_stringified_ords} = join ",", %{$^H{charnames_ord_aliases}};
 826   $^H{charnames_stringified_names} = join ",", %{$^H{charnames_name_aliases}};
 827   $^H{charnames_stringified_inverse_ords} = join ",", %{$^H{charnames_inverse_ords}};
 828   $^H{charnames_scripts} = join "|", @scripts;  # Stringifiy them as a trie
 829 } # import
 830
 831 # Cache of already looked-up values.  This is set to only contain
 832 # official values, and user aliases can't override them, so scoping is
 833 # not an issue.
 834 my %viacode;
 835
 836 sub viacode {
 837
 838   # Returns the name of the code point argument
 839
 840   if (@_ != 1) {
 841     carp "charnames::viacode() expects one argument";
 842     return;
 843   }
 844
 845   my $arg = shift;
 846
 847   # This is derived from Unicode::UCD, where it is nearly the same as the
 848   # function _getcode(), but here it makes sure that even a hex argument
 849   # has the proper number of leading zeros, which is critical in
 850   # matching against $txt below
 851   # Must check if decimal first; see comments at that definition
 852   my $hex;
 853   if ($arg =~ $decimal_qr) {
 854     $hex = sprintf "%05X", $arg;
 855   } elsif ($arg =~ $hex_qr) {
 856     # Below is the line that differs from the _getcode() source
 857     $hex = sprintf "%05X", hex $1;
 858   } else {
 859     carp("unexpected arg \"$arg\" to charnames::viacode()");
 860     return;
 861   }
 862
 863   return $viacode{$hex} if exists $viacode{$hex};
 864
 865   # If the code point is above the max in the table, there's no point
 866   # looking through it.  Checking the length first is slightly faster
 867   if (length($hex) <= 5 || CORE::hex($hex) <= 0x10FFFF) {
 868     $txt = do "unicore/Name.pl" unless $txt;
 869
 870     # See if the name is algorithmically determinable.
 871     my $algorithmic = code_point_to_name_special(CORE::hex $hex);
 872     if (defined $algorithmic) {
 873       $viacode{$hex} = $algorithmic;
 874       return $algorithmic;
 875     }
 876
 877     # Return the official name, if exists.  It's unclear to me (khw) at
 878     # this juncture if it is better to return a user-defined override, so
 879     # leaving it as is for now.
 880     if ($txt =~ m/^$hex\t/m) {
 881
 882         # The name starts with the next character and goes up to the
 883         # next new-line.  Using capturing parentheses above instead of
 884         # @+ more than doubles the execution time in Perl 5.13
 885         $viacode{$hex} = substr($txt, $+[0], index($txt, "\n", $+[0]) - $+[0]);
 886         return $viacode{$hex};
 887     }
 888   }
 889
 890   # See if there is a user name for it, before giving up completely.
 891   # First get the scoped aliases, give up if have none.
 892   my $H_ref = (caller(0))[10];
 893   return if ! defined $H_ref
 894             || ! exists $H_ref->{charnames_stringified_inverse_ords};
 895
 896   my %code_point_aliases = split ',',
 897                           $H_ref->{charnames_stringified_inverse_ords};
 898   if (! exists $code_point_aliases{$hex}) {
 899     if (CORE::hex($hex) > 0x10FFFF) {
 900         carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)";
 901     }
 902     return;
 903   }
 904
 905   return $code_point_aliases{$hex};
 906 } # viacode
 907
 908 sub vianame
 909 {
 910   if (@_ != 1) {
 911     carp "charnames::vianame() expects one name argument";
 912     return ()
 913   }
 914
 915   # Looks up the character name and returns its ordinal if
 916   # found, undef otherwise.
 917
 918   my $arg = shift;
 919
 920   if ($arg =~ /^U\+([0-9a-fA-F]+)$/) {
 921
 922     # khw claims that this is poor interface design.  The function should
 923     # return either a an ord or a chr for all inputs; not be bipolar.  But
 924     # can't change it because of backward compatibility.  New code can use
 925     # string_vianame() instead.
 926     my $ord = CORE::hex $1;
 927     return chr $ord if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits);
 928     carp not_legal_use_bytes_msg($arg, chr $ord);
 929     return;
 930   }
 931
 932   # The first 1 arg means wants an ord returned; the second that we are in
 933   # runtime, and this is the first level routine called from the user
 934   return lookup_name($arg, 1, 1);
 935 } # vianame
 936
 937 sub string_vianame {
 938
 939   # Looks up the character name and returns its string representation if
 940   # found, undef otherwise.
 941
 942   if (@_ != 1) {
 943     carp "charnames::string_vianame() expects one name argument";
 944     return;
 945   }
 946
 947   my $arg = shift;
 948
 949   if ($arg =~ /^U\+([0-9a-fA-F]+)$/) {
 950
 951     my $ord = CORE::hex $1;
 952     return chr $ord if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits);
 953
 954     carp not_legal_use_bytes_msg($arg, chr $ord);
 955     return;
 956   }
 957
 958   # The 0 arg means wants a string returned; the 1 arg means that we are in
 959   # runtime, and this is the first level routine called from the user
 960   return lookup_name($arg, 0, 1);
 961 } # string_vianame
 962
 963
 964
 965 1;
 966 __END__
 967
 968 =head1 NAME
 969
 970 charnames - access to Unicode character names and named character sequences; also define character names
 971
 972 =head1 SYNOPSIS
 973
 974  use charnames ':full';
 975  print "\N{GREEK SMALL LETTER SIGMA} is called sigma.\n";
 976  print "\N{LATIN CAPITAL LETTER E WITH VERTICAL LINE BELOW}",
 977        " is an officially named sequence of two Unicode characters\n";
 978
 979  use charnames ':short';
 980  print "\N{greek:Sigma} is an upper-case sigma.\n";
 981
 982  use charnames qw(cyrillic greek);
 983  print "\N{sigma} is Greek sigma, and \N{be} is Cyrillic b.\n";
 984
 985  use charnames ":full", ":alias" => {
 986    e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
 987    mychar => 0xE8000,  # Private use area
 988  };
 989  print "\N{e_ACUTE} is a small letter e with an acute.\n";
 990  print "\\N{mychar} allows me to name private use characters.\n";
 991
 992  use charnames ();
 993  print charnames::viacode(0x1234); # prints "ETHIOPIC SYLLABLE SEE"
 994  printf "%04X", charnames::vianame("GOTHIC LETTER AHSA"); # prints
 995                                                           # "10330"
 996  print charnames::vianame("LATIN CAPITAL LETTER A"); # prints 65 on
 997                                                      # ASCII platforms;
 998                                                      # 193 on EBCDIC
 999  print charnames::string_vianame("LATIN CAPITAL LETTER A"); # prints "A"
1000
1001 =head1 DESCRIPTION
1002
1003 Pragma C<use charnames> is used to gain access to the names of the
1004 Unicode characters and named character sequences, and to allow you to define
1005 your own character and character sequence names.
1006
1007 All forms of the pragma enable use of the following 3 functions:
1008
1009 =over
1010
1011 =item *
1012
1013 L</charnames::string_vianame(I<name>)> for run-time lookup of a
1014 either a character name or a named character sequence, returning its string
1015 representation
1016
1017 =item *
1018
1019 L</charnames::vianame(I<name>)> for run-time lookup of a
1020 character name (but not a named character sequence) to get its ordinal value
1021 (code point)
1022
1023 =item *
1024
1025 L</charnames::viacode(I<code>)> for run-time lookup of a code point to get its
1026 Unicode name.
1027
1028 =back
1029
1030 All forms other than C<S<"use charnames ();">> also enable the use of
1031 C<\N{I<CHARNAME>}> sequences to compile a Unicode character into a
1032 string, based on its name.
1033
1034 Note that C<\N{U+I<...>}>, where the I<...> is a hexadecimal number,
1035 also inserts a character into a string, but doesn't require the use of
1036 this pragma.  The character it inserts is the one whose code point
1037 (ordinal value) is equal to the number.  For example, C<"\N{U+263a}"> is
1038 the Unicode (white background, black foreground) smiley face; it doesn't
1039 require this pragma, whereas the equivalent, C<"\N{WHITE SMILING FACE}">
1040 does.
1041 Also, C<\N{I<...>}> can mean a regex quantifier instead of a character
1042 name, when the I<...> is a number (or comma separated pair of numbers
1043 (see L<perlreref/QUANTIFIERS>), and is not related to this pragma.
1044
1045 The C<charnames> pragma supports arguments C<:full>, C<:short>, script
1046 names and customized aliases.  If C<:full> is present, for expansion of
1047 C<\N{I<CHARNAME>}>, the string I<CHARNAME> is first looked up in the list of
1048 standard Unicode character names.  If C<:short> is present, and
1049 I<CHARNAME> has the form C<I<SCRIPT>:I<CNAME>>, then I<CNAME> is looked up
1050 as a letter in script I<SCRIPT>.  If C<use charnames> is used
1051 with script name arguments, then for C<\N{I<CHARNAME>}> the name
1052 I<CHARNAME> is looked up as a letter in the given scripts (in the
1053 specified order). Customized aliases can override these, and are explained in
1054 L</CUSTOM ALIASES>.
1055
1056 For lookup of I<CHARNAME> inside a given script I<SCRIPTNAME>
1057 this pragma looks for the names
1058
1059   SCRIPTNAME CAPITAL LETTER CHARNAME
1060   SCRIPTNAME SMALL LETTER CHARNAME
1061   SCRIPTNAME LETTER CHARNAME
1062
1063 in the table of standard Unicode names.  If I<CHARNAME> is lowercase,
1064 then the C<CAPITAL> variant is ignored, otherwise the C<SMALL> variant
1065 is ignored.
1066
1067 Note that C<\N{...}> is compile-time; it's a special form of string
1068 constant used inside double-quotish strings; this means that you cannot
1069 use variables inside the C<\N{...}>.  If you want similar run-time
1070 functionality, use
1071 L<charnames::string_vianame()|/charnames::string_vianame(I<name>)>.
1072
1073 For the C0 and C1 control characters (U+0000..U+001F, U+0080..U+009F)
1074 there are no official Unicode names but you can use instead the ISO 6429
1075 names (LINE FEED, ESCAPE, and so forth, and their abbreviations, LF,
1076 ESC, ...).  In Unicode 3.2 (as of Perl 5.8) some naming changes took
1077 place, and ISO 6429 was updated, see L</ALIASES>.
1078
1079 If the input name is unknown, C<\N{NAME}> raises a warning and
1080 substitutes the Unicode REPLACEMENT CHARACTER (U+FFFD).
1081
1082 For C<\N{NAME}>, it is a fatal error if C<use bytes> is in effect and the
1083 input name is that of a character that won't fit into a byte (i.e., whose
1084 ordinal is above 255).
1085
1086 Otherwise, any string that includes a C<\N{I<charname>}> or
1087 C<S<\N{U+I<code point>}>> will automatically have Unicode semantics (see
1088 L<perlunicode/Byte and Character Semantics>).
1089
1090 =head1 ALIASES
1091
1092 A few aliases have been defined for convenience: instead of having
1093 to use the official names
1094
1095     LINE FEED (LF)
1096     FORM FEED (FF)
1097     CARRIAGE RETURN (CR)
1098     NEXT LINE (NEL)
1099
1100 (yes, with parentheses), one can use
1101
1102     LINE FEED
1103     FORM FEED
1104     CARRIAGE RETURN
1105     NEXT LINE
1106     LF
1107     FF
1108     CR
1109     NEL
1110
1111 All the other standard abbreviations for the controls, such as C<ACK> for
1112 C<ACKNOWLEDGE> also can be used.
1113
1114 One can also use
1115
1116     BYTE ORDER MARK
1117     BOM
1118
1119 and these abbreviations
1120
1121     Abbreviation        Full Name
1122
1123     CGJ                 COMBINING GRAPHEME JOINER
1124     FVS1                MONGOLIAN FREE VARIATION SELECTOR ONE
1125     FVS2                MONGOLIAN FREE VARIATION SELECTOR TWO
1126     FVS3                MONGOLIAN FREE VARIATION SELECTOR THREE
1127     LRE                 LEFT-TO-RIGHT EMBEDDING
1128     LRM                 LEFT-TO-RIGHT MARK
1129     LRO                 LEFT-TO-RIGHT OVERRIDE
1130     MMSP                MEDIUM MATHEMATICAL SPACE
1131     MVS                 MONGOLIAN VOWEL SEPARATOR
1132     NBSP                NO-BREAK SPACE
1133     NNBSP               NARROW NO-BREAK SPACE
1134     PDF                 POP DIRECTIONAL FORMATTING
1135     RLE                 RIGHT-TO-LEFT EMBEDDING
1136     RLM                 RIGHT-TO-LEFT MARK
1137     RLO                 RIGHT-TO-LEFT OVERRIDE
1138     SHY                 SOFT HYPHEN
1139     VS1                 VARIATION SELECTOR-1
1140     .
1141     .
1142     .
1143     VS256               VARIATION SELECTOR-256
1144     WJ                  WORD JOINER
1145     ZWJ                 ZERO WIDTH JOINER
1146     ZWNJ                ZERO WIDTH NON-JOINER
1147     ZWSP                ZERO WIDTH SPACE
1148
1149 For backward compatibility one can use the old names for
1150 certain C0 and C1 controls
1151
1152     old                         new
1153
1154     FILE SEPARATOR              INFORMATION SEPARATOR FOUR
1155     GROUP SEPARATOR             INFORMATION SEPARATOR THREE
1156     HORIZONTAL TABULATION       CHARACTER TABULATION
1157     HORIZONTAL TABULATION SET   CHARACTER TABULATION SET
1158     HORIZONTAL TABULATION WITH JUSTIFICATION    CHARACTER TABULATION
1159                                                 WITH JUSTIFICATION
1160     PARTIAL LINE DOWN           PARTIAL LINE FORWARD
1161     PARTIAL LINE UP             PARTIAL LINE BACKWARD
1162     RECORD SEPARATOR            INFORMATION SEPARATOR TWO
1163     REVERSE INDEX               REVERSE LINE FEED
1164     UNIT SEPARATOR              INFORMATION SEPARATOR ONE
1165     VERTICAL TABULATION         LINE TABULATION
1166     VERTICAL TABULATION SET     LINE TABULATION SET
1167
1168 but the old names in addition to giving the character
1169 will also give a warning about being deprecated.
1170
1171 And finally, certain published variants are usable, including some for
1172 controls that have no Unicode names:
1173
1174     name                                   character
1175
1176     END OF PROTECTED AREA                  END OF GUARDED AREA, U+0097
1177     HIGH OCTET PRESET                      U+0081
1178     HOP                                    U+0081
1179     IND                                    U+0084
1180     INDEX                                  U+0084
1181     PAD                                    U+0080
1182     PADDING CHARACTER                      U+0080
1183     PRIVATE USE 1                          PRIVATE USE ONE, U+0091
1184     PRIVATE USE 2                          PRIVATE USE TWO, U+0092
1185     SGC                                    U+0099
1186     SINGLE GRAPHIC CHARACTER INTRODUCER    U+0099
1187     SINGLE-SHIFT 2                         SINGLE SHIFT TWO, U+008E
1188     SINGLE-SHIFT 3                         SINGLE SHIFT THREE, U+008F
1189     START OF PROTECTED AREA                START OF GUARDED AREA, U+0096
1190
1191 =head1 CUSTOM ALIASES
1192
1193 You can add customized aliases to standard (C<:full>) Unicode naming
1194 conventions.  The aliases override any standard definitions, so, if
1195 you're twisted enough, you can change C<"\N{LATIN CAPITAL LETTER A}"> to
1196 mean C<"B">, etc.
1197
1198 Note that an alias should not be something that is a legal curly
1199 brace-enclosed quantifier (see L<perlreref/QUANTIFIERS>).  For example
1200 C<\N{123}> means to match 123 non-newline characters, and is not treated as a
1201 charnames alias.  Aliases are discouraged from beginning with anything
1202 other than an alphabetic character and from containing anything other
1203 than alphanumerics, spaces, dashes, parentheses, and underscores.
1204 Currently they must be ASCII.
1205
1206 An alias can map to either an official Unicode character name or to a
1207 numeric code point (ordinal).  The latter is useful for assigning names
1208 to code points in Unicode private use areas such as U+E800 through
1209 U+F8FF.
1210 A numeric code point must be a non-negative integer or a string beginning
1211 with C<"U+"> or C<"0x"> with the remainder considered to be a
1212 hexadecimal integer.  A literal numeric constant must be unsigned; it
1213 will be interpreted as hex if it has a leading zero or contains
1214 non-decimal hex digits; otherwise it will be interpreted as decimal.
1215
1216 Aliases are added either by the use of anonymous hashes:
1217
1218     use charnames ":alias" => {
1219         e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
1220         mychar1 => 0xE8000,
1221         };
1222     my $str = "\N{e_ACUTE}";
1223
1224 or by using a file containing aliases:
1225
1226     use charnames ":alias" => "pro";
1227
1228 This will try to read C<"unicore/pro_alias.pl"> from the C<@INC> path. This
1229 file should return a list in plain perl:
1230
1231     (
1232     A_GRAVE         => "LATIN CAPITAL LETTER A WITH GRAVE",
1233     A_CIRCUM        => "LATIN CAPITAL LETTER A WITH CIRCUMFLEX",
1234     A_DIAERES       => "LATIN CAPITAL LETTER A WITH DIAERESIS",
1235     A_TILDE         => "LATIN CAPITAL LETTER A WITH TILDE",
1236     A_BREVE         => "LATIN CAPITAL LETTER A WITH BREVE",
1237     A_RING          => "LATIN CAPITAL LETTER A WITH RING ABOVE",
1238     A_MACRON        => "LATIN CAPITAL LETTER A WITH MACRON",
1239     mychar2         => "U+E8001",
1240     );
1241
1242 Both these methods insert C<":full"> automatically as the first argument (if no
1243 other argument is given), and you can give the C<":full"> explicitly as
1244 well, like
1245
1246     use charnames ":full", ":alias" => "pro";
1247
1248 Also, both these methods currently allow only a single character to be named.
1249 To name a sequence of characters, use a
1250 L<custom translator|/CUSTOM TRANSLATORS> (described below).
1251
1252 =head1 charnames::viacode(I<code>)
1253
1254 Returns the full name of the character indicated by the numeric code.
1255 For example,
1256
1257     print charnames::viacode(0x2722);
1258
1259 prints "FOUR TEARDROP-SPOKED ASTERISK".
1260
1261 The name returned is the official name for the code point, if
1262 available; otherwise your custom alias for it.  This means that your
1263 alias will only be returned for code points that don't have an official
1264 Unicode name (nor Unicode version 1 name), such as private use code
1265 points, and the 4 control characters U+0080, U+0081, U+0084, and U+0099.
1266 If you define more than one name for the code point, it is indeterminate
1267 which one will be returned.
1268
1269 The function returns C<undef> if no name is known for the code point.
1270 In Unicode the proper name of these is the empty string, which
1271 C<undef> stringifies to.  (If you ask for a code point past the legal
1272 Unicode maximum of U+10FFFF that you haven't assigned an alias to, you
1273 get C<undef> plus a warning.)
1274
1275 The input number must be a non-negative integer or a string beginning
1276 with C<"U+"> or C<"0x"> with the remainder considered to be a
1277 hexadecimal integer.  A literal numeric constant must be unsigned; it
1278 will be interpreted as hex if it has a leading zero or contains
1279 non-decimal hex digits; otherwise it will be interpreted as decimal.
1280
1281 Notice that the name returned for of U+FEFF is "ZERO WIDTH NO-BREAK
1282 SPACE", not "BYTE ORDER MARK".
1283
1284 =head1 charnames::string_vianame(I<name>)
1285
1286 This is a runtime equivalent to C<\N{...}>.  I<name> can be any expression
1287 that evaluates to a name accepted by C<\N{...}> under the L<C<:full>
1288 option|/DESCRIPTION> to C<charnames>.  In addition, any other options for the
1289 controlling C<"use charnames"> in the same scope apply, like any L<script
1290 list, C<:short> option|/DESCRIPTION>, or L<custom aliases|/CUSTOM ALIASES> you
1291 may have defined.
1292
1293 The only difference is that if the input name is unknown, C<string_vianame>
1294 returns C<undef> instead of the REPLACEMENT CHARACTER and does not raise a
1295 warning message.
1296
1297 =head1 charnames::vianame(I<name>)
1298
1299 This is similar to C<string_vianame>.  The main difference is that under most
1300 circumstances (see L</BUGS> for the others), vianame returns an ordinal code
1301 point, whereas C<string_vianame> returns a string.  For example,
1302
1303    printf "U+%04X", charnames::vianame("FOUR TEARDROP-SPOKED ASTERISK");
1304
1305 prints "U+2722".
1306
1307 This leads to the other two differences.  Since a single code point is
1308 returned, the function can't handle named character sequences, as these are
1309 composed of multiple characters.  And, the code point can be that of any
1310 character, even ones that aren't legal under the C<S<use bytes>> pragma,
1311
1312 =head1 CUSTOM TRANSLATORS
1313
1314 The mechanism of translation of C<\N{...}> escapes is general and not
1315 hardwired into F<charnames.pm>.  A module can install custom
1316 translations (inside the scope which C<use>s the module) with the
1317 following magic incantation:
1318
1319     sub import {
1320         shift;
1321         $^H{charnames} = \&translator;
1322     }
1323
1324 Here translator() is a subroutine which takes I<CHARNAME> as an
1325 argument, and returns text to insert into the string instead of the
1326 C<\N{I<CHARNAME>}> escape.  Since the text to insert should be different
1327 in C<bytes> mode and out of it, the function should check the current
1328 state of C<bytes>-flag as in:
1329
1330     use bytes ();                      # for $bytes::hint_bits
1331     sub translator {
1332         if ($^H & $bytes::hint_bits) {
1333             return bytes_translator(@_);
1334         }
1335         else {
1336             return utf8_translator(@_);
1337         }
1338     }
1339
1340 See L</CUSTOM ALIASES> above for restrictions on I<CHARNAME>.
1341
1342 Of course, C<vianame> and C<viacode> would need to be overridden as
1343 well.
1344
1345 =head1 BUGS
1346
1347 vianame normally returns an ordinal code point, but when the input name is of
1348 the form C<U+...>, it returns a chr instead.  In this case, if C<use bytes> is
1349 in effect and the character won't fit into a byte, it returns C<undef> and
1350 raises a warning.
1351
1352 Names must be ASCII characters only, which means that you are out of luck if
1353 you want to create aliases in a language where some or all the characters of
1354 the desired aliases are non-ASCII.
1355
1356 Since evaluation of the translation function (see L</CUSTOM
1357 TRANSLATORS>) happens in the middle of compilation (of a string
1358 literal), the translation function should not do any C<eval>s or
1359 C<require>s.  This restriction should be lifted (but is low priority) in
1360 a future version of Perl.
1361
1362 =cut
1363
1364 # ex: set ts=8 sts=2 sw=2 et: