File Coverage

blib/lib/Font/TTF/Name.pm
Criterion Covered Total %
statement 84 199 42.2
branch 16 82 19.5
condition 17 77 22.0
subroutine 9 20 45.0
pod 13 13 100.0
total 139 391 35.5


line stmt bran cond sub pod time code
1             package Font::TTF::Name;
2              
3             =head1 NAME
4              
5             Font::TTF::Name - String table for a TTF font
6              
7             =head1 DESCRIPTION
8              
9             Strings are held by number, platform, encoding and language. Strings are
10             accessed as:
11              
12             $f->{'name'}{'strings'}[$number][$platform_id][$encoding_id]{$language_id}
13              
14             Notice that the language is held in an associative array due to its sparse
15             nature on some platforms such as Microsoft ($pid = 3). Notice also that the
16             array order is different from the stored array order (platform, encoding,
17             language, number) to allow for easy manipulation of strings by number (which is
18             what I guess most people will want to do).
19              
20             By default, C<$Font::TTF::Name::utf8> is set to 1, and strings will be stored as UTF8 wherever
21             possible. The method C can be used to find out if a string in a particular
22             platform and encoding will be returned as UTF8. Unicode strings are always
23             converted if utf8 is requested. Otherwise, strings are stored according to platform:
24              
25             You now have to set <$Font::TTF::Name::utf8> to 0 to get the old behaviour.
26              
27             =over 4
28              
29             =item Apple Unicode (platform id = 0)
30              
31             Data is stored as network ordered UCS2. There is no encoding id for this platform
32             but there are language ids as per Mac language ids.
33              
34             =item Mac (platform id = 1)
35              
36             Data is stored as 8-bit binary data, leaving the interpretation to the user
37             according to encoding id.
38              
39             =item Unicode (platform id = 2)
40              
41             Currently stored as 16-bit network ordered UCS2. Upon release of Perl 5.005 this
42             will change to utf8 assuming current UCS2 semantics for all encoding ids.
43              
44             =item Windows (platform id = 3)
45              
46             As per Unicode, the data is currently stored as 16-bit network ordered UCS2. Upon
47             release of Perl 5.005 this will change to utf8 assuming current UCS2 semantics for
48             all encoding ids.
49              
50             =back
51              
52             =head1 INSTANCE VARIABLES
53              
54             =over 4
55              
56             =item strings
57              
58             An array of arrays, etc.
59              
60             =back
61              
62             =head1 METHODS
63              
64             =cut
65              
66 1     1   4 use strict;
  1         2  
  1         35  
67 1     1   4 use vars qw(@ISA $VERSION @apple_encs @apple_encodings $utf8 $cp_1252 @cp_1252 %win_langs %langs_win %langs_mac @ms_langids @mac_langs);
  1         1  
  1         102  
68 1     1   5 use Font::TTF::Table;
  1         1  
  1         13  
69 1     1   5 use Font::TTF::Utils;
  1         1  
  1         433  
