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 open Union;;
  34 open Dbconn;;
  35 open Utility;;
  36
  37 let quoted s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s
  38
  39 (* Cerca in una lista di assegnamenti (lista di coppie (path,path) dove path e'
  40 di tipo (string * string list) quello relativo alla proprietà p e ne
  41 restituisce la variabile a cui tale proprietà deve essere associata *)
  42 let rec search p = function
  43     [] -> ""
  44   | (path1,path2)::tl -> if (fst(path2) = p) then fst(path1)
  45                        else search p tl
  46 ;;
  47
  48
  49 let get_prop_id prop =
  50   if prop="refObj" then "F"
  51   else if prop="backPointer" then "B"
  52        else assert false
  53 ;;
  54
  55
  56 let relation_ex handle inv rop path rset assl =
  57   let relk = fst path in
  58   match relk with
  59
  60  (* Nota: mancano le inverse di refObj e backPointer!!!! *)
  61
  62 (* Notabis: ora per refObj si restituiscono tutti gli uri della tabella, nella diretta c'e` l'uri vuota *)
  63 (* Notater: quando non richiedo tutte le proprieta` della tabella quelle che non voglio mi vengono restituite lo stesso ma con nome vuoto *)
  64
  65     "refObj"
  66   | "backPointer" ->               (* proprieta` refObj e backPointer *)
  67 (*    print_endline "IN BACKPOINTER"; *)
  68     let prop = get_prop_id relk in
  69     if assl = [] then    (* se non ci sono assegnamenti *)
  70       let c = MQIConn.pgc handle in
  71       let rset_list =  (* lista di singoletti:resource_set di un elemento *)
  72       (List.fold_left (fun acc (uri,l) ->
  73         let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in
  74         let qq = "select uri from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
  75 (*      print_endline qq; *)
  76         let res = c#exec qq in
  77
  78         let l = (pgresult_to_string_list res) in
  79 (*      List.iter print_endline l; *)
  80         (List.map
  81          (function
  82                [uri] -> [(uri,[])]
  83              | _ -> assert false )
  84           res#get_list) @ acc
  85                       )
  86                 [] rset
  87       )
  88       in
  89       let rec edup = function
  90           [] -> []
  91         | rs1::tl -> union_ex rs1 (edup tl)
  92       in
  93       edup rset_list
  94
  95
  96     else               (* con assegnamenti *)
  97       let c = MQIConn.pgc handle in
  98       let rset_list =  (* lista di singoletti:resource_set di un elemento *)
  99       (List.fold_left (fun acc (uri,l) ->
 100         let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in
 101         let qq = "select uri, position, depth from t" ^ tv ^ " where prop_id='" ^ prop ^ "' order by uri asc" in
 102         print_endline qq;
 103         let res = c#exec qq in
 104         let pos = search "position" assl in
 105         let dep = search "depth" assl in
 106         if ((pos != "") && (dep != "")) then   (*caso in cui voglio sia position che depth*)
 107          (List.map
 108          (function
 109                [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
 110              | _ -> assert false )
 111           res#get_list) @ acc
 112         else
 113            if (dep = "") then                    (* voglio solo position *)
 114              (List.map
 115              (function
 116                   [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
 117                 | _ -> assert false )
 118              res#get_list) @ acc
 119             else                                 (* voglio solo depth *)
 120              (List.map
 121              (function
 122                   [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
 123                 | _ -> assert false )
 124              res#get_list) @ acc
 125
 126                         )
 127                 [] rset
 128       )
 129       in
 130       let rec edup = function
 131           [] -> []
 132         | rs1::tl -> union_ex rs1 (edup tl)
 133       in
 134       edup rset_list
 135
 136 (* Fine proprieta` refObj e backPointer *)
 137
 138   | "refRel" ->                        (* proprietà refRel *)
 139     if assl = [] then []    (* se non ci sono assegnamenti *)
 140 (*      let c = MQIConn.pgc handle in
 141       let rset_list =  (* lista di singoletti:resource_set di un elemento *)
 142       (List.fold_left (fun acc (uri,l) ->
 143         let qq = "select uri from hrefRel order by uri asc" in
 144         let res = c#exec qq in
 145         (List.map
 146          (function
 147                [uri] -> [(uri,[])]
 148              | _ -> assert false )
 149           res#get_list) @ acc
 150                       )
 151                 [] rset
 152       )
 153       in
 154       let rec edup = function
 155           [] -> []
 156         | rs1::tl -> union_ex rs1 (edup tl)
 157       in
 158       edup rset_list
 159 *)
 160
 161     else               (* con assegnamenti *)
 162       if inv then   (* INVERSA *)
 163         let c = MQIConn.pgc handle in
 164         let rset_list =  (* lista di singoletti:resource_set di un elemento *)
 165         (List.fold_left (fun acc (uri,l) ->
 166           let qq = "select uri, position, depth from hrefRel order by uri asc" in
 167           let res = c#exec qq in
 168           let pos = search "position" assl in
 169           let dep = search "depth" assl in
 170           if ((pos != "") && (dep != "")) then   (*caso in cui voglio sia position che depth*)
 171            (List.map
 172            (function
 173                  [uri;position;depth] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
 174                | _ -> assert false )
 175             res#get_list) @ acc
 176           else
 177              if (dep = "") then                    (* voglio solo position *)
 178                (List.map
 179                (function
 180                     [uri;position;depth] -> [(uri,[[((pos, []),[position])]])]
 181                   | _ -> assert false )
 182                res#get_list) @ acc
 183               else                                 (* voglio solo depth *)
 184                (List.map
 185                (function
 186                     [uri;position;depth] -> [(uri,[[((dep, []),[depth])]])]
 187                   | _ -> assert false )
 188                res#get_list) @ acc
 189
 190                         )
 191                   [] rset
 192         )
 193         in
 194         let rec edup = function
 195           [] -> []
 196           | rs1::tl -> union_ex rs1 (edup tl)
 197         in
 198         edup rset_list
 199       else                          (* DIRETTA, con risorsa nulla *)
 200         let c = MQIConn.pgc handle in
 201         let rset_list =  (* lista di singoletti:resource_set di un elemento *)
 202         (List.fold_left (fun acc (uri,l) ->
 203           let qq = "select position, depth from hrefRel order by uri asc" in
 204           let res = c#exec qq in
 205           let pos = search "position" assl in
 206           let dep = search "depth" assl in
 207           if ((pos != "") && (dep != "")) then   (*caso in cui voglio sia position che depth*)
 208            (List.map
 209            (function
 210                  [position;depth] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
 211                | _ -> assert false )
 212             res#get_list) @ acc
 213           else
 214              if (dep = "") then                    (* voglio solo position *)
 215                (List.map
 216                (function
 217                     [position;depth] -> [("",[[((pos, []),[position])]])]
 218                   | _ -> assert false )
 219                res#get_list) @ acc
 220               else                                 (* voglio solo depth *)
 221                (List.map
 222                (function
 223                     [position;depth] -> [("",[[((dep, []),[depth])]])]
 224                   | _ -> assert false )
 225                res#get_list) @ acc
 226
 227                         )
 228                   [] rset
 229         )
 230         in
 231         let rec edup = function
 232           [] -> []
 233           | rs1::tl -> union_ex rs1 (edup tl)
 234         in
 235         edup rset_list
 236
 237
 238
 239
 240
 241 (* Fine proprieta` refRel *)
 242
 243
 244
 245
 246   | "refSort" ->                    (* proprietà refSort *)
 247     if assl = [] then []   (* se non ci sono assegnamenti *)
 248 (*      let c = MQIConn.pgc handle in
 249       let rset_list =  (* lista di singoletti:resource_set di un elemento *)
 250       (List.fold_left (fun acc (uri,l) ->
 251         let qq = "select uri from hrefSort order by uri asc" in
 252         let res = c#exec qq in
 253         (List.map
 254          (function
 255                [uri] -> [(uri,[])]
 256              | _ -> assert false )
 257           res#get_list) @ acc
 258
 259                       )
 260                 [] rset
 261       )
 262       in
 263       let rec edup = function
 264           [] -> []
 265         | rs1::tl -> union_ex rs1 (edup tl)
 266       in
 267       edup rset_list
 268 *)
 269
 270
 271      else               (* con assegnamenti *)
 272        if inv then                               (*INVERSA ----> SISTEMARE: vedi refRel!!!!*)
 273          let c = MQIConn.pgc handle in
 274          let rset_list =  (* lista di singoletti:resource_set di un elemento *)
 275          (List.fold_left (fun acc (uri,l) ->
 276            let qq = "select uri, position, depth, sort from hrefSort order by uri asc" in
 277            let res = c#exec qq in
 278            let pos = search "position" assl in
 279            let dep = search "depth" assl in
 280            let sor = search "sort" assl in
 281            if ((pos != "") && (dep != "") && (sor != "")) then   (*caso in cui
 282            voglio position, depth e sort*)
 283             (List.map
 284             (function
 285                   [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
 286                 | _ -> assert false )
 287              res#get_list) @ acc
 288            else
 289               if ((dep = "") && (sor = "")) then          (* voglio solo position *)
 290                 (List.map
 291                 (function
 292                      [uri;position;depth;sort] -> [(uri,[[((pos, []),[position])]])]
 293                    | _ -> assert false )
 294                 res#get_list) @ acc
 295
 296               else
 297                 if ((pos = "") && (sor = "")) then         (* voglio solo depth *)
 298                 (List.map
 299                 (function
 300                      [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth])]])]
 301                    | _ -> assert false )
 302                 res#get_list) @ acc
 303
 304               else
 305               if ((pos = "") && (dep = "")) then   (* voglio solo sort *)
 306                 (List.map
 307                 (function
 308                      [uri;position;depth;sort] -> [(uri,[[((sor, []),[sort])]])]
 309                    | _ -> assert false )
 310                 res#get_list) @ acc
 311
 312                    else
 313               if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e           sort*)
 314                 (List.map
 315                 (function
 316                      [uri;position;depth;sort] -> [(uri,[[((dep, []),[depth]);((sor, []),[sort])]])]
 317                    | _ -> assert false )
 318                 res#get_list) @ acc
 319
 320               else
 321               if((pos != "") && (dep = "") && (sor != "")) then (*voglio
 322               position e sort*)
 323                 (List.map
 324                 (function
 325                      [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((sor, []),[sort])]])]
 326                    | _ -> assert false )
 327                 res#get_list) @ acc
 328
 329               else
 330             (*  if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
 331              position e depth*)
 332                 (List.map
 333                 (function
 334                      [uri;position;depth;sort] -> [(uri,[[((pos, []),[position]);((dep, []),[depth])]])]
 335                    | _ -> assert false )
 336                 res#get_list) @ acc
 337
 338                      )
 339                    [] rset
 340          )
 341          in
 342          let rec edup = function
 343              [] -> []
 344            | rs1::tl -> union_ex rs1 (edup tl)
 345          in
 346          edup rset_list
 347
 348       else       (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*)
 349          let c = MQIConn.pgc handle in
 350          let rset_list =  (* lista di singoletti:resource_set di un elemento *)
 351          (List.fold_left (fun acc (uri,l) ->
 352            let qq = "select position, depth, sort from hrefSort order by uri asc" in
 353            let res = c#exec qq in
 354            let pos = search "position" assl in
 355            let dep = search "depth" assl in
 356            let sor = search "sort" assl in
 357            if ((pos != "") && (dep != "") && (sor != "")) then   (*caso in cui
 358            voglio position, depth e sort*)
 359             (List.map
 360             (function
 361                   [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth]);((sor, []),[sort])]])]
 362                 | _ -> assert false )
 363              res#get_list) @ acc
 364            else
 365               if ((dep = "") && (sor = "")) then          (* voglio solo position *)
 366                 (List.map
 367                 (function
 368                      [position;depth;sort] -> [("",[[((pos, []),[position])]])]
 369                    | _ -> assert false )
 370                 res#get_list) @ acc
 371
 372               else
 373                 if ((pos = "") && (sor = "")) then         (* voglio solo depth *)
 374                 (List.map
 375                 (function
 376                      [position;depth;sort] -> [("",[[((dep, []),[depth])]])]
 377                    | _ -> assert false )
 378                 res#get_list) @ acc
 379
 380               else
 381               if ((pos = "") && (dep = "")) then   (* voglio solo sort *)
 382                 (List.map
 383                 (function
 384                      [position;depth;sort] -> [("",[[((sor, []),[sort])]])]
 385                    | _ -> assert false )
 386                 res#get_list) @ acc
 387
 388                    else
 389               if ((pos = "") && (dep != "") && (sor != "")) then (*voglio depth e           sort*)
 390                 (List.map
 391                 (function
 392                      [position;depth;sort] -> [("",[[((dep, []),[depth]);((sor, []),[sort])]])]
 393                    | _ -> assert false )
 394                 res#get_list) @ acc
 395
 396               else
 397               if((pos != "") && (dep = "") && (sor != "")) then (*voglio
 398               position e sort*)
 399                 (List.map
 400                 (function
 401                      [position;depth;sort] -> [("",[[((pos, []),[position]);((sor, []),[sort])]])]
 402                    | _ -> assert false )
 403                 res#get_list) @ acc
 404
 405               else
 406             (*  if ((pos != "") && (dep != "") && (sor = "")) then*) (*voglio
 407              position e depth*)
 408                 (List.map
 409                 (function
 410                      [position;depth;sort] -> [("",[[((pos, []),[position]);((dep, []),[depth])]])]
 411                    | _ -> assert false )
 412                 res#get_list) @ acc
 413
 414                      )
 415                    [] rset
 416          )
 417          in
 418          let rec edup = function
 419              [] -> []
 420            | rs1::tl -> union_ex rs1 (edup tl)
 421          in
 422          edup rset_list
 423
 424
 425
 426 (* Fine proprieta` refSort *)
 427
 428
 429
 430   | _ -> []
 431
 432 ;;
 433
 434
 435
 436 (**** IMPLEMENTAZIONE DELLA RELATION PER GALAX ****)
 437
 438
 439 (* trasforma un uri in un filename *)
 440 let tofname uri =
 441     if String.contains uri ':' then
 442       (let len = String.length uri in
 443        let scuri = String.sub uri 4 (len-4) in (*tolgo cic:*)
 444        if String.contains scuri '#' then
 445          (let pos = String.index scuri '#' in
 446           let s1 = Str.string_before scuri pos in
 447           let xp = Str.string_after scuri pos in
 448           let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in
 449           let xp = Str.global_replace (Str.regexp "\/") "," xp in
 450           let xp = Str.global_replace (Str.regexp ")") "" xp in
 451           let fname = (s1 ^ xp) in
 452           fname)
 453        else
 454          scuri)
 455     else uri
 456
 457
 458 (* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di resource *)
 459 let rec rsetl uril vvar =
 460     match uril with
 461     | uri::tl -> let scuri = (*tofname*) uri in
 462                    [(scuri, [[((vvar, []), [(List.hd tl)])]])]::(rsetl (List.tl tl) vvar)
 463     | [] -> []
 464
 465
 466 (* 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" *)
 467 let muse path assl r =
 468         let vvar = if assl = [] then "position"
 469                    else List.hd assl
 470         in
 471         let uri = fst r in
 472         let furi = tofname uri in
 473         let dtag = fst path in
 474         let dir =
 475           match dtag with
 476               "refObj" -> "/projects/helm/metadata/create4/forward"
 477             | _ -> "/projects/helm/metadata/create4/backward"
 478         in
 479         let xq ="namespace h=\"http://www.cs.unibo.it/helm/schemas/mattone.rdf#\"
 480                 namespace rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
 481                 for $i in document(" ^ "\"" ^ dir ^ furi ^ ".xml" ^ "\"" ^
 482                 ")/rdf:RDF/h:Object/h:" ^ dtag ^ "/h:Occurrence
 483                 return ($i/h:occurrence, $i/h:position)"
 484
 485         in
 486         let uril = Toputils.eval_query_string xq in (* e' una lista di liste di stringhe*)
 487         let  hd_uril = List.hd uril in(*prendo la testa che contiene altern. lista di uri e pos. *)
 488         let rset_list = rsetl hd_uril vvar in (* da hd_uril costruisco una lista di resource_set(singoletti)*)
 489         let rec edup = function
 490             [] -> []
 491           | rs1::tl -> union_ex rs1 (edup tl)
 492         in
 493         edup rset_list
 494
 495
 496
 497
 498 (* 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
 499 NOTA: "rop" per ora non viene usato perche' vale sempre "ExactOp" *)
 500 let relation_galax_ex handle inv rop path rset assl = []
 501
 502 (*
 503
 504   List.stable_sort (fun (uri1,l1) (uri2,l2) -> compare uri1 uri2) (List.concat (List.map (muse path assl) rset))
 505
 506 *)