------------------------------------------------------------------------------
-- Berekeley BTree Files Package Parser                                     --
--                                                                          --
-- Part of SparForte                                                        --
------------------------------------------------------------------------------
--                                                                          --
--            Copyright (C) 2001-2024 Free Software Foundation              --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT 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  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- This is maintained at http://www.sparforte.com                           --
--                                                                          --
------------------------------------------------------------------------------
pragma ada_2005;

-- if text_io is commented out, then SSDS stops working, even though it is not
-- used

with text_io;use text_io;

with
    Interfaces.C,
    ada.exceptions,
    ada.strings.unbounded,
    gnat.directory_operations,
    gnat.source_info,
    world,
    pegasoft,
    pegasoft.strings,
    scanner,
    scanner.communications,
    scanner_res,
    scanner_restypes,
    parser,
    parser_params,
    parser_bdb;

#if BDB
with
    bdb,
    bdb_constants;
#end if;

use
    ada.exceptions,
    ada.strings.unbounded,
    gnat.directory_operations,
    world,
    pegasoft,
    pegasoft.strings,
    scanner,
    scanner.communications,
    scanner_res,
    scanner_restypes,
    parser,
    parser_params,
    parser_bdb;

#if BDB
use
    bdb,
    bdb_constants;
#end if;

package body parser_btree_io is

------------------------------------------------------------------------------
-- BTree package identifiers
------------------------------------------------------------------------------

--btree_file_t          : identifier;
--btree_cursor_t        : identifier;

--btree_new_file_t      : identifier;
btree_clear_t         : identifier;

btree_will_raise_t    : identifier;
btree_last_error_t    : identifier;
btree_raise_exceptions_t : identifier;

btree_recover_t       : identifier;
btree_create_t        : identifier;
btree_close_t         : identifier;
btree_open_t          : identifier;
btree_delete_t        : identifier;
btree_is_open_t       : identifier;
btree_name_t          : identifier;
btree_flush_t         : identifier;
btree_truncate_t      : identifier;

btree_set_t           : identifier;
btree_get_t           : identifier;
btree_has_element_t   : identifier;
btree_remove_t        : identifier;
btree_increment_t     : identifier;
btree_decrement_t     : identifier;
btree_add_t           : identifier;
btree_replace_t       : identifier;
btree_append_t        : identifier;
btree_prepend_t       : identifier;

--btree_new_cursor_t    : identifier;
btree_open_cursor_t   : identifier;
btree_close_cursor_t  : identifier;
btree_get_first_t     : identifier;
btree_get_last_t      : identifier;
btree_get_next_t      : identifier;
btree_get_previous_t  : identifier;

------------------------------------------------------------------------------
-- Utility subprograms
------------------------------------------------------------------------------

procedure ParseSingleFileParameter( subprogram : identifier; fileId : out identifier ) is
begin
  ParseSingleInOutInstantiatedParameter( subprogram, fileId, btree_file_t );
end ParseSingleFileParameter;

procedure ParseFirstFileParameter( subprogram : identifier; fileId : out identifier ) is
begin
  ParseFirstInOutInstantiatedParameter( subprogram, fileId, btree_file_t );
end ParseFirstFileParameter;

--procedure ParseNextFileParameter( fileId : out identifier ) is
--begin
--  ParseNextInOutInstantiatedParameter( fileId, btree_file_t );
--end ParseNextFileParameter;

--procedure ParseLastFileParameter( fileId : out identifier ) is
--begin
--  ParseLastInOutInstantiatedParameter( fileId, btree_file_t );
--end ParseLastFileParameter;

------------------------------------------------------------------------------

--procedure ParseSingleCursorParameter( cursId : out identifier ) is
--begin
--  ParseSingleInOutInstantiatedParameter( cursId, btree_cursor_t );
--end ParseSingleCursorParameter;

--procedure ParseFirstCursorParameter( cursId : out identifier ) is
--begin
--  ParseFirstInOutInstantiatedParameter( cursId, btree_cursor_t );
--end ParseFirstCursorParameter;

procedure ParseNextCursorParameter( subprogram : identifier; cursId : out identifier ) is
begin
  ParseNextInOutInstantiatedParameter( subprogram, cursId, btree_cursor_t );
end ParseNextCursorParameter;

procedure ParseLastCursorParameter( subprogram : identifier; cursId : out identifier ) is
begin
  ParseLastInOutInstantiatedParameter( subprogram, cursId, btree_cursor_t );
end ParseLastCursorParameter;

#if BDB
-----------------------------------------------------------------------------
--  IS VERIFIED OPEN FILE
--
-- True if the file is open, otherwise an error occurs and false is returned.
------------------------------------------------------------------------------

function isVerifiedOpenFile( subId, fileId : identifier; theFile : resPtr ) return boolean is
  result : boolean := true;
begin
   if not theFile.btree.isOpen then
      err( context => subId,
           subjectNotes => pl( qp( "the file " ) ) & name_em( fileId ),
           reason => +"is not open",
           obstructorNotes => nullMessageStrings
      );
      result := false;
   end if;
   return result;
end isVerifiedOpenFile;


-----------------------------------------------------------------------------
--  CONFIGURE DBD ENV
--
-- Berkeley puts the files in the current directory, though you can
-- move the env because it is shared.  To put the project in a specific
-- directory, you have you configure it.  A sophisiticated setup would
-- place all of these in different directories.
--
-- For our purposes (simple files), keep everything in one directory
-----------------------------------------------------------------------------

procedure configureBDBEnv( env : in out bdb.berkeley_environment; dirname : string ) is
begin
   if dirname'length > 0 then
      begin
         set_data_dir( env, dirname );
      exception when msg: berkeley_error =>
         err( pl( exception_message( msg ) & " on setting the data directory" ) );
      end;
      begin
         set_tmp_dir( env, dirname );
      exception when msg: berkeley_error =>
         err( pl( exception_message( msg ) & " on setting the temp directory" ) );
      end;
      begin
         set_lg_dir( env, dirname );
      exception when msg: berkeley_error =>
         err( pl( exception_message( msg ) & " on setting the logging directory" ) );
      end;
      begin
         if verboseOpt then
            set_verbose( env, DB_VERB_BACKUP, 1 );
            set_verbose( env, DB_VERB_DEADLOCK, 1 );
            set_verbose( env, DB_VERB_FILEOPS_ALL, 1 );
            set_verbose( env, DB_VERB_WAITSFOR, 1 );
         end if;
      exception when msg: berkeley_error =>
         err( pl( exception_message( msg ) & " on changing verbose setting" ) );
      end;
   end if;
end configureBDBEnv;
#end if;

------------------------------------------------------------------------------
-- Parser subprograms
------------------------------------------------------------------------------

#if BDB

--procedure ParseBTreeNewFile is
--  -- Syntax: btree.new_file( f, t );
--  -- Ada:    N/A
--  resId : resHandleId;
--  ref : reference;
--  genKindId : identifier;
--  theFile  : resPtr;
--begin
--  expect( btree_new_file_t );
--  ParseFirstOutParameter( ref, btree_file_t );
--  baseTypesOK( ref.kind, btree_file_t );
--  expect( symbol_t, "," );
--  ParseIdentifier( genKindId );
--  if class_ok( genKindId, typeClass, subClass ) then
--     -- DEBUG: trying aggregates
--     null;
--     --if identifiers( genKindId ).list then
--     --   err( "element type should be a scalar type" );
--     -- elsif identifiers( getBaseType( genKindId ) ).kind = root_record_t then
--     --    err( "element type should be a scalar type" );
--     --end if;
--  end if;
--  identifiers( ref.id ).genKind := genKindId;
--  expect( symbol_t, ")" );
--  if isExecutingCommand then
--     identifiers( ref.id ).resource := true;
--     declareResource( resId, btree_file, getIdentifierBlock( ref.id ) );
--     AssignParameter( ref, to_unbounded_string( resId ) );
--     -- TODO: this won't work if the cursor is in an array or other
--     -- aggregate type
--     identifiers( ref.id ).wasWritten := true;
--     findResource( resId, theFile );
--     theFile.btree.isOpen := false;
--  end if;
--end ParseBtreeNewFile;

#else

pragma warnings( off );
-- Hide unused parameters warnings

procedure not_configured is
begin
  err( +"Berkeley DB support not configured" );
end not_configured;

procedure not_configured( result : out unbounded_string; kind : out identifier ) is
begin
  err( +"Berkeley DB support not configured" );
end not_configured;

--procedure ParseBtreeNewFile renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE CLEAR
--
-- Syntax: btree.clear( f );
-- Ada:    N/A;
-----------------------------------------------------------------------------

procedure ParseBTreeClear is
  fileId   : identifier;
  theFile  : resPtr;
begin
  expect( btree_clear_t );
  ParseSingleFileParameter( btree_clear_t, fileId );
  if isExecutingCommand then
     begin
       -- close the file / environment, if they are still open.  This doesn't
       -- close any cursors.
       findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
       if theFile.btree.isOpen then
          Close( theFile.btree.session );
          Close( theFile.btree.env );
          theFile.btree.isOpen := false;
       end if;
     exception when msg: berkeley_error =>
       err( pl( exception_message( msg ) ) );
     when others =>
        err_exception_raised;
     end;
  end if;
