resources.tcl

Go to the documentation of this file.

/*  resources.tcl --*/
/* */
/*  XSLT extension providing access to resources.*/
/* */
/*  Copyright (c) 2005-2008 Explain*/
/*  http://www.explain.com.au/*/
/*  Copyright (c) 2001-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: resources.tcl,v 1.2 2005/11/04 06:41:56 balls Exp $*/

catch {
    package require base64
}

package provide xslt::resources 1.3

namespace xslt::resources {
    namespace export list type exists modified
}

/*  xslt::resources::list --*/
/* */
/*  List the resources available at a given location*/
/* */
/*  Arguments:*/
/*  locn    Resource path to list*/
/*  basedir Base directory*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns list of resources*/

ret  xslt::resources::list (type locnNd , optional baseNd ={) args} {
    # What kind of resource is this?  file, http, ftp, etc?

    if {[llength $args]} {
    return -code error "too many arguments"
    }

     locn =  $locnNd
    /*  The resource may be passed in as a nodeset*/
    catch { locn =  [dom::node stringValue [lindex $locnNd 0]]}
     base =  $baseNd
    catch { base =  [dom::node stringValue [lindex $baseNd 0]]}

    if {[string match /* $base]} {
    regsub {^(/)} $locn {} locn
    }

     result =  {}
    foreach entry [glob -nocomplain [file join $base $locn *]] {
    lappend result [file tail $entry]
    }

    return $result
}

/*  xslt::resources::type --*/
/* */
/*  Gives the type of the resource*/
/* */
/*  Arguments:*/
/*  locn    Resource path to type*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns string describing resource*/

ret  xslt::resources::type (type locnNd , type args) {

    if {[llength $args]} {
    return -code error "too many arguments"
    }

    set locn $locnNd
    catch {set locn [dom::node stringValue [lindex $locnNd 0]]}

    if {[file isdir $locn]} {
    return directory
    } elseif {[file isfile $locn]} {
    return file
    } else {
    return other
    }
}

/*  xslt::resources::exists --*/
/* */
/*  Check whether a resource exists*/
/* */
/*  Arguments:*/
/*  locn    Resource path to type*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns boolean*/

ret  xslt::resources::exists (type locnNd , type args) {

    if {[llength $args]} {
    return -code error "too many arguments"
    }

    set locn $locnNd
    catch {set locn [dom::node stringValue [lindex $locnNd 0]]}

    if {[file exists $locn]} {
    return 1
    } else {
    return 0
    }
}

/*  xslt::resources::modified --*/
/* */
/*  Report last modification time of a resource*/
/* */
/*  Arguments:*/
/*  locn    Resource path*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns ISO standard date-time string*/

ret  xslt::resources::modified (type locnNd , type args) {

    if {[llength $args]} {
    return -code error "too many arguments"
    }

    set locn $locnNd
    catch {set locn [dom::node stringValue [lindex $locnNd 0]]}

    if {[file exists $locn]} {
    return [clock format [file mtime $locn] -format {%Y-%m-%dT%H:%M:%S}]
    } else {
    return {}
    }
}

/*  xslt::resources::mkdir --*/
/* */
/*  Create a directory hierarchy.*/
/* */
/*  Arguments:*/
/*  locn    Resource path for directory*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns directory created or empty string if unsuccessful*/

ret  xslt::resources::mkdir (type locnNd , type args) {

    if {[llength $args]} {
    return {}
    }

    set locn $locnNd
    catch {set locn [dom::node stringValue [lindex $locnNd 0]]}

    set dir [file split $locn]
    set current [lindex $dir 0]
    set remaining [lrange $dir 1 end]
    while {[llength $remaining]} {
    set current [file join $current [lindex $remaining 0]]
    set remaining [lrange $remaining 1 end]
    if {[file exists $current]} {
        if {![file isdir $current]} {
        return {}
        }
    } elseif {[file isdir $current]} {
        continue
    } else {
        if {[catch {file mkdir $current}]} {
        return {}
        }
    }
    }

    return $locn
}

/*  xslt::resources::copy --*/
/* */
/*  Copy a resource.*/
/* */
/*  Arguments:*/
/*  src Resource to copy*/
/*  dest    Destination for resource*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Resource copied*/

ret  xslt::resources::copy (type srcNd , type destNd , type args) {
    set src $srcNd
    catch {set src [dom::node stringValue [lindex $srcNd 0]]}
    set dest $destNd
    catch {set dest [dom::node stringValue [lindex $destNd 0]]}

    if {[catch {file copy -force $src $dest} msg]} {
    catch {
        package require log
        log::log error "copy failed due to \"$msg\""
    }
    return 0
    } else {
    return 1
    }
}

/*  xslt::resources::move --*/
/* */
/*  Move (rename) a resource.*/
/* */
/*  Arguments:*/
/*  src Resource to move*/
/*  dest    Destination for resource*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Resource renamed*/

ret  xslt::resources::move (type srcNd , type destNd , type args) {
    set src $srcNd
    catch {set src [dom::node stringValue [lindex $srcNd 0]]}
    set dest $destNd
    catch {set dest [dom::node stringValue [lindex $destNd 0]]}

    if {[catch {file rename -force $src $dest}]} {
    return 0
    } else {
    return 1
    }
}

/*  xslt::resources::file-attributes --*/
/* */
/*  Change attributes of a resource.*/
/* */
/*  Arguments:*/
/*  src Resource to change*/
/*  what    Attribute to change*/
/*  detail  Attribute value*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Resource attribute changed*/

ret  xslt::resources::file-set-attributes (type srcNd , type whatNd , type detailNd , type args) {
    set src $srcNd
    catch {set src [dom::node stringValue [lindex $srcNd 0]]}
    set what $whatNd
    catch {set what [dom::node stringValue [lindex $whatNd 0]]}
    set detail $detailNd
    catch {set detail [dom::node stringValue [lindex $detailNd 0]]}

    if {[catch {file attributes $src -$what $detail} result]} {
    return {}
    } else {
    return $result
    }
}

/*  xslt::resources::delete --*/
/* */
/*  Delete a resource*/
/* */
/*  Arguments:*/
/*  locn    Resource path to type*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns boolean*/

ret  xslt::resources::delete (type locnNd , type args) {

    if {[llength $args]} {
    return -code error "too many arguments"
    }

    set locn $locnNd
    catch {set locn [dom::node stringValue [lindex $locnNd 0]]}

    if {[catch {file delete -force $locn} msg]} {
    catch {
        package require log
        log::log error "delete failed due to \"$msg\""
    }
    return 0
    } else {
    return 1
    }
}

/*  xslt::resources::link --*/
/* */
/*  Link a resource.*/
/* */
/*  Arguments:*/
/*  from    Link to create*/
/*  to  Target of link*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Symbolic link created*/

ret  xslt::resources::link (type fromNd , type toNd , type args) {
    set from $fromNd
    catch {set from [dom::node stringValue [lindex $fromNd 0]]}
    set to $toNd
    catch {set to [dom::node stringValue [lindex $toNd 0]]}

    if {[catch {file link $from $to}]} {
    return 0
    } else {
    return 1
    }
}

/*  xslt::resources::write-base64 --*/
/* */
/*  Decode base64 encoded data and write the binary data to a file*/
/* */
/*  Arguments:*/
/*  fname   Filename*/
/*  b64 base64 encoded data*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  File opened for writing and binary data written.*/
/*  Returns 1 if file successfully written, 0 otherwise.*/

ret  xslt::resources::write-base64 (type fnameNd , type b64Nd , type args) {
    set fname $fnameNd
    catch {set fname [dom::node stringValue [lindex $fnameNd 0]]}
    set b64 $b64Nd
    catch {set b64 [dom::node stringValue [lindex $b64Nd 0]]}

    if {[catch {package require base64}]} {
    return 0
    }

    if {[catch {open $fname w} ch]} {
    return 0
    } else {
    set binarydata [base64::decode $b64]
    fconfigure $ch -trans binary -encoding binary
    puts -nonewline $ch $binarydata
    close $ch
    return 1
    }
}

/*  xslt::resources::read-base64 --*/
/* */
/*  Read binary data from a file and base64 encode it*/
/* */
/*  Arguments:*/
/*  fname   Filename*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  File opened for readng and contents read.*/
/*  Returns content as base64-encoded data.*/

ret  xslt::resources::read-base64 (type fnameNd , type args) {
    set fname $fnameNd
    catch {set fname [dom::node stringValue [lindex $fnameNd 0]]}

    if {[catch {package require base64}]} {
    return 0
    }

    if {[catch {open $fname} ch]} {
    return 0
    } else {
    fconfigure $ch -trans binary -encoding binary
    set binarydata [read $ch]
    close $ch
    return [base64::encode $binarydata]
    }
}