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] } } } } }