utilities.tcl

Go to the documentation of this file.

/*  utilities.tcl --*/
/* */
/*  Miscellaneous extension functions for XSLT.*/
/* */
/*  Copyright (c) 2007 Explain*/
/*  http://www.explain.com.au/*/
/*  Copyright (c) 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: utilities.tcl,v 1.1 2004/09/29 23:51:57 balls Exp $*/

package provide xslt::utilities 1.2

namespace xslt::utilities {
    namespace export character-first decode-base64
}

/*  xslt::utilities::character-first --*/
/* */
/*  Returns the character that occurs first from a string*/
/*  of possible characters.*/
/* */
/*  Arguments:*/
/*  src source string*/
/*  chars   characters to find*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns a character or empty string.*/

ret  xslt::utilities::character-first (type srcNd , type charsNd , type args) {
    if {[llength $args]} {
    return -code error "too many arguments"
    }

    set src $srcNd
    catch {set src [dom::node stringValue [lindex $srcNd 0]]}
    set chars $charsNd
    catch {set chars [dom::node stringValue [lindex $charsNd 0]]}

    regsub -all {([\\\[\]^$-])} $chars {\\\1} chars
    if {[regexp [format {([%s])} $chars] $src dummy theChar]} {
    return $theChar
    }

    return {}
}

/*  xslt::utilities::decode-base64 --*/
/* */
/*  Returns decoded (binary) base64-encoded data.*/
/* */
/*  Arguments:*/
/*  src source string*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns binary data.*/

ret  xslt::utilities::decode-base64 (type srcNd , type args) {
    if {[llength $args]} {
    return -code error "too many arguments"
    }

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

    set src $srcNd
    catch {set src [dom::node stringValue [lindex $srcNd 0]]}

    return [base64::decode $src]
}

/*  xslt::utilities::binary-document --*/
/* */
/*  Writes binary data into a document*/
/*  (this should be an extension element)*/
/* */
/*  Arguments:*/
/*  fname   filename*/
/*  data    binary data*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  File opened for writing and data written.*/
/*  Returns 1 on success, 0 otherwise*/

ret  xslt::utilities::binary-document (type fnameNd , type srcNd , type args) {
    if {[llength $args]} {
    return -code error "too many arguments"
    }

    set fname $fnameNd
    catch {set fname [dom::node stringValue [lindex $fnameNd 0]]}
    set data $dataNd
    catch {set data [dom::node stringValue [lindex $dataNd 0]]}

    if {[catch {open $fname w} ch]} {
    return 0
    }
    fconfigure $ch -trans binary -encoding binary
    puts -nonewline $ch $data
    close $ch

    return 1
}

/*  xslt::utilities::base64-binary-document --*/
/* */
/*  Returns base64-encoded data from a file.*/
/* */
/*  Arguments:*/
/*  fname   filename*/
/*  args    not needed*/
/* */
/*  Results:*/
/*  Returns text.  Returns empty string on error.*/

ret  xslt::utilities::base64-binary-document (type fnameNd , type args) {
    if {[llength $args]} {
    return -code error "too many arguments"
    }

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

    set fname $fnameNd
    catch {set fname [dom::node stringValue [lindex $fnameNd 0]]}

    if {[catch {open $fname} ch]} {
    return {}
    }
    fconfigure $ch -trans binary -encoding binary
    set data [read $ch]
    close $ch

    return [base64::encode $data]
}