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