src/charconv.tcl

   1 #!/bin/sh
   2 # the next line restats using tclsh \
   3 exec tclsh "$0" "$@"
   4 #
   5 # $Id: charconv.tcl,v 1.12 2006-04-19 23:15:39 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 reverse} {
 259     global trie
 260
 261     set marc_lines 0
 262     set ucs_lines 0
 263     set utf_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                 if {$reverse} {
 295                     for {set i 0} {$i < [string length $utf]} {incr i 2} {
 296                         lappend hex [string range $utf $i [expr $i+1]]
 297                     }
 298                     # puts "ins_trie $hex $marc
 299                     ins_trie $hex $marc $combining $codename
 300                     unset hex
 301                 } else {
 302                     for {set i 0} {$i < [string length $marc]} {incr i 2} {
 303                         lappend hex [string range $marc $i [expr $i+1]]
 304                     }
 305                     # puts "ins_trie $hex $ucs"
 306                     ins_trie $hex $ucs $combining $codename
 307                     unset hex
 308                 }
 309             }
 310             set marc {}
 311             set uni {}
 312             set codename {}
 313             set combining 0
 314         } elseif {[regexp {<marc>([0-9A-Fa-f]*)</marc>} $line s marc]} {
 315             incr marc_lines
 316         } elseif {[regexp {<name>(.*)</name>} $line s codename]} {
 317             incr codename_lines
 318         } elseif {[regexp {<name>(.*)} $line s codename]} {
 319             incr codename_lines
 320             incr lineno
 321             set cnt [gets $f line]
 322             if {$cnt < 0} {
 323                 break
 324             }
 325             if {[regexp {(.*)</name>} $line s codename_ex]} {
 326                 set codename "${codename} ${codename_ex}"
 327             }
 328         } elseif {[regexp {<isCombining>true</isCombining>} $line s]} {
 329             set combining 1
 330         } elseif {[regexp {<ucs>([0-9A-Fa-f]*)</ucs>} $line s ucs]} {
 331             incr ucs_lines
 332         } elseif {[regexp {<utf-8>([0-9A-Fa-f]*)</utf-8>} $line s utf]} {
 333             incr utf_lines
 334         }
 335     }
 336     close $f
 337 }
 338
 339 set verbose 0
 340 set ifile {}
 341 set ofile out.c
 342 set prefix {c}
 343 set reverse_map 0
 344 # Parse command line
 345 set l [llength $argv]
 346 set i 0
 347 set omits {}
 348 while {$i < $l} {
 349     set arg [lindex $argv $i]
 350     switch -glob -- $arg {
 351         -v {
 352             incr verbose
 353         }
 354         -s {
 355             if {[string length $arg]} {
 356                 set arg [lindex $argv [incr i]]
 357             }
 358             set trie(split) $arg
 359         }
 360         -p {
 361             if {[string length $arg]} {
 362                 set arg [lindex $argv [incr i]]
 363             }
 364             set prefix $arg
 365         }
 366         -o {
 367             if {[string length $arg]} {
 368                 set arg [lindex $argv [incr i]]
 369             }
 370             set ofile $arg
 371         }
 372         -O {
 373             if {[string length $arg]} {
 374                 set arg [lindex $argv [incr i]]
 375             }
 376             lappend omits $arg
 377         }
 378         -r {
 379             set reverse_map 1
 380         }
 381         default {
 382             lappend ifiles $arg
 383         }
 384     }
 385     incr i
 386 }
 387 if {![info exists ifiles]} {
 388     puts "charconv.tcl: missing input file(s)"
 389     usage
 390 }
 391
 392 set ofilehandle [open $ofile w]
 393 preamble_trie $ofilehandle
 394
 395 foreach ifile $ifiles {
 396     readfile $ifile $ofilehandle $prefix $omits $reverse_map
 397 }
 398 close $ofilehandle
 399
 400