src/charconv.tcl

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