X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2Frelation.ml;fp=helm%2Focaml%2Fmathql_interpreter%2Frelation.ml;h=0000000000000000000000000000000000000000;hb=869549224eef6278a48c16ae27dd786376082b38;hp=e5b700064bb297e6d35e533a3d4b73af334c7c31;hpb=89262281b6e83bd2321150f81f1a0583645eb0c8;p=helm.git diff --git a/helm/ocaml/mathql_interpreter/relation.ml b/helm/ocaml/mathql_interpreter/relation.ml deleted file mode 100644 index e5b700064..000000000 --- a/helm/ocaml/mathql_interpreter/relation.ml +++ /dev/null @@ -1,507 +0,0 @@ -(* Copyright (C) 2000, HELM Team. - * - * - if This file is part of HELM, an Hypertextual, Electronic - * Library of Mathematics, developed at the Computer Science - * Department, University of Bologna, Italy. - * - * HELM is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * HELM is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with HELM; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, - * MA 02111-1307, USA. - * - * For details, see the HELM World-Wide-Web page, - * http://www.cs.unibo.it/helm/. - *) - - -(* - * implementazione del comando Relation - *) - - - - -open Union;; -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 prop = - if prop="refObj" then "F" - else if prop="backPointer" then "B" - else assert false -;; - - -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)) - -*)