helm/ocaml/metadata/metadataDb.ml

   1 (* Copyright (C) 2004, 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 MetadataTypes
  27
  28 open Printf
  29
  30 let prepare_insert () =
  31   let insert_owner a b =
  32     sprintf "INSERT %s VALUES (\"%s\", \"%s\")" owners_tbl a b
  33   in
  34   let insert_sort  a b c d =
  35     sprintf "INSERT %s VALUES (\"%s\", \"%s\", %d, \"%s\")" sort_tbl a b c d
  36   in
  37   let insert_rel a b c =
  38     sprintf "INSERT %s VALUES (\"%s\", \"%s\", %d)" rel_tbl a b c
  39   in
  40   let insert_obj a b c d =
  41     sprintf "INSERT %s VALUES (\"%s\", \"%s\", \"%s\", %s)" obj_tbl a b c d
  42   in
  43   (insert_owner, insert_sort, insert_rel, insert_obj)
  44
  45 let execute_insert dbd (insert_owner, insert_sort, insert_rel, insert_obj)
  46   uri owner (sort_cols, rel_cols, obj_cols)
  47 =
  48   ignore (Mysql.exec dbd (insert_owner uri owner));
  49   List.iter (function
  50       | [`String a; `String b; `Int c; `String d] ->
  51           ignore (Mysql.exec dbd (insert_sort a b c d))
  52       | _ -> assert false)
  53     sort_cols;
  54   List.iter (function
  55       | [`String a; `String b; `Int c] ->
  56           ignore (Mysql.exec dbd (insert_rel a b c))
  57       | _ -> assert false)
  58     rel_cols;
  59   List.iter (function
  60       | [`String a; `String b; `String c; `Int d] ->
  61           ignore (Mysql.exec dbd (insert_obj a b c (string_of_int d)))
  62       | [`String a; `String b; `String c; `Null] ->
  63           ignore (Mysql.exec dbd (insert_obj a b c "NULL"))
  64       | _ -> assert false)
  65     obj_cols
  66
  67 let insert_const_no dbd uri =
  68   let inconcl_no =
  69     sprintf "INSERT %s SELECT \"%s\", COUNT(DISTINCT h_occurrence) FROM %s WHERE (h_position=\"%s\" OR h_position=\"%s\") AND source LIKE \"%s%%\""
  70       conclno_tbl uri obj_tbl inconcl_pos mainconcl_pos uri
  71   in
  72   let concl_hyp =
  73     sprintf "INSERT %s
  74         SELECT \"%s\",COUNT(DISTINCT h_occurrence)
  75         FROM %s
  76         WHERE NOT (h_position=\"%s\") AND (source = \"%s\")"
  77       conclno_hyp_tbl uri obj_tbl inbody_pos uri
  78   in
  79   ignore (Mysql.exec dbd inconcl_no);
  80   ignore (Mysql.exec dbd concl_hyp)
  81
  82 let insert_name ~dbd ~uri ~name =
  83   let query =
  84     sprintf "INSERT %s VALUES (\"%s\", \"%s\")" name_tbl uri name
  85   in
  86   ignore (Mysql.exec dbd query)
  87
  88 type columns =
  89   MetadataPp.t list list * MetadataPp.t list list * MetadataPp.t list list
  90
  91 let index_constant ~dbd =
  92   let query = prepare_insert () in
  93   fun ~owner ~uri ~body ~ty  ->
  94     let name = UriManager.name_of_uri uri in
  95     let uri = UriManager.string_of_uri uri in
  96     let metadata = MetadataExtractor.compute ~body ~ty in
  97     let columns = MetadataPp.columns_of_metadata ~about:uri metadata in
  98     execute_insert dbd query uri owner (columns :> columns);
  99     insert_const_no dbd uri;
 100     insert_name ~dbd ~uri ~name
 101
 102 let index_inductive_def ~dbd =
 103   let query = prepare_insert () in
 104   fun ~owner ~uri ~types ->
 105     let metadata = MetadataExtractor.compute_ind ~uri ~types in
 106     let uri_of (a,b,c) = a in
 107     let uris = UriManager.string_of_uri uri :: List.map uri_of metadata in
 108     let uri = UriManager.string_of_uri uri in
 109     let columns = MetadataPp.columns_of_ind_metadata metadata in
 110     execute_insert dbd query uri owner (columns :> columns);
 111     List.iter (insert_const_no dbd) uris;
 112     List.iter (fun (uri, name, _) -> insert_name ~dbd ~uri ~name) metadata
 113
 114 let clean ~(dbd:Mysql.dbd) ~owner =
 115   let owned_uris =  (* list of uris in list-of-columns format *)
 116     let query =
 117       sprintf "SELECT source FROM %s WHERE owner = \"%s\"" owners_tbl owner
 118     in
 119     let result = Mysql.exec dbd query in
 120     Mysql.map result (fun cols ->
 121       match cols.(0) with
 122       | Some src -> src
 123       | None -> assert false)
 124   in
 125   let del_from tbl =
 126     let query s = sprintf "DELETE FROM %s WHERE source LIKE \"%s%%\"" tbl s in
 127     List.iter
 128       (fun source_col -> ignore (Mysql.exec dbd (query source_col)))
 129       owned_uris
 130   in
 131   List.iter del_from
 132     [sort_tbl; rel_tbl; obj_tbl; conclno_tbl; conclno_hyp_tbl; name_tbl;
 133     owners_tbl];
 134   List.iter Http_getter.unregister owned_uris
 135