/[webpac]/trunk/openisis/perl/encoding.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/openisis/perl/encoding.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 239 - (hide annotations)
Mon Mar 8 17:49:13 2004 UTC (17 years, 6 months ago) by dpavlin
File MIME type: text/plain
File size: 2015 byte(s)
including openisis 0.9.0 into webpac tree

1 dpavlin 237 #!/usr/bin/perl
2    
3     # perl/encoding.pl </usr/lib/tcl8.3/encoding/cp850.enc
4     # for x in /usr/lib/tcl8.3/encoding/*; do perl/encoding.pl <$x; done >encodings
5     #
6     # read a Tcl encoding file (see man Tcl_GetEncoding)
7     # spit out a perl translator
8    
9     $enc = 'unknown';
10     $_ = <STDIN>;
11     if ( /^#/ ) {
12     ($enc) = /: ([^,]+),/;
13     $_ = <STDIN>;
14     }
15     /^S/ || die "not a single byte encoding: got '$_'";
16     $_ = <STDIN>;
17     ($fallback,$symbol,$pages) = split /\s+/;
18     1 == $pages || die "not a single byte encoding: got $fallback,$symbol,$pages";
19     $fallback = hex $fallback;
20     $fbchr = 31<$fallback && $fallback<127
21     ? chr($fallback) : sprintf('\x%02x', $fallback);
22     print STDERR "fallback character is $fallback ($fbchr)\n";
23    
24     # read page
25     $_ = <STDIN>;
26     hex && die "base is not 00 but '$_'";
27     for $n (0..7) { # check for ASCII
28     @v = unpack( 'n*', pack( 'H64', scalar(<STDIN>) ) );
29     15 == $#v || die "length is ".$#v;
30     # print STDERR join(',',@v), "\n";
31     for (0..15) {
32     $v[$_] == 16*$n + $_ || die "bad val $v[$_] at row $n pos $_";
33     }
34     }
35     $#rv = 127;
36     for (0..127) { $rv[$_] = $fbchr; }
37     for $n (8..15) {
38     @v = unpack( 'n*', pack( 'H64', scalar(<STDIN>) ) );
39     15 == $#v || die "length is ".$#v;
40     print STDERR join(',',@v), "\n";
41     for (0..15) {
42     if ( 255 < $v[$_] ) {
43     $tr .= '?';
44     } else {
45     $tr .= sprintf('\x%02x',$v[$_]);
46     $rv[$v[$_]-128] = sprintf('\x%02x',16*$n + $_) if 127 < $v[$_];
47     }
48     }
49     }
50     print "# convert $enc to Latin1\n";
51     print 'y/\x80-\xff/',$tr,"/;\n";
52     $rv = join('',@rv);
53     print "# convert Latin1 to $enc\n";
54     print 'y/\x80-\xff/',$rv,"/;\n";
55    
56     # Latin1 roundtrip test
57     $_ = $test = pack( 'C*', (160..255) );
58     eval 'y/\x80-\xff/'.$rv.'/';
59     print STDERR "Latin1 160..255 in encoding $enc\n";
60     for $n (0..5) {
61     print STDERR 160+16*$n,': ',join(',',unpack('C*',substr($_,16*$n,16))), "\n";
62     }
63     print STDERR 'test: ',$test,"\n";
64     eval 'y/\x80-\xff/'.$tr.'/';
65     print STDERR "trip: ",$_,"\n";
66     print STDERR "Latin1 160..255 after roundtrip through $enc\n";
67     for $n (0..5) {
68     print STDERR 160+16*$n,': ',join(',',unpack('C*',substr($_,16*$n,16))), "\n";
69     }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26