#!/import/bw/tools/local/perl-5.8.0/bin/perl
eval 'exec /import/bw/tools/local/perl-5.8.0/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
# @INC poking no longer needed w/ new MakeMaker and Makefile.PL's
# with $ENV{PERL_CORE} set
# In case we need it in future...
require Config; import Config;
our $VERSION = do { my @r = (q$Revision: 1.30 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
# These may get re-ordered.
# RAW is a do_now as inserted by &enter
# AGG is an aggreagated do_now, as built up by &process
# (See the algorithm in encengine.c - we're building structures for it)
# There are two sorts of structures.
# "do_now" (an array, two variants of what needs storing) is whatever we need
# to do now we've read an input byte.
# It's housed in a "do_next" (which is how we got to it), and in turn points
# to a "do_next" which contains all the "do_now"s for the next input byte.
# There will be a "do_next" which is the start state.
# For a single byte encoding it's the only "do_next" - each "do_now" points
# back to it, and each "do_now" will cause bytes. There is no state.
# For a multi-byte encoding where all characters in the input are the same
# length, then there will be a tree of "do_now"->"do_next"->"do_now"
# branching out from the start state, one step for each input byte.
# The leaf "do_now"s will all be at the same distance from the start state,
# only the leaf "do_now"s cause output bytes, and they in turn point back to
# For an encoding where there are varaible length input byte sequences, you
# will encounter a leaf "do_now" sooner for the shorter input sequences, but
# as before the leaves will point back to the start state.
# The system will cope with escape encodings (imagine them as a mostly
# self-contained tree for each escape state, and cross links between trees
# at the state-switching characters) but so far no input format defines these.
# The system will also cope with having output "leaves" in the middle of
# the bifurcating branches, not just at the extremities, but again no
# input format does this yet.
# There are two variants of the "do_now" structure. The first, smaller variant
# is generated by &enter as the input file is read. There is one structure
# for each input byte. Say we are mapping a single byte encoding to a
# single byte encoding, with "ABCD" going "abcd". There will be
# 4 "do_now"s, {"A" => [...,"a",...], "B" => [...,"b",...], "C"=>..., "D"=>...}
# &process then walks the tree, building aggregate "do_now" structres for
# adjacent bytes where possible. The aggregate is for a contiguous range of
# bytes which each produce the same length of output, each move to the
# same next state, and each have the same fallback flag.
# So our 4 RAW "do_now"s above become replaced by a single structure
# ["A", "D", "abcd", 1, ...]
# ie, for an input byte $_ in "A".."D", output 1 byte, found as
# substr ("abcd", (ord $_ - ord "A") * 1, 1)
# which maps very nicely into pointer arithmetic in C for encengine.c
# UTF-8 encode long hand - only covers part of perl's range
# chr() works in native space so convert value from table
# into that space before using chr().
my $ch = chr(utf8::unicode_to_native($_[0]));
# Now get core perl to encode that the way it likes.
## my ($ch,$page) = @_; return chr($ch);
# encode double byte MS byte first
## my ($ch,$page) = @_; return chr($page).chr($ch);
return chr ($_[1]) . chr $_[0];
# encode Multi-byte - single for 0..255 otherwise double
## return &encode_D if $page;
return chr ($_[1]) . chr $_[0] if $_[1];
my %encode_types = (U => \&encode_U,
# Win32 does not expand globs on command line
eval "\@ARGV = map(glob(\$_),\@ARGV)" if ($^O eq 'MSWin32');
# -Q to disable the duplicate codepoint test
# -S make mapping errors fatal
# -q to remove comments written to output files
# -O to enable the (brute force) substring optimiser
# -o <output> to specify the output file name (else it's the first arg)
# -f <inlist> to give a file with a list of input files (else use the args)
# -n <name> to name the encoding (else use the basename of the input file.
getopts('CM:SQqOo:f:n:',\%opt);
$opt{M} and make_makefile_pl($opt{M}, @ARGV);
$opt{C} and make_configlocal_pm($opt{C}, @ARGV);
# This really should go first, else the die here causes empty (non-erroneous)
# output files to be written.
# -F is followed by name of file containing list of filenames
open(FLIST,$flist) || die "Cannot open $flist:$!";
chomp(@encfiles = <FLIST>);
my $cname = (exists $opt{'o'}) ? $opt{'o'} : shift(@ARGV);
chmod(0666,$cname) if -f $cname && !-w $cname;
open(C,">$cname") || die "Cannot open $cname:$!";
my ($doC,$doEnc,$doUcm,$doPet);
if ($cname =~ /\.(c|xs)$/)
$dname =~ s/(\.[^\.]*)?$/.exh/;
chmod(0666,$dname) if -f $cname && !-w $dname;
open(D,">$dname") || die "Cannot open $dname:$!";
$hname =~ s/(\.[^\.]*)?$/.h/;
chmod(0666,$hname) if -f $cname && !-w $hname;
open(H,">$hname") || die "Cannot open $hname:$!";
foreach my $fh (\*C,\*D,\*H)
print $fh <<"END" unless $opt{'q'};
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file was autogenerated by:
if ($cname =~ /(\w+)\.xs$/)
print C "#include <EXTERN.h>\n";
print C "#include <perl.h>\n";
print C "#include <XSUB.h>\n";
print C "#define U8 U8\n";
print C "#include \"encode.h\"\n";
elsif ($cname =~ /\.enc$/)
elsif ($cname =~ /\.ucm$/)
elsif ($cname =~ /\.pet$/)
foreach my $enc (sort cmp_name @encfiles)
my ($name,$sfx) = $enc =~ /^.*?([\w-]+)\.(enc|ucm)$/;
$name = $opt{'n'} if exists $opt{'n'};
compile_enc(\*E,lc($name));
compile_ucm(\*E,lc($name));
warn "Cannot open $enc for $name:$!";
print STDERR "Writing compiled form\n";
foreach my $name (sort cmp_name keys %encoding)
my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
output(\*C,$name.'_utf8',$e2u);
output(\*C,'utf8_'.$name,$u2e);
# push(@{$encoding{$name}},outstring(\*C,$e2u->{Cname}.'_def',$erep));
foreach my $enc (sort cmp_name keys %encoding)
# my ($e2u,$u2e,$rep,$min_el,$max_el,$rsym) = @{$encoding{$enc}};
my ($e2u,$u2e,$rep,$min_el,$max_el) = @{$encoding{$enc}};
#my @info = ($e2u->{Cname},$u2e->{Cname},$rsym,length($rep),$min_el,$max_el);
$replen++ while($rep =~ /\G\\x[0-9A-Fa-f]/g);
my @info = ($e2u->{Cname},$u2e->{Cname},qq((U8 *)"$rep"),$replen,$min_el,$max_el);
my $sym = "${enc}_encoding";
print C "encode_t $sym = \n";
# This is to make null encoding work -- dankogai
for (my $i = (scalar @info) - 1; $i >= 0; --$i){
# end of null tweak -- dankogai
print C " {",join(',',@info,"{\"$enc\",(const char *)0}"),"};\n\n";
foreach my $enc (sort cmp_name keys %encoding)
my $sym = "${enc}_encoding";
print H "extern encode_t $sym;\n";
print D " Encode_XSEncoding(aTHX_ &$sym);\n";
if ($cname =~ /(\w+)\.xs$/)
Encode_XSEncoding(pTHX_ encode_t *enc)
HV *stash = gv_stashpv("Encode::XS", TRUE);
SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(enc))),stash);
const char *name = enc->name[i++];
XPUSHs(sv_2mortal(newSVpvn(name,strlen(name))));
call_pv("Encode::define_encoding",G_DISCARD);
print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n";
print C "#include \"$dname\"\n";
# Close in void context is bad, m'kay
close(D) or warn "Error closing '$dname': $!";
close(H) or warn "Error closing '$hname': $!";
my $perc_saved = $strings/($strings + $saved) * 100;
my $perc_subsaved = $strings/($strings + $subsave) * 100;
printf STDERR "%d bytes in string tables\n",$strings;
printf STDERR "%d bytes (%.3g%%) saved spotting duplicates\n",
$saved, $perc_saved if $saved;
printf STDERR "%d bytes (%.3g%%) saved using substrings\n",
$subsave, $perc_subsaved if $subsave;
foreach my $name (sort cmp_name keys %encoding)
my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
output_enc(\*C,$name,$e2u);
foreach my $name (sort cmp_name keys %encoding)
my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
output_ucm(\*C,$name,$u2e,$erep,$min_el,$max_el);
# writing half meg files and then not checking to see if you just filled the
close(C) or die "Error closing '$cname': $!";
# End of the main program.
last if /^\s*CHARMAP\s*$/i;
if (/^\s*<(\w+)>\s+"?([^"]*)"?\s*$/i) # " # Grrr
if (!defined($cs = $attr{'code_set_name'}))
warn "No <code_set_name> in $name\n";
$name = $cs unless exists $opt{'n'};
if (exists $attr{'subchar'})
#$attr{'subchar'} =~ /^\s*/cg;
#push(@byte,$1) while $attr{'subchar'} =~ /\G\\x([0-9a-f]+)/icg;
#$erep = join('',map(chr(hex($_)),@byte));
$erep = $attr{'subchar'};
$erep =~ s/^\s+//; $erep =~ s/\s+$//;
print "Reading $name ($cs)\n";
last if /^\s*END\s+CHARMAP\s*$/i;
my ($uni, $byte, $fb) = m/^(\S+)\s+(\S+)\s+(\S+)\s+/o
while ($uni =~ m/\G<([U0-9a-fA-F\+]+)>/g){
push @uni, map { substr($_, 1) } split(/\+/, $1);
while ($byte =~ m/\G\\x([0-9a-fA-F]+)/g){
my $uch = join('', map { encode_U(hex($_)) } @uni );
my $ech = join('',map(chr(hex($_)),@byte));
$max_el = $el if (!defined($max_el) || $el > $max_el);
$min_el = $el if (!defined($min_el) || $el < $min_el);
# 1 - fallback for unicode -> enc
# 2 - skip sub-char mapping
# 3 - fallback enc -> unicode
enter($u2e,$uch,$ech,$u2e,$fb+0) if ($fb =~ /[01]/);
enter($e2u,$ech,$uch,$e2u,$fb+0) if ($fb =~ /[03]/);
die "$nfb entries without fallback, $hfb entries with\n";
$encoding{$name} = [$e2u,$u2e,$erep,$min_el,$max_el];
last if $type !~ /^\s*#/;
# Do the hash lookup once, rather than once per function call. 4% speedup.
my $type_func = $encode_types{$type};
my ($def,$sym,$pages) = split(/\s+/,scalar(<$fh>));
warn "$type encoded $name\n";
# Save a defined test by setting these to defined values.
my $min_el = ~0; # A very big integer
my $max_el = 0; # Anything must be longer than 0
$rep = &$type_func($v & 0xFF, ($v >> 8) & 0xffe);
# use -Q to silence the seen test. Makefile.PL uses this by default.
$seen = {} unless $opt{Q};
# So why is it 1% faster to leave the my here?
die "$.:${line}Line should be exactly 65 characters long including
newline (".length($line).")" unless length ($line) == 65;
# Split line into groups of 4 hex digits, convert groups to ints
# map {hex $_} $line =~ /(....)/g
# This takes 63.75 (2.5% less time)
# unpack "n*", pack "H*", $line
# There's an implicit loop in map. Loops are bad, m'kay. Ops are bad, m'kay
# Doing it as while ($line =~ /(....)/g) took 74.63
foreach my $val (unpack "n*", pack "H*", $line)
my $ech = &$type_func($ch,$page);
if ($val || (!$ch && !$page))
$max_el = $el if $el > $max_el;
$min_el = $el if $el < $min_el;
my $uch = encode_U($val);
# We don't need to read this quickly, so storing it as a scalar,
# rather than 3 (anon array, plus the 2 scalars it holds) saves
# RAM and may make us faster on low RAM systems. [see __END__]
if (exists $seen->{$uch})
warn sprintf("U%04X is %02X%02X and %04X\n",
$val,$page,$ch,$seen->{$uch});
$seen->{$uch} = $page << 8 | $ch;
# Passing 2 extra args each time is 3.6% slower!
# Even with having to add $fallback ||= 0 later
enter_fb0($e2u,$ech,$uch);
enter_fb0($u2e,$uch,$ech);
# No character at this position
# enter($e2u,$ech,undef,$e2u);
die "\$min_el=$min_el, \$max_el=$max_el - seems we read no lines"
die "$errors mapping conflicts\n" if ($errors && $opt{'S'});
$encoding{$name} = [$e2u,$u2e,$rep,$min_el,$max_el];
# my ($a,$s,$d,$t,$fb) = @_;
my ($current,$inbytes,$outbytes,$next,$fallback) = @_;
# state we shift to after this (multibyte) input character defaults to same
# Making sure it is defined seems to be faster than {no warnings;} in
# &process, or passing it in as 0 explicity.
# Start at the beginning and work forwards through the string to zero.
# effectively we are removing 1 character from the front each time
# but we don't actually edit the string. [this alone seems to be 14% speedup]
# Hence -$pos is the length of the remaining string.
my $pos = -length $inbytes;
my $byte = substr $inbytes, $pos, 1;
# to unicode an array would seem to be better, because the pages are dense.
# from unicode can be very sparse, favouring a hash.
# hash using the bytes (all length 1) as keys rather than ord value,
# as it's easier to sort these in &process.
# It's faster to always add $fallback even if it's undef, rather than
# choosing between 3 and 4 element array. (hence why we set it defined
my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,'',$fallback];
# When $pos was -1 we were at the last input character.
$do_now->[RAW_OUT_BYTES] = $outbytes;
$do_now->[RAW_NEXT] = $next;
# Tail recursion. The intermdiate state may not have a name yet.
$current = $do_now->[RAW_NEXT];
# This is purely for optimistation. It's just &enter hard coded for $fallback
# of 0, using only a 3 entry array ref to save memory for every entry.
my ($current,$inbytes,$outbytes,$next) = @_;
my $pos = -length $inbytes;
my $byte = substr $inbytes, $pos, 1;
my $do_now = $current->{Raw}{$byte} ||= [{},-$pos,''];
$do_now->[RAW_OUT_BYTES] = $outbytes;
$do_now->[RAW_NEXT] = $next;
$current = $do_now->[RAW_NEXT];
foreach my $o (keys %strings)
next unless (my $i = index($o,$s)) >= 0;
# gcc things that 0x0e+0x10 (anything with e+) starts to look like
# a hexadecimal floating point constant. Silly gcc. Only p
# introduces a floating point constant. Put the space in to stop it
$sym .= sprintf(" +0x%02x",$i) if ($i);
return $strings{$s} = $sym;
$strings{$s} = $sym = $name;
my $definition = sprintf "static const U8 %s[%d] = { ",$name,length($s);
# Maybe we should assert that these are all <256.
$definition .= join(',',unpack "C*",$s);
# We have a single long line. Split it at convenient commas.
$definition =~ s/(.{74,77},)/$1\n/g;
print $fh "$definition };\n\n";
my ($l, $agg_max_in, $agg_next, $agg_in_len, $agg_out_len, $agg_fallback);
foreach my $key (sort keys %$raw) {
my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
# Now we are converting from raw to aggregate, switch from 1 byte strings
# If this == fails, we're going to reset $agg_max_in below anyway.
# References in numeric context give the pointer as an int.
$agg_in_len == $in_len &&
$agg_out_len == length $out_bytes &&
$agg_fallback == $fallback
# && length($l->[AGG_OUT_BYTES]) < 16
# my $i = ord($b)-ord($l->[AGG_MIN_IN]);
# we can aggregate this byte onto the end.
$l->[AGG_OUT_BYTES] .= $out_bytes;
# Reset the last thing we saw, plus set 5 lexicals to save some derefs.
# (only gains .6% on euc-jp -- is it worth it?)
push @ent, $l = [$b, $agg_max_in = $b, $out_bytes, $agg_next = $next,
$agg_in_len = $in_len, $agg_out_len = length $out_bytes,
$agg_fallback = $fallback];
if (exists $next->{Cname}) {
$next->{'Forward'} = 1 if $next != $a;
process(sprintf("%s_%02x",$name,$b),$next);
# encengine.c rules say that last entry must be for 255
push @ent, [1+$agg_max_in, 255,undef,$a,0,0];
my $name = $a->{'Cname'};
foreach my $b (@{$a->{'Entries'}})
next unless $b->[AGG_OUT_LEN];
my $s = $b->[AGG_MIN_IN];
my $e = $b->[AGG_MAX_IN];
outstring($fh,sprintf("%s__%02x_%02x",$name,$s,$e),$b->[AGG_OUT_BYTES]);
my $var = $^O eq 'MacOS' ? 'extern' : 'static';
print $fh "\n$var encpage_t $name\[",scalar(@{$a->{'Entries'}}),"];\n";
foreach my $b (@{$a->{'Entries'}})
my ($s,$e,$out,$t,$end,$l) = @$b;
outtable($fh,$t) unless $t->{'Done'};
print $fh "\nstatic encpage_t $name\[",scalar(@{$a->{'Entries'}}),"] = {\n";
foreach my $b (@{$a->{'Entries'}})
my ($sc,$ec,$out,$t,$end,$l,$fb) = @$b;
# $end |= 0x80 if $fb; # what the heck was on your mind, Nick? -- Dan
printf $fh outstring($fh,'',$out);
print $fh ",",$t->{Cname};
printf $fh ",0x%02x,0x%02x,$l,$end},\n",$sc,$ec;
die "Changed - fix me for new structure";
foreach my $b (sort keys %$a)
my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}};
my $s = do "unicore/Name.pl";
die "char_names: unicore/Name.pl: $!\n" unless defined $s;
while ($s =~ /\G([0-9a-f]+)\t([0-9a-f]*)\t(.*?)\s*\n/igc)
my $e = length($2) ? hex($2) : $s;
for (my $i = $s; $i <= $e; $i++)
# print sprintf("U%04X $name\n",$i);
my ($cmap,$a,$t,$pre) = @_;
# warn sprintf("Page %x\n",$pre);
foreach my $key (sort keys %$raw) {
my ($next, $in_len, $out_bytes, $fallback) = @{$raw->{$key}};
if ($next != $a && $next != $t) {
output_ucm_page($cmap,$a,$next,(($pre|($u &0x3F)) << 6)&0xFFFF);
} elsif (length $out_bytes) {
my $s = sprintf "<U%04X> ",$u;
#foreach my $c (split(//,$out_bytes)) {
# $s .= sprintf "\\x%02X",ord($c);
# 9.5% faster changing that loop to this:
$s .= sprintf +("\\x%02X" x length $out_bytes), unpack "C*", $out_bytes;
$s .= sprintf " |%d # %s\n",($fallback ? 1 : 0),$uname[$u];
warn join(',',$u, @{$raw->{$key}},$a,$t);
my ($fh,$name,$h,$rep,$min_el,$max_el) = @_;
print $fh "# $0 @orig_ARGV\n" unless $opt{'q'};
print $fh "<code_set_name> \"$name\"\n";
print $fh "<mb_cur_min> $min_el\n";
print $fh "<mb_cur_max> $max_el\n";
foreach my $c (split(//,$rep))
printf $fh "\\x%02X",ord($c);
output_ucm_page(\@cmap,$h,$h,0);
print $fh "#\nCHARMAP\n";
foreach my $line (sort { substr($a,8) cmp substr($b,8) } @cmap)
print $fh "END CHARMAP\n";
eval { require File::Find };
push @inc, $inc unless $inc eq '.'; #skip current dir
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
$e2x_dir{$File::Find::dir} ||= $mtime;
warn join("\n", keys %e2x_dir), "\n";
for my $d (sort {$e2x_dir{$a} <=> $e2x_dir{$b}} keys %e2x_dir){
# warn "$_E2X => ", scalar localtime($e2x_dir{$d});
eval { require Encode; };
$@ and die "You need to install Encode to use enc2xs -M\nerror: $@\n";
# our used for variable expanstion
$_TableFiles = join(",", map {qq('$_')} @_);
$_Now = scalar localtime();
eval { require File::Spec; };
_print_expand(File::Spec->catfile($_E2X,"Makefile_PL.e2x"),"Makefile.PL");
_print_expand(File::Spec->catfile($_E2X,"_PM.e2x"), "$_Name.pm");
_print_expand(File::Spec->catfile($_E2X,"_T.e2x"), "t/$_Name.t");
_print_expand(File::Spec->catfile($_E2X,"README.e2x"), "README");
_print_expand(File::Spec->catfile($_E2X,"Changes.e2x"), "Changes");
eval { require Encode; };
$@ and die "Unable to require Encode: $@\n";
eval { require File::Spec; };
# our used for variable expanstion
my %in_core = map {$_=>1}('ascii','iso-8859-1','utf8');
my $inc = File::Spec->catfile($d, "Encode");
opendir my $dh, $inc or die "$inc:$!";
warn "Checking $inc...\n";
for my $f (grep /\.pm$/o, readdir($dh)){
-f File::Spec->catfile($inc, "$f") or next;
$INC{"Encode/$f"} and next;
warn "require Encode/$f;\n";
eval { require "Encode/$f"; };
$@ and die "Can't require Encode/$f: $@\n";
for my $enc (Encode->encodings()){
$Encode::Config::ExtModule{$enc} and next;
$mod =~ s/\.pm$//o; $mod =~ s,/,::,og;
$LocalMod{$enc} ||= $mod;
for my $enc (sort keys %LocalMod){
qq(\$Encode::ExtModule{'$enc'} =\t"$LocalMod{$enc}";\n);
$_LocalVer = _mkversion();
$_Inc = $INC{"Encode.pm"}; $_Inc =~ s/\.pm$//o;
_print_expand(File::Spec->catfile($_E2X,"ConfigLocal_PM.e2x"),
File::Spec->catfile($_Inc,"ConfigLocal.pm"),
my ($ss,$mm,$hh,$dd,$mo,$yyyy) = localtime();
return sprintf("v%04d.%04d.%04d", $yyyy, $mo*100+$dd, $hh*100+$mm);
eval { require File::Basename; };
$@ and die "File::Basename needed. Are you on miniperl?;\nerror: $@\n";
File::Basename->import();
my ($src, $dst, $clobber) = @_;
if (!$clobber and -e $dst){
warn "$dst exists. skipping\n";
warn "Generating $dst...\n";
open my $in, $src or die "$src : $!";
if ((my $d = dirname($dst)) ne '.'){
-d $d or mkdir $d, 0755 or die "mkdir $d : $!";
open my $out, ">$dst" or die "$!";
if (/^#### END_OF_HEADER/){
s/(\$_[A-Z][A-Za-z0-9]+)_/$1/gee unless $asis;
enc2xs -- Perl Encode Module Generator
enc2xs -M ModName mapfiles...
F<enc2xs> builds a Perl extension for use by Encode from either
Unicode Character Mapping files (.ucm) or Tcl Encoding Files (.enc).
Besides being used internally during the build process of the Encode
module, you can use F<enc2xs> to add your own encoding to perl.
No knowledge of XS is necessary.
If you want to know as little about Perl as possible but need to
add a new encoding, just read this chapter and forget the rest.
Have a .ucm file ready. You can get it from somewhere or you can write
your own from scratch or you can grab one from the Encode distribution
and customize it. For the UCM format, see the next Chapter. In the
example below, I'll call my theoretical encoding myascii, defined
in I<my.ucm>. C<$> is a shell prompt.
Issue a command as follows;
Now take a look at your current directory. It should look like this.
Makefile.PL My.pm my.ucm t/
The following files were created.
Makefile.PL - MakeMaker script
If you want *.ucm installed together with the modules, do as follows;
$ enc2xs -M My Encode/*ucm
Edit the files generated. You don't have to if you have no time AND no
intention to give it to someone else. But it is a good idea to edit
the pod and to add more tests.
Now issue a command all Perl Mongers love:
Writing Makefile for Encode::My
Now all you have to do is make.
cp My.pm blib/lib/Encode/My.pm
/usr/local/bin/perl /usr/local/bin/enc2xs -Q -O \
-o encode_t.c -f encode_t.fnm
Reading myascii (myascii)
128 bytes in string tables
384 bytes (25%) saved spotting duplicates
1 bytes (99.2%) saved using substrings
chmod 644 blib/arch/auto/Encode/My/My.bs
The time it takes varies depending on how fast your machine is and
how large your encoding is. Unless you are working on something big
like euc-tw, it won't take too long.
You can "make install" already but you should test first.
PERL_DL_NONLAZY=1 /usr/local/bin/perl -Iblib/arch -Iblib/lib \
-e 'use Test::Harness qw(&runtests $verbose); \
$verbose=0; runtests @ARGV;' t/*.t
Files=1, Tests=2, 0 wallclock secs
( 0.09 cusr + 0.01 csys = 0.09 CPU)
If you are content with the test result, just "make install"
If you want to add your encoding to Encode's demand-loading list
(so you don't have to "use Encode::YourEncoding"), run
to update Encode::ConfigLocal, a module that controls local settings.
After that, "use Encode;" is enough to load your encodings on demand.
=head1 The Unicode Character Map
Encode uses the Unicode Character Map (UCM) format for source character
mappings. This format is used by IBM's ICU package and was adopted
by Nick Ing-Simmons for use with the Encode module. Since UCM is
more flexible than Tcl's Encoding Map and far more user-friendly,
this is the recommended formet for Encode now.
A UCM file looks like this.
<code_set_name> "US-ascii" # Required
<code_set_alias> "ascii" # Optional
<mb_cur_min> 1 # Required; usually 1
<mb_cur_max> 1 # Max. # of bytes/char
<subchar> \x3F # Substitution char
<U0000> \x00 |0 # <control>
<U0001> \x01 |0 # <control>
<U0002> \x02 |0 # <control>
<U007C> \x7C |0 # VERTICAL LINE
<U007D> \x7D |0 # RIGHT CURLY BRACKET
<U007F> \x7F |0 # <control>
Anything that follows C<#> is treated as a comment.
The header section continues until a line containing the word
CHARMAP. This section has a form of I<E<lt>keywordE<gt> value>, one
pair per line. Strings used as values must be quoted. Barewords are
treated as numbers. I<\xXX> represents a byte.
Most of the keywords are self-explanatory. I<subchar> means
substitution character, not subcharacter. When you decode a Unicode
sequence to this encoding but no matching character is found, the byte
sequence defined here will be used. For most cases, the value here is
\x3F; in ASCII, this is a question mark.
CHARMAP starts the character map section. Each line has a form as
<UXXXX> \xXX.. |0 # comment
| +-------- Encoded byte sequence
+-------------- Unicode Character ID in hex
The format is roughly the same as a header section except for the
fallback flag: | followed by 0..3. The meaning of the possible
Round trip safe. A character decoded to Unicode encodes back to the
same byte sequence. Most characters have this flag.
Fallback for unicode -> encoding. When seen, enc2xs adds this
character for the encode map only.
Skip sub-char mapping should there be no code point.
Fallback for encoding -> unicode. When seen, enc2xs adds this
character for the decode map only.
And finally, END OF CHARMAP ends the section.
When you are manually creating a UCM file, you should copy ascii.ucm
or an existing encoding which is close to yours, rather than write
When you do so, make sure you leave at least B<U0000> to B<U0020> as
is, unless your environment is EBCDIC.
B<CAVEAT>: not all features in UCM are implemented. For example,
icu:state is not used. Because of that, you need to write a perl
module if you want to support algorithmical encodings, notably
the ISO-2022 series. Such modules include L<Encode::JP::2022_JP>,
L<Encode::KR::2022_KR>, and L<Encode::TW::HZ>.
=head2 Coping with duplicate mappings
When you create a map, you SHOULD make your mappings round-trip safe.
That is, C<encode('your-encoding', decode('your-encoding', $data)) eq
$data> stands for all characters that are marked as C<|0>. Here is
Sort your map in Unicode order.
When you have a duplicate entry, mark either one with '|1' or '|3'.
And make sure the '|1' or '|3' entry FOLLOWS the '|0' entry.
Here is an example from big5-eten.
Internally Encoding -> Unicode and Unicode -> Encoding Map looks like
--------------------------------------
\xF9\xF9 => U2550 U2550 => \xF9\xF9
So it is round-trip safe for \xF9\xF9. But if the line above is upside
down, here is what happens.
--------------------------------------
\xA2\xA4 => U2550 U2550 => \xF9\xF9
(\xF9\xF9 => U2550 is now overwritten!)
The Encode package comes with F<ucmlint>, a crude but sufficient
utility to check the integrity of a UCM file. Check under the
Encode/bin directory for this.
L<http://oss.software.ibm.com/icu/>
ICU Character Mapping Tables
L<http://oss.software.ibm.com/icu/charset/>
L<http://oss.software.ibm.com/icu/userguide/conversion-data.html>
# -Q to disable the duplicate codepoint test
# -S make mapping errors fatal
# -q to remove comments written to output files
# -O to enable the (brute force) substring optimiser
# -o <output> to specify the output file name (else it's the first arg)
# -f <inlist> to give a file with a list of input files (else use the args)
# -n <name> to name the encoding (else use the basename of the input file.
With %seen holding array refs:
865.66 real 28.80 user 8.79 sys
7904 maximum resident set size
1356 average shared memory size
18566 average unshared data size
229 average unshared stack size
With %seen holding simple scalars:
342.16 real 27.11 user 3.54 sys
8388 maximum resident set size
1394 average shared memory size
14969 average unshared data size
236 average unshared stack size
Yes, 5 minutes is faster than 15. Above is for CP936 in CN. Only difference is
how %seen is storing things its seen. So it is pathalogically bad on a 16M
RAM machine, but it's going to help even on modern machines.
Swapping is bad, m'kay :-)