This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Mark more static Encode data structures as const.
[perl5.git] / ext / Encode / bin / enc2xs
CommitLineData
3ef515df 1#!./perl
67d7b5ef 2BEGIN {
a999c27c
JH
3 # @INC poking no longer needed w/ new MakeMaker and Makefile.PL's
4 # with $ENV{PERL_CORE} set
5 # In case we need it in future...
6 require Config; import Config;
67d7b5ef
JH
7}
8use strict;
b536bf57 9use warnings;
67d7b5ef
JH
10use Getopt::Std;
11my @orig_ARGV = @ARGV;
cf9f87ce 12our $VERSION = do { my @r = (q$Revision: 2.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
67d7b5ef
JH
13
14# These may get re-ordered.
15# RAW is a do_now as inserted by &enter
16# AGG is an aggreagated do_now, as built up by &process
a999c27c 17
67d7b5ef
JH
18use constant {
19 RAW_NEXT => 0,
20 RAW_IN_LEN => 1,
21 RAW_OUT_BYTES => 2,
22 RAW_FALLBACK => 3,
23
24 AGG_MIN_IN => 0,
25 AGG_MAX_IN => 1,
26 AGG_OUT_BYTES => 2,
27 AGG_NEXT => 3,
28 AGG_IN_LEN => 4,
29 AGG_OUT_LEN => 5,
30 AGG_FALLBACK => 6,
31};
a999c27c 32
67d7b5ef
JH
33# (See the algorithm in encengine.c - we're building structures for it)
34
35# There are two sorts of structures.
36# "do_now" (an array, two variants of what needs storing) is whatever we need
37# to do now we've read an input byte.
38# It's housed in a "do_next" (which is how we got to it), and in turn points
39# to a "do_next" which contains all the "do_now"s for the next input byte.
40
41# There will be a "do_next" which is the start state.
42# For a single byte encoding it's the only "do_next" - each "do_now" points
43# back to it, and each "do_now" will cause bytes. There is no state.
44
45# For a multi-byte encoding where all characters in the input are the same
46# length, then there will be a tree of "do_now"->"do_next"->"do_now"
47# branching out from the start state, one step for each input byte.
48# The leaf "do_now"s will all be at the same distance from the start state,
49# only the leaf "do_now"s cause output bytes, and they in turn point back to
50# the start state.
51
52# For an encoding where there are varaible length input byte sequences, you
53# will encounter a leaf "do_now" sooner for the shorter input sequences, but
54# as before the leaves will point back to the start state.
55
56# The system will cope with escape encodings (imagine them as a mostly
57# self-contained tree for each escape state, and cross links between trees
58# at the state-switching characters) but so far no input format defines these.
59
60# The system will also cope with having output "leaves" in the middle of
61# the bifurcating branches, not just at the extremities, but again no
62# input format does this yet.
63
64# There are two variants of the "do_now" structure. The first, smaller variant
65# is generated by &enter as the input file is read. There is one structure
66# for each input byte. Say we are mapping a single byte encoding to a
67# single byte encoding, with "ABCD" going "abcd". There will be
68# 4 "do_now"s, {"A" => [...,"a",...], "B" => [...,"b",...], "C"=>..., "D"=>...}
69
70# &process then walks the tree, building aggregate "do_now" structres for
71# adjacent bytes where possible. The aggregate is for a contiguous range of
72# bytes which each produce the same length of output, each move to the
73# same next state, and each have the same fallback flag.
74# So our 4 RAW "do_now"s above become replaced by a single structure
75# containing:
76# ["A", "D", "abcd", 1, ...]
77# ie, for an input byte $_ in "A".."D", output 1 byte, found as
78# substr ("abcd", (ord $_ - ord "A") * 1, 1)
79# which maps very nicely into pointer arithmetic in C for encengine.c
80
81sub encode_U
82{
83 # UTF-8 encode long hand - only covers part of perl's range
84 ## my $uv = shift;
85 # chr() works in native space so convert value from table
86 # into that space before using chr().
87 my $ch = chr(utf8::unicode_to_native($_[0]));
88 # Now get core perl to encode that the way it likes.
89 utf8::encode($ch);
90 return $ch;
91}
92
93sub encode_S
94{
95 # encode single byte
96 ## my ($ch,$page) = @_; return chr($ch);
97 return chr $_[0];
98}
99
100sub encode_D
101{
102 # encode double byte MS byte first
103 ## my ($ch,$page) = @_; return chr($page).chr($ch);
104 return chr ($_[1]) . chr $_[0];
105}
106
107sub encode_M
108{
109 # encode Multi-byte - single for 0..255 otherwise double
110 ## my ($ch,$page) = @_;
111 ## return &encode_D if $page;
112 ## return &encode_S;
113 return chr ($_[1]) . chr $_[0] if $_[1];
114 return chr $_[0];
115}
116
117my %encode_types = (U => \&encode_U,
118 S => \&encode_S,
119 D => \&encode_D,
120 M => \&encode_M,
121 );
122
123# Win32 does not expand globs on command line
124eval "\@ARGV = map(glob(\$_),\@ARGV)" if ($^O eq 'MSWin32');
125
126my %opt;
127# I think these are:
128# -Q to disable the duplicate codepoint test
129# -S make mapping errors fatal
130# -q to remove comments written to output files
131# -O to enable the (brute force) substring optimiser
132# -o <output> to specify the output file name (else it's the first arg)
133# -f <inlist> to give a file with a list of input files (else use the args)
134# -n <name> to name the encoding (else use the basename of the input file.
aae85ceb 135getopts('CM:SQqOo:f:n:',\%opt);
67d7b5ef
JH
136
137$opt{M} and make_makefile_pl($opt{M}, @ARGV);
aae85ceb 138$opt{C} and make_configlocal_pm($opt{C}, @ARGV);
67d7b5ef
JH
139
140# This really should go first, else the die here causes empty (non-erroneous)
141# output files to be written.
142my @encfiles;
143if (exists $opt{'f'}) {
144 # -F is followed by name of file containing list of filenames
145 my $flist = $opt{'f'};
146 open(FLIST,$flist) || die "Cannot open $flist:$!";
147 chomp(@encfiles = <FLIST>);
148 close(FLIST);
149} else {
150 @encfiles = @ARGV;
151}
152
153my $cname = (exists $opt{'o'}) ? $opt{'o'} : shift(@ARGV);
154chmod(0666,$cname) if -f $cname && !-w $cname;
155open(C,">$cname") || die "Cannot open $cname:$!";
156
157my $dname = $cname;
158my $hname = $cname;
159
160my ($doC,$doEnc,$doUcm,$doPet);
161
0e4142c9 162if ($cname =~ /\.(c|xs)$/i) # VMS may have upcased filenames with DECC$ARGV_PARSE_STYLE defined
67d7b5ef
JH
163 {
164 $doC = 1;
e7cbefb8 165 $dname =~ s/(\.[^\.]*)?$/.exh/;
67d7b5ef
JH
166 chmod(0666,$dname) if -f $cname && !-w $dname;
167 open(D,">$dname") || die "Cannot open $dname:$!";
168 $hname =~ s/(\.[^\.]*)?$/.h/;
169 chmod(0666,$hname) if -f $cname && !-w $hname;
170 open(H,">$hname") || die "Cannot open $hname:$!";
171
172 foreach my $fh (\*C,\*D,\*H)
173 {
174 print $fh <<"END" unless $opt{'q'};
175/*
176 !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
177 This file was autogenerated by:
178 $^X $0 @orig_ARGV
179*/
180END
181 }
182
183 if ($cname =~ /(\w+)\.xs$/)
184 {
185 print C "#include <EXTERN.h>\n";
186 print C "#include <perl.h>\n";
187 print C "#include <XSUB.h>\n";
188 print C "#define U8 U8\n";
189 }
b536bf57 190 print C "#include \"encode.h\"\n\n";
67d7b5ef
JH
191
192 }
193elsif ($cname =~ /\.enc$/)
194 {
195 $doEnc = 1;
196 }
197elsif ($cname =~ /\.ucm$/)
198 {
199 $doUcm = 1;
200 }
201elsif ($cname =~ /\.pet$/)
202 {
203 $doPet = 1;
204 }
205
206my %encoding;
207my %strings;
b536bf57
DK
208my $string_acc;
209my %strings_in_acc;
210
67d7b5ef
JH
211my $saved = 0;
212my $subsave = 0;
213my $strings = 0;
214
215sub cmp_name
216{
217 if ($a =~ /^.*-(\d+)/)
218 {
219 my $an = $1;
220 if ($b =~ /^.*-(\d+)/)
221 {
222 my $r = $an <=> $1;
223 return $r if $r;
224 }
225 }
226 return $a cmp $b;
227}
228
229
230foreach my $enc (sort cmp_name @encfiles)
231 {
232 my ($name,$sfx) = $enc =~ /^.*?([\w-]+)\.(enc|ucm)$/;
233 $name = $opt{'n'} if exists $opt{'n'};
234 if (open(E,$enc))
235 {
236 if ($sfx eq 'enc')
237 {
238 compile_enc(\*E,lc($name));
239 }
240 else
241 {
242 compile_ucm(\*E,lc($name));
243 }
244 }
245 else
246 {
247 warn "Cannot open $enc for $name:$!";
248 }
249 }
250
251if ($doC)
252 {
253 print STDERR "Writing compiled form\n";
254 foreach my $name (sort cmp_name keys %encoding)
255 {
256 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
b536bf57
DK
257 process($name.'_utf8',$e2u);
258 addstrings(\*C,$e2u);
259
260 process('utf8_'.$name,$u2e);
261 addstrings(\*C,$u2e);
262 }
263 outbigstring(\*C,"enctable");
264 foreach my $name (sort cmp_name keys %encoding)
265 {
266 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
267 outtable(\*C,$e2u, "enctable");
268 outtable(\*C,$u2e, "enctable");
269
b2704119 270 # push(@{$encoding{$name}},outstring(\*C,$e2u->{Cname}.'_def',$erep));
67d7b5ef
JH
271 }
272 foreach my $enc (sort cmp_name keys %encoding)
273 {
b2704119
JH
274 # my ($e2u,$u2e,$rep,$min_el,$max_el,$rsym) = @{$encoding{$enc}};
275 my ($e2u,$u2e,$rep,$min_el,$max_el) = @{$encoding{$enc}};
276 #my @info = ($e2u->{Cname},$u2e->{Cname},$rsym,length($rep),$min_el,$max_el);
277 my $replen = 0;
278 $replen++ while($rep =~ /\G\\x[0-9A-Fa-f]/g);
85982a32 279 my @info = ($e2u->{Cname},$u2e->{Cname},qq((U8 *)"$rep"),$replen,$min_el,$max_el);
67d7b5ef
JH
280 my $sym = "${enc}_encoding";
281 $sym =~ s/\W+/_/g;
0629a5b3 282 print C "const encode_t $sym = \n";
f0a41339
DK
283 # This is to make null encoding work -- dankogai
284 for (my $i = (scalar @info) - 1; $i >= 0; --$i){
285 $info[$i] ||= 1;
286 }
287 # end of null tweak -- dankogai
67d7b5ef
JH
288 print C " {",join(',',@info,"{\"$enc\",(const char *)0}"),"};\n\n";
289 }
290
291 foreach my $enc (sort cmp_name keys %encoding)
292 {
293 my $sym = "${enc}_encoding";
294 $sym =~ s/\W+/_/g;
295 print H "extern encode_t $sym;\n";
296 print D " Encode_XSEncoding(aTHX_ &$sym);\n";
297 }
298
299 if ($cname =~ /(\w+)\.xs$/)
300 {
301 my $mod = $1;
302 print C <<'END';
303
304static void
305Encode_XSEncoding(pTHX_ encode_t *enc)
306{
307 dSP;
308 HV *stash = gv_stashpv("Encode::XS", TRUE);
309 SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
310 int i = 0;
311 PUSHMARK(sp);
312 XPUSHs(sv);
313 while (enc->name[i])
314 {
315 const char *name = enc->name[i++];
316 XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
317 }
318 PUTBACK;
319 call_pv("Encode::define_encoding",G_DISCARD);
320 SvREFCNT_dec(sv);
321}
322
323END
324
325 print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n";
326 print C "BOOT:\n{\n";
327 print C "#include \"$dname\"\n";
328 print C "}\n";
329 }
330 # Close in void context is bad, m'kay
331 close(D) or warn "Error closing '$dname': $!";
332 close(H) or warn "Error closing '$hname': $!";
333
cf9f87ce
RGS
334 my $perc_saved = $saved/($strings + $saved) * 100;
335 my $perc_subsaved = $subsave/($strings + $subsave) * 100;
67d7b5ef
JH
336 printf STDERR "%d bytes in string tables\n",$strings;
337 printf STDERR "%d bytes (%.3g%%) saved spotting duplicates\n",
338 $saved, $perc_saved if $saved;
339 printf STDERR "%d bytes (%.3g%%) saved using substrings\n",
340 $subsave, $perc_subsaved if $subsave;
341 }
342elsif ($doEnc)
343 {
344 foreach my $name (sort cmp_name keys %encoding)
345 {
346 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
347 output_enc(\*C,$name,$e2u);
348 }
349 }
350elsif ($doUcm)
351 {
352 foreach my $name (sort cmp_name keys %encoding)
353 {
354 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
355 output_ucm(\*C,$name,$u2e,$erep,$min_el,$max_el);
356 }
357 }
358
359# writing half meg files and then not checking to see if you just filled the
360# disk is bad, m'kay
361close(C) or die "Error closing '$cname': $!";
362
363# End of the main program.
364
365sub compile_ucm
366{
367 my ($fh,$name) = @_;
368 my $e2u = {};
369 my $u2e = {};
370 my $cs;
371 my %attr;
372 while (<$fh>)
373 {
374 s/#.*$//;
375 last if /^\s*CHARMAP\s*$/i;
376 if (/^\s*<(\w+)>\s+"?([^"]*)"?\s*$/i) # " # Grrr
377 {
378 $attr{$1} = $2;
379 }
380 }
381 if (!defined($cs = $attr{'code_set_name'}))
382 {
383 warn "No <code_set_name> in $name\n";
384 }
385 else
386 {
387 $name = $cs unless exists $opt{'n'};
388 }
389 my $erep;
390 my $urep;
391 my $max_el;
392 my $min_el;
393 if (exists $attr{'subchar'})
394 {
b2704119
JH
395 #my @byte;
396 #$attr{'subchar'} =~ /^\s*/cg;
397 #push(@byte,$1) while $attr{'subchar'} =~ /\G\\x([0-9a-f]+)/icg;
398 #$erep = join('',map(chr(hex($_)),@byte));
399 $erep = $attr{'subchar'};
400 $erep =~ s/^\s+//; $erep =~ s/\s+$//;
67d7b5ef
JH
401 }
402 print "Reading $name ($cs)\n";
403 my $nfb = 0;
404 my $hfb = 0;
405 while (<$fh>)
406 {
407 s/#.*$//;
408 last if /^\s*END\s+CHARMAP\s*$/i;
409 next if /^\s*$/;
a999c27c
JH
410 my (@uni, @byte) = ();
411 my ($uni, $byte, $fb) = m/^(\S+)\s+(\S+)\s+(\S+)\s+/o
412 or die "Bad line: $_";
413 while ($uni =~ m/\G<([U0-9a-fA-F\+]+)>/g){
414 push @uni, map { substr($_, 1) } split(/\+/, $1);
415 }
416 while ($byte =~ m/\G\\x([0-9a-fA-F]+)/g){
417 push @byte, $1;
418 }
419 if (@uni)
67d7b5ef 420 {
a999c27c 421 my $uch = join('', map { encode_U(hex($_)) } @uni );
67d7b5ef
JH
422 my $ech = join('',map(chr(hex($_)),@byte));
423 my $el = length($ech);
424 $max_el = $el if (!defined($max_el) || $el > $max_el);
425 $min_el = $el if (!defined($min_el) || $el < $min_el);
426 if (length($fb))
427 {
428 $fb = substr($fb,1);
429 $hfb++;
430 }
431 else
432 {
433 $nfb++;
434 $fb = '0';
435 }
436 # $fb is fallback flag
437 # 0 - round trip safe
438 # 1 - fallback for unicode -> enc
439 # 2 - skip sub-char mapping
440 # 3 - fallback enc -> unicode
441 enter($u2e,$uch,$ech,$u2e,$fb+0) if ($fb =~ /[01]/);
442 enter($e2u,$ech,$uch,$e2u,$fb+0) if ($fb =~ /[03]/);
443 }
444 else
445 {
446 warn $_;
447 }
448 }
449 if ($nfb && $hfb)
450 {
451 die "$nfb entries without fallback, $hfb entries with\n";
452 }
453 $encoding{$name} = [$e2u,$u2e,$erep,$min_el,$max_el];
454}
455
456
457
458sub compile_enc
459{
460 my ($fh,$name) = @_;
461 my $e2u = {};
462 my $u2e = {};
463
464 my $type;
465 while ($type = <$fh>)
466 {
467 last if $type !~ /^\s*#/;
468 }
469 chomp($type);
470 return if $type eq 'E';
471 # Do the hash lookup once, rather than once per function call. 4% speedup.
472 my $type_func = $encode_types{$type};
473 my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
474 warn "$type encoded $name\n";
475 my $rep = '';
476 # Save a defined test by setting these to defined values.
477 my $min_el = ~0; # A very big integer
478 my $max_el = 0; # Anything must be longer than 0
479 {
480 my $v = hex($def);
481 $rep = &$type_func($v & 0xFF, ($v >> 8) & 0xffe);
482 }
483 my $errors;
484 my $seen;
485 # use -Q to silence the seen test. Makefile.PL uses this by default.
486 $seen = {} unless $opt{Q};
487 do
488 {
489 my $line = <$fh>;
490 chomp($line);
491 my $page = hex($line);
492 my $ch = 0;
493 my $i = 16;
494 do
495 {
496 # So why is it 1% faster to leave the my here?
497 my $line = <$fh>;
498 $line =~ s/\r\n$/\n/;
499 die "$.:${line}Line should be exactly 65 characters long including
500 newline (".length($line).")" unless length ($line) == 65;
501 # Split line into groups of 4 hex digits, convert groups to ints
502 # This takes 65.35
503 # map {hex $_} $line =~ /(....)/g
504 # This takes 63.75 (2.5% less time)
505 # unpack "n*", pack "H*", $line
506 # There's an implicit loop in map. Loops are bad, m'kay. Ops are bad, m'kay
507 # Doing it as while ($line =~ /(....)/g) took 74.63
508 foreach my $val (unpack "n*", pack "H*", $line)
509 {
510 next if $val == 0xFFFD;
511 my $ech = &$type_func($ch,$page);
512 if ($val || (!$ch && !$page))
513 {
514 my $el = length($ech);
515 $max_el = $el if $el > $max_el;
516 $min_el = $el if $el < $min_el;
517 my $uch = encode_U($val);
518 if ($seen) {
519 # We're doing the test.
520 # We don't need to read this quickly, so storing it as a scalar,
521 # rather than 3 (anon array, plus the 2 scalars it holds) saves
522 # RAM and may make us faster on low RAM systems. [see __END__]
523 if (exists $seen->{$uch})
524 {
525 warn sprintf("U%04X is %02X%02X and %04X\n",
526 $val,$page,$ch,$seen->{$uch});
527 $errors++;
528 }
529 else
530 {
531 $seen->{$uch} = $page << 8 | $ch;
532 }
533 }
534 # Passing 2 extra args each time is 3.6% slower!
535 # Even with having to add $fallback ||= 0 later
536 enter_fb0($e2u,$ech,$uch);
537 enter_fb0($u2e,$uch,$ech);
538 }
539 else
540 {
541 # No character at this position
542 # enter($e2u,$ech,undef,$e2u);
543 }
544 $ch++;
545 }
546 } while --$i;
547 } while --$pages;
548 die "\$min_el=$min_el, \$max_el=$max_el - seems we read no lines"
549 if $min_el > $max_el;
550 die "$errors mapping conflicts\n" if ($errors && $opt{'S'});
551 $encoding{$name} = [$e2u,$u2e,$rep,$min_el,$max_el];
552}
553
554# my ($a,$s,$d,$t,$fb) = @_;
555sub enter {
556 my ($current,$inbytes,$outbytes,$next,$fallback) = @_;
557 # state we shift to after this (multibyte) input character defaults to same
558 # as current state.
559 $next ||= $current;
560 # Making sure it is defined seems to be faster than {no warnings;} in
561 # &process, or passing it in as 0 explicity.
562 # XXX $fallback ||= 0;
563
564 # Start at the beginning and work forwards through the string to zero.
565 # effectively we are removing 1 character from the front each time
566 # but we don't actually edit the string. [this alone seems to be 14% speedup]
567 # Hence -$pos is the length of the remaining string.
568 my $pos = -length $inbytes;
569 while (1) {
570 my $byte = substr $inbytes, $pos, 1;
571 # RAW_NEXT => 0,
572 # RAW_IN_LEN => 1,
573 # RAW_OUT_BYTES => 2,
574 # RAW_FALLBACK => 3,
575 # to unicode an array would seem to be better, because the pages are dense.
576 # from unicode can be very sparse, favouring a hash.
577 # hash using the bytes (all length 1) as keys rather than ord value,
578 # as it's easier to sort these in &process.
579
580 # It's faster to always add $fallback even if it's undef, rather than
581 # choosing between 3 and 4 element array. (hence why we set it defined
582 # above)
583 my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,'',$fallback];
584 # When $pos was -1 we were at the last input character.
585 unless (++$pos) {
586 $do_now->[RAW_OUT_BYTES] = $outbytes;
587 $do_now->[RAW_NEXT] = $next;
588 return;
589 }
590 # Tail recursion. The intermdiate state may not have a name yet.
591 $current = $do_now->[RAW_NEXT];
592 }
593}
594
595# This is purely for optimistation. It's just &enter hard coded for $fallback
596# of 0, using only a 3 entry array ref to save memory for every entry.
597sub enter_fb0 {
598 my ($current,$inbytes,$outbytes,$next) = @_;
599 $next ||= $current;
600
601 my $pos = -length $inbytes;
602 while (1) {
603 my $byte = substr $inbytes, $pos, 1;
604 my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,''];
605 unless (++$pos) {
606 $do_now->[RAW_OUT_BYTES] = $outbytes;
607 $do_now->[RAW_NEXT] = $next;
608 return;
609 }
610 $current = $do_now->[RAW_NEXT];
611 }
612}
613
67d7b5ef
JH
614sub process
615{
616 my ($name,$a) = @_;
617 $name =~ s/\W+/_/g;
618 $a->{Cname} = $name;
619 my $raw = $a->{Raw};
620 my ($l, $agg_max_in, $agg_next, $agg_in_len, $agg_out_len, $agg_fallback);
621 my @ent;
622 $agg_max_in = 0;
623 foreach my $key (sort keys %$raw) {
624 # RAW_NEXT => 0,
625 # RAW_IN_LEN => 1,
626 # RAW_OUT_BYTES => 2,
627 # RAW_FALLBACK => 3,
628 my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
629 # Now we are converting from raw to aggregate, switch from 1 byte strings
630 # to numbers
631 my $b = ord $key;
632 $fallback ||= 0;
633 if ($l &&
634 # If this == fails, we're going to reset $agg_max_in below anyway.
635 $b == ++$agg_max_in &&
636 # References in numeric context give the pointer as an int.
637 $agg_next == $next &&
638 $agg_in_len == $in_len &&
639 $agg_out_len == length $out_bytes &&
640 $agg_fallback == $fallback
641 # && length($l->[AGG_OUT_BYTES]) < 16
642 ) {
643 # my $i = ord($b)-ord($l->[AGG_MIN_IN]);
644 # we can aggregate this byte onto the end.
645 $l->[AGG_MAX_IN] = $b;
646 $l->[AGG_OUT_BYTES] .= $out_bytes;
647 } else {
648 # AGG_MIN_IN => 0,
649 # AGG_MAX_IN => 1,
650 # AGG_OUT_BYTES => 2,
651 # AGG_NEXT => 3,
652 # AGG_IN_LEN => 4,
653 # AGG_OUT_LEN => 5,
654 # AGG_FALLBACK => 6,
655 # Reset the last thing we saw, plus set 5 lexicals to save some derefs.
656 # (only gains .6% on euc-jp -- is it worth it?)
657 push @ent, $l = [$b, $agg_max_in = $b, $out_bytes, $agg_next = $next,
658 $agg_in_len = $in_len, $agg_out_len = length $out_bytes,
659 $agg_fallback = $fallback];
660 }
661 if (exists $next->{Cname}) {
662 $next->{'Forward'} = 1 if $next != $a;
663 } else {
664 process(sprintf("%s_%02x",$name,$b),$next);
665 }
666 }
667 # encengine.c rules say that last entry must be for 255
668 if ($agg_max_in < 255) {
669 push @ent, [1+$agg_max_in, 255,undef,$a,0,0];
670 }
671 $a->{'Entries'} = \@ent;
672}
673
b536bf57
DK
674
675sub addstrings
67d7b5ef
JH
676{
677 my ($fh,$a) = @_;
678 my $name = $a->{'Cname'};
679 # String tables
680 foreach my $b (@{$a->{'Entries'}})
681 {
682 next unless $b->[AGG_OUT_LEN];
b536bf57 683 $strings{$b->[AGG_OUT_BYTES]} = undef;
67d7b5ef
JH
684 }
685 if ($a->{'Forward'})
686 {
f0a41339 687 my $var = $^O eq 'MacOS' ? 'extern' : 'static';
0629a5b3 688 print $fh "$var const encpage_t $name\[",scalar(@{$a->{'Entries'}}),"];\n";
b536bf57
DK
689 }
690 $a->{'DoneStrings'} = 1;
691 foreach my $b (@{$a->{'Entries'}})
692 {
693 my ($s,$e,$out,$t,$end,$l) = @$b;
694 addstrings($fh,$t) unless $t->{'DoneStrings'};
67d7b5ef 695 }
b536bf57
DK
696}
697
698sub outbigstring
699{
700 my ($fh,$name) = @_;
701
702 $string_acc = '';
703
704 # Make the big string in the string accumulator. Longest first, on the hope
705 # that this makes it more likely that we find the short strings later on.
706 # Not sure if it helps sorting strings of the same length lexcically.
707 foreach my $s (sort {length $b <=> length $a || $a cmp $b} keys %strings) {
708 my $index = index $string_acc, $s;
709 if ($index >= 0) {
710 $saved += length($s);
711 $strings_in_acc{$s} = $index;
712 } else {
713 OPTIMISER: {
714 if ($opt{'O'}) {
715 my $sublength = length $s;
716 while (--$sublength > 0) {
717 # progressively lop characters off the end, to see if the start of
718 # the new string overlaps the end of the accumulator.
719 if (substr ($string_acc, -$sublength)
720 eq substr ($s, 0, $sublength)) {
721 $subsave += $sublength;
722 $strings_in_acc{$s} = length ($string_acc) - $sublength;
723 # append the last bit on the end.
724 $string_acc .= substr ($s, $sublength);
725 last OPTIMISER;
726 }
727 # or if the end of the new string overlaps the start of the
728 # accumulator
729 next unless substr ($string_acc, 0, $sublength)
730 eq substr ($s, -$sublength);
731 # well, the last $sublength characters of the accumulator match.
732 # so as we're prepending to the accumulator, need to shift all our
733 # existing offsets forwards
734 $_ += $sublength foreach values %strings_in_acc;
735 $subsave += $sublength;
736 $strings_in_acc{$s} = 0;
737 # append the first bit on the start.
738 $string_acc = substr ($s, 0, -$sublength) . $string_acc;
739 last OPTIMISER;
740 }
741 }
742 # Optimiser (if it ran) found nothing, so just going have to tack the
743 # whole thing on the end.
744 $strings_in_acc{$s} = length $string_acc;
745 $string_acc .= $s;
746 };
747 }
748 }
749
750 $strings = length $string_acc;
751 my $definition = "\nstatic const U8 $name\[$strings] = { " .
752 join(',',unpack "C*",$string_acc);
753 # We have a single long line. Split it at convenient commas.
754 print $fh $1, "\n" while $definition =~ /\G(.{74,77},)/gcs;
755 print $fh substr ($definition, pos $definition), " };\n";
756}
757
758sub findstring {
759 my ($name,$s) = @_;
760 my $offset = $strings_in_acc{$s};
761 die "Can't find string " . join (',',unpack "C*",$s) . " in accumulator"
762 unless defined $offset;
763 "$name + $offset";
764}
765
766sub outtable
767{
768 my ($fh,$a,$bigname) = @_;
769 my $name = $a->{'Cname'};
67d7b5ef
JH
770 $a->{'Done'} = 1;
771 foreach my $b (@{$a->{'Entries'}})
772 {
773 my ($s,$e,$out,$t,$end,$l) = @$b;
b536bf57 774 outtable($fh,$t,$bigname) unless $t->{'Done'};
67d7b5ef 775 }
0629a5b3
NC
776 print $fh "\nstatic const encpage_t $name\[",
777 scalar(@{$a->{'Entries'}}), "] = {\n";
67d7b5ef
JH
778 foreach my $b (@{$a->{'Entries'}})
779 {
780 my ($sc,$ec,$out,$t,$end,$l,$fb) = @$b;
d6f02b51 781 # $end |= 0x80 if $fb; # what the heck was on your mind, Nick? -- Dan
67d7b5ef
JH
782 print $fh "{";
783 if ($l)
784 {
b536bf57 785 printf $fh findstring($bigname,$out);
67d7b5ef
JH
786 }
787 else
788 {
789 print $fh "0";
790 }
791 print $fh ",",$t->{Cname};
792 printf $fh ",0x%02x,0x%02x,$l,$end},\n",$sc,$ec;
793 }
794 print $fh "};\n";
795}
796
67d7b5ef
JH
797sub output_enc
798{
799 my ($fh,$name,$a) = @_;
800 die "Changed - fix me for new structure";
801 foreach my $b (sort keys %$a)
802 {
803 my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}};
804 }
805}
806
807sub decode_U
808{
809 my $s = shift;
810}
811
812my @uname;
813sub char_names
814{
815 my $s = do "unicore/Name.pl";
816 die "char_names: unicore/Name.pl: $!\n" unless defined $s;
817 pos($s) = 0;
818 while ($s =~ /\G([0-9a-f]+)\t([0-9a-f]*)\t(.*?)\s*\n/igc)
819 {
820 my $name = $3;
821 my $s = hex($1);
822 last if $s >= 0x10000;
823 my $e = length($2) ? hex($2) : $s;
824 for (my $i = $s; $i <= $e; $i++)
825 {
826 $uname[$i] = $name;
827# print sprintf("U%04X $name\n",$i);
828 }
829 }
830}
831
832sub output_ucm_page
833{
834 my ($cmap,$a,$t,$pre) = @_;
835 # warn sprintf("Page %x\n",$pre);
836 my $raw = $t->{Raw};
837 foreach my $key (sort keys %$raw) {
838 # RAW_NEXT => 0,
839 # RAW_IN_LEN => 1,
840 # RAW_OUT_BYTES => 2,
841 # RAW_FALLBACK => 3,
842 my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
843 my $u = ord $key;
844 $fallback ||= 0;
845
846 if ($next != $a && $next != $t) {
847 output_ucm_page($cmap,$a,$next,(($pre|($u &0x3F)) << 6)&0xFFFF);
848 } elsif (length $out_bytes) {
849 if ($pre) {
850 $u = $pre|($u &0x3f);
851 }
852 my $s = sprintf "<U%04X> ",$u;
853 #foreach my $c (split(//,$out_bytes)) {
854 # $s .= sprintf "\\x%02X",ord($c);
855 #}
856 # 9.5% faster changing that loop to this:
857 $s .= sprintf +("\\x%02X" x length $out_bytes), unpack "C*", $out_bytes;
858 $s .= sprintf " |%d # %s\n",($fallback ? 1 : 0),$uname[$u];
859 push(@$cmap,$s);
860 } else {
861 warn join(',',$u, @{$raw->{$key}},$a,$t);
862 }
863 }
864}
865
866sub output_ucm
867{
868 my ($fh,$name,$h,$rep,$min_el,$max_el) = @_;
869 print $fh "# $0 @orig_ARGV\n" unless $opt{'q'};
870 print $fh "<code_set_name> \"$name\"\n";
871 char_names();
872 if (defined $min_el)
873 {
874 print $fh "<mb_cur_min> $min_el\n";
875 }
876 if (defined $max_el)
877 {
878 print $fh "<mb_cur_max> $max_el\n";
879 }
880 if (defined $rep)
881 {
882 print $fh "<subchar> ";
883 foreach my $c (split(//,$rep))
884 {
885 printf $fh "\\x%02X",ord($c);
886 }
887 print $fh "\n";
888 }
889 my @cmap;
890 output_ucm_page(\@cmap,$h,$h,0);
891 print $fh "#\nCHARMAP\n";
892 foreach my $line (sort { substr($a,8) cmp substr($b,8) } @cmap)
893 {
894 print $fh $line;
895 }
896 print $fh "END CHARMAP\n";
897}
898
3ef515df
JH
899use vars qw(
900 $_Enc2xs
901 $_Version
902 $_Inc
b2704119 903 $_E2X
3ef515df
JH
904 $_Name
905 $_TableFiles
906 $_Now
907);
908
b2704119 909sub find_e2x{
b536bf57 910 eval { require File::Find; };
b2704119
JH
911 my (@inc, %e2x_dir);
912 for my $inc (@INC){
913 push @inc, $inc unless $inc eq '.'; #skip current dir
914 }
915 File::Find::find(
916 sub {
917 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
918 $atime,$mtime,$ctime,$blksize,$blocks)
919 = lstat($_) or return;
920 -f _ or return;
921 if (/^.*\.e2x$/o){
b536bf57 922 no warnings 'once';
b2704119
JH
923 $e2x_dir{$File::Find::dir} ||= $mtime;
924 }
925 return;
926 }, @inc);
927 warn join("\n", keys %e2x_dir), "\n";
928 for my $d (sort {$e2x_dir{$a} <=> $e2x_dir{$b}} keys %e2x_dir){
929 $_E2X = $d;
930 # warn "$_E2X => ", scalar localtime($e2x_dir{$d});
931 return $_E2X;
932 }
933}
934
67d7b5ef
JH
935sub make_makefile_pl
936{
937 eval { require Encode; };
938 $@ and die "You need to install Encode to use enc2xs -M\nerror: $@\n";
3ef515df
JH
939 # our used for variable expanstion
940 $_Enc2xs = $0;
941 $_Version = $VERSION;
b2704119 942 $_E2X = find_e2x();
3ef515df
JH
943 $_Name = shift;
944 $_TableFiles = join(",", map {qq('$_')} @_);
945 $_Now = scalar localtime();
b2704119 946
aae85ceb 947 eval { require File::Spec; };
b2704119 948 _print_expand(File::Spec->catfile($_E2X,"Makefile_PL.e2x"),"Makefile.PL");
b2704119 949 _print_expand(File::Spec->catfile($_E2X,"_PM.e2x"), "$_Name.pm");
b2704119 950 _print_expand(File::Spec->catfile($_E2X,"_T.e2x"), "t/$_Name.t");
b2704119 951 _print_expand(File::Spec->catfile($_E2X,"README.e2x"), "README");
b2704119 952 _print_expand(File::Spec->catfile($_E2X,"Changes.e2x"), "Changes");
3ef515df
JH
953 exit;
954}
955
aae85ceb
DK
956use vars qw(
957 $_ModLines
958 $_LocalVer
959 );
960
961sub make_configlocal_pm
962{
963 eval { require Encode; };
964 $@ and die "Unable to require Encode: $@\n";
965 eval { require File::Spec; };
966 # our used for variable expanstion
967 my %in_core = map {$_=>1}('ascii','iso-8859-1','utf8');
968 my %LocalMod = ();
969 for my $d (@INC){
970 my $inc = File::Spec->catfile($d, "Encode");
971 -d $inc or next;
972 opendir my $dh, $inc or die "$inc:$!";
973 warn "Checking $inc...\n";
974 for my $f (grep /\.pm$/o, readdir($dh)){
975 -f File::Spec->catfile($inc, "$f") or next;
976 $INC{"Encode/$f"} and next;
977 warn "require Encode/$f;\n";
978 eval { require "Encode/$f"; };
979 $@ and die "Can't require Encode/$f: $@\n";
980 for my $enc (Encode->encodings()){
b536bf57 981 no warnings 'once';
aae85ceb
DK
982 $in_core{$enc} and next;
983 $Encode::Config::ExtModule{$enc} and next;
984 my $mod = "Encode/$f";
985 $mod =~ s/\.pm$//o; $mod =~ s,/,::,og;
b2704119 986 $LocalMod{$enc} ||= $mod;
aae85ceb
DK
987 }
988 }
989 }
990 $_ModLines = "";
991 for my $enc (sort keys %LocalMod){
992 $_ModLines .=
993 qq(\$Encode::ExtModule{'$enc'} =\t"$LocalMod{$enc}";\n);
994 }
b2704119 995 warn $_ModLines;
aae85ceb 996 $_LocalVer = _mkversion();
b2704119 997 $_E2X = find_e2x();
aae85ceb 998 $_Inc = $INC{"Encode.pm"}; $_Inc =~ s/\.pm$//o;
b2704119 999 _print_expand(File::Spec->catfile($_E2X,"ConfigLocal_PM.e2x"),
621b0f8d
DK
1000 File::Spec->catfile($_Inc,"ConfigLocal.pm"),
1001 1);
aae85ceb
DK
1002 exit;
1003}
1004
1005sub _mkversion{
1006 my ($ss,$mm,$hh,$dd,$mo,$yyyy) = localtime();
1007 $yyyy += 1900, $mo +=1;
1008 return sprintf("v%04d.%04d.%04d", $yyyy, $mo*100+$dd, $hh*100+$mm);
1009}
1010
3ef515df 1011sub _print_expand{
67d7b5ef
JH
1012 eval { require File::Basename; };
1013 $@ and die "File::Basename needed. Are you on miniperl?;\nerror: $@\n";
1014 File::Basename->import();
621b0f8d
DK
1015 my ($src, $dst, $clobber) = @_;
1016 if (!$clobber and -e $dst){
1017 warn "$dst exists. skipping\n";
1018 return;
1019 }
1020 warn "Generating $dst...\n";
3ef515df
JH
1021 open my $in, $src or die "$src : $!";
1022 if ((my $d = dirname($dst)) ne '.'){
1023 -d $d or mkdir $d, 0755 or die "mkdir $d : $!";
1024 }
1025 open my $out, ">$dst" or die "$!";
1026 my $asis = 0;
1027 while (<$in>){
1028 if (/^#### END_OF_HEADER/){
1029 $asis = 1; next;
1030 }
1031 s/(\$_[A-Z][A-Za-z0-9]+)_/$1/gee unless $asis;
1032 print $out $_;
67d7b5ef 1033 }
67d7b5ef 1034}
67d7b5ef
JH
1035__END__
1036
1037=head1 NAME
1038
1039enc2xs -- Perl Encode Module Generator
1040
1041=head1 SYNOPSIS
1042
67d7b5ef 1043 enc2xs -[options]
aae85ceb
DK
1044 enc2xs -M ModName mapfiles...
1045 enc2xs -C
67d7b5ef
JH
1046
1047=head1 DESCRIPTION
1048
1049F<enc2xs> builds a Perl extension for use by Encode from either
0ab8f81e
JH
1050Unicode Character Mapping files (.ucm) or Tcl Encoding Files (.enc).
1051Besides being used internally during the build process of the Encode
1052module, you can use F<enc2xs> to add your own encoding to perl.
1053No knowledge of XS is necessary.
67d7b5ef
JH
1054
1055=head1 Quick Guide
1056
0ab8f81e 1057If you want to know as little about Perl as possible but need to
67d7b5ef
JH
1058add a new encoding, just read this chapter and forget the rest.
1059
1060=over 4
1061
1062=item 0.
1063
0ab8f81e
JH
1064Have a .ucm file ready. You can get it from somewhere or you can write
1065your own from scratch or you can grab one from the Encode distribution
1066and customize it. For the UCM format, see the next Chapter. In the
1067example below, I'll call my theoretical encoding myascii, defined
1068in I<my.ucm>. C<$> is a shell prompt.
67d7b5ef
JH
1069
1070 $ ls -F
1071 my.ucm
1072
1073=item 1.
1074
1075Issue a command as follows;
1076
1077 $ enc2xs -M My my.ucm
3ef515df
JH
1078 generating Makefile.PL
1079 generating My.pm
1080 generating README
1081 generating Changes
67d7b5ef
JH
1082
1083Now take a look at your current directory. It should look like this.
1084
1085 $ ls -F
1086 Makefile.PL My.pm my.ucm t/
1087
0ab8f81e 1088The following files were created.
67d7b5ef 1089
0ab8f81e
JH
1090 Makefile.PL - MakeMaker script
1091 My.pm - Encode submodule
1092 t/My.t - test file
1093
1094=over 4
67d7b5ef 1095
037b88d6
JH
1096=item 1.1.
1097
1098If you want *.ucm installed together with the modules, do as follows;
1099
1100 $ mkdir Encode
1101 $ mv *.ucm Encode
1102 $ enc2xs -M My Encode/*ucm
1103
0ab8f81e
JH
1104=back
1105
67d7b5ef
JH
1106=item 2.
1107
1108Edit the files generated. You don't have to if you have no time AND no
1109intention to give it to someone else. But it is a good idea to edit
0ab8f81e 1110the pod and to add more tests.
67d7b5ef
JH
1111
1112=item 3.
1113
0ab8f81e 1114Now issue a command all Perl Mongers love:
67d7b5ef 1115
9160fdbd 1116 $ perl Makefile.PL
67d7b5ef
JH
1117 Writing Makefile for Encode::My
1118
1119=item 4.
1120
1121Now all you have to do is make.
1122
1123 $ make
1124 cp My.pm blib/lib/Encode/My.pm
1125 /usr/local/bin/perl /usr/local/bin/enc2xs -Q -O \
1126 -o encode_t.c -f encode_t.fnm
1127 Reading myascii (myascii)
1128 Writing compiled form
1129 128 bytes in string tables
cf9f87ce
RGS
1130 384 bytes (75%) saved spotting duplicates
1131 1 bytes (0.775%) saved using substrings
67d7b5ef
JH
1132 ....
1133 chmod 644 blib/arch/auto/Encode/My/My.bs
1134 $
1135
0ab8f81e
JH
1136The time it takes varies depending on how fast your machine is and
1137how large your encoding is. Unless you are working on something big
1138like euc-tw, it won't take too long.
67d7b5ef
JH
1139
1140=item 5.
1141
1142You can "make install" already but you should test first.
1143
1144 $ make test
1145 PERL_DL_NONLAZY=1 /usr/local/bin/perl -Iblib/arch -Iblib/lib \
1146 -e 'use Test::Harness qw(&runtests $verbose); \
1147 $verbose=0; runtests @ARGV;' t/*.t
1148 t/My....ok
1149 All tests successful.
1150 Files=1, Tests=2, 0 wallclock secs
1151 ( 0.09 cusr + 0.01 csys = 0.09 CPU)
1152
1153=item 6.
1154
1155If you are content with the test result, just "make install"
1156
aae85ceb
DK
1157=item 7.
1158
0ab8f81e 1159If you want to add your encoding to Encode's demand-loading list
aae85ceb
DK
1160(so you don't have to "use Encode::YourEncoding"), run
1161
1162 enc2xs -C
1163
1164to update Encode::ConfigLocal, a module that controls local settings.
1165After that, "use Encode;" is enough to load your encodings on demand.
1166
67d7b5ef
JH
1167=back
1168
1169=head1 The Unicode Character Map
1170
0ab8f81e
JH
1171Encode uses the Unicode Character Map (UCM) format for source character
1172mappings. This format is used by IBM's ICU package and was adopted
1173by Nick Ing-Simmons for use with the Encode module. Since UCM is
1174more flexible than Tcl's Encoding Map and far more user-friendly,
1175this is the recommended formet for Encode now.
67d7b5ef 1176
0ab8f81e 1177A UCM file looks like this.
67d7b5ef
JH
1178
1179 #
1180 # Comments
1181 #
1182 <code_set_name> "US-ascii" # Required
1183 <code_set_alias> "ascii" # Optional
1184 <mb_cur_min> 1 # Required; usually 1
1185 <mb_cur_max> 1 # Max. # of bytes/char
1186 <subchar> \x3F # Substitution char
1187 #
1188 CHARMAP
1189 <U0000> \x00 |0 # <control>
1190 <U0001> \x01 |0 # <control>
1191 <U0002> \x02 |0 # <control>
1192 ....
1193 <U007C> \x7C |0 # VERTICAL LINE
1194 <U007D> \x7D |0 # RIGHT CURLY BRACKET
1195 <U007E> \x7E |0 # TILDE
1196 <U007F> \x7F |0 # <control>
1197 END CHARMAP
1198
1199=over 4
1200
1201=item *
1202
0ab8f81e 1203Anything that follows C<#> is treated as a comment.
67d7b5ef
JH
1204
1205=item *
1206
0ab8f81e
JH
1207The header section continues until a line containing the word
1208CHARMAP. This section has a form of I<E<lt>keywordE<gt> value>, one
1209pair per line. Strings used as values must be quoted. Barewords are
1210treated as numbers. I<\xXX> represents a byte.
67d7b5ef
JH
1211
1212Most of the keywords are self-explanatory. I<subchar> means
1213substitution character, not subcharacter. When you decode a Unicode
1214sequence to this encoding but no matching character is found, the byte
1215sequence defined here will be used. For most cases, the value here is
0ab8f81e 1216\x3F; in ASCII, this is a question mark.
67d7b5ef
JH
1217
1218=item *
1219
1220CHARMAP starts the character map section. Each line has a form as
0ab8f81e 1221follows:
67d7b5ef
JH
1222
1223 <UXXXX> \xXX.. |0 # comment
1224 ^ ^ ^
1225 | | +- Fallback flag
1226 | +-------- Encoded byte sequence
1227 +-------------- Unicode Character ID in hex
1228
0ab8f81e
JH
1229The format is roughly the same as a header section except for the
1230fallback flag: | followed by 0..3. The meaning of the possible
1231values is as follows:
67d7b5ef 1232
0ab8f81e 1233=over 4
67d7b5ef
JH
1234
1235=item |0
1236
0ab8f81e
JH
1237Round trip safe. A character decoded to Unicode encodes back to the
1238same byte sequence. Most characters have this flag.
67d7b5ef
JH
1239
1240=item |1
1241
1242Fallback for unicode -> encoding. When seen, enc2xs adds this
0ab8f81e 1243character for the encode map only.
67d7b5ef
JH
1244
1245=item |2
1246
1247Skip sub-char mapping should there be no code point.
1248
1249=item |3
1250
1251Fallback for encoding -> unicode. When seen, enc2xs adds this
0ab8f81e 1252character for the decode map only.
67d7b5ef
JH
1253
1254=back
1255
1256=item *
1257
1258And finally, END OF CHARMAP ends the section.
1259
1260=back
1261
6d1c0808 1262When you are manually creating a UCM file, you should copy ascii.ucm
0ab8f81e
JH
1263or an existing encoding which is close to yours, rather than write
1264your own from scratch.
67d7b5ef
JH
1265
1266When you do so, make sure you leave at least B<U0000> to B<U0020> as
0ab8f81e 1267is, unless your environment is EBCDIC.
67d7b5ef
JH
1268
1269B<CAVEAT>: not all features in UCM are implemented. For example,
1270icu:state is not used. Because of that, you need to write a perl
0ab8f81e
JH
1271module if you want to support algorithmical encodings, notably
1272the ISO-2022 series. Such modules include L<Encode::JP::2022_JP>,
67d7b5ef
JH
1273L<Encode::KR::2022_KR>, and L<Encode::TW::HZ>.
1274
6d1c0808
JH
1275=head2 Coping with duplicate mappings
1276
1277When you create a map, you SHOULD make your mappings round-trip safe.
1278That is, C<encode('your-encoding', decode('your-encoding', $data)) eq
1279$data> stands for all characters that are marked as C<|0>. Here is
0ab8f81e 1280how to make sure:
6d1c0808 1281
0ab8f81e 1282=over 4
6d1c0808
JH
1283
1284=item *
1285
1286Sort your map in Unicode order.
1287
1288=item *
1289
1290When you have a duplicate entry, mark either one with '|1' or '|3'.
1291
1292=item *
1293
0ab8f81e 1294And make sure the '|1' or '|3' entry FOLLOWS the '|0' entry.
6d1c0808
JH
1295
1296=back
1297
1298Here is an example from big5-eten.
1299
1300 <U2550> \xF9\xF9 |0
1301 <U2550> \xA2\xA4 |3
1302
1303Internally Encoding -> Unicode and Unicode -> Encoding Map looks like
1304this;
1305
1306 E to U U to E
1307 --------------------------------------
1308 \xF9\xF9 => U2550 U2550 => \xF9\xF9
1309 \xA2\xA4 => U2550
1310
1311So it is round-trip safe for \xF9\xF9. But if the line above is upside
1312down, here is what happens.
1313
1314 E to U U to E
1315 --------------------------------------
1316 \xA2\xA4 => U2550 U2550 => \xF9\xF9
1317 (\xF9\xF9 => U2550 is now overwritten!)
1318
1319The Encode package comes with F<ucmlint>, a crude but sufficient
0ab8f81e
JH
1320utility to check the integrity of a UCM file. Check under the
1321Encode/bin directory for this.
cf9f87ce
RGS
1322
1323When in doubt, you can use F<ucmsort>, yet another utility under
1324Encode/bin directory.
6d1c0808 1325
67d7b5ef
JH
1326=head1 Bookmarks
1327
0ab8f81e
JH
1328=over 4
1329
1330=item *
1331
67d7b5ef
JH
1332ICU Home Page
1333L<http://oss.software.ibm.com/icu/>
1334
0ab8f81e
JH
1335=item *
1336
67d7b5ef
JH
1337ICU Character Mapping Tables
1338L<http://oss.software.ibm.com/icu/charset/>
1339
0ab8f81e
JH
1340=item *
1341
67d7b5ef
JH
1342ICU:Conversion Data
1343L<http://oss.software.ibm.com/icu/userguide/conversion-data.html>
1344
0ab8f81e
JH
1345=back
1346
67d7b5ef
JH
1347=head1 SEE ALSO
1348
1349L<Encode>,
1350L<perlmod>,
1351L<perlpod>
1352
1353=cut
1354
1355# -Q to disable the duplicate codepoint test
1356# -S make mapping errors fatal
1357# -q to remove comments written to output files
1358# -O to enable the (brute force) substring optimiser
1359# -o <output> to specify the output file name (else it's the first arg)
1360# -f <inlist> to give a file with a list of input files (else use the args)
1361# -n <name> to name the encoding (else use the basename of the input file.
1362
1363With %seen holding array refs:
1364
1365 865.66 real 28.80 user 8.79 sys
1366 7904 maximum resident set size
1367 1356 average shared memory size
1368 18566 average unshared data size
1369 229 average unshared stack size
1370 46080 page reclaims
1371 33373 page faults
1372
1373With %seen holding simple scalars:
1374
1375 342.16 real 27.11 user 3.54 sys
1376 8388 maximum resident set size
1377 1394 average shared memory size
1378 14969 average unshared data size
1379 236 average unshared stack size
1380 28159 page reclaims
1381 9839 page faults
1382
1383Yes, 5 minutes is faster than 15. Above is for CP936 in CN. Only difference is
1384how %seen is storing things its seen. So it is pathalogically bad on a 16M
1385RAM machine, but it's going to help even on modern machines.
1386Swapping is bad, m'kay :-)