helm/ocaml/cic/test.ml

   1 (* Copyright (C) 2004-2005, HELM Team.
   2  *
   3  * This file is part of HELM, an Hypertextual, Electronic
   4  * Library of Mathematics, developed at the Computer Science
   5  * Department, University of Bologna, Italy.
   6  *
   7  * HELM is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License
   9  * as published by the Free Software Foundation; either version 2
  10  * of the License, or (at your option) any later version.
  11  *
  12  * HELM is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with HELM; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://helm.cs.unibo.it/
  24  *)
  25
  26 open Printf
  27
  28 let _ =
  29   Helm_registry.set "getter.mode" "remote";
  30   Helm_registry.set "getter.url" "http://mowgli.cs.unibo.it:58081/"
  31
  32 let body_RE = Str.regexp "^.*\\.body$"
  33 let con_RE = Str.regexp "^.*\\.con$"
  34
  35 let unlink f =
  36   if Sys.file_exists f then
  37     Unix.unlink f
  38
  39 let rec parse uri tmpfile1 tmpfile2 =
  40 (*  prerr_endline (sprintf "%s %s" tmpfile1 (match tmpfile2 with None -> "None" | Some f -> "Some " ^ f));*)
  41   (try
  42     let uri' = UriManager.uri_of_string uri in
  43     let time_new0 = Unix.gettimeofday () in
  44 (*    let obj_new = CicPushParser.CicParser.annobj_of_xml tmpfile1 tmpfile2 in*)
  45     let obj_new = CicParser.annobj_of_xml uri' tmpfile1 tmpfile2 in
  46     let time_new1 = Unix.gettimeofday () in
  47
  48     let time_old0 = Unix.gettimeofday () in
  49     let obj_old = CicPxpParser.CicParser.annobj_of_xml uri' tmpfile1 tmpfile2 in
  50     let time_old1 = Unix.gettimeofday () in
  51
  52     let time_old = time_old1 -. time_old0 in
  53     let time_new = time_new1 -. time_new0 in
  54     let are_equal = (obj_old = obj_new) in
  55     printf "%s\t%b\t%f\t%f\t%f\n"
  56       uri are_equal time_old time_new (time_new /. time_old *. 100.);
  57     flush stdout;
  58   with
  59   | CicParser.Getter_failure ("key_not_found", uri)
  60     when Str.string_match body_RE uri 0 ->
  61       parse uri tmpfile1 None
  62   | CicParser.Parser_failure msg ->
  63       printf "%s FAILED (%s)\n" uri msg; flush stdout);
  64   unlink tmpfile1;
  65   (match tmpfile2 with None -> () | Some f -> unlink f)
  66
  67 let _ =
  68   try
  69     while true do
  70       let uri = input_line stdin in
  71       let tmpfile1 = Http_getter.getxml uri in
  72       let tmpfile2 =
  73         if Str.string_match con_RE uri 0 then begin
  74           Some (Http_getter.getxml (uri ^ ".body"))
  75         end else
  76           None
  77       in
  78       parse uri tmpfile1 tmpfile2
  79     done
  80   with End_of_file -> ()
  81
  82 (* Parsing test:
  83  * - XmlPushParser version *)
  84 (*open Printf*)
  85 (*open XmlPushParser*)
  86
  87 (*let print s = print_endline s; flush stdout*)
  88
  89 (*let callbacks =*)
  90 (*  { default_callbacks with*)
  91 (*      start_element =*)
  92 (*        Some (fun tag attrs ->*)
  93 (*          let length = List.length attrs in*)
  94 (*          print (sprintf "opening %s [%s]"*)
  95 (*            tag (String.concat ";" (List.map fst attrs))));*)
  96 (*      end_element = Some (fun tag -> print ("closing " ^ tag));*)
  97 (*      character_data = Some (fun data -> print "character data ...");*)
  98 (*  }*)
  99
 100 (*let xml_parser = create_parser callbacks*)
 101
 102 (*let _ = parse xml_parser (`File Sys.argv.(1))*)
 103
 104 (* Parsing test:
 105  * - Pure expat version (without XmlPushParser mediation).
 106  * Originally written only to test if XmlPushParser mediation caused overhead.
 107  * That was not the case. *)
 108
 109 (*let _ =*)
 110 (*  let ic = open_in Sys.argv.(1) in*)
 111 (*  let expat_parser = Expat.parser_create ~encoding:None in*)
 112 (*  Expat.set_start_element_handler expat_parser*)
 113 (*    (fun tag attrs ->*)
 114 (*      let length = List.length attrs in*)
 115 (*      print (sprintf "opening %s [%d attribute%s]"*)
 116 (*      tag length (if length = 1 then "" else "s")));*)
 117 (*  Expat.set_end_element_handler expat_parser*)
 118 (*    (fun tag -> print ("closing " ^ tag));*)
 119 (*  Expat.set_character_data_handler expat_parser*)
 120 (*    (fun data -> print "character data ...");*)
 121 (*  try*)
 122 (*    while true do*)
 123 (*      Expat.parse expat_parser (input_line ic ^ "\n")*)
 124 (*    done*)
 125 (*  with End_of_file -> Expat.final expat_parser*)
 126