Source file my2.ml

(*********************************************************************************)
(*                OCaml-RDF                                                      *)
(*                                                                               *)
(*    Copyright (C) 2012-2024 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program 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 this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** *)

open Rdf;;
open Term;;
open My;;

let table_options engine =
  " ENGINE="^engine^
    (if String.lowercase_ascii engine = "myisam" then " DELAY_KEY_WRITE=1" else "")^
    " MAX_ROWS=100000000 DEFAULT CHARSET=UTF8"
;;

let creation_queries =
  [
    "CREATE TABLE IF NOT EXISTS graphs (id integer AUTO_INCREMENT PRIMARY KEY NOT NULL, name text NOT NULL)" ;
  ]
;;

let hash_of_term = function
| Term.Iri iri -> "U"^(Iri.to_string iri)
| Term.Blank -> assert false
| Term.Blank_ id -> "B"^(Term.string_of_blank_id id)
| Term.Literal lit ->
    let iri = Misc.map_opt Iri.to_string lit.lit_type in
    "L"^(Marshal.to_string (lit.lit_value, lit.lit_language, iri) [])
;;

let term_of_hash dbd hash =
  match hash.[0] with
    'U' -> Term.Iri (Iri.of_string (String.sub hash 1 (String.length hash - 1)))
  | 'B' -> Term.Blank_ (Term.blank_id_of_string (String.sub hash 1 (String.length hash -1)))
  | 'L' ->
      let (v,lang,iri) = Marshal.from_string hash 1 in
      Term.Literal
        { Term.lit_value = v ;
          lit_language = lang ;
          lit_type = Misc.map_opt Iri.of_string iri ;
        }
  | c -> raise (Error ("Bad term header '"^(String.make 1 c)^"'"))
;;

let init_db db engine =
  let table_options = table_options engine in
  let queries = List.map (fun q -> q^table_options) creation_queries in
  My.init_db db queries
;;

let init_graph dbd engine name =
  let table = My.graph_table_of_graph_name dbd name in
  if not (My.table_exists dbd table) then
    begin
      let query =
        "CREATE TABLE IF NOT EXISTS "^table^" (\
         subject text NOT NULL, predicate text NOT NULL, \
         object text NOT NULL,\
         KEY SubjectPredicate (subject(100),predicate(100)),\
         KEY PredicateObject (predicate(100),object(100)),\
         KEY SubjectObject (subject(100),object(100))\
        ) "^(table_options engine)^" AVG_ROW_LENGTH=250"
      in
      ignore(My.exec_query dbd query);
    end;
  My.create_namespaces_table dbd table ;
  My.prepare_queries dbd table;
  table
;;

let query_term_list g stmt params =
  let res = My.exec_prepared g.g_dbd stmt params in
  let f = function
  | [| Some hash |] -> term_of_hash g.g_dbd (Mysql.blob2ml hash)
  | _ -> raise (Error "Invalid result: NULL hash or too many fields")
  in
  Mysql.map res ~f
;;

let query_pred_list g stmt params =
  let res = My.exec_prepared g.g_dbd stmt params in
  let f = function
  | [| Some s |] -> Iri.of_string (Mysql.blob2ml s)
  | _ -> raise (Error "Invalid result: NULL hash or too many fields")
  in
  Mysql.map res ~f
;;

let query_triple_list g where_clause =
  let query =
    "SELECT subject, predicate, object FROM "^g.g_table^" where " ^ where_clause (* removed DISTINCT *)
  in
  let res = exec_query g.g_dbd query in
  let f = function
  | [| Some sub ; Some pred ; Some obj |] ->
      (term_of_hash g.g_dbd (Mysql.blob2ml sub),
       Iri.of_string (Mysql.blob2ml pred),
       term_of_hash g.g_dbd (Mysql.blob2ml obj)
      )
  | _ -> raise (Error "Invalid result: NULL hash(es) or bad number of fields")
  in
  Mysql.map res ~f
;;

let open_graph ?(options=[]) name =
  let db = db_of_options options in
  let engine =
    try
      match List.assoc "engine" options with
        "" -> raise Not_found
      | s -> s
    with Not_found -> "InnoDB"
  in
  let engine = String.uppercase_ascii engine in
  let dbd = init_db db engine in
  let table_name = init_graph dbd engine name in
  { g_name = name ;
    g_table = table_name ;
    g_dbd = dbd ;
    g_in_transaction = false ;
    g_transactions = engine = "INNODB" ;
  }
;;

let add_triple g ~sub ~pred ~obj =
  let sub = hash_of_term sub in
  let pred = Iri.to_string pred in
  let obj = hash_of_term obj in
  let params = [
    My.mysql_quote g sub ;
    My.mysql_quote g pred ;
    My.mysql_quote g obj
    ]
  in
  (* do not insert if already present *)
  let res = My.exec_prepared g.g_dbd prepared_count_triples params in
  match Mysql.fetch res with
    Some [| Some s |] when int_of_string s = 0 ->
      ignore(My.exec_prepared g.g_dbd prepared_insert_triple params)
  | _ -> ()
