/[webpac]/openisis/current/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

Contents of /openisis/current/perl/encoding.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years ago) by dpavlin
File MIME type: text/plain
File size: 2015 byte(s)
initial import of openisis 0.9.0 vendor drop

1 #!/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