1 (* Copyright (C) 2000, HELM Team.
4 if This file is part of HELM, an Hypertextual, Electronic
5 * Library of Mathematics, developed at the Computer Science
6 * Department, University of Bologna, Italy.
8 * HELM is free software; you can redistribute it and/or
9 * modify it under the terms of the GNU General Public License
10 * as published by the Free Software Foundation; either version 2
11 * of the License, or (at your option) any later version.
13 * HELM is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
18 * You should have received a copy of the GNU General Public License
19 * along with HELM; if not, write to the Free Software
20 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
23 * For details, see the HELM World-Wide-Web page,
24 * http://www.cs.unibo.it/helm/.
29 * implementazione del comando Relation
37 let quoted s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s
39 (* Cerca in una lista di assegnamenti (lista di coppie (path,path) dove path e'
40 di tipo (string * string list) quello relativo alla proprietà p e ne
41 restituisce la variabile a cui tale proprietà deve essere associata *)
42 let rec search p = function
44 | (path1,path2)::tl -> if (fst(path2) = p) then fst(path1)
49 let get_prop_id prop =
50 if prop="refObj" then "F"
51 else if prop="backPointer" then "B"
56 let relation_ex handle inv rop path rset assl =
57 let relk = fst path in
60 (* Nota: mancano le inverse di refObj e backPointer!!!! *)
62 (* Notabis: ora per refObj si restituiscono tutti gli uri della tabella, nella diretta c'e` l'uri vuota *)
63 (* Notater: quando non richiedo tutte le proprieta` della tabella quelle che non voglio mi vengono restituite lo stesso ma con nome vuoto *)
66 | "backPointer" -> (* proprieta` refObj e backPointer *)
67 (* print_endline "IN BACKPOINTER"; *)
68 let prop = get_prop_id relk in
69 if assl = [] then (* se non ci sono assegnamenti *)
70 let c = MQIConn.pgc handle in
71 let rset_list = (* lista di singoletti:resource_set di un elemento *)
72 (List.fold_left (fun acc (uri,l) ->
73 let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in
74 let qq = "select uri from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
75 (* print_endline qq; *)
76 let res = c#exec qq in
78 let l = (pgresult_to_string_list res) in
79 (* List.iter print_endline l; *)
89 let rec edup = function
91 | rs1::tl -> union_ex rs1 (edup tl)
96 else (* con assegnamenti *)
97 let c = MQIConn.pgc handle in
98 let rset_list = (* lista di singoletti:resource_set di un elemento *)
99 (List.fold_left (fun acc (uri,l) ->
100 let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in
101 let qq = "select uri, position, depth from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
103 let res = c#exec qq in
104 let pos = search "position" assl in
105 let dep = search "depth" assl in
106 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
109 [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
110 | _ -> assert false )
113 if (dep = "") then (* voglio solo position *)
116 [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
117 | _ -> assert false )
119 else (* voglio solo depth *)
122 [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
123 | _ -> assert false )
130 let rec edup = function
132 | rs1::tl -> union_ex rs1 (edup tl)
136 (* Fine proprieta` refObj e backPointer *)
138 | "refRel" -> (* proprietà refRel *)
139 if assl = [] then [] (* se non ci sono assegnamenti *)
140 (* let c = MQIConn.pgc handle in
141 let rset_list = (* lista di singoletti:resource_set di un elemento *)
142 (List.fold_left (fun acc (uri,l) ->
143 let qq = "select uri from hrefRel order by uri asc" in
144 let res = c#exec qq in
148 | _ -> assert false )
154 let rec edup = function
156 | rs1::tl -> union_ex rs1 (edup tl)
161 else (* con assegnamenti *)
162 if inv then (* INVERSA *)
163 let c = MQIConn.pgc handle in
164 let rset_list = (* lista di singoletti:resource_set di un elemento *)
165 (List.fold_left (fun acc (uri,l) ->
166 let qq = "select uri, position, depth from hrefRel order by uri asc" in
167 let res = c#exec qq in
168 let pos = search "position" assl in
169 let dep = search "depth" assl in
170 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
173 [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
174 | _ -> assert false )
177 if (dep = "") then (* voglio solo position *)
180 [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
181 | _ -> assert false )
183 else (* voglio solo depth *)
186 [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
187 | _ -> assert false )
194 let rec edup = function
196 | rs1::tl -> union_ex rs1 (edup tl)
199 else (* DIRETTA, con risorsa nulla *)
200 let c = MQIConn.pgc handle in
201 let rset_list = (* lista di singoletti:resource_set di un elemento *)
202 (List.fold_left (fun acc (uri,l) ->
203 let qq = "select position, depth from hrefRel order by uri asc" in
204 let res = c#exec qq in
205 let pos = search "position" assl in
206 let dep = search "depth" assl in
207 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
210 [position;depth] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
211 | _ -> assert false )
214 if (dep = "") then (* voglio solo position *)
217 [position;depth] -> [("",[[((pos, []),[position])]])]
218 | _ -> assert false )
220 else (* voglio solo depth *)
223 [position;depth] -> [("",[[((dep, []),[depth])]])]
224 | _ -> assert false )
231 let rec edup = function
233 | rs1::tl -> union_ex rs1 (edup tl)
241 (* Fine proprieta` refRel *)
246 | "refSort" -> (* proprietà refSort *)
247 if assl = [] then [] (* se non ci sono assegnamenti *)
248 (* let c = MQIConn.pgc handle in
249 let rset_list = (* lista di singoletti:resource_set di un elemento *)
250 (List.fold_left (fun acc (uri,l) ->
251 let qq = "select uri from hrefSort order by uri asc" in
252 let res = c#exec qq in
256 | _ -> assert false )
263 let rec edup = function
265 | rs1::tl -> union_ex rs1 (edup tl)
271 else (* con assegnamenti *)
272 if inv then (*INVERSA ----> SISTEMARE: vedi refRel!!!!*)
273 let c = MQIConn.pgc handle in
274 let rset_list = (* lista di singoletti:resource_set di un elemento *)
275 (List.fold_left (fun acc (uri,l) ->
276 let qq = "select uri, position, depth, sort from hrefSort order by uri asc" in
277 let res = c#exec qq in
278 let pos = search "position" assl in
279 let dep = search "depth" assl in
280 let sor = search "sort" assl in
281 if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui
282 voglio position, depth e sort*)
285 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
286 | _ -> assert false )
289 if ((dep = "") && (sor = "")) then (* voglio solo position *)
292 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position])]])]
293 | _ -> assert false )
297 if ((pos = "") && (sor = "")) then (* voglio solo depth *)
300 [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth])]])]
301 | _ -> assert false )
305 if ((pos = "") && (dep = "")) then (* voglio solo sort *)
308 [uri;position;depth;sort] -> [(uri,[[((sor, []),[sort])]])]
309 | _ -> assert false )
313 if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*)
316 [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth]);((sor, []),[sort])]])]
317 | _ -> assert false )
321 if((pos != "") && (dep = "") && (sor != "")) then (*voglio
325 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((sor, []),[sort])]])]
326 | _ -> assert false )
330 (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
334 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
335 | _ -> assert false )
342 let rec edup = function
344 | rs1::tl -> union_ex rs1 (edup tl)
348 else (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*)
349 let c = MQIConn.pgc handle in
350 let rset_list = (* lista di singoletti:resource_set di un elemento *)
351 (List.fold_left (fun acc (uri,l) ->
352 let qq = "select position, depth, sort from hrefSort order by uri asc" in
353 let res = c#exec qq in
354 let pos = search "position" assl in
355 let dep = search "depth" assl in
356 let sor = search "sort" assl in
357 if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui
358 voglio position, depth e sort*)
361 [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
362 | _ -> assert false )
365 if ((dep = "") && (sor = "")) then (* voglio solo position *)
368 [position;depth;sort] -> [("",[[((pos, []),[position])]])]
369 | _ -> assert false )
373 if ((pos = "") && (sor = "")) then (* voglio solo depth *)
376 [position;depth;sort] -> [("",[[((dep, []),[depth])]])]
377 | _ -> assert false )
381 if ((pos = "") && (dep = "")) then (* voglio solo sort *)
384 [position;depth;sort] -> [("",[[((sor, []),[sort])]])]
385 | _ -> assert false )
389 if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*)
392 [position;depth;sort] -> [("",[[((dep, []),[depth]);((sor, []),[sort])]])]
393 | _ -> assert false )
397 if((pos != "") && (dep = "") && (sor != "")) then (*voglio
401 [position;depth;sort] -> [("",[[((pos, []),[position]);((sor, []),[sort])]])]
402 | _ -> assert false )
406 (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
410 [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
411 | _ -> assert false )
418 let rec edup = function
420 | rs1::tl -> union_ex rs1 (edup tl)
426 (* Fine proprieta` refSort *)
436 (**** IMPLEMENTAZIONE DELLA RELATION PER GALAX ****)
439 (* trasforma un uri in un filename *)
441 if String.contains uri ':' then
442 (let len = String.length uri in
443 let scuri = String.sub uri 4 (len-4) in (*tolgo cic:*)
444 if String.contains scuri '#' then
445 (let pos = String.index scuri '#' in
446 let s1 = Str.string_before scuri pos in
447 let xp = Str.string_after scuri pos in
448 let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in
449 let xp = Str.global_replace (Str.regexp "\/") "," xp in
450 let xp = Str.global_replace (Str.regexp ")") "" xp in
451 let fname = (s1 ^ xp) in
458 (* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di resource *)
459 let rec rsetl uril vvar =
461 | uri::tl -> let scuri = (*tofname*) uri in
462 [(scuri, [[((vvar, []), [(List.hd tl)])]])]::(rsetl (List.tl tl) vvar)
466 (* prende una resource e una vvar e restituisce la lista delle resource in relazione (refObj o backPointer in base al parametro "path") con tale resource e associa alla proprieta' il nome della vvar contenuto in "assl" *)
467 let muse path assl r =
468 let vvar = if assl = [] then "position"
472 let furi = tofname uri in
473 let dtag = fst path in
476 "refObj" -> "/projects/helm/metadata/create4/forward"
477 | _ -> "/projects/helm/metadata/create4/backward"
479 let xq ="namespace h=\"http://www.cs.unibo.it/helm/schemas/mattone.rdf#\"
480 namespace rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
481 for $i in document(" ^ "\"" ^ dir ^ furi ^ ".xml" ^ "\"" ^
482 ")/rdf:RDF/h:Object/h:" ^ dtag ^ "/h:Occurrence
483 return ($i/h:occurrence, $i/h:position)"
486 let uril = Toputils.eval_query_string xq in (* e' una lista di liste di stringhe*)
487 let hd_uril = List.hd uril in(*prendo la testa che contiene altern. lista di uri e pos. *)
488 let rset_list = rsetl hd_uril vvar in (* da hd_uril costruisco una lista di resource_set(singoletti)*)
489 let rec edup = function
491 | rs1::tl -> union_ex rs1 (edup tl)
498 (* prende un resource_set, una vvar (primo el. di assl) a cui associare la posizione, e la relazione (refObj o backPointer) e per ogni resource chiama la muse
499 NOTA: "rop" per ora non viene usato perche' vale sempre "ExactOp" *)
500 let relation_galax_ex handle inv rop path rset assl = []
504 List.stable_sort (fun (uri1,l1) (uri2,l2) -> compare uri1 uri2) (List.concat (List.map (muse path assl) rset))