end ParseBTreeClear;

#else

procedure ParseBTreeClear renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE RECOVERY
--
-- Syntax: btree.recovery( f, fname );
-- Ada:    N/A;
-----------------------------------------------------------------------------

procedure ParseBTreeRecover is
  fileId     : identifier;
  theFile    : resPtr;
  fname_val  : unbounded_string;
  fname_type : identifier;
begin
  if rshOpt then
     err( +"recover not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_recover_t );
  ParseFirstFileParameter( btree_recover_t, fileId );
  ParseLastStringParameter( btree_recover_t, fname_val, fname_type, string_t );

  if isExecutingCommand then
     declare
        dirname  : constant string := dir_name( to_string( fname_val ) );
        dirname2 : unbounded_string;
        pwdId : identifier;
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        init( theFile.btree.env );

        -- berkeley db paths must be absolute paths when creating (opening
        -- an exisiting data file is OK for relative paths)

        dirname2 := to_unbounded_string( dirname );
        if dirname = "." then
           dirname2 := null_unbounded_string;
        elsif element( dirname2, 1 ) /= '/' then
           findIdent( to_unbounded_string( "PWD" ), pwdId );
           dirname2 := identifiers( pwdId ).value.all & "/" & dirname;
        end if;
        if trace then
           put_trace( "Base directory is '" & toSecureData( to_string( toEscaped( dirname2 ) ) ) & "'" );
        end if;

        configureBDBEnv( theFile.btree.env, to_string( dirname2 ) );

        -- To recover, open a new environment in recovery mode.  Transactions
        -- must be enabled.  This will recreate the environment files.

        begin
           create( theFile.btree.env,
                   to_string( dirname2 ),
                   DB_E_OPEN_RECOVER OR
                   DB_E_OPEN_INIT_TXN OR
                   DB_E_OPEN_INIT_LOCK OR
                   DB_E_OPEN_INIT_MPOOL,
                   0 );
           close( theFile.btree.env );
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) & " on recovering the environment" ) );
        when others =>
           err_exception_raised;
        end;
     end;
  end if; -- is executing command
end ParseBTreeRecover;

#else

procedure ParseBTreeRecover renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE CREATE
--
-- Syntax: btree.create( f, path, keyLen, valLen );
-- Ada:    btree.create( f, path, keyLen, valLen );
-- this is impacted by --verbse
-----------------------------------------------------------------------------

procedure ParseBTreeCreate is
  fileId     : identifier;
  theFile    : resPtr;
  fname_val  : unbounded_string;
  fname_type : identifier;
  keyLen     : interfaces.C.size_t;
  keyLenExpr : unbounded_string;
  keyLenType : identifier;
  valLen     : interfaces.C.size_t;
  valLenExpr : unbounded_string;
  valLenType : identifier;
