1 (* Copyright (C) 2004, HELM Team.
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.
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.
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.
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,
22 * For details, see the HELM World-Wide-Web page,
23 * http://helm.cs.unibo.it/
28 type cardinality_condition =
32 let tbln n = "table" ^ string_of_int n
34 let add_depth_constr depth_opt cur_tbl where =
37 | Some depth -> (sprintf "%s.h_depth = %d" cur_tbl depth) :: where
39 let add_card_constr tbl (n,from,where) = function
40 | None -> (n,from,where)
43 (sprintf "%s as %s" tbl (tbln n) :: from),
44 (sprintf "no=%d" card ::
46 else [sprintf "table0.source = %s.source" (tbln n)]) @
50 (sprintf "%s as %s" tbl (tbln n) :: from),
51 (sprintf "no>%d" card ::
53 else [sprintf "table0.source = %s.source" (tbln n)]) @
56 let at_least ~(dbh:Dbi.connection) ?concl_card ?full_card
57 (metadata: MetadataTypes.metadata list)
59 if (metadata = []) && concl_card = None && full_card = None then
60 failwith "MetadataQuery.at_least: no constraints given";
61 let add_constraint (n,from,where) metadata =
62 let cur_tbl = tbln n in
64 | `Obj (uri, pos, depth_opt) ->
65 let tbl = MetadataTypes.obj_tbl in
66 let pos_str = MetadataPp.pp_position pos in
67 let from = (sprintf "%s as %s" tbl cur_tbl) :: from in
69 (sprintf "%s.h_position = \"%s\"" cur_tbl pos_str) ::
70 (sprintf "%s.h_occurrence = \"%s\"" cur_tbl uri) ::
72 else [sprintf "table0.source = %s.source" cur_tbl]) @
75 let where = add_depth_constr depth_opt cur_tbl where in
77 | `Rel (pos, depth) ->
78 let tbl = MetadataTypes.rel_tbl in
79 let pos_str = MetadataPp.pp_position (pos :> MetadataTypes.position) in
80 let from = (sprintf "%s as %s" tbl cur_tbl) :: from in
82 (sprintf "%s.h_position = \"%s\"" cur_tbl pos_str) ::
84 else [sprintf "table0.source = %s.source" cur_tbl]) @
87 let where = add_depth_constr (Some depth) cur_tbl where in
89 | `Sort (sort, pos, depth) ->
90 let tbl = MetadataTypes.sort_tbl in
91 let pos_str = MetadataPp.pp_position (pos :> MetadataTypes.position) in
92 let sort_str = MetadataPp.pp_sort sort in
93 let from = (sprintf "%s as %s" tbl cur_tbl) :: from in
95 (sprintf "%s.h_position = \"%s\"" cur_tbl pos_str) ::
96 (sprintf "%s.h_sort = \"%s\"" cur_tbl sort_str) ::
98 else [sprintf "table0.source = %s.source" cur_tbl]) @
101 let where = add_depth_constr (Some depth) cur_tbl where in
104 let (n,from,where) = List.fold_left add_constraint (0,[],[]) metadata in
106 add_card_constr MetadataTypes.conclno_tbl (n,from,where) concl_card
109 add_card_constr MetadataTypes.conclno_hyp_tbl (n,from,where) full_card
111 let from = String.concat ", " from in
112 let where = String.concat " and " where in
113 let query = sprintf "select table0.source from %s where %s" from where in
115 let query = dbh#prepare query in
117 List.map (function [`String s] -> s | _ -> assert false) (query#fetchall ())