X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2Frelation.ml;h=e5b700064bb297e6d35e533a3d4b73af334c7c31;hb=89262281b6e83bd2321150f81f1a0583645eb0c8;hp=159369ad2b55fe0469dcc41e158f16a1b0619613;hpb=ba824e867afc3eaf081ed1a1d6526d421242a6a0;p=helm.git diff --git a/helm/ocaml/mathql_interpreter/relation.ml b/helm/ocaml/mathql_interpreter/relation.ml index 159369ad2..e5b700064 100644 --- a/helm/ocaml/mathql_interpreter/relation.ml +++ b/helm/ocaml/mathql_interpreter/relation.ml @@ -1,6 +1,7 @@ (* Copyright (C) 2000, HELM Team. * - * This file is part of HELM, an Hypertextual, Electronic + * + if This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * @@ -36,41 +37,471 @@ open Dbconn;; open Utility;; +(* Cerca in una lista di assegnamenti (lista di coppie (path,path) dove path e' +di tipo (string * string list) quello relativo alla proprietà p e ne +restituisce la variabile a cui tale proprietà deve essere associata *) +let rec search p = function + [] -> "" + | (path1,path2)::tl -> if (fst(path2) = p) then fst(path1) + else search p tl +;; -let get_prop_id propl = - let prop = List.hd propl in +let get_prop_id prop = if prop="refObj" then "F" else if prop="backPointer" then "B" else assert false ;; -let relation_ex rop path rset attl = - if path = [] then [] - else - let usek = get_prop_id path in - let vvar = if attl = [] then "position" - else List.hd attl - in - let c = pgc () in - let rset_list = (* lista di singoletti:resource_set di un elemento *) - (List.fold_left (fun acc (uri,l) -> - let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in - let qq = "select uri, context from t" ^ tv ^ " where prop_id='" ^ usek ^ "' order by uri asc" in - let res = c#exec qq in - (List.map - (function - [uri;context] -> [(uri,[[(vvar,[context])]])] - | _ -> assert false ) - res#get_list) @ acc - ) - [] rset - ) - in - let rec edup = function - [] -> [] - | rs1::tl -> union_ex rs1 (edup tl) - in - edup rset_list +let relation_ex inv rop path rset assl = + let relk = fst path in + match relk with + + (* Nota: mancano le inverse di refObj e backPointer!!!! *) + +(* Notabis: ora per refObj si restituiscono tutti gli uri della tabella, nella diretta c'e` l'uri vuota *) +(* Notater: quando non richiedo tutte le proprieta` della tabella quelle che non voglio mi vengono restituite lo stesso ma con nome vuoto *) + + "refObj" + | "backPointer" -> (* proprieta` refObj e backPointer *) + print_endline "IN BACKPOINTER"; + let prop = get_prop_id relk in + if assl = [] then (* se non ci sono assegnamenti *) + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in + let qq = "select uri from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in + print_endline qq; + let res = c#exec qq in + + let l = (pgresult_to_string_list res) in + List.iter print_endline l; + (List.map + (function + [uri] -> [(uri,[])] + | _ -> assert false ) + res#get_list) @ acc + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + + + else (* con assegnamenti *) + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ uri ^ "'")) in + let qq = "select uri, position, depth from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in + print_endline qq; + let res = c#exec qq in + let pos = search "position" assl in + let dep = search "depth" assl in + if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*) + (List.map + (function + [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + else + if (dep = "") then (* voglio solo position *) + (List.map + (function + [uri;position;depth] -> [(uri,[[((pos, []),[position])]])] + | _ -> assert false ) + res#get_list) @ acc + else (* voglio solo depth *) + (List.map + (function + [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + +(* Fine proprieta` refObj e backPointer *) + + | "refRel" -> (* proprietà refRel *) + if assl = [] then [] (* se non ci sono assegnamenti *) +(* let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let qq = "select uri from hrefRel order by uri asc" in + let res = c#exec qq in + (List.map + (function + [uri] -> [(uri,[])] + | _ -> assert false ) + res#get_list) @ acc + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list +*) + + else (* con assegnamenti *) + if inv then (* INVERSA *) + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let qq = "select uri, position, depth from hrefRel order by uri asc" in + let res = c#exec qq in + let pos = search "position" assl in + let dep = search "depth" assl in + if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*) + (List.map + (function + [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + else + if (dep = "") then (* voglio solo position *) + (List.map + (function + [uri;position;depth] -> [(uri,[[((pos, []),[position])]])] + | _ -> assert false ) + res#get_list) @ acc + else (* voglio solo depth *) + (List.map + (function + [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + else (* DIRETTA, con risorsa nulla *) + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let qq = "select position, depth from hrefRel order by uri asc" in + let res = c#exec qq in + let pos = search "position" assl in + let dep = search "depth" assl in + if ((pos != "") && (dep != "")) then (*caso in cui voglio sia position che depth*) + (List.map + (function + [position;depth] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + else + if (dep = "") then (* voglio solo position *) + (List.map + (function + [position;depth] -> [("",[[((pos, []),[position])]])] + | _ -> assert false ) + res#get_list) @ acc + else (* voglio solo depth *) + (List.map + (function + [position;depth] -> [("",[[((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + + + + + +(* Fine proprieta` refRel *) + + + + + | "refSort" -> (* proprietà refSort *) + if assl = [] then [] (* se non ci sono assegnamenti *) +(* let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let qq = "select uri from hrefSort order by uri asc" in + let res = c#exec qq in + (List.map + (function + [uri] -> [(uri,[])] + | _ -> assert false ) + res#get_list) @ acc + + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list +*) + + + else (* con assegnamenti *) + if inv then (*INVERSA ----> SISTEMARE: vedi refRel!!!!*) + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let qq = "select uri, position, depth, sort from hrefSort order by uri asc" in + let res = c#exec qq in + let pos = search "position" assl in + let dep = search "depth" assl in + let sor = search "sort" assl in + if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui + voglio position, depth e sort*) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + else + if ((dep = "") && (sor = "")) then (* voglio solo position *) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((pos, []),[position])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if ((pos = "") && (sor = "")) then (* voglio solo depth *) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if ((pos = "") && (dep = "")) then (* voglio solo sort *) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth]);((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if((pos != "") && (dep = "") && (sor != "")) then (*voglio + position e sort*) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio + position e depth*) + (List.map + (function + [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + + else (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*) + let c = pgc () in + let rset_list = (* lista di singoletti:resource_set di un elemento *) + (List.fold_left (fun acc (uri,l) -> + let qq = "select position, depth, sort from hrefSort order by uri asc" in + let res = c#exec qq in + let pos = search "position" assl in + let dep = search "depth" assl in + let sor = search "sort" assl in + if ((pos != "") && (dep != "") && (sor != "")) then (*caso in cui + voglio position, depth e sort*) + (List.map + (function + [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + else + if ((dep = "") && (sor = "")) then (* voglio solo position *) + (List.map + (function + [position;depth;sort] -> [("",[[((pos, []),[position])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if ((pos = "") && (sor = "")) then (* voglio solo depth *) + (List.map + (function + [position;depth;sort] -> [("",[[((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if ((pos = "") && (dep = "")) then (* voglio solo sort *) + (List.map + (function + [position;depth;sort] -> [("",[[((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e sort*) + (List.map + (function + [position;depth;sort] -> [("",[[((dep, []),[depth]);((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + if((pos != "") && (dep = "") && (sor != "")) then (*voglio + position e sort*) + (List.map + (function + [position;depth;sort] -> [("",[[((pos, []),[position]);((sor, []),[sort])]])] + | _ -> assert false ) + res#get_list) @ acc + + else + (* if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio + position e depth*) + (List.map + (function + [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])] + | _ -> assert false ) + res#get_list) @ acc + + ) + [] rset + ) + in + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + + + +(* Fine proprieta` refSort *) + + + + | _ -> [] + ;; + + + +(**** IMPLEMENTAZIONE DELLA RELATION PER GALAX ****) + + +(* trasforma un uri in un filename *) +let tofname uri = + if String.contains uri ':' then + (let len = String.length uri in + let scuri = String.sub uri 4 (len-4) in (*tolgo cic:*) + if String.contains scuri '#' then + (let pos = String.index scuri '#' in + let s1 = Str.string_before scuri pos in + let xp = Str.string_after scuri pos in + let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in + let xp = Str.global_replace (Str.regexp "\/") "," xp in + let xp = Str.global_replace (Str.regexp ")") "" xp in + let fname = (s1 ^ xp) in + fname) + else + scuri) + else uri + + +(* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di resource *) +let rec rsetl uril vvar = + match uril with + | uri::tl -> let scuri = (*tofname*) uri in + [(scuri, [[((vvar, []), [(List.hd tl)])]])]::(rsetl (List.tl tl) vvar) + | [] -> [] + + +(* 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" *) +let muse path assl r = + let vvar = if assl = [] then "position" + else List.hd assl + in + let uri = fst r in + let furi = tofname uri in + let dtag = fst path in + let dir = + match dtag with + "refObj" -> "/projects/helm/metadata/create4/forward" + | _ -> "/projects/helm/metadata/create4/backward" + in + let xq ="namespace h=\"http://www.cs.unibo.it/helm/schemas/mattone.rdf#\" + namespace rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\" + for $i in document(" ^ "\"" ^ dir ^ furi ^ ".xml" ^ "\"" ^ + ")/rdf:RDF/h:Object/h:" ^ dtag ^ "/h:Occurrence + return ($i/h:occurrence, $i/h:position)" + + in + let uril = Toputils.eval_query_string xq in (* e' una lista di liste di stringhe*) + let hd_uril = List.hd uril in(*prendo la testa che contiene altern. lista di uri e pos. *) + let rset_list = rsetl hd_uril vvar in (* da hd_uril costruisco una lista di resource_set(singoletti)*) + let rec edup = function + [] -> [] + | rs1::tl -> union_ex rs1 (edup tl) + in + edup rset_list + + + + +(* 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 +NOTA: "rop" per ora non viene usato perche' vale sempre "ExactOp" *) +let relation_galax_ex inv rop path rset assl = [] + +(* + + List.stable_sort (fun (uri1,l1) (uri2,l2) -> compare uri1 uri2) (List.concat (List.map (muse path assl) rset)) + +*)