This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #76502] Fix UCD.pm doc
[perl5.git] / lib / Unicode / UCD.pm
1 package Unicode::UCD;
2
3 use strict;
4 use warnings;
5
6 our $VERSION = '0.28';
7
8 use Storable qw(dclone);
9
10 require Exporter;
11
12 our @ISA = qw(Exporter);
13
14 our @EXPORT_OK = qw(charinfo
15                     charblock charscript
16                     charblocks charscripts
17                     charinrange
18                     general_categories bidi_types
19                     compexcl
20                     casefold casespec
21                     namedseq);
22
23 use Carp;
24
25 =head1 NAME
26
27 Unicode::UCD - Unicode character database
28
29 =head1 SYNOPSIS
30
31     use Unicode::UCD 'charinfo';
32     my $charinfo   = charinfo($codepoint);
33
34     use Unicode::UCD 'casefold';
35     my $casefold = casefold(0xFB00);
36
37     use Unicode::UCD 'casespec';
38     my $casespec = casespec(0xFB00);
39
40     use Unicode::UCD 'charblock';
41     my $charblock  = charblock($codepoint);
42
43     use Unicode::UCD 'charscript';
44     my $charscript = charscript($codepoint);
45
46     use Unicode::UCD 'charblocks';
47     my $charblocks = charblocks();
48
49     use Unicode::UCD 'charscripts';
50     my $charscripts = charscripts();
51
52     use Unicode::UCD qw(charscript charinrange);
53     my $range = charscript($script);
54     print "looks like $script\n" if charinrange($range, $codepoint);
55
56     use Unicode::UCD qw(general_categories bidi_types);
57     my $categories = general_categories();
58     my $types = bidi_types();
59
60     use Unicode::UCD 'compexcl';
61     my $compexcl = compexcl($codepoint);
62
63     use Unicode::UCD 'namedseq';
64     my $namedseq = namedseq($named_sequence_name);
65
66     my $unicode_version = Unicode::UCD::UnicodeVersion();
67
68 =head1 DESCRIPTION
69
70 The Unicode::UCD module offers a series of functions that
71 provide a simple interface to the Unicode
72 Character Database.
73
74 =head2 code point argument
75
76 Some of the functions are called with a I<code point argument>, which is either
77 a decimal or a hexadecimal scalar designating a Unicode code point, or C<U+>
78 followed by hexadecimals designating a Unicode code point.  In other words, if
79 you want a code point to be interpreted as a hexadecimal number, you must
80 prefix it with either C<0x> or C<U+>, because a string like e.g. C<123> will be
81 interpreted as a decimal code point.  Also note that Unicode is B<not> limited
82 to 16 bits (the number of Unicode code points is open-ended, in theory
83 unlimited): you may have more than 4 hexdigits.
84 =cut
85
86 my $UNICODEFH;
87 my $BLOCKSFH;
88 my $SCRIPTSFH;
89 my $VERSIONFH;
90 my $COMPEXCLFH;
91 my $CASEFOLDFH;
92 my $CASESPECFH;
93 my $NAMEDSEQFH;
94
95 sub openunicode {
96     my ($rfh, @path) = @_;
97     my $f;
98     unless (defined $$rfh) {
99         for my $d (@INC) {
100             use File::Spec;
101             $f = File::Spec->catfile($d, "unicore", @path);
102             last if open($$rfh, $f);
103             undef $f;
104         }
105         croak __PACKAGE__, ": failed to find ",
106               File::Spec->catfile(@path), " in @INC"
107             unless defined $f;
108     }
109     return $f;
110 }
111
112 =head2 B<charinfo()>
113
114     use Unicode::UCD 'charinfo';
115
116     my $charinfo = charinfo(0x41);
117
118 This returns information about the input L</code point argument>
119 as a reference to a hash of fields as defined by the Unicode
120 standard.  If the L</code point argument> is not assigned in the standard
121 (i.e., has the general category C<Cn> meaning C<Unassigned>)
122 or is a non-character (meaning it is guaranteed to never be assigned in
123 the standard),
124 B<undef> is returned.
125
126 Fields that aren't applicable to the particular code point argument exist in the
127 returned hash, and are empty. 
128
129 The keys in the hash with the meanings of their values are:
130
131 =over
132
133 =item B<code>
134
135 the input L</code point argument> expressed in hexadecimal, with leading zeros
136 added if necessary to make it contain at least four hexdigits
137
138 =item B<name>
139
140 name of I<code>, all IN UPPER CASE.
141 Some control-type code points do not have names.
142 This field will be empty for C<Surrogate> and C<Private Use> code points,
143 and for the others without a name,
144 it will contain a description enclosed in angle brackets, like
145 C<E<lt>controlE<gt>>.
146
147
148 =item B<category>
149
150 The short name of the general category of I<code>.
151 This will match one of the keys in the hash returned by L</general_categories()>.
152
153 =item B<combining>
154
155 the combining class number for I<code> used in the Canonical Ordering Algorithm.
156 For Unicode 5.1, this is described in Section 3.11 C<Canonical Ordering Behavior>
157 available at
158 L<http://www.unicode.org/versions/Unicode5.1.0/>
159
160 =item B<bidi>
161
162 bidirectional type of I<code>.
163 This will match one of the keys in the hash returned by L</bidi_types()>.
164
165 =item B<decomposition>
166
167 is empty if I<code> has no decomposition; or is one or more codes
168 (separated by spaces) that taken in order represent a decomposition for
169 I<code>.  Each has at least four hexdigits.
170 The codes may be preceded by a word enclosed in angle brackets then a space,
171 like C<E<lt>compatE<gt> >, giving the type of decomposition
172
173 =item B<decimal>
174
175 if I<code> is a decimal digit this is its integer numeric value
176
177 =item B<digit>
178
179 if I<code> represents a whole number, this is its integer numeric value
180
181 =item B<numeric>
182
183 if I<code> represents a whole or rational number, this is its numeric value.
184 Rational values are expressed as a string like C<1/4>.
185
186 =item B<mirrored>
187
188 C<Y> or C<N> designating if I<code> is mirrored in bidirectional text
189
190 =item B<unicode10>
191
192 name of I<code> in the Unicode 1.0 standard if one
193 existed for this code point and is different from the current name
194
195 =item B<comment>
196
197 ISO 10646 comment field.
198 It appears in parentheses in the ISO 10646 names list,
199 or contains an asterisk to indicate there is
200 a note for this code point in Annex P of that standard.
201
202 =item B<upper>
203
204 is empty if there is no single code point uppercase mapping for I<code>;
205 otherwise it is that mapping expressed as at least four hexdigits.
206 (L</casespec()> should be used in addition to B<charinfo()>
207 for case mappings when the calling program can cope with multiple code point
208 mappings.)
209
210 =item B<lower>
211
212 is empty if there is no single code point lowercase mapping for I<code>;
213 otherwise it is that mapping expressed as at least four hexdigits.
214 (L</casespec()> should be used in addition to B<charinfo()>
215 for case mappings when the calling program can cope with multiple code point
216 mappings.)
217
218 =item B<title>
219
220 is empty if there is no single code point titlecase mapping for I<code>;
221 otherwise it is that mapping expressed as at least four hexdigits.
222 (L</casespec()> should be used in addition to B<charinfo()>
223 for case mappings when the calling program can cope with multiple code point
224 mappings.)
225
226 =item B<block>
227
228 block I<code> belongs to (used in \p{In...}).
229 See L</Blocks versus Scripts>.
230
231
232 =item B<script>
233
234 script I<code> belongs to.
235 See L</Blocks versus Scripts>.
236
237 =back
238
239 Note that you cannot do (de)composition and casing based solely on the
240 I<decomposition>, I<combining>, I<lower>, I<upper>, and I<title> fields;
241 you will need also the L</compexcl()>, and L</casespec()> functions.
242
243 =cut
244
245 # NB: This function is nearly duplicated in charnames.pm
246 sub _getcode {
247     my $arg = shift;
248
249     if ($arg =~ /^[1-9]\d*$/) {
250         return $arg;
251     } elsif ($arg =~ /^(?:[Uu]\+|0[xX])?([[:xdigit:]]+)$/) {
252         return hex($1);
253     }
254
255     return;
256 }
257
258 # Lingua::KO::Hangul::Util not part of the standard distribution
259 # but it will be used if available.
260
261 eval { require Lingua::KO::Hangul::Util };
262 my $hasHangulUtil = ! $@;
263 if ($hasHangulUtil) {
264     Lingua::KO::Hangul::Util->import();
265 }
266
267 sub hangul_decomp { # internal: called from charinfo
268     if ($hasHangulUtil) {
269         my @tmp = decomposeHangul(shift);
270         return sprintf("%04X %04X",      @tmp) if @tmp == 2;
271         return sprintf("%04X %04X %04X", @tmp) if @tmp == 3;
272     }
273     return;
274 }
275
276 sub hangul_charname { # internal: called from charinfo
277     return sprintf("HANGUL SYLLABLE-%04X", shift);
278 }
279
280 sub han_charname { # internal: called from charinfo
281     return sprintf("CJK UNIFIED IDEOGRAPH-%04X", shift);
282 }
283
284 # Overwritten by data in file
285 my %first_last = (
286    'CJK Ideograph Extension A' => [ 0x3400,   0x4DB5   ],
287    'CJK Ideograph'             => [ 0x4E00,   0x9FA5   ],
288    'CJK Ideograph Extension B' => [ 0x20000,  0x2A6D6  ],
289 );
290
291 get_charinfo_ranges();
292
293 sub get_charinfo_ranges {
294    my @blocks = keys %first_last;
295    
296    my $fh;
297    openunicode( \$fh, 'UnicodeData.txt' );
298    if( defined $fh ){
299       while( my $line = <$fh> ){
300          next unless $line =~ /(?:First|Last)/;
301          if( grep{ $line =~ /[^;]+;<$_\s*,\s*(?:First|Last)>/ }@blocks ){
302             my ($number,$block,$type);
303             ($number,$block) = split /;/, $line;
304             $block =~ s/<|>//g;
305             ($block,$type) = split /, /, $block;
306             my $index = $type eq 'First' ? 0 : 1;
307             $first_last{ $block }->[$index] = hex $number;
308          }
309       }
310    }
311 }
312
313 my @CharinfoRanges = (
314 # block name
315 # [ first, last, coderef to name, coderef to decompose ],
316 # CJK Ideographs Extension A
317   [ @{ $first_last{'CJK Ideograph Extension A'} },        \&han_charname,   undef  ],
318 # CJK Ideographs
319   [ @{ $first_last{'CJK Ideograph'} },                    \&han_charname,   undef  ],
320 # Hangul Syllables
321   [ 0xAC00,   0xD7A3,   $hasHangulUtil ? \&getHangulName : \&hangul_charname,  \&hangul_decomp ],
322 # Non-Private Use High Surrogates
323   [ 0xD800,   0xDB7F,   undef,   undef  ],
324 # Private Use High Surrogates
325   [ 0xDB80,   0xDBFF,   undef,   undef  ],
326 # Low Surrogates
327   [ 0xDC00,   0xDFFF,   undef,   undef  ],
328 # The Private Use Area
329   [ 0xE000,   0xF8FF,   undef,   undef  ],
330 # CJK Ideographs Extension B
331   [ @{ $first_last{'CJK Ideograph Extension B'} },        \&han_charname,   undef  ],
332 # Plane 15 Private Use Area
333   [ 0xF0000,  0xFFFFD,  undef,   undef  ],
334 # Plane 16 Private Use Area
335   [ 0x100000, 0x10FFFD, undef,   undef  ],
336 );
337
338 sub charinfo {
339     my $arg  = shift;
340     my $code = _getcode($arg);
341     croak __PACKAGE__, "::charinfo: unknown code '$arg'"
342         unless defined $code;
343     my $hexk = sprintf("%06X", $code);
344     my($rcode,$rname,$rdec);
345     foreach my $range (@CharinfoRanges){
346       if ($range->[0] <= $code && $code <= $range->[1]) {
347         $rcode = $hexk;
348         $rcode =~ s/^0+//;
349         $rcode =  sprintf("%04X", hex($rcode));
350         $rname = $range->[2] ? $range->[2]->($code) : '';
351         $rdec  = $range->[3] ? $range->[3]->($code) : '';
352         $hexk  = sprintf("%06X", $range->[0]); # replace by the first
353         last;
354       }
355     }
356     openunicode(\$UNICODEFH, "UnicodeData.txt");
357     if (defined $UNICODEFH) {
358         use Search::Dict 1.02;
359         if (look($UNICODEFH, "$hexk;", { xfrm => sub { $_[0] =~ /^([^;]+);(.+)/; sprintf "%06X;$2", hex($1) } } ) >= 0) {
360             my $line = <$UNICODEFH>;
361             return unless defined $line;
362             chomp $line;
363             my %prop;
364             @prop{qw(
365                      code name category
366                      combining bidi decomposition
367                      decimal digit numeric
368                      mirrored unicode10 comment
369                      upper lower title
370                     )} = split(/;/, $line, -1);
371             $hexk =~ s/^0+//;
372             $hexk =  sprintf("%04X", hex($hexk));
373             if ($prop{code} eq $hexk) {
374                 $prop{block}  = charblock($code);
375                 $prop{script} = charscript($code);
376                 if(defined $rname){
377                     $prop{code} = $rcode;
378                     $prop{name} = $rname;
379                     $prop{decomposition} = $rdec;
380                 }
381                 return \%prop;
382             }
383         }
384     }
385     return;
386 }
387
388 sub _search { # Binary search in a [[lo,hi,prop],[...],...] table.
389     my ($table, $lo, $hi, $code) = @_;
390
391     return if $lo > $hi;
392
393     my $mid = int(($lo+$hi) / 2);
394
395     if ($table->[$mid]->[0] < $code) {
396         if ($table->[$mid]->[1] >= $code) {
397             return $table->[$mid]->[2];
398         } else {
399             _search($table, $mid + 1, $hi, $code);
400         }
401     } elsif ($table->[$mid]->[0] > $code) {
402         _search($table, $lo, $mid - 1, $code);
403     } else {
404         return $table->[$mid]->[2];
405     }
406 }
407
408 sub charinrange {
409     my ($range, $arg) = @_;
410     my $code = _getcode($arg);
411     croak __PACKAGE__, "::charinrange: unknown code '$arg'"
412         unless defined $code;
413     _search($range, 0, $#$range, $code);
414 }
415
416 =head2 B<charblock()>
417
418     use Unicode::UCD 'charblock';
419
420     my $charblock = charblock(0x41);
421     my $charblock = charblock(1234);
422     my $charblock = charblock(0x263a);
423     my $charblock = charblock("U+263a");
424
425     my $range     = charblock('Armenian');
426
427 With a L</code point argument> charblock() returns the I<block> the code point
428 belongs to, e.g.  C<Basic Latin>.
429 If the code point is unassigned, this returns the block it would belong to if
430 it were assigned (which it may in future versions of the Unicode Standard).
431
432 See also L</Blocks versus Scripts>.
433
434 If supplied with an argument that can't be a code point, charblock() tries
435 to do the opposite and interpret the argument as a code point block. The
436 return value is a I<range>: an anonymous list of lists that contain
437 I<start-of-range>, I<end-of-range> code point pairs. You can test whether
438 a code point is in a range using the L</charinrange()> function. If the
439 argument is not a known code point block, B<undef> is returned.
440
441 =cut
442
443 my @BLOCKS;
444 my %BLOCKS;
445
446 sub _charblocks {
447     unless (@BLOCKS) {
448         if (openunicode(\$BLOCKSFH, "Blocks.txt")) {
449             local $_;
450             while (<$BLOCKSFH>) {
451                 if (/^([0-9A-F]+)\.\.([0-9A-F]+);\s+(.+)/) {
452                     my ($lo, $hi) = (hex($1), hex($2));
453                     my $subrange = [ $lo, $hi, $3 ];
454                     push @BLOCKS, $subrange;
455                     push @{$BLOCKS{$3}}, $subrange;
456                 }
457             }
458             close($BLOCKSFH);
459         }
460     }
461 }
462
463 sub charblock {
464     my $arg = shift;
465
466     _charblocks() unless @BLOCKS;
467
468     my $code = _getcode($arg);
469
470     if (defined $code) {
471         _search(\@BLOCKS, 0, $#BLOCKS, $code);
472     } else {
473         if (exists $BLOCKS{$arg}) {
474             return dclone $BLOCKS{$arg};
475         } else {
476             return;
477         }
478     }
479 }
480
481 =head2 B<charscript()>
482
483     use Unicode::UCD 'charscript';
484
485     my $charscript = charscript(0x41);
486     my $charscript = charscript(1234);
487     my $charscript = charscript("U+263a");
488
489     my $range      = charscript('Thai');
490
491 With a L</code point argument> charscript() returns the I<script> the
492 code point belongs to, e.g.  C<Latin>, C<Greek>, C<Han>.
493 If the code point is unassigned, it returns B<undef>
494
495 If supplied with an argument that can't be a code point, charscript() tries
496 to do the opposite and interpret the argument as a code point script. The
497 return value is a I<range>: an anonymous list of lists that contain
498 I<start-of-range>, I<end-of-range> code point pairs. You can test whether a
499 code point is in a range using the L</charinrange()> function. If the
500 argument is not a known code point script, B<undef> is returned.
501
502 See also L</Blocks versus Scripts>.
503
504 =cut
505
506 my @SCRIPTS;
507 my %SCRIPTS;
508
509 sub _charscripts {
510     unless (@SCRIPTS) {
511         if (openunicode(\$SCRIPTSFH, "Scripts.txt")) {
512             local $_;
513             while (<$SCRIPTSFH>) {
514                 if (/^([0-9A-F]+)(?:\.\.([0-9A-F]+))?\s+;\s+(\w+)/) {
515                     my ($lo, $hi) = (hex($1), $2 ? hex($2) : hex($1));
516                     my $script = lc($3);
517                     $script =~ s/\b(\w)/uc($1)/ge;
518                     my $subrange = [ $lo, $hi, $script ];
519                     push @SCRIPTS, $subrange;
520                     push @{$SCRIPTS{$script}}, $subrange;
521                 }
522             }
523             close($SCRIPTSFH);
524             @SCRIPTS = sort { $a->[0] <=> $b->[0] } @SCRIPTS;
525         }
526     }
527 }
528
529 sub charscript {
530     my $arg = shift;
531
532     _charscripts() unless @SCRIPTS;
533
534     my $code = _getcode($arg);
535
536     if (defined $code) {
537         _search(\@SCRIPTS, 0, $#SCRIPTS, $code);
538     } else {
539         if (exists $SCRIPTS{$arg}) {
540             return dclone $SCRIPTS{$arg};
541         } else {
542             return;
543         }
544     }
545 }
546
547 =head2 B<charblocks()>
548
549     use Unicode::UCD 'charblocks';
550
551     my $charblocks = charblocks();
552
553 charblocks() returns a reference to a hash with the known block names
554 as the keys, and the code point ranges (see L</charblock()>) as the values.
555
556 See also L</Blocks versus Scripts>.
557
558 =cut
559
560 sub charblocks {
561     _charblocks() unless %BLOCKS;
562     return dclone \%BLOCKS;
563 }
564
565 =head2 B<charscripts()>
566
567     use Unicode::UCD 'charscripts';
568
569     my $charscripts = charscripts();
570
571 charscripts() returns a reference to a hash with the known script
572 names as the keys, and the code point ranges (see L</charscript()>) as
573 the values.
574
575 See also L</Blocks versus Scripts>.
576
577 =cut
578
579 sub charscripts {
580     _charscripts() unless %SCRIPTS;
581     return dclone \%SCRIPTS;
582 }
583
584 =head2 B<charinrange()>
585
586 In addition to using the C<\p{In...}> and C<\P{In...}> constructs, you
587 can also test whether a code point is in the I<range> as returned by
588 L</charblock()> and L</charscript()> or as the values of the hash returned
589 by L</charblocks()> and L</charscripts()> by using charinrange():
590
591     use Unicode::UCD qw(charscript charinrange);
592
593     $range = charscript('Hiragana');
594     print "looks like hiragana\n" if charinrange($range, $codepoint);
595
596 =cut
597
598 my %GENERAL_CATEGORIES =
599  (
600     'L'  =>         'Letter',
601     'LC' =>         'CasedLetter',
602     'Lu' =>         'UppercaseLetter',
603     'Ll' =>         'LowercaseLetter',
604     'Lt' =>         'TitlecaseLetter',
605     'Lm' =>         'ModifierLetter',
606     'Lo' =>         'OtherLetter',
607     'M'  =>         'Mark',
608     'Mn' =>         'NonspacingMark',
609     'Mc' =>         'SpacingMark',
610     'Me' =>         'EnclosingMark',
611     'N'  =>         'Number',
612     'Nd' =>         'DecimalNumber',
613     'Nl' =>         'LetterNumber',
614     'No' =>         'OtherNumber',
615     'P'  =>         'Punctuation',
616     'Pc' =>         'ConnectorPunctuation',
617     'Pd' =>         'DashPunctuation',
618     'Ps' =>         'OpenPunctuation',
619     'Pe' =>         'ClosePunctuation',
620     'Pi' =>         'InitialPunctuation',
621     'Pf' =>         'FinalPunctuation',
622     'Po' =>         'OtherPunctuation',
623     'S'  =>         'Symbol',
624     'Sm' =>         'MathSymbol',
625     'Sc' =>         'CurrencySymbol',
626     'Sk' =>         'ModifierSymbol',
627     'So' =>         'OtherSymbol',
628     'Z'  =>         'Separator',
629     'Zs' =>         'SpaceSeparator',
630     'Zl' =>         'LineSeparator',
631     'Zp' =>         'ParagraphSeparator',
632     'C'  =>         'Other',
633     'Cc' =>         'Control',
634     'Cf' =>         'Format',
635     'Cs' =>         'Surrogate',
636     'Co' =>         'PrivateUse',
637     'Cn' =>         'Unassigned',
638  );
639
640 sub general_categories {
641     return dclone \%GENERAL_CATEGORIES;
642 }
643
644 =head2 B<general_categories()>
645
646     use Unicode::UCD 'general_categories';
647
648     my $categories = general_categories();
649
650 This returns a reference to a hash which has short
651 general category names (such as C<Lu>, C<Nd>, C<Zs>, C<S>) as keys and long
652 names (such as C<UppercaseLetter>, C<DecimalNumber>, C<SpaceSeparator>,
653 C<Symbol>) as values.  The hash is reversible in case you need to go
654 from the long names to the short names.  The general category is the
655 one returned from
656 L</charinfo()> under the C<category> key.
657
658 =cut
659
660 my %BIDI_TYPES =
661  (
662    'L'   => 'Left-to-Right',
663    'LRE' => 'Left-to-Right Embedding',
664    'LRO' => 'Left-to-Right Override',
665    'R'   => 'Right-to-Left',
666    'AL'  => 'Right-to-Left Arabic',
667    'RLE' => 'Right-to-Left Embedding',
668    'RLO' => 'Right-to-Left Override',
669    'PDF' => 'Pop Directional Format',
670    'EN'  => 'European Number',
671    'ES'  => 'European Number Separator',
672    'ET'  => 'European Number Terminator',
673    'AN'  => 'Arabic Number',
674    'CS'  => 'Common Number Separator',
675    'NSM' => 'Non-Spacing Mark',
676    'BN'  => 'Boundary Neutral',
677    'B'   => 'Paragraph Separator',
678    'S'   => 'Segment Separator',
679    'WS'  => 'Whitespace',
680    'ON'  => 'Other Neutrals',
681  ); 
682
683 =head2 B<bidi_types()>
684
685     use Unicode::UCD 'bidi_types';
686
687     my $categories = bidi_types();
688
689 This returns a reference to a hash which has the short
690 bidi (bidirectional) type names (such as C<L>, C<R>) as keys and long
691 names (such as C<Left-to-Right>, C<Right-to-Left>) as values.  The
692 hash is reversible in case you need to go from the long names to the
693 short names.  The bidi type is the one returned from
694 L</charinfo()>
695 under the C<bidi> key.  For the exact meaning of the various bidi classes
696 the Unicode TR9 is recommended reading:
697 L<http://www.unicode.org/reports/tr9/>
698 (as of Unicode 5.0.0)
699
700 =cut
701
702 sub bidi_types {
703     return dclone \%BIDI_TYPES;
704 }
705
706 =head2 B<compexcl()>
707
708     use Unicode::UCD 'compexcl';
709
710     my $compexcl = compexcl(0x09dc);
711
712 This returns B<true> if the
713 L</code point argument> should not be produced by composition normalization,
714 B<AND> if that fact is not otherwise determinable from the Unicode data base.
715 It currently does not return B<true> if the code point has a decomposition
716 consisting of another single code point, nor if its decomposition starts
717 with a code point whose combining class is non-zero.  Code points that meet
718 either of these conditions should also not be produced by composition
719 normalization.
720
721 It returns B<false> otherwise.
722
723 =cut
724
725 my %COMPEXCL;
726
727 sub _compexcl {
728     unless (%COMPEXCL) {
729         if (openunicode(\$COMPEXCLFH, "CompositionExclusions.txt")) {
730             local $_;
731             while (<$COMPEXCLFH>) {
732                 if (/^([0-9A-F]+)\s+\#\s+/) {
733                     my $code = hex($1);
734                     $COMPEXCL{$code} = undef;
735                 }
736             }
737             close($COMPEXCLFH);
738         }
739     }
740 }
741
742 sub compexcl {
743     my $arg  = shift;
744     my $code = _getcode($arg);
745     croak __PACKAGE__, "::compexcl: unknown code '$arg'"
746         unless defined $code;
747
748     _compexcl() unless %COMPEXCL;
749
750     return exists $COMPEXCL{$code};
751 }
752
753 =head2 B<casefold()>
754
755     use Unicode::UCD 'casefold';
756
757     my $casefold = casefold(0xDF);
758     if (defined $casefold) {
759         my @full_fold_hex = split / /, $casefold->{'full'};
760         my $full_fold_string =
761                     join "", map {chr(hex($_))} @full_fold_hex;
762         my @turkic_fold_hex =
763                         split / /, ($casefold->{'turkic'} ne "")
764                                         ? $casefold->{'turkic'}
765                                         : $casefold->{'full'};
766         my $turkic_fold_string =
767                         join "", map {chr(hex($_))} @turkic_fold_hex;
768     }
769     if (defined $casefold && $casefold->{'simple'} ne "") {
770         my $simple_fold_hex = $casefold->{'simple'};
771         my $simple_fold_string = chr(hex($simple_fold_hex));
772     }
773
774 This returns the (almost) locale-independent case folding of the
775 character specified by the L</code point argument>.
776
777 If there is no case folding for that code point, B<undef> is returned.
778
779 If there is a case folding for that code point, a reference to a hash
780 with the following fields is returned:
781
782 =over
783
784 =item B<code>
785
786 the input L</code point argument> expressed in hexadecimal, with leading zeros
787 added if necessary to make it contain at least four hexdigits
788
789 =item B<full>
790
791 one or more codes (separated by spaces) that taken in order give the
792 code points for the case folding for I<code>.
793 Each has at least four hexdigits.
794
795 =item B<simple>
796
797 is empty, or is exactly one code with at least four hexdigits which can be used
798 as an alternative case folding when the calling program cannot cope with the
799 fold being a sequence of multiple code points.  If I<full> is just one code
800 point, then I<simple> equals I<full>.  If there is no single code point folding
801 defined for I<code>, then I<simple> is the empty string.  Otherwise, it is an
802 inferior, but still better-than-nothing alternative folding to I<full>.
803
804 =item B<mapping>
805
806 is the same as I<simple> if I<simple> is not empty, and it is the same as I<full>
807 otherwise.  It can be considered to be the simplest possible folding for
808 I<code>.  It is defined primarily for backwards compatibility.
809
810 =item B<status>
811
812 is C<C> (for C<common>) if the best possible fold is a single code point
813 (I<simple> equals I<full> equals I<mapping>).  It is C<S> if there are distinct
814 folds, I<simple> and I<full> (I<mapping> equals I<simple>).  And it is C<F> if
815 there only a I<full> fold (I<mapping> equals I<full>; I<simple> is empty).  Note
816 that this
817 describes the contents of I<mapping>.  It is defined primarily for backwards
818 compatibility.
819
820 On versions 3.1 and earlier of Unicode, I<status> can also be
821 C<I> which is the same as C<C> but is a special case for dotted uppercase I and
822 dotless lowercase i:
823
824 =over
825
826 =item B<*>
827
828 If you use this C<I> mapping, the result is case-insensitive,
829 but dotless and dotted I's are not distinguished
830
831 =item B<*>
832
833 If you exclude this C<I> mapping, the result is not fully case-insensitive, but
834 dotless and dotted I's are distinguished
835
836 =back
837
838 =item B<turkic>
839
840 contains any special folding for Turkic languages.  For versions of Unicode
841 starting with 3.2, this field is empty unless I<code> has a different folding
842 in Turkic languages, in which case it is one or more codes (separated by
843 spaces) that taken in order give the code points for the case folding for
844 I<code> in those languages.
845 Each code has at least four hexdigits.
846 Note that this folding does not maintain canonical equivalence without
847 additional processing.
848
849 For versions of Unicode 3.1 and earlier, this field is empty unless there is a
850 special folding for Turkic languages, in which case I<status> is C<I>, and
851 I<mapping>, I<full>, I<simple>, and I<turkic> are all equal.  
852
853 =back
854
855 Programs that want complete generality and the best folding results should use
856 the folding contained in the I<full> field.  But note that the fold for some
857 code points will be a sequence of multiple code points.
858
859 Programs that can't cope with the fold mapping being multiple code points can
860 use the folding contained in the I<simple> field, with the loss of some
861 generality.  In Unicode 5.1, about 7% of the defined foldings have no single
862 code point folding.
863
864 The I<mapping> and I<status> fields are provided for backwards compatibility for
865 existing programs.  They contain the same values as in previous versions of
866 this function.
867
868 Locale is not completely independent.  The I<turkic> field contains results to
869 use when the locale is a Turkic language.
870
871 For more information about case mappings see
872 L<http://www.unicode.org/unicode/reports/tr21>
873
874 =cut
875
876 my %CASEFOLD;
877
878 sub _casefold {
879     unless (%CASEFOLD) {
880         if (openunicode(\$CASEFOLDFH, "CaseFolding.txt")) {
881             local $_;
882             while (<$CASEFOLDFH>) {
883                 if (/^([0-9A-F]+); ([CFIST]); ([0-9A-F]+(?: [0-9A-F]+)*);/) {
884                     my $code = hex($1);
885                     $CASEFOLD{$code}{'code'} = $1;
886                     $CASEFOLD{$code}{'turkic'} = "" unless
887                                             defined $CASEFOLD{$code}{'turkic'};
888                     if ($2 eq 'C' || $2 eq 'I') {       # 'I' is only on 3.1 and
889                                                         # earlier Unicodes
890                                                         # Both entries there (I
891                                                         # only checked 3.1) are
892                                                         # the same as C, and
893                                                         # there are no other
894                                                         # entries for those
895                                                         # codepoints, so treat
896                                                         # as if C, but override
897                                                         # the turkic one for
898                                                         # 'I'.
899                         $CASEFOLD{$code}{'status'} = $2;
900                         $CASEFOLD{$code}{'full'} = $CASEFOLD{$code}{'simple'} =
901                         $CASEFOLD{$code}{'mapping'} = $3;
902                         $CASEFOLD{$code}{'turkic'} = $3 if $2 eq 'I';
903                     } elsif ($2 eq 'F') {
904                         $CASEFOLD{$code}{'full'} = $3;
905                         unless (defined $CASEFOLD{$code}{'simple'}) {
906                                 $CASEFOLD{$code}{'simple'} = "";
907                                 $CASEFOLD{$code}{'mapping'} = $3;
908                                 $CASEFOLD{$code}{'status'} = $2;
909                         }
910                     } elsif ($2 eq 'S') {
911
912
913                         # There can't be a simple without a full, and simple
914                         # overrides all but full
915
916                         $CASEFOLD{$code}{'simple'} = $3;
917                         $CASEFOLD{$code}{'mapping'} = $3;
918                         $CASEFOLD{$code}{'status'} = $2;
919                     } elsif ($2 eq 'T') {
920                         $CASEFOLD{$code}{'turkic'} = $3;
921                     } # else can't happen because only [CIFST] are possible
922                 }
923             }
924             close($CASEFOLDFH);
925         }
926     }
927 }
928
929 sub casefold {
930     my $arg  = shift;
931     my $code = _getcode($arg);
932     croak __PACKAGE__, "::casefold: unknown code '$arg'"
933         unless defined $code;
934
935     _casefold() unless %CASEFOLD;
936
937     return $CASEFOLD{$code};
938 }
939
940 =head2 B<casespec()>
941
942     use Unicode::UCD 'casespec';
943
944     my $casespec = casespec(0xFB00);
945
946 This returns the potentially locale-dependent case mappings of the L</code point
947 argument>.  The mappings may be longer than a single code point (which the basic
948 Unicode case mappings as returned by L</charinfo()> never are).
949
950 If there are no case mappings for the L</code point argument>, or if all three
951 possible mappings (I<lower>, I<title> and I<upper>) result in single code
952 points and are locale independent and unconditional, B<undef> is returned
953 (which means that the case mappings, if any, for the code point are those
954 returned by L</charinfo()>).
955
956 Otherwise, a reference to a hash giving the mappings (or a reference to a hash
957 of such hashes, explained below) is returned with the following keys and their
958 meanings:
959
960 The keys in the bottom layer hash with the meanings of their values are:
961
962 =over
963
964 =item B<code>
965
966 the input L</code point argument> expressed in hexadecimal, with leading zeros
967 added if necessary to make it contain at least four hexdigits
968
969 =item B<lower>
970
971 one or more codes (separated by spaces) that taken in order give the
972 code points for the lower case of I<code>.
973 Each has at least four hexdigits.
974
975 =item B<title>
976
977 one or more codes (separated by spaces) that taken in order give the
978 code points for the title case of I<code>.
979 Each has at least four hexdigits.
980
981 =item B<upper>
982
983 one or more codes (separated by spaces) that taken in order give the
984 code points for the upper case of I<code>.
985 Each has at least four hexdigits.
986
987 =item B<condition>
988
989 the conditions for the mappings to be valid.
990 If B<undef>, the mappings are always valid.
991 When defined, this field is a list of conditions,
992 all of which must be true for the mappings to be valid.
993 The list consists of one or more
994 I<locales> (see below)
995 and/or I<contexts> (explained in the next paragraph),
996 separated by spaces.
997 (Other than as used to separate elements, spaces are to be ignored.)
998 Case distinctions in the condition list are not significant.
999 Conditions preceded by "NON_" represent the negation of the condition.
1000
1001 A I<context> is one of those defined in the Unicode standard.
1002 For Unicode 5.1, they are defined in Section 3.13 C<Default Case Operations>
1003 available at
1004 L<http://www.unicode.org/versions/Unicode5.1.0/>.
1005 These are for context-sensitive casing.
1006
1007 =back
1008
1009 The hash described above is returned for locale-independent casing, where
1010 at least one of the mappings has length longer than one.  If B<undef> is 
1011 returned, the code point may have mappings, but if so, all are length one,
1012 and are returned by L</charinfo()>.
1013 Note that when this function does return a value, it will be for the complete
1014 set of mappings for a code point, even those whose length is one.
1015
1016 If there are additional casing rules that apply only in certain locales,
1017 an additional key for each will be defined in the returned hash.  Each such key
1018 will be its locale name, defined as a 2-letter ISO 3166 country code, possibly
1019 followed by a "_" and a 2-letter ISO language code (possibly followed by a "_"
1020 and a variant code).  You can find the lists of all possible locales, see
1021 L<Locale::Country> and L<Locale::Language>.
1022 (In Unicode 5.1, the only locales returned by this function
1023 are C<lt>, C<tr>, and C<az>.)
1024
1025 Each locale key is a reference to a hash that has the form above, and gives
1026 the casing rules for that particular locale, which take precedence over the
1027 locale-independent ones when in that locale.
1028
1029 If the only casing for a code point is locale-dependent, then the returned
1030 hash will not have any of the base keys, like C<code>, C<upper>, etc., but
1031 will contain only locale keys.
1032
1033 For more information about case mappings see
1034 L<http://www.unicode.org/unicode/reports/tr21/>
1035
1036 =cut
1037
1038 my %CASESPEC;
1039
1040 sub _casespec {
1041     unless (%CASESPEC) {
1042         if (openunicode(\$CASESPECFH, "SpecialCasing.txt")) {
1043             local $_;
1044             while (<$CASESPECFH>) {
1045                 if (/^([0-9A-F]+); ([0-9A-F]+(?: [0-9A-F]+)*)?; ([0-9A-F]+(?: [0-9A-F]+)*)?; ([0-9A-F]+(?: [0-9A-F]+)*)?; (\w+(?: \w+)*)?/) {
1046                     my ($hexcode, $lower, $title, $upper, $condition) =
1047                         ($1, $2, $3, $4, $5);
1048                     my $code = hex($hexcode);
1049                     if (exists $CASESPEC{$code}) {
1050                         if (exists $CASESPEC{$code}->{code}) {
1051                             my ($oldlower,
1052                                 $oldtitle,
1053                                 $oldupper,
1054                                 $oldcondition) =
1055                                     @{$CASESPEC{$code}}{qw(lower
1056                                                            title
1057                                                            upper
1058                                                            condition)};
1059                             if (defined $oldcondition) {
1060                                 my ($oldlocale) =
1061                                 ($oldcondition =~ /^([a-z][a-z](?:_\S+)?)/);
1062                                 delete $CASESPEC{$code};
1063                                 $CASESPEC{$code}->{$oldlocale} =
1064                                 { code      => $hexcode,
1065                                   lower     => $oldlower,
1066                                   title     => $oldtitle,
1067                                   upper     => $oldupper,
1068                                   condition => $oldcondition };
1069                             }
1070                         }
1071                         my ($locale) =
1072                             ($condition =~ /^([a-z][a-z](?:_\S+)?)/);
1073                         $CASESPEC{$code}->{$locale} =
1074                         { code      => $hexcode,
1075                           lower     => $lower,
1076                           title     => $title,
1077                           upper     => $upper,
1078                           condition => $condition };
1079                     } else {
1080                         $CASESPEC{$code} =
1081                         { code      => $hexcode,
1082                           lower     => $lower,
1083                           title     => $title,
1084                           upper     => $upper,
1085                           condition => $condition };
1086                     }
1087                 }
1088             }
1089             close($CASESPECFH);
1090         }
1091     }
1092 }
1093
1094 sub casespec {
1095     my $arg  = shift;
1096     my $code = _getcode($arg);
1097     croak __PACKAGE__, "::casespec: unknown code '$arg'"
1098         unless defined $code;
1099
1100     _casespec() unless %CASESPEC;
1101
1102     return ref $CASESPEC{$code} ? dclone $CASESPEC{$code} : $CASESPEC{$code};
1103 }
1104
1105 =head2 B<namedseq()>
1106
1107     use Unicode::UCD 'namedseq';
1108
1109     my $namedseq = namedseq("KATAKANA LETTER AINU P");
1110     my @namedseq = namedseq("KATAKANA LETTER AINU P");
1111     my %namedseq = namedseq();
1112
1113 If used with a single argument in a scalar context, returns the string
1114 consisting of the code points of the named sequence, or B<undef> if no
1115 named sequence by that name exists.  If used with a single argument in
1116 a list context, it returns the list of the ordinals of the code points.  If used
1117 with no
1118 arguments in a list context, returns a hash with the names of the
1119 named sequences as the keys and the named sequences as strings as
1120 the values.  Otherwise, it returns B<undef> or an empty list depending
1121 on the context.
1122
1123 This function only operates on officially approved (not provisional) named
1124 sequences.
1125
1126 =cut
1127
1128 my %NAMEDSEQ;
1129
1130 sub _namedseq {
1131     unless (%NAMEDSEQ) {
1132         if (openunicode(\$NAMEDSEQFH, "NamedSequences.txt")) {
1133             local $_;
1134             while (<$NAMEDSEQFH>) {
1135                 if (/^(.+)\s*;\s*([0-9A-F]+(?: [0-9A-F]+)*)$/) {
1136                     my ($n, $s) = ($1, $2);
1137                     my @s = map { chr(hex($_)) } split(' ', $s);
1138                     $NAMEDSEQ{$n} = join("", @s);
1139                 }
1140             }
1141             close($NAMEDSEQFH);
1142         }
1143     }
1144 }
1145
1146 sub namedseq {
1147     _namedseq() unless %NAMEDSEQ;
1148     my $wantarray = wantarray();
1149     if (defined $wantarray) {
1150         if ($wantarray) {
1151             if (@_ == 0) {
1152                 return %NAMEDSEQ;
1153             } elsif (@_ == 1) {
1154                 my $s = $NAMEDSEQ{ $_[0] };
1155                 return defined $s ? map { ord($_) } split('', $s) : ();
1156             }
1157         } elsif (@_ == 1) {
1158             return $NAMEDSEQ{ $_[0] };
1159         }
1160     }
1161     return;
1162 }
1163
1164 =head2 Unicode::UCD::UnicodeVersion
1165
1166 This returns the version of the Unicode Character Database, in other words, the
1167 version of the Unicode standard the database implements.  The version is a
1168 string of numbers delimited by dots (C<'.'>).
1169
1170 =cut
1171
1172 my $UNICODEVERSION;
1173
1174 sub UnicodeVersion {
1175     unless (defined $UNICODEVERSION) {
1176         openunicode(\$VERSIONFH, "version");
1177         chomp($UNICODEVERSION = <$VERSIONFH>);
1178         close($VERSIONFH);
1179         croak __PACKAGE__, "::VERSION: strange version '$UNICODEVERSION'"
1180             unless $UNICODEVERSION =~ /^\d+(?:\.\d+)+$/;
1181     }
1182     return $UNICODEVERSION;
1183 }
1184
1185 =head2 B<Blocks versus Scripts>
1186
1187 The difference between a block and a script is that scripts are closer
1188 to the linguistic notion of a set of code points required to present
1189 languages, while block is more of an artifact of the Unicode code point
1190 numbering and separation into blocks of (mostly) 256 code points.
1191
1192 For example the Latin B<script> is spread over several B<blocks>, such
1193 as C<Basic Latin>, C<Latin 1 Supplement>, C<Latin Extended-A>, and
1194 C<Latin Extended-B>.  On the other hand, the Latin script does not
1195 contain all the characters of the C<Basic Latin> block (also known as
1196 ASCII): it includes only the letters, and not, for example, the digits
1197 or the punctuation.
1198
1199 For blocks see L<http://www.unicode.org/Public/UNIDATA/Blocks.txt>
1200
1201 For scripts see UTR #24: L<http://www.unicode.org/unicode/reports/tr24/>
1202
1203 =head2 B<Matching Scripts and Blocks>
1204
1205 Scripts are matched with the regular-expression construct
1206 C<\p{...}> (e.g. C<\p{Tibetan}> matches characters of the Tibetan script),
1207 while C<\p{In...}> is used for blocks (e.g. C<\p{InTibetan}> matches
1208 any of the 256 code points in the Tibetan block).
1209
1210
1211 =head2 Implementation Note
1212
1213 The first use of charinfo() opens a read-only filehandle to the Unicode
1214 Character Database (the database is included in the Perl distribution).
1215 The filehandle is then kept open for further queries.  In other words,
1216 if you are wondering where one of your filehandles went, that's where.
1217
1218 =head1 BUGS
1219
1220 Does not yet support EBCDIC platforms.
1221
1222 L</compexcl()> should give a complete list of excluded code points.
1223
1224 =head1 AUTHOR
1225
1226 Jarkko Hietaniemi
1227
1228 =cut
1229
1230 1;