if 0 { schlenk I have made up this small toy for a collegue who needed to use Saxon 7.x for some transformations and he was bored at using the cmdline. So i did this one and added basic support for tDOM and TclXSLT also.
As Rolf Ade pointed out, there are some issues with this code, that need an overhaul, especially the guess_encoding does not work es expected (it's actually totally broken like it is).
}
#!/bin/sh
#
# \
exec tclkit $0 "$(1+$@)"
package require starkit
::starkit::startup
lappend auto_path [file join $:.starkit::topdir lib]
package require Tcl 8.4
package require Tk 8.4
#################################################################################
#
# XSLT Toy
#
# (c) 2003 Michael Schlenker <schlenk at physnet.uni-oldenburg.de>
#
# Use under BSD License
#
# A little multi XSLT processor demo in Tcl/Tk
#
# This script is a simple demonstration how to use the following XSLT Processors
# from Tcl/Tk to transform XML files via XSLT.
#
# It is written for use with tclkit or ActiveStates distro.
# You have to set your auto_path before sourcing it, so
# it can find tDOM or TclXSLT packages.
#
# The following processors can be used:
# InstantSaxon 6.5.2 (Windows only) (http://saxon.sourceforge.net/)
# Saxon 7.x (with java available) (http://saxon.sourceforge.net/)
# tDOM (http://www.tdom.org)
# TclXSLT (http://tclxml.sourceforge.net/tclxslt.html)
#
#################################################################################
############################################################
#
# Copy the saxon7.jar out of the starkit if it is included
# (not included here, get it from above link,
# it is searched in the dir the starkit is in.)
#
############################################################
proc copySaxon2Disk {} {
if {[auto_execok java] ne ""} {
if {![file exists [file join $::starkit::topdir .. saxon7.jar]]} {
catch {file copy [file join $::starkit::topdir saxon7.jar] [file join $::starkit::topdir .. saxon7.jar]}
}
}
}
############################################################
#
# Find XSLT processors we can get
#
############################################################
proc discoverProcessors {} {
global processors
set saxon [auto_execok saxon]
if {$saxon eq ""} {
set processors(saxon) 0
} else {
set processors(saxon) 1
}
set java [auto_execok java]
set processors(saxon7) 0
if {$java ne ""} {
if {[file exist [file join $::starkit::topdir .. saxon7.jar]]} {
set processors(saxon7) 1
}
}
if {[catch {package require tdom} msg]} {
set processors(tdom) 0
} else {
set processors(tdom) 1
}
if {[catch {package require xslt} msg]} {
set processors(libxslt) 0
} else {
set processors(libxslt) 1
}
}
####################################################################
#
# Start the actual processors
#
####################################################################
proc startXSLT {} {
if {$::inputfiles eq ""} {
tk_messageBox -type ok -icon error -message "No Input files"
return
}
# basically the next test is there because i was lazy, saxon has a command line option
# to use the stylesheet information from the xml document
#
if {$::usePI && ($::processor ne "saxon") && ($::processor ne "saxon7") } {
tk_messageBox -type ok -icon error -message "Embedded stylesheets are not supported for $::processor in this version."
return
}
if {!$::usePI && ($::stylesheet eq "")} {
tk_messageBox -type ok -icon error -message "No Stylesheet given"
return
}
foreach file $::inputfiles {
if {![file readable $file]} {
tk_messageBox -type ok -icon error -message "\"$file\" does not exist or unreadable."
return
}
}
if {!$::usePI && ![file readable $::stylesheet]} {
tk_messageBox -type ok -icon error -message "Stylsheet \"$:.stylesheet\" does not exist or is unreadable."
return
}
# Now simply call the selected processor
${::processor}XSLT $::inputfiles $::namechange $::stylesheet
}
proc saxonXSLT {files transform stylesheet} {
foreach file $files {
set outfile [slashify [file nativename [transformFilename $file $transform]]]
set file [slashify [file nativename $file]]
if {$::usePI} {
if {[catch {exec [auto_execok saxon] -a -w1 -o $outfile $file} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile
log $msg $tag
} else {
if {[catch {exec [auto_execok saxon] -w1 -o $outfile $file $::stylesheet} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile [file nativename $::stylesheet]
log $msg $tag
}
}
}
proc saxon7XSLT {files transform stylesheet} {
set saxonjar [slashify [file nativename [file join $::starkit::topdir .. saxon7.jar]]]
foreach file $files {
set outfile [slashify [file nativename [file normalize [transformFilename $file $transform]]]]
set file [slashify [file nativename $file]]
if {$::usePI} {
if {[catch {exec [auto_execok java] -jar $saxonjar -a -w1 -o $outfile $file} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile
log $msg $tag
} else {
if {[catch {exec [auto_execok java] -jar $saxonjar -w1 -o $outfile $file $::stylesheet} msg]} {
set tag error
} else {
set tag std
}
set file [deslashify $file]
set outfile [deslashify $outfile]
logProgress $file $outfile [file nativename $::stylesheet]
log $msg $tag
}
}
}
proc tdomXSLT {files transform stylesheet} {
if {!$::usePI} {
#precompile stylesheet
set fid [open $::stylesheet]
set xml_head [gets $fid]
# find encoding of the xml document
set encoding [guess_encoding $xml_head]
if {[catch {fconfigure $fid -encoding [string tolower $encoding]} msg]} {
log "Could not determine encoding of xml document!\n$msg" error
close $fid
continue
}
seek $fid 0
set style [read $fid]
close $fid
if {[catch {dom parse $style ssheet} style_doc]} {
log "Error loading stylesheet \"$::stylesheet\":\n"
log $style_doc error
return
}
}
foreach file $files {
set outfile [transformFilename $file $transform]
set fid [open $file]
set xml_head [gets $fid]
logProgress $file $outfile [file nativename $::stylesheet]
set encoding [guess_encoding $xml_head]
if {[catch {fconfigure $fid -encoding [string tolower $encoding]} msg]} {
log "Could not determine encoding of xml document!\n$msg" error
close $fid
continue
}
seek $fid 0
set xml_doc [read $fid]
close $fid
if {[catch {dom parse $xml_doc doc} xml_parsed]} {
log "\n$xml_parsed" error
continue
}
if {!$::usePI} {
if {[catch {$xml_parsed xslt $ssheet xslt_doc} result]} {
log "\n$result" error
}
}
set xml_doc [$result asXML]
set fid [open $outfile w+]
fconfigure $fid -encoding [string tolower $encoding]
puts $fid $xml_doc
close $fid
$xml_parsed delete
$result delete
}
}
proc libxsltXSLT {files transform stylesheet} {
if {!$::usePI} {
#precompile stylesheet
set fid [open $::stylesheet]
set style [read $fid]
close $fid
if {[catch {::dom::libxml2::parse $style} style_doc]} {
log "Error loading stylesheet: \"$::stylesheet\":\n"
log $style_doc error
return
}
if {[catch {::xslt::compile $style_doc} ssheet]} {
log "Error loading stylesheet \"$::stylesheet\":\n"
log $ssheet error
return
}
::dom::libxml2::destroy $style_doc
}
foreach file $files {
set outfile [transformFilename $file $transform]
set fid [open $file]
set xml_head [gets $fid]
logProgress $file $outfile [file nativename $::stylesheet]
set encoding [guess_encoding $xml_head]
if {[catch {fconfigure $fid -encoding [string tolower $encoding]} msg]} {
log "Could not determine encoding of xml document!\n$msg" error
close $fid
continue
}
seek $fid 0
set xml_doc [read $fid]
close $fid
set xml_parsed [::dom::libxml2::parse $xml_doc]
if {!$::usePI} {
set result [$ssheet transform $xml_parsed]
::dom::libxml2::destroy $xml_parsed
}
set xml_doc [::dom::libxml2::serialize $result]
::dom::libxml2::destroy $result
set fid [open $outfile w+]
fconfigure $fid -encoding [string tolower $encoding]
puts $fid $xml_doc
close $fid
}
}
#############################################################################
#
# Helper procs
#
#############################################################################
# the filename is transformed for the output
proc transformFilename {file transform} {
return "[file rootname $file].${transform}"
}
# helpers for exec to double backslashes
proc slashify {filename} {
string map {\\ \\\\} $filename
}
proc deslashify {filename} {
string map {\\\\ \\} $filename
}
# a simple regexp to get xml version from the first line of a file, probably suboptimal
proc guessEncoding {xml_head} {
regexp -inline {<\?xml\s+version=\"[^\"]+"\s+(?:(?:encoding=\")([^\"]+)(?:\"))?.*\?>} $xml_head
}
# logging support
proc log {msg {tag std}} {
global logwidget
$logwidget insert end $msg $tag
}
proc logProgress {input output {stylesheet "PI in Inputfile"}} {
log "-----------------------------------------------\n"
log "Eingabedatei:\t$inputn"
log "Ausgabedatei:\t$output\n"
log "Stylesheet :\t$stylesheet\n"
log "-----------------------------------------------\n"
}
proc get_inputfiles {} {
set files [tk_getOpenFile -title "Select XML files for conversion" -multiple 1\
-defaultextension .xml -filetypes {{{XML File} {.xml .XML}} {{All Files} *}}]
set ::inputfiles [list]
foreach file $files {
lappend ::inputfiles [file nativename $file]
}
}
proc get_stylesheet {} {
set files [tk_getOpenFile -title "Select XSL(T) Stylesheet" \
-defaultextension .xsl -filetypes {{{XSL Stylesheet} {.xsl .XSL .xslt .XSLT}} {{All Files} *}}]
set ::stylesheet $files
}
proc showWindow {} {
global processors
set ::processor "None selected"
set ::usePI 1
set ::namechange html
toplevel .gui
wm title .gui "XSLT Transformer"
label .gui.inputlabel -text "XML Input files"
entry .gui.input -width 50 -background white -textvariable ::inputfiles
button .gui.inputsearch -text "Browse" -command get_inputfiles
label .gui.styllabel -text "XSL(T) Stylesheet"
checkbutton .gui.stylcheck -text "Use embedded PI" -variable ::usePI -offvalue 0 -onvalue 1
entry .gui.stylesheet -background white -textvariable ::stylesheet
button .gui.stylesearch -text "Browse" -command get_stylesheet
label .gui.ext -text "NameChange"
frame .gui.exts
radiobutton .gui.exts.ext1 -text ".xml > .html" -variable ::namechange -value html
radiobutton .gui.exts.ext2 -text ".xml > .xhtml" -variable ::namechange -value xhtml
radiobutton .gui.exts.ext3 -text ".xml > .txt" -variable ::namechange -value txt
label .gui.proclabel -text "XSL(T) Processor"
menubutton .gui.processor -textvariable ::processor -menu .gui.processor.menu -relief raised -width 30
menu .gui.processor.menu
if {$processors(saxon)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Michael Kay's InstantSAXON 6.5.2" -value saxon -state $state
if {$processors(saxon7)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Michael Kay's SAXON 7.x" -value saxon7 -state $state
if {$processors(tdom)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Jochen Loewers tDOM" -value tdom -state $state
if {$processors(libxslt)} { set state normal
} else { set state disabled
}
.gui.processor.menu add radiobutton -variable ::processor -label "Gnome libxslt" -value libxslt -state $state
button .gui.process -text "Start" -command startXSLT
button .gui.log -text "Protocol" -command showLog
button .gui.end -text "Exit" -command exit
grid .gui.inputlabel -sticky w -padx 5 -pady 5
grid .gui.input -row 0 -columnspan 2 -column 1 -padx 5 -pady 5
grid .gui.inputsearch -row 0 -column 3 -padx 5 -pady 5
grid .gui.styllabel .gui.stylcheck .gui.stylesheet .gui.stylesearch -padx 5 -pady 5
grid configure .gui.styllabel -sticky w
grid configure .gui.stylcheck -sticky w
grid configure .gui.stylesheet -sticky ew
grid .gui.ext .gui.exts -sticky w -padx 5 -pady 5
grid configure .gui.exts -columnspan 3
grid .gui.exts.ext1 .gui.exts.ext2 .gui.exts.ext3 -sticky w
grid .gui.proclabel .gui.processor -sticky w -padx 5 -pady 5
grid configure .gui.processor -columnspan 2
grid .gui.process .gui.log .gui.end -sticky ew -padx 5 -pady 5
bind .gui <Return> startXSLT
wm protocol .gui WM_DELETE_WINDOW exit
}
proc showLog {} {
if {[lsearch [winfo children .] .log] ==-1} {
toplevel .log
} else {
wm deiconify .log
return
}
wm title .log "Protocol"
wm protocol .log WM_DELETE_WINDOW saveProtocol
text .log.text -background white -width 80 -height 40 \
-yscrollcommand ".log.yscroll set" -xscrollcommand ".log.xscroll set"
scrollbar .log.yscroll -command ".log.text yview" -orient vertical
scrollbar .log.xscroll -command ".log.text xview" -orient horizontal
frame .log.cmds
button .log.cmds.save -text "Save Log" -command "saveLog .log.text"
button .log.cmds.clear -text "Delete Log" -command ".log.text delete 1.0 end"
button .log.cmds.close -text "Close Window" -command "wm withdraw .log"
set ::logwidget .log.text
.log.text tag configure error -foreground red
.log.text tag configure std -foreground black
grid .log.text .log.yscroll -sticky news -padx 2 -pady 2
grid .log.xscroll -sticky ew
grid .log.cmds -columnspan 2 -sticky news -pady 10
grid .log.cmds.save .log.cmds.clear .log.cmds.close -sticky ew -padx 10
grid columnconfigure .log 0 -weight 1
grid columnconfigure .log 1 -weight 0
grid rowconfigure .log 0 -weight 1
grid rowconfigure .log 1 -weight 0
grid rowconfigure .log 2 -weight 0
}
proc saveProtocol {} {
wm withdraw .log
}
proc saveLog {w} {
set text [$w dump -text 1.0 end]
set file [tk_getSaveFile -title "Save Logfile as..."]
if {$file ne ""} {
set fid [open $file w+]
puts $fid $text
close $fid
}
}
# main
wm withdraw .
copySaxon2Disk
discoverProcessors
showLog
wm withdraw .log
showWindow