xsltcache.tcl

Go to the documentation of this file.

/*  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.10 2005/11/04 06:41:56 balls Exp $*/

package require xslt 3.2
package require uri

package provide xslt::cache 3.2

namespace xslt::cache {
    namespace export transform transformdoc flush
    namespace export parse_depend
    namespace export 

    variable sources
    array  sources =  {}
    variable stylesheets
    array  stylesheets =  {}
    variable results
    array  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*/

ret  xslt::cache::transform (type src , type ssheet , type 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.*/

ret  xslt::cache::loadstylesheet (type src , type 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.*/

ret  xslt::cache::ReadXML (type src , type 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*/

ret  xslt::cache::transformdoc (type src , type ssheet , type 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.*/

ret  xslt::cache::parse_depend (type uri , type 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*/

ret  xslt::cache::ParseDepend_Entity (type depVar , type pubId , type 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.*/

ret  xslt::cache::flush (type src , type ssheet , type 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)}
    }
    }
}