Artifact Content
Not logged in

Artifact ae89b8cfa1bd2fd9a2fce68e2852b333f5a83281:


namespace eval didl {
    package require tdom
    variable xmlns {
	dc	http://purl.org/dc/elements/1.1/
	upnp	urn:schemas-upnp-org:metadata-1-0/upnp/
    }
    variable containers {}
    namespace ensemble create -subcommands {parse build}
}

proc didl::parse {data} {
    variable xmlns
    dom parse $data doc
    $doc selectNodesNamespaces $xmlns
    $doc documentElement root
    # Can't use tailcall because doc needs to stay around while recurse runs.
    return [recurse $root]
}

proc didl::recurse {doc} {
    set rc {}
    foreach n [$doc childNodes] {
	set name [$n nodeName]
	set attr {}
	foreach a [$n attributes] {
	    if {[llength $a] == 1} {
		dict set attr $a [$n getAttribute $a]
	    }
	}
	if {[dict size $attr] == 0 && [string match *:* $name]} {
	    dict set rc $name [$n text]
	} elseif {[[$n firstChild] nodeType] eq "TEXT_NODE"} {
	    dict lappend rc $name \
	      [dict create attributes $attr value [$n text]]
	} else {
	    dict lappend rc $name \
	      [dict create attributes $attr contents [recurse $n]]
	}
    }
    return $rc
}

proc didl::build {dict} {
    variable xmlns
    dom createDocument DIDL-Lite doc
    $doc selectNodesNamespaces $xmlns
    $doc documentElement root
    dict for {ns url} $xmlns {
	$root setAttribute xmlns:$ns $url
    }
    $root setAttribute xmlns urn:schemas-upnp-org:metadata-1-0/DIDL-Lite/
    builddict $root $dict
    return [$doc asXML -indent none]
}

proc didl::builddict {node dict} {
    $node ownerDocument doc
    dict for {tag data} $dict {
	if {[string match *:* $tag]} {
	    $node appendChild [$doc createElement $tag new]
	    $new appendChild [$doc createTextNode $data]
	} else {
	    foreach item $data {
		$node appendChild [$doc createElement $tag new]
		if {[dict exists $item attributes]} {
		    $new setAttribute {*}[dict get $item attributes]
		}
		if {[dict exists $item value]} {
		    $new appendChild \
		      [$doc createTextNode [dict get $item value]]
		} elseif {[dict exists $item contents]} {
		    builddict $new [dict get $item contents]
		}
	    }
	}
    }
}