begin
  if rshOpt then
     err( +"create not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_create_t );
  -- NOTE: normally this is an out parameter but it is a resource so it
  -- must be initialized separately.
  ParseFirstFileParameter( btree_create_t, fileId );
  ParseNextStringParameter( btree_create_t, fname_val, fname_type, string_t );
  ParseNextNumericParameter( btree_create_t, keyLenExpr, keyLenType, positive_t );
  ParseLastNumericParameter( btree_create_t, valLenExpr, valLenType, positive_t );
  if isExecutingCommand then
     begin
        keyLen := Interfaces.C.size_t'value( to_string( keyLenExpr ) );
     exception when others =>
        err( pl( "key length must be" & Interfaces.C.size_t'first'img & ".." & Interfaces.C.size_t'last'img ) );
     end;
     begin
        valLen := Interfaces.C.size_t'value( to_string( valLenExpr ) );
     exception when others =>
        err( pl( "value length must be" & Interfaces.C.size_t'first'img & ".." & Interfaces.C.size_t'last'img ) );
     end;

     declare
        filename : constant string := base_name( to_string( fname_val ) );
        dirname  : constant string := dir_name( to_string( fname_val ) );
        dirname2 : unbounded_string;
        pwdId : identifier;
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );

        init( theFile.btree.env );

        -- berkeley db paths must be absolute paths when creating (opening
        -- an exisiting data file is OK for relative paths)

        dirname2 := to_unbounded_string( dirname );
        if dirname = "." then
           dirname2 := null_unbounded_string;
        elsif element( dirname2, 1 ) /= '/' then
           findIdent( to_unbounded_string( "PWD" ), pwdId );
           dirname2 := identifiers( pwdId ).value.all & "/" & dirname;
        end if;
        if trace then
           put_trace( "Base directory is '" & toSecuredata( to_string( toEscaped( dirname2 ) ) ) & "'" );
        end if;

        configureBDBEnv( theFile.btree.env, to_string( dirname2 ) );

        -- Create an environment

        if theFile.btree.isOpen then
           err( pl( "file " ) &
              name_em( fileId ) &
              pl( "(" & ASCII.Quotation & to_string( theFile.btree.name ) & ASCII.Quotation & ") " &
              " is already open" ) );
        else
           begin
              create( theFile.btree.env,
                   to_string( dirname2 ),
                   -- I assume we don't need logging or transactions but
                   -- they could be implemented.
                   DB_E_OPEN_INIT_LOCK OR
                   DB_E_OPEN_INIT_MPOOL,
                   0 );
              theFile.btree.envhome := dirname2;
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on creating the environment" ) );
              end;

           -- Create the file
           new_berkeley_session(
              theFile.btree.session,
              theFile.btree.env,
              keyLen,
              valLen );
           begin
              create( theFile.btree.session, filename, "", DB_BTREE, 0, 0 );
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) & " on creating the data file" ) );
           end;

           -- Do not truncate if create failed

           if not error_found then
              theFile.btree.isOpen := true;
              theFile.btree.name := fname_val;
              declare
                 cnt : natural;
              begin
                 truncate( theFile.btree.session, cnt );
                    if trace and cnt > 0 then
                    put_trace( cnt'img & " records were erased" );
                 end if;
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on truncating the data file" ) );
              end;
          end if;
       end if;
     --exception when berkeley_error:s =>
     --   err( to_string( last_error( theFile.btree.session ) );
     end;
  end if;
end ParseBTreeCreate;

#else

procedure ParseBTreeCreate renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE CLOSE
--
-- Syntax: btree.close( f );
-- Ada:    btree.close( f );
-----------------------------------------------------------------------------

procedure ParseBTreeClose is
  fileId     : identifier;
  theFile    : resPtr;
begin
  expect( btree_close_t );
  ParseSingleFileParameter( btree_close_t, fileId );
  if isExecutingCommand then
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if theFile.btree.isOpen then
           close( theFile.btree.session );
           close( theFile.btree.env );
           theFile.btree.isOpen := false;
        else
           err( +"file " &
              name_em( fileId ) &
              pl( "(" & ASCII.Quotation & to_string( theFile.btree.name ) & ASCII.Quotation & ") " &
               " is not open" ) );
        end if;
      exception when msg: berkeley_error =>
        err( pl( exception_message( msg ) ) );
     end;
  end if;
end ParseBTreeClose;

#else

procedure ParseBTreeClose renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE OPEN
--
-- Syntax: btree.open( f, path, keyLen, valLen );
-- Ada:    btree.open( f, path, keyLen, valLen );
-- this is impacted by --verbse
-----------------------------------------------------------------------------

procedure ParseBTreeOpen is
  fileId     : identifier;
  theFile    : resPtr;
  fname_val  : unbounded_string;
  fname_type : identifier;
  keyLen     : interfaces.C.size_t;
  keyLenExpr : unbounded_string;
  keyLenType : identifier;
  valLen     : interfaces.C.size_t;
  valLenExpr : unbounded_string;
  valLenType : identifier;
begin
  expect( btree_open_t );
  -- NOTE: normally this is an out parameter but it is a resource so it
  -- must be initialized separately.
  ParseFirstFileParameter( btree_open_t, fileId );
  ParseNextStringParameter( btree_open_t, fname_val, fname_type, string_t );
  -- TODO: can this be dynamic?
  ParseNextNumericParameter( btree_open_t, keyLenExpr, keyLenType, positive_t );
  ParseLastNumericParameter( btree_open_t, valLenExpr, valLenType, positive_t );
  if isExecutingCommand then
     begin
        keyLen := Interfaces.C.size_t'value( to_string( keyLenExpr ) );
     exception when others =>
        err( pl( "key length must be" & Interfaces.C.size_t'first'img & ".." & Interfaces.C.size_t'last'img ) );
     end;
     begin
        valLen := Interfaces.C.size_t'value( to_string( valLenExpr ) );
     exception when others =>
        err( pl( "value length must be" & Interfaces.C.size_t'first'img & ".." & Interfaces.C.size_t'last'img ) );
     end;

     declare
        filename : constant string := base_name( to_string( fname_val ) );
        dirname  : constant string := dir_name( to_string( fname_val ) );
        dirname2 : unbounded_string;
        pwdId : identifier;
     begin
        -- TODO: pathname handling
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );

        -- Create an environment
        init( theFile.btree.env );

        -- berkeley db paths must be absolute paths when creating (opening
        -- an exisiting data file is OK for relative paths).  We're doing this
        -- here to be consistent with create but it shouldn't be necessary

        dirname2 := to_unbounded_string( dirname );
        if dirname = "." then
           dirname2 := null_unbounded_string;
        elsif rshOpt then
           -- TODO: probably could be in directories in current PATH as well
           err( +"file must be in current directory in a " & em( "restricted shell" ) );
        elsif element( dirname2, 1 ) /= '/' then
           findIdent( to_unbounded_string( "PWD" ), pwdId );
           dirname2 := identifiers( pwdId ).value.all & "/" & dirname;
        end if;
        if trace then
           put_trace( "Base directory is '" & toSecureData( to_string( toEscaped( dirname2 ) ) ) & "'" );
        end if;

        configureBDBEnv( theFile.btree.env, to_string( dirname2 ) );

        if theFile.btree.isOpen then
           err( +"file " &
              name_em( fileId ) &
              pl( "(" & ASCII.Quotation & to_string( theFile.btree.name ) & ASCII.Quotation & ") " &
              " is already open" ) );
        else
           begin
              open( theFile.btree.env,
                   to_string( dirname2 ),
                   -- I assume we don't need logging or transactions but
                   -- they could be implemented.
                   DB_E_OPEN_INIT_LOCK OR
                   DB_E_OPEN_INIT_MPOOL,
                   0 );
              theFile.btree.envhome := dirname2;
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on opening the environment" ) );
              end;

           if not error_found then
              -- Create the file
              new_berkeley_session(
                 theFile.btree.session,
                 theFile.btree.env,
                 keyLen,
                 valLen );

              begin
                 open( theFile.btree.session, filename, "", DB_BTREE, 0, 0 );
                 theFile.btree.isOpen := true;
                 theFile.btree.name := fname_val;
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on opening the data file" ) );
              end;
           end if;
        end if;
     end;
  end if;
end ParseBTreeOpen;

#else

procedure ParseBTreeOpen renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE IS OPEN
--
-- Syntax: b := btree.is_open( f );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBTreeIsOpen( result : out unbounded_string; kind : out identifier ) is
  fileId     : identifier;
  theFile    : resPtr;
begin
  kind := boolean_t;
  expect( btree_is_open_t );
  ParseSingleFileParameter( btree_is_open_t, fileId );
  if isExecutingCommand then
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        result := to_bush_boolean( theFile.btree.isOpen );
     exception when berkeley_error =>
        result := to_bush_boolean( false );
     end;
  end if;
end ParseBTreeIsOpen;

#else

procedure ParseBTreeIsOpen( result : out unbounded_string; kind : out identifier ) renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE NAME
--
-- Syntax: b := btree.name( f );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBTreeName( result : out unbounded_string; kind : out identifier ) is
  fileId     : identifier;
  theFile    : resPtr;
begin
  kind := string_t;
  expect( btree_name_t );
  ParseSingleFileParameter( btree_name_t, fileId );
  if isExecutingCommand then
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        result := theFile.btree.name;
     end;
  end if;
end ParseBTreeName;

#else

procedure ParseBTreeName( result : out unbounded_string; kind : out identifier ) renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE NAME
--
-- Syntax: btree.delete( f );
-- Ada:    btree_io.delete( f );
-----------------------------------------------------------------------------
-- TODO:   option to the keep environment in case other files use it

procedure ParseBTreeDelete is
  fileId     : identifier;
  theFile    : resPtr;
  dirname2 : unbounded_string;
begin
  if rshOpt then
     err( +"delete not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_delete_t );
  ParseSingleFileParameter( btree_delete_t, fileId );
  if isExecutingCommand then
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if theFile.btree.isOpen then
           begin
              close( theFile.btree.session );
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) & " on closing the data file" ) );
           end;
        end if;

        -- Close closes the environment.  We need to reopen it.

        declare
           --filename : constant string := base_name( to_string( theFile.btree.name ) );
           dirname  : constant string := dir_name( to_string( theFile.btree.name ) );
           pwdId : identifier;
        begin
           -- TODO: pathname handling
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );

           -- Create an environment
           init( theFile.btree.env );

           -- berkeley db paths must be absolute paths when creating (opening
           -- an exisiting data file is OK for relative paths).  We're doing this
           -- here to be consistent with create but it shouldn't be necessary

           dirname2 := to_unbounded_string( dirname );
           if dirname = "." then
              dirname2 := null_unbounded_string;
           elsif rshOpt then
              -- TODO: probably could be in directories in current PATH as well
              err( +"file must be in current directory in a " & em( "restricted shell" ) );
           elsif element( dirname2, 1 ) /= '/' then
              findIdent( to_unbounded_string( "PWD" ), pwdId );
              dirname2 := identifiers( pwdId ).value.all & "/" & dirname;
           end if;
           if trace then
              put_trace( "Base directory is '" & toSecureData( to_string( toEscaped( dirname2 ) ) ) & "'" );
           end if;

           -- Berkeley puts the files in the current directory, though you can
           -- move the env because it is shared.  To put the project in a specific
           -- directory, you have you configure it.  A sophisiticated setup would
           -- place all of these in different directories.
           --
           -- For our purposes (simple files), keep everything in one directory

           if length( dirname2 ) > 0 then
              begin
                 set_data_dir( theFile.btree.env, to_string( dirname2 ) );
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on setting the data directory" ) );
              end;
              begin
                 set_tmp_dir( theFile.btree.env, to_string( dirname2 ) );
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on setting the temp directory" ) );
              end;
              begin
                 set_lg_dir( theFile.btree.env, to_string( dirname2 ) );
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on setting the logging directory" ) );
              end;
              begin
                 if verboseOpt then
                    set_verbose( theFile.btree.env, 1, 1 );
                 end if;
              exception when msg: berkeley_error =>
                 err( pl( exception_message( msg ) & " on changing verbose setting" ) );
              end;
           end if;
        end;

        begin
           open( theFile.btree.env,
                to_string( dirname2 ),
                -- I assume we don't need logging or transactions but
                -- they could be implemented.
                DB_E_OPEN_INIT_LOCK OR
                DB_E_OPEN_INIT_MPOOL,
                0 );
           theFile.btree.envhome := dirname2;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) & " on opening the environment" ) );
        end;

        begin
           dbremove( theFile.btree.env,
             --to_string( theFile.btree.name ),
             --TODO: this is calculated above
             base_name( to_string( theFile.btree.name ) ),
             "",
             0 );
        exception when msg: berkeley_error =>
            err( pl( exception_message( msg ) & " on removing the data file" ) );
        end;

        begin
           --init( theFile.btree.env );
           close( theFile.btree.env );
           --remove( theFile.btree.env, to_string( theFile.btree.envhome ) );
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) & " on removing the environment" ) );
        end;
        theFile.btree.isOpen := false;
     exception when storage_error =>
        err( +"storage_error raised" );
     when constraint_error =>
        err( +"constraint_error raised" );
     when others =>
        err_exception_raised;
     end;
  end if;
end ParseBTreeDelete;

#else

procedure ParseBTreeDelete renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE SET
--
-- Syntax: btree.set( f, key, value );
-- Ada:    bdb.put( f, key, value );
-----------------------------------------------------------------------------

procedure ParseBTreeSet is
  fileId     : identifier;
  theFile    : resPtr;
  keyExpr    : unbounded_string;
  keyType    : identifier;
  valExpr    : unbounded_string;
  valType    : identifier;
  valId      : identifier;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_set_t;
begin
  if rshOpt then
     err( +"set not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( subprogramId );
  ParseFirstFileParameter( subprogramId, fileId );
  ParseNextStringParameter( subprogramId, keyExpr, keyType, string_t );
  expectParameterComma;
  genKindId := identifiers( fileId ).genKind;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     isRecord := true;
     ParseIdentifier( valId );
     genTypesOk( identifiers( valId ).kind, genKindId );
  -- array?
  elsif identifiers( genKindId ).list then
     isArray := true;
     ParseIdentifier( valId );
     genTypesOk( identifiers( valId ).kind, genKindId );
  -- normal (scalar) expression?
  else
    ParseGenItemParameter( valExpr, valType, genKindId );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              jsonString : unbounded_string;
           begin
              DoRecordToJson( jsonString, valId );
              put( theFile.btree.session, to_string( keyExpr ), to_string( jsonString ) );
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) ) );
           when CONSTRAINT_ERROR =>
              err( +"constraint_error: value too big" );
           end;
        end if;
     elsif isArray then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              jsonString : unbounded_string;
           begin
              DoArrayToJson( jsonString, valId );
              put( theFile.btree.session, to_string( keyExpr ), to_string( jsonString ) );
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) ) );
           when CONSTRAINT_ERROR =>
              err( +"constraint_error: value too big" );
           end;
        end if;
     else
        -- normal scalar expression
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           begin
              put( theFile.btree.session, to_string( keyExpr ), to_string( valExpr ) );
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) ) );
           when CONSTRAINT_ERROR =>
              err( +"constraint_error: value too big" );
           when STORAGE_ERROR =>
              err( pl( gnat.source_info.source_location & ": internal error: unable to reference BDB session" ) );
           end;
        end if;
     end if;
  end if;
