Patch title: Release 94 bulk changes
Abstract:
File: /pliant/storage/database/mount.pli
Key:
    Removed line
    Added line
abstract
  [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.]

# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

scope "/pliant/storage/" "/pliant/appli/"
module "/pliant/language/compiler.pli"
module "/pliant/util/encoding/html.pli"
module "prototype.pli"


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


type DataMount
  void
  
DataInterface_ maybe DataMount


method dm search d k -> d2
  oarg DataMount dm ; arg Data_ d ; arg Str k ; arg Data_ d2
  var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k
  if exists:cursor
    if entry_type:cursor=(Index Str Arrow)
      d2 adr := cursor
      d2 object := cursor
      d2 interface :> d interface
    else
      (cursor omap Database_) get_root d2
      return
  else
    d2 := data_null
  d2 base :> d base
  d2 path1 :> new Str d:dbpath+"/"+html_encode:k
  d2 path2 :> null map Str

method dm first d start stop buf -> d2
  oarg DataMount dm ; arg Data_ d ; arg Str start stop ; arg_w DataScanBuffer buf ; arg Data_ d2
  var Pointer:Arrow cursor
  if start:len=0
    cursor :> (d:adr map (Index Str Arrow)) first
  else
    cursor :> (d:adr map (Index Str Arrow)) from start
  if not exists:cursor
    d2 adr := null
    return
  if entry_type:cursor=(Index Str Arrow)
    d2 adr := cursor
    d2 object := cursor
    d2 interface :> d interface
  else
    (cursor omap Database_) get_root d2
  d2 path1 :> new Str d:dbpath+"/"+html_encode:((d:adr map (Index Str Arrow)) key cursor)
  d2 path2 :> null map Str
  buf adr := addressof cursor

method dm next d start stop buf -> d2
  oarg DataMount dm ; arg Data_ d ; arg Str start stop ; arg_rw DataScanBuffer buf ; arg Data_ d2
  var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) next (buf:adr map Arrow)
  if not exists:cursor
    d2 adr := null
    return
  if stop:len>0 and ((d:adr map (Index Str Arrow)) key cursor)>=stop
    d2 adr := null
    return
  if entry_type:cursor=(Index Str Arrow)
    d2 adr := cursor
    d2 object := cursor
    d2 interface :> d interface
  else
    (cursor omap Database_) get_root d2
  d2 path1 :> new Str d:dbpath+"/"+html_encode:((d:adr map (Index Str Arrow)) key cursor)
  d2 path2 :> null map Str
  buf adr := addressof cursor

method dm count d start stop -> count
  oarg_rw DataMount dm ; arg Data_ d ; arg Str start stop ; arg Int count
  var Pointer:Index_ idx :> d:adr map Index_
  if start:len=0 and stop:len=0
    count := (d:adr map (Index Str Arrow)) size
  else
    # FIXME
    void


method dm create d k -> status
  oarg_rw DataMount dm ; arg_rw Data_ d ; arg Str k; arg Status status
  var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k
  if not exists:cursor
    var Arrow a := entry_new (Index Str Arrow)
    (d:adr map (Index Str Arrow)) insert k a
    status := success
  else
    status := failure

method dm delete d k -> status
  oarg_rw DataMount dm ; arg_rw Data_ d ; arg Str k; arg Status status
  var Pointer:Arrow cursor :> (d:adr map (Index Str Arrow)) first k
  if exists:cursor
    (d:adr map (Index Str Arrow)) remove cursor
    status := success
  else
    status := failure


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

type DatabaseMount
  field Database_ common
  field Sem real_sem

Database_ maybe DatabaseMount


function build dm
  arg_w DatabaseMount dm
  dm:common sem :> dm real_sem

gvar DatabaseMount database_root

gvar Data_ data_root := data_null
data_root object := entry_new (Index Str Arrow)
data_root adr := data_root object
data_root interface :> new DataMount
data_root base :> database_root
data_root path1 :> ""
data_root path2 :> null map Str

method dm get_root d
  arg DatabaseMount dm ; arg_w Data_ d
  d := data_root


function data_mount db path
  oarg_rw Database_ db ; arg Str path
  data_root:base:sem request
  db path := path
  var Str p := path
  var Data_ d := data_root
  while (p parse "/" any:(var Str k) "/" any:(var Str remain))
    var Data_ d2 := d:interface search d html_decode:k true
    d := d2 ; p := "/"+remain
  if (p parse "/" any:(var Str k))
    var Pointer:(Index Str Arrow) index :> d:adr map (Index Str Arrow)
    var Pointer:Arrow c :> index first html_decode:k
    if exists:c
      if entry_type:c<>(Index Str Arrow)
        (c map Database_) path := ""
      index remove c
    var Arrow a := addressof db
    index insert html_decode:k a
  data_root:base:sem release


function data_umount path -> status
  arg Str path ; arg Status status
  database_root:sem request
  var Str p := path
  var Data_ d := data_root
  while (p parse "/" any:(var Str k) "/" any:(var Str remain))
    var Data_ d2 := d:interface search d html_decode:k false
    d := d2 ; p := "/"+remain
  if (p parse "/" any:(var Str k))
    status := d:interface delete d html_decode:k
    if (d:interface count d "" "")=0
      data_root:base:sem release
      data_umount (path 0 (path search_last "/" 0))
      return
  else
    status := failure
  database_root:sem release


export data_root
export data_mount data_umount