diff options
Diffstat (limited to 'tclxml/tclxslt/process.tcl')
| -rw-r--r-- | tclxml/tclxslt/process.tcl | 312 |
1 files changed, 0 insertions, 312 deletions
diff --git a/tclxml/tclxslt/process.tcl b/tclxml/tclxslt/process.tcl deleted file mode 100644 index d38e5fb..0000000 --- a/tclxml/tclxslt/process.tcl +++ /dev/null @@ -1,312 +0,0 @@ -# process.tcl -- -# -# XSLT extension providing processing functions -# -# Copyright (c) 2007 Packaged Press -# http://www.packagedpress.com/ -# Copyright (c) 2002-2004 Zveno Pty Ltd -# http://www.zveno.com/ -# -# See the file "LICENSE" in this distribution for information on usage and -# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# $Id: process.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ - -package provide xslt::process 1.1 - -package require uri 1.1 -package require xslt::cache 3.2 - -namespace eval xslt::process { - namespace export transform fop - namespace export transform-result - namespace export dtd-valid -} - -# Add support for the dom: URI scheme. -# -# This scheme allows a script to reference an in-memory DOM tree. - -proc ::uri::SplitDom url { - return [list dom $url] -} - -proc ::uri::JoinDom args { - array set components { - dom {} - } - array set components $args - - return dom:$components(dom) -} - -# xslt::process::transform -- -# -# Perform an XSL Transformation. -# -# TODO: -# Return messages -# Cache source and stylesheet documents. -# Generate dependency documents. -# -# Arguments: -# src Location of source document -# ssheet Location of stylesheet -# result Location for result document -# params Parameters (nodelist) -# args not needed -# -# Results: -# Returns empty string for success - -# This version forks a process -proc xslt::process::transform_fork {src ssheet result {params {}} args} { - if {[catch {exec tclxsltproc -config /Users/steve/scms/lib/config.tcl --xinclude -o $result $ssheet $src} out]} { - return $out - } else { - return {} - } -} - -# This version performs the transformation in-process. -proc xslt::process::transform:dbg {src ssheet result {params {}} args} { - puts stderr [list process::transform $src $ssheet $result $params $args] - if {[catch {eval transform:dbg [list $src $ssheet $result] $params $args} msg]} { - puts stderr "\nprocess::transform returned error $msg\nStack trace:$::errorInfo\n" - return -code error $msg - } else { - puts stderr [list process::transform ran OK] - return $msg - } -} -proc xslt::process::transform {srcNd ssheetNd resultNd {params {}} args} { - - # The filenames may be passed in as nodesets - set src $srcNd - catch {set src [dom::node stringValue [lindex $srcNd 0]]} - set ssheet $ssheetNd - catch {set ssheet [dom::node stringValue [lindex $ssheetNd 0]]} - set result $resultNd - catch {set result [dom::node stringValue [lindex $resultNd 0]]} - - # params will be a nodeset consisting of name/value pairs. - # These must be converted to strings - set parameterList {} - switch [llength $params] { - 1 { - puts stderr [list xslt::process::transform params nodeType [dom::node cget $params -nodeType]] - set pNdList [dom::node children $params] - } - default { - set pNdList $params - } - } - foreach paramNd $pNdList { - set name [set value {}] - foreach child [dom::node children $paramNd] { - set nameNd [dom::node selectNode $child name] - set name [dom::node stringValue $nameNd] - set valueNd [dom::node selectNode $child value] - set value [dom::node stringValue $valueNd] - } - if {[string compare $name {}]} { - lappend parameterList $name $value - } - } - - puts stderr [list xslt::process::transform parameters: $parameterList] - - set cleanup {} - - if {[catch {open $src} ch]} { - # eval $cleanup - return "unable to open source document \"$src\" for reading due to \"$ch\"" - } - if {[catch {::dom::parse [read $ch] -baseuri $src} sourcedoc]} { - # eval $cleanup - return "unable to parse source document \"$src\" due to \"$sourcedoc\"" - } - close $ch - - append cleanup "dom::destroy $sourcedoc" \n - - dom::xinclude $sourcedoc - - if {[catch {open $ssheet} ch]} { - eval $cleanup - return "unable to open stylesheet document \"$ssheet\" for reading due to \"$ch\"" - } - if {[catch {::dom::parse [read $ch] -baseuri $ssheet} styledoc]} { - eval $cleanup - return "unable to parse stylesheet document \"$ssheet\" due to \"$styledoc\"" - } - close $ch - - append cleanup "dom::destroy $styledoc" \n - - if {[catch {xslt::compile $styledoc} style]} { - eval $cleanup - return "unable to compile stylesheet \"$ssheet\" due to \"$style\"" - } - - append cleanup "rename $style {}" \n - - if {[catch {eval [list $style] transform [list $sourcedoc] $parameterList} resultdoc]} { - eval $cleanup - return "unable to transform document \"$src\" with stylesheet \"$ssheet\" due to \"$resultdoc\"" - } - - append cleanup "dom::destroy $resultdoc" \n - - if {[catch {open $result w} ch]} { - eval $cleanup - return "unable to save result document \"$result\" due to \"$ch\"" - } - - puts $ch [dom::serialize $resultdoc -method [$style cget -method]] - close $ch - - catch { - uplevel \#0 $cleanup - } - - return {} -} - -# xslt::process::transform-result -- -# -# Perform an XSL Transformation. -# This version returns the result document. -# -# Arguments: -# src Location of source document -# ssheet Location of stylesheet -# params Parameters (nodelist) -# args not needed -# -# Results: -# Returns result document. - -proc xslt::process::transform-result {srcNd ssheetNd {params {}} args} { - - # The filenames may be passed in as nodesets - set src $srcNd - catch {set src [dom::node stringValue [lindex $srcNd 0]]} - set ssheet $ssheetNd - catch {set ssheet [dom::node stringValue [lindex $ssheetNd 0]]} - - # params will be a nodeset consisting of name/value pairs. - # These must be converted to strings - set parameterList {} - foreach paramNd $params { - set name [set value {}] - foreach child [dom::node children $paramNd] { - set nameNd [dom::node selectNode $child name] - set name [dom::node stringValue $nameNd] - set valueNd [dom::node selectNode $child value] - set value [dom::node stringValue $valueNd] - } - if {[string compare $name {}]} { - lappend parameterList $name $value - } - } - - if {[catch {eval xslt::cache::transform [list $src $ssheet] $parameterList} rd]} { - return "unable to perform transformation due to \"$rd\"" - } - - return $rd -} - -# xslt::process::checkwffdoc -- -# -# Test a document for well-formedness -# -# Arguments: -# doc DOM token for document to check -# args not needed -# -# Results: -# Returns success message - -proc xslt::process::checkwffdoc {doc args} { - return "of course it's well-formed, it's a DOM tree!" -} - -# xslt::process::dtd-valid -- -# -# Test a document for (DTD) validity -# -# Arguments: -# uri URI for document to check, supports dom: scheme -# args not needed -# -# Results: -# Returns success/failure message - -proc xslt::process::dtd-valid {uri args} { - array set components [uri::split $uri] - - switch -- $components(scheme) { - file { - set ch [open $components(path)] - set xmldata [read $ch] - close $ch - set doc [dom::parse $xmldata -baseuri $uri] - set cleanup [list dom::destroy $doc] - } - dom { - set doc $components(dom) - set cleanup {} - } - default { - # TODO: support http: scheme - return -code error "unable to resolve entity $uri" - } - } - - if {[catch {dom::validate $doc} msg]} { - set result $msg - } else { - set result {document is valid} - } - - eval $cleanup - - return $result -} - -# xslt::process::fop -- -# -# Format an XSL FO document using FOP -# -# Arguments: -# fo Location of FO document -# pdf Location for PDF document -# params Parameters (nodelist) -# args not needed -# -# Results: -# Returns success message - -proc xslt::process::fop {fo pdf params args} { - return "format fo $fo to produce $pdf" -} - -# xslt::process::log -- -# -# Emit a log message. The application is expected to override this. -# -# Arguments: -# msg Log message -# args not needed -# -# Results: -# None - -proc xslt::process::log {msg args} { - Stderr Log:\ $msg - return {} -} - - |