70             @ISA = qw(Font::TTF::Table);
71              
72             $utf8 = 1;
73              
74             {
75             my ($count, $i);
76             eval {require Compress::Zlib;};
77             unless ($@)
78             {
79             for ($i = 0; $i <= $#apple_encs; $i++)
80             {
81             $apple_encodings[0][$i] = [unpack("n*", Compress::Zlib::uncompress(unpack("u", $apple_encs[$i])))]
82             if (defined $apple_encs[$i]);
83             foreach (0 .. 127)
84             { $apple_encodings[0][$i][$_] = $_; }
85             $count = 0;
86             $apple_encodings[1][$i] = {map {$_ => $count++} @{$apple_encodings[0][$i]}};
87             }
88             $cp_1252[0] = [unpack("n*", Compress::Zlib::uncompress(unpack("u", $cp_1252)))];
89             $count = 0;
90             $cp_1252[1] = {map({$_ => $count++} @{$cp_1252[0]})};
91             }
92             for ($i = 0; $i < $#ms_langids; $i++)
93             {
94             if (defined $ms_langids[$i][1])
95             {
96             my ($j);
97             for ($j = 0; $j < $#{$ms_langids[$i][1]}; $j++)
98             {
99             my ($v) = $ms_langids[$i][1][$j];
100             if ($v =~ m/^-/o)
101             { $win_langs{(($j + 1) << 10) + $i} = $ms_langids[$i][0] . $v; }
102             else
103             { $win_langs{(($j + 1) << 10) + $i} = $v; }
104             }
105             }
106             else
107             { $win_langs{$i + 0x400} = $ms_langids[$i][0]; }
108             }
109             %langs_win = map {my ($t) = $win_langs{$_}; my (@res) = ($t => $_); push (@res, $t => $_) if ($t =~ s/-.*$//o && ($_ & 0xFC00) == 0x400); @res} keys %win_langs;
110             $i = 0;
111             %langs_mac = map {$_ => $i++} @mac_langs;
112             }
113            
114              
115             $VERSION = 1.1; # MJPH 17-JUN-2000 Add utf8 support
116             # $VERSION = 1.001; # MJPH 10-AUG-1998 Put $number first in list
117              
118             =head2 $t->read
119              
120             Reads all the names into memory
121              
122             =cut
123              
124             sub read
125             {
126 2     2 1 13 my ($self) = @_;
127 2 50       14 $self->SUPER::read or return $self;
128              
129 2         6 my ($fh) = $self->{' INFILE'};
130 2         3 my ($dat, $num, $stroff, $i, $pid, $eid, $lid, $nid, $len, $off, $here);
131              
132 2         7 $fh->read($dat, 6);
133 2         34 ($num, $stroff) = unpack("x2nn", $dat);
134 2         15 for ($i = 0; $i < $num; $i++)
135             {
136 1     1   5 use bytes; # hack to fix bugs in 5.8.7
  1         1  
  1         7  
137 122         1777 read($fh, $dat, 12);
138 122         937 ($pid, $eid, $lid, $nid, $len, $off) = unpack("n6", $dat);
139 122         333 $here = $fh->tell();
140 122         847 $fh->seek($self->{' OFFSET'} + $stroff + $off, 0);
141 122         1015 $fh->read($dat, $len);
142 122 50       1236 if ($utf8)
143             {
144 122 100 66     881 if ($pid == 1 && defined $apple_encodings[0][$eid])
    50 33        
    50 33        
      33        
      0        
      33        
145 32         518 { $dat = TTF_word_utf8(pack("n*", map({$apple_encodings[0][$eid][$_]} unpack("C*", $dat)))); }
  9786         11247  
146             elsif ($pid == 2 && $eid == 2 && @cp_1252)
147 0         0 { $dat = TTF_word_utf8(pack("n*", map({$cp_1252[0][$_]} unpack("C*", $dat)))); }
  0         0  
148             elsif ($pid == 0 || $pid == 3 || ($pid == 2 && $eid == 1))
149 90         216 { $dat = TTF_word_utf8($dat); }
150             }
151 122         990 $self->{'strings'}[$nid][$pid][$eid]{$lid} = $dat;
152 122         307 $fh->seek($here, 0);
153             }
154 2         35 $self;
155             }
156              
157              
158             =head2 $t->out($fh)
159              
160             Writes out all the strings
161              
162             =cut
163              
164             sub out
165             {
166 2     2 1 4 my ($self, $fh) = @_;
167 2         3 my ($pid, $eid, $lid, $nid, $todo, @todo);
168 0         0 my ($len, $loc, $stroff, $endloc, $str_trans);
169 0         0 my (%dedup, @strings, @offsets, $strcount);
170              
171 2 50       6 return $self->SUPER::out($fh) unless $self->{' read'};
172              
173 2         4 $strcount = 0;
174 2         5 $offsets[0] = 0;
175 2         7 $loc = $fh->tell();
176 2         15 $fh->print(pack("n3", 0, 0, 0));
177 2         12 foreach $nid (0 .. $#{$self->{'strings'}})
  2         10  
178             {
179 4156         3161 foreach $pid (0 .. $#{$self->{'strings'}[$nid]})
  4156         7154  
180             {
181 364         277 foreach $eid (0 .. $#{$self->{'strings'}[$nid][$pid]})
  364         812  
182             {
183 212         153 foreach $lid (sort keys %{$self->{'strings'}[$nid][$pid][$eid]})
  212         669  
184             {
185 122         193 $str_trans = $self->{'strings'}[$nid][$pid][$eid]{$lid};
186 122 50       201 if ($utf8)
187             {
188 122 100 66     929 if ($pid == 1 && defined $apple_encodings[1][$eid])
    50 33        
    50 33        
    50 33        
      33        
      0        
      33        
189 9786 50       21244 { $str_trans = pack("C*",
190 32         77 map({$apple_encodings[1][$eid]{$_} || 0x3F} unpack("n*",
191             TTF_utf8_word($str_trans)))); }
192             elsif ($pid == 2 && $eid == 2 && @cp_1252)
193 0 0       0 { $str_trans = pack("C*",
194 0         0 map({$cp_1252[1][$eid]{$_} || 0x3F} unpack("n*",
195             TTF_utf8_word($str_trans)))); }
196             elsif ($pid == 2 && $eid == 0)
197 0         0 { $str_trans =~ s/[\xc0-\xff][\x80-\xbf]+/?/og; }
198             elsif ($pid == 0 || $pid == 3 || ($pid == 2 && $eid == 1))
199 90         208 { $str_trans = TTF_utf8_word($str_trans); }
200             }
201 122         1360 my ($str_ind);
202 122 100       355 unless (defined $dedup{$str_trans})
203             {
204 1     1   431 use bytes;
  1         1  
  1         5  
205 112         408 $dedup{$str_trans} = $strcount;
206 112         353 $strings[$strcount] = $str_trans;
207 112         97 $strcount++;
208 112         282 $offsets[$strcount] = $offsets[$strcount-1] + bytes::length($str_trans);
209             }
210 122         1194 $str_ind = $dedup{$str_trans};
211 122         539 push (@todo, [$pid, $eid, $lid, $nid, $str_ind]);
212             }
213             }
214             }
215             }
216              
217 2 0 66     18 @todo = (sort {$a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2]
  288   66     1123  
218             || $a->[3] <=> $b->[3]} @todo);
219 2         5 foreach $todo (@todo)
220 122         488 { $fh->print(pack("n6", @{$todo}[0..3], $offsets[$todo->[4]+1] - $offsets[$todo->[4]], $offsets[$todo->[4]])); }
  122         383  
221            
222 2         21 $stroff = $fh->tell() - $loc;
223 2         19 foreach my $str (@strings)
224 112         564 { $fh->print($str); }
225              
226 2         15 $endloc = $fh->tell();
227 2         15 $fh->seek($loc, 0);
228 2         65 $fh->print(pack("n3", 0, $#todo + 1, $stroff));
229 2         11 $fh->seek($endloc, 0);
230 2         77 $self;
231             }
232              
233              
234             =head2 $t->XML_element($context, $depth, $key, $value)
235              
236             Outputs the string element in nice XML (which is all the table really!)
237              
238             =cut
239              
240             sub XML_element
241             {
242 0     0 1   my ($self) = shift;
243 0           my ($context, $depth, $key, $value) = @_;
244 0           my ($fh) = $context->{'fh'};
245 0           my ($nid, $pid, $eid, $lid);
246              
247 0 0         return $self->SUPER::XML_element(@_) unless ($key eq 'strings');
248              
249 0           foreach $nid (0 .. $#{$self->{'strings'}})
  0            
250             {
251 0 0         next unless ref($self->{'strings'}[$nid]);
252             # $fh->print("$depth\n");
253 0           foreach $pid (0 .. $#{$self->{'strings'}[$nid]})
  0            
254             {
255 0           foreach $eid (0 .. $#{$self->{'strings'}[$nid][$pid]})
  0            
256             {
257 0           foreach $lid (sort {$a <=> $b} keys %{$self->{'strings'}[$nid][$pid][$eid]})
  0            
  0            
258             {
259 0   0       my ($lang) = $self->get_lang($pid, $lid) || $lid;
260 0           $fh->printf("%s\n%s%s%s\n%s\n",
261             $depth, $nid, $pid, $eid, $lang, $depth,
262             $context->{'indent'}, $self->{'strings'}[$nid][$pid][$eid]{$lid}, $depth);
263             }
264             }
265             }
266             # $fh->print("$depth\n");
267             }
268 0           $self;
269             }
270              
271              
272             =head2 $t->XML_end($context, $tag, %attrs)
273              
274             Store strings in the right place
275              
276             =cut
277              
278             sub XML_end
279             {
280 0     0 1   my ($self) = shift;
281 0           my ($context, $tag, %attrs) = @_;
282              
283 0 0         if ($tag eq 'string')
284             {
285 0   0       my ($lid) = $self->find_name($attrs{'platform'}, $attrs{'language'}) || $attrs{'language'};
286 0           $self->{'strings'}[$attrs{'id'}][$attrs{'platform'}][$attrs{'encoding'}]{$lid}
287             = $context->{'text'};
288 0           return $context;
289             }
290             else
291 0           { return $self->SUPER::XML_end(@_); }
292             }
293              
294             =head2 $t->minsize()
295              
296             Returns the minimum size this table can be. If it is smaller than this, then the table
297             must be bad and should be deleted or whatever.
298              
299             =cut
300              
301             sub minsize
302             {
303 0     0 1   return 6;
304             }
305              
306             =head2 is_utf8($pid, $eid)
307              
308             Returns whether a string of a given platform and encoding is going to be in UTF8
309              
310             =cut
311              
312             sub is_utf8
313             {
314 0     0 1   my ($self, $pid, $eid) = @_;
315              
316 0   0       return ($utf8 && ($pid == 0 || $pid == 3 || ($pid == 2 && ($eid != 2 || @cp_1252))
317             || ($pid == 1 && defined $apple_encodings[$eid])));
318             }
319              
320              
321             =head2 find_name($nid)
322              
323             Hunts down a name in all the standard places and returns the string and for an
324             array context the pid, eid & lid as well
325              
326             =cut
327              
328             sub find_name
329             {
330 0     0 1   my ($self, $nid) = @_;
331 0           my ($res, $pid, $eid, $lid, $look, $k);
332              
333 0           my (@lookup) = ([3, 1, 1033], [3, 1, -1], [3, 0, 1033], [3, 0, -1], [2, 1, -1], [2, 2, -1], [2, 0, -1],
334             [0, 0, 0], [1, 0, 0]);
335 0           foreach $look (@lookup)
336             {
337 0           ($pid, $eid, $lid) = @$look;
338 0 0         if ($lid == -1)
339             {
340 0           foreach $k (keys %{$self->{'strings'}[$nid][$pid][$eid]})
  0            
341             {
342 0 0         if (($res = $self->{strings}[$nid][$pid][$eid]{$k}) ne '')
343             {
344 0           $lid = $k;
345 0           last;
346             }
347             }
348             } else
349 0           { $res = $self->{strings}[$nid][$pid][$eid]{$lid} }
350 0 0         if ($res ne '')
351 0 0         { return wantarray ? ($res, $pid, $eid, $lid) : $res; }
352             }
353 0           return '';
354             }
355              
356              
357             =head2 remove_name($nid)
358              
359             Removes all strings with the given name id from the table.
360              
361             =cut
362              
363             sub remove_name
364             {
365 0     0 1   my ($self, $nid) = @_;
366              
367 0           delete $self->{'strings'}[$nid];
368             }
369              
370             =head2 set_name($nid, $str[, $lang[, @cover]])
371              
372             Sets the given name id string to $str for all platforms and encodings that
373             this module can handle. If $lang is set, it is interpretted as a language
374             tag and if the particular language of a string is found to match, then
375             that string is changed, otherwise no change occurs.
376              
377             If supplied, @cover should be a list of references to two-element arrays
378             containing pid,eid pairs that should be added to the name table if not already present.
379              
380             This function does not add any names to the table unless @cover is supplied.
381              
382             =cut
383              
384             sub set_name
385             {
386 0     0 1   my ($self, $nid, $str, $lang, @cover) = @_;
387 0           my ($pid, $eid, $lid, $c);
388              
389 0           foreach $pid (0 .. $#{$self->{'strings'}[$nid]})
  0            
390             {
391 0           my $strNL = $str;
392 0 0         $strNL =~ s/(?:\r?)\n/\r\n/og if $pid == 3;
393 0 0         $strNL =~ s/(?:\r?)\n/\r/og if $pid == 1;
394 0           foreach $eid (0 .. $#{$self->{'strings'}[$nid][$pid]})
  0            
395             {
396 0 0         if (defined $self->{'strings'}[$nid][$pid][$eid])
397             {
398 0           my ($isincover) = 0;
399 0           foreach $c (@cover)
400             {
401 0 0 0       if ($c->[0] == $pid && $c->[1] == $eid)
402             {
403 0           $isincover = 1;
404 0           last;
405             }
406             }
407 0 0         push(@cover, [$pid, $eid]) if (!$isincover);
408             }
409 0           foreach $lid (keys %{$self->{'strings'}[$nid][$pid][$eid]})
  0            
410             {
411 0 0 0       next unless (!defined $lang || $self->match_lang($pid, $lid, $lang));
412 0           $self->{'strings'}[$nid][$pid][$eid]{$lid} = $strNL;
413 0           foreach $c (0 .. $#cover)
414             {
415 0 0 0       next unless (defined $cover[$c] && $cover[$c][0] == $pid && $cover[$c][1] == $eid);
      0        
416 0           delete $cover[$c];
417 0           last;
418             }
419             }
420             }
421             }
422 0           foreach $c (@cover)
423             {
424 0 0 0       next unless (defined $c && scalar @$c);
425 0           my ($pid, $eid) = @{$c};
  0            
426 0           my ($lid) = $self->find_lang($pid, $lang);
427 0           my $strNL = $str;
428 0 0         $strNL =~ s/\n/\r\n/og if $pid == 3;
429 0 0         $strNL =~ s/\n/\r/og if $pid == 1;
430 0           $self->{'strings'}[$nid][$pid][$eid]{$lid} = $strNL;
431             }
432 0           return $self;
433             }
434              
435             =head2 Font::TTF::Name->match_lang($pid, $lid, $lang)
436              
437             Compares the language associated to the string of given platform and language
438             with the given language tag. If the language matches the tag (i.e. is equal
439             or more defined than the given language tag) returns true. This is calculated
440             by finding whether the associated language tag starts with the given language
441             tag.
442              
443             =cut
444              
445             sub match_lang
446             {
447 0     0 1   my ($self, $pid, $lid, $lang) = @_;
448 0           my ($langid) = $self->get_lang($pid, $lid);
449              
450 0 0         return 1 if ($pid == 0); # all languages are equal in unicode since nothing defined
451 0 0 0       return ($lid == $lang) if ($lang != 0 || $lang eq '0');
452 0   0       return !index(lc($langid), lc($lang)) || !index(lc($lang), lc($langid));
453             }
454              
455             =head2 Font::TTF::Name->get_lang($pid, $lid)
456              
457             Returns the language tag associated with a particular platform and language id
458              
459             =cut
460              
461             sub get_lang
462             {
463 0     0 1   my ($self, $pid, $lid) = @_;
464              
465 0 0         if ($pid == 3)
    0          
466 0           { return $win_langs{$lid}; }
467             elsif ($pid == 1)
468 0           { return $mac_langs[$lid]; }
469 0           return '';
470             }
471              
472              
473             =head2 Font::TTF::Name->find_lang($pid, $lang)
474              
475             Looks up the language name and returns a lang id if one exists
476              
477             =cut
478              
479             sub find_lang
480             {
481 0     0 1   my ($self, $pid, $lang) = @_;
482              
483 0 0         if ($pid == 3)
    0          
484 0           { return $langs_win{$lang}; }
485             elsif ($pid == 1)
486 0           { return $langs_mac{$lang}; }
487 0           return undef;
488             }
489              
490             =head2 Font::TTF::Name->pe_list()
491              
492             Returns an array of references to two-element arrays
493             containing pid,eid pairs that already exist in this name table.
494             Useful for creating @cover parameter to set_name().
495              
496             =cut
497              
498             sub pe_list
499             {
500 0     0 1   my ($self) = @_;
501 0           my (@cover, %ids);
502              
503 0           foreach my $nid (0 .. $#{$self->{'strings'}})
  0            
504             {
505 0 0         if (defined $self->{'strings'}[$nid])
506             {
507 0           foreach my $pid (0 .. $#{$self->{'strings'}[$nid]})
  0            
508             {
509 0 0         if (defined $self->{'strings'}[$nid][$pid])
510             {
511 0           foreach my $eid (0 .. $#{$self->{'strings'}[$nid][$pid]})
  0            
512             {
513 0 0 0       if (defined $self->{'strings'}[$nid][$pid][$eid] && !$ids{$pid}{$eid})
514             {
515 0           $ids{$pid}{$eid} = 1;
516 0           push @cover, [$pid, $eid];
517             }
518             }
519             }
520             }
521             }
522             }
523 0           return @cover;
524             }
525              
526              
527             BEGIN {
528 1     1   2112 @apple_encs = (
529             <<'EOT',
530             M>)RES==NCW$`@.'G_S5Q*L(!#?+K1VO4:.W6IJA-:\^BM?>L>1&NP(A0Q$BL
531             M<*!62ZV8Z1)[K]BE$MR#O,=/7OW]7T&*6"NMI4K31EOMM)>N@XXZZ2Q#IBZZ
532             MZJ:['GKJ)4NVWOKHJ]\_/\!`@PR68XBAALDUW`@CC3+:&&.-,UZ>?!-,-,ED
533             M4TPUS70SS#3+;`7FF&N>0D7F6V"A119;8JEEEEMAI5566V.M==;;H-A&FVRV
534             MQ5;;_OTONJ3<%;?<5^NQ1YYXYJGG7GKME3?>>N^=#S[ZY(O/OOKNFU]^JO<[
535             M!$?LLMO>$#OAH4-*4F+'[(L+E*F,6SH:%\9%]C@>1W&CN&%2:9QNO]-))5ZH
536             M<]9.!^/DQ/8X-V[@@#,AS0ZE+KB7R$ODA\:A26@>6H2FH9D?J17^)(I#3C@8
537             MLD)V?:(^"BE.AN30,F0XK\(Y5UUVW0TW77/'W;H_;JM6HRJ1&95%M0Y'E5%5
538             .5.U4]""JB`?E$`
539             EOT
540              
541             undef,
542             undef,
543             undef,
544             <<'EOT',
545             M>)RES[=/%```1O$WO8G_@$'J';W70Z2WHS>5WJN%8D6%D;BZ,3*P,;#C2D(8
546             M,9&)08V)+4*(1((X2'(#[.:;7[[\*./_%D,L<<230"(!@B213`JII)%.!IED
547             MD4T.N>213P&%%%%,B!)N4LJMR[Z<"BJIHIH::JFCG@;"--)$,RVTTD8['732
548             M13>WN<-=>NBECWX&&&2(848898QQ)IADBFEFF.4>]WG`0^:89X%%'O&8)SSE
549             M&<]9X@4O><4R*Y?_.ZRSRQ[[''#(1S[PB<]NL\D7OO&5[_S@9TR`(XXYX1=O
550             M.>4W9_SAG`O^7OF=O>XW*N)WV!%''7/<"2>=
551             MT"2333'5--/-,-,LL\TQUSSS+;#0(HL-7?DMM\)*JZRVQEKKK+?!L(TVV6R+
552             9K;;9;HS?<\K5O(G[7?/Y>'```
553             EOT
554              
555             <<'EOT',
556             M>)RED$LSEW$`A9_-^00L,H-^(=>4Y%^2J'1Q*Y+[I2(BHA`B?!%J6EM1*28S
557             M;9II[/PI*7*_%TUN\_*VZ%W:FN9LSYEGGD,\_Q?#$?SP)X"C!!)$,"&$$L8Q
558             MPCG."2(X222GB,+%:XR"42N,P5KG*-1))()H54KG.#
559             M--*Y20:WR"2+;'+()8]\"BBDB-O$PM
560             M==3SA`8::>(IS;3PC%;::'?X'^W#?&(0-Z-,,,,TL\PSQP)+K+#,*C]9XQ?K
561             M_.8/FVRPQ0[;[+&+S=_]_J;KX/Y6I?&U.JQ.Z[GU0@-VBNTR@;Q4G]ZI5V_U
562             MQG@83^-M?,PAXV6'VF'ZH&Z]4H_>J]]IO=:0W!K6B#[KBT;U56/ZIN\:UX1^
563             ?:%)3FM:,9C6G>2UH44M:UHI6'?
564             EOT
565              
566             <<'EOT',
567             M>)RES5=OSG$`0.$CYR.(A(3DUS]J4WOO59O6;&F+UMY[7R&(V'N^4ETZ=*"J
568             M:M:H=>E*0D1B)7HC1KC0[R#G^LEA,/]7((Z(EK2B-?&TH2WM:$\'.M*)SG0A
569             M@:YTHSL]Z$DO>M.'OO2C/P,8R*`&/X2A#&,X(QC)*$:3R!C&,H[Q3&`BDYC,
570             M%))(9BK3F,X,9C*+%%*9S1S22">#N
571             M6,LZUK.!C6QB,UO8RC:VLZ/A7TL5Y=11P6O>N(MWO.>#.\GG(Y_YQ!>^DAT7
572             M\8WZ$%$3$OC.#W(IYC=_^!N"1SWF*<]ZP1AO*:'`;*^0%V502J6'*8LRHRQR
573             M/.)Q3WC2TY[QG+D6FF^!19ZGR(M>BA*]3"'5(9Z8.>:YVSV-DD/CT"0T#RU"
574             MT]",G^YUG_L]8+$E7O6%!WUIF>4^]9K7?6R%E59YQUM6>]L:[WK/5][WH;7>
575             4M,X'/O&1-WSF_\`
576             EOT
577              
578             <<'EOT',
579             M>)RERT=.%5``0-&+7K'&!B(@X/L/^/3>ZZ?SZ=*K@`KVWOL:U!68.#!&8G2@
580             M$Q?F5/=@SOB0XO\$$D2**:&4)&644T$E55130RUUU--`(TTTTT(K;;3302==
581             M=--#[[_?1S\###+$,".,DF:,<2:89(II9KC`+'/,L\`B2RRSPBIKK+/!13;9
582             M8IM+7.8*.^QRE6M]SG`0]YQ&.>\)1G/.<%+WG%:][PEI0G
583             M/>5IL\SVC#F>-=<\\SUG@846>=Y@PFBQ)9::M,QR*ZRTRFIKK+4N!+[[CD]\
584             M#I%?9O*-+XGH/N?BMON=CT7\B#MQUR5^^MY#ZH('7?:PJQYQS14/L!?S,S[$
585             M=,SD*[]#DH\>==UC;K@8LD)V*`B%(3?D\2<4>=Q-3[B5R#'#66>LM\%&FVRV
586             GQ5;;;+?#3KOLML=>4_;9[X"##CGLB*.F'7/<"2>=
587             EOT
588              
589             undef,
590             <<'EOT',
591             M>)RED-DVUG$`1;=:U*Y%0C)5O^^/SSS/F>>9#"$JE7D>"D6\3S=>Q^MPU^JF
592             M&^M"2JJHIH9:ZJBG@4:::*:%M[32
593             M1CL==_TNNNFAES[Z&6"0(889890QQIE@DG=,,
594             MY@M?^<8*JZRQS@:;;+'-#KOLL<\!AQQQS'=^<,(I9_SD%^=<\)M+KN[X-U%:
595             M2`\9(2MDAWB(^,-U+/KKYYJ'_W_`!!_XT$23?.1C]8E/3?&9J2:;9KH9/O>%
596             MF;XTRVQSS#7/5[[VC<&8D?D66&C<(HLML=0RRZVPTBJ7K;;&6NNLM\%&FVRV
597             L):388:===MMCKP,..F2_(XXZYK#CMKGZS[YU-]QTRVUWW'7/?0]N`4(?0WT`
598             EOT
599              
600             <<'EOT',
601             M>)RED,5.0U$415=(D.X!$"ANMX^VN+M#D>+N[H4"Q5W^APF_PZ\PY.9-"`-&
602             MY.3LG>-"#_\3@P^'8OP$"%)"*6644T$E55130RUUU--`(TTTTT(K;;3302==
603             M=-OZ7OH(T<\`@PP19I@11AECG`DFF6*:&6:98YX%%EEBF15666.=#3;98IL=
604             M=MECGP,.B7#$,5%...6,&.=<<,D5U]QPRQWW//#($\^\\,J;G?_II)ETXS79
605             M)L<$C<,['S[GYSY=?FWK6E>Z^?L'BK,:KP0E*DD>R?6E*-7E='DM9BA36
606             MCG*5IWP5J%!%,O+)4;'\"BBH$I7:S')5J%)5JE:-M6JMUKM]FM1LL55M)EG=
607             GZE&O^A1R(V$-NSRF<8L3ZO3L_]KN4!$=Z5A1G>A49XKI_!M<9D8J
608             EOT
609              
610             <<'EOT',
611             M>)RED,E3SW$8QU_77@<''+A]^Y5(2-F7+"%92\B^ES5ES]H,)L(8&21E*UNH
612             M&"8T8ZS3I(FS_T"$_`L^-^/D8)YY/^]Y/\L\"Y/Y/XN()T8"B0P@B8$,(IG!
613             MI#"$H0PCE>&DDG,((N99#.+V
614             M+O.83PZY+""/A2QB,?DL82G+6,X*5K**U:QA+>M8SP8**&0CF]C,%K:RC2*V
615             M4TP).]C)+G:SA[WLHY3]'.`@ASC,$
616             M7USAOS[@48]YW')/>-(*3WG:,R%ZSDK/!K[@1<][R2HO6^T5:ZSUJM>\[@UO
617             M6F>]M[SM'>]ZSX90_\"'-MIDLX^">ASPQ*?!M_C,Y[ZP->KE*U_[QK>^\WW(
618             CM/O!ML"=?K3#3[Z,*_AKOR]V^=5O=OO='_ZTQU^_`2-%:*``
619             EOT
620              
621             undef,
622             undef,
623             undef,
624             undef,
625             undef,
626             undef,
627             undef,
628             undef,
629             undef,
630             <<'EOT',
631             M>)REC]=.E&$`1(\%&W@4004%_7:!I?>.Z-+[TJL*=K"`BH`*J,_"+2'A!7PW
632             MX;\2[LG<3#*9G!F2G$V!&'$***2(!,644$H9Y5102175U%!+'?4TT$@3S;30
633             M2AN/:.\HSG
634             M+++$"U[RBM>\X2WO6&:%]WS@(Y]898W/?.$KZWQC@TVV^,X/?K+-#KO\XC=_
635             M(OX!?T/"`0<=-$T+WG9
636             M*U[UFNEF>%V]X4TSO666V=[VCG?-,==[WC?/?!_XT&#,N`466F3"8DLLM
637             M*ZRTRFIK(GJ=]?_Y+;;:]N\HI(>LD&W2#COMLML>>^V+=IX\2<7BCCGNA)-.
638             0.>V,L\XY[P*'[!\#D^='L@``
639             EOT
640              
641             undef,
642             undef,
643             undef,
644             undef,
645             undef,
646             undef,
647             undef,
648             undef,
649             undef,
650             );
651              
652 1         2 $cp_1252 = (
653             <<'EOT',
654             M>)P-SD-B'5```,#YJ6VE>DEM&[\VD]JVF?H./4'-U+93V[9M:SV;$141(Y74
655             MTD@KG?0RR"B3S++(*IOL
656             M458YY550426555%5-=754%,MM=515SWU-=!05".--=%4,\VUT%(KK;715COM
657             M==!1)YTE2-1%5]UTUT-/O?361U_]]#?`0(,,-L10PPPWPDBCC#;&6..,-\%$
658             MDTPVQ5333)=DAIEFF6V.N>:%9-$0&YD?BH22(82XF)10.3(@U(DDB$;F_/]%
659             M0_Y0(!0*A4-\R!5RQ]R*BX\,#'4CB?]];B3)`@LMLM@22RVSW`HKK;):LC76
660             M6F>]#3;:9+,MMMIFNQUVVF6W/?;:9[\##CKDL"-2''7,<2><=,II9YQUSGD7
661             M7'3)95=<=
662             1?/7-=S_\],MO?_S]!Y==>0@`
663             EOT
664             );
665              
666              
667 1         120 @ms_langids = ( [""],
668             ['ar', ["-SA", "-IQ", "-EG", "-LY", "-DZ", "-MA", "-TN",
669             "-OM", "-YE", "-SY", "-JO", "-LB", "-KW", "-AE",
670             "-BH", "-QA", "-Ploc-SA", "-145"]],
671             ['bg-BG'],
672             ['ca-ES'],
673             ['zh', ['-TW', '-CN', '-HK', '-SG', '-MO', "", "", "", "", "", "",
674             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
675             "", "", "", "zh", "-Hant"]],
676             ["cs-CZ"],
677             ["da-DK"],
678             ["de", ["-DE", "-CH", "-AT", "-LU", "-LI"]],
679             ["el-GR"],
680             ["en", ["-US", "-UK", "-AU", "-CA", "-NZ", "-IE", "-ZA",
681             "-JM", "029", "-BZ", "-TT", "-ZW", "-PH", "-ID",
682             "-HK", "-IN", "-MY", "-SG", "-AE", "-BH", "-EG",
683             "-JO", "-KW", "-TR", "-YE"]],
684             ["es", ["-ES", "-MX", "-ES", "-GT", "-CR", "-PA", "-DO",
685             "-VE", "-CO", "-PE", "-AR", "-EC", "-CL", "-UY",
686             "-PY", "-BO", "-SV", "-HN", "-NI", "-PR", "-US"]],
687             ["fi-FI"],
688             ["fr", ["-FR", "-BE", "-CA", "-CH", "-LU", "-MC", "",
689             "-RE", "-CG", "-SN", "-CM", "-CI", "-ML", "-MA",
690             "-HT"]],
691             ["he-IL"],
692             ["hu-HU"],
693             ["is-IS"],
694             # 0010
695             ["it", ["-IT", "-CH"]],
696             ["ja-JP"],
697             ["ko-KR"],
698             ["nl", ["-NL", "-BE"]],
699             ["no", ["-bok-NO", "-nyn-NO", "", "", "", "", "", "", "", "", "",
700             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
701             "", "", "", "nn", "nb"]],
702             ["pl-PL"],
703             ["pt", ["-BR", "-PT"]],
704             ["rm-CH"],
705             ["ro", ["-RO", "_MD"]],
706             ["ru-RU"],
707             ["hr", ["-HR", "-Latn-CS", "Cyrl-CS", "-BA", "", "-Latn-BA", "-Cyrl-BA",
708             "", "". "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
709             "bs-Cyrl", "bs-Latn", "sr-Cyrl", "sr-Latn", "", "bs", "sr"]],
710             ["sk-SK"],
711             ["sq-AL"],
712             ["sv", ["-SE", "-FI"]],
713             ["th-TH"],
714             ["tr-TR"],
715             # 0020
716             ["ur", ["-PK", "tr-IN"]],
717             ["id-ID"],
718             ["uk-UA"],
719             ["be-BY"],
720             ["sl-SL"],
721             ["et-EE"],
722             ["lv-LV"],
723             ["lt-LT"],
724             ["tg", ["-Cyrl-TJ", "", "", "", "", "", "", "", "", "", "", "", "",
725             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
726             "", "", "-Cyrl"]],
727             ["fa-IR"],
728             ["vi-VN"],
729             ["hy-AM"],
730             ["az", ["-Latn-AZ", "-Cyrl-AZ", "", "", "", "", "", "", "", "", "",
731             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
732             "", "", "-Cyrl", "-Latn"]],
733             ["eu-ES"],
734             ["wen". ["wen-DE", "dsb-DE", "", "", "", "", "", "", "", "", "", "",
735             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
736             "", "", "", "dsb"]],
737             ["mk-MK"],
738             # 0030
739             ["st"],
740             ["ts"],
741             ["tn-ZA"],
742             ["ven"],
743             ["xh-ZA"],
744             ["zu-ZA"],
745             ["af-ZA"],
746             ["ka-GE"],
747             ["fo-FO"],
748             ["hi-IN"],
749             ["mt"],
750             ["se", ["-NO", "-SE", "-FI", "smj-NO", "smj-SE", "sma-NO", "sma-SE",
751             "", "smn-FI", "", "", "", "", "", "", "", "", "", "", "", "", "",
752             "", "", "", "", "smn", "sms", "smj"]],
753             ["ga-IE"],
754             ["yi"],
755             ["ms", ["-MY", "-BN"]],
756             ["kk-KZ"],
757             # 0040
758             ["ky-KG"],
759             ["sw-KE"],
760             ["tk-TM"],
761             ["uz", ["-Latn-UZ", "-Cyrl-UZ", "", "", "", "", "", "", "", "", "", "",
762             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
763             "", "-Cyrl", "-Latn"]],
764             ["tt-RU"],
765             ["bn", ["-IN", "-BD"]],
766             ["pa", ["-IN", "-Arab-PK", "", "", "", "", "", "", "", "", "", "",
767             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
768             "", "", "", "-Arab"]],
769             ["gu-IN"],
770             ["or-IN"],
771             ["ta-IN"],
772             ["te-IN"],
773             ["kn-IN"],
774             ["ml-IN"],
775             ["as-IN"],
776             ["mr-IN"],
777             ["sa-IN"],
778             # 0050
779             ["mn", ["-Cyrl-MN", "-Mong-CN", "", "", "", "", "", "", "", "", "", "", "",
780             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
781             "-Cyrl", "-Mong"]],
782             ["bo", ["-CN", "-BT"]],
783             ["cy-GB"],
784             ["km-KH"],
785             ["lo-LA"],
786             ["my"],
787             ["gl-ES"],
788             ["kok-IN"],
789             ["mni"],
790             ["sd", ["-IN", "-PK", "", "", "", "", "", "", "", "", "", "", "", "", "",
791             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "-Arab"]],
792             ["syr-SY"],
793             ["si-LK"],
794             ["chr", ["", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
795             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "-Cher"]],
796             ["iu", ["-Cans-CA", "-Latn-CA", "", "", "", "", "", "", "", "", "", "", "",
797             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
798             "-Cans", "-Latn"]],
799             ["am-ET"],
800             ["tmz", ["-Arab", "-Latn-DZ", "", "", "", "", "", "", "", "", "", "", "",
801             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
802             "", "-Latn"]],
803             # 0060
804             ["ks"],
805             ["ne", ["-NP", "-IN"]],
806             ["fy-NL"],
807             ["ps-AF"],
808             ["fil-PH"],
809             ["dv-MV"],
810             ["bin-NG"],
811             ["fuv", ["-NG", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
812             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "ff-Latn"]],
813             ["ha", ["-Latn-NG", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
814             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "-Latn"]],
815             ["ibb-NG"],
816             ["yo-NG"],
817             ["quz", ["-BO", "-EC", "-PE"]],
818             ["ns-ZA"],
819             ["ba-RU"],
820             ["lb-LU"],
821             ["kl-GL"],
822             # 0070
823             ["ig-NG"],
824             ["kau"],
825             ["om"],
826             ["ti", ["-ET". "-ER"]],
827             ["gn"],
828             ["haw"],
829             ["la"],
830             ["so"],
831             ["ii-CN"],
832             ["pap"],
833             ["arn-CL"],
834             [""], # (unassigned)
835             ["moh-CA"],
836             [""], # (unassigned)
837             ["br-FR"],
838             [""], # (unassigned)
839             # 0080
840             ["ug-CN"],
841             ["mi-NZ"],
842             ["oc-FR"],
843             ["co-FR"],
844             ["gsw-FR"],
845             ["sah-RU"],
846             ["qut-GT"],
847             ["rw-RW"],
848             ["wo-SN"],
849             [""], # (unassigned)
850             [""], # (unassigned)
851             [""], # (unassigned)
852             ["gbz-AF"],
853             [""], # (unassigned)
854             [""], # (unassigned)
855             [""], # (unassigned)
856             # 0090
857             [""], # (unassigned)
858             ["gd-GB"],
859             ["ku", ["-Arab-IQ", "", "", "", "", "", "", "", "", "", "", "", "", "", "",
860             "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "-Arab"]],
861             ["quc-CO"],
862             );
863             # 0501 = qps-ploc
864             # 05fe = qps-ploca
865             # 09ff = qps-plocm
866              
867 1         75 @mac_langs = (
868             'en', 'fr', 'de', 'it', 'nl', 'sv', 'es', 'da', 'pt', 'no',
869             'he', 'ja', 'ar', 'fi', 'el', 'is', 'mt', 'tr', 'hr', 'zh-Hant',
870             'ur', 'hi', 'th', 'ko', 'lt', 'pl', 'hu', 'et', 'lv', 'se',
871             'fo', 'ru' ,'zh-Hans', 'nl', 'ga', 'sq', 'ro', 'cs', 'sk',
872             'sl', 'yi', 'sr', 'mk', 'bg', 'uk', 'be', 'uz', 'kk', 'az-Cyrl',
873             'az-Latn', 'hy', 'ka', 'mo', 'ky', 'abh', 'tuk', 'mn-Mong', 'mn-Cyrl', 'pst',
874             'ku', 'ks', 'sd', 'bo', 'ne', 'sa', 'mr', 'bn', 'as', 'gu',
875             'pa', 'or', 'ml', 'kn', 'ta', 'te', 'si', 'my', 'km', 'lo',
876             'vi', 'id', 'tl', 'ms-Latn', 'ms-Arab', 'am', 'ti', 'tga', 'so', 'sw',
877             'rw', 'rn', 'ny', 'mg', 'eo', '', '', '', '', '',
878             '', '', '', '', '', '', '', '', '', '',
879             '', '', '', '', '', '', '', '', '', '',
880             '', '', '', '', '', '', '', '', 'cy', 'eu',
881             'la', 'qu', 'gn', 'ay', 'tt', 'ug', 'dz', 'jv-Latn', 'su-Latn',
882             'gl', 'af', 'br', 'iu', 'gd', 'gv', 'gd-IR-x-dotabove', 'to', 'el-polyton', 'kl',
883             'az-Latn'
884             );
885              
886             }
887              
888             1;
889              
890             =head1 BUGS
891              
892             =over 4
893              
894             =item *
895              
896             Unicode type strings will be stored in utf8 for all known platforms,
897             once Perl 5.6 has been released and I can find all the mapping tables, etc.
898              
899             =back
900              
901             =head1 AUTHOR
902              
903             Martin Hosken L.
904              
905              
906             =head1 LICENSING
907              
908             Copyright (c) 1998-2014, SIL International (http://www.sil.org)
909              
910             This module is released under the terms of the Artistic License 2.0.
911             For details, see the full text of the license in the file LICENSE.
912              
913              
914              
915             =cut
916