sxml.tcl

Linux下的MSN聊天程序源码

		return 1
	    }
	    return 0
	}

	#########################################################################
	#									#
	# The below function, when called with the current position and the	#
	# being interpreted will return the character to place on the string	#
	# and the pointer will be updated to the next character position.	#
	#									#
	# This routine handles escape characters and & special symbols.		#
	#									#
	# 1.8.2		When this routine is called it is now passed the	#
	#		value of xml_cdata_parse as well. If set none of the	#
	#		standard substitutions are performed. However the 	#
	#		special CDATA case of "]]>" will change to		#
	#		"]]>" in such cases.					#
	#									#
	#########################################################################

	proc xml_handle_bs {cptr cline incdata} {
	    upvar $cptr c

	    set tcline [string range $cline $c end]
	    if { $incdata == 1 } {
		if { [string first {]]>} $tcline] == 0 } {
		    incr c 6
		    return {]]>}
            }
            set ch [string index $cline $c]
            incr c
            return $ch
            }

            if { [string first "&" $tcline] == 0 } {
                incr c 5
                return {&}
            }
            if { [string first "<" $tcline] == 0 } {
                incr c 4
                return {<}
            }
            if { [string first "&gt;" $tcline] == 0 } {
                incr c 4
                return {>}
            }
            if { [string first "&quot;" $tcline] == 0 } {
                incr c 6
                return \"
            } 
            if { [string first "&apos;" $tcline] == 0 } {
                incr c 6
                return {'}
            } 

            set ch [string index $cline $c]
            incr c
            return $ch
      }

proc xml_handle_bs_string {str incdata} {
    set c 0
    set x [string length $str]
    set nstr ""
    while { $c <= $x } {
	append nstr [xml_handle_bs c $str $incdata]
    }
    return $nstr
}

proc do_extended_proc_search {proclist cstack} {

    # We need to get the current stack and chop off the most 	#
    # recent...							#
    set els [split $cstack :]
    set y [llength $els]
    if { $y < 1 } {
	return -1
    }
    set searchfor [join [lrange $els 0 [expr {$y - 2}]] ":"]
    if { "$searchfor" == "" } {
	set searchfor "*"
    } else {
	append searchfor ":*"
    }
    #################################################################
    # If we have a stack then we generate the the possible global	#
    # function to handle this level of stack.			#
    #################################################################

    set x [lsearch -exact $proclist $searchfor]
    return $x
}

# xml_parse return codes:
# -1:	Id specified is not recognized.
# -2:	End of line encountered before end of current tag
# -3:	Current end tag does not match latest start tag
# -4:	An error occurred whilst calling user-procedure
# -5:	End of file encountered during comment reading
# -6:	End of file encountered with non-empty stack
# -7:	More than one top level entity encountered in file
# -8:	Entity name is not well formed.
# -9:	Attribute name is not well formed.
# 