end ParseBTreeSet;

#else

procedure ParseBTreeSet renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE GET
--
-- Syntax: btree.get( f, k, v );
-- Ada:    v := bdb.get( f, k );
-- This was originally a function but turned into a procedure because
-- v can now be an aggregate (and we currently cannot return aggregates
-- from a function)
-----------------------------------------------------------------------------

procedure ParseBTreeGet is
  fileId     : identifier;
  theFile    : resPtr;
  keyExpr    : unbounded_string;
  keyType    : identifier;
  itemRef    : reference;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_get_t;
begin
  -- TODO: null string instead of exception to parallel dht
  expect( subprogramId );
  ParseFirstFileParameter( subprogramId, fileId );
  genKindId := identifiers( fileId ).genKind;
  ParseNextStringParameter( subprogramId, keyExpr, keyType, string_t );
  expectParameterComma;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     -- ParseOutParam doesn't handle full records or arrays
     isRecord := true;
     ParseIdentifier( itemRef.id );
     genTypesOk( identifiers( itemRef.id ).kind, genKindId );
     -- Mark the variable as having been written for future tests.
     if syntax_check and then not error_found then
        if identifiers( itemRef.id ).field_of /= eof_t then
           identifiers( identifiers( itemRef.id ).field_of ).wasWritten := true;
           identifiers( identifiers( itemRef.id ).field_of ).writtenByFlow := getDataFlowName;
        else
           identifiers( itemRef.id ).wasWritten := true;
           identifiers( itemRef.id ).writtenByFlow := getDataFlowName;
        end if;
     end if;
  -- array?
  elsif identifiers( genKindId ).list then
     -- ParseOutParam doesn't handle full records or arrays
     isArray := true;
     ParseIdentifier( itemRef.id );
     genTypesOk( identifiers( itemRef.id ).kind, genKindId );
     --ParseLastOutParameter(  itemRef, genKindId );
     -- Mark the variable as having been written for future tests.
     if syntax_check and then not error_found then
        if identifiers( itemRef.id ).field_of /= eof_t then
           identifiers( identifiers( itemRef.id ).field_of ).wasWritten := true;
           identifiers( identifiers( itemRef.id ).field_of ).writtenByFlow := getDataFlowName;
        else
           identifiers( itemRef.id ).wasWritten := true;
           identifiers( itemRef.id ).writtenByFlow := getDataFlowName;
        end if;
     end if;
  else
     -- This will still auto-declare scalars
     ParseOutParameter(  itemRef, genKindId );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              jsonString : unbounded_string;
           begin
              get( theFile.btree.session, to_string( keyExpr ), jsonString );
              DoJsonToRecord( itemRef.id, jsonString );
           exception when msg: berkeley_error =>
              if last_error( theFile.btree.session ) = DB_NOTFOUND then
                 err( +"key not found" );
              else
                  err( pl( exception_message( msg ) ) );
              end if;
           when STORAGE_ERROR =>
              err( pl( gnat.source_info.source_location & ": internal error: unable to reference BDB session" ) );
           when others =>
              err_exception_raised;
           end;
        end if;
     elsif isArray then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              jsonString : unbounded_string;
           begin
              get( theFile.btree.session, to_string( keyExpr ), jsonString );
              DoJsonToArray( itemRef.id, jsonString );
           exception when msg: berkeley_error =>
              if last_error( theFile.btree.session ) = DB_NOTFOUND then
                 err( +"key not found" );
              else
                  err( pl( exception_message( msg ) ) );
              end if;
           when STORAGE_ERROR =>
              err( pl( gnat.source_info.source_location & ": internal error: unable to reference BDB session" ) );
           when others =>
              err_exception_raised;
           end;
        end if;
     else
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              result : unbounded_string;
           begin
              get( theFile.btree.session, to_string( keyExpr ), result );
              AssignParameter( itemRef, result );
           exception when msg: berkeley_error =>
              if last_error( theFile.btree.session ) = DB_NOTFOUND then
                 err( +"key not found" );
              else
                  err( pl( exception_message( msg ) ) );
              end if;
           when STORAGE_ERROR =>
              err( pl( gnat.source_info.source_location & ": internal error: unable to reference BDB session" ) );
           end;
        end if;
     end if;
  end if;
end ParseBTreeGet;

#else

procedure ParseBTreeGet renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE HAS ELEMENT
--
-- Syntax: v := btree.has_element( f, k );
-- Ada:    bdb.exists( f, k );
-----------------------------------------------------------------------------

procedure ParseBTreeHasElement( result : out unbounded_string; kind : out identifier ) is
  fileId     : identifier;
  theFile    : resPtr;
  keyExpr    : unbounded_string;
  keyType    : identifier;
  subprogramId : constant identifier := btree_has_element_t;
begin
  kind := boolean_t;
  expect( btree_has_element_t );
  ParseFirstFileParameter( btree_has_element_t, fileId );
  ParseLastStringParameter( btree_has_element_t, keyExpr, keyType, string_t );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        begin
           exists( theFile.btree.session, to_string( keyExpr ) );
           result := to_bush_boolean( true );
        exception when berkeley_error =>
           result := to_bush_boolean( false );
        when STORAGE_ERROR =>
           err( pl( gnat.source_info.source_location & ": internal error: unable to reference BDB session" ) );
        when others =>
           err_exception_raised;
        end;
     end if;
  end if;
end ParseBTreeHasElement;

#else

procedure ParseBTreeHasElement( result : out unbounded_string; kind : out identifier ) renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE REMOVE
--
-- Syntax: v := btree.remove( f, k | c );
-- Ada:    bdb.remove( f, k | c );
-----------------------------------------------------------------------------

procedure ParseBTreeRemove is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier := eof_t;
  theCurs    : resPtr;
  keyExpr    : unbounded_string;
  keyType    : identifier;
  subprogramId : constant identifier := btree_remove_t;
