yaz-asncomp

harvest是一个下载html网页得机器人

proc asnModuleBody {} {
    global type val file inf

    if {[info exists inf(prefix,$inf(module))]} {
        set prefix $inf(prefix,$inf(module))
    } else {
        set prefix $inf(prefix)
    }
    set inf(fprefix) [lindex $prefix 0]
    set inf(vprefix) [lindex $prefix 1]
    set inf(dprefix) [lindex $prefix 2]
    if {[llength $prefix] > 3} {
	set inf(cprefix) [lindex $prefix 3]
    } else {
	set inf(cprefix) {YAZ_EXPORT }
    }

    if {$inf(verbose)} {
        puts "Module $inf(module), $inf(lineno)"
    }

    set defblock 0
    if {[info exists inf(init,$inf(module),c)]} {
	puts $file(outc) $inf(init,$inf(module),c)
    }
    if {[info exists inf(init,$inf(module),h)]} {
	puts $file(outh) "\#ifdef __cplusplus"
	puts $file(outh) "extern \"C\" \{"
	puts $file(outh) "\#endif"
	set defblock 1
	puts $file(outh) $inf(init,$inf(module),h)
    }
    if {[info exists inf(init,$inf(module),p)]} {
	puts $file(outp) $inf(init,$inf(module),p)
    }

    while {[string length $type]} {
	if {[string compare $type n]} {
	    lex
	    continue
	}
	if {![string compare $val END]} {
	    break
	} elseif {![string compare $val EXPORTS]} {
	    lex
	    asnExports
	} elseif {![string compare $val IMPORTS]} {
	    if {$defblock} {
		puts $file(outh) "\#ifdef __cplusplus"
		puts $file(outh) "\}"
		puts $file(outh) "\#endif"
		set defblock 0
	    }
	    lex
	    asnImports
	} else {
	    if {!$defblock} {
		puts $file(outh) "\#ifdef __cplusplus"
		puts $file(outh) "extern \"C\" \{"
		puts $file(outh) "\#endif"
		set defblock 1
	    }
	    set inf(asndef) $inf(nodef)
	    set oval $val
	    lex
	    if {![string compare $type :]} {
		lex
		asnDef $oval
		set inf(asndef) 0
	    } elseif {![string compare $type n]} {
		lex
		if {[string length $type]} {
		    lex
		}
	    }
	}
    }
    if {$defblock} {
	puts $file(outh) "\#ifdef __cplusplus"
	puts $file(outh) "\}"
	puts $file(outh) "\#endif"
	set defblock 0
    }
    foreach x [array names inf imports,*] {
        unset inf($x)
    }
}

# asnTagDefault: parses TagDefault section
proc asnTagDefault {} {
    global type val inf file
    
    set inf(implicit-tags) 0
    while {[string length $type]} {
	if {[lex-name-move EXPLICIT]} {
	    lex
	    set inf(implicit-tags) 0
	} elseif {[lex-name-move  IMPLICIT]} {
	    lex
	    set inf(implicit-tags) 1
	} else {
	    break
	}
    }
}

