From 952ad2bf8ea4bea5999570f0f592f84bf30acd3f Mon Sep 17 00:00:00 2001 From: Luca Padovani Date: Thu, 8 Feb 2001 11:06:19 +0000 Subject: [PATCH] A lot of changes to support the new UWOBO stylesheet processor: Modified Files: Makefile.in : of course, some new source files configuration.ml.in : better support for configuration variables and overriding getter.ml : now it is just a wrapper for clientHTTP, still needs some serious rearrangement getter.mli : the interface changed a little bit mmlinterface.ml : call for the initialization of the processor pxpUriResolver.ml : the resolver is now more reliable styleConfiguration.ml : retrieve and parse stylesheet configuration xsltProcessor.ml : it is now a simple wrapper for xsltProcessorHTTP Added Files: clientHTTP.ml : a simple client HTTP (a minimal wrapper for netclient) xsltProcessorHTTP.ml : send HTTP requests to the processor xsltProcessorUDP.ml : just in case we want to implement both methods for invoking the processor --- helm/interface/Makefile.in | 69 ++++++++++++--------- helm/interface/clientHTTP.ml | 49 +++++++++++++++ helm/interface/configuration.ml.in | 48 +++++++++----- helm/interface/getter.ml | 8 +-- helm/interface/getter.mli | 3 + helm/interface/mmlinterface.ml | 2 + helm/interface/pxpUriResolver.ml | 20 +++--- helm/interface/styleConfiguration.ml | 42 ++++++++----- helm/interface/xsltProcessor.ml | 64 +------------------ helm/interface/xsltProcessorHTTP.ml | 52 ++++++++++++++++ helm/interface/xsltProcessorUDP.ml | 93 ++++++++++++++++++++++++++++ 11 files changed, 314 insertions(+), 136 deletions(-) create mode 100644 helm/interface/clientHTTP.ml create mode 100644 helm/interface/xsltProcessorHTTP.ml create mode 100644 helm/interface/xsltProcessorUDP.ml diff --git a/helm/interface/Makefile.in b/helm/interface/Makefile.in index a6e9eae90..1fe157016 100644 --- a/helm/interface/Makefile.in +++ b/helm/interface/Makefile.in @@ -6,11 +6,13 @@ MINIDOM_DIR = @MLMINIDOM_LIB_DIR@ PXP_DIR = $(OCAML_ROOT)/site-lib/pxp NETSTRING_DIR = $(OCAML_ROOT)/site-lib/netstring +XSTR_DIR = $(OCAML_ROOT)/site-lib/xstr +NETCLIENT_DIR = $(OCAML_ROOT)/site-lib/netclient #OCAMLC = ocamlc -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I mlmathview #OCAMLOPT = ocamlopt -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I mlgtk_devel -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I mlmathview -OCAMLC = ocamlc -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -OCAMLOPT = ocamlopt -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) +OCAMLC = ocamlc -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I $(XSTR_DIR) -I $(NETCLIENT_DIR) +OCAMLOPT = ocamlopt -I $(LABLGTK_DIR) -I $(LABLGTKMATHVIEW_DIR) -I $(PXP_DIR) -I $(NETSTRING_DIR) -I $(MINIDOM_DIR) -I $(XSTR_DIR) -I $(NETCLIENT_DIR) OCAMLDEP = ocamldep all: experiment reduction fix_params mmlinterface @@ -26,10 +28,17 @@ PXPLIBSOPT = netstring.cmxa netmappings_iso.cmx netmappings_other.cmx \ pxp_lex_iso88591.cmxa pxp_lex_utf8.cmxa pxp_engine.cmxa \ pxp_utf8.cmx +XSTRLIBS = xstr.cma + +XSTRLIBSOPT = xstr.cmxa + +NETCLIENTLIBS = netclient.cma + +NETCLIENTLIBSOPT = netclient.cmxa DEPOBJS = experiment.ml cicCache.ml cicCache.mli cicPp.ml cicPp.mli \ cicParser.ml cicParser.mli cicParser2.ml cicParser2.mli \ - cicParser3.ml cicParser3.mli cic.ml getter.ml getter.mli \ + cicParser3.ml cicParser3.mli cic.ml clientHTTP.ml getter.ml getter.mli \ gtkInterface.ml cicReduction.ml cicReduction.mli cicTypeChecker.ml \ cicTypeChecker.mli reduction.ml tgtkInterface.ml theory.ml \ theoryParser.ml theoryParser2.ml theoryPp.ml theoryTypeChecker.ml \ @@ -37,71 +46,71 @@ DEPOBJS = experiment.ml cicCache.ml cicCache.mli cicPp.ml cicPp.mli \ fix_params.ml cic2Xml.ml xml.ml uriManager.ml uriManager.mli \ cicSubstitution.ml cicSubstitution.mli \ mmlinterface.ml configuration.ml styleConfiguration.ml \ - xsltProcessor.ml deannotate.ml cicXPath.ml pxpUriResolver.ml \ + xsltProcessorHTTP.ml xsltProcessor.ml deannotate.ml cicXPath.ml pxpUriResolver.ml \ annotationParser.ml annotationParser2.ml annotation2Xml.ml \ cicAnnotationHinter.ml -MMLINTERFACEOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \ - pxpUriResolver.cmo \ +MMLINTERFACEOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \ + pxpUriResolver.cmo styleConfiguration.cmo \ cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \ cicSubstitution.cmo annotationParser2.cmo \ annotationParser.cmo cicCache.cmo cicCooking.cmo cicPp.cmo \ cicReduction.cmo cicTypeChecker.cmo \ xml.cmo \ - xsltProcessor.cmo cic2Xml.cmo annotation2Xml.cmo \ + xsltProcessorHTTP.cmo xsltProcessor.cmo cic2Xml.cmo annotation2Xml.cmo \ cicXPath.cmo theory.cmo theoryParser2.cmo theoryParser.cmo \ theoryCache.cmo theoryTypeChecker.cmo \ cicAnnotationHinter.cmo mmlinterface.cmo -MMLINTERFACEOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \ - pxpUriResolver.cmx \ +MMLINTERFACEOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \ + pxpUriResolver.cmx styleConfiguration.cmx \ cicParser3.cmx cicParser2.cmx cicParser.cmx \ deannotate.cmx cicSubstitution.cmx annotationParser2.cmx \ annotationParser.cmx cicCache.cmx \ cicCooking.cmx cicPp.cmx cicReduction.cmx \ cicTypeChecker.cmx \ - xml.cmx xsltProcessor.cmx \ + xml.cmx xsltProcessorHTTP.cmx xsltProcessor.cmx \ cic2Xml.cmx annotation2Xml.cmx cicXPath.cmx \ theory.cmx theoryParser2.cmx theoryParser.cmx \ theoryCache.cmx theoryTypeChecker.cmx \ cicAnnotationHinter.cmx mmlinterface.cmx -FIX_PARAMSOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \ - pxpUriResolver.cmo \ +FIX_PARAMSOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \ + pxpUriResolver.cmo styleConfiguration.cmo \ cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \ cicSubstitution.cmo annotationParser2.cmo \ annotationParser.cmo cicCache.cmo cicPp.cmo xml.cmo \ cic2Xml.cmo cicFindParameters.cmo fix_params.cmo -FIX_PARAMSOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \ - pxpUriResolver.cmx \ +FIX_PARAMSOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \ + pxpUriResolver.cmx styleConfiguration.cmx \ cicParser3.cmx cicParser2.cmx cicParser.cmx deannotate.cmx \ cicSubstitution.cmx annotationParser2.cmx \ annotationParser.cmx cicCache.cmx cicPp.cmx xml.cmx \ cic2Xml.cmx cicFindParameters.cmx fix_params.cmx -REDUCTIONOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \ - pxpUriResolver.cmo \ +REDUCTIONOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \ + pxpUriResolver.cmo styleConfiguration.cmo \ cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \ cicSubstitution.cmo annotationParser2.cmo annotationParser.cmo \ cicCache.cmo cicPp.cmo cicCooking.cmo \ cicReduction.cmo cicTypeChecker.cmo reduction.cmo -REDUCTIONOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \ - pxpUriResolver.cmx \ +REDUCTIONOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \ + pxpUriResolver.cmx styleConfiguration.cmx \ cicParser3.cmx cicParser2.cmx cicParser.cmx deannotate.cmx \ cicSubstitution.cmx annotationParser2.cmx \ annotationParser.cmx cicCache.cmx cicPp.cmx cicCooking.cmx \ cicReduction.cmx cicTypeChecker.cmx reduction.cmx -EXPERIMENTOBJS = configuration.cmo uriManager.cmo getter.cmo cic.cmo \ - pxpUriResolver.cmo \ +EXPERIMENTOBJS = configuration.cmo uriManager.cmo clientHTTP.cmo getter.cmo cic.cmo \ + pxpUriResolver.cmo styleConfiguration.cmo \ cicParser3.cmo cicParser2.cmo cicParser.cmo deannotate.cmo \ cicSubstitution.cmo annotationParser2.cmo \ annotationParser.cmo cicCache.cmo cicPp.cmo experiment.cmo -EXPERIMENTOPTOBJS = configuration.cmx uriManager.cmx getter.cmx cic.cmx \ - pxpUriResolver.cmx \ +EXPERIMENTOPTOBJS = configuration.cmx uriManager.cmx clientHTTP.cmx getter.cmx cic.cmx \ + pxpUriResolver.cmx styleConfiguration.cmx \ cicParser3.cmx cicParser2.cmx cicParser.cmx deannotate.cmx \ cicSubstitution.cmx annotationParser2.cmx \ annotationParser.cmx cicCache.cmx cicPp.cmx experiment.cmx @@ -110,7 +119,7 @@ depend: $(OCAMLDEP) $(DEPOBJS) > .depend mmlinterface: $(MMLINTERFACEOBJS) - $(OCAMLC) -custom -o mmlinterface str.cma unix.cma $(PXPLIBS) dbm.cma \ + $(OCAMLC) -custom -o mmlinterface str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \ lablgtk.cma gtkInit.cmo \ $(MINIDOM_DIR)/minidom.cmo \ $(MINIDOM_DIR)/ominidom.cmo \ @@ -124,7 +133,7 @@ mmlinterface: $(MMLINTERFACEOBJS) -cclib -lmldbm -cclib -lndbm mmlinterface.opt: $(MMLINTERFACEOPTOBJS) - $(OCAMLOPT) -o mmlinterface.opt str.cmxa $(PXPLIBSOPT) unix.cmxa \ + $(OCAMLOPT) -o mmlinterface.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) unix.cmxa \ dbm.cmxa lablgtk.cmxa gtkInit.cmx \ $(MINIDOM_DIR)/minidom.cmx \ $(MINIDOM_DIR)/ominidom.cmx \ @@ -138,29 +147,29 @@ mmlinterface.opt: $(MMLINTERFACEOPTOBJS) -cclib -lmldbm -cclib -lndbm fix_params: $(FIX_PARAMSOBJS) - $(OCAMLC) -custom -o fix_params str.cma $(PXPLIBS) dbm.cma \ + $(OCAMLC) -custom -o fix_params str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \ $(FIX_PARAMSOBJS) -cclib -lstr -cclib -lmldbm -cclib -lndbm fix_params.opt: $(FIX_PARAMSOPTOBJS) - $(OCAMLOPT) -o fix_params.opt str.cmxa $(PXPLIBSOPT) dbm.cmxa \ + $(OCAMLOPT) -o fix_params.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) dbm.cmxa \ $(FIX_PARAMSOPTOBJS) -cclib -lstr -cclib -lmldbm \ -cclib -lndbm reduction: $(REDUCTIONOBJS) - $(OCAMLC) -custom -o reduction str.cma $(PXPLIBS) dbm.cma \ + $(OCAMLC) -custom -o reduction str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \ $(REDUCTIONOBJS) -cclib -lstr -cclib -lmldbm -cclib -lndbm reduction.opt: $(REDUCTIONOPTOBJS) - $(OCAMLOPT) -o reduction.opt str.cmxa $(PXPLIBSOPT) dbm.cmxa \ + $(OCAMLOPT) -o reduction.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) dbm.cmxa \ $(REDUCTIONOPTOBJS) -cclib -lstr -cclib -lmldbm \ -cclib -lndbm experiment: $(EXPERIMENTOBJS) - $(OCAMLC) -custom -o experiment str.cma $(PXPLIBS) dbm.cma \ + $(OCAMLC) -custom -o experiment str.cma unix.cma $(PXPLIBS) $(XSTRLIBS) $(NETCLIENTLIBS) dbm.cma \ $(EXPERIMENTOBJS) -cclib -lstr -cclib -lmldbm -cclib -lndbm experiment.opt: $(EXPERIMENTOPTOBJS) - $(OCAMLOPT) -o experiment.opt str.cmxa $(PXPLIBSOPT) dbm.cmxa \ + $(OCAMLOPT) -o experiment.opt str.cmxa unix.cmxa $(PXPLIBSOPT) $(XSTRLIBSOPT) $(NETCLIENTLIBSOPT) dbm.cmxa \ $(EXPERIMENTOPTOBJS) -cclib -lstr -cclib -lmldbm \ -cclib -lndbm diff --git a/helm/interface/clientHTTP.ml b/helm/interface/clientHTTP.ml new file mode 100644 index 000000000..9086d8207 --- /dev/null +++ b/helm/interface/clientHTTP.ml @@ -0,0 +1,49 @@ +(* Copyright (C) 2000, HELM Team. + * + * 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://cs.unibo.it/helm/. + *) + +let send cmd = + ignore (Http_client.Convenience.http_get cmd) + +let get uri = + Http_client.Convenience.http_get uri + +let get_and_save uri dest_filename = + let reply = get uri + and out_channel = open_out dest_filename in + output_string out_channel reply ; + close_out out_channel + +let get_and_save_to_tmp uri = + let flat_string s s' c = + let cs = String.copy s in + for i = 0 to (String.length s) - 1 do + if String.contains s' s.[i] then cs.[i] <- c + done ; + cs + in + let tmp_file = Configuration.tmp_dir ^ "/" ^ (flat_string uri ".-=:;!?/&" '_') in + get_and_save uri tmp_file ; + tmp_file + diff --git a/helm/interface/configuration.ml.in b/helm/interface/configuration.ml.in index df5f61b89..b9358d8ff 100644 --- a/helm/interface/configuration.ml.in +++ b/helm/interface/configuration.ml.in @@ -9,6 +9,8 @@ (* *) (******************************************************************************) +exception MalformedDir of string + (* this should be the only hard coded constant *) let filename = let prefix = @@ -17,6 +19,8 @@ let filename = with Not_found -> "@HELM_CONFIGURATION_DIR@" in + if prefix.[(String.length prefix) - 1] = '/' then + raise (MalformedDir prefix) ; prefix ^ "/configuration.xml";; exception Warnings;; @@ -76,22 +80,38 @@ let _ = * configuration.xml file and its name into the shell environment. * The shell variable, if present, has precedence over configuration.xml *) -let read_configuration_var xml_name env_name = +let read_configuration_var_env xml_name env_name = try - Sys.getenv env_name + try + Sys.getenv env_name + with + Not_found -> Hashtbl.find vars xml_name with - Not_found -> Hashtbl.find vars xml_name + Not_found -> + Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ; + flush stdout ; + raise Not_found -let helm_dir = Hashtbl.find vars "helm_dir";; -let dtd_dir = Hashtbl.find vars "dtd_dir";; -let style_dir = read_configuration_var "style_dir" "HELM_STYLE_DIR";; -let servers_file = Hashtbl.find vars "servers_file";; -let uris_dbm = Hashtbl.find vars "uris_dbm";; -let dest = Hashtbl.find vars "dest";; -let indexname = Hashtbl.find vars "indexname";; -let tmpdir = Hashtbl.find vars "tmpdir";; -let helm_dir = Hashtbl.find vars "helm_dir";; -let getter_url = Hashtbl.find vars "getter_url";; -let processor_url = read_configuration_var "processor_url" "HELM_PROCESSOR_URL" +let read_configuration_var xml_name = + try + Hashtbl.find vars xml_name + with + Not_found -> + Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ; + flush stdout ; + raise Not_found + +let helm_dir = read_configuration_var "helm_dir";; +let dtd_dir = read_configuration_var "dtd_dir";; +let style_dir = read_configuration_var_env "style_dir" "HELM_STYLE_DIR" +let servers_file = read_configuration_var "servers_file";; +let uris_dbm = read_configuration_var "uris_dbm";; +let dest = read_configuration_var "dest";; +let indexname = read_configuration_var "indexname";; +let tmp_dir = read_configuration_var "tmp_dir" +let helm_dir = read_configuration_var "helm_dir";; +let getter_url = read_configuration_var "getter_url";; +let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL" let _ = Hashtbl.clear vars;; + diff --git a/helm/interface/getter.ml b/helm/interface/getter.ml index 50ec96380..241dd4443 100644 --- a/helm/interface/getter.ml +++ b/helm/interface/getter.ml @@ -45,11 +45,11 @@ module MapOfStrings = Map.Make(OrderedStrings);; let read_index url = let module C = Configuration in - if Sys.command ("helm_wget " ^ C.tmpdir ^ " " ^ url ^ "/\"" ^ + if Sys.command ("helm_wget " ^ C.tmp_dir ^ " " ^ url ^ "/\"" ^ C.indexname ^ "\"") <> 0 then raise (ErrorGetting url) ; - let tmpfilename = C.tmpdir ^ "/" ^ C.indexname in + let tmpfilename = C.tmp_dir ^ "/" ^ C.indexname in let fd = open_in tmpfilename in let uris = ref [] in try @@ -145,9 +145,7 @@ let get_file uri = fn ;; -let raw_get uri = - let msg = new Http_client.get uri in - msg#get_req_body +let raw_get = ClientHTTP.get_and_save (* get : uri -> filename *) (* If uri is the URI of an annotation, the annotated object is processed *) diff --git a/helm/interface/getter.mli b/helm/interface/getter.mli index c44aa3e43..0c7401cbc 100644 --- a/helm/interface/getter.mli +++ b/helm/interface/getter.mli @@ -33,6 +33,9 @@ (* *) (******************************************************************************) +(* raw_get : uri -> dest_file -> () *) +val raw_get : string -> string -> unit + (* get : uri -> filename *) (* If uri is the URI of an annotation, the annotated object is processed *) val get : UriManager.uri -> string diff --git a/helm/interface/mmlinterface.ml b/helm/interface/mmlinterface.ml index 64c068fc3..b95303d2f 100755 --- a/helm/interface/mmlinterface.ml +++ b/helm/interface/mmlinterface.ml @@ -791,6 +791,8 @@ end;; (* MAIN *) let _ = + (* first of all initialize the processor by requiring the desired stylesheets *) + XsltProcessor.initialize () ; build_uri_tree () ; let output = GMathView.math_view ~width:400 ~height:380 () and label = GMisc.label ~text:"???" () in diff --git a/helm/interface/pxpUriResolver.ml b/helm/interface/pxpUriResolver.ml index 1be7355c7..7ca78aa93 100644 --- a/helm/interface/pxpUriResolver.ml +++ b/helm/interface/pxpUriResolver.ml @@ -33,15 +33,17 @@ (* *) (******************************************************************************) -let resolve = - function - "http://localhost:8081/getdtd?uri=cic.dtd" -> - Configuration.dtd_dir ^ "/cic.dtd" - | "http://localhost:8081/getdtd?uri=maththeory.dtd" -> - Configuration.dtd_dir ^ "/maththeory.dtd" - | "http://localhost:8081/getdtd?uri=annotations.dtd" -> - Configuration.dtd_dir ^ "/annotations.dtd" - | s -> s +let resolve s = + let starts_with s s' = + if String.length s < String.length s' then + false + else + (String.sub s 0 (String.length s')) = s' + in + if starts_with s "http:" then + ClientHTTP.get_and_save_to_tmp s + else + s ;; let url_syntax = diff --git a/helm/interface/styleConfiguration.ml b/helm/interface/styleConfiguration.ml index 753a808ea..38bcc8e35 100644 --- a/helm/interface/styleConfiguration.ml +++ b/helm/interface/styleConfiguration.ml @@ -14,15 +14,11 @@ let filename = Sys.getenv "HELM_STYLECONFIGURATION_PATH" with Not_found -> - let tmp_filename = C.tmpdir ^ "/style-configuration.xml" in - if Sys.file_exists tmp_filename then tmp_filename - else begin - let styleconf = Getter.raw_get "getstyleconf" in - let out_channel = open_out tmp_filename in - output_string out_channel styleconf; - close_out out_channel; - tmp_filename - end + let xml = "style-configuration.xml" in + let tmp_xml = Configuration.tmp_dir ^ "/" ^ xml in + let request_xml = Configuration.getter_url ^ "getstyleconf?uri=" ^ xml in + Getter.raw_get request_xml tmp_xml ; + tmp_xml exception Warnings;; @@ -38,7 +34,7 @@ let xml_document () = let module Y = Pxp_yacc in try let config = {Y.default_config with Y.warner = new warner} in - Y.parse_document_entity config (Y.from_file filename) Y.default_spec + Y.parse_document_entity config (PxpUriResolver.from_file filename) Y.default_spec with e -> print_endline (Pxp_types.string_of_exn e) ; @@ -59,27 +55,41 @@ let _ = Pxp_document.T_element "style" -> let key = try - n#attribute "key" + match n#attribute "key" with + Pxp_types.Value s -> s + | _ -> raise Impossible with Not_found -> n#data - Hashtbl.add styles key n#data + in + Hashtbl.add styles key n#data | Pxp_document.T_element "apply" -> let keys = List.map (function n -> match n#node_type with - Pxp_document.T_element "style-ref" -> n#attribute "key" + Pxp_document.T_element "style-ref" -> + begin + match n#attribute "key" with + Pxp_types.Value s -> s + | _ -> raise Impossible + end | _ -> raise Impossible ) n#sub_nodes in - Hashtbl.add applies (n#attribute "name") keys + let apply_name = + match n#attribute "name" with + Pxp_types.Value s -> s + | _ -> raise Impossible + in Hashtbl.add applies apply_name keys | _ -> raise Impossible ) ((xml_document ())#root#sub_nodes) ;; let style_of_key key = - Hashtbl.lookup styles key + Hashtbl.find styles key let key_list_of_mode_name name = - Hashtbl.lookup applies name + Hashtbl.find applies name +;; + diff --git a/helm/interface/xsltProcessor.ml b/helm/interface/xsltProcessor.ml index 63d0c1fa5..ec3d9fdb0 100644 --- a/helm/interface/xsltProcessor.ml +++ b/helm/interface/xsltProcessor.ml @@ -23,67 +23,7 @@ * http://cs.unibo.it/helm/. *) -exception XsltProcessorCouldNotSend;; -exception XsltProcessorCouldNotReceive;; +let initialize = XsltProcessorHTTP.initialize -let initialize l = - List.iter - (function (name,key) -> - client_add (Configuration.getter_url ^ "getxslt?uri=" ^ name ^ "?key=" ^ key) - ) +let process = XsltProcessorHTTP.process -let portserver = 12345;; -let portclient = 12346;; -let time_to_wait = 10;; - -let rec process uri usecache mode = - let module U = Unix in - let uri = UriManager.string_of_uri uri in - let pid = string_of_int (U.getpid ()) - and filename' = - let uri' = Str.replace_first (Str.regexp ".*:") "" uri in - Str.global_replace (Str.regexp "/") "_" - (Str.global_replace (Str.regexp "_") "__" uri') - in let tmpfile = "/tmp/helm_" ^ filename' ^ "_" ^ pid in - (* test if the cache can be used *) - let tmp_file_exists = Sys.file_exists tmpfile in - if usecache && tmp_file_exists then - tmpfile - else - let url = Configuration.getter_url ^ uri in - (* purge the cache if asked to *) - if not usecache && tmp_file_exists then - Sys.remove tmpfile ; - (* let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in *) - let string_to_send = "apply " ^ url ^ " " ^ tmpfile ^ - match mode with - "cic" -> " C1 C2" - | "theory" -> " T1 T2" - in - (* next function is for looping in case the server is not responding *) - let socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in - let rec contact_server () = - let n = - U.sendto socketserver string_to_send 0 (String.length string_to_send) - [] (U.ADDR_INET(U.inet_addr_any,portserver)) - in - if n = -1 then raise XsltProcessorCouldNotSend ; - let process_signal _ = () in - Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ; - (* if the server does not respond, repeat the query *) - ignore (U.alarm time_to_wait) ; - try - if U.recv socketserver "" 0 0 [] = -1 then - raise XsltProcessorCouldNotReceive ; - ignore (U.alarm 0) ; (* stop the bomb *) - Sys.set_signal Sys.sigalrm Sys.Signal_default ; - U.close socketserver ; - tmpfile - with - U.Unix_error(_,"recv",_) -> - print_endline "Xaland server not responding. Retrying..." ; - flush stdout; - contact_server () - in - contact_server () -;; diff --git a/helm/interface/xsltProcessorHTTP.ml b/helm/interface/xsltProcessorHTTP.ml new file mode 100644 index 000000000..56096a314 --- /dev/null +++ b/helm/interface/xsltProcessorHTTP.ml @@ -0,0 +1,52 @@ +(* Copyright (C) 2000, HELM Team. + * + * 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://cs.unibo.it/helm/. + *) + +let initialize () = + Printf.printf "Initializing the UWOBO servlet, please wait" ; flush stdout ; + Hashtbl.iter + (fun key uri -> + let string_to_send = (Configuration.processor_url ^ "add?xsluri=" ^ Configuration.getter_url ^ "getxslt?uri=" ^ uri ^ "&key=" ^ key) + in + print_char '.' ; flush stdout ; + ClientHTTP.send string_to_send + ) + StyleConfiguration.styles ; + Printf.printf " ok\n" ; flush stdout +;; + +let process uri usecache mode = + let uri = UriManager.string_of_uri uri in + let url = Configuration.getter_url ^ "get?uri=" ^ uri in + let key_list = StyleConfiguration.key_list_of_mode_name mode in + let string_to_send = Configuration.processor_url ^ "apply?xmluri=" ^ url ^ + (List.fold_right + (fun key cmd -> "&key=" ^ key ^ cmd) + key_list + "" + ) + in + ClientHTTP.get_and_save_to_tmp string_to_send +;; + diff --git a/helm/interface/xsltProcessorUDP.ml b/helm/interface/xsltProcessorUDP.ml new file mode 100644 index 000000000..a95eefc57 --- /dev/null +++ b/helm/interface/xsltProcessorUDP.ml @@ -0,0 +1,93 @@ +(* Copyright (C) 2000, HELM Team. + * + * 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://cs.unibo.it/helm/. + *) + +exception XsltProcessorCouldNotSend;; +exception XsltProcessorCouldNotReceive;; + +let initialize () = + Hashtbl.iter + (fun key uri -> + ignore (Sys.command ("uwobo-client add " ^ uri ^ " " ^ key)) + ) + StyleConfiguration.styles +;; + +let _ = initialize () ;; + +let portserver = 12345;; +let portclient = 12346;; +let time_to_wait = 10;; + +let rec process uri usecache mode = + let module U = Unix in + let uri = UriManager.string_of_uri uri in + let pid = string_of_int (U.getpid ()) + and filename' = + let uri' = Str.replace_first (Str.regexp ".*:") "" uri in + Str.global_replace (Str.regexp "/") "_" + (Str.global_replace (Str.regexp "_") "__" uri') + in let tmpfile = Configuration.tmp_dir ^ "/helm_" ^ filename' ^ "_" ^ pid in + (* test if the cache can be used *) + let tmp_file_exists = Sys.file_exists tmpfile in + if usecache && tmp_file_exists then + tmpfile + else + let url = Configuration.getter_url ^ uri in + (* purge the cache if asked to *) + if not usecache && tmp_file_exists then + Sys.remove tmpfile ; + (* let string_to_send = mode ^ " " ^ url ^ " " ^ tmpfile in *) + let string_to_send = "apply " ^ url ^ " " ^ tmpfile ^ + match mode with + "cic" -> " C1 C2" + | "theory" -> " T1 T2" + in + (* next function is for looping in case the server is not responding *) + let socketserver = U.socket U.PF_INET U.SOCK_DGRAM 0 in + let rec contact_server () = + let n = + U.sendto socketserver string_to_send 0 (String.length string_to_send) + [] (U.ADDR_INET(U.inet_addr_any,portserver)) + in + if n = -1 then raise XsltProcessorCouldNotSend ; + let process_signal _ = () in + Sys.set_signal Sys.sigalrm (Sys.Signal_handle process_signal) ; + (* if the server does not respond, repeat the query *) + ignore (U.alarm time_to_wait) ; + try + if U.recv socketserver "" 0 0 [] = -1 then + raise XsltProcessorCouldNotReceive ; + ignore (U.alarm 0) ; (* stop the bomb *) + Sys.set_signal Sys.sigalrm Sys.Signal_default ; + U.close socketserver ; + tmpfile + with + U.Unix_error(_,"recv",_) -> + print_endline "Xaland server not responding. Retrying..." ; + flush stdout; + contact_server () + in + contact_server () +;; -- 2.39.2