Patch title: Release 92 bulk changes
Abstract:
File: /appli/database/io.pli
Key:
    Removed line
    Added line
   
abstract
  [Handles datas stored in a file, using HTML like tags.]


constant optimized_loader true
abstract
  [Handles datas stored in a file, using HTML like tags.]


constant optimized_loader true
public
  constant database_line_limit 2^24






public

constant database_line_limit 2^24


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


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


gvar Sem database_store_sem
public
  gvar Sem database_store_sem


method db do_store filename -> status
  oarg_rw Database_ db ; arg Str filename ; arg Status statu
  if not database_store_sem:nowait_rd_request
    return failure
  part store "store database "+filename
    db get_root (var Data_ d)
    var Link:Stream s :> new Stream
    s open filename+".tmp" out+safe
    if db:flags:database_compressed
      s writeline "<zlib>"
      (var Stream z) open "zlib:" "" out+safe pliant_default
      d store z
      z flush sync
      status := shunt z:close=success and s:close=success su
    else
      d store s
      s flush sync
      status := shunt s:close=success success failure
    if status=success


method db do_store filename -> status
  oarg_rw Database_ db ; arg Str filename ; arg Status statu
  if not database_store_sem:nowait_rd_request
    return failure
  part store "store database "+filename
    db get_root (var Data_ d)
    var Link:Stream s :> new Stream
    s open filename+".tmp" out+safe
    if db:flags:database_compressed
      s writeline "<zlib>"
      (var Stream z) open "zlib:" "" out+safe pliant_default
      d store z
      z flush sync
      status := shunt z:close=success and s:close=success su
    else
      d store s
      s flush sync
      status := shunt s:close=success success failure
    if status=success
      # file_directory_flush filename
      file_delete filename
      file_move filename+".tmp" filename
      file_directory_flush filename
    else
      file_delete filename+".tmp"
  database_store_sem rd_release



method d load s base_size -> status
  arg_rw Data_ d ; arg_rw Stream s ; arg_w Intn base_size ; 
  status := success ; base_size := undefined
  s line_limit := database_line_limit
  if optimized_loader
    var Array:Data_ cache
    cache size := 1
    cache 0 := d
    var Int level := 0
  while not s:atend
    # if s:line_number%10000=0
    #   console "line " s:line_number "            [cr]"
    var Str l := s readline
    if (l eparse "<pdata path=[dq]" any:(var Str path) "[dq]
      if optimized_loader
        if level>0
          level -= 1
        while level>0 and { var Pointer:Data_ d0 :> cache le
          level -= 1
        var Int cur := cache:level:path1:len
        while cur<path:len and path:cur="/" and { var Int ne
          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
          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
          level += 1
        var Str v := html_decode value
        if (cache:level:interface set cache:level addressof:
          status := failure
      else
        var Data_ d2 := d direct_search_path path true
        var Str v := html_decode value
        if (d2:interface set d2 addressof:v Str)=failure
          status := failure
    eif (l eparse "<pdata path=[dq]" any:(var Str path) "[dq
      var Data_ d2 := d direct_search_path path true
      var Str v := html_decode value
      if (d2:interface set d2 addressof:v Str)=failure
        status := failure
    eif (l eparse "<preset path=[dq]" any:(var Str path) "[d
      var Data_ d2 := d direct_search_path path false
      if d:adr<>null and (d2:interface reset d2)=failure
        status := failure
    eif (l eparse "<pcreate path=[dq]" any:(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_decod
        status := failure
      file_delete filename
      file_move filename+".tmp" filename
      file_directory_flush filename
    else
      file_delete filename+".tmp"
  database_store_sem rd_release



method d load s base_size -> status
  arg_rw Data_ d ; arg_rw Stream s ; arg_w Intn base_size ; 
  status := success ; base_size := undefined
  s line_limit := database_line_limit
  if optimized_loader
    var Array:Data_ cache
    cache size := 1
    cache 0 := d
    var Int level := 0
  while not s:atend
    # if s:line_number%10000=0
    #   console "line " s:line_number "            [cr]"
    var Str l := s readline
    if (l eparse "<pdata path=[dq]" any:(var Str path) "[dq]
      if optimized_loader
        if level>0
          level -= 1
        while level>0 and { var Pointer:Data_ d0 :> cache le
          level -= 1
        var Int cur := cache:level:path1:len
        while cur<path:len and path:cur="/" and { var Int ne
          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
          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
          level += 1
        var Str v := html_decode value
        if (cache:level:interface set cache:level addressof:
          status := failure
      else
        var Data_ d2 := d direct_search_path path true
        var Str v := html_decode value
        if (d2:interface set d2 addressof:v Str)=failure
          status := failure
    eif (l eparse "<pdata path=[dq]" any:(var Str path) "[dq
      var Data_ d2 := d direct_search_path path true
      var Str v := html_decode value
      if (d2:interface set d2 addressof:v Str)=failure
        status := failure
    eif (l eparse "<preset path=[dq]" any:(var Str path) "[d
      var Data_ d2 := d direct_search_path path false
      if d:adr<>null and (d2:interface reset d2)=failure
        status := failure
    eif (l eparse "<pcreate path=[dq]" any:(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_decod
        status := failure
      if optimized_loader
        level := 0
    eif (l eparse "<pdelete path=[dq]" any:(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_decod
        status := failure
    eif (l eparse "<pdelete path=[dq]" any:(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_decod
        status := failure
      if optimized_loader
        level := 0
    eif (l eparse "<precovery offset=[dq]" (var Intn offset)
      var Str filename := d:base query "filename"
      var Str logname := d:base query "logname"
      if logname<>"" and logname<>filename
        s open logname in+safe
        s configure "seek "+string:offset
        s line_limit := database_line_limit
    eif (l parse "<plogin" _ any)
      if base_size=undefined
        (s query "seek") parse base_size
    eif l="<zlib>"
      d:base flags += database_compressed
      var Link:Stream z :> new Stream
      z open "zlib:" "" in+safe pliant_default_file_system s
      if (d load z (var Intn drop))=failure or z:close=failu
        status := failure


    eif (l eparse "<precovery offset=[dq]" (var Intn offset)
      var Str filename := d:base query "filename"
      var Str logname := d:base query "logname"
      if logname<>"" and logname<>filename
        s open logname in+safe
        s configure "seek "+string:offset
        s line_limit := database_line_limit
    eif (l parse "<plogin" _ any)
      if base_size=undefined
        (s query "seek") parse base_size
    eif l="<zlib>"
      d:base flags += database_compressed
      var Link:Stream z :> new Stream
      z open "zlib:" "" in+safe pliant_default_file_system s
      if (d load z (var Intn drop))=failure or z:close=failu
        status := failure



export '. store' '. do_store' '. load' '. do_load'