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. Many thanks to Rolf Ade for pointing out some really broken stuff in the original version. } #!/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 # # 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} { # use tDOM's xmlReadFile proc to read the stylesheet in the correct encoding if {[catch {dom parse [::tDOM::xmlReadFile $stylesheet]} ssheet]} { log "Error loading stylesheet \"$::stylesheet\":\n" log $ssheet error return } # try to compile XSLT stylesheet (since tdom 0.7.7) if {[catch {$ssheet toXSLTcmd} compss]} { log "Could not compile XSLT Command, probably old tdom version (< 0.7.7).\n" set compiled 0 } else { set compiled 1 } } foreach file $files { set outfile [transformFilename $file $transform] logProgress $file $outfile [file nativename $::stylesheet] if {[catch {dom parse [::tDOM::xmlReadFile $file]} xml_parsed]} { log "\n$xml_parsed" error continue } if {!$::usePI} { if {$compiled} { # use tDOM's OO style xslt command for compiled stylesheets if {[catch {$compss $xml_parsed} result]} { log "\n$result" error } } else { # use the traditional xslt subcommand of the doc for uncompiled stylesheets if {[catch {$xml_parsed xslt $ssheet} result]} { log "\n$result" error } } } set xml_doc [$result asXML] writeResultFile $outfile $xml_doc $xml_parsed delete $result delete # compiled stylesheets replace their stylesheet document object # so we either destroy the compiled stylesheet object by rename or # we delete the stylesheet document object if {$compiled} { rename $compss "" } else { $ssheet 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] logProgress $file $outfile [file nativename $::stylesheet] set fid [open $file] 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 writeResultFile $outfile $xml_doc } # clean up rename $ssheet {} } ############################################################################# # # 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 } # logging support proc log {msg {tag std}} { global logwidget $logwidget insert end $msg $tag } proc writeResultFile {outfile data} { # probably should inspect the result if an encoding other than utf-8 # is requested, but for now just write the result as utf-8 set fid [open $outfile w+] fconfigure $fid -encoding utf-8 puts $fid $data close $fid } proc logProgress {input output {stylesheet "PI in Inputfile"}} { log "-----------------------------------------------\n" log "Inputfile:\t$input\n" log "Outputfile:\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 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 ----- [LES] on July 23 2004, 358 days after this page's last edit: ''this is a great little app. But it's sad that no one seems to be using it, because there is a tiny silly bug that prevents it from running at all:'' '''Inputfile:\t$inputn''' , ''in line 315, actually should be'' '''Inputfile:\t$input\n'''. [schlenk] your right, fixed it but why didn't you fix the code in place? Its a wiki after all. :-) ----- [Category Example] | [Category XML]