/usr/share/tcltk/xotcl1.6.7-xml/xml.xotcl is in xotcl 1.6.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | #!../../src/xotclsh
# $Id: xml.xotcl,v 1.2 2006/02/18 22:17:33 neumann Exp $
#
# smaller implementation of an XML parser wrapper, similar to xoXML
# example from the XOTcl paper
#
# not used in ActiWeb
#
package require xml
#
# Xml Parser Connection Class (wrapper facade to TclXML and expat interface like parsers)
#
Class XMLParser
XMLParser instproc init args {
my set PC [xml::parser [my autoname [namespace tail [self]]]]
my config \
-characterdatacommand "[self] pcdata" \
-elementstartcommand "[self] start" \
-elementendcommand "[self] end"
my set currentElement [Node create [self]::T]
next
}
# Create Forwarding methods to the parser ==
# abstact interface for xml parser acces
XMLParser instproc cget option {[my set PC] cget $option}
XMLParser instproc config args {eval "[my set PC] configure $args"}
XMLParser instproc parse data {[my set PC] parse $data}
XMLParser instproc reset {} {[my set PC] reset; [self]::T reset}
XMLParser instproc pcdata text {
my instvar currentElement
$currentElement insertText $text
}
XMLParser instproc start {name attrList} {
my instvar currentElement
set currentElement [$currentElement insertElement $name $attrList]
}
XMLParser instproc end {name} {
my instvar currentElement
set currentElement [$currentElement info parent]
}
XMLParser instproc print {} {
::x::T print
puts ""
}
###############################################################################
# Simple Node tree
# General Nodes
Class Node
Node instproc reset {} {
foreach c [my info children] {$c destroy}
my set children ""
}
Node instproc print {} {
if {[my exists children]} {
foreach c [my set children] { $c print}
}
}
Node instproc insert {xoclass elementclass args} {
set new [eval $xoclass new -childof [self] $args]
my lappend children $new
return $new
}
Node instproc insertElement {tag args} {
return [eval my insert Element $tag -attributes $args -tag $tag]
}
Node instproc insertText {text} {
return [my insert Text text -content $text]
}
# Element Nodes
Class Element -superclass Node -parameter {
{attributes ""}
tag
}
Element instproc print {} {
my instvar tag attributes
if {[llength $attributes]>0} {
foreach {n v} $attributes {append string " " $n = '$v'}
} else {
set string ""
}
puts -nonewline <$tag$string>
next
puts -nonewline </$tag>
}
# Text Nodes
Class Text -superclass Node -parameter {
{content ""}
}
Text instproc print {} {
puts -nonewline [my set content]
}
#################################################################################
### Examples
#################################################################################
XMLParser x
x parse {<rdf:RDF
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
xmlns:dc="http://purl.org/metadata/dublin_core#">
<rdf:Description about="http://www.foo.com/cool.html">
<dc:Creator>
<rdf:Seq ID="CreatorsAlphabeticalBySurname">
<rdf:li>Mary Andrew</rdf:li>
<rdf:li>Jacky Crystal</rdf:li>
</rdf:Seq>
</dc:Creator>
<dc:Identifier>
<rdf:Bag ID="MirroredSites">
<rdf:li rdf:resource="http://www.foo.com.au/cool.html"/>
<rdf:li rdf:resource="http://www.foo.com.it/cool.html"/>
</rdf:Bag>
</dc:Identifier>
<dc:Title>
<rdf:Alt>
<rdf:li xml:lang="en">The Coolest Web Page</rdf:li>
<rdf:li xml:lang="it">Il Pagio di Web Fuba</rdf:li>
</rdf:Alt>
</dc:Title>
</rdf:Description>
</rdf:RDF>}
::x print
puts ============================================================
x reset
x parse {
<TEST>
a
<X a="http://www.foo.com/cool1.html">b</X>
c
<Y a="http://www.foo.com/cool2.html">d<Z>e</Z>f</Y>
g
</TEST>
}
x print
|