# asnModules: parses a collection of module specifications.
# Depending on the module pattern, $inf(moduleP), a module is either
# skipped or processed.
proc asnModules {} {
    global type val inf file yc_version

    set inf(nodef) 0
    set inf(asndef) 0
    lex
    while {![string compare $type n]} {
	set inf(module) $val
        if {[info exists inf(moduleP)] && ![string match $inf(moduleP) $val]} {
            if {$inf(verbose)} {
                puts "Skipping $id"
            }
            while {![lex-name-move END]} {
		lex
	    }
        } else {
	    set inf(nodef) 1
	    set inf(asndef) 1

	    while {![lex-name-move DEFINITIONS]} {
		lex
		if {![string length $type]} return
	    }
	    if {[info exists inf(filename,$inf(module))]} {
		set fname $inf(filename,$inf(module))
	    } else {
		set fname $inf(module)
	    }
            set ppname [join [split $fname -] _]

	    if {![info exists inf(c-file)]} {
		set inf(c-file) ${fname}.c
	    }
	    set file(outc) [open $inf(c-file) w]

	    if {![info exists inf(h-file)]} {
		set inf(h-file) ${fname}.h
	    }
	    set file(outh) [open $inf(h-path)/$inf(h-dir)$inf(h-file) w]

	    if {0} {
	        if {![info exists inf(p-file)]} {
		    set inf(p-file) ${fname}-p.h
	        }
	        set file(outp) [open $inf(h-path)/$inf(h-dir)$inf(p-file) w]
            }

	    set greeting {Generated automatically by the YAZ ASN.1 Compiler}

	    puts $file(outc) "/* ${greeting} ${yc_version} */"
	    puts $file(outc) "/* Module-C: $inf(module) */"
	    puts $file(outc) {}

	    puts $file(outh) "/* ${greeting} ${yc_version} */"
	    puts $file(outh) "/* Module-H $inf(module) */"
	    puts $file(outh) {}

	    if {[info exists file(outp)]} {
	        puts $file(outp) "/* ${greeting} ${yc_version} */"
	        puts $file(outp) "/* Module-P: $inf(module) */"
	        puts $file(outp) {}
            }

            if {[info exists inf(p-file)]} {
	        puts $file(outc) "\#include <$inf(h-dir)$inf(p-file)>"
            } else {
	        puts $file(outc) "\#include <$inf(h-dir)$inf(h-file)>"
            }
	    puts $file(outh) "\#ifndef ${ppname}_H"
	    puts $file(outh) "\#define ${ppname}_H"
	    puts $file(outh) {}
	    puts $file(outh) "\#include <yaz/odr.h>"
	   
            if {[info exists file(outp)]} { 
	        puts $file(outp) "\#ifndef ${ppname}_P_H"
	        puts $file(outp) "\#define ${ppname}_P_H"
	        puts $file(outp) {}
	        puts $file(outp) "\#include <$inf(h-dir)$inf(h-file)>"

            }
	    
	    asnTagDefault
	    if {[string compare $type :]} {
		asnError "::= expected got $type '$val'"
	    } 
	    lex
	    if {![lex-name-move BEGIN]} {
		asnError "BEGIN expected"
	    }
	    asnModuleBody
	    lex

	    if {[info exists file(outp)]} {
		set f $file(outp)
	    } else {
		set f $file(outh)
	    }
	    puts $f "\#ifdef __cplusplus"
	    puts $f "extern \"C\" \{"
	    puts $f "\#endif"
	    for {set i 1} {$i < $inf(nodef)} {incr i} {
		puts $f $inf(var,$i)
		if {[info exists inf(asn,$i)]} {
		    if {0} {
			puts $f "/*"
			foreach comment $inf(asn,$i) {
			    puts $f $comment
			}
			puts $f " */"
		    }
		    unset inf(asn,$i)
		}
		unset inf(var,$i)
		puts $f {}
	    }
	    puts $f "\#ifdef __cplusplus"
	    puts $f "\}"
	    puts $f "\#endif"

	    if {[info exists inf(body,$inf(module),h)]} {
		puts $file(outh) $inf(body,$inf(module),h)
	    }
	    if {[info exists inf(body,$inf(module),c)]} {
		puts $file(outc) $inf(body,$inf(module),c)
	    }
	    if {[info exists inf(body,$inf(module),p)]} {
                if {[info exists file(outp)]} {
		    puts $file(outp) $inf(body,$inf(module),p)
                }
	    }
	    puts $file(outh) "\#endif"
            if {[info exists file(outp)]} {
	        puts $file(outp) "\#endif"
            }
	    foreach f [array names file] {
		close $file($f)
	    }
	    unset inf(c-file)
	    unset inf(h-file)
	    catch {unset inf(p-file)}
	}
    }
}

# asnFile: parses an ASN.1 specification file as specified in $inf(iname).
proc asnFile {} {
    global inf file

    if {$inf(verbose) > 1} {
        puts "Reading ASN.1 file $inf(iname)"
    }
    set inf(str) {}
    set inf(lineno) 0
    set inf(inf) [open $inf(iname) r]
    
    asnModules
    
}

# The following procedures are invoked by the asnType function. 
# Each procedure takes the form: asnBasic<TYPE> and they must return
# two elements: the C function handler and the C type.
# On entry upvar $name is the type we are defining and global, $inf(module), is
# the current module name.