begin
  if rshOpt then
     err( +"remove not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_remove_t );
  ParseFirstFileParameter( btree_remove_t, fileId );
  expectParameterComma( btree_remove_t );
  if getbaseType( identifiers( token ).kind ) = btree_cursor_t then
     ParseIdentifier( cursId );
     genTypesOk( identifiers( fileId ).genKind, identifiers( cursId ).genKind );
  else
     ParseExpression( keyExpr, keyType );
     baseTypesOk( keyType, uni_string_t );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        if cursId /= eof_t then
           begin
             findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
             delete( theFile.btree.session, theCurs.btree_cur.cursor );
           exception when msg: berkeley_error =>
               err( pl( exception_message( msg ) ) );
           end;
        else
           begin
              delete( theFile.btree.session, to_string( keyExpr ) );
           exception when msg: berkeley_error =>
              if last_error( theFile.btree.session ) = DB_NOTFOUND then
                 err( +"key not found" );
              else
                 err( pl( exception_message( msg ) ) );
              end if;
           when STORAGE_ERROR =>
              err( pl( gnat.source_info.source_location & ": internal error: unable to reference BDB session" ) );
           end;
        end if;
     end if;
  end if;
end ParseBTreeRemove;

#else

procedure ParseBTreeRemove renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE INCREMENT
--
-- Syntax: btree.increment( f, s [,n] );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBtreeIncrement is
  fileId     : identifier;
  theFile    : resPtr;
  keyExpr  : unbounded_string;
  keyType  : identifier;
  amtExpr  : unbounded_string;
  amtType  : identifier;
  hasAmt   : boolean := false;
  oldItem  : unbounded_string;
  oldItemValue : numericValue;
  subprogramId : constant identifier := btree_increment_t;
begin
  if rshOpt then
     err( +"increment not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_increment_t );
  ParseFirstFileParameter( btree_increment_t, fileId );
  if getUniType( identifiers( fileId ).genKind ) /= uni_numeric_t then
     err( +"increment requires a numeric item type" );
  end if;
  ParseNextStringParameter( btree_increment_t, keyExpr, keyType, uni_string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     hasAmt := true;
     ParseLastNumericParameter( btree_increment_t, amtExpr, amtType, natural_t );
  elsif token = symbol_t and identifiers( token ).value.all = ")" then
     expect( symbol_t, ")" );
  else
     err( +", or ) expected" );
  end if;
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        begin
          get( theFile.btree.session, to_string( keyExpr ), oldItem );
          -- berkeley throws exception on not found
          --if oldItem /= null_unbounded_string then
          oldItemValue := to_numeric( oldItem );
          if hasAmt then
             put( theFile.btree.session, to_string( keyExpr ),  to_string( to_unbounded_string( oldItemValue + numericValue( natural( to_numeric( amtExpr ) ) ) ) ) );
          else
             put( theFile.btree.session, to_string( keyExpr ), to_string( to_unbounded_string( oldItemValue + 1.0 ) ) );
          end if;
         --end if;
        exception when storage_error =>
          err( +"storage error raised" );
        when constraint_error =>
          err( +"constraint error raised" );
        when msg: berkeley_error =>
          if last_error( theFile.btree.session ) = DB_NOTFOUND then
             err( +"key not found" );
          else
             err( pl( exception_message( msg ) ) );
          end if;
        when others =>
           err_exception_raised;
        end;
     end if;
  end if;
end ParseBTreeIncrement;

#else

procedure ParseBTreeIncrement renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE DECREMENT
--
-- Syntax: btree.decrement( f, s [,n] );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBtreeDecrement is
  fileId     : identifier;
  theFile    : resPtr;
  keyExpr  : unbounded_string;
  keyType  : identifier;
  amtExpr  : unbounded_string;
  amtType  : identifier;
  hasAmt   : boolean := false;
  oldItem  : unbounded_string;
  oldItemValue : numericValue;
  subprogramId : constant identifier := btree_decrement_t;
begin
  if rshOpt then
     err( +"decrement not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_decrement_t );
  ParseFirstFileParameter( btree_decrement_t, fileId );
  if getUniType( identifiers( fileId ).genKind ) /= uni_numeric_t then
     err( +"increment requires a numeric item type" );
  end if;
  ParseNextStringParameter( btree_decrement_t, keyExpr, keyType, uni_string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     hasAmt := true;
     ParseLastNumericParameter( btree_decrement_t, amtExpr, amtType, natural_t );
  elsif token = symbol_t and identifiers( token ).value.all = ")" then
     expect( symbol_t, ")" );
  else
     err( +", or ) expected" );
  end if;
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
       begin
         get( theFile.btree.session, to_string( keyExpr ), oldItem );
         -- berkeley throws exception on not found
         --if oldItem /= null_unbounded_string then
            oldItemValue := to_numeric( oldItem );
            if hasAmt then
               put( theFile.btree.session, to_string( keyExpr ),  to_string( to_unbounded_string( oldItemValue - numericValue( natural( to_numeric( amtExpr ) ) ) ) ) );
            else
               put( theFile.btree.session, to_string( keyExpr ), to_string( to_unbounded_string( oldItemValue - 1.0 ) ) );
            end if;
         --end if;
       exception when storage_error =>
         err( +"storage error raised" );
       when constraint_error =>
         err( +"constraint error raised" );
       when msg: berkeley_error =>
         if last_error( theFile.btree.session ) = DB_NOTFOUND then
            err( +"key not found" );
         else
            err( pl( exception_message( msg ) ) );
         end if;
      when others =>
         err_exception_raised;
       end;
     end if;
  end if;
end ParseBTreeDecrement;

#else

procedure ParseBTreeDecrement renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE ADD
--
-- Syntax: btree.add( f, s, e );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBtreeAdd is
  fileId     : identifier;
  theFile  : resPtr;
  keyExpr  : unbounded_string;
  keyType  : identifier;
  itemExpr : unbounded_string;
  itemType : identifier;
  itemId     : identifier;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_add_t;
begin
  if rshOpt then
     err( +"add not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_add_t );
  ParseFirstFileParameter( btree_add_t, fileId );
  ParseNextStringParameter( btree_add_t, keyExpr, keyType, uni_string_t );
  expectParameterComma;
  genKindId := identifiers( fileId ).genKind;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     isRecord := true;
     ParseIdentifier( itemId );
     genTypesOk( identifiers( itemId ).kind, genKindId );
  -- array?
  elsif identifiers( genKindId ).list then
     isArray := true;
     ParseIdentifier( itemId );
     genTypesOk( identifiers( itemId ).kind, genKindId );
  -- normal (scalar) expression?
  else
    ParseGenItemParameter( itemExpr, itemType, genKindId );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              jsonString : unbounded_string;
           begin
              findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
              exists( theFile.btree.session, to_string( keyExpr ) );
           exception when storage_error =>
             err( +"storage error raised" );
           when msg: berkeley_error =>
             if last_error( theFile.btree.session ) = DB_NOTFOUND then
                begin
                   DoRecordToJson( jsonString, itemId );
                   put( theFile.btree.session, to_string( keyExpr ), to_string( jsonString ) );
                exception when CONSTRAINT_ERROR =>
                   err( +"constraint_error: value too big" );
                end;
             else
                err( pl( exception_message( msg ) ) );
             end if;
           when others =>
             err_exception_raised;
           end;
        end if;
     elsif isArray then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              jsonString : unbounded_string;
           begin
              exists( theFile.btree.session, to_string( keyExpr ) );
           exception when storage_error =>
             err( +"storage error raised" );
           when msg: berkeley_error =>
             if last_error( theFile.btree.session ) = DB_NOTFOUND then
                begin
                   DoArrayToJson( jsonString, itemId );
                   put( theFile.btree.session, to_string( keyExpr ), to_string( jsonString ) );
                exception when CONSTRAINT_ERROR =>
                   err( +"constraint_error: value too big" );
                end;
             else
                err( pl( exception_message( msg ) ) );
             end if;
           end;
        end if;
     else
        -- normal scalar expression
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           begin
              exists( theFile.btree.session, to_string( keyExpr ) );
           exception when storage_error =>
             err( +"storage error raised" );
           when msg: berkeley_error =>
             if last_error( theFile.btree.session ) = DB_NOTFOUND then
                begin
                   put( theFile.btree.session, to_string( keyExpr ), to_string( itemExpr ) );
                exception when CONSTRAINT_ERROR =>
                   err( +"constraint_error: value too big" );
                end;
             else
                err( pl( exception_message( msg ) ) );
             end if;
           end;
        end if;
     end if;
  end if;
end ParseBTreeAdd;

#else

procedure ParseBTreeAdd renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE ADD
--
-- Syntax: btree.replace( f, c | k, v );
-- Ada:    N/A
-- Note: the key will not be overwritten if a cursor is used
-----------------------------------------------------------------------------

procedure ParseBtreeReplace is
  fileId     : identifier;
  theFile  : resPtr;
  keyExpr  : unbounded_string;
  keyType  : identifier;
  itemExpr : unbounded_string;
  itemType : identifier;
  itemId     : identifier;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  cursId   : identifier := eof_t;
  theCurs  : resPtr;
  subprogramId : constant identifier := btree_replace_t;
begin
  if rshOpt then
     err( +"replace not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_replace_t );
  ParseFirstFileParameter( btree_replace_t, fileId );
  expectParameterComma;
  if getbaseType( identifiers( token ).kind ) = btree_cursor_t then
     ParseIdentifier( cursId );
     genTypesOk( identifiers( fileId ).genKind, identifiers( cursId ).genKind );
  else
     ParseExpression( keyExpr, keyType );
     baseTypesOk( keyType, uni_string_t );
  end if;
  expectParameterComma;
  genKindId := identifiers( fileId ).genKind;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     isRecord := true;
     ParseIdentifier( itemId );
     genTypesOk( identifiers( itemId ).kind, genKindId );
  -- array?
  elsif identifiers( genKindId ).list then
     isArray := true;
     ParseIdentifier( itemId );
     genTypesOk( identifiers( itemId ).kind, genKindId );
  -- normal (scalar) expression?
  else
    ParseGenItemParameter( itemExpr, itemType, genKindId );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if cursId /= eof_t then
        -- put where the cursor is
        if isRecord then
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              declare
                 jsonString : unbounded_string;
                 temp_key    : unbounded_string;
                 temp_string : unbounded_string;
              begin
                findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
                get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   temp_key,
                   temp_string,
                   DB_C_GET_CURRENT );
                if last_error( theFile.btree.session ) = DB_OK then
                   DoRecordToJson( jsonString, itemId );
                   put( theFile.btree.session,
                      theCurs.btree_cur.cursor,
                      keyExpr, -- this is ignored
                      jsonString,
                      DB_C_PUT_CURRENT );
                end if;
              exception when msg: berkeley_error =>
                err( pl( exception_message( msg ) ) );
              when CONSTRAINT_ERROR =>
                 err( +"constraint_error: value too big" );
              when others =>
                err_exception_raised;
              end;
           end if;
        elsif isArray then
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              declare
                 temp_key    : unbounded_string;
                 temp_string : unbounded_string;
                 jsonString : unbounded_string;
              begin
                findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
                get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   temp_key,
                   temp_string,
                   DB_C_GET_CURRENT );
                if last_error( theFile.btree.session ) = DB_OK then
                   DoArrayToJson( jsonString, itemId );
                   put( theFile.btree.session,
                        theCurs.btree_cur.cursor,
                        keyExpr, -- this is ignored
                        jsonString,
                        DB_C_PUT_CURRENT );
                end if;
              exception when msg: berkeley_error =>
                err( pl( exception_message( msg ) ) );
              when CONSTRAINT_ERROR =>
                 err( +"constraint_error: value too big" );
              when others =>
                 err_exception_raised;
              end;
           end if;
        else
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
             declare
               temp_key    : unbounded_string;
               temp_string : unbounded_string;
             begin
               findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
               get( theFile.btree.session,
                  theCurs.btree_cur.cursor,
                  temp_key,
                  temp_string,
                  DB_C_GET_CURRENT );
               if last_error( theFile.btree.session ) = DB_OK then
                  put( theFile.btree.session,
                       theCurs.btree_cur.cursor,
                       keyExpr, -- this is ignored
                       itemExpr,
                       DB_C_PUT_CURRENT );
               end if;
             exception when msg: berkeley_error =>
               err( pl( exception_message( msg ) ) );
             when CONSTRAINT_ERROR =>
                err( +"constraint_error: value too big" );
             when others =>
                err_exception_raised;
             end;
           end if;
        end if;
     else
       -- put, but only if the target exists
        if isRecord then
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              declare
                 jsonString : unbounded_string;
              begin
                exists( theFile.btree.session, to_string( keyExpr ) );
                DoRecordToJson( jsonString, itemId );
                put( theFile.btree.session, to_string( keyExpr ), to_string( jsonString ) );
              exception when storage_error =>
                err( +"storage error raised" );
              when msg: berkeley_error =>
                 if last_error( theFile.btree.session ) /= DB_NOTFOUND then
                    err( pl( exception_message( msg ) ) );
                 end if;
              when CONSTRAINT_ERROR =>
                 err( +"constraint_error: value too big" );
              when others =>
                 err_exception_raised;
              end;
           end if;
        elsif isArray then
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              declare
                 jsonString : unbounded_string;
              begin
                exists( theFile.btree.session, to_string( keyExpr ) );
                DoArrayToJson( jsonString, itemId );
                put( theFile.btree.session, to_string( keyExpr ), to_string( jsonString ) );
              exception when storage_error =>
                err( +"storage error raised" );
              when msg: berkeley_error =>
                 if last_error( theFile.btree.session ) /= DB_NOTFOUND then
                    err( pl( exception_message( msg ) ) );
                 end if;
              when CONSTRAINT_ERROR =>
                 err( +"constraint_error: value too big" );
              when others =>
                 err_exception_raised;
              end;
           end if;
        else
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
             begin
               exists( theFile.btree.session, to_string( keyExpr ) );
               put( theFile.btree.session, to_string( keyExpr ), to_string( itemExpr ) );
             exception when storage_error =>
               err( +"storage error raised" );
             when msg: berkeley_error =>
                if last_error( theFile.btree.session ) /= DB_NOTFOUND then
                   err( pl( exception_message( msg ) ) );
                end if;
             when CONSTRAINT_ERROR =>
                err( +"constraint_error: value too big" );
             when others =>
                err_exception_raised;
             end;
           end if;
        end if;
     end if;
  end if;
end ParseBTreeReplace;

#else

procedure ParseBTreeReplace renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE APPEND
--
-- Syntax: btree.append( f, s, e );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBtreeAppend is
  fileId     : identifier;
  theFile  : resPtr;
  keyExpr  : unbounded_string;
  keyType  : identifier;
  itemExpr : unbounded_string;
  itemType : identifier;
  oldItem  : unbounded_string;
  subprogramId : constant identifier := btree_append_t;
begin
  if rshOpt then
     err( +"append not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_append_t );
  ParseFirstFileParameter( btree_append_t, fileId );
  if getUniType( identifiers( fileId ).genKind ) /= uni_string_t then
     err( +"append requires a string item type" );
  end if;
  ParseNextStringParameter( btree_append_t, keyExpr, keyType, uni_string_t );
  ParseLastGenItemParameter( btree_append_t, itemExpr, itemType, identifiers( fileId ).genKind );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        begin
          get( theFile.btree.session, to_string( keyExpr ), oldItem );
          put( theFile.btree.session, to_string( keyExpr ), to_string( oldItem & itemExpr ) );
        exception when storage_error =>
          err( +"storage error raised" );
        when msg: berkeley_error =>
          if last_error( theFile.btree.session ) /= DB_NOTFOUND then
              err( pl( exception_message( msg ) ) );
          end if;
        when CONSTRAINT_ERROR =>
          err( +"constraint_error: value too big" );
        end;
     end if;
  end if;
end ParseBTreeAppend;

#else

procedure ParseBTreeAppend renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE PREPEND
--
-- Syntax: btree.prepend( f, s, e );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBtreePrepend is
  fileId     : identifier;
  theFile  : resPtr;
  keyExpr  : unbounded_string;
  keyType  : identifier;
  itemExpr : unbounded_string;
  itemType : identifier;
  oldItem  : unbounded_string;
  subprogramId : constant identifier := btree_prepend_t;
begin
  if rshOpt then
     err( +"prepend not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_prepend_t );
  ParseFirstFileParameter( btree_prepend_t, fileId );
  if getUniType( identifiers( fileId ).genKind ) /= uni_string_t then
     err( +"append requires a string item type" );
  end if;
  ParseNextStringParameter( btree_prepend_t, keyExpr, keyType, uni_string_t );
  ParseLastGenItemParameter( btree_prepend_t, itemExpr, itemType, identifiers( fileId ).genKind );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        begin
          get( theFile.btree.session, to_string( keyExpr ), oldItem );
          put( theFile.btree.session, to_string( keyExpr ), to_string( itemExpr & oldItem ) );
        exception when storage_error =>
          err( +"storage error raised" );
        when msg: berkeley_error =>
          if last_error( theFile.btree.session ) /= DB_NOTFOUND then
              err( pl( exception_message( msg ) ) );
          end if;
        when CONSTRAINT_ERROR =>
          err( +"constraint_error: value too big" );
        end;
     end if;
  end if;
end ParseBTreePrepend;

#else

procedure ParseBTreePrepend renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE FLUSH
--
-- Syntax: btree.flush( f, flags );
-- Ada:    bdb.sync( f, flags );
-----------------------------------------------------------------------------

procedure ParseBTreeFlush is
  fileId     : identifier;
  theFile    : resPtr;
  subprogramId : constant identifier := btree_flush_t;
begin
  expect( btree_flush_t );
  ParseSingleFileParameter( btree_flush_t, fileId );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        begin
           sync( theFile.btree.session );
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        end;
     end if;
  end if;
end ParseBTreeFlush;

#else

procedure ParseBTreeFlush renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE TRUNCATE
--
-- Syntax: btree.truncate( f );
-- Ada:    bdb.sync( f, cnt );
-----------------------------------------------------------------------------

procedure ParseBTreeTruncate is
  fileId     : identifier;
  theFile    : resPtr;
  subprogramId : constant identifier := btree_truncate_t;
begin
  if rshOpt then
     err( +"truncate not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_truncate_t );
  ParseSingleFileParameter( btree_truncate_t, fileId );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        declare
           cnt : natural;
        begin
           truncate( theFile.btree.session, cnt );
           if trace and cnt > 0 then
              put_trace( cnt'img & " records were erased" );
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        end;
     end if;
  end if;
end ParseBTreeTruncate;

#else

procedure ParseBTreeTruncate renames not_configured;

#end if;
#if BDB

--procedure ParseBTreeNewCursor is
--  -- Syntax: btree.new_cursor( c, t );
--  -- Ada:    N/A
--  resId : resHandleId;
--  ref : reference;
--  genKindId : identifier;
--begin
--  expect( btree_new_cursor_t );
--  ParseFirstOutParameter( ref, btree_cursor_t );
--  baseTypesOK( ref.kind, btree_cursor_t );
--  expect( symbol_t, "," );
--  ParseIdentifier( genKindId );
--  if class_ok( genKindId, typeClass, subClass ) then
--     --DEBUG
--     null;
--     --if identifiers( genKindId ).list then
--     --   err( "element type should be a scalar type" );
--     --elsif identifiers( getBaseType( genKindId ) ).kind = root_record_t then
--     --   err( "element type should be a scalar type" );
--     --end if;
--  end if;
--  identifiers( ref.id ).genKind := genKindId;
--  expect( symbol_t, ")" );
--  if isExecutingCommand then
--     identifiers( ref.id ).resource := true;
--     declareResource( resId, btree_cursor, getIdentifierBlock( ref.id ) );
--     AssignParameter( ref, to_unbounded_string( resId ) );
--     -- Note: this won't work if the cursor is in an array or other
--     -- aggregate type
--     identifiers( ref.id ).wasWritten := true;
--  end if;
--end ParseBtreeNewCursor;

#else

--procedure ParseBtreeNewCursor renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE OPEN CURSOR
--
-- Syntax: btree_io.open_cursor( f, c );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBTreeOpenCursor is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier;
  theCurs    : resPtr;
  subprogramId : constant identifier := btree_open_cursor_t;
begin
  expect( btree_open_cursor_t );
  ParseFirstFileParameter( btree_open_cursor_t, fileId );
  ParseLastCursorParameter( btree_open_cursor_t, cursId );
  if isExecutingCommand then
     findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
     if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
        findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
        if theCurs.btree_cur.isOpen then
           err( +"cursor " &
              name_em( cursId ) &
              pl( " is already open" ) );
        else
           new_berkeley_cursor( theFile.btree.session, theCurs.btree_cur.cursor );
           theCurs.btree_cur.session := theFile.btree.session;
           theCurs.btree_cur.isOpen := true;
        end if;
     end if;
  end if;
end ParseBtreeOpenCursor;

#else

procedure ParseBTreeOpenCursor renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE CLOSE CURSOR
--
-- Syntax: btree_io.close_cursor( f,c );
-- Ada:    bdb.close_cursor( f,c );
-----------------------------------------------------------------------------

procedure ParseBTreeCloseCursor is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier;
  theCurs    : resPtr;
  subprogramId : constant identifier := btree_close_cursor_t;
begin
  expect( btree_close_cursor_t );
  ParseFirstFileParameter( btree_close_cursor_t, fileId );
  ParseLastCursorParameter( btree_close_cursor_t, cursId );
  if isExecutingCommand then
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
           if not theCurs.btree_cur.isOpen then
              err( +"cursor " &
                 name_em( cursId ) &
                 pl( " is not open" ) );
           else
              close( theFile.btree.session, theCurs.btree_cur.cursor );
              theCurs.btree_cur.isOpen := false;
           end if;
        end if;
     exception when msg: berkeley_error =>
        err( pl( exception_message( msg ) ) );
     end;
  end if;
end ParseBTreeCloseCursor;

#else

procedure ParseBTreeCloseCursor renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE GET FIRST
--
-- Syntax: btree_io.get_first( f, c, k, v );
-- Ada:    bdb.get_first( f, ... );
-- Note: Unlike Ada lists, Berkeley will also return the element when
-- positioning the cursor.
-----------------------------------------------------------------------------

procedure ParseBTreeGetFirst is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier;
  theCurs    : resPtr;
  keyRef     : reference;
  valRef     : reference;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_get_first_t;
begin
  if rshOpt then
     err( +"get_first not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_get_first_t );
  ParseFirstFileParameter( btree_get_first_t, fileId );
  ParseNextCursorParameter( btree_get_first_t, cursId );
  genKindId := identifiers( fileId ).genKind;
  genTypesOk( genKindId, identifiers( cursId ).genKind );
  ParseNextOutParameter( btree_get_first_t, keyRef, string_t );
  baseTypesOK( keyRef.kind, string_t );
  if syntax_check and then not error_found then
     identifiers( keyRef.id ).wasWritten := true;
     identifiers( keyRef.id ).writtenByFlow := getDataFlowName;
  end if;
  expectParameterComma;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     -- ParseOutParam doesn't handle full records or arrays
     isRecord := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  -- array?
  elsif identifiers( genKindId ).list then
     -- ParseOutParam doesn't handle full records or arrays
     isArray := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  else
     -- This will still auto-declare scalar values
     ParseOutParameter(  valRef, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              key : unbounded_string;
              jsonString : unbounded_string;
           begin
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_FIRST );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToRecord( valRef.id, jsonString );
                 end if;
              end if;
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) ) );
           when STORAGE_ERROR =>
              err( +"storage_error raised" );
           when others =>
             err_exception_raised;
           end;
        end if;
     elsif isArray then
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              key : unbounded_string;
              jsonString : unbounded_string;
           begin
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                      name_em( cursId ) &
                      pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_FIRST );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToArray( valRef.id, jsonString );
                 end if;
              end if;
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) ) );
           when STORAGE_ERROR =>
              err( +"storage_error raised" );
           when others =>
              err_exception_raised;
           end;
        end if;
     else
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           declare
              key : unbounded_string;
              data : unbounded_string;
           begin
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   data,
                   DB_C_GET_FIRST );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    AssignParameter( valRef, data );
                 end if;
              end if;
           exception when msg: berkeley_error =>
              err( pl( exception_message( msg ) ) );
           when STORAGE_ERROR =>
              err( +"storage_error raised" );
           when others =>
              err_exception_raised;
           end;
        end if;
     end if;
  end if;
end ParseBTreeGetFirst;

#else

procedure ParseBTreeGetFirst renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE GET NEXT
--
-- Syntax: btree_io.get_next( f, c, k, v );
-- Ada:    bdb.get( f );
-- Note: Unlike Ada lists, Berkeley will also return the element when
-- positioning the cursor.
-----------------------------------------------------------------------------

procedure ParseBTreeGetNext is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier;
  theCurs    : resPtr;
  keyRef     : reference;
  valRef     : reference;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_get_next_t;
begin
  if rshOpt then
     err( +"get_next not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_get_next_t );
  ParseFirstFileParameter( btree_get_next_t, fileId );
  ParseNextCursorParameter( btree_get_next_t, cursId );
  genKindId := identifiers( fileId ).genKind;
  genTypesOk( genKindId, identifiers( cursId ).genKind );
  ParseNextOutParameter( btree_get_next_t, keyRef, string_t );
  baseTypesOK( keyRef.kind, string_t );
  expectParameterComma;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     -- ParseOutParam doesn't handle full records or arrays
     isRecord := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  -- array?
  elsif identifiers( genKindId ).list then
     -- ParseOutParam doesn't handle full records or arrays
     isArray := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  else
     -- This will still auto-declare scalar values
     ParseOutParameter(  valRef, genKindId );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        declare
           key : unbounded_string;
           jsonString : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_NEXT );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToRecord( valRef.id, jsonString );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     elsif isArray then
        declare
           key : unbounded_string;
           jsonString : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_NEXT );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToArray( valRef.id, jsonString );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     else
        declare
           key : unbounded_string;
           data : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   data,
                   DB_C_GET_NEXT );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    AssignParameter( valRef, data );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     end if;
  end if;
