helm/ocaml/mathql_interpreter/relation.ml

   1 (* Copyright (C) 2000, HELM Team.
   2  *
   3  *
   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.
   7  *
   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.
  12  *
  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.
  17  *
  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,
  21  * MA  02111-1307, USA.
  22  *
  23  * For details, see the HELM World-Wide-Web page,
  24  * http://www.cs.unibo.it/helm/.
  25  *)
  26
  27
  28 (*
  29  * implementazione del comando Relation
  30  *)
  31
  32
  33
  34
  35 open Union;;
  36 open Dbconn;;
  37 open Utility;;
  38
  39
  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
  44     [] -> ""
  45   | (path1,path2)::tl -> if (fst(path2) = p) then fst(path1)
  46                        else search p tl
  47 ;;
  48
  49
  50 let get_prop_id prop =
  51   if prop="refObj" then "F"
  52   else if prop="backPointer" then "B"
  53        else assert false
  54 ;;
  55
  56
  57 let relation_ex inv rop path rset assl =
  58   let relk = fst path in
  59   match relk with
  60
  61  (* Nota: mancano le inverse di refObj e backPointer!!!! *)
  62
  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 *)
  65
  66     "refObj"
  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 *)
  71       let c = pgc () in
  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
  76         print_endline qq;
  77         let res = c#exec qq in
  78
  79         let l = (pgresult_to_string_list res) in
  80         List.iter print_endline l;
  81         (List.map
  82          (function
  83                [uri] -> [(uri,[])]
  84              | _ -> assert false )
  85           res#get_list) @ acc
  86                       )
  87                 [] rset
  88       )
  89       in
  90       let rec edup = function
  91           [] -> []
  92         | rs1::tl -> union_ex rs1 (edup tl)
  93       in
  94       edup rset_list
  95
  96
  97     else               (* con assegnamenti *)
  98       let c = pgc () in
  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
 103         print_endline qq;
 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*)
 108          (List.map
 109          (function
 110                [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
 111              | _ -> assert false )
 112           res#get_list) @ acc
 113         else
 114            if (dep = "") then                    (* voglio solo position *)
 115              (List.map
 116              (function
 117                   [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
 118                 | _ -> assert false )
 119              res#get_list) @ acc
 120             else                                 (* voglio solo depth *)
 121              (List.map
 122              (function
 123                   [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
 124                 | _ -> assert false )
 125              res#get_list) @ acc
 126
 127                         )
 128                 [] rset
 129       )
 130       in
 131       let rec edup = function
 132           [] -> []
 133         | rs1::tl -> union_ex rs1 (edup tl)
 134       in
 135       edup rset_list
 136
 137 (* Fine proprieta` refObj e backPointer *)
 138
 139   | "refRel" ->                        (* proprietà refRel *)
 140     if assl = [] then []    (* se non ci sono assegnamenti *)
 141 (*      let c = pgc () in
 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
 146         (List.map
 147          (function
 148                [uri] -> [(uri,[])]
 149              | _ -> assert false )
 150           res#get_list) @ acc
 151                       )
 152                 [] rset
 153       )
 154       in
 155       let rec edup = function
 156           [] -> []
 157         | rs1::tl -> union_ex rs1 (edup tl)
 158       in
 159       edup rset_list
 160 *)
 161
 162     else               (* con assegnamenti *)
 163       if inv then   (* INVERSA *)
 164         let c = pgc () in
 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*)
 172            (List.map
 173            (function
 174                  [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
 175                | _ -> assert false )
 176             res#get_list) @ acc
 177           else
 178              if (dep = "") then                    (* voglio solo position *)
 179                (List.map
 180                (function
 181                     [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
 182                   | _ -> assert false )
 183                res#get_list) @ acc
 184               else                                 (* voglio solo depth *)
 185                (List.map
 186                (function
 187                     [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
 188                   | _ -> assert false )
 189                res#get_list) @ acc
 190
 191                         )
 192                   [] rset
 193         )
 194         in
 195         let rec edup = function
 196           [] -> []
 197           | rs1::tl -> union_ex rs1 (edup tl)
 198         in
 199         edup rset_list
 200       else                          (* DIRETTA, con risorsa nulla *)
 201         let c = pgc () in
 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*)
 209            (List.map
 210            (function
 211                  [position;depth] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
 212                | _ -> assert false )
 213             res#get_list) @ acc
 214           else
 215              if (dep = "") then                    (* voglio solo position *)
 216                (List.map
 217                (function
 218                     [position;depth] -> [("",[[((pos, []),[position])]])]
 219                   | _ -> assert false )
 220                res#get_list) @ acc
 221               else                                 (* voglio solo depth *)
 222                (List.map
 223                (function
 224                     [position;depth] -> [("",[[((dep, []),[depth])]])]
 225                   | _ -> assert false )
 226                res#get_list) @ acc
 227
 228                         )
 229                   [] rset
 230         )
 231         in
 232         let rec edup = function
 233           [] -> []
 234           | rs1::tl -> union_ex rs1 (edup tl)
 235         in
 236         edup rset_list
 237
 238
 239
 240
 241
 242 (* Fine proprieta` refRel *)
 243
 244
 245
 246
 247   | "refSort" ->                    (* proprietà refSort *)
 248     if assl = [] then []   (* se non ci sono assegnamenti *)
 249 (*      let c = pgc () in
 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
 254         (List.map
 255          (function
 256                [uri] -> [(uri,[])]
 257              | _ -> assert false )
 258           res#get_list) @ acc
 259
 260                       )
 261                 [] rset
 262       )
 263       in
 264       let rec edup = function
 265           [] -> []
 266         | rs1::tl -> union_ex rs1 (edup tl)
 267       in
 268       edup rset_list
 269 *)
 270
 271
 272      else               (* con assegnamenti *)
 273        if inv then                               (*INVERSA ----> SISTEMARE: vedi refRel!!!!*)
 274          let c = pgc () in
 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*)
 284             (List.map
 285             (function
 286                   [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
 287                 | _ -> assert false )
 288              res#get_list) @ acc
 289            else
 290               if ((dep = "") && (sor = "")) then          (* voglio solo position *)
 291                 (List.map
 292                 (function
 293                      [uri;position;depth;sort] -> [(uri,[[((pos, []),[position])]])]
 294                    | _ -> assert false )
 295                 res#get_list) @ acc
 296
 297               else
 298                 if ((pos = "") && (sor = "")) then         (* voglio solo depth *)
 299                 (List.map
 300                 (function
 301                      [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth])]])]
 302                    | _ -> assert false )
 303                 res#get_list) @ acc
 304
 305               else
 306               if ((pos = "") && (dep = "")) then   (* voglio solo sort *)
 307                 (List.map
 308                 (function
 309                      [uri;position;depth;sort] -> [(uri,[[((sor, []),[sort])]])]
 310                    | _ -> assert false )
 311                 res#get_list) @ acc
 312
 313                    else
 314               if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e           sort*)
 315                 (List.map
 316                 (function
 317                      [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth]);((sor, []),[sort])]])]
 318                    | _ -> assert false )
 319                 res#get_list) @ acc
 320
 321               else
 322               if((pos != "") && (dep = "") && (sor != "")) then (*voglio
 323               position e sort*)
 324                 (List.map
 325                 (function
 326                      [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((sor, []),[sort])]])]
 327                    | _ -> assert false )
 328                 res#get_list) @ acc
 329
 330               else
 331             (*  if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
 332              position e depth*)
 333                 (List.map
 334                 (function
 335                      [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
 336                    | _ -> assert false )
 337                 res#get_list) @ acc
 338
 339                      )
 340                    [] rset
 341          )
 342          in
 343          let rec edup = function
 344              [] -> []
 345            | rs1::tl -> union_ex rs1 (edup tl)
 346          in
 347          edup rset_list
 348
 349       else       (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*)
 350          let c = pgc () in
 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*)
 360             (List.map
 361             (function
 362                   [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
 363                 | _ -> assert false )
 364              res#get_list) @ acc
 365            else
 366               if ((dep = "") && (sor = "")) then          (* voglio solo position *)
 367                 (List.map
 368                 (function
 369                      [position;depth;sort] -> [("",[[((pos, []),[position])]])]
 370                    | _ -> assert false )
 371                 res#get_list) @ acc
 372
 373               else
 374                 if ((pos = "") && (sor = "")) then         (* voglio solo depth *)
 375                 (List.map
 376                 (function
 377                      [position;depth;sort] -> [("",[[((dep, []),[depth])]])]
 378                    | _ -> assert false )
 379                 res#get_list) @ acc
 380
 381               else
 382               if ((pos = "") && (dep = "")) then   (* voglio solo sort *)
 383                 (List.map
 384                 (function
 385                      [position;depth;sort] -> [("",[[((sor, []),[sort])]])]
 386                    | _ -> assert false )
 387                 res#get_list) @ acc
 388
 389                    else
 390               if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e           sort*)
 391                 (List.map
 392                 (function
 393                      [position;depth;sort] -> [("",[[((dep, []),[depth]);((sor, []),[sort])]])]
 394                    | _ -> assert false )
 395                 res#get_list) @ acc
 396
 397               else
 398               if((pos != "") && (dep = "") && (sor != "")) then (*voglio
 399               position e sort*)
 400                 (List.map
 401                 (function
 402                      [position;depth;sort] -> [("",[[((pos, []),[position]);((sor, []),[sort])]])]
 403                    | _ -> assert false )
 404                 res#get_list) @ acc
 405
 406               else
 407             (*  if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
 408              position e depth*)
 409                 (List.map
 410                 (function
 411                      [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
 412                    | _ -> assert false )
 413                 res#get_list) @ acc
 414
 415                      )
 416                    [] rset
 417          )
 418          in
 419          let rec edup = function
 420              [] -> []
 421            | rs1::tl -> union_ex rs1 (edup tl)
 422          in
 423          edup rset_list
 424
 425
 426
 427 (* Fine proprieta` refSort *)
 428
 429
 430
 431   | _ -> []
 432
 433 ;;
 434
 435
 436
 437 (**** IMPLEMENTAZIONE DELLA RELATION PER GALAX ****)
 438
 439
 440 (* trasforma un uri in un filename *)
 441 let tofname uri =
 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
 453           fname)
 454        else
 455          scuri)
 456     else uri
 457
 458
 459 (* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di resource *)
 460 let rec rsetl uril vvar =
 461     match uril with
 462     | uri::tl -> let scuri = (*tofname*) uri in
 463                    [(scuri, [[((vvar, []), [(List.hd tl)])]])]::(rsetl (List.tl tl) vvar)
 464     | [] -> []
 465
 466
 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"
 470                    else List.hd assl
 471         in
 472         let uri = fst r in
 473         let furi = tofname uri in
 474         let dtag = fst path in
 475         let dir =
 476           match dtag with
 477               "refObj" -> "/projects/helm/metadata/create4/forward"
 478             | _ -> "/projects/helm/metadata/create4/backward"
 479         in
 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)"
 485
 486         in
 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
 491             [] -> []
 492           | rs1::tl -> union_ex rs1 (edup tl)
 493         in
 494         edup rset_list
 495
 496
 497
 498
 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 = []
 502
 503 (*
 504
 505   List.stable_sort (fun (uri1,l1) (uri2,l2) -> compare uri1 uri2) (List.concat (List.map (muse path assl) rset))
 506
 507 *)