Patch title: Release 94 bulk changes
Abstract:
File: /pliant/storage/database/io_pml.pli
Key:
    Removed line
    Added line
abstract
  [Handles datas stored in a file, using PML encoding.]

module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/util/pml/io.pli"
module "prototype.pli"
module "/pliant/util/encoding/html.pli"
module "io.pli"


constant optimized_loader true

method d direct_search_path path createit -> d2
  arg_rw Data_ d ; arg Str path ; arg CBool createit ; arg Data_ d2
  d2 := d
  var Str p := path
  while (p parse "/" any:(var Str k) "/" any:(var Str remain))
    d2 := d2:interface search d2 html_decode:k createit
    p := "/"+remain
  if (p parse "/" any:(var Str k))
    d2 := d2:interface search d2 html_decode:k createit


#--------------------------------------------------------------------------


method d store_pml s
  arg Data_ d ; arg_rw Stream s
  if (d:interface get_raw d addressof:(var Str value) Str)=success
    s otag "set" d:dbpath value
  var Data_ cur := d:interface first_to_store d "" "" (var DataScanBuffer buf)
  while cur:adr<>null
    cur store_pml s
    cur := d:interface next_to_store d "" "" buf

method db do_store_pml filename -> status
  oarg_rw Database_ db ; arg Str filename ; arg Status status
  if not database_store_sem:nowait_rd_request
    return failure
  part store "store database "+filename
    db get_root (var Data_ root)
    var Link:Stream s :> new Stream
    s open filename+".tmp" out+safe
    s safe_configure "journal"
    root store_pml s
    s flush sync
    status := shunt s:close=success success failure
    if status=success
      file_delete filename
      file_move filename+".tmp" filename
      file_directory_flush filename
    else
      file_delete filename+".tmp"
  database_store_sem rd_release


#--------------------------------------------------------------------------

module "/pliant/language/compiler.pli"

method d load_pml s -> status
  arg_rw Data_ d ; arg_rw Stream s ; arg Status status
  status := success
  if optimized_loader
    var Array:Data_ cache
    cache size := 1
    cache 0 := d
    var Int level := 0
  while s:iavailable # not s:atend
    # if s:line_number%10000=0
    #   console "line " s:line_number "            [cr]"
    if (s itag "set" (var Str path) (var Str value))
      if optimized_loader
        if level>0
          level -= 1
        while level>0 and { var Pointer:Data_ d0 :> cache level ; (path 0 d0:path1:len)<>d0:path1 or (path d0:path1:len 1)<>"/" or (addressof d0:base)<>(addressof d:base) }
          level -= 1
        var Int cur := cache:level:path1:len
        while cur<path:len and path:cur="/" and { var Int next := ((path cur+1 path:len) search "/" -1)+cur+1 ; next>cur }
          if level+1>=cache:size
            cache size += 1
          var Pointer:Data_ d0 :> cache level
          var Pointer:Data_ d1 :> cache level+1
          d1 := d0:interface search d0 html_decode:(path cur+1 next-cur-1) true
          if (exists d1:path2)
            d1 path1 :> new Str d1:path1+d1:path2
            d1 path2 :> null map Str
          level += 1 ; cur := next
        if cur<path:len and path:cur="/"
          if level+1>=cache:size
            cache size += 1
          var Pointer:Data_ d0 :> cache level
          var Pointer:Data_ d1 :> cache level+1
          d1 := d0:interface search d0 html_decode:(path cur+1 path:len) true
          level += 1
        var Str v := html_decode value
        if (cache:level:interface set_raw cache:level addressof:v Str)=failure
          status := failure
      else
        var Data_ d2 := d direct_search_path path true
        var Str v := html_decode value
        if (d2:interface set_raw d2 addressof:v Str)=failure
          status := failure
    eif (s itag "set" (var Str path) (var Str value))
      var Data_ d2 := d direct_search_path path true
      var Str v := html_decode value
      if (d2:interface set_raw d2 addressof:v Str)=failure
        status := failure
    eif (s itag "reset" (var Str path))
      var Data_ d2 := d direct_search_path path false
      if d:adr<>null and (d2:interface reset d2)=failure
        status := failure
    eif (s itag "create" (var Str path))
      var Int i := path search_last "/" 0
      var Data_ d2 := d direct_search_path (path 0 i) false
      if d2:adr<>null and (d2:interface create d2 html_decode:(path i+1 path:len))=failure
        status := failure
      if optimized_loader
        level := 0
    eif (s itag "delete" (var Str path))
      var Int i := path search_last "/" 0
      var Data_ d2 := d direct_search_path (path 0 i) false
      if d2:adr<>null and (d2:interface delete d2 html_decode:(path i+1 path:len))=failure
        status := failure
      if optimized_loader
        level := 0
    else
      return failure

method db do_load_pml filename -> status
  oarg_rw Database_ db ; arg Str filename ; arg Status status
  db flags += database_loading
  db get_root (var Data_ root)
  root:interface reset root
  part load "load database "+filename
    status := success
    var Link:Stream s :> new Stream
    s open filename in+safe
    if s=failure
      s open filename+".tmp" in+safe
    status := root load_pml s
    if s:close=failure
      status := failure
  db flags -= database_loading


export '. store_pml' '. do_store_pml' '. load_pml' '. do_load_pml'