1#!/bin/sh
2# \
3exec tclsh "$0" "$@"
4
5# tclxsltproc --
6#
7#	This script is an enhancement to xsltproc.
8#	With no additions, it performs exactly the
9#	same functions as xsltproc.
10#
11#	However, Tcl-enhanced features may be
12#	specified.  These include the ability to
13#	define extensions as Tcl scripts.
14#
15# Copyright (c) 2002 Zveno Pty Ltd
16# http://www.zveno.com/
17#
18# Zveno Pty Ltd makes this software and associated documentation
19# available free of charge for any purpose.  You may make copies
20# of the software but you must include all of this notice on any copy.
21#
22# Zveno Pty Ltd does not warrant that this software is error free
23# or fit for any purpose.  Zveno Pty Ltd disclaims any liability for
24# all claims, expenses, losses, damages and costs any user may incur
25# as a result of using, copying or modifying the software.
26#
27# $Id: tclxsltproc,v 1.4 2002/12/10 05:28:57 balls Exp $
28
29package require cmdline
30
31# exprEsc --
32#
33#	Escape an XPath expression
34#
35# Arguments:
36#	text	XPath expression
37#
38# Results:
39#	Quoted expression
40
41proc exprEsc text {
42    array set Map { < lt   > gt   & amp   \" quot  ' apos}
43    regsub -all {[\\$]} $text {\\&} text
44    regsub -all {[><&"']} $text {\&$Map(&);} text
45    return \"[subst -nocommands $text]\"
46}
47
48# msg --
49#
50#	Handler for -messagecommand option
51#
52# Arguments:
53#	args	messages
54#
55# Results:
56#	Store message in global variable
57
58proc msg args {
59    global msgs
60    eval append msgs $args
61}
62
63set optList [list \
64	[list config.arg	{}	{Configuration Tcl script}] \
65	[list version		{}	{show the version of libxml and libxslt used}] \
66	[list V			{}	{show the version of libxml and libxslt used}] \
67	[list output.arg	{}	{save to a given file}] \
68	[list o.arg		{}	{save to a given file}] \
69	[list timing		{}	{display the time used}] \
70	[list repeat		20	{run the transformation 20 times}] \
71	[list debug		{}	{dump the tree of the result instead}] \
72	[list novalid		{}	{skip the Dtd loading phase}] \
73	[list noout		{}	{do not dump the result}] \
74	[list maxdepth.arg	{}	{increase the maximum depth}] \
75	[list html		{}	{the input is(are) an HTML file(s)}] \
76	[list docbook		{}	{the input document is SGML docbook}] \
77	[list param.arg		{}	{pass a {parameter,value} pair
78	value is an XPath expression.
79	string values must be quoted like "'string'"
80or	use stringparam to avoid it}] \
81	[list stringparam.arg	{}	{pass a {parameter,string value} pair}] \
82	[list nonet		{}	{refuse to fetch DTDs or entities over network}] \
83	[list catalogs		{}	{use SGML catalogs from $SGML_CATALOG_FILES
84	otherwise XML Catalogs starting from
85	file:///etc/xml/catalog are activated by default}] \
86	[list xinclude		{}	{do XInclude processing on document input}] \
87	]
88
89# Can't use tcllib cmdline package since xsltproc uses non-standard options
90
91set stylesheet {}
92set sourceFiles {}
93array set Config {
94    config {}
95    showversion 0
96    output {}
97    timing 0
98    repeat 0
99    debug 0
100    novalid 0
101    noout 0
102    maxdepth 0
103    html 0
104    docbook 0
105    param {}
106    nonet 0
107    catalogs 0
108    xinclude 0
109}
110for {set idx 0} {$idx < [llength $argv]} {incr idx} {
111    switch -glob -- [lindex $argv $idx] {
112	-config -
113	--config {
114	    set Config(config) [lindex $argv [expr $idx + 1]]
115	    incr idx
116	}
117	--version -
118	-V {
119	    set Config(showversion) 1
120	}
121	--output -
122	-o {
123	    set Config(output) [lindex $argv [expr $idx + 1]]
124	    incr idx
125	}
126	--timing {
127	    set Config(timing) 1
128	}
129	--repeat {
130	    set Config(repeat) 1
131	}
132	--debug {
133	    set Config(debug) 1
134	}
135	--novalid {
136	    set Config(novalid) 1
137	}
138	--noout {
139	    set Config(noout) 1
140	}
141	--maxdepth {
142	    set Config(maxdepth) [lindex $argv [expr $idx + 1]]
143	    incr idx
144	}
145	--html {
146	    set Config(html) 1
147	}
148	--docbook {
149	    set Config(docbook) 1
150	}
151	--param {
152	    lappend Config(param) [lindex $argv [expr $idx + 1]] [lindex $argv [expr $idx + 2]]
153	    incr idx 2
154	}
155	--stringparam {
156	    lappend Config(param) [lindex $argv [expr $idx + 1]] [exprEsc [lindex $argv [expr $idx + 2]]]
157	    incr idx 2
158	}
159	--nonet {
160	    set Config(nonet) 1
161	}
162	--catalogs {
163	    set Config(catalogs) 1
164	}
165	--xinclude {
166	    set Config(xinclude) 0
167	}
168
169	default {
170	    break
171	}
172    }
173}
174set argv [lrange $argv $idx end]
175
176if {[llength $argv] == 0} {
177    puts stderr [cmdline::usage $optList "?options? ssheet file ?files...?\nOptions:"]
178    exit 4
179}
180if {[llength $argv] < 2} {
181    puts stderr [cmdline::usage $optList "?options? ssheet file ?files...?\nOptions:"]
182    exit 5
183}
184
185if {[catch {package require dom 2.5}]} {
186    puts stderr "TclDOM version 2.5 is not installed"
187    exit 2
188}
189if {[catch {package require xslt 2.5}]} {
190    puts stderr "TclXSLT v2.5 is not installed"
191    exit 2
192}
193
194if {[string length $Config(config)]} {
195    if {[catch {source $Config(config)} msg]} {
196	puts stderr "error reading configuration script \"$Config(config)\":"
197	puts stderr $msg
198	exit 3
199    }
200}
201
202if {[catch {open [lindex $argv 0]} ch]} {
203    puts stderr "Unable to read stylesheet due to \"$ch\""
204    exit 6
205}
206set xsl [read $ch]
207close $ch
208if {[catch {dom::libxml2::parse $xsl -baseuri file://[file join [pwd] [lindex $argv 0]]} xsldoc]} {
209    puts stderr "failed to read stylesheet document \"[lindex $argv 0]\" as XML"
210    exit 9
211}
212if {[catch {xslt::compile $xsldoc} ssheet]} {
213    puts stderr "failed to compile stylesheet \"[lindex $argv 0]\" due to \"$ssheet\""
214    exit 10
215}
216unset xsl
217
218$ssheet configure -messagecommand msg
219
220foreach sourcefile [lrange $argv 1 end] {
221    if {[catch {open $sourcefile} ch]} {
222	puts stderr "Unable to read source document \"sourcefile\" due to \"$ch\""
223	exit 7
224    }
225    set xml [read $ch]
226    close $ch
227    if {[catch {dom::libxml2::parse $xml -baseuri file://[file join [pwd] $sourcefile]} sourcedoc]} {
228	puts stderr "failed to read source XML document \"$sourcefile\""
229	exit 9
230    }
231    if {$Config(xinclude)} {
232	dom::libxml2::xinclude $sourcedoc
233    }
234    catch {unset msgs}
235    set msgs {}
236    if {[catch {eval [list $ssheet] transform [list $sourcedoc] $Config(param)} resultdoc]} {
237	puts stderr "failed to transform document \"$sourcefile\" due to \"$resultdoc\""
238	exit 11
239    }
240    puts stderr $msgs
241    if {[string length $Config(output)]} {
242	if {[catch {open $Config(output) w} ch]} {
243	    puts stderr "Unable to write result to \"$Config(output)\" due to \"$ch\""
244	    exit 8
245	}
246	puts $ch [dom::libxml2::serialize $resultdoc -method [$ssheet cget -method]]
247	close $ch
248    } else {
249	puts [dom::libxml2::serialize $resultdoc -method [$ssheet cget -method]]
250    }
251
252    dom::destroy $sourcedoc
253    dom::destroy $resultdoc
254}
255
256exit 0
257