end ParseBTreeGetNext;

#else

procedure ParseBTreeGetNext renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE GET LAST
--
-- Syntax: btree_io.get_last( f, c, k, v );
-- Ada:    bdb.get( f );
-- Note: Unlike Ada lists, Berkeley will also return the element when
-- positioning the cursor.
-----------------------------------------------------------------------------

procedure ParseBTreeGetLast is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier;
  theCurs    : resPtr;
  keyRef     : reference;
  valRef     : reference;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_get_last_t;
begin
  if rshOpt then
     err( +"get_last not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_get_last_t );
  ParseFirstFileParameter( btree_get_last_t, fileId );
  ParseNextCursorParameter( btree_get_last_t, cursId );
  genKindId := identifiers( fileId ).genKind;
  genTypesOk( genKindId, identifiers( cursId ).genKind );
  ParseNextOutParameter( btree_get_last_t, keyRef, string_t );
  baseTypesOK( keyRef.kind, string_t );
  if syntax_check and then not error_found then
     identifiers( keyRef.id ).wasWritten := true;
     identifiers( keyRef.id ).writtenByFlow := getDataFlowName;
  end if;
  expectParameterComma;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     -- ParseOutParam doesn't handle full records or arrays
     isRecord := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  -- array?
  elsif identifiers( genKindId ).list then
     -- ParseOutParam doesn't handle full records or arrays
     isArray := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  else
     -- This will still auto-declare scalar values
     ParseOutParameter(  valRef, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        declare
           key : unbounded_string;
           jsonString : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_LAST );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToRecord( valRef.id, jsonString );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     elsif isArray then
        declare
           key : unbounded_string;
           jsonString : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_LAST );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToArray( valRef.id, jsonString );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     else
        declare
           key : unbounded_string;
           data : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   data,
                   DB_C_GET_LAST );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    AssignParameter( valRef, data );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     end if;
  end if;
