diff options
Diffstat (limited to 'tclxml/tclxslt/xsltcache.tcl')
| -rw-r--r-- | tclxml/tclxslt/xsltcache.tcl | 379 |
1 files changed, 0 insertions, 379 deletions
diff --git a/tclxml/tclxslt/xsltcache.tcl b/tclxml/tclxslt/xsltcache.tcl deleted file mode 100644 index 9a3d8f7..0000000 --- a/tclxml/tclxslt/xsltcache.tcl +++ /dev/null @@ -1,379 +0,0 @@ -# xsltcache.tcl -- -# -# Handles performing XSLT transformations, -# caching documents and results. -# -# Copyright (c) 2005-2007 Steve Ball -# http://www.packagedpress.com/staff/Steve.Ball -# Copyright (c) 2002-2003 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: xsltcache.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ - -package require xslt 3.2 -package require uri - -package provide xslt::cache 3.2 - -namespace eval xslt::cache { - namespace export transform transformdoc flush - namespace export parse_depend - namespace export loadstylesheet - - variable sources - array set sources {} - variable stylesheets - array set stylesheets {} - variable results - array set results {} -} - -# xslt::cache::transform -- -# -# Perform an XSLT transformation. -# -# Arguments: -# src Filename of source document -# ssheet Filename of stylesheet document -# args Configuration options, stylesheet parameters -# -# Results: -# Result document token - -proc xslt::cache::transform {src ssheet args} { - variable sources - variable stylesheets - variable results - - # Separate parameters from options - set parameters {} - set options {} - foreach {key value} $args { - switch -glob -- $key { - -* { - lappend options $key $value - } - default { - lappend parameters $key $value - } - } - } - - # Normalize the parameter list - array set paramArray $parameters - set parameters {} - foreach name [lsort [array names paramArray]] { - lappend parameters $name $paramArray($name) - } - - set hash $src.$ssheet.$parameters - - array set opts { - -xmlinclude 1 - } - array set opts $options - - set readSource [ReadXML $src -xmlinclude $opts(-xmlinclude)] - - set readStylesheet 1 - if {[info exists stylesheets($ssheet)]} { - if {[file mtime $ssheet] < $stylesheets($ssheet,time)} { - set readStylesheet 0 - } - } - if {$readStylesheet} { - catch {rename $stylesheets($ssheet) {}} - ReadXML $ssheet -xmlinclude $opts(-xmlinclude) - - set stylesheets($ssheet) [xslt::compile $sources($ssheet)] - set stylesheets($ssheet,time) [clock seconds] - } - - if {$readSource || $readStylesheet || ![info exists results($hash)]} { - - set results($hash) [eval [list $stylesheets($ssheet)] transform [list $sources($src)] $parameters] - set results($hash,time) [clock seconds] - } - - return $results($hash) -} - -# xslt::cache::loadstylesheet -- -# -# Read, parse and compile an XSLT stylesheet. -# -# Arguments: -# src Filename for the stylesheet document -# args options -# -# Results: -# Returns compiled stylesheet token. Adds reference to stylesheet to cache. - -proc xslt::cache::loadstylesheet {src args} { - variable sources - variable stylesheets - - array set options { - -keepsource 0 - -xmlinclude 0 - } - array set options $args - - eval ReadXML [list $src] [array get options -xmlinclude] - - set stylesheets($src) [xslt::compile $sources($src)] - set stylesheets($src,time) [clock seconds] - - if {!$options(-keepsource)} { - flush $src {} - } - - # TODO: set command trace so that if the stylesheet is deleted - # the cache is invalidated - - return $stylesheets($src) -} - -# xslt::cache::ReadXML -- -# -# Internal proc to manage parsing a document. -# Used for both source and stylesheet documents. -# -# Arguments: -# src Filename of source document -# args Configuration options -# -# Results: -# Returns 1 if document was read. Returns 0 if document is cached. - -proc xslt::cache::ReadXML {src args} { - variable sources - array set opts { - -xmlinclude 1 - } - array set opts $args - - set readSource 1 - if {[info exists sources($src)]} { - if {[file mtime $src] < $sources($src,time)} { - set readSource 0 - } - } - if {$readSource} { - catch {dom::destroy $sources($src)} - set ch [open $src] - set sources($src) [dom::parse [read $ch] -baseuri file://$src] - close $ch - if {$opts(-xmlinclude)} { - dom::xinclude $sources($src) - } - set sources($src,time) [clock seconds] - } - - return $readSource -} - -# xslt::cache::transformdoc -- -# -# Perform an XSLT transformation on a DOM document. -# -# Arguments: -# src DOM token of source document -# ssheet Filename of stylesheet document -# args Configuration options, stylesheet parameters -# -# Results: -# Result document token - -proc xslt::cache::transformdoc {src ssheet args} { - variable sources - variable stylesheets - - # Separate parameters from options - set parameters {} - set options {} - foreach {key value} $args { - switch -glob -- $key { - -* { - lappend options $key $value - } - default { - lappend parameters $key $value - } - } - } - - # Normalize the parameter list - array set paramArray $parameters - set parameters {} - foreach name [lsort [array names paramArray]] { - lappend parameters $name $paramArray($name) - } - - array set opts { - -xmlinclude 1 - } - array set opts $options - - set readStylesheet 1 - if {[info exists stylesheets($ssheet)]} { - if {[file mtime $ssheet] < $stylesheets($ssheet,time)} { - set readStylesheet 0 - } - } - if {$readStylesheet} { - catch {rename $stylesheets($ssheet) {}} - ReadXML $ssheet -xmlinclude $opts(-xmlinclude) - - set stylesheets($ssheet) [xslt::compile $sources($ssheet)] - set stylesheets($ssheet,time) [clock seconds] - } - - set result [eval [list $stylesheets($ssheet)] transform [list $src] $parameters] - - return $result -} - -# ::xslt::cache::parse_depend -- -# -# Parse a document while determining its dependencies. -# -# Arguments: -# uri Document's URI -# depVar Global variable name for dependency document -# -# Results: -# Returns parsed document token. -# Document token for dependency document is stored in depVar. - -proc xslt::cache::parse_depend {uri depVar} { - upvar #0 $depVar dep - - set dep [dom::create] - dom::document createElement $dep dependencies - - array set uriParsed [uri::split $uri] - - switch -- $uriParsed(scheme) { - file { - set ch [open $uriParsed(path)] - set doc [dom::parse [read $ch] -baseuri $uri -externalentitycommand [namespace code [list ParseDepend_Entity $depVar]]] - close $ch - - ParseDepend_XInclude $doc $depVar - ParseDepend_XSLT $doc $depVar - } - http { - return -code error "URI scheme \"http\" not yet implemented" - } - dom { - set doc $uriParsed(dom) - - # Can't determine external entities, but can find XInclude - # and XSL stylesheet includes/imports. - ParseDepend_XInclude $uriParsed(dom) $depVar - ParseDepend_XSLT $uriParsed(dom) $depVar - } - default { - return -code error "URI scheme \"$uriParsed(scheme)\" not supported" - } - } - - return $doc -} - -# xslt::cache::ParseDepend_Entity -- -# -# Callback for external entity inclusion. -# -# Arguments: -# depVar Global variable of dependency document -# pubId Public identifier -# sysId System identifier -# -# Results: -# Dependency added to dependency document - -proc xslt::cache::ParseDepend_Entity {depVar pubId sysId} { - upvar #0 $depVar dep - - dom::document createNode $dep /dependencies/external-entities/entity -} - -# ::xslt::cache::flush -- -# -# Flush the cache -# -# Arguments: -# src source document filename -# ssheet stylesheet document filename -# args parameters -# -# Results: -# Returns the empty string. -# If all arguments are given then all entries corresponding -# to that transformation are destroyed. -# If the source and/or stylesheet are given then all -# entries corresponding to those documents are destroyed. - -proc xslt::cache::flush {src ssheet args} { - variable sources - variable stylesheets - variable results - - # Normalize parameter list - array set paramArray $args - set parameters {} - foreach name [lsort [array names paramArray]] { - lappend parameters $name $paramArray($name) - } - - set hash $src.$ssheet.$parameters - - switch -glob [string length $src],[string length $ssheet],[llength $args] { - 0,0,* { - # Special case: flush all - unset sources - array set sources {} - unset stylesheets - array set stylesheets {} - unset results - array set results {} - } - - 0,*,0 { - # Flush all entries for the given stylesheet - catch {rename $stylesheets($ssheet) {}} - catch {unset stylesheets($ssheet)} - catch {unset stylesheets($ssheet,time)} - - foreach entry [array names results *.$ssheet.*] { - catch {dom::destroy $results($entry)} - catch {unset results($entry)} - catch {unset results($entry,time)} - } - } - - *,0,0 { - # Flush all entries for the given source document - catch {dom::destroy $sources($src)} - catch {unset sources($src)} - catch {unset sources($src,time)} - foreach entry [array names results $src.*] { - catch {dom::destroy $results($entry)} - catch {unset results($entry)} - catch {unset results($entry,time)} - } - } - - default { - # Flush specific entry - catch {dom::destroy $results($hash)} - catch {unset results($hash)} - catch {unset results($hash,time)} - } - } -} |