/pliant/storage/database/inmemory.pli
 
 1  abstract 
 2    [The methods used to access datas stored in the main memory.] 
 3   
 4  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 5  # 
 6  # This program is free software; you can redistribute it and/or 
 7  # modify it under the terms of the GNU General Public License version 2 
 8  # as published by the Free Software Foundation. 
 9  # 
 10  # This program is distributed in the hope that it will be useful, 
 11  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 12  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 13  # GNU General Public License for more details. 
 14  # 
 15  # You should have received a copy of the GNU General Public License 
 16  # version 2 along with this program; if not, write to the Free Software 
 17  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 18   
 19  scope "/pliant/storage/" "/pliant/appli/" 
 20  module "/pliant/language/compiler.pli" 
 21  module "/pliant/language/data/string_cast.pli" 
 22  module "/pliant/util/encoding/html.pli" 
 23  module "prototype.pli" 
 24  module "interface.pli" 
 25  module "set.pli" 
 26   
 27  public 
 28   
 29   
 30 
 
 31   
 32   
 33  type DataField 
 34    field Link:Type type 
 35     
 36  DataInterface_ maybe DataField 
 37   
 38   
 39  method df type d -> t 
 40    oarg DataField df ; arg Data_ d ; arg_R Type t 
 41    :> df type 
 42   
 43  method df get d adr type -> status 
 44    oarg DataField df ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 45    if type=df:type 
 46      type copy_instance d:adr adr 
 47      status := success 
 48    else 
 49      var Str := to_string d:adr df:type "db" 
 50      status := from_string adr type "db" 
 51   
 52  method df set d adr type -> status 
 53    oarg_rw DataField df ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 54    if type=df:type 
 55      type copy_instance adr d:adr 
 56      status := success 
 57    else 
 58      var Str := to_string adr type "db" 
 59      status := from_string d:adr df:type "db" 
 60    if status=success 
 61      d:base notify_set d:adr df:type 
 62   
 63  method df get_raw d adr type -> status 
 64    oarg DataField df ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 65    if type=df:type 
 66      type copy_instance d:adr adr 
 67      status := success 
 68    else 
 69      var Str := to_string d:adr df:type "raw" 
 70      status := from_string adr type "raw" 
 71   
 72  method df set_raw d adr type -> status 
 73    oarg_rw DataField df ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 74    if type=df:type 
 75      type copy_instance adr d:adr 
 76      status := success 
 77    else 
 78      var Str := to_string adr type "raw" 
 79      status := from_string d:adr df:type "raw" 
 80    if status=success 
 81      d:base notify_set d:adr df:type 
 82   
 83  method df reset d -> status 
 84    oarg_rw DataField df ; arg_rw Data_ d ; arg Status status 
 85    df:type destroy_instance d:adr 
 86    df:type build_instance d:adr 
 87    d:base notify_reset d 
 88    status := success 
 89   
 90   
 91 
 
 92   
 93   
 94  type DataRecordFieldDef 
 95    field Pointer:DataInterface_ record_interface 
 96    field Int offset 
 97    field Link:DataInterface_ interface 
 98    field Str path 
 99    field Arrow default 
 100   
 101  type DataRecord 
 102    field Link:Type type 
 103    field Dictionary fields 
 104    field List all_fields 
 105     
 106  DataInterface_ maybe DataRecord 
 107   
 108   
 109  method dr reset d -> status 
 110    oarg_rw DataRecord dr ; arg_rw Data_ d ; arg Status status 
 111    dr:type destroy_instance d:adr 
 112    dr:type build_instance d:adr 
 113    d:base notify_reset d 
 114    status := success 
 115   
 116   
 117  method f apply d d2 
 118    arg DataRecordFieldDef f ; arg Data_ d ; arg_w Data_ d2 
 119    d2 adr := d:adr translate Byte f:offset 
 120    d2 object := object 
 121    d2 interface :> interface 
 122    d2 base :> base 
 123    if (addressof d:path2)=null 
 124      d2 path1 :> path1 
 125      d2 path2 :> path 
 126    else 
 127      d2 path1 :> new Str d:path1+d:path2+f:path 
 128      d2 path2 :> null map Str 
 129   
 130  method dr search d k -> d2 
 131    oarg DataRecord dr ; arg Data_ d ; arg Str k ; arg Data_ d2 
 132    var Pointer:Arrow :> dr:fields first k 
 133    if a<>null 
 134      (map DataRecordFieldDef) apply d2 
 135    else 
 136      d2 := data_null 
 137      d2 base :> base 
 138      d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 139      d2 path2 :> null map Str 
 140   
 141  method dr next d start stop buf -> d2 
 142    oarg DataRecord dr ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2 
 143    var Pointer:Arrow a 
 144    if buf:adr<>null 
 145      :> dr:all_fields next (buf:adr map Arrow) 
 146    else 
 147      :> dr:all_fields first 
 148    while a<>null 
 149      var Pointer:DataRecordFieldDef :> map DataRecordFieldDef 
 150      if (start:len=or html_decode:(f:path f:path:len)>=start) and (stop:len=or html_decode:(f:path f:path:len)<stop) 
 151        apply d2 
 152        buf adr := addressof a 
 153        return 
 154      :> dr:all_fields next a 
 155    d2 adr := null 
 156   
 157  method dr first d start stop buf -> d2 
 158    oarg DataRecord dr ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2 
 159    buf adr := null 
 160    d2 := dr next start stop buf 
 161   
 162  method dr count d start stop -> count 
 163    oarg_rw DataRecord dr ; arg Data_ d ; arg Str start stop ; arg Int count 
 164    if start:len=and stop:len=0 
 165      count := dr:fields count 
 166    else 
 167      count := 0 
 168      var Pointer:Arrow :> dr:all_fields first 
 169      while c<>null 
 170        var Pointer:DataRecordFieldDef :> map DataRecordFieldDef 
 171        if (start:len=or html_decode:(f:path f:path:len)>=start) and (stop:len=or html_decode:(f:path f:path:len)<stop) 
 172          count += 1 
 173        :> dr:all_fields next c 
 174   
 175  if false 
 176    method dr set d adr type -> status 
 177      oarg_rw DataRecord dr ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 178      if type=Str and (adr map Str)="" 
 179        dr:type destroy_instance d:adr 
 180        dr:type build_instance d:adr 
 181        status := success 
 182      else 
 183        status := failure 
 184   
 185   
 186 
 
 187   
 188   
 189  type DataTable 
 190    field Link:DataInterface_ value_interface 
 191    field Link:Type value_type 
 192    field Link:Type node_type 
 193     
 194  DataInterface_ maybe DataTable 
 195   
 196   
 197  method dt reset d -> status 
 198    oarg_rw DataTable dt ; arg_rw Data_ d ; arg Status status 
 199    var Pointer:Index_ idx :> d:adr map Index_ 
 200    idx reset dt:node_type true 
 201    d:base notify_reset d 
 202    status := success 
 203   
 204   
 205  method dt search d k -> d2 
 206    oarg DataTable dt ; arg Data_ d ; arg Str k ; arg Data_ d2 
 207    var Pointer:Index_ idx :> d:adr map Index_ 
 208    var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 209    if cursor<>null 
 210      d2 adr := cursor 
 211      d2 object := cursor translate Byte -(Str:size+IndexNode_:size) 
 212      d2 interface :> dt value_interface 
 213    else 
 214      d2 := data_null 
 215    d2 base :> base 
 216    d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 217    d2 path2 :> null map Str 
 218   
 219  method dt first d start stop buf -> d2 
 220    oarg DataTable dt ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2 
 221    var Pointer:Index_ idx :> d:adr map Index_ 
 222    var Address cursor 
 223    if start:len=0 
 224      cursor := idx first IndexNode_:size+Str:size 
 225    else 
 226      cursor := idx from addressof:start (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 227    d2 adr := cursor 
 228    if cursor<>null 
 229      d2 object := cursor translate Byte -(Str:size+IndexNode_:size) 
 230      d2 interface :> dt value_interface 
 231      d2 base :> base 
 232      var Pointer:Str :> (cursor translate Str -1) map Str 
 233      d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 234      d2 path2 :> null map Str 
 235      buf adr := cursor 
 236   
 237  method dt next d start stop buf -> d2 
 238    oarg DataTable dt ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2 
 239    var Pointer:Index_ idx :> d:adr map Index_ 
 240    if (idx is_deleted buf:adr IndexNode_:size+Str:size) 
 241      var Str key := (buf:adr translate Str -1) map Str 
 242      # console "automatic recovery of deleted key " key eol 
 243      d2 := dt first key stop buf 
 244      if d2:adr<>null and d2:key=key 
 245        d2 := dt next start stop buf 
 246      return 
 247    var Address cursor := idx next buf:adr IndexNode_:size+Str:size 
 248    if cursor=null 
 249      d2 adr := null 
 250      return 
 251    var Pointer:Str :> (cursor translate Str -1) map Str 
 252    if stop:len>and k>=stop 
 253      d2 adr := null 
 254      return 
 255    d2 adr := cursor 
 256    d2 object := cursor translate Byte -(Str:size+IndexNode_:size) 
 257    d2 interface :> dt value_interface 
 258    d2 base :> base 
 259    var Pointer:Str :> (cursor translate Str -1) map Str 
 260    d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 261    d2 path2 :> null map Str 
 262    buf adr := cursor 
 263   
 264  method dt count d start stop -> count 
 265    oarg_rw DataTable dt ; arg Data_ d ; arg Str start stop ; arg Int count 
 266    var Pointer:Index_ idx :> d:adr map Index_ 
 267    if start:len=and stop:len=0 
 268      count := idx size 
 269    else 
 270      # highly suboptimal implementation 
 271      count := 0 
 272      var Data_ cur := dt first start stop (var DataScanBuffer buf) 
 273      while cur:adr<>null 
 274        var Data_ cur := dt next start stop buf 
 275        count += 1 
 276   
 277   
 278  method dt create d k -> status 
 279    oarg_rw DataTable dt ; arg_rw Data_ d ; arg Str k; arg Status status 
 280    var Pointer:Index_ idx :> d:adr map Index_ 
 281    var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 282    if cursor=null 
 283      idx insert addressof:false null (the_function compare Str Str -> Int) Str:size+IndexNode_:size Str dt:value_type dt:node_type true 
 284      d:base notify_create k 
 285      status := success 
 286    else 
 287      status := failure 
 288   
 289  method dt delete d k -> status 
 290    oarg_rw DataTable dt ; arg_rw Data_ d ; arg Str k; arg Status status 
 291    var Pointer:Index_ idx :> d:adr map Index_ 
 292    var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 293    if cursor<>null 
 294      dt:value_interface pre_delete k 
 295      idx remove cursor IndexNode_:size+Str:size dt:node_type true 
 296      d:base notify_delete k 
 297      status := success 
 298    else 
 299      status := failure 
 300   
 301   
 302 
 
 303   
 304   
 305  type Anything 
 306    field Str value 
 307    field Index_ index 
 308   
 309  (addressof:Anything map Type) flags := Anything:flags .or. type_flag_field 
 310   
 311  type AnythingNode 
 312    field IndexNode_ node 
 313    field Str key 
 314    field Anything value 
 315   
 316  type DataAnything 
 317    field Link:DataInterface_ value_interface 
 318    field Link:Type value_type 
 319    field Link:Type node_type 
 320     
 321  DataInterface_ maybe DataAnything 
 322   
 323  function destroy a 
 324    arg_w Anything a 
 325    a:index reset AnythingNode true 
 326   
 327   
 328  method da type d -> t 
 329    oarg DataAnything da ; arg Data_ d ; arg_R Type t 
 330    :> Str 
 331   
 332  method da get d adr type -> status 
 333    oarg DataAnything da ; arg Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 334    status := from_string adr type (d:adr map Anything):value "db" 
 335   
 336  method da set d adr type -> status 
 337    oarg_rw DataAnything da ; arg_rw Data_ d ; arg Address adr ; arg Type type ; arg Status status 
 338    (d:adr map Anything) value := to_string adr type "db" 
 339    d:base notify_set d:adr Str 
 340    status := success 
 341   
 342  method da reset d -> status 
 343    oarg_rw DataAnything da ; arg_rw Data_ d ; arg Status status 
 344    (d:adr map Anything) value := "" 
 345    var Pointer:Index_ idx :> (d:adr map Anything) index 
 346    idx reset AnythingNode true 
 347    d:base notify_reset d 
 348    status := success 
 349   
 350   
 351  method da search d k -> d2 
 352    oarg DataAnything da ; arg Data_ d ; arg Str k ; arg Data_ d2 
 353    var Pointer:Index_ idx :> (d:adr map Anything) index 
 354    var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 355    if cursor<>null 
 356      d2 adr := cursor 
 357      d2 object := cursor translate Byte -(Str:size+IndexNode_:size) 
 358      d2 interface :> da 
 359    else 
 360      d2 := data_null 
 361    d2 base :> base 
 362    d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 363    d2 path2 :> null map Str 
 364   
 365  method da first d start stop buf -> d2 
 366    oarg DataAnything da ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2 
 367    var Pointer:Index_ idx :> (d:adr map Anything) index 
 368    var Address cursor 
 369    if start:len=0 
 370      cursor := idx first IndexNode_:size+Str:size 
 371    else 
 372      cursor := idx from addressof:start (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 373    d2 adr := cursor 
 374    if cursor<>null 
 375      d2 object := cursor translate Byte -(Str:size+IndexNode_:size) 
 376      d2 interface :> da 
 377      d2 base :> base 
 378      var Pointer:Str :> (cursor translate Str -1) map Str 
 379      d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 380      d2 path2 :> null map Str 
 381      buf adr := cursor 
 382   
 383  method da next d start stop buf -> d2 
 384    oarg DataAnything da ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2 
 385    var Pointer:Index_ idx :> (d:adr map Anything) index 
 386    if (idx is_deleted buf:adr IndexNode_:size+Str:size) 
 387      var Str key := (buf:adr translate Str -1) map Str 
 388      # console "automatic recovery of deleted key " key eol 
 389      d2 := da first key stop buf 
 390      if d2:adr<>null and d2:key=key 
 391        d2 := da next start stop buf 
 392      return 
 393    var Address cursor := idx next buf:adr IndexNode_:size+Str:size 
 394    if cursor=null 
 395      d2 adr := null 
 396      return 
 397    var Pointer:Str :> (cursor translate Str -1) map Str 
 398    if stop:len>and k>=stop 
 399      d2 adr := null 
 400      return 
 401    d2 adr := cursor 
 402    d2 object := cursor translate Byte -(Str:size+IndexNode_:size) 
 403    d2 interface :> da 
 404    d2 base :> base 
 405    var Pointer:Str :> (cursor translate Str -1) map Str 
 406    d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 407    d2 path2 :> null map Str 
 408    buf adr := cursor 
 409   
 410  method da count d start stop -> count 
 411    oarg_rw DataAnything da ; arg Data_ d ; arg Str start stop ; arg Int count 
 412    var Pointer:Index_ idx :> (d:adr map Anything) index 
 413    if start:len=and stop:len=0 
 414      count := idx size 
 415    else 
 416      # highly suboptimal implementation 
 417      count := 0 
 418      var Data_ cur := da first start stop (var DataScanBuffer buf) 
 419      while cur:adr<>null 
 420        var Data_ cur := da next start stop buf 
 421        count += 1 
 422   
 423   
 424  method da create d k -> status 
 425    oarg_rw DataAnything da ; arg_rw Data_ d ; arg Str k; arg Status status 
 426    var Pointer:Index_ idx :> (d:adr map Anything) index 
 427    var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 428    if cursor=null 
 429      idx insert addressof:false null (the_function compare Str Str -> Int) Str:size+IndexNode_:size Str Anything AnythingNode true 
 430      d:base notify_create k 
 431      status := success 
 432    else 
 433      status := failure 
 434   
 435  method da delete d k -> status 
 436    oarg_rw DataAnything da ; arg_rw Data_ d ; arg Str k; arg Status status 
 437    var Pointer:Index_ idx :> (d:adr map Anything) index 
 438    var Address cursor := idx first addressof:k (the_function compare Str Str -> Int) IndexNode_:size+Str:size 
 439    if cursor<>null 
 440      idx remove cursor IndexNode_:size+Str:size AnythingNode true 
 441      d:base notify_delete k 
 442      status := success 
 443    else 
 444      status := failure 
 445   
 446   
 447 
 
 448   
 449  doc 
 450    [The 'interface' function will return an object that implements 'DataInterface_' generic methods, and that will be used to map an object with the type provided as the argument.] 
 451   
 452   
 453  function inmemory_interface t -> di 
 454    arg Type t ; arg Link:DataInterface_ di 
 455    var DataKind := data_kind t 
 456    if t=Anything 
 457      di :> new DataAnything 
 458    eif k=data_field 
 459      var Link:DataField df :> new DataField 
 460      df type :> t 
 461      di :> df 
 462    eif k=data_record 
 463      var Link:DataRecord dr :> new DataRecord 
 464      dr type :> t 
 465      var (Index Str Arrow) order 
 466      for (var Int i) t:nb_fields-1 
 467        var Link:DataRecordFieldDef :> new DataRecordFieldDef 
 468        record_interface :> dr 
 469        offset := (field i) offset 
 470        interface :> data_interface (field i):type 
 471        path := "/"+(html_encode (field i):name) 
 472        default := (field i) initial_value 
 473        dr:fields insert (field i):name false addressof:f 
 474        var Arrow := addressof f 
 475        order insert (field i):name a 
 476      var Pointer:Arrow :> order first 
 477      while addressof:c<>null 
 478        dr:all_fields append c 
 479        :> order next c 
 480      di :> dr 
 481    eif k=data_set 
 482      var Pointer:Type :> value_type 
 483      var Link:DataTable dt :> new DataTable 
 484      dt value_interface :> data_interface v 
 485      dt value_type :> v 
 486      dt node_type :> ('pliant data setnode types' query addressof:null) map Type 
 487      di :> dt 
 488   
 489  data_interface_generators append addressof:(the_function inmemory_interface Type -> Link:DataInterface_)