end ParseBTreeGetLast;

#else

procedure ParseBTreeGetLast renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE GET PREVIOUS
--
-- Syntax: btree_io.get_previous( f, c, k, v );
-- Ada:    bdb.get( f );
-- Note: Unlike Ada lists, Berkeley will also return the element when
-- positioning the cursor.
-----------------------------------------------------------------------------

procedure ParseBTreeGetPrevious is
  fileId     : identifier;
  theFile    : resPtr;
  cursId     : identifier;
  theCurs    : resPtr;
  keyRef     : reference;
  valRef     : reference;
  isRecord   : boolean := false;
  isArray    : boolean := false;
  genKindId  : identifier;
  subprogramId : constant identifier := btree_get_previous_t;
begin
  if rshOpt then
     err( +"get_previous not allowed in a " & em( "restricted shell" ) );
  end if;
  expect( btree_get_previous_t );
  ParseFirstFileParameter( btree_get_previous_t, fileId );
  ParseNextCursorParameter( btree_get_previous_t, cursId );
  genKindId := identifiers( fileId ).genKind;
  genTypesOk( genKindId, identifiers( cursId ).genKind );
  ParseNextOutParameter( btree_get_previous_t, keyRef, string_t );
  baseTypesOK( keyRef.kind, string_t );
  expectParameterComma;
  -- This assumes we don't have aggregate expressions yet.
  -- record?
  if identifiers( getBaseType( genKindId ) ).kind = root_record_t then
     -- ParseOutParam doesn't handle full records or arrays
     isRecord := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  -- array?
  elsif identifiers( genKindId ).list then
     -- ParseOutParam doesn't handle full records or arrays
     isArray := true;
     ParseIdentifier( valRef.id );
     genTypesOk( identifiers( valRef.id ).kind, genKindId );
     if syntax_check and then not error_found then
        identifiers( valRef.id ).wasWritten := true;
        identifiers( valRef.id ).writtenByFlow := getDataFlowName;
     end if;
  else
     -- This will still auto-declare scalar values
     ParseOutParameter(  valRef, genKindId );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if isRecord then
        declare
           key : unbounded_string;
           jsonString : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_PREV );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToRecord( valRef.id, jsonString );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( pl( "storage_error raised" ) );
        when others =>
           err_exception_raised;
        end;
     elsif isArray then
        declare
           key : unbounded_string;
           jsonString : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   jsonString,
                   DB_C_GET_PREV );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    DoJsonToArray( valRef.id, jsonString );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     else
        declare
           key : unbounded_string;
           data : unbounded_string;
        begin
           findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
           if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
              findResource( to_resource_id( identifiers( cursId ).value.all ), theCurs );
              if not theCurs.btree_cur.isOpen then
                 err( +"cursor " &
                    name_em( cursId ) &
                    pl( " is not open" ) );
              else
                 get( theFile.btree.session,
                   theCurs.btree_cur.cursor,
                   key,
                   data,
                   DB_C_GET_PREV );
                 if last_error( theFile.btree.session ) = DB_OK then
                    AssignParameter( keyRef, key );
                    AssignParameter( valRef, data );
                 end if;
              end if;
           end if;
        exception when msg: berkeley_error =>
           err( pl( exception_message( msg ) ) );
        when STORAGE_ERROR =>
           err( +"storage_error raised" );
        when others =>
           err_exception_raised;
        end;
     end if;
  end if;
