src/charconv.tcl

   1 #!/bin/sh
   2 # the next line restats using tclsh \
   3 exec tclsh "$0" "$@"
   4 #
   5 # $Id: charconv.tcl,v 1.11 2006-02-23 13:15:43 adam Exp $
   6
   7 proc usage {} {
   8     puts {charconv.tcl: [-p prefix] [-s split] [-o ofile] file ... }
   9     exit 1
  10 }
  11
  12 proc preamble_trie {ofilehandle} {
  13     set f $ofilehandle
  14
  15     set totype {unsigned }
  16
  17     puts $f "\#include <string.h>"
  18     puts $f "
  19         struct yaz_iconv_trie_flat {
  20             char from\[6\];
  21             unsigned combining : 1;
  22             $totype to : 24;
  23         };
  24         struct yaz_iconv_trie_dir {
  25             int ptr : 15;
  26             unsigned combining : 1;
  27             $totype to : 24;
  28         };
  29
  30         struct yaz_iconv_trie {
  31             struct yaz_iconv_trie_flat *flat;
  32             struct yaz_iconv_trie_dir *dir;
  33         };
  34     "
  35     puts $f {
  36         static unsigned long lookup(struct yaz_iconv_trie **ptrs, int ptr, unsigned char *inp,
  37                                     size_t inbytesleft, size_t *no_read, int *combining)
  38         {
  39             struct yaz_iconv_trie *t = (ptr > 0) ? ptrs[ptr-1] : 0;
  40             if (!t || inbytesleft < 1)
  41                 return 0;
  42             if (t->dir)
  43             {
  44                 size_t ch = inp[0] & 0xff;
  45                 unsigned long code =
  46                 lookup(ptrs, t->dir[ch].ptr, inp+1, inbytesleft-1, no_read, combining);
  47                 if (code)
  48                 {
  49                     (*no_read)++;
  50                     return code;
  51                 }
  52                 if (t->dir[ch].to)
  53                 {
  54                     code = t->dir[ch].to;
  55                     *combining = t->dir[ch].combining;
  56                     *no_read = 1;
  57                     return code;
  58                 }
  59             }
  60             else
  61             {
  62                 struct yaz_iconv_trie_flat *flat = t->flat;
  63                 while (flat->to)
  64                 {
  65                     size_t len = strlen(flat->from);
  66                     if (len <= inbytesleft)
  67                     {
  68                         if (memcmp(flat->from, inp, len) == 0)
  69                         {
  70                             *no_read = len;
  71                             *combining = flat->combining;
  72                             return flat->to;
  73                         }
  74                     }
  75                     flat++;
  76                 }
  77             }
  78             return 0;
  79         }
  80     }
  81 }
  82
  83 proc reset_trie {} {
  84     global trie
  85
  86     foreach x [array names trie] {
  87         unset trie($x)
  88     }
  89
  90     set trie(no) 1
  91     set trie(size) 0
  92     set trie(max) 0
  93     set trie(split) 50
  94     set trie(prefix) {}
  95 }
  96
  97 proc ins_trie {from to combining codename} {
  98     global trie
  99     if {![info exists trie(no)]} {
 100         set trie(no) 1
 101         set trie(size) 0
 102         set trie(max) 0
 103     }
 104     if {$trie(max) < $to} {
 105         set trie(max) $to
 106     }
 107     incr trie(size)
 108     ins_trie_r [split $from] $to $combining $codename 0
 109 }
 110
 111 proc split_trie {this} {
 112     global trie
 113     set trie($this,type) d
 114     foreach e $trie($this,content) {
 115         set from [lindex $e 0]
 116         set to [lindex $e 1]
 117         set combining [lindex $e 2]
 118         set codename [lindex $e 3]
 119
 120         set ch [lindex $from 0]
 121         set rest [lrange $from 1 end]
 122
 123         if {[llength $rest]} {
 124             if {![info exist trie($this,ptr,$ch)]} {
 125                 set trie($this,ptr,$ch) $trie(no)
 126                 incr trie(no)
 127             }
 128             ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
 129         } else {
 130             set trie($this,to,$ch) $to
 131             set trie($this,combining,$ch) $combining
 132             set trie($this,codename,$ch) $codename
 133         }
 134     }
 135     set trie($this,content) missing
 136 }
 137
 138 proc ins_trie_r {from to combining codename this} {
 139     global trie
 140
 141     if {![info exist trie($this,type)]} {
 142         set trie($this,type) f
 143     }
 144     if {$trie($this,type) == "f"} {
 145         lappend trie($this,content) [list $from $to $combining $codename]
 146
 147         # split ?
 148         if {[llength $trie($this,content)] > $trie(split)} {
 149             split_trie $this
 150             return [ins_trie_r $from $to $combining $codename $this]
 151         }
 152     } else {
 153         set ch [lindex $from 0]
 154         set rest [lrange $from 1 end]
 155
 156         if {[llength $rest]} {
 157             if {![info exist trie($this,ptr,$ch)]} {
 158                 set trie($this,ptr,$ch) $trie(no)
 159                 incr trie(no)
 160             }
 161             ins_trie_r $rest $to $combining $codename $trie($this,ptr,$ch)
 162         } else {
 163             set trie($this,to,$ch) $to
 164             set trie($this,combining,$ch) $combining
 165             set trie($this,codename,$ch) $codename
 166         }
 167     }
 168 }
 169
 170 proc dump_trie {ofilehandle} {
 171     global trie
 172
 173     set f $ofilehandle
 174
 175     puts $f "/* TRIE: size $trie(size) */"
 176
 177     set this $trie(no)
 178     while { [incr this -1] >= 0 } {
 179         puts $f "/* PAGE $this */"
 180         if {$trie($this,type) == "f"} {
 181             puts $f "struct yaz_iconv_trie_flat $trie(prefix)page${this}_flat\[\] = \{"
 182             foreach m $trie($this,content) {
 183                 puts -nonewline $f "  \{\""
 184                 foreach d [lindex $m 0] {
 185                     puts -nonewline $f "\\x$d"
 186                 }
 187                 puts -nonewline $f "\", [lindex $m 2], 0x[lindex $m 1]"
 188                 set v [lindex $m 3]
 189                 puts $f "\}, /* $v */"
 190             }
 191             puts $f "  \{\"\", 0\}"
 192             puts $f "\};"
 193             puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
 194             puts $f "  $trie(prefix)page${this}_flat, 0"
 195             puts $f "\};"
 196         } else {
 197             puts $f "struct yaz_iconv_trie_dir $trie(prefix)page${this}_dir\[256\] = \{"
 198             for {set i 0} {$i < 256} {incr i} {
 199                 puts -nonewline $f "  \{"
 200                 set ch [format %02X $i]
 201                 set null 1
 202                 if {[info exist trie($this,ptr,$ch)]} {
 203                     puts -nonewline $f "[expr $trie($this,ptr,$ch)+1], "
 204                     set null 0
 205                 } else {
 206                     puts -nonewline $f "0, "
 207                 }
 208                 if {[info exist trie($this,combining,$ch)]} {
 209                     puts -nonewline $f "$trie($this,combining,$ch), "
 210                 } else {
 211                     puts -nonewline $f "0, "
 212                 }
 213                 if {[info exist trie($this,to,$ch)]} {
 214                     puts -nonewline $f "0x$trie($this,to,$ch)\}"
 215                     set null 0
 216                 } else {
 217                     puts -nonewline $f "0\}"
 218                 }
 219                 if {[info exist trie($this,codename,$ch)]} {
 220                     set v $trie($this,codename,$ch)
 221                     puts -nonewline $f " /* $v */"
 222                 }
 223                 if {$i < 255} {
 224                     puts $f ","
 225                 } else {
 226                     puts $f ""
 227                 }
 228             }
 229             puts $f "\};"
 230             puts $f "struct yaz_iconv_trie $trie(prefix)page${this} = \{"
 231             puts $f "  0, $trie(prefix)page${this}_dir"
 232             puts $f "\};"
 233         }
 234     }
 235
 236     puts $f "struct yaz_iconv_trie *$trie(prefix)ptrs \[\] = {"
 237     for {set this 0} {$this < $trie(no)} {incr this} {
 238         puts $f " &$trie(prefix)page$this,"
 239     }
 240     puts $f "0, };"
 241     puts $f ""
 242
 243     puts $f "unsigned long yaz_$trie(prefix)_conv
 244             (unsigned char *inp, size_t inbytesleft, size_t *no_read, int *combining)
 245         {
 246             unsigned long code;
 247
 248             code = lookup($trie(prefix)ptrs, 1, inp, inbytesleft, no_read, combining);
 249             if (!code)
 250             {
 251                 *no_read = 1;
 252             }
 253             return code;
 254         }
 255     "
 256 }
 257
 258 proc readfile {fname ofilehandle prefix omits} {
 259     global trie
 260
 261     set marc_lines 0
 262     set ucs_lines 0
 263     set codename_lines 0
 264     set lineno 0
 265     set f [open $fname r]
 266     set tablenumber x
 267     set combining 0
 268     set codename {}
 269     while {1} {
 270         incr lineno
 271         set cnt [gets $f line]
 272         if {$cnt < 0} {
 273             break
 274         }
 275         if {[regexp {<entitymap>} $line s]} {
 276             reset_trie
 277             set trie(prefix) "${prefix}"
 278         } elseif {[regexp {</entitymap>} $line s]} {
 279             dump_trie $ofilehandle
 280         } elseif {[regexp {<character hex="([^\"]*)".*<unientity>([0-9A-Fa-f]*)</unientity>} $line s hex ucs]} {
 281             ins_trie $hex $ucs $combining {}
 282             unset hex
 283         } elseif {[regexp {<codeTable .*number="([0-9]+)"} $line s tablenumber]} {
 284             reset_trie
 285             set trie(prefix) "${prefix}_$tablenumber"
 286             set combining 0
 287         } elseif {[regexp {</codeTable>} $line s]} {
 288             if {[lsearch $omits $tablenumber] == -1} {
 289                 dump_trie $ofilehandle
 290             }
 291         } elseif {[regexp {</code>} $line s]} {
 292             if {[string length $ucs]} {
 293                 for {set i 0} {$i < [string length $marc]} {incr i 2} {
 294                     lappend hex [string range $marc $i [expr $i+1]]
 295                 }
 296                 # puts "ins_trie $hex $ucs"
 297                 ins_trie $hex $ucs $combining $codename
 298                 unset hex
 299             }
 300             set marc {}
 301             set uni {}
 302             set codename {}
 303             set combining 0
 304         } elseif {[regexp {<marc>([0-9A-Fa-f]*)</marc>} $line s marc]} {
 305             incr marc_lines
 306         } elseif {[regexp {<name>(.*)</name>} $line s codename]} {
 307             incr codename_lines
 308         } elseif {[regexp {<name>(.*)} $line s codename]} {
 309             incr codename_lines
 310             incr lineno
 311             set cnt [gets $f line]
 312             if {$cnt < 0} {
 313                 break
 314             }
 315             if {[regexp {(.*)</name>} $line s codename_ex]} {
 316                 set codename "${codename} ${codename_ex}"
 317             }
 318         } elseif {[regexp {<isCombining>true</isCombining>} $line s]} {
 319             set combining 1
 320         } elseif {[regexp {<ucs>([0-9A-Fa-f]*)</ucs>} $line s ucs]} {
 321             incr ucs_lines
 322         }
 323     }
 324     close $f
 325 }
 326
 327 set verbose 0
 328 set ifile {}
 329 set ofile out.c
 330 set prefix {c}
 331 # Parse command line
 332 set l [llength $argv]
 333 set i 0
 334 set omits {}
 335 while {$i < $l} {
 336     set arg [lindex $argv $i]
 337     switch -glob -- $arg {
 338         -v {
 339             incr verbose
 340         }
 341         -s {
 342             if {[string length $arg]} {
 343                 set arg [lindex $argv [incr i]]
 344             }
 345             set trie(split) $arg
 346         }
 347         -p {
 348             if {[string length $arg]} {
 349                 set arg [lindex $argv [incr i]]
 350             }
 351             set prefix $arg
 352         }
 353         -o {
 354             if {[string length $arg]} {
 355                 set arg [lindex $argv [incr i]]
 356             }
 357             set ofile $arg
 358         }
 359         -O {
 360             if {[string length $arg]} {
 361                 set arg [lindex $argv [incr i]]
 362             }
 363             lappend omits $arg
 364         }
 365         default {
 366             lappend ifiles $arg
 367         }
 368     }
 369     incr i
 370 }
 371 if {![info exists ifiles]} {
 372     puts "charconv.tcl: missing input file(s)"
 373     usage
 374 }
 375
 376 set ofilehandle [open $ofile w]
 377 preamble_trie $ofilehandle
 378
 379 foreach ifile $ifiles {
 380     readfile $ifile $ofilehandle $prefix $omits
 381 }
 382 close $ofilehandle
 383
 384