proc asnBasicEXTERNAL {} {
    return {odr_external {Odr_external}}
}

proc asnBasicINTEGER {} {
    return {odr_integer {int}}
}

proc asnBasicENUMERATED {} {
    return {odr_enum {int}}
}

proc asnBasicNULL {} {
    return {odr_null {Odr_null}}
}

proc asnBasicBOOLEAN {} {
    return {odr_bool {bool_t}}
}

proc asnBasicOCTET {} {
    global type val
    lex-name-move STRING
    return {odr_octetstring {Odr_oct}}
}

proc asnBasicBIT {} {
    global type val
    lex-name-move STRING
    return {odr_bitstring {Odr_bitmask}}
}

proc asnBasicOBJECT {} {
    global type val
    lex-name-move IDENTIFIER
    return {odr_oid {Odr_oid}}
}

proc asnBasicGeneralString {} {
    return {odr_generalstring char}
}

proc asnBasicVisibleString {} {
    return {odr_visiblestring char}
}

proc asnBasicGeneralizedTime {} {
    return {odr_generalizedtime char}
}

proc asnBasicANY {} {
    upvar name name
    global inf
    return [list $inf(fprefix)ANY_$name void]
}

# userDef: reads user definitions file $name
proc userDef {name} {
    global inf

    if {$inf(verbose) > 1} {
        puts "Reading definitions file $name"
    }
    source $name

    if {[info exists default-prefix]} {
        set inf(prefix) ${default-prefix}
    }
    if {[info exists h-path]} {
        set inf(h-path) ${h-path}
    }
    foreach m [array names prefix] {
        set inf(prefix,$m) $prefix($m)
    }
    foreach m [array names body] {
	set inf(body,$m) $body($m)
    }
    foreach m [array names init] {
	set inf(init,$m) $init($m)
    }
    foreach m [array names filename] {
	set inf(filename,$m) $filename($m)
    }
    foreach m [array names map] {
        set inf(map,$m) $map($m)
    }
    foreach m [array names membermap] {
        set inf(membermap,$m) $membermap($m)
    }
    foreach m [array names unionmap] {
        set inf(unionmap,$m) $unionmap($m)
    }
}

set inf(verbose) 0
set inf(prefix) {yc_ Yc_ YC_}
set inf(h-path) .
set inf(h-dir) ""

# Parse command line
set l [llength $argv]
set i 0
while {$i < $l} {
    set arg [lindex $argv $i]
    switch -glob -- $arg {
        -v {
	    incr inf(verbose) 
        }
        -c {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
                 set p [lindex $argv [incr i]]
             }
	    set inf(c-file) $p
        }
        -I* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
                 set p [lindex $argv [incr i]]
             }
	    set inf(h-path) $p
        }
	-i* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
                 set p [lindex $argv [incr i]]
            }
	    set inf(h-dir) [string trim $p \\/]/
	}
        -h* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
                 set p [lindex $argv [incr i]]
             }
	    set inf(h-file) $p
        }
        -p* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
		set p [lindex $argv [incr i]]
	    }
	    set inf(p-file) $p
        }
        -d* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
		set p [lindex $argv [incr i]]
	    }
	    userDef $p
        }
        -m* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
		set p [lindex $argv [incr i]]
	    }
	    set inf(moduleP) $p
        }
	-x* {
	    set p [string range $arg 2 end]
	    if {![string length $p]} {
		set p [lindex $argv [incr i]]
	    }
	    if {[llength $p] == 1} {
		set inf(prefix) [list [string tolower $p] \
				     [string toupper $p] [string toupper $p]]
	    } elseif {[llength $p] == 3} {
		set inf(prefix) $p
	    } else {
		puts [llength $p]
		exit 1
	    }
	}	    
        default {
	    set inf(iname) $arg
        }
    }
    incr i
}

if {![info exists inf(iname)]} {
    puts "YAZ ASN.1 Compiler ${yc_version}"
    puts "Usage:"	
    puts -nonewline ${argv0}
    puts { [-v] [-c cfile] [-h hfile] [-p hfile] [-d dfile] [-I iout] [-i idir]}
    puts {    [-m module] file}
    exit 1
}

asnFile