]> matita.cs.unibo.it Git - helm.git/blob - helm/uwobo/uwobo_common.ml
tex notation for compatibility with texTermEditor
[helm.git] / helm / uwobo / uwobo_common.ml
1 (*
2  * Copyright (C) 2003:
3  *    Stefano Zacchiroli <zack@cs.unibo.it>
4  *    for the HELM Team http://helm.cs.unibo.it/
5  *
6  *  This file is part of HELM, an Hypertextual, Electronic
7  *  Library of Mathematics, developed at the Computer Science
8  *  Department, University of Bologna, Italy.
9  *
10  *  HELM is free software; you can redistribute it and/or
11  *  modify it under the terms of the GNU General Public License
12  *  as published by the Free Software Foundation; either version 2
13  *  of the License, or (at your option) any later version.
14  *
15  *  HELM is distributed in the hope that it will be useful,
16  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
17  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18  *  GNU General Public License for more details.
19  *
20  *  You should have received a copy of the GNU General Public License
21  *  along with HELM; if not, write to the Free Software
22  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
23  *  MA  02111-1307, USA.
24  *
25  *  For details, see the HELM World-Wide-Web page,
26  *  http://helm.cs.unibo.it/
27  *)
28
29 open Printf ;;
30
31 exception Uwobo_failure of string ;;
32
33 let uwobo_namespace = "http://helm.cs.unibo.it/uwobo" ;;
34 let xsl_namespace = "http://helm.cs.unibo.it/uwobo" ;;
35
36 let supported_properties = [
37   "cdata-section-elements";
38   "doctype-public";
39   "doctype-system";
40   "encoding";
41   "indent";
42   "media-type";
43   "method";
44   "omit-xml-declaration";
45   "standalone";
46   "version"
47 ]
48
49 let is_supported_property name = List.mem name supported_properties
50
51 let version = "0.2.1" ;;
52
53 let usage_string =
54   sprintf
55 "
56 <html>
57   <head>
58     <title>UWOBO's help message</title>
59   </head>
60   <body>
61     <h1>UWOBO (version: %s)</h1>
62     <h2>Information</h2>
63     Version: %s
64     <h2>Usage</h2>
65     <p>
66     Usage: <kbd>http://hostname:uwoboport/</kbd><em>command</em>
67     </p>
68     <p>
69     Available commands:
70     </p>
71     <p>
72       <b><kbd>help</kbd></b><br />
73       display this help message
74     </p>
75     <p>
76       <b><kbd>newsession?port=p</kbd></b><br />
77       starts a new daemon on a given port <em>p</em>
78     </p>
79     <p>
80       <b><kbd>kill</kbd></b><br />
81       kills the daemon. The log file is mantained.
82     </p>
83     <p>
84       <b><kbd>add?bind=key,uri[&bind=key,uri[&...]]</kbd></b><br />
85       load a new stylesheet, specified by <em>uri</em>, and bind it to key
86           <em>key</em>
87     </p>
88     <p>
89       <b><kbd>remove?keys=[key1,key2,...]</kbd></b><br />
90       unload stylesheets specified by <em>key1, key2, ...</em> or all
91           stylesheets if no key was given
92     </p>
93     <p>
94       <b><kbd>reload?keys=[key1,key2,...]</kbd></b><br />
95       reload stylesheets specified by <em>key1, key2, ...</em> or all
96           stylesheets if no key was given
97     </p>
98     <p>
99       <b><kbd>list</kbd></b><br />
100       return a list of loaded stylesheets
101     </p>
102     <p>
103       <b><kbd>apply?xmluri=uri&keys=key1,key2,...[&errormode={ignore|comment|embed}][&debugmode={ignore|comment|embed}][&param.name=value[&param.name=value[&...]]][&param.key.name=value[&param.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]</kbd></b><br />
104       apply a chain of stylesheets, specified by <em>key1, key2, ...</em>, to an
105       input document, specified by <em>uri</em>.<br />
106       Error and debugging modes could be ste to three different values.
107       <em>ignore</em> means that LibXSLT messages are ignored; <em>comment</em>
108       meanst that LibXSLT messages are embedded in the result document inside an
109       XML like comment; <em>embed</em> means that LibXSLT messages are embedded
110       at the beginning of the result document (as childs of the root node) in
111       XML elements in the UWOBO namespace<br />
112       Additional parameters can be set for each stylesheet application: global
113       parameters (i.e. parameters passed to all stylesheets) are set using
114       <em>param.name=value</em> syntax, per stylesheet parameters are set using
115       <em>param.key.name=value</em> where <em>key</em> is the key of a loaded
116       stylesheet.<br />
117       Properties of the final chain output can be set too: valueless properties
118       can be set using <em>prop.name</em> syntax, others can be set using
119       <em>prop.name=value</em> syntax.<br />
120       Current supported properties are: %s.
121     </p>
122   </body>
123 </html>
124 "
125   version version
126   (String.concat ", " supported_properties) (* supported properties *)
127 ;;
128
129 let pp_error =
130   sprintf
131     "<html><body><span style=\"color:red\">Error: %s</span>%s</body></html>"
132 ;;
133 let return_error msg ?(body = "") outchan =
134   Http_daemon.respond ~body:(pp_error msg body) outchan;;
135 let bad_request body outchan =
136   Http_daemon.respond_error ~code:400 ~body outchan
137 ;;
138
139   (** {2 LibXSLT logging} *)
140
141 type xslt_msg =
142   | LibXsltErrorMsg of string
143   | LibXsltDebugMsg of string
144 ;;
145
146 let string_of_xslt_msg = function
147   | LibXsltErrorMsg msg -> "LibXSLT ERROR: " ^ msg
148   | LibXsltDebugMsg msg -> "LibXSLT DEBUG: " ^ msg
149 ;;
150
151 type xslt_msg_mode =
152   | LibXsltMsgIgnore
153   | LibXsltMsgComment
154   | LibXsltMsgEmbed
155 ;;
156
157 class libXsltLogger =
158   let is_libxslt_error = function LibXsltErrorMsg _ -> true | _ -> false in
159   let is_libxslt_debug = function LibXsltDebugMsg _ -> true | _ -> false in
160   let flatten_libxslt_msg = function
161     | LibXsltErrorMsg msg -> msg
162     | LibXsltDebugMsg msg -> msg
163   in
164   object (self)
165
166     initializer
167       Gdome_xslt.setErrorCallback
168         (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
169       Gdome_xslt.setDebugCallback
170         (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
171
172     val mutable libXsltMsgs = []  (** libxslt's error and debugging messages *)
173
174       (* libxslt's error and debugging messages handling *)
175
176     method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
177
178     method clearMsgs = libXsltMsgs <- []
179     method clearErrorMsgs =
180       libXsltMsgs <- List.filter is_libxslt_debug libXsltMsgs
181     method clearDebugMsgs =
182       libXsltMsgs <- List.filter is_libxslt_error libXsltMsgs
183
184     method msgs = libXsltMsgs
185     method errorMsgs =
186       List.map flatten_libxslt_msg (List.filter is_libxslt_error libXsltMsgs)
187     method debugMsgs =
188       List.map flatten_libxslt_msg (List.filter is_libxslt_debug libXsltMsgs)
189
190   end
191 ;;
192