(* * Copyright (C) 2003: * Stefano Zacchiroli * for the HELM Team http://helm.cs.unibo.it/ * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * * HELM is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * HELM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with HELM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, * http://helm.cs.unibo.it/ *) open Printf ;; exception Uwobo_failure of string ;; let uwobo_namespace = "http://helm.cs.unibo.it/uwobo" ;; let xsl_namespace = "http://helm.cs.unibo.it/uwobo" ;; let supported_properties = [ "cdata-section-elements"; "doctype-public"; "doctype-system"; "encoding"; "indent"; "media-type"; "method"; "omit-xml-declaration"; "standalone"; "version" ] let is_supported_property name = List.mem name supported_properties let version = "0.2.1" ;; let usage_string = sprintf " UWOBO's help message

UWOBO (version: %s)

Information

Version: %s

Usage

Usage: http://hostname:uwoboport/command

Available commands:

help
display this help message

newsession?port=p
starts a new daemon on a given port p

kill
kills the daemon. The log file is mantained.

add?bind=key,uri[&bind=key,uri[&...]]
load a new stylesheet, specified by uri, and bind it to key key

remove?keys=[key1,key2,...]
unload stylesheets specified by key1, key2, ... or all stylesheets if no key was given

reload?keys=[key1,key2,...]
reload stylesheets specified by key1, key2, ... or all stylesheets if no key was given

list
return a list of loaded stylesheets

apply?xmluri=uri&keys=key1,key2,...[&errormode={ignore|comment|embed}][&debugmode={ignore|comment|embed}][¶m.name=value[¶m.name=value[&...]]][¶m.key.name=value[¶m.key.name=value[&...]]][&prop.name[=value][&prop.name[=value][&...]]]
apply a chain of stylesheets, specified by key1, key2, ..., to an input document, specified by uri.
Error and debugging modes could be ste to three different values. ignore means that LibXSLT messages are ignored; comment meanst that LibXSLT messages are embedded in the result document inside an XML like comment; embed means that LibXSLT messages are embedded at the beginning of the result document (as childs of the root node) in XML elements in the UWOBO namespace
Additional parameters can be set for each stylesheet application: global parameters (i.e. parameters passed to all stylesheets) are set using param.name=value syntax, per stylesheet parameters are set using param.key.name=value where key is the key of a loaded stylesheet.
Properties of the final chain output can be set too: valueless properties can be set using prop.name syntax, others can be set using prop.name=value syntax.
Current supported properties are: %s.

" version version (String.concat ", " supported_properties) (* supported properties *) ;; let pp_error = sprintf "Error: %s%s" ;; let return_error msg ?(body = "") outchan = Http_daemon.respond ~body:(pp_error msg body) outchan;; let bad_request body outchan = Http_daemon.respond_error ~code:400 ~body outchan ;; (** {2 LibXSLT logging} *) type xslt_msg = | LibXsltErrorMsg of string | LibXsltDebugMsg of string ;; let string_of_xslt_msg = function | LibXsltErrorMsg msg -> "LibXSLT ERROR: " ^ msg | LibXsltDebugMsg msg -> "LibXSLT DEBUG: " ^ msg ;; type xslt_msg_mode = | LibXsltMsgIgnore | LibXsltMsgComment | LibXsltMsgEmbed ;; class libXsltLogger = let is_libxslt_error = function LibXsltErrorMsg _ -> true | _ -> false in let is_libxslt_debug = function LibXsltDebugMsg _ -> true | _ -> false in let flatten_libxslt_msg = function | LibXsltErrorMsg msg -> msg | LibXsltDebugMsg msg -> msg in object (self) initializer Gdome_xslt.setErrorCallback (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg))); Gdome_xslt.setDebugCallback (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg))) val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *) (* libxslt's error and debugging messages handling *) method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs method clearMsgs = libXsltMsgs <- [] method clearErrorMsgs = libXsltMsgs <- List.filter is_libxslt_debug libXsltMsgs method clearDebugMsgs = libXsltMsgs <- List.filter is_libxslt_error libXsltMsgs method msgs = libXsltMsgs method errorMsgs = List.map flatten_libxslt_msg (List.filter is_libxslt_error libXsltMsgs) method debugMsgs = List.map flatten_libxslt_msg (List.filter is_libxslt_debug libXsltMsgs) end ;;