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;
10 my @orig_ARGV = @ARGV;
11 our $VERSION = do { my @r = (q$Revision: 1.20 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
13 # These may get re-ordered.
14 # RAW is a do_now as inserted by &enter
15 # AGG is an aggreagated do_now, as built up by &process
32 # (See the algorithm in encengine.c - we're building structures for it)
34 # There are two sorts of structures.
35 # "do_now" (an array, two variants of what needs storing) is whatever we need
36 # to do now we've read an input byte.
37 # It's housed in a "do_next" (which is how we got to it), and in turn points
38 # to a "do_next" which contains all the "do_now"s for the next input byte.
40 # There will be a "do_next" which is the start state.
41 # For a single byte encoding it's the only "do_next" - each "do_now" points
42 # back to it, and each "do_now" will cause bytes. There is no state.
44 # For a multi-byte encoding where all characters in the input are the same
45 # length, then there will be a tree of "do_now"->"do_next"->"do_now"
46 # branching out from the start state, one step for each input byte.
47 # The leaf "do_now"s will all be at the same distance from the start state,
48 # only the leaf "do_now"s cause output bytes, and they in turn point back to
51 # For an encoding where there are varaible length input byte sequences, you
52 # will encounter a leaf "do_now" sooner for the shorter input sequences, but
53 # as before the leaves will point back to the start state.
55 # The system will cope with escape encodings (imagine them as a mostly
56 # self-contained tree for each escape state, and cross links between trees
57 # at the state-switching characters) but so far no input format defines these.
59 # The system will also cope with having output "leaves" in the middle of
60 # the bifurcating branches, not just at the extremities, but again no
61 # input format does this yet.
63 # There are two variants of the "do_now" structure. The first, smaller variant
64 # is generated by &enter as the input file is read. There is one structure
65 # for each input byte. Say we are mapping a single byte encoding to a
66 # single byte encoding, with "ABCD" going "abcd". There will be
67 # 4 "do_now"s, {"A" => [...,"a",...], "B" => [...,"b",...], "C"=>..., "D"=>...}
69 # &process then walks the tree, building aggregate "do_now" structres for
70 # adjacent bytes where possible. The aggregate is for a contiguous range of
71 # bytes which each produce the same length of output, each move to the
72 # same next state, and each have the same fallback flag.
73 # So our 4 RAW "do_now"s above become replaced by a single structure
75 # ["A", "D", "abcd", 1, ...]
76 # ie, for an input byte $_ in "A".."D", output 1 byte, found as
77 # substr ("abcd", (ord $_ - ord "A") * 1, 1)
78 # which maps very nicely into pointer arithmetic in C for encengine.c
82 # UTF-8 encode long hand - only covers part of perl's range
84 # chr() works in native space so convert value from table
85 # into that space before using chr().
86 my $ch = chr(utf8::unicode_to_native($_[0]));
87 # Now get core perl to encode that the way it likes.
95 ## my ($ch,$page) = @_; return chr($ch);
101 # encode double byte MS byte first
102 ## my ($ch,$page) = @_; return chr($page).chr($ch);
103 return chr ($_[1]) . chr $_[0];
108 # encode Multi-byte - single for 0..255 otherwise double
109 ## my ($ch,$page) = @_;
110 ## return &encode_D if $page;
112 return chr ($_[1]) . chr $_[0] if $_[1];
116 my %encode_types = (U => \&encode_U,
122 # Win32 does not expand globs on command line
123 eval "\@ARGV = map(glob(\$_),\@ARGV)" if ($^O eq 'MSWin32');
127 # -Q to disable the duplicate codepoint test
128 # -S make mapping errors fatal
129 # -q to remove comments written to output files
130 # -O to enable the (brute force) substring optimiser
131 # -o <output> to specify the output file name (else it's the first arg)
132 # -f <inlist> to give a file with a list of input files (else use the args)
133 # -n <name> to name the encoding (else use the basename of the input file.
134 getopts('M:SQqOo:f:n:',\%opt);
136 $opt{M} and make_makefile_pl($opt{M}, @ARGV);
138 # This really should go first, else the die here causes empty (non-erroneous)
139 # output files to be written.
141 if (exists $opt{'f'}) {
142 # -F is followed by name of file containing list of filenames
143 my $flist = $opt{'f'};
144 open(FLIST,$flist) || die "Cannot open $flist:$!";
145 chomp(@encfiles = <FLIST>);
151 my $cname = (exists $opt{'o'}) ? $opt{'o'} : shift(@ARGV);
152 chmod(0666,$cname) if -f $cname && !-w $cname;
153 open(C,">$cname") || die "Cannot open $cname:$!";
158 my ($doC,$doEnc,$doUcm,$doPet);
160 if ($cname =~ /\.(c|xs)$/)
163 $dname =~ s/(\.[^\.]*)?$/.exh/;
164 chmod(0666,$dname) if -f $cname && !-w $dname;
165 open(D,">$dname") || die "Cannot open $dname:$!";
166 $hname =~ s/(\.[^\.]*)?$/.h/;
167 chmod(0666,$hname) if -f $cname && !-w $hname;
168 open(H,">$hname") || die "Cannot open $hname:$!";
170 foreach my $fh (\*C,\*D,\*H)
172 print $fh <<"END" unless $opt{'q'};
174 !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
175 This file was autogenerated by:
181 if ($cname =~ /(\w+)\.xs$/)
183 print C "#include <EXTERN.h>\n";
184 print C "#include <perl.h>\n";
185 print C "#include <XSUB.h>\n";
186 print C "#define U8 U8\n";
188 print C "#include \"encode.h\"\n";
191 elsif ($cname =~ /\.enc$/)
195 elsif ($cname =~ /\.ucm$/)
199 elsif ($cname =~ /\.pet$/)
212 if ($a =~ /^.*-(\d+)/)
215 if ($b =~ /^.*-(\d+)/)
225 foreach my $enc (sort cmp_name @encfiles)
227 my ($name,$sfx) = $enc =~ /^.*?([\w-]+)\.(enc|ucm)$/;
228 $name = $opt{'n'} if exists $opt{'n'};
233 compile_enc(\*E,lc($name));
237 compile_ucm(\*E,lc($name));
242 warn "Cannot open $enc for $name:$!";
248 print STDERR "Writing compiled form\n";
249 foreach my $name (sort cmp_name keys %encoding)
251 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
252 output(\*C,$name.'_utf8',$e2u);
253 output(\*C,'utf8_'.$name,$u2e);
254 push(@{$encoding{$name}},outstring(\*C,$e2u->{Cname}.'_def',$erep));
256 foreach my $enc (sort cmp_name keys %encoding)
258 my ($e2u,$u2e,$rep,$min_el,$max_el,$rsym) = @{$encoding{$enc}};
259 my @info = ($e2u->{Cname},$u2e->{Cname},$rsym,length($rep),$min_el,$max_el);
260 my $sym = "${enc}_encoding";
262 print C "encode_t $sym = \n";
263 print C " {",join(',',@info,"{\"$enc\",(const char *)0}"),"};\n\n";
266 foreach my $enc (sort cmp_name keys %encoding)
268 my $sym = "${enc}_encoding";
270 print H "extern encode_t $sym;\n";
271 print D " Encode_XSEncoding(aTHX_ &$sym);\n";
274 if ($cname =~ /(\w+)\.xs$/)
280 Encode_XSEncoding(pTHX_ encode_t *enc)
283 HV *stash = gv_stashpv("Encode::XS", TRUE);
284 SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
290 const char *name = enc->name[i++];
291 XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
294 call_pv("Encode::define_encoding",G_DISCARD);
300 print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n";
301 print C "BOOT:\n{\n";
302 print C "#include \"$dname\"\n";
305 # Close in void context is bad, m'kay
306 close(D) or warn "Error closing '$dname': $!";
307 close(H) or warn "Error closing '$hname': $!";
309 my $perc_saved = $strings/($strings + $saved) * 100;
310 my $perc_subsaved = $strings/($strings + $subsave) * 100;
311 printf STDERR "%d bytes in string tables\n",$strings;
312 printf STDERR "%d bytes (%.3g%%) saved spotting duplicates\n",
313 $saved, $perc_saved if $saved;
314 printf STDERR "%d bytes (%.3g%%) saved using substrings\n",
315 $subsave, $perc_subsaved if $subsave;
319 foreach my $name (sort cmp_name keys %encoding)
321 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
322 output_enc(\*C,$name,$e2u);
327 foreach my $name (sort cmp_name keys %encoding)
329 my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
330 output_ucm(\*C,$name,$u2e,$erep,$min_el,$max_el);
334 # writing half meg files and then not checking to see if you just filled the
336 close(C) or die "Error closing '$cname': $!";
338 # End of the main program.
350 last if /^\s*CHARMAP\s*$/i;
351 if (/^\s*<(\w+)>\s+"?([^"]*)"?\s*$/i) # " # Grrr
356 if (!defined($cs = $attr{'code_set_name'}))
358 warn "No <code_set_name> in $name\n";
362 $name = $cs unless exists $opt{'n'};
368 if (exists $attr{'subchar'})
371 $attr{'subchar'} =~ /^\s*/cg;
372 push(@byte,$1) while $attr{'subchar'} =~ /\G\\x([0-9a-f]+)/icg;
373 $erep = join('',map(chr(hex($_)),@byte));
375 print "Reading $name ($cs)\n";
381 last if /^\s*END\s+CHARMAP\s*$/i;
383 my (@uni, @byte) = ();
384 my ($uni, $byte, $fb) = m/^(\S+)\s+(\S+)\s+(\S+)\s+/o
385 or die "Bad line: $_";
386 while ($uni =~ m/\G<([U0-9a-fA-F\+]+)>/g){
387 push @uni, map { substr($_, 1) } split(/\+/, $1);
389 while ($byte =~ m/\G\\x([0-9a-fA-F]+)/g){
394 my $uch = join('', map { encode_U(hex($_)) } @uni );
395 my $ech = join('',map(chr(hex($_)),@byte));
396 my $el = length($ech);
397 $max_el = $el if (!defined($max_el) || $el > $max_el);
398 $min_el = $el if (!defined($min_el) || $el < $min_el);
409 # $fb is fallback flag
410 # 0 - round trip safe
411 # 1 - fallback for unicode -> enc
412 # 2 - skip sub-char mapping
413 # 3 - fallback enc -> unicode
414 enter($u2e,$uch,$ech,$u2e,$fb+0) if ($fb =~ /[01]/);
415 enter($e2u,$ech,$uch,$e2u,$fb+0) if ($fb =~ /[03]/);
424 die "$nfb entries without fallback, $hfb entries with\n";
426 $encoding{$name} = [$e2u,$u2e,$erep,$min_el,$max_el];
438 while ($type = <$fh>)
440 last if $type !~ /^\s*#/;
443 return if $type eq 'E';
444 # Do the hash lookup once, rather than once per function call. 4% speedup.
445 my $type_func = $encode_types{$type};
446 my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
447 warn "$type encoded $name\n";
449 # Save a defined test by setting these to defined values.
450 my $min_el = ~0; # A very big integer
451 my $max_el = 0; # Anything must be longer than 0
454 $rep = &$type_func($v & 0xFF, ($v >> 8) & 0xffe);
458 # use -Q to silence the seen test. Makefile.PL uses this by default.
459 $seen = {} unless $opt{Q};
464 my $page = hex($line);
469 # So why is it 1% faster to leave the my here?
471 $line =~ s/\r\n$/\n/;
472 die "$.:${line}Line should be exactly 65 characters long including
473 newline (".length($line).")" unless length ($line) == 65;
474 # Split line into groups of 4 hex digits, convert groups to ints
476 # map {hex $_} $line =~ /(....)/g
477 # This takes 63.75 (2.5% less time)
478 # unpack "n*", pack "H*", $line
479 # There's an implicit loop in map. Loops are bad, m'kay. Ops are bad, m'kay
480 # Doing it as while ($line =~ /(....)/g) took 74.63
481 foreach my $val (unpack "n*", pack "H*", $line)
483 next if $val == 0xFFFD;
484 my $ech = &$type_func($ch,$page);
485 if ($val || (!$ch && !$page))
487 my $el = length($ech);
488 $max_el = $el if $el > $max_el;
489 $min_el = $el if $el < $min_el;
490 my $uch = encode_U($val);
492 # We're doing the test.
493 # We don't need to read this quickly, so storing it as a scalar,
494 # rather than 3 (anon array, plus the 2 scalars it holds) saves
495 # RAM and may make us faster on low RAM systems. [see __END__]
496 if (exists $seen->{$uch})
498 warn sprintf("U%04X is %02X%02X and %04X\n",
499 $val,$page,$ch,$seen->{$uch});
504 $seen->{$uch} = $page << 8 | $ch;
507 # Passing 2 extra args each time is 3.6% slower!
508 # Even with having to add $fallback ||= 0 later
509 enter_fb0($e2u,$ech,$uch);
510 enter_fb0($u2e,$uch,$ech);
514 # No character at this position
515 # enter($e2u,$ech,undef,$e2u);
521 die "\$min_el=$min_el, \$max_el=$max_el - seems we read no lines"
522 if $min_el > $max_el;
523 die "$errors mapping conflicts\n" if ($errors && $opt{'S'});
524 $encoding{$name} = [$e2u,$u2e,$rep,$min_el,$max_el];
527 # my ($a,$s,$d,$t,$fb) = @_;
529 my ($current,$inbytes,$outbytes,$next,$fallback) = @_;
530 # state we shift to after this (multibyte) input character defaults to same
533 # Making sure it is defined seems to be faster than {no warnings;} in
534 # &process, or passing it in as 0 explicity.
535 # XXX $fallback ||= 0;
537 # Start at the beginning and work forwards through the string to zero.
538 # effectively we are removing 1 character from the front each time
539 # but we don't actually edit the string. [this alone seems to be 14% speedup]
540 # Hence -$pos is the length of the remaining string.
541 my $pos = -length $inbytes;
543 my $byte = substr $inbytes, $pos, 1;
546 # RAW_OUT_BYTES => 2,
548 # to unicode an array would seem to be better, because the pages are dense.
549 # from unicode can be very sparse, favouring a hash.
550 # hash using the bytes (all length 1) as keys rather than ord value,
551 # as it's easier to sort these in &process.
553 # It's faster to always add $fallback even if it's undef, rather than
554 # choosing between 3 and 4 element array. (hence why we set it defined
556 my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,'',$fallback];
557 # When $pos was -1 we were at the last input character.
559 $do_now->[RAW_OUT_BYTES] = $outbytes;
560 $do_now->[RAW_NEXT] = $next;
563 # Tail recursion. The intermdiate state may not have a name yet.
564 $current = $do_now->[RAW_NEXT];
568 # This is purely for optimistation. It's just &enter hard coded for $fallback
569 # of 0, using only a 3 entry array ref to save memory for every entry.
571 my ($current,$inbytes,$outbytes,$next) = @_;
574 my $pos = -length $inbytes;
576 my $byte = substr $inbytes, $pos, 1;
577 my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,''];
579 $do_now->[RAW_OUT_BYTES] = $outbytes;
580 $do_now->[RAW_NEXT] = $next;
583 $current = $do_now->[RAW_NEXT];
590 my ($fh,$name,$s) = @_;
591 my $sym = $strings{$s};
594 $saved += length($s);
599 foreach my $o (keys %strings)
601 next unless (my $i = index($o,$s)) >= 0;
603 # gcc things that 0x0e+0x10 (anything with e+) starts to look like
604 # a hexadecimal floating point constant. Silly gcc. Only p
605 # introduces a floating point constant. Put the space in to stop it
607 $sym .= sprintf(" +0x%02x",$i) if ($i);
608 $subsave += length($s);
609 return $strings{$s} = $sym;
612 $strings{$s} = $sym = $name;
613 $strings += length($s);
614 my $definition = sprintf "static const U8 %s[%d] = { ",$name,length($s);
615 # Maybe we should assert that these are all <256.
616 $definition .= join(',',unpack "C*",$s);
617 # We have a single long line. Split it at convenient commas.
618 $definition =~ s/(.{74,77},)/$1\n/g;
619 print $fh "$definition };\n\n";
630 my ($l, $agg_max_in, $agg_next, $agg_in_len, $agg_out_len, $agg_fallback);
633 foreach my $key (sort keys %$raw) {
636 # RAW_OUT_BYTES => 2,
638 my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
639 # Now we are converting from raw to aggregate, switch from 1 byte strings
644 # If this == fails, we're going to reset $agg_max_in below anyway.
645 $b == ++$agg_max_in &&
646 # References in numeric context give the pointer as an int.
647 $agg_next == $next &&
648 $agg_in_len == $in_len &&
649 $agg_out_len == length $out_bytes &&
650 $agg_fallback == $fallback
651 # && length($l->[AGG_OUT_BYTES]) < 16
653 # my $i = ord($b)-ord($l->[AGG_MIN_IN]);
654 # we can aggregate this byte onto the end.
655 $l->[AGG_MAX_IN] = $b;
656 $l->[AGG_OUT_BYTES] .= $out_bytes;
660 # AGG_OUT_BYTES => 2,
665 # Reset the last thing we saw, plus set 5 lexicals to save some derefs.
666 # (only gains .6% on euc-jp -- is it worth it?)
667 push @ent, $l = [$b, $agg_max_in = $b, $out_bytes, $agg_next = $next,
668 $agg_in_len = $in_len, $agg_out_len = length $out_bytes,
669 $agg_fallback = $fallback];
671 if (exists $next->{Cname}) {
672 $next->{'Forward'} = 1 if $next != $a;
674 process(sprintf("%s_%02x",$name,$b),$next);
677 # encengine.c rules say that last entry must be for 255
678 if ($agg_max_in < 255) {
679 push @ent, [1+$agg_max_in, 255,undef,$a,0,0];
681 $a->{'Entries'} = \@ent;
687 my $name = $a->{'Cname'};
689 foreach my $b (@{$a->{'Entries'}})
691 next unless $b->[AGG_OUT_LEN];
692 my $s = $b->[AGG_MIN_IN];
693 my $e = $b->[AGG_MAX_IN];
694 outstring($fh,sprintf("%s__%02x_%02x",$name,$s,$e),$b->[AGG_OUT_BYTES]);
698 print $fh "\nstatic encpage_t $name\[",scalar(@{$a->{'Entries'}}),"];\n";
701 foreach my $b (@{$a->{'Entries'}})
703 my ($s,$e,$out,$t,$end,$l) = @$b;
704 outtable($fh,$t) unless $t->{'Done'};
706 print $fh "\nstatic encpage_t $name\[",scalar(@{$a->{'Entries'}}),"] = {\n";
707 foreach my $b (@{$a->{'Entries'}})
709 my ($sc,$ec,$out,$t,$end,$l,$fb) = @$b;
714 printf $fh outstring($fh,'',$out);
720 print $fh ",",$t->{Cname};
721 printf $fh ",0x%02x,0x%02x,$l,$end},\n",$sc,$ec;
728 my ($fh,$name,$a) = @_;
736 my ($fh,$name,$a) = @_;
737 die "Changed - fix me for new structure";
738 foreach my $b (sort keys %$a)
740 my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}};
752 my $s = do "unicore/Name.pl";
753 die "char_names: unicore/Name.pl: $!\n" unless defined $s;
755 while ($s =~ /\G([0-9a-f]+)\t([0-9a-f]*)\t(.*?)\s*\n/igc)
759 last if $s >= 0x10000;
760 my $e = length($2) ? hex($2) : $s;
761 for (my $i = $s; $i <= $e; $i++)
764 # print sprintf("U%04X $name\n",$i);
771 my ($cmap,$a,$t,$pre) = @_;
772 # warn sprintf("Page %x\n",$pre);
774 foreach my $key (sort keys %$raw) {
777 # RAW_OUT_BYTES => 2,
779 my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
783 if ($next != $a && $next != $t) {
784 output_ucm_page($cmap,$a,$next,(($pre|($u &0x3F)) << 6)&0xFFFF);
785 } elsif (length $out_bytes) {
787 $u = $pre|($u &0x3f);
789 my $s = sprintf "<U%04X> ",$u;
790 #foreach my $c (split(//,$out_bytes)) {
791 # $s .= sprintf "\\x%02X",ord($c);
793 # 9.5% faster changing that loop to this:
794 $s .= sprintf +("\\x%02X" x length $out_bytes), unpack "C*", $out_bytes;
795 $s .= sprintf " |%d # %s\n",($fallback ? 1 : 0),$uname[$u];
798 warn join(',',$u, @{$raw->{$key}},$a,$t);
805 my ($fh,$name,$h,$rep,$min_el,$max_el) = @_;
806 print $fh "# $0 @orig_ARGV\n" unless $opt{'q'};
807 print $fh "<code_set_name> \"$name\"\n";
811 print $fh "<mb_cur_min> $min_el\n";
815 print $fh "<mb_cur_max> $max_el\n";
819 print $fh "<subchar> ";
820 foreach my $c (split(//,$rep))
822 printf $fh "\\x%02X",ord($c);
827 output_ucm_page(\@cmap,$h,$h,0);
828 print $fh "#\nCHARMAP\n";
829 foreach my $line (sort { substr($a,8) cmp substr($b,8) } @cmap)
833 print $fh "END CHARMAP\n";
847 eval { require Encode; };
848 $@ and die "You need to install Encode to use enc2xs -M\nerror: $@\n";
849 # our used for variable expanstion
851 $_Version = $VERSION;
852 $_Inc = $INC{"Encode.pm"}; $_Inc =~ s/\.pm$//o;
854 $_TableFiles = join(",", map {qq('$_')} @_);
855 $_Now = scalar localtime();
856 warn "Generating Makefile.PL\n";
857 _print_expand("$_Inc/Makefile_PL.e2x", "Makefile.PL");
858 warn "Generating $_Name.pm\n";
859 _print_expand("$_Inc/_PM.e2x", "$_Name.pm");
860 warn "Generating t/$_Name.t\n";
861 _print_expand("$_Inc/_T.e2x", "t/$_Name.t");
862 warn "Generating README\n";
863 _print_expand("$_Inc/README.e2x", "README");
864 warn "Generating t/$_Name.t\n";
865 _print_expand("$_Inc/Changes.e2x", "Changes");
870 eval { require File::Basename; };
871 $@ and die "File::Basename needed. Are you on miniperl?;\nerror: $@\n";
872 File::Basename->import();
873 my ($src, $dst) = @_;
874 open my $in, $src or die "$src : $!";
875 if ((my $d = dirname($dst)) ne '.'){
876 -d $d or mkdir $d, 0755 or die "mkdir $d : $!";
878 open my $out, ">$dst" or die "$!";
881 if (/^#### END_OF_HEADER/){
884 s/(\$_[A-Z][A-Za-z0-9]+)_/$1/gee unless $asis;
892 enc2xs -- Perl Encode Module Generator
896 enc2xs -M ModName mapfiles...
901 F<enc2xs> builds a Perl extension for use by Encode from either
902 Unicode Character Mapping files (.ucm) or Tcl Encoding Files
903 (.enc) Besides internally used during the build process of Encode
904 module, you can use F<enc2xs> to add your own encoding to perl. No
905 knowledge on XS is necessary.
909 If what you want to know as little about Perl possible but needs to
910 add a new encoding, just read this chapter and forget the rest.
916 Have a .ucm file ready. You can get it from somewhere or you can
917 write your own from scratch or you can grab one from Encode
918 distribution and customize. For UCM format, see the next Chapter.
919 In the example below, I'll call my theoretical encoding myascii,
920 defined inI<my.ucm>. C<$> is a shell prompt.
927 Issue a command as follows;
929 $ enc2xs -M My my.ucm
930 generating Makefile.PL
935 Now take a look at your current directory. It should look like this.
938 Makefile.PL My.pm my.ucm t/
940 The following files are created.
942 Makefle.PL - MakeMaker script
943 My.pm - Encode Submodule
948 If you want *.ucm installed together with the modules, do as follows;
952 $ enc2xs -M My Encode/*ucm
956 Edit the files generated. You don't have to if you have no time AND no
957 intention to give it to someone else. But it is a good idea to edit
958 pod and add more tests.
962 Now issue a command all Perl Mongers love;
964 $ perl5.7.3 Makefile.PL
965 Writing Makefile for Encode::My
969 Now all you have to do is make.
972 cp My.pm blib/lib/Encode/My.pm
973 /usr/local/bin/perl /usr/local/bin/enc2xs -Q -O \
974 -o encode_t.c -f encode_t.fnm
975 Reading myascii (myascii)
976 Writing compiled form
977 128 bytes in string tables
978 384 bytes (25%) saved spotting duplicates
979 1 bytes (99.2%) saved using substrings
981 chmod 644 blib/arch/auto/Encode/My/My.bs
984 The time it takes varies how fast your machine is and how large your
985 encoding is. Unless you are working on something big like euc-tw, it
990 You can "make install" already but you should test first.
993 PERL_DL_NONLAZY=1 /usr/local/bin/perl -Iblib/arch -Iblib/lib \
994 -e 'use Test::Harness qw(&runtests $verbose); \
995 $verbose=0; runtests @ARGV;' t/*.t
997 All tests successful.
998 Files=1, Tests=2, 0 wallclock secs
999 ( 0.09 cusr + 0.01 csys = 0.09 CPU)
1003 If you are content with the test result, just "make install"
1007 =head1 The Unicode Character Map
1009 Encode uses The Unicode Character Map (UCM) for source character
1010 mappings. This format is used by ICU package of IBM and adopted by
1011 Nick Ing-Simmons. Since UCM is more flexible than Tcl's Encoding Map
1012 and far more user-friendly, This is the recommended formet for
1015 UCM file looks like this.
1020 <code_set_name> "US-ascii" # Required
1021 <code_set_alias> "ascii" # Optional
1022 <mb_cur_min> 1 # Required; usually 1
1023 <mb_cur_max> 1 # Max. # of bytes/char
1024 <subchar> \x3F # Substitution char
1027 <U0000> \x00 |0 # <control>
1028 <U0001> \x01 |0 # <control>
1029 <U0002> \x02 |0 # <control>
1031 <U007C> \x7C |0 # VERTICAL LINE
1032 <U007D> \x7D |0 # RIGHT CURLY BRACKET
1033 <U007E> \x7E |0 # TILDE
1034 <U007F> \x7F |0 # <control>
1041 Anything that follows C<#> is treated as comments.
1045 The header section continues until CHARMAP. This section Has a form of
1046 I<E<lt>keywordE<gt> value>, one at a line. For a value, strings must
1047 be quoted. Barewords are treated as numbers. I<\xXX> represents a
1050 Most of the keywords are self-explanatory. I<subchar> means
1051 substitution character, not subcharacter. When you decode a Unicode
1052 sequence to this encoding but no matching character is found, the byte
1053 sequence defined here will be used. For most cases, the value here is
1054 \x3F, in ASCII this is a question mark.
1058 CHARMAP starts the character map section. Each line has a form as
1061 <UXXXX> \xXX.. |0 # comment
1063 | | +- Fallback flag
1064 | +-------- Encoded byte sequence
1065 +-------------- Unicode Character ID in hex
1067 The format is roughly the same as a header section except for fallback
1068 flag. It is | followed by 0..3. And their meaning as follows
1074 Round trip safe. A character decoded to Unicode encodes back to the
1075 same byte sequence. most character belong to this.
1079 Fallback for unicode -> encoding. When seen, enc2xs adds this
1080 character for encode map only
1084 Skip sub-char mapping should there be no code point.
1088 Fallback for encoding -> unicode. When seen, enc2xs adds this
1089 character for decode map only
1095 And finally, END OF CHARMAP ends the section.
1099 Needless to say, if you are manually creating a UCM file, you should
1100 copy ascii.ucm or existing encoding which is close to yours than write
1101 your own from scratch.
1103 When you do so, make sure you leave at least B<U0000> to B<U0020> as
1104 is, unless your environment is on EBCDIC.
1106 B<CAVEAT>: not all features in UCM are implemented. For example,
1107 icu:state is not used. Because of that, you need to write a perl
1108 module if you want to support algorithmical encodings, notablly
1109 ISO-2022 series. Such modules include L<Encode::JP::2022_JP>,
1110 L<Encode::KR::2022_KR>, and L<Encode::TW::HZ>.
1115 L<http://oss.software.ibm.com/icu/>
1117 ICU Character Mapping Tables
1118 L<http://oss.software.ibm.com/icu/charset/>
1121 L<http://oss.software.ibm.com/icu/userguide/conversion-data.html>
1131 # -Q to disable the duplicate codepoint test
1132 # -S make mapping errors fatal
1133 # -q to remove comments written to output files
1134 # -O to enable the (brute force) substring optimiser
1135 # -o <output> to specify the output file name (else it's the first arg)
1136 # -f <inlist> to give a file with a list of input files (else use the args)
1137 # -n <name> to name the encoding (else use the basename of the input file.
1139 With %seen holding array refs:
1141 865.66 real 28.80 user 8.79 sys
1142 7904 maximum resident set size
1143 1356 average shared memory size
1144 18566 average unshared data size
1145 229 average unshared stack size
1149 With %seen holding simple scalars:
1151 342.16 real 27.11 user 3.54 sys
1152 8388 maximum resident set size
1153 1394 average shared memory size
1154 14969 average unshared data size
1155 236 average unshared stack size
1159 Yes, 5 minutes is faster than 15. Above is for CP936 in CN. Only difference is
1160 how %seen is storing things its seen. So it is pathalogically bad on a 16M
1161 RAM machine, but it's going to help even on modern machines.
1162 Swapping is bad, m'kay :-)