/pliant/storage/database/io.pli
 
 1  abstract 
 2    [Handles datas stored in a file, using HTML like tags.] 
 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   
 20  module "/pliant/language/compiler.pli" 
 21  module "/pliant/language/stream.pli" 
 22  module "/pliant/language/stream/filesystembase.pli" 
 23  module "/pliant/admin/file.pli" 
 24  module "prototype.pli" 
 25  module "/pliant/util/encoding/html.pli" 
 26   
 27  constant optimized_loader true 
 28  public 
 29    constant database_line_limit 2^24 
 30   
 31   
 32  method d direct_search_path path createit -> d2 
 33    arg_rw Data_ d ; arg Str path ; arg CBool createit ; arg Data_ d2 
 34    d2 := d 
 35    var Str := path 
 36    while (parse "/" any:(var Str k) "/" any:(var Str remain)) 
 37      d2 := d2:interface search d2 html_decode:createit 
 38      := "/"+remain 
 39    if (parse "/" any:(var Str k)) 
 40      d2 := d2:interface search d2 html_decode:createit 
 41   
 42   
 43 
 
 44   
 45   
 46  public 
 47    gvar Sem database_store_sem 
 48   
 49  function stop_storing p 
 50    arg Address p 
 51    database_store_sem request 
 52  gvar DelayedAction stop 
 53  stop function :> the_function stop_storing Address 
 54  pliant_shutdown_actions append addressof:stop 
 55   
 56  function restart_storing p 
 57    arg Address p 
 58    database_store_sem release 
 59  gvar DelayedAction restart 
 60  restart function :> the_function restart_storing Address 
 61  pliant_wakeup_actions append addressof:restart 
 62   
 63   
 64  method d store s 
 65    arg Data_ d ; arg_rw Stream s 
 66    if (d:interface get_raw addressof:(var Str value) Str)=success 
 67      writeline "<pdata path=[dq]"+d:dbpath+"[dq]>"+html_encode:value+"</pdata>" 
 68    var Data_ cur := d:interface first_to_store "" "" (var DataScanBuffer buf) 
 69    while cur:adr<>null 
 70      cur store s 
 71      cur := d:interface next_to_store "" "" buf 
 72   
 73  method db do_store filename -> status 
 74    oarg_rw Database_ db ; arg Str filename ; arg Status status 
 75    if not database_store_sem:nowait_rd_request 
 76      return failure 
 77    part store "store database "+filename 
 78      db get_root (var Data_ d) 
 79      var Link:Stream :> new Stream 
 80      open filename+".tmp" out+safe 
 81      safe_configure "journal" 
 82      if db:flags:database_compressed 
 83        writeline "<zlib>" 
 84        (var Stream z) open "zlib:" "" out+safe pliant_default_file_system s 
 85        store z 
 86        flush sync 
 87        status := shunt z:close=success and s:close=success success failure 
 88      else 
 89        store s 
 90        flush sync 
 91        status := shunt s:close=success success failure 
 92      if status=success 
 93        file_delete filename 
 94        file_move filename+".tmp" filename 
 95        file_directory_flush filename 
 96      else 
 97        file_delete filename+".tmp" 
 98    database_store_sem rd_release 
 99   
 100   
 101 
 
 102   
 103   
 104  method d load s base_size -> status 
 105    arg_rw Data_ d ; arg_rw Stream s ; arg_w Intn base_size ; arg Status status 
 106    status := success ; base_size := undefined 
 107    line_limit := database_line_limit 
 108    if optimized_loader 
 109      var Array:Data_ cache 
 110      cache size := 1 
 111      cache := d 
 112      var Int level := 0 
 113    while not s:atend 
 114      # if s:line_number%10000=0 
 115      #   console "line " s:line_number "            [cr]" 
 116      var Str := readline 
 117      if (eparse "<pdata path=[dq]" any:(var Str path) "[dq]" any ">" any:(var Str value) "</pdata>") 
 118        if optimized_loader 
 119          if level>0 
 120            level -= 1 
 121          while level>and { var Pointer:Data_ d0 :> cache level ; (path d0:path1:len)<>d0:path1 or (path d0:path1:len 1)<>"/" or (addressof d0:base)<>(addressof d:base) } 
 122            level -= 1 
 123          var Int cur := cache:level:path1:len 
 124          while cur<path:len and path:cur="/" and { var Int next := ((path cur+path:len) search "/" -1)+cur+1 ; next>cur } 
 125            if level+1>=cache:size 
 126              cache size += 1 
 127            var Pointer:Data_ d0 :> cache level 
 128            var Pointer:Data_ d1 :> cache level+1 
 129            d1 := d0:interface search d0 html_decode:(path cur+next-cur-1) true 
 130            if (exists d1:path2) 
 131              d1 path1 :> new Str d1:path1+d1:path2 
 132              d1 path2 :> null map Str 
 133            level += 1 ; cur := next 
 134          if cur<path:len and path:cur="/" 
 135            if level+1>=cache:size 
 136              cache size += 1 
 137            var Pointer:Data_ d0 :> cache level 
 138            var Pointer:Data_ d1 :> cache level+1 
 139            d1 := d0:interface search d0 html_decode:(path cur+path:len) true 
 140            level += 1 
 141          var Str := html_decode value 
 142          if (cache:level:interface set_raw cache:level addressof:Str)=failure 
 143            status := failure 
 144        else 
 145          var Data_ d2 := d direct_search_path path true 
 146          var Str v := html_decode value 
 147          if (d2:interface set_raw d2 addressof:v Str)=failure 
 148            status := failure 
 149      eif (eparse "<pdata path=[dq]" any:(var Str path) "[dq] value=[dq]" any:(var Str value) "[dq]" any "/>") 
 150        var Data_ d2 := direct_search_path path true 
 151        var Str := html_decode value 
 152        if (d2:interface set_raw d2 addressof:Str)=failure 
 153          status := failure 
 154      eif (eparse "<preset path=[dq]" any:(var Str path) "[dq]" any "/>") 
 155        var Data_ d2 := direct_search_path path false 
 156        if d:adr<>null and (d2:interface reset d2)=failure 
 157          status := failure 
 158      eif (eparse "<pcreate path=[dq]" any:(var Str path) "[dq]" any "/>") 
 159        var Int := path search_last "/" 0 
 160        var Data_ d2 := direct_search_path (path i) false 
 161        if d2:adr<>null and (d2:interface create d2 html_decode:(path i+path:len))=failure 
 162          status := failure 
 163        if optimized_loader 
 164          level := 0 
 165      eif (eparse "<pdelete path=[dq]" any:(var Str path) "[dq]" any "/>") 
 166        var Int := path search_last "/" 0 
 167        var Data_ d2 := direct_search_path (path i) false 
 168        if d2:adr<>null and (d2:interface delete d2 html_decode:(path i+path:len))=failure 
 169          status := failure 
 170        if optimized_loader 
 171          level := 0 
 172      eif (eparse "<precovery offset=[dq]" (var Intn offset) "[dq]" any "/>") 
 173        var Str filename := d:base query "filename" 
 174        var Str logname := d:base query "logname" 
 175        if logname<>"" and logname<>filename 
 176          open logname in+safe 
 177          configure "seek "+string:offset 
 178          line_limit := database_line_limit 
 179      eif (parse "<plogin" _ any) 
 180        if base_size=undefined 
 181          (query "seek"parse base_size 
 182      eif l="<zlib>" 
 183        d:base flags += database_compressed 
 184        var Link:Stream :> new Stream 
 185        open "zlib:" "" in+safe pliant_default_file_system s 
 186        if (load z (var Intn drop))=failure or z:close=failure 
 187          status := failure 
 188   
 189  method d load s -> status 
 190    arg_rw Data_ d ; arg_rw Stream s ; arg Status status 
 191    status := load s (var Intn drop) 
 192   
 193  method db do_load filename base_size -> status 
 194    oarg_rw Database_ db ; arg Str filename ; arg_w Intn base_size ; arg Status status 
 195    db flags -= database_compressed 
 196    db flags += database_loading 
 197    db get_root (var Data_ root) 
 198    root:interface reset root 
 199    part load "load database "+filename 
 200      status := success 
 201      var Link:Stream :> new Stream 
 202      open filename in+safe 
 203      if s=failure 
 204        open filename+".tmp" in+safe 
 205      status := root load base_size 
 206      if s:close=failure 
 207        status := failure 
 208    db flags -= database_loading 
 209   
 210  method db do_load filename -> status 
 211    oarg_rw Database_ db ; arg Str filename ; arg Status status 
 212    status := db do_load filename (var Intn drop) 
 213   
 214   
 215  export '. store' '. do_store' '. load' '. do_load' 
 216