;;

let rem_triple g ~sub ~pred ~obj =
  let sub = hash_of_term sub in
  let pred = Iri.to_string pred in
  let obj = hash_of_term obj in
  ignore(My.exec_prepared g.g_dbd
   prepared_delete_triple
   [ My.mysql_quote g sub;
     My.mysql_quote g pred;
     My.mysql_quote g obj
   ]
  )
;;

let subjects_of g ~pred ~obj =
  query_term_list g prepared_subjects_of
  [ My.mysql_quote g (Iri.to_string pred) ;
    My.mysql_quote g (hash_of_term obj) ;
  ]
;;

let predicates_of g ~sub ~obj =
  query_pred_list g prepared_predicates_of
   [ My.mysql_quote g (hash_of_term sub) ;
     My.mysql_quote g (hash_of_term obj) ;
   ]
;;

let objects_of g ~sub ~pred =
  query_term_list g prepared_objects_of
  [ My.mysql_quote g (hash_of_term sub) ;
    My.mysql_quote g (Iri.to_string pred) ;
  ]
;;

let mk_where_clause ?sub ?pred ?obj g =
  let mk_cond field = function
    None -> []
  | Some term ->
      [field ^"="^(My.mysql_quote g (hash_of_term term))]
  in
  match sub, pred, obj with
    None, None, None -> "TRUE"
  | _ ->
      let pred_cond =
        match pred with
          None -> []
        | Some p -> ["predicate="^(My.mysql_quote g (Iri.to_string p) )]
      in
      let l =
        (mk_cond "subject" sub) @
        pred_cond @
        (mk_cond "object" obj)
      in
      String.concat " AND " l
;;

let find ?sub ?pred ?obj g =
  let clause = mk_where_clause ?sub ?pred ?obj g in
  query_triple_list g clause
;;

let exists = My.exists mk_where_clause;;

let subjects g = query_term_list g prepared_subject [];;
let predicates g = query_pred_list g prepared_predicate [];;
let objects g = query_term_list g prepared_object [];;


module MyBGP =
  struct
    let to_iri (sub,pred,obj) = (sub, Term.Iri pred, obj)
    type term = Term.term
    type g = t
    let term _ t = t
    let rdfterm _ t = t
    let compare _ = Term.compare
    let subjects = subjects
    let objects = objects
    let find ?sub ?pred ?obj g =
      match pred with
        None -> List.map to_iri (find ?sub ?obj g)
      | Some (Term.Iri iri) ->
          List.map to_iri (find ?sub ~pred: iri ?obj g)
      | _ -> []
  end

module Mysql =
  struct
    let name = "mysql2"
    type g = t
    type error = string
    exception Error = Error
    let string_of_error = My.string_of_error

    let graph_name g = g.g_name
    let graph_size g = My.graph_size g

    let open_graph = open_graph

    let add_triple = add_triple
    let rem_triple = rem_triple

    let add_triple_t g (sub, pred, obj) = add_triple g ~sub ~pred ~obj
    let rem_triple_t g (sub, pred, obj) = rem_triple g ~sub ~pred ~obj

    let subjects_of = subjects_of
    let predicates_of = predicates_of
    let objects_of = objects_of

    let find = find
    let exists = exists
    let exists_t (sub, pred, obj) g = exists ~sub ~pred ~obj g

    let subjects = subjects
    let predicates = predicates
    let objects = objects
    let folder _ = None
    let transaction_start = My.transaction_start
    let transaction_commit = My.transaction_commit
    let transaction_rollback = My.transaction_rollback
    let copy _ = raise (Error (Printf.sprintf "%s: Copy operation not supported" name))
    let new_blank_id = My.new_blank_id

    let namespaces = My.namespaces
    let add_namespace = My.add_namespace
    let rem_namespace = My.rem_namespace
    let set_namespaces = My.set_namespaces

    module BGP = MyBGP
  end;;

Graph.add_storage (module Mysql : Graph.Storage);;

(*
let output_times file map =
  let oc = open_out file in
  let total = SMap.fold
  (fun q (t,cpt) acc ->
     Printf.fprintf oc "%f;%f;%d;%s\n"
     (t /. (float cpt)) t cpt q;
     t +. acc
    )
    map 0.
  in
  Printf.fprintf oc "Total=%f\n" total;
  close_out oc
;;

let _ = Stdlib.at_exit
  (fun () ->
     output_times "rdf_my_prep_times.log" !prep_times;
     output_times "rdf_my_q_times.log" !q_times
  )
;;
*)