src/charconv.tcl

   1 #!/bin/sh
   2 # the next line restats using tclsh \
   3 exec tclsh "$0" "$@"
   4 #
   5 # $Id: charconv.tcl,v 1.8 2005-03-16 21:26:37 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             short 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] : 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 "$trie($this,ptr,$ch), "
 204                     set null 0
 205                 } else {
 206                     puts -nonewline $f "-1, "
 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, 0, inp, inbytesleft, no_read, combining);
 249             if (!code)
 250             {
 251                 *no_read = 1;
 252                 code = *inp;
 253             }
 254             return code;
 255         }
 256     "
 257 }
 258
 259 proc readfile {fname ofilehandle prefix omits} {
 260     global trie
 261
 262     set marc_lines 0
 263     set ucs_lines 0
 264     set codename_lines 0
 265     set lineno 0
 266     set f [open $fname r]
 267     set tablenumber x
 268     set combining 0
 269     set codename {}
 270     while {1} {
 271         incr lineno
 272         set cnt [gets $f line]
 273         if {$cnt < 0} {
 274             break
 275         }
 276         if {[regexp {<entitymap>} $line s]} {
 277             reset_trie
 278             set trie(prefix) "${prefix}"
 279         } elseif {[regexp {</entitymap>} $line s]} {
 280             dump_trie $ofilehandle
 281         } elseif {[regexp {<character hex="([^\"]*)".*<unientity>([0-9A-Fa-f]*)</unientity>} $line s hex ucs]} {
 282             ins_trie $hex $ucs $combining {}
 283             unset hex
 284         } elseif {[regexp {<codeTable .*number="([0-9]+)"} $line s tablenumber]} {
 285             reset_trie
 286             set trie(prefix) "${prefix}_$tablenumber"
 287             set combining 0
 288         } elseif {[regexp {</codeTable>} $line s]} {
 289             if {[lsearch $omits $tablenumber] == -1} {
 290                 dump_trie $ofilehandle
 291             }
 292         } elseif {[regexp {</code>} $line s]} {
 293             if {[string length $ucs]} {
 294                 for {set i 0} {$i < [string length $marc]} {incr i 2} {
 295                     lappend hex [string range $marc $i [expr $i+1]]
 296                 }
 297                 # puts "ins_trie $hex $ucs"
 298                 ins_trie $hex $ucs $combining $codename
 299                 unset hex
 300             }
 301             set marc {}
 302             set uni {}
 303             set codename {}
 304             set combining 0
 305         } elseif {[regexp {<marc>([0-9A-Fa-f]*)</marc>} $line s marc]} {
 306             incr marc_lines
 307         } elseif {[regexp {<name>(.*)</name>} $line s codename]} {
 308             incr codename_lines
 309         } elseif {[regexp {<name>(.*)} $line s codename]} {
 310             incr codename_lines
 311             incr lineno
 312             set cnt [gets $f line]
 313             if {$cnt < 0} {
 314                 break
 315             }
 316             if {[regexp {(.*)</name>} $line s codename_ex]} {
 317                 set codename "${codename} ${codename_ex}"
 318             }
 319         } elseif {[regexp {<isCombining>true</isCombining>} $line s]} {
 320             set combining 1
 321         } elseif {[regexp {<ucs>([0-9A-Fa-f]*)</ucs>} $line s ucs]} {
 322             incr ucs_lines
 323         }
 324     }
 325     close $f
 326 }
 327
 328 set verbose 0
 329 set ifile {}
 330 set ofile out.c
 331 set prefix {c}
 332 # Parse command line
 333 set l [llength $argv]
 334 set i 0
 335 set omits {}
 336 while {$i < $l} {
 337     set arg [lindex $argv $i]
 338     switch -glob -- $arg {
 339         -v {
 340             incr verbose
 341         }
 342         -s {
 343             if {[string length $arg]} {
 344                 set arg [lindex $argv [incr i]]
 345             }
 346             set trie(split) $arg
 347         }
 348         -p {
 349             if {[string length $arg]} {
 350                 set arg [lindex $argv [incr i]]
 351             }
 352             set prefix $arg
 353         }
 354         -o {
 355             if {[string length $arg]} {
 356                 set arg [lindex $argv [incr i]]
 357             }
 358             set ofile $arg
 359         }
 360         -O {
 361             if {[string length $arg]} {
 362                 set arg [lindex $argv [incr i]]
 363             }
 364             lappend omits $arg
 365         }
 366         default {
 367             lappend ifiles $arg
 368         }
 369     }
 370     incr i
 371 }
 372 if {![info exists ifiles]} {
 373     puts "charconv.tcl: missing input file(s)"
 374     usage
 375 }
 376
 377 set ofilehandle [open $ofile w]
 378 preamble_trie $ofilehandle
 379
 380 foreach ifile $ifiles {
 381     readfile $ifile $ofilehandle $prefix $omits
 382 }
 383 close $ofilehandle
 384
 385