end ParseBTreeGetPrevious;
#else

procedure ParseBTreeGetPrevious renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE WILL RAISE
--
-- Syntax: b := btree.will_raise( f );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBTreeWillRaise( result : out unbounded_string; kind : out identifier ) is
  fileId     : identifier;
  theFile    : resPtr;
  subprogramId : constant identifier := btree_will_raise_t;
begin
  kind := boolean_t;
  expect( btree_will_raise_t );
  ParseSingleFileParameter( btree_will_raise_t, fileId );
  if isExecutingCommand then
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           result := to_bush_boolean( will_raise( theFile.btree.session ) );
        end if;
     exception when berkeley_error =>
        result := to_bush_boolean( false );
     end;
  end if;
end ParseBTreeWillRaise;

#else

procedure ParseBTreeWillRaise( result : out unbounded_string; kind : out identifier ) renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE LAST ERROR
--
-- Syntax: n := btree_io.last_error( f );
-- Ada:    N/A
-----------------------------------------------------------------------------

procedure ParseBTreeLastError( result : out unbounded_string; kind : out identifier ) is
  fileId     : identifier;
  theFile    : resPtr;
  subprogramId : constant identifier := bdb_db_error_t;
begin
  kind := bdb_db_error_t;
  expect( btree_last_error_t );
  ParseSingleFileParameter( btree_last_error_t, fileId );
  if isExecutingCommand then
     begin
       findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
       if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
          result := to_unbounded_string( db_error'image( last_error( theFile.btree.session ) ) );
       end if;
     exception when msg: berkeley_error =>
        err( pl( exception_message( msg ) ) );
     when others =>
        err_exception_raised;
     end;
  end if;
end ParseBTreeLastError;

#else

procedure ParseBTreeLastError( result : out unbounded_string; kind : out identifier ) renames not_configured;

#end if;
#if BDB

-----------------------------------------------------------------------------
--  PARSE BTREE RAISE EXCEPTIONS
--
-- Syntax: btree_io.raise_exceptions( f, b );
-- Ada:    bdb.raise_exceptions
-- this is impacted by --trace
-----------------------------------------------------------------------------

procedure ParseBTreeRaiseExceptions is
  fileId     : identifier;
  theFile    : resPtr;
  boolExpr   : unbounded_string;
  boolType   : identifier;
  subprogramId : constant identifier := btree_raise_exceptions_t;
begin
  expect( btree_raise_exceptions_t );
  ParseFirstFileParameter( btree_raise_exceptions_t, fileId );
  ParseLastEnumParameter( btree_raise_exceptions_t, boolExpr, boolType, boolean_t );
  if isExecutingCommand then
     declare
       raise_them : constant boolean := boolExpr = to_unbounded_string( "1" );
     begin
        findResource( to_resource_id( identifiers( fileId ).value.all ), theFile );
        if isVerifiedOpenFile( subprogramId, fileId, theFile ) then
           raise_exceptions( theFile.btree.session, raise_them, boolean( traceOpt ) );
        end if;
     exception when msg: berkeley_error =>
        err( pl( exception_message( msg ) ) );
     when others =>
        err_exception_raised;
     end;
  end if;
end ParseBtreeRaiseExceptions;

#else

procedure ParseBTreeRaiseExceptions renames not_configured;

#end if;

-----------------------------------------------------------------------------

procedure StartupBTreeIO is
begin

  declareNamespace( "btree_io" );

  declareIdent( btree_file_t,   "btree_io.file", variable_t, genericTypeClass );
  identifiers( btree_file_t ).usage := limitedUsage;
  identifiers( btree_file_t ).resource := true;
  declareIdent( btree_cursor_t, "btree_io.cursor", variable_t, genericTypeClass );
  identifiers( btree_cursor_t ).usage := limitedUsage;
  identifiers( btree_cursor_t ).resource := true;

  --declareProcedure( btree_new_file_t,  "btree_io.new_file", ParseBTreeNewFile'access );
  declareProcedure( btree_clear_t,     "btree_io.clear",    ParseBTreeClear'access );

  declareProcedure( btree_recover_t,   "btree_io.recover",  ParseBTreeRecover'access );
  declareProcedure( btree_create_t,    "btree_io.create",   ParseBTreeCreate'access );
  declareProcedure( btree_close_t,     "btree_io.close",    ParseBTreeClose'access );
  declareProcedure( btree_open_t,      "btree_io.open",     ParseBTreeOpen'access );
  declareFunction(  btree_is_open_t,   "btree_io.is_open",  ParseBTreeIsOpen'access );
  declareFunction(  btree_name_t,      "btree_io.name",     ParseBTreeName'access );
  declareProcedure( btree_delete_t,    "btree_io.delete",   ParseBTreeDelete'access );
  declareProcedure( btree_flush_t,     "btree_io.flush",    ParseBTreeFlush'access );
  declareProcedure( btree_truncate_t,  "btree_io.truncate",  ParseBTreeTruncate'access );

  declareProcedure( btree_set_t,       "btree_io.set",      ParseBTreeSet'access );
  declareProcedure( btree_get_t,       "btree_io.get",      ParseBTreeGet'access );
  declareFunction(  btree_has_element_t, "btree_io.has_element",  ParseBTreeHasElement'access );
  declareProcedure( btree_remove_t,    "btree_io.remove",      ParseBTreeRemove'access );
  declareProcedure( btree_increment_t, "btree_io.increment",ParseBTreeIncrement'access );
  declareProcedure( btree_decrement_t, "btree_io.decrement",ParseBTreeDecrement'access );
  declareProcedure( btree_add_t,       "btree_io.add", ParseBTreeAdd'access );
  declareProcedure( btree_replace_t,   "btree_io.replace", ParseBTreeReplace'access );
  declareProcedure( btree_append_t,    "btree_io.append", ParseBTreeAppend'access );
  declareProcedure( btree_prepend_t,   "btree_io.prepend", ParseBTreePrepend'access );

  --declareProcedure( btree_new_cursor_t,  "btree_io.new_cursor", ParseBTreeNewCursor'access );
  declareProcedure( btree_open_cursor_t,  "btree_io.open_cursor", ParseBTreeOpenCursor'access );
  declareProcedure( btree_close_cursor_t,  "btree_io.close_cursor", ParseBTreeCloseCursor'access );
  declareProcedure( btree_get_first_t,     "btree_io.get_first", ParseBTreeGetFirst'access );
  declareProcedure( btree_get_next_t,      "btree_io.get_next", ParseBTreeGetNext'access );
  declareProcedure( btree_get_previous_t,  "btree_io.get_previous", ParseBTreeGetPrevious'access );
  declareProcedure( btree_get_last_t,      "btree_io.get_last", ParseBTreeGetLast'access );

  declareFunction( btree_will_raise_t, "btree_io.will_raise",  ParseBTreeWillRaise'access );
  declareFunction( btree_last_error_t, "btree_io.last_error",  ParseBTreeLastError'access );
  declareProcedure( btree_raise_exceptions_t, "btree_io.raise_exceptions", ParseBTreeRaiseExceptions'access );

-- TODO: assemble and disassemble - are they helpful for potentially huge trees?
-- TODO: clear (cursor) - just for consistency
-- TODO: reset?  are in_file, etc. helpful to define here?

  declareNamespaceClosed( "btree_io" );

end StartupBTreeIO;

procedure ShutdownBTreeIO is
begin
  null;
end ShutdownBTreeIO;

end parser_btree_io;
