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
40 (* Cerca in una lista di assegnamenti (lista di coppie (path,path) dove path e'
41 di tipo (string * string list) quello relativo alla proprietà p e ne
42 restituisce la variabile a cui tale proprietà deve essere associata *)
43 let rec search p = function
45 | (path1,path2)::tl -> if (fst(path2) = p) then fst(path1)
50 let get_prop_id prop =
51 if prop="refObj" then "F"
52 else if prop="backPointer" then "B"
57 let relation_ex inv rop path rset assl =
58 let relk = fst path in
61 (* Nota: mancano le inverse di refObj e backPointer!!!! *)
63 (* Notabis: ora per refObj si restituiscono tutti gli uri della tabella, nella diretta c'e` l'uri vuota *)
64 (* Notater: quando non richiedo tutte le proprieta` della tabella quelle che non voglio mi vengono restituite lo stesso ma con nome vuoto *)
67 | "backPointer" -> (* proprieta` refObj e backPointer *)
68 print_endline "IN BACKPOINTER";
69 let prop = get_prop_id relk in
70 if assl = [] then (* se non ci sono assegnamenti *)
72 let rset_list = (* lista di singoletti:resource_set di un elemento *)
73 (List.fold_left (fun acc (uri,l) ->
74 let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in
75 let qq = "select uri from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
77 let res = c#exec qq in
79 let l = (pgresult_to_string_list res) in
80 List.iter print_endline l;
90 let rec edup = function
92 | rs1::tl -> union_ex rs1 (edup tl)
97 else (* con assegnamenti *)
99 let rset_list = (* lista di singoletti:resource_set di un elemento *)
100 (List.fold_left (fun acc (uri,l) ->
101 let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in
102 let qq = "select uri, position, depth from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
104 let res = c#exec qq in
105 let pos = search "position" assl in
106 let dep = search "depth" assl in
107 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
110 [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
111 | _ -> assert false )
114 if (dep = "") then (* voglio solo position *)
117 [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
118 | _ -> assert false )
120 else (* voglio solo depth *)
123 [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
124 | _ -> assert false )
131 let rec edup = function
133 | rs1::tl -> union_ex rs1 (edup tl)
137 (* Fine proprieta` refObj e backPointer *)
139 | "refRel" -> (* proprietà refRel *)
140 if assl = [] then [] (* se non ci sono assegnamenti *)
142 let rset_list = (* lista di singoletti:resource_set di un elemento *)
143 (List.fold_left (fun acc (uri,l) ->
144 let qq = "select uri from hrefRel order by uri asc" in
145 let res = c#exec qq in
149 | _ -> assert false )
155 let rec edup = function
157 | rs1::tl -> union_ex rs1 (edup tl)
162 else (* con assegnamenti *)
163 if inv then (* INVERSA *)
165 let rset_list = (* lista di singoletti:resource_set di un elemento *)
166 (List.fold_left (fun acc (uri,l) ->
167 let qq = "select uri, position, depth from hrefRel order by uri asc" in
168 let res = c#exec qq in
169 let pos = search "position" assl in
170 let dep = search "depth" assl in
171 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
174 [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
175 | _ -> assert false )
178 if (dep = "") then (* voglio solo position *)
181 [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
182 | _ -> assert false )
184 else (* voglio solo depth *)
187 [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
188 | _ -> assert false )
195 let rec edup = function
197 | rs1::tl -> union_ex rs1 (edup tl)
200 else (* DIRETTA, con risorsa nulla *)
202 let rset_list = (* lista di singoletti:resource_set di un elemento *)
203 (List.fold_left (fun acc (uri,l) ->
204 let qq = "select position, depth from hrefRel order by uri asc" in
205 let res = c#exec qq in
206 let pos = search "position" assl in
207 let dep = search "depth" assl in
208 if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*)
211 [position;depth] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
212 | _ -> assert false )
215 if (dep = "") then (* voglio solo position *)
218 [position;depth] -> [("",[[((pos, []),[position])]])]
219 | _ -> assert false )
221 else (* voglio solo depth *)
224 [position;depth] -> [("",[[((dep, []),[depth])]])]
225 | _ -> assert false )
232 let rec edup = function
234 | rs1::tl -> union_ex rs1 (edup tl)
242 (* Fine proprieta` refRel *)
247 | "refSort" -> (* proprietà refSort *)
248 if assl = [] then [] (* se non ci sono assegnamenti *)
250 let rset_list = (* lista di singoletti:resource_set di un elemento *)
251 (List.fold_left (fun acc (uri,l) ->
252 let qq = "select uri from hrefSort order by uri asc" in
253 let res = c#exec qq in
257 | _ -> assert false )
264 let rec edup = function
266 | rs1::tl -> union_ex rs1 (edup tl)
272 else (* con assegnamenti *)
273 if inv then (*INVERSA ----> SISTEMARE: vedi refRel!!!!*)
275 let rset_list = (* lista di singoletti:resource_set di un elemento *)
276 (List.fold_left (fun acc (uri,l) ->
277 let qq = "select uri, position, depth, sort from hrefSort order by uri asc" in
278 let res = c#exec qq in
279 let pos = search "position" assl in
280 let dep = search "depth" assl in
281 let sor = search "sort" assl in
282 if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui
283 voglio position, depth e sort*)
286 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
287 | _ -> assert false )
290 if ((dep = "") && (sor = "")) then (* voglio solo position *)
293 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position])]])]
294 | _ -> assert false )
298 if ((pos = "") && (sor = "")) then (* voglio solo depth *)
301 [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth])]])]
302 | _ -> assert false )
306 if ((pos = "") && (dep = "")) then (* voglio solo sort *)
309 [uri;position;depth;sort] -> [(uri,[[((sor, []),[sort])]])]
310 | _ -> assert false )
314 if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*)
317 [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth]);((sor, []),[sort])]])]
318 | _ -> assert false )
322 if((pos != "") && (dep = "") && (sor != "")) then (*voglio
326 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((sor, []),[sort])]])]
327 | _ -> assert false )
331 (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
335 [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
336 | _ -> assert false )
343 let rec edup = function
345 | rs1::tl -> union_ex rs1 (edup tl)
349 else (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*)
351 let rset_list = (* lista di singoletti:resource_set di un elemento *)
352 (List.fold_left (fun acc (uri,l) ->
353 let qq = "select position, depth, sort from hrefSort order by uri asc" in
354 let res = c#exec qq in
355 let pos = search "position" assl in
356 let dep = search "depth" assl in
357 let sor = search "sort" assl in
358 if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui
359 voglio position, depth e sort*)
362 [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
363 | _ -> assert false )
366 if ((dep = "") && (sor = "")) then (* voglio solo position *)
369 [position;depth;sort] -> [("",[[((pos, []),[position])]])]
370 | _ -> assert false )
374 if ((pos = "") && (sor = "")) then (* voglio solo depth *)
377 [position;depth;sort] -> [("",[[((dep, []),[depth])]])]
378 | _ -> assert false )
382 if ((pos = "") && (dep = "")) then (* voglio solo sort *)
385 [position;depth;sort] -> [("",[[((sor, []),[sort])]])]
386 | _ -> assert false )
390 if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*)
393 [position;depth;sort] -> [("",[[((dep, []),[depth]);((sor, []),[sort])]])]
394 | _ -> assert false )
398 if((pos != "") && (dep = "") && (sor != "")) then (*voglio
402 [position;depth;sort] -> [("",[[((pos, []),[position]);((sor, []),[sort])]])]
403 | _ -> assert false )
407 (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
411 [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
412 | _ -> assert false )
419 let rec edup = function
421 | rs1::tl -> union_ex rs1 (edup tl)
427 (* Fine proprieta` refSort *)
437 (**** IMPLEMENTAZIONE DELLA RELATION PER GALAX ****)
440 (* trasforma un uri in un filename *)
442 if String.contains uri ':' then
443 (let len = String.length uri in
444 let scuri = String.sub uri 4 (len-4) in (*tolgo cic:*)
445 if String.contains scuri '#' then
446 (let pos = String.index scuri '#' in
447 let s1 = Str.string_before scuri pos in
448 let xp = Str.string_after scuri pos in
449 let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in
450 let xp = Str.global_replace (Str.regexp "\/") "," xp in
451 let xp = Str.global_replace (Str.regexp ")") "" xp in
452 let fname = (s1 ^ xp) in
459 (* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di resource *)
460 let rec rsetl uril vvar =
462 | uri::tl -> let scuri = (*tofname*) uri in
463 [(scuri, [[((vvar, []), [(List.hd tl)])]])]::(rsetl (List.tl tl) vvar)
467 (* 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" *)
468 let muse path assl r =
469 let vvar = if assl = [] then "position"
473 let furi = tofname uri in
474 let dtag = fst path in
477 "refObj" -> "/projects/helm/metadata/create4/forward"
478 | _ -> "/projects/helm/metadata/create4/backward"
480 let xq ="namespace h=\"http://www.cs.unibo.it/helm/schemas/mattone.rdf#\"
481 namespace rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
482 for $i in document(" ^ "\"" ^ dir ^ furi ^ ".xml" ^ "\"" ^
483 ")/rdf:RDF/h:Object/h:" ^ dtag ^ "/h:Occurrence
484 return ($i/h:occurrence, $i/h:position)"
487 let uril = Toputils.eval_query_string xq in (* e' una lista di liste di stringhe*)
488 let hd_uril = List.hd uril in(*prendo la testa che contiene altern. lista di uri e pos. *)
489 let rset_list = rsetl hd_uril vvar in (* da hd_uril costruisco una lista di resource_set(singoletti)*)
490 let rec edup = function
492 | rs1::tl -> union_ex rs1 (edup tl)
499 (* 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
500 NOTA: "rop" per ora non viene usato perche' vale sempre "ExactOp" *)
501 let relation_galax_ex inv rop path rset assl = []
505 List.stable_sort (fun (uri1,l1) (uri2,l2) -> compare uri1 uri2) (List.concat (List.map (muse path assl) rset))