schema.tcl

Local Lucene ==================== Provide geographical based searching to lucene in an efficent ma

# $RCSfile: schema.tcl,v $ 
#    Schema engine
#    using an xml schema document, pass in a node name
#    and data elements, ::schema::parse generates
#
# Copywrite (c) Patrick O'Leary 2005, [e-mail]
#
# License: released under the gnu license
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# $Id: schema.tcl,v 1.4 2005/05/22 00:08:23 pjaol Exp $

package provide schema 1.0
package require tdom

namespace eval ::schema:: {}


#
proc ::schema::parse { doc name {results} } {

    set root [$doc documentElement]

    global _schema
    global _result
    global _docNameSpace

    set _schema $doc
    set _result [dom createDocument a]

    set node [$doc documentElement]
    set nodeName [$node nodeName]
    set _docNameSpace [lindex [split $nodeName :] 0]

    set res {}
    set elementXSD \
	[$root selectNodes \
	     "/$_docNameSpace:schema/$_docNameSpace:element\[@name='$name'\]"]

    #grr stupid tdom returns "" rather than 0 or {}
    if {[string length $elementXSD] } {
	set res [::schema::parseElements \
		     $elementXSD $name $results]
    } else {
	error "Invalid schema node: $name"
    }
    return $res
}


proc ::schema::parseElements { nodes name {results {}} } {

    global _docNameSpace
    if {[$nodes hasChildNodes]} {
	foreach node [$nodes childNodes] {
	    
	    set nodeType [$node nodeName]
	    if {$nodeType == "$_docNameSpace:simpleType"} {
		
		return [::schema::simpleType $nodes \
			    $name \
			    $results]
	    } else {
		
		return [::schema::complexType $nodes\
			    $name\
			    $results]
	    }
	}
    } else {
	
	set type ""
	catch {
	    set type [$node getAttribute type]
	}
	
	if { $type == "$_docNameSpace:simpleType" || [::schema::isNaturalType $type]} {
	    return [::schema::simpleType $nodes $name $results]
	} else {
	    return [::schema::complexType $nodes $name $results $type]
	}
    }
}




proc ::schema::simpleType { node name {results} } {

    global _result
    global _docNameSpace

    if {[$node hasChildNodes]} {
	set restriction [$node getElementsByTagName $_docNameSpace:restriction]
	set type [$restriction getAttribute base]
    } else {
	set type [$node getAttribute type]
    }
    #could be a simpleType element from
    #a complexType complexContent, where local attribute name
    #overrides parent name, if no name use parent name
    catch {
	set name [$node getAttribute name]
    } err

    set element [$_result createElement $name]
    $element setAttribute type $type
    $element appendFromList [list "\#text" $results]
    
    return $element
}



proc ::schema::complexType { node name {results {}} {type {}} } {

    global _docNameSpace

    if {[string length $type]} {
	set nodes [$node selectNodes "/$_docNameSpace:complexType\[@name='$type'\]"]
	return [::schema::complexTypeContent $nodes $name $results]
    }
    
    $node firstChild child
    return [::schema::complexTypeContent $child $name $results]
}



proc ::schema::complexTypeContent { node name {results {}}} {

    global _docNameSpace
    global _result
    set res [$_result createElement $name]
    set name [$node nodeName]

    if { $name == "$_docNameSpace:complexType" } {
	
	set content [$node firstChild]
	set body [$content nodeName]
	
	if {$body == "$_docNameSpace:sequence"} {
	    foreach item [$content childNodes] {
		set thisResult [lindex $results 0]
		$res appendChild \
		    [::schema::parseElements $item\
			    $name\
			 $thisResult]
		set results [lrange $results 1 end]
	    }
	} elseif { $body == "$_docNameSpace:attribute" } {
	    set atName [$content getAttribute name]
	    $res setAttribute $atName $results
	} elseif { $body == "$_docNameSpace:complexContent" } {
	    ::schema::complexContent $content $name $results
	}
	
    }

    return $res
}



proc ::schema::complexContent { node name {results {}}} {
    error "soap.schema.complexContent not implemented yet"
}



proc ::schema::isNaturalType { type } {

    global _docNameSpace
    set valid "$_docNameSpace:string $_docNameSpace:Boolean $_docNameSpace:float $_docNameSpace:double\
               $_docNameSpace:decimal $_docNameSpace:binary $_docNameSpace:integer\
               $_docNameSpace:nonPositiveInteger $_docNameSpace:negativeInteger\
               $_docNameSpace:long $_docNameSpace:short $_docNameSpace:byte $_docNameSpace:nonNegativeInteger\
               $_docNameSpace:unsignedLong $_docNameSpace:unsignedInt $_docNameSpace:unsignedShort \
               $_docNameSpace:unsignedByte $_docNameSpace:positiveInteger $_docNameSpace:date $_docNameSpace:time"

    return [string match "*$type*" $valid]
}


proc soap.getDoc { file } {

    set fh [open $file]
    set content [read $fh]
    close $fh

    return [dom parse $content]

}