Updated 2011-06-07 01:50:27 by RLE

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 <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} {
             # 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 <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

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. :-)