lib/charnames.pm

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