proc parse {id} {
    variable xml_invoc
    variable xml_stack
    variable xml_file
    variable xml_procs
    variable xml_attrs_stack
    variable xml_data_stack
    variable xml_hadtoplevel
    variable xml_cdata_parse
    variable xml_cdata_start
    variable xml_cdata_end
    variable xml_attrs

	if { $xml_attrs(${id}_trace) >= 1 } {
		status_log "sxml $id : Started parsing"
	}


    #################################################################
    # If the trace attribute has been set, then set the local	#
    # variable to indicate this fact.				#
    #################################################################

    set trace $xml_attrs(${id}_trace)

    set xml_s_len [expr {[string length $xml_cdata_start] - 1}]
    set xml_e_len [expr {[string length $xml_cdata_end] - 1}]

    #################################################################
    # Check for the special _default_ handler and ensure this	#
    # is made available during the parse.				#
    #################################################################

    set have_default [lsearch -exact $xml_procs($id) _default_]
    if { $have_default == -1 || [expr {$have_default % 3}] != 0 } {
	set defproc ""
    } else {
	incr have_default
	set defproc [lindex $xml_procs($id) $have_default]
	# Call back arguments, if defined
	set args [lindex $xml_procs($id) [expr {$have_default + 1}]]
    }

    set have_default 0
    if {! [info exists xml_stack($id)]} {
	return -1
    }
    
    #################################################################
    # Loop for all lines in the file to parse			#
    # Status is used to indicate current status of element... 	#
    # 0 - waiting to start element....				#
    # 1 - reading element start tag					#
    # 2 - Reading data for attribute...				#
    # 3 - Reading tag (end tag if 1st ch!= "/")			#
    # 4 - Reading embedded comment/code, ignoring...		#
    #								#
    # 1.8.2	Note:	When reading CDATA the status must be 2, since	#
    #		CDATA is only accepted in data.			#
    #################################################################

    set cstack {}
    set cfileline 0
    set status 0
    while {! [eof $xml_file($id)]} {
	    # The following commented block could be used instead of the 3 [read/string map/append] lines that come right after
	    # The advantage is that, this way we get the line number for each tag (only used in a puts, if no closing tag for a comment is found), 
	    # but we might have a bug on a line like "<entry/> <entry" ...

	    # Both versions are used to avoid a bug on reading files where the tags are multiline like in .svn/entries for example
	    
	    gets $xml_file($id) cline
	    incr cfileline
	    if { "$trace" >= 1 } {
	        status_log "Trace: Read line ($status): $cline"
	    }

	    if { [string first "<" $cline] != -1 } {
		    while { [string first ">" $cline] == -1 && ! [eof $xml_file($id)] } {
			    append cline [gets $xml_file($id)]
			    incr cfileline
			    if { "$trace" >= 1 } {
				    status_log "Trace: Append line ($status): $cline"
			    }
		    } 
	    }
	    append cline "\n"


#	    # The following lines read the whole file and put it as a single line.
#	    set cline [read $xml_file($id)]
#	    set cline [string map { "\n" "" } $cline]
#	    append cline "\n"


	#########################################################
	# The processing of <tag/> is performed by		#
	# pre-processing each line to convert <tag/> to		#
	# <tag></tag>.						#
	#########################################################
	if {[regsub -all {<([A-Za-z0-9_]+)/>} $cline {<\1></\1>} xx]} {
	    set cline $xx
	}

	set c 0
	set ll [string length $cline]
	while { $c < $ll } {
	    set ch [string index $cline $c]
	    if { $status == 4 } {
		#################################################
		# Cope with --> end comments...			#
		#################################################
		set ch3 [string range $cline $c [expr {$c + 2}]]
		if { "$ch3" == "-->" } {
		    set status $prev_status
		    incr c 3; continue
		}
		if { "$ch" != "?" } {
		    incr c; continue
		}
		set ch2 [string index $cline [expr {$c + 1}] ]
		if { "$ch2" == ">" } {
		    set status $prev_status
		    incr c 2; continue
		}
		incr c; continue
	    }
	    if { $status == 0 } {
		if { "$ch" == "<" } {
		    set status 1
		    set tag ""
		    incr c; continue
		}
		#################################################
		# Ignore all other characters. . .		#
		#################################################
		incr c; continue
	    }

	    if { $status == 1 } {
		set empty_ctag 0
		#################################################
		# Look for <? which is treated as a		#
		# comment at the moment...			#
		#################################################
		if { "$tag" == "" } {
		    if { "$ch" == "?" } {
			set status 4
			set prev_status 0
			set comstart $cfileline
			incr c; continue
		    }

		    #########################################
		    # Look for <!-- comment start tag	#
		    #########################################
		    set ch3 [string range $cline $c [expr {$c + 2}]]
		    if { "$ch3" == "!--" } {
			set status 4
			set prev_status 0
			set comstart $cfileline
			incr c 3; continue
		    }

		    if { "$ch" == "/" } {
			#################################
			# We've got an embedded end tag	#
			# rather than item start tag.   #
			#################################
			set status 3
			set etag $ch
			incr c; continue
		    }
		}

		if { "$ch" != ">" } {
		    #########################################
		    # If we've got a space, then we expect  #
		    # attributes - if tag is not empty. - - #
		    #########################################
		    if { "$tag" != "" && ("$ch" == " " || "$ch" == "\t") } {
			set xx [string range $cline $c end]
			set xx2 [string first ">" $xx]
			if { $xx2 == -1 } {
				if { $xml_attrs(${id}_silent) == 0 } {
					status_log "Error: End of line before end of tag encountered."
					status_log "Current line below: \n$cline"
				}
				return -2
				
			}
			set xx [string range $xx 0 [expr {$xx2 - 1}] ]
			if { [catch {set ctag_attrs [xml_tag_attrs_to_str $xx empty_ctag $xml_cdata_parse($id)]}] } {
			    if { $xml_attrs(${id}_silent) == 0 } {
				status_log "Current stack: $cstack:$tag"
			    }
			    return -9
			}
			incr c $xx2
			# Move past tag and deal with it...
		    } else {
			set ctag_attrs ""
			append tag $ch
			incr c; continue
		    }
		}
		#################################################
		# We have ended the current tag...		#
		#################################################
		set tag [string tolower $tag]
		if { "$trace" >= 1 } {
		    status_log "Trace: Start-tag: $tag"
		}
		if { [string length $cstack] == 0 } {
		    #################################################################
		    # If we have ended the current tag and the stack is empty	#
		    # then we should check to ensure this is the first top-level	#
		    # entity and abort with an error if not.			#
		    #################################################################
		    if { $xml_hadtoplevel($id) == 1 } {
			if { $xml_attrs(${id}_silent) == 0 } {
			    status_log "Error: Second top-level entity found! ($tag)"
			}
			return -7
		    }
		    if { ! [validate_name $tag] } {
			if { $xml_attrs(${id}_silent) == 0 } {
			    status_log "Error: Entity name malformed: $tag"
			}
			return -8
		    }
		    set cstack $tag
		    set xml_hadtoplevel($id) 1
		} else {
		    if { ! [validate_name $tag] } {
			if { $xml_attrs(${id}_silent) == 0 } {
				status_log "Error: Entity name malformed: $tag"
			}
			return -8
		    }
		    append cstack ":$tag"
		}
		#################################################