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
39 let quoted s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s
41 (* Cerca in una lista di assegnamenti (lista di coppie (path,path) dove path e'
42 di tipo (string * string list) quello relativo alla proprietà p e ne
43 restituisce la variabile a cui tale proprietà deve essere associata *)
44 let rec search p = function
46 | (path1,path2)::tl -> if (fst(path2) = p) then fst(path1)
51 let get_prop_id prop =
52 if prop="refObj" then "F"
53 else if prop="backPointer" then "B"
58 let relation_ex inv rop path rset assl =
59 let relk = fst path in
62 (* Nota: mancano le inverse di refObj e backPointer!!!! *)
64 (* Notabis: ora per refObj si restituiscono tutti gli uri della tabella, nella diretta c'e` l'uri vuota *)
65 (* Notater: quando non richiedo tutte le proprieta` della tabella quelle che non voglio mi vengono restituite lo stesso ma con nome vuoto *)
68 | "backPointer" -> (* proprieta` refObj e backPointer *)
69 (* print_endline "IN BACKPOINTER"; *)
70 let prop = get_prop_id relk in
71 if assl = [] then (* se non ci sono assegnamenti *)
73 let rset_list = (* lista di singoletti:resource_set di un elemento *)
74 (List.fold_left (fun acc (uri,l) ->
75 let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in
76 let qq = "select uri from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
77 (* print_endline qq; *)
78 let res = c#exec qq in
80 let l = (pgresult_to_string_list res) in
81 (* List.iter print_endline l; *)
91 let rec edup = function
93 | rs1::tl -> union_ex rs1 (edup tl)
98 else (* con assegnamenti *)
100 let rset_list = (* lista di singoletti:resource_set di un elemento *)
101 (List.fold_left (fun acc (uri,l) ->
102 let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in
103 let qq = "select uri, position, depth from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
105 let res = c#exec qq in
106 let pos = search "position" assl in
107 let dep = search "depth" assl in
108 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
111 [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
112 | _ -> assert false )
115 if (dep = "") then (* voglio solo position *)
118 [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
119 | _ -> assert false )
121 else (* voglio solo depth *)
124 [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
125 | _ -> assert false )
132 let rec edup = function
134 | rs1::tl -> union_ex rs1 (edup tl)
138 (* Fine proprieta` refObj e backPointer *)
140 | "refRel" -> (* proprietà refRel *)
141 if assl = [] then [] (* se non ci sono assegnamenti *)
143 let rset_list = (* lista di singoletti:resource_set di un elemento *)
144 (List.fold_left (fun acc (uri,l) ->
145 let qq = "select uri from hrefRel order by uri asc" in
146 let res = c#exec qq in
150 | _ -> assert false )
156 let rec edup = function
158 | rs1::tl -> union_ex rs1 (edup tl)
163 else (* con assegnamenti *)
164 if inv then (* INVERSA *)
166 let rset_list = (* lista di singoletti:resource_set di un elemento *)
167 (List.fold_left (fun acc (uri,l) ->
168 let qq = "select uri, position, depth from hrefRel order by uri asc" in
169 let res = c#exec qq in
170 let pos = search "position" assl in
171 let dep = search "depth" assl in
172 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
175 [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
176 | _ -> assert false )
179 if (dep = "") then (* voglio solo position *)
182 [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
183 | _ -> assert false )
185 else (* voglio solo depth *)
188 [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
189 | _ -> assert false )
196 let rec edup = function
198 | rs1::tl -> union_ex rs1 (edup tl)
201 else (* DIRETTA, con risorsa nulla *)
203 let rset_list = (* lista di singoletti:resource_set di un elemento *)
204 (List.fold_left (fun acc (uri,l) ->
205 let qq = "select position, depth from hrefRel order by uri asc" in
206 let res = c#exec qq in
207 let pos = search "position" assl in
208 let dep = search "depth" assl in
209 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
212 [position;depth] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
213 | _ -> assert false )
216 if (dep = "") then (* voglio solo position *)
219 [position;depth] -> [("",[[((pos, []),[position])]])]
220 | _ -> assert false )
222 else (* voglio solo depth *)
225 [position;depth] -> [("",[[((dep, []),[depth])]])]
226 | _ -> assert false )
233 let rec edup = function
235 | rs1::tl -> union_ex rs1 (edup tl)
243 (* Fine proprieta` refRel *)
248 | "refSort" -> (* proprietà refSort *)
249 if assl = [] then [] (* se non ci sono assegnamenti *)
251 let rset_list = (* lista di singoletti:resource_set di un elemento *)
252 (List.fold_left (fun acc (uri,l) ->
253 let qq = "select uri from hrefSort order by uri asc" in
254 let res = c#exec qq in
258 | _ -> assert false )
265 let rec edup = function
267 | rs1::tl -> union_ex rs1 (edup tl)
273 else (* con assegnamenti *)
274 if inv then (*INVERSA ----> SISTEMARE: vedi refRel!!!!*)
276 let rset_list = (* lista di singoletti:resource_set di un elemento *)
277 (List.fold_left (fun acc (uri,l) ->
278 let qq = "select uri, position, depth, sort from hrefSort order by uri asc" in
279 let res = c#exec qq in
280 let pos = search "position" assl in
281 let dep = search "depth" assl in
282 let sor = search "sort" assl in
283 if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui
284 voglio position, depth e sort*)
287 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
288 | _ -> assert false )
291 if ((dep = "") && (sor = "")) then (* voglio solo position *)
294 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position])]])]
295 | _ -> assert false )
299 if ((pos = "") && (sor = "")) then (* voglio solo depth *)
302 [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth])]])]
303 | _ -> assert false )
307 if ((pos = "") && (dep = "")) then (* voglio solo sort *)
310 [uri;position;depth;sort] -> [(uri,[[((sor, []),[sort])]])]
311 | _ -> assert false )
315 if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*)
318 [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth]);((sor, []),[sort])]])]
319 | _ -> assert false )
323 if((pos != "") && (dep = "") && (sor != "")) then (*voglio
327 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((sor, []),[sort])]])]
328 | _ -> assert false )
332 (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
336 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
337 | _ -> assert false )
344 let rec edup = function
346 | rs1::tl -> union_ex rs1 (edup tl)
350 else (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*)
352 let rset_list = (* lista di singoletti:resource_set di un elemento *)
353 (List.fold_left (fun acc (uri,l) ->
354 let qq = "select position, depth, sort from hrefSort order by uri asc" in
355 let res = c#exec qq in
356 let pos = search "position" assl in
357 let dep = search "depth" assl in
358 let sor = search "sort" assl in
359 if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui
360 voglio position, depth e sort*)
363 [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
364 | _ -> assert false )
367 if ((dep = "") && (sor = "")) then (* voglio solo position *)
370 [position;depth;sort] -> [("",[[((pos, []),[position])]])]
371 | _ -> assert false )
375 if ((pos = "") && (sor = "")) then (* voglio solo depth *)
378 [position;depth;sort] -> [("",[[((dep, []),[depth])]])]
379 | _ -> assert false )
383 if ((pos = "") && (dep = "")) then (* voglio solo sort *)
386 [position;depth;sort] -> [("",[[((sor, []),[sort])]])]
387 | _ -> assert false )
391 if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*)
394 [position;depth;sort] -> [("",[[((dep, []),[depth]);((sor, []),[sort])]])]
395 | _ -> assert false )
399 if((pos != "") && (dep = "") && (sor != "")) then (*voglio
403 [position;depth;sort] -> [("",[[((pos, []),[position]);((sor, []),[sort])]])]
404 | _ -> assert false )
408 (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
412 [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
413 | _ -> assert false )
420 let rec edup = function
422 | rs1::tl -> union_ex rs1 (edup tl)
428 (* Fine proprieta` refSort *)
438 (**** IMPLEMENTAZIONE DELLA RELATION PER GALAX ****)
441 (* trasforma un uri in un filename *)
443 if String.contains uri ':' then
444 (let len = String.length uri in
445 let scuri = String.sub uri 4 (len-4) in (*tolgo cic:*)
446 if String.contains scuri '#' then
447 (let pos = String.index scuri '#' in
448 let s1 = Str.string_before scuri pos in
449 let xp = Str.string_after scuri pos in
450 let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in
451 let xp = Str.global_replace (Str.regexp "\/") "," xp in
452 let xp = Str.global_replace (Str.regexp ")") "" xp in
453 let fname = (s1 ^ xp) in
460 (* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di resource *)
461 let rec rsetl uril vvar =
463 | uri::tl -> let scuri = (*tofname*) uri in
464 [(scuri, [[((vvar, []), [(List.hd tl)])]])]::(rsetl (List.tl tl) vvar)
468 (* 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" *)
469 let muse path assl r =
470 let vvar = if assl = [] then "position"
474 let furi = tofname uri in
475 let dtag = fst path in
478 "refObj" -> "/projects/helm/metadata/create4/forward"
479 | _ -> "/projects/helm/metadata/create4/backward"
481 let xq ="namespace h=\"http://www.cs.unibo.it/helm/schemas/mattone.rdf#\"
482 namespace rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
483 for $i in document(" ^ "\"" ^ dir ^ furi ^ ".xml" ^ "\"" ^
484 ")/rdf:RDF/h:Object/h:" ^ dtag ^ "/h:Occurrence
485 return ($i/h:occurrence, $i/h:position)"
488 let uril = Toputils.eval_query_string xq in (* e' una lista di liste di stringhe*)
489 let hd_uril = List.hd uril in(*prendo la testa che contiene altern. lista di uri e pos. *)
490 let rset_list = rsetl hd_uril vvar in (* da hd_uril costruisco una lista di resource_set(singoletti)*)
491 let rec edup = function
493 | rs1::tl -> union_ex rs1 (edup tl)
500 (* 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
501 NOTA: "rop" per ora non viene usato perche' vale sempre "ExactOp" *)
502 let relation_galax_ex inv rop path rset assl = []
506 List.stable_sort (fun (uri1,l1) (uri2,l2) -> compare uri1 uri2) (List.concat (List.map (muse path assl) rset))