helm/interface/getter.ml

   1 (* Copyright (C) 2000, 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://cs.unibo.it/helm/.
  24  *)
  25
  26 (******************************************************************************)
  27 (*                                                                            *)
  28 (*                               PROJECT HELM                                 *)
  29 (*                                                                            *)
  30 (*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
  31 (*                                 24/01/2000                                 *)
  32 (*                                                                            *)
  33 (******************************************************************************)
  34
  35 exception ErrorGetting of string;;
  36
  37 module OrderedStrings =
  38  struct
  39   type t = string
  40   let compare (s1 : t) (s2 : t) = compare s1 s2
  41  end
  42 ;;
  43
  44 module MapOfStrings = Map.Make(OrderedStrings);;
  45
  46 let read_index url =
  47  let module C = Configuration in
  48   if Sys.command ("helm_wget " ^ C.tmpdir ^ " " ^ url ^ "/\"" ^
  49    C.indexname ^ "\"") <> 0
  50   then
  51    raise (ErrorGetting url) ;
  52   let tmpfilename = C.tmpdir ^ "/" ^ C.indexname in
  53    let fd = open_in tmpfilename in
  54    let uris = ref [] in
  55     try
  56      while true do
  57       let (uri,comp) =
  58        match (Str.split (Str.regexp "[ \t]+") (input_line fd)) with
  59          [uri] -> (uri,"")
  60        | [uri;comp] -> (uri,".gz")
  61       in
  62        uris := (uri,comp) :: !uris
  63      done ;
  64      [] (* only to make the compiler happy *)
  65     with
  66      End_of_file ->
  67       Sys.remove tmpfilename ;
  68       !uris
  69 ;;
  70
  71 (* mk_urls_of_uris list_of_servers_base_urls *)
  72 let rec mk_urls_of_uris =
  73  function
  74     [] -> MapOfStrings.empty
  75   | he::tl ->
  76      let map = mk_urls_of_uris tl in
  77       let uris = read_index he in
  78        let url_of_uri (uri,comp) =
  79         let url = uri  ^ ".xml" ^ comp in
  80          let url' = Str.replace_first (Str.regexp "cic:") he url in
  81          let url'' = Str.replace_first (Str.regexp "theory:") he url' in
  82           url''
  83        in
  84         List.fold_right
  85          (fun (uri,comp) m -> MapOfStrings.add uri (url_of_uri (uri,comp)) m)
  86          uris map
  87 ;;
  88
  89 exception PerlGetterNotResponding;;
  90
  91 let update () =
  92  let module C = Configuration in
  93   let fd = open_in C.servers_file in
  94   let servers = ref [] in
  95    try
  96     while true do
  97      servers := (input_line fd) :: !servers
  98     done
  99    with
 100     End_of_file ->
 101      let urls_of_uris = mk_urls_of_uris (List.rev !servers) in
 102       (try Sys.remove (C.uris_dbm ^ ".db") with _ -> ()) ;
 103       let dbm =
 104        Dbm.opendbm C.uris_dbm [Dbm.Dbm_wronly ; Dbm.Dbm_create] 0o660
 105       in
 106        MapOfStrings.iter (fun uri url -> Dbm.add dbm uri url) urls_of_uris ;
 107        Dbm.close dbm ;
 108        (* Inform also the Perl-getter *)
 109        if Sys.command ("wget -O /dev/null http://localhost:8081/update") <> 0
 110        then
 111         raise PerlGetterNotResponding ;
 112 ;;
 113
 114 (* url_of_uri : uri -> url *)
 115 let url_of_uri uri =
 116  let dbm = Dbm.opendbm Configuration.uris_dbm [Dbm.Dbm_rdonly] 0o660 in
 117   let url = Dbm.find dbm (UriManager.string_of_uri uri) in
 118    Dbm.close dbm ;
 119    url
 120 ;;
 121
 122 let filedir_of_uri uri =
 123  let fn = UriManager.buri_of_uri uri in
 124   let fn' = Str.replace_first (Str.regexp ".*:") Configuration.dest fn in
 125    fn'
 126 ;;
 127
 128 let name_and_ext_of_uri uri =
 129  let str = UriManager.string_of_uri uri in
 130   Str.replace_first (Str.regexp ".*/") "" str
 131 ;;
 132
 133 (* get_file : uri -> filename *)
 134 let get_file uri =
 135  let dir = filedir_of_uri uri in
 136   let fn = dir ^ "/" ^ name_and_ext_of_uri uri ^ ".xml" in
 137    if not (Sys.file_exists fn) then
 138     begin
 139      let url = url_of_uri uri in
 140       (*CSC: use -q for quiet mode *)
 141       if Sys.command ("helm_wget " ^ dir ^ " \"" ^ url ^"\"") <> 0
 142       then
 143        raise (ErrorGetting url) ;
 144     end ;
 145    fn
 146 ;;
 147
 148 (* get : uri -> filename *)
 149 (* If uri is the URI of an annotation, the annotated object is processed *)
 150 let get uri =
 151  let module U = UriManager in
 152   get_file
 153    (U.uri_of_string
 154     (Str.replace_first (Str.regexp "\.types$") ""
 155      (Str.replace_first (Str.regexp "\.ann$") "" (U.string_of_uri uri))))
 156 ;;
 157
 158 (* get_ann : uri -> filename *)
 159 (* If uri is the URI of an annotation, the annotation file is processed *)
 160 let get_ann = get_file;;
 161
 162 (* get_ann_file_name_and_uri : uri -> filename * annuri *)
 163 (* If given an URI, it returns the name of the corresponding *)
 164 (* annotation file and the annotation uri                    *)
 165 let get_ann_file_name_and_uri uri =
 166  let module U = UriManager in
 167   let uri = U.string_of_uri uri in
 168    let annuri =
 169     U.uri_of_string (
 170      if Str.string_match (Str.regexp ".*\.ann$") uri 0 then
 171       uri
 172      else
 173       uri ^ ".ann"
 174     )
 175    in
 176     let dir = filedir_of_uri annuri in
 177      let fn = dir ^ "/" ^ name_and_ext_of_uri annuri ^ ".xml" in
 178       (fn, annuri)
 179 ;;