This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
mktables: Allow for loose \N{} matching
[perl5.git] / lib / charnames.pm
CommitLineData
423cee85 1package charnames;
b177ca84
JF
2use strict;
3use warnings;
51cf30b6 4use File::Spec;
363879a0 5our $VERSION = '1.21';
b75c8c73 6
52fb7278 7use bytes (); # for $bytes::hint_bits
423cee85 8
fb121860
KW
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
232cbbee 15my %system_aliases = (
69ccf208 16 # Synonyms for the icky 3.2 names that have parentheses.
bcc08981
KW
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
3ffed8c2 38 'BEL' => pack("U", 0x07), # ALERT; formerly BELL
bcc08981
KW
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
25aa614d 74 'RI' => pack("U", 0x8D), # REVERSE LINE FEED
bcc08981
KW
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
25aa614d 82 'MW' => pack("U", 0x95), # MESSAGE WAITING
bcc08981
KW
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
25aa614d 88 'ST' => pack("U", 0x9C), # STRING TERMINATOR
bcc08981 89 'OSC' => pack("U", 0x9D), # OPERATING SYSTEM COMMAND
25aa614d 90 'PM' => pack("U", 0x9E), # PRIVACY MESSAGE
bcc08981
KW
91 'APC' => pack("U", 0x9F), # APPLICATION PROGRAM COMMAND
92
81965e2b
KW
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.
bcc08981
KW
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
81965e2b
KW
106 # More convenience. For further convenience, it is suggested some way of
107 # using the NamesList aliases be implemented, but there are ambiguities in
bcc08981
KW
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);
52ea3e69 388
232cbbee 389my %deprecated_aliases = (
bcc08981
KW
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
3ffed8c2
KW
404
405 # Unicode 6.0 co-opted this for U+1F514, so deprecate it for now.
406 'BELL' => pack("U", 0x07),
bcc08981 407);
52ea3e69 408
84374e30 409
cc26ddeb 410my $txt; # The table of official character names
281aa49e 411
84374e30
KW
412my %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
281aa49e
KW
439# Designed so that test decimal first, and then hex. Leading zeros
440# imply non-decimal, as do non-[0-9]
232cbbee
KW
441my $decimal_qr = qr/^[1-9]\d*$/;
442
443# Returns the hex number in $1.
444my $hex_qr = qr/^(?:[Uu]\+|0[xX])?([[:xdigit:]]+)$/;
423cee85 445
8878f897
T
446sub croak
447{
448 require Carp; goto &Carp::croak;
449} # croak
450
451sub carp
452{
453 require Carp; goto &Carp::carp;
454} # carp
455
cc26ddeb 456sub alias (@) # Set up a single alias
35c0985d 457{
35c0985d 458 my $alias = ref $_[0] ? $_[0] : { @_ };
232cbbee
KW
459 foreach my $name (keys %$alias) {
460 my $value = $alias->{$name};
52fb7278 461 next unless defined $value; # Omit if screwed up.
84374e30
KW
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 }
232cbbee 470 if ($value =~ $decimal_qr) {
0ae19c29 471 no warnings qw(non_unicode surrogate nonchar); # Allow any non-malformed
fb121860 472 $^H{charnames_ord_aliases}{$name} = pack("U", $value);
232cbbee
KW
473
474 # Use a canonical form.
b1c167a3 475 $^H{charnames_inverse_ords}{sprintf("%05X", $value)} = $name;
232cbbee
KW
476 }
477 else {
52fb7278
KW
478 # XXX validate syntax when deprecation cycle complete. ie. start
479 # with an alpha only, etc.
480 $^H{charnames_name_aliases}{$name} = $value;
232cbbee
KW
481 }
482 }
35c0985d
MB
483} # alias
484
5a7fb30a 485sub not_legal_use_bytes_msg {
fb121860
KW
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";
5a7fb30a
KW
495}
496
281aa49e 497sub alias_file ($) # Reads a file containing alias definitions
35c0985d 498{
51cf30b6
MB
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 }
35c0985d 509 if (my @alias = do $file) {
51cf30b6
MB
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";
35c0985d
MB
514 alias (@alias);
515 return (1);
516 }
517 0;
518} # alias_file
519
03f95285
KW
520# For use when don't import anything. This structure must be kept in
521# sync with the one that import() fills up.
522my %dummy_H = (
523 charnames_stringified_names => "",
524 charnames_stringified_ords => "",
525 charnames_scripts => "",
526 charnames_full => 1,
527 charnames_short => 0,
528 );
529
63098191 530
fb121860
KW
531sub lookup_name ($$$) {
532 my ($name, $wants_ord, $runtime) = @_;
63098191 533
fb121860
KW
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.
63098191 542
fb121860
KW
543 # It looks first in the aliases, then in the large table of official Unicode
544 # names.
84374e30 545
9deebca3 546 my $utf8; # The string result
e79869e1 547 my $save_input;
b177ca84 548
84374e30 549 if ($runtime) {
03f95285 550
fb121860
KW
551 my $hints_ref = (caller($runtime))[10];
552
03f95285
KW
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
84374e30
KW
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.
03f95285 562 # N.B. New fields must be also added to %dummy_H
84374e30 563
03f95285
KW
564 %{$^H{charnames_name_aliases}} = split ',',
565 $hints_ref->{charnames_stringified_names};
566 %{$^H{charnames_ord_aliases}} = split ',',
567 $hints_ref->{charnames_stringified_ords};
e79869e1 568 $^H{charnames_scripts} = $hints_ref->{charnames_scripts};
84374e30
KW
569 $^H{charnames_full} = $hints_ref->{charnames_full};
570 $^H{charnames_short} = $hints_ref->{charnames_short};
571 }
572
232cbbee 573 # User alias should be checked first or else can't override ours, and if we
9deebca3 574 # were to add any, could conflict with theirs.
84374e30 575 if (exists $^H{charnames_ord_aliases}{$name}) {
f1ccd77d 576 $utf8 = $^H{charnames_ord_aliases}{$name};
16036bcd 577 }
84374e30
KW
578 elsif (exists $^H{charnames_name_aliases}{$name}) {
579 $name = $^H{charnames_name_aliases}{$name};
e79869e1 580 $save_input = $name; # Cache the result for any error message
232cbbee
KW
581 }
582 elsif (exists $system_aliases{$name}) {
f1ccd77d 583 $utf8 = $system_aliases{$name};
52ea3e69 584 }
232cbbee 585 elsif (exists $deprecated_aliases{$name}) {
35c0985d 586 require warnings;
fb121860 587 warnings::warnif('deprecated', "Unicode character name \"$name\" is deprecated, use \"" . viacode(ord $deprecated_aliases{$name}) . "\" instead");
f1ccd77d 588 $utf8 = $deprecated_aliases{$name};
52ea3e69 589 }
b177ca84 590
423cee85 591 my @off;
52ea3e69 592
f1ccd77d 593 if (! defined $utf8) {
35c0985d 594
9deebca3 595 # See if has looked this input up earlier.
84374e30 596 if ($^H{charnames_full} && exists $full_names_cache{$name}) {
f1ccd77d 597 $utf8 = $full_names_cache{$name};
35c0985d 598 }
84374e30 599 else {
35c0985d 600
84374e30
KW
601 ## Suck in the code/name list as a big string.
602 ## Lines look like:
73d9566f 603 ## "00052\tLATIN CAPITAL LETTER R\n"
fb121860
KW
604 # or
605 # "0052 0303\tLATIN CAPITAL LETTER R WITH TILDE\n"
84374e30
KW
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
8a684a5b 612 my $found_full_in_table = 0; # Tells us if can cache the result
84374e30 613 if ($^H{charnames_full}) {
5bd59e57
KW
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.
fb121860
KW
624 if (defined (my $ord = name_to_code_point_special($name))) {
625 $utf8 = pack("U", $ord);
626 }
627 else {
5bd59e57 628
98dc9551 629 # Not algorithmically determinable; look up in the table.
73d9566f
KW
630 if ($txt =~ /\t\Q$name\E$/m) {
631 @off = ($-[0] + 1, $+[0]); # The 1 is for the tab
5bd59e57
KW
632 $found_full_in_table = 1;
633 }
52fb7278 634 }
423cee85 635 }
b177ca84 636
e79869e1 637 # If we didn't get it above, keep looking
f1ccd77d 638 if (! $found_full_in_table && ! defined $utf8) {
84374e30 639
dc023ef4 640 # If :short is allowed, see if input is like "greek:Sigma".
e79869e1 641 my $scripts_trie;
52fb7278 642 if (($^H{charnames_short})
dc023ef4
KW
643 && $name =~ /^ \s* (.+?) \s* : \s* (.+?) \s* $ /xs)
644 {
e79869e1
KW
645 $scripts_trie = "\U\Q$1";
646 $name = $2;
dc023ef4 647 }
9deebca3 648 else { # Otherwise look in allowed scripts
e79869e1 649 $scripts_trie = $^H{charnames_scripts};
dc023ef4
KW
650 }
651
e79869e1
KW
652 my $case = $name =~ /[[:upper:]]/ ? "CAPITAL" : "SMALL";
653 if ($txt !~
73d9566f 654 /\t (?: $scripts_trie ) \ (?:$case\ )? LETTER \ \U\Q$name\E $/xm)
e79869e1
KW
655 {
656 # Here we still don't have it, give up.
657 return if $runtime;
52fb7278 658
e79869e1
KW
659 # May have zapped input name, get it again.
660 $name = (defined $save_input) ? $save_input : $_[0];
661 carp "Unknown charname '$name'";
fb121860 662 return ($wants_ord) ? 0xFFFD : pack("U", 0xFFFD);
e79869e1 663 }
52fb7278 664
69ccf208 665 # Here have found the input name in the table.
73d9566f 666 @off = ($-[0] + 1, $+[0]); # The 1 is for the tab
52ea3e69 667 }
35c0985d 668
f1ccd77d 669 if (! defined $utf8) {
b1c167a3 670
69ccf208
KW
671 # Here, the input name has been found; we haven't set up the output,
672 # but we know where in the string
fb121860 673 # the name starts. The string is set up so that for single characters
98dc9551 674 # (and not named sequences), the name is preceded immediately by a
fb121860 675 # tab and 5 hex digits for its code, with a \n before those. Named
98dc9551 676 # sequences won't have the 7th preceding character be a \n.
fb121860
KW
677 # (Actually, for the very first entry in the table this isn't strictly
678 # true: subtracting 7 will yield -1, and the substr below will
679 # therefore yield the very last character in the table, which should
680 # also be a \n, so the statement works anyway.)
681 if (substr($txt, $off[0] - 7, 1) eq "\n") {
682 $utf8 = pack("U", CORE::hex substr($txt, $off[0] - 6, 5));
683 }
684 else {
685
686 # Here, is a named sequence. Need to go looking for the beginning,
687 # which is just after the \n from the previous entry in the table.
688 # The +1 skips past that newline, or, if the rindex() fails, to put
689 # us to an offset of zero.
690 my $charstart = rindex($txt, "\n", $off[0] - 7) + 1;
691 $utf8 = pack("U*", map { CORE::hex }
692 split " ", substr($txt, $charstart, $off[0] - $charstart - 1));
693 }
5bd59e57 694 }
84374e30
KW
695
696 # Cache the input so as to not have to search the large table
697 # again, but only if it came from the one search that we cache.
f1ccd77d 698 $full_names_cache{$name} = $utf8 if $found_full_in_table;
35c0985d 699 }
423cee85 700 }
b177ca84 701
63098191 702
fb121860
KW
703 # Here, have the utf8. If the return is to be an ord, must be any single
704 # character.
705 if ($wants_ord) {
706 return ord($utf8) if length $utf8 == 1;
707 }
708 else {
709
710 # Here, wants string output. If utf8 is acceptable, just return what
711 # we've got; otherwise attempt to convert it to non-utf8 and return that.
712 my $in_bytes = ($runtime)
713 ? (caller $runtime)[8] & $bytes::hint_bits
714 : $^H & $bytes::hint_bits;
715 return $utf8 if (! $in_bytes || utf8::downgrade($utf8, 1)) # The 1 arg
716 # means don't die on failure
717 }
718
719 # Here, there is an error: either there are too many characters, or the
720 # result string needs to be non-utf8, and at least one character requires
721 # utf8. Prefer any official name over the input one for the error message.
e79869e1
KW
722 if (@off) {
723 $name = substr($txt, $off[0], $off[1] - $off[0]) if @off;
724 }
725 else {
726 $name = (defined $save_input) ? $save_input : $_[0];
727 }
fb121860
KW
728
729 if ($wants_ord) {
730 # Only way to get here in this case is if result too long. Message
731 # assumes that our only caller that requires single char result is
732 # vianame.
733 carp "charnames::vianame() doesn't handle named sequences ($name). Use charnames::string_vianame() instead";
734 return;
735 }
736
737 # Only other possible failure here is from use bytes.
738 if ($runtime) {
739 carp not_legal_use_bytes_msg($name, $utf8);
740 return;
741 } else {
742 croak not_legal_use_bytes_msg($name, $utf8);
743 }
744
63098191
KW
745} # lookup_name
746
747sub charnames {
63098191 748
9deebca3
KW
749 # For \N{...}. Looks up the character name and returns the string
750 # representation of it.
63098191 751
fb121860
KW
752 # The first 0 arg means wants a string returned; the second that we are in
753 # compile time
754 return lookup_name($_[0], 0, 0);
63098191 755}
423cee85 756
b177ca84
JF
757sub import
758{
759 shift; ## ignore class name
760
35c0985d
MB
761 if (not @_) {
762 carp("`use charnames' needs explicit imports list");
b177ca84 763 }
423cee85 764 $^H{charnames} = \&charnames ;
84374e30
KW
765 $^H{charnames_ord_aliases} = {};
766 $^H{charnames_name_aliases} = {};
767 $^H{charnames_inverse_ords} = {};
03f95285
KW
768 # New fields must be added to %dummy_H, and the code in lookup_name()
769 # that copies fields from the runtime structure
b177ca84
JF
770
771 ##
772 ## fill %h keys with our @_ args.
773 ##
35c0985d 774 my ($promote, %h, @args) = (0);
e5c3f898
MG
775 while (my $arg = shift) {
776 if ($arg eq ":alias") {
51cf30b6 777 @_ or
52fb7278 778 croak ":alias needs an argument in charnames";
35c0985d
MB
779 my $alias = shift;
780 if (ref $alias) {
52fb7278
KW
781 ref $alias eq "HASH" or
782 croak "Only HASH reference supported as argument to :alias";
783 alias ($alias);
784 next;
35c0985d 785 }
51cf30b6 786 if ($alias =~ m{:(\w+)$}) {
52fb7278
KW
787 $1 eq "full" || $1 eq "short" and
788 croak ":alias cannot use existing pragma :$1 (reversed order?)";
789 alias_file ($1) and $promote = 1;
790 next;
35c0985d 791 }
51cf30b6
MB
792 alias_file ($alias);
793 next;
794 }
e5c3f898
MG
795 if (substr($arg, 0, 1) eq ':' and ! ($arg eq ":full" || $arg eq ":short")) {
796 warn "unsupported special '$arg' in charnames";
51cf30b6 797 next;
35c0985d 798 }
e5c3f898 799 push @args, $arg;
35c0985d
MB
800 }
801 @args == 0 && $promote and @args = (":full");
802 @h{@args} = (1) x @args;
b177ca84 803
03f95285
KW
804 $^H{charnames_full} = delete $h{':full'} || 0; # Don't leave undefined,
805 # as tested for in
806 # lookup_names
807 $^H{charnames_short} = delete $h{':short'} || 0;
363879a0 808 my @scripts = map { uc quotemeta } keys %h;
b177ca84
JF
809
810 ##
811 ## If utf8? warnings are enabled, and some scripts were given,
281aa49e 812 ## see if at least we can find one letter from each script.
b177ca84 813 ##
e79869e1 814 if (warnings::enabled('utf8') && @scripts) {
35c0985d
MB
815 $txt = do "unicore/Name.pl" unless $txt;
816
e79869e1 817 for my $script (@scripts) {
73d9566f 818 if (not $txt =~ m/\t$script (?:CAPITAL |SMALL )?LETTER /) {
52fb7278 819 warnings::warn('utf8', "No such script: '$script'");
e79869e1 820 $script = quotemeta $script; # Escape it, for use in the re.
b177ca84 821 }
35c0985d 822 }
bd62941a 823 }
84374e30
KW
824
825 # %^H gets stringified, so serialize it ourselves so can extract the
826 # real data back later.
827 $^H{charnames_stringified_ords} = join ",", %{$^H{charnames_ord_aliases}};
828 $^H{charnames_stringified_names} = join ",", %{$^H{charnames_name_aliases}};
829 $^H{charnames_stringified_inverse_ords} = join ",", %{$^H{charnames_inverse_ords}};
e79869e1 830 $^H{charnames_scripts} = join "|", @scripts; # Stringifiy them as a trie
35c0985d 831} # import
423cee85 832
84374e30
KW
833# Cache of already looked-up values. This is set to only contain
834# official values, and user aliases can't override them, so scoping is
835# not an issue.
836my %viacode;
63098191
KW
837
838sub viacode {
839
840 # Returns the name of the code point argument
4e2cda5d 841
35c0985d
MB
842 if (@_ != 1) {
843 carp "charnames::viacode() expects one argument";
bd5c3bd9 844 return;
35c0985d 845 }
f0175764 846
35c0985d 847 my $arg = shift;
b177ca84 848
e5432b89
KW
849 # This is derived from Unicode::UCD, where it is nearly the same as the
850 # function _getcode(), but here it makes sure that even a hex argument
851 # has the proper number of leading zeros, which is critical in
852 # matching against $txt below
281aa49e 853 # Must check if decimal first; see comments at that definition
35c0985d 854 my $hex;
232cbbee 855 if ($arg =~ $decimal_qr) {
b1c167a3 856 $hex = sprintf "%05X", $arg;
232cbbee 857 } elsif ($arg =~ $hex_qr) {
e10d7780 858 # Below is the line that differs from the _getcode() source
b1c167a3 859 $hex = sprintf "%05X", hex $1;
35c0985d
MB
860 } else {
861 carp("unexpected arg \"$arg\" to charnames::viacode()");
862 return;
863 }
b177ca84 864
35c0985d 865 return $viacode{$hex} if exists $viacode{$hex};
4e2cda5d 866
ac046fe1
KW
867 # If the code point is above the max in the table, there's no point
868 # looking through it. Checking the length first is slightly faster
869 if (length($hex) <= 5 || CORE::hex($hex) <= 0x10FFFF) {
870 $txt = do "unicore/Name.pl" unless $txt;
b177ca84 871
5bd59e57
KW
872 # See if the name is algorithmically determinable.
873 my $algorithmic = code_point_to_name_special(CORE::hex $hex);
874 if (defined $algorithmic) {
875 $viacode{$hex} = $algorithmic;
876 return $algorithmic;
877 }
878
ac046fe1
KW
879 # Return the official name, if exists. It's unclear to me (khw) at
880 # this juncture if it is better to return a user-defined override, so
881 # leaving it as is for now.
73d9566f 882 if ($txt =~ m/^$hex\t/m) {
f3227b74 883
52fb7278
KW
884 # The name starts with the next character and goes up to the
885 # next new-line. Using capturing parentheses above instead of
886 # @+ more than doubles the execution time in Perl 5.13
f3227b74 887 $viacode{$hex} = substr($txt, $+[0], index($txt, "\n", $+[0]) - $+[0]);
52fb7278 888 return $viacode{$hex};
ac046fe1 889 }
232cbbee
KW
890 }
891
892 # See if there is a user name for it, before giving up completely.
03f95285
KW
893 # First get the scoped aliases, give up if have none.
894 my $H_ref = (caller(0))[10];
895 return if ! defined $H_ref
896 || ! exists $H_ref->{charnames_stringified_inverse_ords};
897
84374e30 898 my %code_point_aliases = split ',',
03f95285 899 $H_ref->{charnames_stringified_inverse_ords};
84374e30 900 if (! exists $code_point_aliases{$hex}) {
ac046fe1
KW
901 if (CORE::hex($hex) > 0x10FFFF) {
902 carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)";
903 }
904 return;
905 }
bd5c3bd9 906
84374e30 907 return $code_point_aliases{$hex};
35c0985d 908} # viacode
daf0d493
JH
909
910sub vianame
911{
35c0985d
MB
912 if (@_ != 1) {
913 carp "charnames::vianame() expects one name argument";
914 return ()
915 }
daf0d493 916
63098191
KW
917 # Looks up the character name and returns its ordinal if
918 # found, undef otherwise.
daf0d493 919
63098191 920 my $arg = shift;
dbc0d4f2 921
63098191 922 if ($arg =~ /^U\+([0-9a-fA-F]+)$/) {
4e2cda5d 923
fb121860
KW
924 # khw claims that this is poor interface design. The function should
925 # return either a an ord or a chr for all inputs; not be bipolar. But
926 # can't change it because of backward compatibility. New code can use
927 # string_vianame() instead.
5a7fb30a
KW
928 my $ord = CORE::hex $1;
929 return chr $ord if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits);
fb121860 930 carp not_legal_use_bytes_msg($arg, chr $ord);
5a7fb30a 931 return;
63098191 932 }
daf0d493 933
fb121860
KW
934 # The first 1 arg means wants an ord returned; the second that we are in
935 # runtime, and this is the first level routine called from the user
936 return lookup_name($arg, 1, 1);
35c0985d 937} # vianame
b177ca84 938
fb121860
KW
939sub string_vianame {
940
941 # Looks up the character name and returns its string representation if
942 # found, undef otherwise.
943
944 if (@_ != 1) {
945 carp "charnames::string_vianame() expects one name argument";
946 return;
947 }
948
949 my $arg = shift;
950
951 if ($arg =~ /^U\+([0-9a-fA-F]+)$/) {
952
953 my $ord = CORE::hex $1;
954 return chr $ord if $ord <= 255 || ! ((caller 0)[8] & $bytes::hint_bits);
955
956 carp not_legal_use_bytes_msg($arg, chr $ord);
957 return;
958 }
959
960 # The 0 arg means wants a string returned; the 1 arg means that we are in
961 # runtime, and this is the first level routine called from the user
962 return lookup_name($arg, 0, 1);
963} # string_vianame
964
965
423cee85
JH
966
9671;
968__END__
969
970=head1 NAME
971
fb121860 972charnames - access to Unicode character names and named character sequences; also define character names
423cee85
JH
973
974=head1 SYNOPSIS
975
bcc08981
KW
976 use charnames ':full';
977 print "\N{GREEK SMALL LETTER SIGMA} is called sigma.\n";
978 print "\N{LATIN CAPITAL LETTER E WITH VERTICAL LINE BELOW}",
979 " is an officially named sequence of two Unicode characters\n";
980
981 use charnames ':short';
982 print "\N{greek:Sigma} is an upper-case sigma.\n";
983
984 use charnames qw(cyrillic greek);
985 print "\N{sigma} is Greek sigma, and \N{be} is Cyrillic b.\n";
986
987 use charnames ":full", ":alias" => {
988 e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
989 mychar => 0xE8000, # Private use area
990 };
991 print "\N{e_ACUTE} is a small letter e with an acute.\n";
14aeae98 992 print "\N{mychar} allows me to name private use characters.\n";
bcc08981
KW
993
994 use charnames ();
995 print charnames::viacode(0x1234); # prints "ETHIOPIC SYLLABLE SEE"
996 printf "%04X", charnames::vianame("GOTHIC LETTER AHSA"); # prints
997 # "10330"
998 print charnames::vianame("LATIN CAPITAL LETTER A"); # prints 65 on
999 # ASCII platforms;
1000 # 193 on EBCDIC
1001 print charnames::string_vianame("LATIN CAPITAL LETTER A"); # prints "A"
b177ca84 1002
423cee85
JH
1003=head1 DESCRIPTION
1004
da9dec57 1005Pragma C<use charnames> is used to gain access to the names of the
fb121860
KW
1006Unicode characters and named character sequences, and to allow you to define
1007your own character and character sequence names.
1008
1009All forms of the pragma enable use of the following 3 functions:
1010
1011=over
1012
1013=item *
1014
1015L</charnames::string_vianame(I<name>)> for run-time lookup of a
1016either a character name or a named character sequence, returning its string
1017representation
1018
1019=item *
1020
1021L</charnames::vianame(I<name>)> for run-time lookup of a
1022character name (but not a named character sequence) to get its ordinal value
1023(code point)
da9dec57 1024
fb121860 1025=item *
da9dec57 1026
fb121860
KW
1027L</charnames::viacode(I<code>)> for run-time lookup of a code point to get its
1028Unicode name.
1029
1030=back
1031
1032All forms other than C<S<"use charnames ();">> also enable the use of
da9dec57 1033C<\N{I<CHARNAME>}> sequences to compile a Unicode character into a
8ebef31d 1034string, based on its name.
da9dec57
KW
1035
1036Note that C<\N{U+I<...>}>, where the I<...> is a hexadecimal number,
1037also inserts a character into a string, but doesn't require the use of
1038this pragma. The character it inserts is the one whose code point
1039(ordinal value) is equal to the number. For example, C<"\N{U+263a}"> is
1040the Unicode (white background, black foreground) smiley face; it doesn't
1041require this pragma, whereas the equivalent, C<"\N{WHITE SMILING FACE}">
1042does.
1043Also, C<\N{I<...>}> can mean a regex quantifier instead of a character
8ebef31d
KW
1044name, when the I<...> is a number (or comma separated pair of numbers
1045(see L<perlreref/QUANTIFIERS>), and is not related to this pragma.
da9dec57
KW
1046
1047The C<charnames> pragma supports arguments C<:full>, C<:short>, script
14aeae98
KW
1048names and L<customized aliases|/CUSTOM ALIASES>. If C<:full> is present, for
1049expansion of
da9dec57 1050C<\N{I<CHARNAME>}>, the string I<CHARNAME> is first looked up in the list of
76ae0c45 1051standard Unicode character names. If C<:short> is present, and
da9dec57 1052I<CHARNAME> has the form C<I<SCRIPT>:I<CNAME>>, then I<CNAME> is looked up
14aeae98
KW
1053as a letter in script I<SCRIPT>, as described in the next paragraph.
1054Or, if C<use charnames> is used
da9dec57
KW
1055with script name arguments, then for C<\N{I<CHARNAME>}> the name
1056I<CHARNAME> is looked up as a letter in the given scripts (in the
16036bcd
KW
1057specified order). Customized aliases can override these, and are explained in
1058L</CUSTOM ALIASES>.
423cee85 1059
da9dec57 1060For lookup of I<CHARNAME> inside a given script I<SCRIPTNAME>
14aeae98 1061this pragma looks in the table of standard Unicode names for the names
423cee85
JH
1062
1063 SCRIPTNAME CAPITAL LETTER CHARNAME
1064 SCRIPTNAME SMALL LETTER CHARNAME
1065 SCRIPTNAME LETTER CHARNAME
1066
14aeae98 1067If I<CHARNAME> is all lowercase,
daf0d493 1068then the C<CAPITAL> variant is ignored, otherwise the C<SMALL> variant
14aeae98
KW
1069is ignored, and both I<CHARNAME> and I<SCRIPTNAME> are converted to all
1070uppercase for look-up.
daf0d493 1071
da9dec57
KW
1072Note that C<\N{...}> is compile-time; it's a special form of string
1073constant used inside double-quotish strings; this means that you cannot
4e2cda5d 1074use variables inside the C<\N{...}>. If you want similar run-time
fb121860
KW
1075functionality, use
1076L<charnames::string_vianame()|/charnames::string_vianame(I<name>)>.
423cee85 1077
301a3cda 1078For the C0 and C1 control characters (U+0000..U+001F, U+0080..U+009F)
da9dec57
KW
1079there are no official Unicode names but you can use instead the ISO 6429
1080names (LINE FEED, ESCAPE, and so forth, and their abbreviations, LF,
1f31fcd4 1081ESC, ...). In Unicode 3.2 (as of Perl 5.8) some naming changes took
b59ae8bb
KW
1082place, and ISO 6429 was updated, see L</ALIASES>. Since Unicode 6.0, it
1083is deprecated to use C<BELL>. Instead use C<ALERT> (but C<BEL> works).
301a3cda 1084
e5432b89
KW
1085If the input name is unknown, C<\N{NAME}> raises a warning and
1086substitutes the Unicode REPLACEMENT CHARACTER (U+FFFD).
1087
8ebef31d
KW
1088For C<\N{NAME}>, it is a fatal error if C<use bytes> is in effect and the
1089input name is that of a character that won't fit into a byte (i.e., whose
1090ordinal is above 255).
e5432b89 1091
da9dec57
KW
1092Otherwise, any string that includes a C<\N{I<charname>}> or
1093C<S<\N{U+I<code point>}>> will automatically have Unicode semantics (see
1094L<perlunicode/Byte and Character Semantics>).
1095
5ffe0e96 1096=head1 ALIASES
423cee85 1097
14aeae98
KW
1098A few aliases have been defined for convenience; instead of having
1099to use the official names,
423cee85 1100
5ffe0e96
MB
1101 LINE FEED (LF)
1102 FORM FEED (FF)
1103 CARRIAGE RETURN (CR)
1104 NEXT LINE (NEL)
423cee85 1105
e5432b89 1106(yes, with parentheses), one can use
d5448623 1107
5ffe0e96
MB
1108 LINE FEED
1109 FORM FEED
1110 CARRIAGE RETURN
1111 NEXT LINE
1112 LF
1113 FF
1114 CR
1115 NEL
1116
16036bcd
KW
1117All the other standard abbreviations for the controls, such as C<ACK> for
1118C<ACKNOWLEDGE> also can be used.
1119
5ffe0e96
MB
1120One can also use
1121
1122 BYTE ORDER MARK
1123 BOM
1124
16036bcd
KW
1125and these abbreviations
1126
1127 Abbreviation Full Name
1128
1129 CGJ COMBINING GRAPHEME JOINER
1130 FVS1 MONGOLIAN FREE VARIATION SELECTOR ONE
1131 FVS2 MONGOLIAN FREE VARIATION SELECTOR TWO
1132 FVS3 MONGOLIAN FREE VARIATION SELECTOR THREE
1133 LRE LEFT-TO-RIGHT EMBEDDING
1134 LRM LEFT-TO-RIGHT MARK
1135 LRO LEFT-TO-RIGHT OVERRIDE
1136 MMSP MEDIUM MATHEMATICAL SPACE
1137 MVS MONGOLIAN VOWEL SEPARATOR
1138 NBSP NO-BREAK SPACE
1139 NNBSP NARROW NO-BREAK SPACE
1140 PDF POP DIRECTIONAL FORMATTING
1141 RLE RIGHT-TO-LEFT EMBEDDING
1142 RLM RIGHT-TO-LEFT MARK
1143 RLO RIGHT-TO-LEFT OVERRIDE
1144 SHY SOFT HYPHEN
1145 VS1 VARIATION SELECTOR-1
1146 .
1147 .
1148 .
1149 VS256 VARIATION SELECTOR-256
1150 WJ WORD JOINER
1151 ZWJ ZERO WIDTH JOINER
1152 ZWNJ ZERO WIDTH NON-JOINER
1153 ZWSP ZERO WIDTH SPACE
5ffe0e96
MB
1154
1155For backward compatibility one can use the old names for
1156certain C0 and C1 controls
1157
1158 old new
1159
5ffe0e96
MB
1160 FILE SEPARATOR INFORMATION SEPARATOR FOUR
1161 GROUP SEPARATOR INFORMATION SEPARATOR THREE
16036bcd
KW
1162 HORIZONTAL TABULATION CHARACTER TABULATION
1163 HORIZONTAL TABULATION SET CHARACTER TABULATION SET
1164 HORIZONTAL TABULATION WITH JUSTIFICATION CHARACTER TABULATION
1165 WITH JUSTIFICATION
5ffe0e96
MB
1166 PARTIAL LINE DOWN PARTIAL LINE FORWARD
1167 PARTIAL LINE UP PARTIAL LINE BACKWARD
16036bcd
KW
1168 RECORD SEPARATOR INFORMATION SEPARATOR TWO
1169 REVERSE INDEX REVERSE LINE FEED
1170 UNIT SEPARATOR INFORMATION SEPARATOR ONE
1171 VERTICAL TABULATION LINE TABULATION
1172 VERTICAL TABULATION SET LINE TABULATION SET
5ffe0e96
MB
1173
1174but the old names in addition to giving the character
1175will also give a warning about being deprecated.
423cee85 1176
16036bcd
KW
1177And finally, certain published variants are usable, including some for
1178controls that have no Unicode names:
1179
1f31fcd4
KW
1180 name character
1181
52fb7278 1182 END OF PROTECTED AREA END OF GUARDED AREA, U+0097
1f31fcd4
KW
1183 HIGH OCTET PRESET U+0081
1184 HOP U+0081
1185 IND U+0084
1186 INDEX U+0084
1187 PAD U+0080
1188 PADDING CHARACTER U+0080
1189 PRIVATE USE 1 PRIVATE USE ONE, U+0091
1190 PRIVATE USE 2 PRIVATE USE TWO, U+0092
1191 SGC U+0099
1192 SINGLE GRAPHIC CHARACTER INTRODUCER U+0099
1193 SINGLE-SHIFT 2 SINGLE SHIFT TWO, U+008E
1194 SINGLE-SHIFT 3 SINGLE SHIFT THREE, U+008F
1195 START OF PROTECTED AREA START OF GUARDED AREA, U+0096
16036bcd 1196
35c0985d
MB
1197=head1 CUSTOM ALIASES
1198
1f31fcd4
KW
1199You can add customized aliases to standard (C<:full>) Unicode naming
1200conventions. The aliases override any standard definitions, so, if
da9dec57
KW
1201you're twisted enough, you can change C<"\N{LATIN CAPITAL LETTER A}"> to
1202mean C<"B">, etc.
55bc7d3c
KW
1203
1204Note that an alias should not be something that is a legal curly
1205brace-enclosed quantifier (see L<perlreref/QUANTIFIERS>). For example
e5432b89
KW
1206C<\N{123}> means to match 123 non-newline characters, and is not treated as a
1207charnames alias. Aliases are discouraged from beginning with anything
1208other than an alphabetic character and from containing anything other
1209than alphanumerics, spaces, dashes, parentheses, and underscores.
1210Currently they must be ASCII.
1211
1212An alias can map to either an official Unicode character name or to a
1213numeric code point (ordinal). The latter is useful for assigning names
1214to code points in Unicode private use areas such as U+E800 through
f12d74c0
KW
1215U+F8FF.
1216A numeric code point must be a non-negative integer or a string beginning
1217with C<"U+"> or C<"0x"> with the remainder considered to be a
1218hexadecimal integer. A literal numeric constant must be unsigned; it
1219will be interpreted as hex if it has a leading zero or contains
1220non-decimal hex digits; otherwise it will be interpreted as decimal.
232cbbee 1221
da9dec57 1222Aliases are added either by the use of anonymous hashes:
35c0985d 1223
da9dec57 1224 use charnames ":alias" => {
35c0985d 1225 e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
232cbbee 1226 mychar1 => 0xE8000,
35c0985d
MB
1227 };
1228 my $str = "\N{e_ACUTE}";
1229
da9dec57 1230or by using a file containing aliases:
35c0985d 1231
da9dec57 1232 use charnames ":alias" => "pro";
35c0985d 1233
8ebef31d 1234This will try to read C<"unicore/pro_alias.pl"> from the C<@INC> path. This
da9dec57 1235file should return a list in plain perl:
35c0985d
MB
1236
1237 (
1238 A_GRAVE => "LATIN CAPITAL LETTER A WITH GRAVE",
1239 A_CIRCUM => "LATIN CAPITAL LETTER A WITH CIRCUMFLEX",
1240 A_DIAERES => "LATIN CAPITAL LETTER A WITH DIAERESIS",
1241 A_TILDE => "LATIN CAPITAL LETTER A WITH TILDE",
1242 A_BREVE => "LATIN CAPITAL LETTER A WITH BREVE",
1243 A_RING => "LATIN CAPITAL LETTER A WITH RING ABOVE",
1244 A_MACRON => "LATIN CAPITAL LETTER A WITH MACRON",
f12d74c0 1245 mychar2 => "U+E8001",
35c0985d
MB
1246 );
1247
da9dec57
KW
1248Both these methods insert C<":full"> automatically as the first argument (if no
1249other argument is given), and you can give the C<":full"> explicitly as
1250well, like
35c0985d 1251
da9dec57 1252 use charnames ":full", ":alias" => "pro";
35c0985d 1253
14aeae98 1254Also, both these methods currently allow only single characters to be named.
8ebef31d
KW
1255To name a sequence of characters, use a
1256L<custom translator|/CUSTOM TRANSLATORS> (described below).
1257
da9dec57 1258=head1 charnames::viacode(I<code>)
b177ca84
JF
1259
1260Returns the full name of the character indicated by the numeric code.
da9dec57 1261For example,
b177ca84
JF
1262
1263 print charnames::viacode(0x2722);
1264
1265prints "FOUR TEARDROP-SPOKED ASTERISK".
1266
232cbbee 1267The name returned is the official name for the code point, if
8ebef31d 1268available; otherwise your custom alias for it. This means that your
232cbbee 1269alias will only be returned for code points that don't have an official
14aeae98 1270Unicode name (nor a Unicode version 1 name), such as private use code
232cbbee 1271points, and the 4 control characters U+0080, U+0081, U+0084, and U+0099.
da9dec57
KW
1272If you define more than one name for the code point, it is indeterminate
1273which one will be returned.
1274
1275The function returns C<undef> if no name is known for the code point.
1276In Unicode the proper name of these is the empty string, which
1277C<undef> stringifies to. (If you ask for a code point past the legal
1278Unicode maximum of U+10FFFF that you haven't assigned an alias to, you
f12d74c0
KW
1279get C<undef> plus a warning.)
1280
1281The input number must be a non-negative integer or a string beginning
1282with C<"U+"> or C<"0x"> with the remainder considered to be a
1283hexadecimal integer. A literal numeric constant must be unsigned; it
1284will be interpreted as hex if it has a leading zero or contains
1285non-decimal hex digits; otherwise it will be interpreted as decimal.
daf0d493 1286
274085e3
PN
1287Notice that the name returned for of U+FEFF is "ZERO WIDTH NO-BREAK
1288SPACE", not "BYTE ORDER MARK".
1289
fb121860 1290=head1 charnames::string_vianame(I<name>)
daf0d493 1291
fb121860
KW
1292This is a runtime equivalent to C<\N{...}>. I<name> can be any expression
1293that evaluates to a name accepted by C<\N{...}> under the L<C<:full>
1294option|/DESCRIPTION> to C<charnames>. In addition, any other options for the
1295controlling C<"use charnames"> in the same scope apply, like any L<script
1296list, C<:short> option|/DESCRIPTION>, or L<custom aliases|/CUSTOM ALIASES> you
1297may have defined.
daf0d493 1298
fb121860
KW
1299The only difference is that if the input name is unknown, C<string_vianame>
1300returns C<undef> instead of the REPLACEMENT CHARACTER and does not raise a
1301warning message.
daf0d493 1302
fb121860
KW
1303=head1 charnames::vianame(I<name>)
1304
1305This is similar to C<string_vianame>. The main difference is that under most
1306circumstances (see L</BUGS> for the others), vianame returns an ordinal code
1307point, whereas C<string_vianame> returns a string. For example,
daf0d493 1308
fb121860 1309 printf "U+%04X", charnames::vianame("FOUR TEARDROP-SPOKED ASTERISK");
b177ca84 1310
fb121860 1311prints "U+2722".
1f31fcd4 1312
fb121860
KW
1313This leads to the other two differences. Since a single code point is
1314returned, the function can't handle named character sequences, as these are
14aeae98
KW
1315composed of multiple characters (it returns C<undef> for these. And, the code
1316point can be that of any
fb121860 1317character, even ones that aren't legal under the C<S<use bytes>> pragma,
b177ca84 1318
5ffe0e96 1319=head1 CUSTOM TRANSLATORS
52ea3e69 1320
5ffe0e96 1321The mechanism of translation of C<\N{...}> escapes is general and not
14aeae98
KW
1322hardwired into F<charnames.pm>. This is the only way you can create
1323a custom named sequence of code points. A module can install custom
5ffe0e96
MB
1324translations (inside the scope which C<use>s the module) with the
1325following magic incantation:
52ea3e69 1326
5ffe0e96 1327 sub import {
52fb7278
KW
1328 shift;
1329 $^H{charnames} = \&translator;
5ffe0e96 1330 }
52ea3e69 1331
da9dec57 1332Here translator() is a subroutine which takes I<CHARNAME> as an
5ffe0e96 1333argument, and returns text to insert into the string instead of the
da9dec57 1334C<\N{I<CHARNAME>}> escape. Since the text to insert should be different
5ffe0e96
MB
1335in C<bytes> mode and out of it, the function should check the current
1336state of C<bytes>-flag as in:
52ea3e69 1337
52fb7278 1338 use bytes (); # for $bytes::hint_bits
5ffe0e96 1339 sub translator {
52fb7278
KW
1340 if ($^H & $bytes::hint_bits) {
1341 return bytes_translator(@_);
1342 }
1343 else {
1344 return utf8_translator(@_);
1345 }
5ffe0e96 1346 }
52ea3e69 1347
da9dec57 1348See L</CUSTOM ALIASES> above for restrictions on I<CHARNAME>.
f0175764 1349
9e808deb
KW
1350Of course, C<vianame>, C<viacode>, and C<string_vianame> would need to be
1351overridden as well.
1f31fcd4 1352
423cee85
JH
1353=head1 BUGS
1354
14aeae98 1355vianame() normally returns an ordinal code point, but when the input name is of
8ebef31d
KW
1356the form C<U+...>, it returns a chr instead. In this case, if C<use bytes> is
1357in effect and the character won't fit into a byte, it returns C<undef> and
1358raises a warning.
55bc7d3c 1359
16036bcd
KW
1360Names must be ASCII characters only, which means that you are out of luck if
1361you want to create aliases in a language where some or all the characters of
1362the desired aliases are non-ASCII.
bee80e93 1363
f12d74c0
KW
1364Since evaluation of the translation function (see L</CUSTOM
1365TRANSLATORS>) happens in the middle of compilation (of a string
1366literal), the translation function should not do any C<eval>s or
1367C<require>s. This restriction should be lifted (but is low priority) in
1368a future version of Perl.
423cee85
JH
1369
1370=cut
0eacc33e 1371
52fb7278 1372# ex: set ts=8 sts=2 sw=2 et: