/pliant/storage/database/mount.pli
 
 1  abstract 
 2    [This will handle the tree that is used to provide all databases as a single datas tree, just like in Unix, all files in all filesystems are provided as a single tree.] 
 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/util/encoding/html.pli" 
 22  module "prototype.pli" 
 23   
 24   
 25 
 
 26   
 27   
 28  type DataMount 
 29    void 
 30     
 31  DataInterface_ maybe DataMount 
 32   
 33   
 34  method dm search d k -> d2 
 35    oarg DataMount dm ; arg Data_ d ; arg Str k ; arg Data_ d2 
 36    var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k 
 37    if exists:cursor 
 38      if entry_type:cursor=(Index Str Arrow) 
 39        d2 adr := cursor 
 40        d2 object := cursor 
 41        d2 interface :> interface 
 42      else 
 43        (cursor omap Database_) get_root d2 
 44        return 
 45    else 
 46      d2 := data_null 
 47    d2 base :> base 
 48    d2 path1 :> new Str d:dbpath+"/"+html_encode:k 
 49    d2 path2 :> null map Str 
 50   
 51  method dm first d start stop buf -> d2 
 52    oarg DataMount dm ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2 
 53    var Pointer:Arrow cursor 
 54    if start:len=0 
 55      cursor :> (d:adr map (Index Str Arrow)) first 
 56    else 
 57      cursor :> (d:adr map (Index Str Arrow)) from start 
 58    if not exists:cursor 
 59      d2 adr := null 
 60      return 
 61    if entry_type:cursor=(Index Str Arrow) 
 62      d2 adr := cursor 
 63      d2 object := cursor 
 64      d2 interface :> interface 
 65    else 
 66      (cursor omap Database_) get_root d2 
 67    d2 path1 :> new Str d:dbpath+"/"+html_encode:((d:adr map (Index Str Arrow)) key cursor) 
 68    d2 path2 :> null map Str 
 69    buf adr := addressof cursor 
 70   
 71  method dm next d start stop buf -> d2 
 72    oarg DataMount dm ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2 
 73    var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) next (buf:adr map Arrow) 
 74    if not exists:cursor 
 75      d2 adr := null 
 76      return 
 77    if stop:len>and ((d:adr map (Index Str Arrow)) key cursor)>=stop 
 78      d2 adr := null 
 79      return 
 80    if entry_type:cursor=(Index Str Arrow) 
 81      d2 adr := cursor 
 82      d2 object := cursor 
 83      d2 interface :> interface 
 84    else 
 85      (cursor omap Database_) get_root d2 
 86    d2 path1 :> new Str d:dbpath+"/"+html_encode:((d:adr map (Index Str Arrow)) key cursor) 
 87    d2 path2 :> null map Str 
 88    buf adr := addressof cursor 
 89   
 90  method dm count d start stop -> count 
 91    oarg_rw DataMount dm ; arg Data_ d ; arg Str start stop ; arg Int count 
 92    var Pointer:Index_ idx :> d:adr map Index_ 
 93    if start:len=and stop:len=0 
 94      count := (d:adr map (Index Str Arrow)) size 
 95    else 
 96      # FIXME 
 97      void 
 98   
 99   
 100  method dm create d k -> status 
 101    oarg_rw DataMount dm ; arg_rw Data_ d ; arg Str k; arg Status status 
 102    var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k 
 103    if not exists:cursor 
 104      var Arrow := entry_new (Index Str Arrow) 
 105      (d:adr map (Index Str Arrow)) insert a 
 106      status := success 
 107    else 
 108      status := failure 
 109   
 110  method dm delete d k -> status 
 111    oarg_rw DataMount dm ; arg_rw Data_ d ; arg Str k; arg Status status 
 112    var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k 
 113    if exists:cursor 
 114      (d:adr map (Index Str Arrow)) remove cursor 
 115      status := success 
 116    else 
 117      status := failure 
 118   
 119   
 120 
 
 121   
 122  type DatabaseMount 
 123    field Database_ common 
 124    field Sem real_sem 
 125   
 126  Database_ maybe DatabaseMount 
 127   
 128   
 129  function build dm 
 130    arg_w DatabaseMount dm 
 131    dm:common sem :> dm real_sem 
 132   
 133  gvar DatabaseMount database_root 
 134   
 135  gvar Data_ data_root := data_null 
 136  data_root object := entry_new (Index Str Arrow) 
 137  data_root adr := data_root object 
 138  data_root interface :> new DataMount 
 139  data_root base :> database_root 
 140  data_root path1 :> "" 
 141  data_root path2 :> null map Str 
 142   
 143  method dm get_root d 
 144    arg DatabaseMount dm ; arg_w Data_ d 
 145    := data_root 
 146   
 147   
 148  function data_mount db path 
 149    oarg_rw Database_ db ; arg Str path 
 150    data_root:base:sem request 
 151    db path := path 
 152    var Str := path 
 153    var Data_ := data_root 
 154    while (parse "/" any:(var Str k) "/" any:(var Str remain)) 
 155      var Data_ d2 := d:interface search html_decode:true 
 156      := d2 ; := "/"+remain 
 157    if (parse "/" any:(var Str k)) 
 158      var Pointer:(Index Str Arrow) index :> d:adr map (Index Str Arrow) 
 159      var Pointer:Arrow :> index first html_decode:k 
 160      if exists:c 
 161        if entry_type:c<>(Index Str Arrow) 
 162          (map Database_) path := "" 
 163        index remove c 
 164      var Arrow := addressof db 
 165      index insert html_decode:a 
 166    data_root:base:sem release 
 167   
 168   
 169  function data_umount path -> status 
 170    arg Str path ; arg Status status 
 171    database_root:sem request 
 172    var Str := path 
 173    var Data_ := data_root 
 174    while (parse "/" any:(var Str k) "/" any:(var Str remain)) 
 175      var Data_ d2 := d:interface search html_decode:false 
 176      := d2 ; := "/"+remain 
 177    if (parse "/" any:(var Str k)) 
 178      status := d:interface delete html_decode:k 
 179      if (d:interface count "" "")=0 
 180        data_root:base:sem release 
 181        data_umount (path 0 (path search_last "/" 0)) 
 182        return 
 183    else 
 184      status := failure 
 185    database_root:sem release 
 186   
 187   
 188  export data_root 
 189  export data_mount data_umount