------------------------------------------------------------------------------
-- Database 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                           --
--                                                                          --
------------------------------------------------------------------------------

with ada.io_exceptions,
     ada.strings.unbounded,
     ada.text_io,
#if POSTGRES
     APQ.PostgreSQL.Client,
     pegasoft.pg,
#end if;
     spar_os.tty,
     world.utf8,
     signal_flags,
     pegasoft.strings,
     pegasoft.user_io,
     scanner,
     scanner.communications,
     scanner_res,
     parser_params,
     parser_db;
use  ada.strings.unbounded,
     ada.text_io,
#if POSTGRES
     APQ,
     APQ.PostgreSQL,
     APQ.PostgreSQL.Client,
     pegasoft.pg,
#end if;
     spar_os.tty,
     world,
     world.utf8,
     signal_flags,
     pegasoft,
     pegasoft.strings,
     pegasoft.user_io,
     scanner,
     scanner.communications,
     scanner_res,
     parser_params,
     parser_db;

package body parser_dbm is

------------------------------------------------------------------------------
-- Database package identifiers
------------------------------------------------------------------------------

dbm_connection_t : identifier;
dbm_query_t : identifier;

dbm_column_index_type_t : identifier;
dbm_tuple_index_type_t : identifier;
dbm_tuple_count_type_t : identifier;

dbm_mode_type_t       : identifier;
dbm_read_t            : identifier;
dbm_write_t           : identifier;
dbm_read_write_t      : identifier;

dbm_new_connection_t : identifier;
dbm_new_query_t     : identifier;
dbm_connect_t      : identifier;
dbm_disconnect_t   : identifier;
dbm_is_connected_t : identifier;
dbm_reset_t        : identifier;
dbm_error_message_t: identifier;
dbm_notice_message_t: identifier;
dbm_in_abort_state_t: identifier;
dbm_options_t      : identifier;
dbm_will_rollback_on_finalize_t : identifier;
dbm_set_rollback_on_finalize_t : identifier;
dbm_open_db_trace_t: identifier;
dbm_close_db_trace_t: identifier;
dbm_set_trace_t    : identifier;
dbm_is_trace_t     : identifier;
dbm_clear_t        : identifier;
dbm_prepare_t      : identifier;
dbm_append_t       : identifier;
dbm_append_line_t  : identifier;
dbm_append_quoted_t: identifier;
dbm_execute_t      : identifier;
dbm_execute_checked_t : identifier;
dbm_raise_exceptions_t : identifier;
dbm_report_errors_t : identifier;
dbm_begin_work_t   : identifier;
dbm_commit_work_t  : identifier;
dbm_rollback_work_t : identifier;
dbm_rewind_t : identifier;
dbm_fetch_t : identifier;
dbm_end_of_query_t : identifier;
dbm_tuple_t        : identifier;
dbm_tuples_t       : identifier;
dbm_columns_t      : identifier;
dbm_column_name_t  : identifier;
dbm_column_index_t : identifier;
--dbm_column_type_t  : identifier;
dbm_is_null_t      : identifier;
dbm_value_t        : identifier;
dbm_engine_of_t    : identifier;
dbm_show_t         : identifier;
dbm_list_t         : identifier;
dbm_schema_t       : identifier;
dbm_users_t        : identifier;
dbm_databases_t    : identifier;
dbm_fetch_values_t : identifier;
dbm_append_for_insert_t : identifier;
dbm_append_for_update_t : identifier;

#if POSTGRES

-- Utilities
--
-- findConnection and findQuery are to avoid throwing exceptions
-- on uninitialized resources, giving a meaningful error instead.

procedure findConnection( connectId : identifier; connection : in out resPtr ) is
  expr : constant unbounded_string := identifiers( connectId ).value.all;
begin
  if length( expr ) = 0 then
     err( em( "new_connnection" ) & pl( " has not been called to initialize the connection" ) );
  else
     findResource( to_resource_id( expr ), connection );
  end if;
end findConnection;

--procedure findQuery( queryId : identifier; query : in out resPtr ) is
--  expr : constant unbounded_string := identifiers( queryId ).value.all;
--begin
--  if length( expr ) = 0 then
--     err( em( "new_query" ) & " has not been called to initialize the query" );
--  else
--     findResource( to_resource_id( expr ), query );
--  end if;
--end findQuery;

-----------------------------------------------------------------------------
--  CONNECT
--
-- Syntax: dbm.connect( C, dbname [,user ,passwd [,host [,port ] ] ] );
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBMConnect is
  connectId   : identifier;
  dbnameExpr : unbounded_string;
  dbnameType : identifier;
  userExpr : unbounded_string;
  userType : identifier;
  hasUser  : boolean := false;
  pswdExpr : unbounded_string;
  pswdType : identifier;
  hostExpr : unbounded_string;
  hostType : identifier;
  hasHost  : boolean := false;
  portExpr : unbounded_string;
  portType : identifier;
  hasPort  : boolean := false;
  connection : resPtr;
begin
  -- temporary limitation: only one database open at a time...
  expect( dbm_connect_t );
  --if engineOpen then
  --   err( "only one database connection may be open (a limitation of this verison of bush)" );
  --   return;
  --end if;
  ParseFirstInOutParameter( dbm_connect_t, connectId, dbm_connection_t );
  ParseNextStringParameter( dbm_connect_t, dbnameExpr, dbnameType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( dbm_connect_t, userExpr, userType, string_t );
     hasUser := true;
     if token = symbol_t and identifiers( token ).value.all = "," then
        ParseNextStringParameter( dbm_connect_t, pswdExpr, pswdType, string_t );
        if token = symbol_t and identifiers( token ).value.all = "," then
           ParseNextStringParameter( dbm_connect_t, hostExpr, hostType, string_t );
           hasHost := true;
           if token = symbol_t and identifiers( token ).value.all = "," then
              ParseNextNumericParameter( dbm_connect_t, portExpr, portType, integer_t );
              hasPort := true;
           end if;
        end if;
     end if;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     if restriction_no_postgresql_database then
        err( +"not allowed with " & em( "pragma restriction( no_postgresql_database )" ) );
     end if;
     begin
       findConnection( connectId, connection );
       begin
         Set_DB_Name( connection.PG_C, to_string( dbnameExpr ) );
       exception when others =>
         err( pl( "Internal error: set_db_name " ) &
              em_value( dbnameExpr ) &
              pl( " failed" )
         );
       end;
       if hasUser then
          begin
            Set_User_Password( connection.PG_C, to_string( userExpr ), to_string( pswdExpr ) );
          exception when others =>
             err( pl( "Internal error: set_user_password " ) &
                  em_value( userExpr ) &
                  pl( "/" ) &
                  em_value( pswdExpr ) &
                  pl( " failed" )
             );
          end;
       end if;
       if hasHost then
          begin
             Set_Host_Name( connection.PG_C, to_string( hostExpr ) );
          exception when others =>
             err( pl( "Internal error: set_host_name " ) &
                  em_value( hostExpr ) &
                  pl( " failed" )
             );
          end;
       end if;
       if hasPort then
          begin
            Set_Port( connection.PG_C, integer( to_numeric( portExpr ) ) );
          exception when others =>
             err( pl( "Internal error: set_port " ) &
                  em_value( portExpr ) &
                  pl( " failed" )
             );
          end;
       end if;
       Connect( connection.PG_C );
       --engineOpen := true;
       --currentEngine := Engine_PostgreSQL;
     exception when not_connected =>
        if hasHost and hasPort and not boolean( maintenanceOpt ) then
           err( pl(
             "database connection failed - User " & User( connection.PG_C ) &
             ", Password " & Password( connection.PG_C ) &
             ", Host " & Host_Name( connection.PG_C ) &
             "and Port " & integer'image( Port( connection.PG_C ) ) & " " & DB_Name( connection.PG_C ) ) );
        else
          err( +"database connection failed" );
        end if;
     when already_connected =>
        err( +"already connected to database" );
     when STORAGE_ERROR =>
        err( +"out-of-memory or bad pointer" );
     when CONSTRAINT_ERROR =>
        err( +"constraint error exception" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMConnect;

#else

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

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

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

procedure ParseDBMConnect is
begin
  not_configured;
end ParseDBMConnect;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  ENGINE OF
--
-- Syntax: b := dbm.engine_of( c );
-- Source: APQ.Engine_Of
-----------------------------------------------------------------------------

procedure ParseDBMEngineOf( result : out unbounded_string; kind : out identifier ) is
  connectId   : identifier;
  connection : resPtr;
begin
  kind := db_database_type_t;
  expect( dbm_engine_of_t );
  ParseSingleInOutParameter( dbm_engine_of_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_unbounded_string( integer'image( Database_Type'pos( Engine_Of( connection.PG_C ) ) ) );
       if length( result ) > 0 then
          if element( result, 1 ) = ' ' then
             delete( result, 1, 1 );
          end if;
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMEngineOf;

#else

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

#end if;

--procedure ParseDBIPrepare( result : out unbounded_string ) is
--  -- Syntax: db.prepare( sqlstmt [,after] );
--  sqlExpr   : unbounded_string;
--  sqlType   : identifier;
--  afterExpr : unbounded_string;
--  afterType : identifier;
--  hasAfter  : boolean := false;
--begin
--  expect( db_prepare_t );
--  expect( symbol_t, "(" );
--  ParseExpression( sqlExpr, sqlType );
--  if baseTypesOK( string_t, sqlType ) then
--     if token = symbol_t and identifiers( token ).value = "," then
--        expect( symbol_t, "," );
--        ParseExpression( afterExpr, afterType );
--        if baseTypesOK( string_t, sqlType ) then
--           hasAfter := true;
--        end if;
--     end if;
--  end if;
--  expect( symbol_t, ")" );
--  if isExecutingCommand then
--     result := to_bush_boolean( true );
--     begin
--       Clear( Q );
--       if hasAfter then
--          Prepare( Q, to_string( sqlExpr ), to_string( afterExpr ) );
--       else
--          Prepare( Q, to_string( sqlExpr ) );
--       end if;
--     exception when others =>
--       result := to_bush_boolean( false );
--     end;
--  end if;
--end ParseDBIPrepare;

#if POSTGRES

-----------------------------------------------------------------------------
--  PREPARE
--
-- Syntax: dbm.prepare( Q, sqlstmt [,after] );
-- Source: APQ.Prepare
-----------------------------------------------------------------------------

procedure ParseDBMPrepare is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  afterExpr : unbounded_string;
  afterType : identifier;
  hasAfter  : boolean := false;
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_prepare_t );
  ParseFirstInOutParameter( dbm_prepare_t, queryId, dbm_query_t );
  ParseNextStringParameter( dbm_prepare_t, sqlExpr, sqlType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( dbm_prepare_t, afterExpr, afterType, string_t );
     hasAfter := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       if hasAfter then
          Prepare( query.PG_Q, to_string( sqlExpr ), to_string( afterExpr ) );
       else
          Prepare( query.PG_Q, to_string( sqlExpr ) );
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMPrepare;

#else

procedure ParseDBMPrepare renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND
--
-- Syntax: dbm.append( Q, sqlstmt [,after] );
-- Source: APQ.Append
-----------------------------------------------------------------------------

procedure ParseDBMAppend is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  afterExpr : unbounded_string;
  afterType : identifier;
  hasAfter  : boolean := false;
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_append_t );
  ParseFirstInOutParameter( dbm_append_t, queryId, dbm_query_t );
  ParseNextStringParameter( dbm_append_t, sqlExpr, sqlType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( dbm_append_t, afterExpr, afterType, string_t );
     hasAfter := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       if hasAfter then
          Append( query.PG_Q, to_string( sqlExpr ), to_string( afterExpr ) );
       else
          Append( query.PG_Q, to_string( sqlExpr ) );
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMAppend;

#else

procedure ParseDBMAppend renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND LINE
--
-- Syntax: dbm.append_line( query, sqlstmt );
-- Source: APQ.Append_Line
-----------------------------------------------------------------------------

procedure ParseDBMAppendLine is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_append_line_t );
  ParseFirstInOutParameter( dbm_append_line_t, queryId, dbm_query_t );
  ParseLastStringParameter( dbm_append_line_t, sqlExpr, sqlType, string_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       Append_Line( query.PG_Q, to_string( sqlExpr ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMAppendLine;

#else

procedure ParseDBMAppendLine renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND LINE
--
-- Syntax: dbm.append_quoted( query, connect, sqlstmt [,after] );
-- Source: APQ.Append_Quoted
-----------------------------------------------------------------------------

procedure ParseDBMAppendQuoted is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  afterExpr : unbounded_string;
  afterType : identifier;
  hasAfter  : boolean := false;
  queryId : identifier;
  query : resPtr;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_append_quoted_t );
  ParseFirstInOutParameter( dbm_append_quoted_t, queryId, dbm_query_t );
  ParseNextInOutParameter( dbm_append_quoted_t, connectId, dbm_connection_t );
  ParseNextStringParameter( dbm_append_quoted_t, sqlExpr, sqlType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( dbm_append_quoted_t, afterExpr, afterType, string_t );
     hasAfter := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       findConnection( queryId, query );
       if hasAfter then
          Append_Quoted( query.PG_Q, connection.PG_C, to_string( sqlExpr ), to_string( afterExpr ) );
       else
          Append_Quoted( query.PG_Q, connection.PG_C, to_string( sqlExpr ) );
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMAppendQuoted;

#else

procedure ParseDBMAppendQuoted renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  EXECUTE
--
-- Syntax: dbm.execute( Q, C );
-- Source: APQ.Execute
-----------------------------------------------------------------------------

procedure ParseDBMExecute is
  queryId : identifier;
  query : resPtr;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_execute_t );
  ParseFirstInOutParameter( dbm_execute_t, queryId, dbm_query_t );
  ParseLastInOutParameter( dbm_execute_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       findConnection( queryId, query );
       Execute( query.PG_Q, connection.PG_C );
     exception when not_connected =>
       err( +"not connected" );
     when abort_state =>
       err( +"in abort state" );
     when sql_error =>
       err( pl( Error_Message( query.PG_Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMExecute;

#else

procedure ParseDBMExecute renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  EXECUTE CHECKED
--
-- Syntax: dbm.execute_checked( Q, C [, msg ] );
-- Source: APQ.Execute_Checked
-----------------------------------------------------------------------------

procedure ParseDBMExecuteChecked is
  msgExpr   : unbounded_string;
  msgType   : identifier;
  hasMsg    : boolean := false;
  queryId : identifier;
  query : resPtr;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_execute_checked_t );
  ParseFirstInOutParameter( dbm_execute_checked_t, queryId, dbm_query_t );
  ParseNextInOutParameter( dbm_execute_checked_t, connectId, dbm_connection_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( dbm_execute_checked_t, msgExpr, msgType, string_t );
     hasMsg := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       findConnection( connectId, connection );
       if hasMsg then
          Execute_Checked( query.PG_Q, connection.PG_C, to_string( msgExpr ) );
       else
          Execute_Checked( query.PG_Q, connection.PG_C );
       end if;
     exception when not_connected =>
       err( +"not connected" );
     when abort_state =>
       err( +"in abort state" );
     when sql_error =>
       err( pl( Error_Message( query.PG_Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMExecuteChecked;

#else

procedure ParseDBMExecuteChecked renames not_configured;

#end if;

--procedure ParseDBDo( result : out unbounded_string ) is
--begin
--  expect( db_do_t );
--  result := null_unbounded_string;
--end ParseDBDo;
--
--procedure ParseDBFetchrow( result : out unbounded_string ) is
--begin
--  expect( db_fetchrow_t );
--  result := null_unbounded_string;
--end ParseDBFetchrow;
#if POSTGRES

-----------------------------------------------------------------------------
--  DISCONNECT
--
-- Syntax: dbm.disconnect( c );
-- Source: APQ.Disconnect
-----------------------------------------------------------------------------

procedure ParseDBMDisconnect is
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_disconnect_t );
  ParseSingleInOutParameter( dbm_disconnect_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
        findConnection( connectId, connection );
        Disconnect( connection.PG_C );
        --engineOpen := false;
     exception when not_connected =>
        err( +"no database connection" );
     when already_connected =>
        err( +"already connected to database" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMDisconnect;

#else

procedure ParseDBMDisconnect renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  IS CONNECTED
--
-- Syntax: b := dbm.is_connected( c )
-- Source: APQ.Is_Connected
-----------------------------------------------------------------------------

procedure ParseDBMIsConnected( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := boolean_t;
  expect( dbm_is_connected_t );
  ParseSingleInOutParameter( dbm_is_connected_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_bush_boolean( is_connected( connection.PG_C ) );
     exception when others =>
       result := to_bush_boolean( false );
     end;
  end if;
end ParseDBMIsConnected;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  IS CONNECTED
--
-- Syntax: b := dbm.is_connected( c )
-- Source: APQ.Is_Connected
-----------------------------------------------------------------------------

procedure ParseDBMReset is
  -- Syntax: dbm.reset
  -- Source: APQ.Reset
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_reset_t );
  ParseSingleInOutParameter( dbm_reset_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       Reset( connection.PG_C );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMReset;

#else

procedure ParseDBMReset renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  ERROR MESSAGE
--
-- Syntax: s := dbm.error_message( c )
-- Source: APQ.Error_Message
-----------------------------------------------------------------------------

procedure ParseDBMErrorMessage( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := string_t;
  expect( dbm_error_message_t );
  ParseSingleInOutParameter( dbm_error_message_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_unbounded_string( Error_Message( connection.PG_C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMErrorMessage;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  NOTICE MESSAGE
--
-- Syntax: dbm.notice_message( c )
-- Source: APQ.Notice_Message
-----------------------------------------------------------------------------
--
procedure ParseDBMNoticeMessage( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := string_t;
  expect( dbm_notice_message_t );
  ParseSingleInOutParameter( dbm_notice_message_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_unbounded_string( Notice_Message( connection.PG_C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMNoticeMessage;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  IN ABORT STATE
--
-- Syntax: dbm.in_abort_state( c )
-- Source: APQ.In_Abort_State
-----------------------------------------------------------------------------

procedure ParseDBMInAbortState( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := boolean_t;
  expect( dbm_in_abort_state_t );
  ParseSingleInOutParameter( dbm_in_abort_state_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_bush_boolean( In_Abort_State( connection.PG_C ) );
     exception when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMInAbortState;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  OPTIONS
--
-- Syntax: s := dbm.options( c )
-- Source: APQ.Options
-----------------------------------------------------------------------------

procedure ParseDBMOptions( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := string_t;
  expect( dbm_options_t );
  ParseSingleInOutParameter( dbm_options_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_unbounded_string( Options( connection.PG_C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMOptions;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  SET ROLLBACK ON FINALIZE
--
-- Syntax: dbm.set_rollback_on_finalize( c, b );
-- Source: APQ.Set_Rollback_On_Finalize
-----------------------------------------------------------------------------

procedure ParseDBMSetRollbackOnFinalize is
  rollExpr : unbounded_string;
  rollType : identifier;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_set_rollback_on_finalize_t );
  ParseFirstInOutParameter( dbm_set_rollback_on_finalize_t, connectId, dbm_connection_t );
  ParseLastEnumParameter( dbm_set_rollback_on_finalize_t, rollExpr, rollType, boolean_t );
  if isExecutingCommand then
     declare
       rollback : constant boolean := rollExpr = to_unbounded_string( "1" );
     begin
       findConnection( connectId, connection );
       Set_Rollback_On_Finalize( connection.PG_C, rollback );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMSetRollbackOnFinalize;

#else

procedure ParseDBMSetRollbackOnFinalize renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  WILL ROLLBACK ON FINALIZE
--
-- Syntax: dbm.will_rollback_on_finalize( C );
-- Source: APQ.Will_Rollback_On_Finalize
-----------------------------------------------------------------------------

procedure ParseDBMWillRollbackOnFinalize( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := boolean_t;
  expect( dbm_will_rollback_on_finalize_t );
  ParseSingleInOutParameter( dbm_will_rollback_on_finalize_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_bush_boolean( Will_Rollback_On_Finalize( connection.PG_C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMWillRollbackOnFinalize;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  OPEN DB TRACE
--
-- Syntax: dbm.open_db_trace( f [,m] );
-- Source: APQ.Open_DB_Trace
-----------------------------------------------------------------------------

procedure ParseDBMOpenDBTrace is
  fnameExpr : unbounded_string;
  fnameType : identifier;
  modeExpr  : unbounded_string;
  modeType  : identifier;
  traceMode : trace_mode_type;
  hasMode  : boolean := false;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_open_db_trace_t );
  ParseFirstInOutParameter( dbm_open_db_trace_t, connectId, dbm_connection_t );
  ParseNextStringParameter( dbm_open_db_trace_t, fnameExpr, fnameType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( dbm_open_db_trace_t, modeExpr, modeType, db_trace_mode_type_t );
     traceMode := Trace_Mode_Type'val( integer'value( ' ' & to_string( modeExpr ) ) );
     hasMode := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       if hasMode then
          Open_DB_Trace( connection.PG_C, to_string( fnameExpr ), traceMode );
       else
          Open_DB_Trace( connection.PG_C, to_string( fnameExpr ) );
       end if;
     exception when not_connected =>
       err( +"not connected" );
     when tracing_state =>
       err( +"file already open" );
     when Ada.IO_Exceptions.Name_Error =>
       err( +"file not found" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMOpenDBTrace;

#else

procedure ParseDBMOpenDBTrace renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  CLOSE DB TRACE
--
-- Syntax: dbm.close_db_trace( C );
-- Source: APQ.Close_DB_Trace
-----------------------------------------------------------------------------

procedure ParseDBMCloseDBTrace is
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_close_db_trace_t );
  ParseSingleInOutParameter( dbm_close_db_trace_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       Close_DB_Trace( connection.PG_C );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMCloseDBTrace;

#else

procedure ParseDBMCloseDBTrace renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  SET TRACE
--
-- Syntax: dbm.set_trace( C, b );
-- Source: APQ.Set_Trace
-----------------------------------------------------------------------------

procedure ParseDBMSetTrace is
  traceExpr : unbounded_string;
  traceType : identifier;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_set_trace_t );
  ParseFirstinOutParameter( dbm_set_trace_t, connectId, dbm_connection_t );
  ParseLastEnumParameter( dbm_set_trace_t, traceExpr, traceType, boolean_t );
  if isExecutingCommand then
     declare
       traceback : constant boolean := traceExpr = to_unbounded_string( "1" );
     begin
       findConnection( connectId, connection );
       Set_Trace( connection.PG_C, traceback );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMSetTrace;

#else

procedure ParseDBMSetTrace renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  IS TRACE
--
-- Syntax: b := dbm.is_trace( C );
-- Source: APQ.Is_Trace
-----------------------------------------------------------------------------

procedure ParseDBMIsTrace( result : out unbounded_string; kind : out identifier ) is
  connectId : identifier;
  connection : resPtr;
begin
  kind := boolean_t;
  expect( dbm_is_trace_t );
  ParseSingleInOutParameter( dbm_is_trace_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       result := to_bush_boolean( Is_Trace( connection.PG_C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMIsTrace;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  CLEAR
--
-- Syntax: dbm.clear( Q );
-- Source: APQ.Clear
-----------------------------------------------------------------------------

procedure ParseDBMClear is
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_clear_t );
  ParseSingleInOutParameter( dbm_clear_t, queryId, dbm_query_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       Clear( query.PG_Q );
     exception when CONSTRAINT_ERROR =>
       err( +"constraint error exception" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMClear;

#else

procedure ParseDBMClear renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  RAISE EXCEPTIONS
--
-- Syntax: dbm.raise_exceptions( Q [, b ] );
-- Source: APQ.Raise_Exceptions
-----------------------------------------------------------------------------

procedure ParseDBMRaiseExceptions is
  raiseExpr : unbounded_string;
  raiseType : identifier;
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_raise_exceptions_t );
  ParseFirstInOutParameter( dbm_raise_exceptions_t, queryId, dbm_query_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextEnumParameter( dbm_raise_exceptions_t, raiseExpr, raiseType, boolean_t );
  else
     raiseExpr := to_unbounded_string( "1" );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     declare
       raise_them : constant boolean := raiseExpr = to_unbounded_string( "1" );
     begin
       findConnection( queryId, query );
       Raise_Exceptions( query.PG_Q, raise_them );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMRaiseExceptions;

#else

procedure ParseDBMRaiseExceptions renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  REPORT ERRORS
--
-- Syntax: dbm.report_errors( Q [, b ] );
-- Source: APQ.Report_Errors
-----------------------------------------------------------------------------

procedure ParseDBMReportErrors is
  reportExpr : unbounded_string;
  reportType : identifier;
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_report_errors_t );
  ParseFirstInOutParameter( dbm_report_errors_t, queryId, dbm_query_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextEnumParameter( dbm_report_errors_t, reportExpr, reportType, boolean_t );
  else
     reportExpr := to_unbounded_string( "1" );
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     declare
       report_them : constant boolean := reportExpr = to_unbounded_string( "1" );
     begin
       findConnection( queryId, query );
       Report_Errors( query.PG_Q, report_them );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMReportErrors;

#else

procedure ParseDBMReportErrors renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  BEGIN WORK
--
-- Syntax: dbm.begin_work( Q, C);
-- Source: APQ.Begin_Work
-----------------------------------------------------------------------------

procedure ParseDBMBeginWork is
  queryId : identifier;
  query : resPtr;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_begin_work_t );
  ParseFirstInOutParameter( dbm_begin_work_t, queryId, dbm_query_t );
  ParseLastInOutParameter( dbm_begin_work_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       findConnection( connectId, connection );
       Begin_Work( query.PG_Q, connection.PG_C );
     exception when abort_state =>
       err( +"in abort state" );
     when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMBeginWork;

#else

procedure ParseDBMBeginWork renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  ROLLBACK WORK
--
-- Syntax: dbm.rollback_work( Q, C );
-- Source: APQ.Rollback_Work
-----------------------------------------------------------------------------

procedure ParseDBMRollbackWork is
  queryId : identifier;
  query : resPtr;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_rollback_work_t );
  ParseFirstInOutParameter( dbm_rollback_work_t, queryId, dbm_query_t );
  ParseLastInOutParameter( dbm_rollback_work_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       findConnection( queryId, query );
       Rollback_Work( query.PG_Q, connection.PG_C );
     exception when abort_state =>
       err( +"in abort state" );
     when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMRollbackWork;

#else

procedure ParseDBMRollbackWork renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COMMIT WORK
--
-- Syntax: dbm.commit_work( Q, C );
-- Source: APQ.Commit_Work
-----------------------------------------------------------------------------

procedure ParseDBMCommitWork is
  queryId : identifier;
  query : resPtr;
  connectId : identifier;
  connection : resPtr;
begin
  expect( dbm_commit_work_t );
  ParseFirstInOutParameter( dbm_commit_work_t, queryId, dbm_query_t );
  ParseLastInOutParameter( dbm_commit_work_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
       findConnection( queryId, query );
       Commit_Work( query.PG_Q, connection.PG_C );
     exception when abort_state =>
       err( +"in abort state" );
     when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMCommitWork;

#else

procedure ParseDBMCommitWork renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  REWIND
--
-- Syntax: dbm.rewind( Q );
-- Source: APQ.Rewind
-----------------------------------------------------------------------------

procedure ParseDBMRewind is
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_rewind_t );
  ParseSingleInOutParameter( dbm_rewind_t, queryId, dbm_query_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       Rewind( query.PG_Q );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMRewind;

#else

procedure ParseDBMRewind renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  FETCH
--
-- Syntax: dbm.fetch( q [,i] );
-- Source: APQ.Fetch
-----------------------------------------------------------------------------

procedure ParseDBMFetch is
  expr_val : unbounded_string;
  expr_type : identifier;
  haveIndex : boolean := false;
  queryId : identifier;
  query : resPtr;
begin
  expect( dbm_fetch_t );
  ParseFirstInOutParameter( dbm_fetch_t, queryId, dbm_query_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextNumericParameter( dbm_fetch_t, expr_val, expr_type, dbm_tuple_index_type_t );
     haveIndex := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       if haveIndex then
          Fetch( query.PG_Q, Tuple_Index_Type( to_numeric( expr_val ) ) );
       else
          Fetch( query.PG_Q );
       end if;
     exception when no_tuple =>
       err( +"no tuple" );
     when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMFetch;

#else

procedure ParseDBMFetch renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  END OF QUERY
--
-- Syntax: b := dbm.end_of_query( Q );
-- Source: APQ.End_Of_Query
-----------------------------------------------------------------------------

procedure ParseDBMEndOfQuery( result : out unbounded_string; kind : out identifier ) is
  queryId : identifier;
  query : resPtr;
begin
  kind := boolean_t;
  expect( dbm_end_of_query_t );
  ParseSingleInOutParameter( dbm_end_of_query_t, queryId, dbm_query_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_bush_boolean( End_Of_Query( query.PG_Q ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMEndOfQuery;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  TUPLE
--
-- Syntax: t := dbm.tuple( Q );
-- Source: APQ.Tuple
-----------------------------------------------------------------------------

procedure ParseDBMTuple( result : out unbounded_string; kind : out identifier ) is
  queryId : identifier;
  query : resPtr;
begin
  kind := dbm_tuple_index_type_t;
  expect( dbm_tuple_t );
  ParseSingleInOutParameter( dbm_tuple_t, queryId, dbm_query_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_unbounded_string( Tuple_Index_Type'image( Tuple( query.PG_Q ) ) );
     exception when no_tuple =>
       err( +"no tuple" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMTuple;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  TUPLES
--
-- Syntax: n := dbm.tuples( Q );
-- Source: APQ.Tuples
-----------------------------------------------------------------------------

procedure ParseDBMTuples( result : out unbounded_string; kind : out identifier ) is
  queryId : identifier;
  query : resPtr;
begin
  kind := dbm_tuple_count_type_t;
  expect( dbm_tuples_t );
  ParseSingleInOutParameter( dbm_tuples_t, queryId, dbm_query_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_unbounded_string( Tuple_Count_Type'image( Tuples( query.PG_Q ) ) );
     exception when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMTuples;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COLUMNS
--
-- Syntax: n := dbm.columns( Q );
-- Source: APQ.Columns
-----------------------------------------------------------------------------

procedure ParseDBMColumns( result : out unbounded_string; kind : out identifier ) is
  queryId : identifier;
  query : resPtr;
begin
  kind := natural_t;
  expect( dbm_columns_t );
  ParseSingleInOutParameter( dbm_columns_t, queryId, dbm_query_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_unbounded_string( Natural'image( Columns( query.PG_Q ) ) );
     exception when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMColumns;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COLUMN NAME
--
-- Syntax: n := dbm.column_Name;
-- Source: APQ.Column_Name;
-----------------------------------------------------------------------------

procedure ParseDBMColumnName( result : out unbounded_string; kind : out identifier ) is
  exprVal : unbounded_string;
  exprType : identifier;
  queryId : identifier;
  query : resPtr;
begin
  kind := string_t;
  expect( dbm_column_name_t );
  ParseFirstInOutParameter( dbm_column_name_t, queryId, dbm_query_t );
  ParseLastNumericParameter( dbm_column_name_t, exprVal, exprType, dbm_column_index_type_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_unbounded_string(
          Column_Name( query.PG_Q, Column_Index_Type( to_numeric( exprVal ) ) )
       );
     exception when no_column =>
       err( +"no column" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMColumnName;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COLUMN INDEX
--
-- Syntax: n := dbm.column_index( Q, s );
-- Source: APQ.Column_Index
-----------------------------------------------------------------------------

procedure ParseDBMColumnIndex( result : out unbounded_string; kind : out identifier ) is
  exprVal : unbounded_string;
  exprType : identifier;
  queryId : identifier;
  query : resPtr;
begin
  kind := dbm_column_index_type_t;
  expect( dbm_column_index_t );
  ParseFirstInOutParameter( dbm_column_index_t, queryId, dbm_query_t );
  ParseLastStringParameter( dbm_column_index_t, exprVal, exprType, string_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_unbounded_string( Column_Index_Type'image(
           Column_Index( query.PG_Q, to_string( exprVal ) )
       ) );
     exception when no_column =>
       err( +"no column" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMColumnIndex;

#else

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

#end if;
#if POSTGRES

--procedure ParseDBColumnType( result : out unbounded_string ) is
  -- Syntax: n := db.column_type;
  -- Source: APQ.Column_Type;
  --exprVal : unbounded_string;
  --exprType : identifier;
--begin
  --expect( db_column_type_t );
  --expect( symbol_t, "(" );
  --ParseExpression( exprVal, exprType );
  --if baseTypesOK( exprType, db_column_index_type_t ) then
     --expect( symbol_t, ")" );
  --end if;
  --if isExecutingCommand then
     --begin
       --result := to_unbounded_string(
          --Column_Type( Q,
          --Column_Index_Type( to_numeric( exprVal ) ) )
       --);
     --exception when no_column =>
       --err( "no column" );
     --when no_result =>
       --err( "no result" );
     --when others =>
       --err( "exception was raised" );
     --end;
  --end if;
--end ParseDBColumnType;

-----------------------------------------------------------------------------
--  IS NULL
--
-- Syntax: n := dbm.is_null;
-- Source: APQ.Is_Null;
-----------------------------------------------------------------------------

procedure ParseDBMIsNull( result : out unbounded_string; kind : out identifier ) is
  exprVal : unbounded_string;
  exprType : identifier;
  queryId : identifier;
  query : resPtr;
begin
  kind := boolean_t;
  expect( dbm_is_null_t );
  ParseFirstInOutParameter( dbm_is_null_t, queryId, dbm_query_t );
  ParseLastNumericParameter( dbm_is_null_t, exprVal, exprType, dbm_column_index_type_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := to_bush_boolean(
          Is_Null( query.PG_Q,
          Column_Index_Type( to_numeric( exprVal ) ) )
       );
     exception when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMIsNull;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  VALUES
--
-- Syntax: n := dbm.value;
-- Source: APQ.Value;
-----------------------------------------------------------------------------

procedure ParseDBMValue( result : out unbounded_string; kind : out identifier ) is
  exprVal  : unbounded_string;
  exprType : identifier;
  queryId : identifier;
  query : resPtr;
begin
  kind := universal_t;
  expect( dbm_value_t );
  ParseFirstInOutParameter( dbm_value_t, queryId, dbm_query_t );
  ParseLastNumericParameter( dbm_value_t, exprVal, exprType, dbm_column_index_type_t );
  if isExecutingCommand then
     begin
       findConnection( queryId, query );
       result := Value( query.PG_Q, Column_Index_Type( to_numeric( exprVal ) ) );
     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMValue;

#else

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

#end if;

#if POSTGRES

-----------------------------------------------------------------------------
--  SHOW IT
--
-- run SQL command and display results in tabular format
-----------------------------------------------------------------------------

procedure DBMShowIt( Q : in out APQ.PostgreSQL.Client.Query_Type; C : resPtr ) is
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
begin
  if isExecutingCommand then
     begin
     if is_connected( C.PG_C ) then
        execute( Q, C.PG_C );

        -- Initially, the columns widths are the widths of the headings

        for i in 1..columns( Q ) loop
            columnWidths( i ) := column_name( Q, Column_Index_Type( i ) )'length;
            if columnWidths( i ) < 4 then -- room for NULL on tabular display
               columnWidths( i ) := 4;
            end if;
            if headingWidth < columnWidths( i ) then
               headingWidth := columnWidths( i );
            end if;
        end loop;

        -- Check query results and adjust the columns widths for the longest
        -- results.

        while not end_of_query( Q ) loop
              fetch( Q );
              for i in 1..columns( Q ) loop
                 if not is_null( Q, Column_Index_Type( i ) ) then
                    width := length( ada.strings.unbounded.to_unbounded_string( Value( Q, Column_Index_Type( i ) ) ) );
                    if width > 256 then
                       width := 256;
                    end if;
                    if width > columnWidths( i ) then
                       columnWidths( i ) := width;
                    end if;
                 end if;
              end loop;
        end loop;

        -- Add up all columns for the total width for a tabular display

        totalWidth := 2;                                        -- left/right marg
        for i in 1..columns( Q ) loop
            totalWidth := totalWidth + columnWidths( i );       -- width of column
            if i /= columns(Q) then                             -- not last col?
               totalWidth := totalWidth + 3;                    -- 3 char sep
            end if;
        end loop;

        -- Rewind the clear and prepare to show the results

        Rewind( Q );
        new_line_retry;

        -- Use a tabular display only if will fit in the current display

        tabularDisplay := totalWidth <= integer( displayInfo.col );

        -- Draw the columns

        if tabularDisplay then
           put_retry( " " );
           for i in 1..columns( Q ) loop
               put_retry(
                  to_string(
                      ada.strings.unbounded.Head(
                          to_unbounded_string(
                              column_name( Q, Column_Index_Type( i ) ) )
                      , columnWidths( i ) )
                  )
               );
               if i /= columns( Q ) then
                  put_retry( " " & utf_verticalLine & " " );
               end if;
           end loop;
           new_line_retry;
           put_retry( utf_horizontalLine );
           for i in 1..columns( Q ) loop
               put_retry( ada.strings.unbounded.to_string( columnWidths( i ) * utf_horizontalLine ) );
               if i /= columns( Q ) then
                  put_retry( utf_horizontalLine & utf_crossedLines & utf_horizontalLine );
               else
                  put_retry( utf_horizontalLine );
               end if;
           end loop;
           new_line_retry;
        end if;

        -- Draw the query results

        while not end_of_query( Q ) loop
            fetch( Q );
            if tabularDisplay then
               put_retry( " " );
            end if;
            for i in 1..columns( Q ) loop
                if tabularDisplay then
                   if is_null( Q, Column_Index_Type( i ) ) then
                      put_retry( inverse( to_string( ada.strings.unbounded.Head( to_unbounded_string( "NULL" ), columnWidths( i ) ) ) ) );
                      wasNull := true;
                   else
                      put_retry( to_string( ada.strings.unbounded.Head( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ), columnWidths( i ) ) ) );
                   end if;
                   if i /= columns( Q ) then
                      put_retry( " " & utf_verticalLine & " " );
                   end if;
                else
                   put_retry( to_string( head( ada.strings.unbounded.to_unbounded_string( column_name( Q, Column_Index_Type( i ) ) ), headingWidth ) ) );
                   put_retry( ": " );
                   if is_null( Q, Column_Index_Type( i ) ) then
                      put_retry( inverse( "NULL" ) );
                      wasNull := true;
                   else
                      put_retry( bold( to_string( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) );
                   end if;
                   new_line_retry;
                end if;
                exit when wasSIGINT or wasSIGTERM;
            end loop;
            new_line_retry;
        end loop;
     end if;

     -- Draw the summary line

     if tuples( Q ) > 1 and columns ( Q ) > 1 then
        if tuples( Q ) = 1 then
           put_retry( " 1 Row" );
        else
           put_retry( Tuple_Index_Type'image( tuples( Q ) ) );
           put_retry( " Rows" );
        end if;
        if wasNull then
           put_retry( " with nulls" );
        end if;
        if columns( Q ) = 1 then
           put_retry( " and 1 Column" );
        else
           put_retry( " and" );
           put_retry( integer'image( columns( Q ) ) );
           put_retry( " Columns" );
        end if;
        new_line_retry;
     end if;
     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end DBMShowIt;

-----------------------------------------------------------------------------
--  SHOW
--
-- Syntax: dbm.show( Q, C );
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBMShow is
  queryId : identifier;
  query : resPtr;
  connectionId : identifier;
  connection : resPtr;
begin
  expect( dbm_show_t );
  ParseFirstInOutParameter( dbm_show_t, queryId, dbm_query_t );
  ParseLastInOutParameter( dbm_show_t, connectionId, dbm_connection_t );
  if isExecutingCommand then
     findConnection( connectionId, connection );
     findConnection( queryId, query );
     DBMShowIt( Q => query.PG_Q, C => connection );
  end if;
end ParseDBMShow;

#else

procedure ParseDBMShow renames not_configured;

#end if;
#if POSTGRES

procedure ParseDBMList is
  -- Syntax: dbm.list( C )
  -- Source: N/A
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
  connectId : identifier;
  connection : resPtr;
  Q : APQ.PostgreSQL.Client.Query_Type;
begin
  expect( dbm_list_t );
  ParseSingleInOutParameter( dbm_list_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
     if is_connected( connection.PG_C ) then
        -- Show tablename and kind, lookup owner from another table.
        -- Don't show tables owned by postgres (user 1), TOAST tables or indexes
        prepare( Q, "select n.nspname as " & '"' & "Schema" & '"' &
          ", c.relname as " & '"' & "Name" & '"' &
          ", c.relkind as " & '"' & "Type" & '"' &
          ", u.usename as " &  '"' & "Owner" & '"' &
          " from pg_class c, pg_user u, pg_namespace n where u.usesysid = c.relowner and n.oid = c.relnamespace and c.relkind <> 't' and c.relkind <> 'i' and u.usesysid <> 1 order by c.relname" );
        execute( Q, connection.PG_C );

        -- Initially, the columns widths are the widths of the headings

        for i in 1..columns( Q ) loop
            columnWidths( i ) := column_name( Q, Column_Index_Type( i ) )'length;
            if columnWidths( i ) < 4 then -- room for NULL on tabular display
               columnWidths( i ) := 4;
            end if;
            if headingWidth < columnWidths( i ) then
               headingWidth := columnWidths( i );
            end if;
        end loop;

        -- Check query results and adjust the columns widths for the longest
        -- results.

        while not end_of_query( Q ) loop
              fetch( Q );
              for i in 1..columns( Q ) loop
                 if not is_null( Q, Column_Index_Type( i ) ) then
                    if i = 3 then -- column 2 is table type
                       width := length( ada.strings.unbounded.to_unbounded_string( pg_kind_to_string( Value( Q, Column_Index_Type( i ) ) ) ) );
                    else
                       width := length( ada.strings.unbounded.to_unbounded_string( Value( Q, Column_Index_Type( i ) ) ) );
                    end if;
                    if width > 256 then
                       width := 256;
                    end if;
                    if width > columnWidths( i ) then
                       columnWidths( i ) := width;
                    end if;
                 end if;
              end loop;
              exit when wasSIGINT or wasSIGTERM;
        end loop;

        -- Add up all columns for the total width for a tabular display

        totalWidth := 2;                                        -- left/right marg
        for i in 1..columns( Q ) loop
            totalWidth := totalWidth + columnWidths( i );       -- width of column
            if i /= columns(Q) then                             -- not last col?
               totalWidth := totalWidth + 3;                    -- 3 char sep
            end if;
        end loop;

        -- Rewind the clear and prepare to show the results

        Rewind( Q );
        new_line_retry;

        -- Use a tabular display only if will fit in the current display

        tabularDisplay := totalWidth <= integer( displayInfo.col );

        -- Draw the columns

        if tabularDisplay then
           put_retry( " " );
           for i in 1..columns( Q ) loop
               put_retry(
                  to_string(
                      ada.strings.unbounded.Head(
                          to_unbounded_string(
                              column_name( Q, Column_Index_Type( i ) ) )
                      , columnWidths( i ) )
                  )
               );
               if i /= columns( Q ) then
                  put_retry( " " & utf_verticalLine & " " );
               end if;
           end loop;
           new_line_retry;
           put_retry( utf_horizontalLine );
           for i in 1..columns( Q ) loop
               put_retry( ada.strings.unbounded.to_string( columnWidths( i ) * utf_horizontalLine ) );
               if i /= columns( Q ) then
                  put_retry( utf_horizontalLine & utf_crossedLines & utf_horizontalLine );
               else
                  put_retry( utf_horizontalLine );
               end if;
           end loop;
           new_line_retry;
        end if;

        -- Draw the query results

        while not end_of_query( Q ) loop
            fetch( Q );
            if tabularDisplay then
               put_retry( " " );
            end if;
            for i in 1..columns( Q ) loop
                if tabularDisplay then
                   if is_null( Q, Column_Index_Type( i ) ) then
                      put_retry( inverse( to_string( ada.strings.unbounded.Head( to_unbounded_string( "NULL" ), columnWidths( i ) ) ) ) );
                      wasNull := true;
                   elsif i = 3 then -- column 2 is table type
                      put_retry( to_string( Head( ToEscaped( to_unbounded_string( pg_kind_to_string( value( Q, Column_Index_Type( i ) ) ) ) ), columnWidths( i ) ) ) );
                   else
                      put_retry( to_string( Head( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ), columnWidths( i ) ) ) );
                   end if;
                   if i /= columns( Q ) then
                      put_retry( " " & utf_verticalLine & " " );
                   end if;
                else
                   put_retry( to_string( ada.strings.unbounded.head( to_unbounded_string( column_name( Q, Column_Index_Type( i ) ) ), headingWidth ) ) );
                   put_retry( ": " );
                   if is_null( Q, Column_Index_Type( i ) ) then
                      put_retry( inverse( "NULL" ) );
                      wasNull := true;
                   elsif i = 3 then
                      put_retry( bold( to_string( ToEscaped( to_unbounded_string( pg_kind_to_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) ) );
                   else
                      put_retry( bold( to_string( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) );
                   end if;
                   new_line_retry;
                end if;
            end loop;
            new_line_retry;
            exit when wasSIGINT or wasSIGTERM;
        end loop;
     end if;

     -- Draw the summary line

     if tuples( Q ) = 1 then
        put_retry( " 1 Row" );
     else
        put_retry( Tuple_Index_Type'image( tuples( Q ) ) );
        put_retry( " Rows" );
     end if;
     if wasNull then
        put_retry( " with nulls" );
     end if;
     if columns( Q ) = 1 then
        put_retry( " and 1 Column" );
     else
        put_retry( " and" );
        put_retry( integer'image( columns( Q ) ) );
        put_retry( " Columns" );
     end if;
     new_line_retry;
     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMList;

#else

procedure ParseDBMList renames not_configured;

#end if;
#if POSTGRES

procedure ParseDBMSchema is
  -- Syntax: dbm.schema( C, "table" );
  -- Source: N/A
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
  exprType       : identifier;
  exprVal        : unbounded_string;
  connectId : identifier;
  connection : resPtr;
  Q : APQ.PostgreSQL.Client.Query_Type;
begin
  expect( dbm_schema_t );
  ParseFirstInOutParameter( dbm_schema_t, connectId, dbm_connection_t );
  ParseLastStringParameter( dbm_schema_t, exprVal, exprType, string_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
     if is_connected( connection.PG_C ) then
        -- Find column name, type, type length, not null and default flags
        -- Don't show dropped columns, columns with system types (oid, etc).
        prepare( Q, "select a.attname as " & '"' & "Column" & '"' &
                    ", t.typname as " & '"' & "Type" & '"' &
                    ", a.atttypmod-4 as " & '"' & "Length" & '"' &
                    ", a.attnotnull as " & '"' & "Not Null" & '"' &
                    ", a.atthasdef as " & '"' & "Default" & '"' &
                    "from pg_attribute a, pg_class c, pg_type t where a.attrelid = c.oid and t.oid = a.atttypid and a.attisdropped = 'f' and (a.atttypid < 26 or a.atttypid > 29) and c.relname='" &
                     to_string( exprVal ) & "' order by a.attnum" );
        execute( Q, connection.PG_C );

        -- No result? Then table was not found.

        if end_of_query( Q ) then
           err( +"Did not find any relation named " &
              unb_em( exprVal ) );
           return;
        end if;

        -- Initially, the columns widths are the widths of the headings

        for i in 1..columns( Q ) loop
            if i /= 3 then -- column 3 is type length (not shown)
               columnWidths( i ) := column_name( Q, Column_Index_Type( i ) )'length;
               if columnWidths( i ) < 4 then -- room for NULL on tabular display
                  columnWidths( i ) := 4;
               end if;
               if headingWidth < columnWidths( i ) then
                  headingWidth := columnWidths( i );
               end if;
            end if;
        end loop;

        -- Check query results and adjust the columns widths for the longest
        -- results.

        while not end_of_query( Q ) loop
              fetch( Q );
              for i in 1..columns( Q ) loop
                 if i /= 3 then -- column 3 is type length (not shown)
                    if not is_null( Q, Column_Index_Type( i ) ) then
                       if i = 2 then -- column 2 is column type
                          width := ada.strings.unbounded.length( to_unbounded_string(
                                   pg_column_type_to_string( Value( Q, Column_Index_Type( i ) ),
                                                             Value( Q, Column_Index_Type( i+1 ) ) ) ) );
                       elsif i = 4 then
                          width := ada.strings.unbounded.length( to_unbounded_string(
                                   pg_not_null_to_string( Value( Q, Column_Index_Type( i ) ) ) ) );
                       elsif i = 5 then
                          width := ada.strings.unbounded.length( to_unbounded_string(
                                   pg_default_to_string( Value( Q, Column_Index_Type( i ) ) ) ) );
                       else
                          width := ada.strings.unbounded.length( to_unbounded_string( Value( Q, Column_Index_Type( i ) ) ) );
                       end if;
                       if width > 256 then
                          width := 256;
                       end if;
                       if width > columnWidths( i ) then
                          columnWidths( i ) := width;
                       end if;
                    end if;
                 end if;
              end loop;
        end loop;

        -- Add up all columns for the total width for a tabular display

        totalWidth := 2;                                        -- left/right marg
        for i in 1..columns( Q ) loop
            if i /= 3 then -- column 3 is type length (not shown)
               totalWidth := totalWidth + columnWidths( i );       -- width of column
               if i /= columns(Q) then                             -- not last col?
                  totalWidth := totalWidth + 3;                    -- 3 char sep
               end if;
            end if;
        end loop;

        -- Rewind the clear and prepare to show the results

        Rewind( Q );
        new_line_retry;

        -- Use a tabular display only if will fit in the current display

        tabularDisplay := totalWidth <= integer( displayInfo.col );

        -- Draw the columns

        if tabularDisplay then
           put_retry( " " );
           for i in 1..columns( Q ) loop
               if i /= 3 then -- column 3 is type length (not shown)
                  put_retry(
                     to_string(
                         ada.strings.unbounded.Head(
                             to_unbounded_string(
                                 column_name( Q, Column_Index_Type( i ) ) )
                         , columnWidths( i ) )
                     )
                  );
                  if i /= columns( Q ) then
                     put_retry( " " & utf_verticalLine & " " );
                  end if;
               end if;
           end loop;
           new_line_retry;
           put_retry( utf_horizontalLine );
           for i in 1..columns( Q ) loop
               if i /= 3 then -- column 3 is type length (not shown)
                  put_retry( ada.strings.unbounded.to_string( columnWidths( i ) * utf_horizontalLine ) );
                  if i /= columns( Q ) then
                     put_retry( utf_horizontalLine & utf_crossedLines & utf_horizontalLine );
                  else
                     put_retry( utf_horizontalLine );
                  end if;
               end if;
           end loop;
           new_line_retry;
        end if;

        -- Draw the query results

        while not end_of_query( Q ) loop
            fetch( Q );
            if tabularDisplay then
               put_retry( " " );
            end if;
            for i in 1..columns( Q ) loop
                if i /= 3 then -- column 3 is type length (not shown)
                   if tabularDisplay then
                      if is_null( Q, Column_Index_Type( i ) ) then
                         put_retry( inverse( to_string( ada.strings.unbounded.Head( to_unbounded_string( "NULL" ), columnWidths( i ) ) ) ) );
                         wasNull := true;
                      elsif i = 2 then -- column 2 is column type
                         put_retry( to_string( Head( ToEscaped( to_unbounded_string( pg_column_type_to_string( value( Q, Column_Index_Type( i ) ), Value( Q, Column_Index_Type( i+1 ) ) ) ) ), columnWidths( i ) ) ) );
                      elsif i = 4 then
                         put_retry( to_string( Head( ToEscaped( to_unbounded_string( pg_not_null_to_string( value( Q, Column_Index_Type( i ) ) ) ) ), columnWidths( i ) ) ) );
                      elsif i = 5 then
                         put_retry( to_string( Head( ToEscaped( to_unbounded_string( pg_default_to_string( value( Q, Column_Index_Type( i ) ) ) ) ), columnWidths( i ) ) ) );
                      else
                         put_retry( to_string( Head( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ), columnWidths( i ) ) ) );
                      end if;
                      if i /= columns( Q ) then
                         put_retry( " " & utf_verticalLine & " " );
                      end if;
                   else
                      put_retry( to_string( ada.strings.unbounded.head( to_unbounded_string( column_name( Q, Column_Index_Type( i ) ) ), headingWidth ) ) );
                      put_retry( ": " );
                      if is_null( Q, Column_Index_Type( i ) ) then
                         put_retry( inverse( "NULL" ) );
                         wasNull := true;
                      elsif i = 2 then
                         put_retry( bold( to_string( ToEscaped( to_unbounded_string( pg_column_type_to_string( value( Q, Column_Index_Type( i ) ), Value( Q, Column_Index_Type( i+1 ) ) ) ) ) ) ) );
                      elsif i = 4 then
                         put_retry( bold( to_string( ToEscaped( to_unbounded_string( pg_not_null_to_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) ) );
                      elsif i = 5 then
                         put_retry( bold( to_string( ToEscaped( to_unbounded_string( pg_default_to_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) ) );
                      else
                         put_retry( bold( to_string( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) );
                      end if;
                      new_line_retry;
                   end if;
                end if;
            end loop;
            new_line_retry;
        end loop;
     end if;

     -- Draw the summary line

     if tuples( Q ) = 1 then
        put_retry( " 1 Row" );
     else
        put_retry( Tuple_Index_Type'image( tuples( Q ) ) );
        put_retry( " Rows" );
     end if;
     if wasNull then
        put_retry( " with nulls" );
     end if;
     if columns( Q ) = 1 then
        put_retry( " and 1 Column" );
     else
        put_retry( " and" );
        put_retry( integer'image( columns( Q ) ) );
        put_retry( " Columns" );
     end if;
     new_line_retry;
     prepare( Q, "select c.relname, i.indisprimary, i.indisunique, i.indkey from pg_index i, pg_class c" &
                 " where c.oid = i.indexrelid and i.indrelid in " &
                 " (select i.indrelid from pg_index, pg_class c2 where i.indrelid = c2.oid and c2.relname='" & to_string( exprVal ) & "') order by c.relname" );
     execute( Q, connection.PG_C );
     if tuples( Q ) > 0 then
        put_line_retry( "Indexes:" );
        while not end_of_query( Q ) loop
            fetch( Q );
            put_retry( "    " );
            declare
               indexName   : constant string := Value( Q, 1 );
               primaryKey  : constant string := Value( Q, 2 );
               uniqueIndex : constant string := Value( Q, 3 );
               colList     : constant string := Value( Q, 4 );
            begin
               put_retry( bold( indexName ) );
               put_retry( " " );
               if primaryKey = "t" then
                  put_retry( "primary key " );
               end if;
               if uniqueIndex = "t" then
                  put_retry( "unique " );
               end if;
               put_retry( "on columns " );
               put_retry( bold( colList ) );
            end;
            new_line_retry;
        end loop;
     end if;

     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMSchema;

#else

procedure ParseDBMSchema renames not_configured;

#end if;
#if POSTGRES

procedure ParseDBMUsers is
  -- Syntax: dbm.users
  -- Source: N/A
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
  connectId : identifier;
  connection : resPtr;
  Q : APQ.PostgreSQL.Client.Query_Type;
begin
  expect( dbm_users_t );
  ParseSingleInOutParameter( dbm_users_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
     if is_connected( connection.PG_C ) then
        -- Show tablename and kind, lookup owner from another table.
        -- Don't show tables owned by postgres (user 1), TOAST tables or indexes
        prepare( Q, "select usename as " & '"' & "User Name" & '"' &
                    ", usesysid as " & '"' & "User ID" & '"' &
                    ", usesuper as " & '"' & "Attributes" & '"' &
                    ", usecreatedb from pg_user order by usename" );
        execute( Q, connection.PG_C );

        -- Initially, the columns widths are the widths of the headings

        for i in 1..columns( Q ) loop
            columnWidths( i ) := column_name( Q, Column_Index_Type( i ) )'length;
            if columnWidths( i ) < 4 then -- room for NULL on tabular display
               columnWidths( i ) := 4;
            end if;
            if headingWidth < columnWidths( i ) then
               headingWidth := columnWidths( i );
            end if;
        end loop;

        -- Check query results and adjust the columns widths for the longest
        -- results.

        while not end_of_query( Q ) loop
              fetch( Q );
              for i in 1..columns( Q ) loop
                 if not is_null( Q, Column_Index_Type( i ) ) then
                    if i = 3 then -- column 3 and 4 are attributes
                       width := ada.strings.unbounded.length( to_unbounded_string( pg_userattributes_to_string( Value( Q, Column_Index_Type( i ) ), Value( Q, Column_Index_Type( i ) ) ) ) );
                    elsif i = 4 then
                       null;
                    else
                       width := ada.strings.unbounded.length( to_unbounded_string( Value( Q, Column_Index_Type( i ) ) ) );
                    end if;
                    if width > 256 then
                       width := 256;
                    end if;
                    if width > columnWidths( i ) then
                       columnWidths( i ) := width;
                    end if;
                 end if;
              end loop;
        end loop;

        -- Add up all columns for the total width for a tabular display

        totalWidth := 2;                                        -- left/right marg
        for i in 1..columns( Q ) loop
            totalWidth := totalWidth + columnWidths( i );       -- width of column
            if i /= columns(Q) then                             -- not last col?
               totalWidth := totalWidth + 3;                    -- 3 char sep
            end if;
        end loop;

        -- Rewind the clear and prepare to show the results

        Rewind( Q );
        new_line_retry;

        -- Use a tabular display only if will fit in the current display

        tabularDisplay := totalWidth <= integer( displayInfo.col );

        -- Draw the columns

        if tabularDisplay then
           put_retry( " " );
           for i in 1..columns( Q ) loop
               if i /= 4 then
                  put_retry(
                     to_string(
                         ada.strings.unbounded.Head(
                             to_unbounded_string(
                                 column_name( Q, Column_Index_Type( i ) ) )
                         , columnWidths( i ) )
                     )
                  );
                  if i /= 3 then
                     put_retry( " " & utf_verticalLine & " " );
                  end if;
               end if;
           end loop;
           new_line_retry;
           put_retry( utf_horizontalLine );
           for i in 1..columns( Q ) loop
               if i /= 4 then
                  put_retry( ada.strings.unbounded.to_string( columnWidths( i ) * utf_horizontalLine ) );
                  if i /= 3 then
                     put_retry( utf_horizontalLine & utf_crossedLines & utf_horizontalLine );
                  else
                     put_retry( utf_horizontalLine );
                  end if;
               end if;
           end loop;
           new_line_retry;
        end if;

        -- Draw the query results

        while not end_of_query( Q ) loop
            fetch( Q );
            if tabularDisplay then
               put_retry( " " );
            end if;
            for i in 1..columns( Q ) loop
                if i /= 4 then
                   if tabularDisplay then
                      if is_null( Q, Column_Index_Type( i ) ) then
                         put_retry( inverse( to_string( ada.strings.unbounded.Head( to_unbounded_string( "NULL" ), columnWidths( i ) ) ) ) );
                         wasNull := true;
                      elsif i = 2 then -- right-aligned
                         put_retry( to_string( Tail( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ), columnWidths( i ) ) ) );
                      elsif i = 3 then -- column 3 and 4 are attributes
                         put_retry( to_string( Head( ToEscaped( to_unbounded_string( pg_userattributes_to_string( value( Q, Column_Index_Type( i ) ), Value( Q, Column_Index_Type( i ) ) ) ) ), columnWidths( i ) ) ) );
                      else
                         put_retry( to_string( Head( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ), columnWidths( i ) ) ) );
                      end if;
                      if i /= 3 then
                         put_retry( " " & utf_verticalLine & " " );
                      end if;
                   else
                      put_retry( to_string( ada.strings.unbounded.head( to_unbounded_string( column_name( Q, Column_Index_Type( i ) ) ), headingWidth ) ) );
                      put_retry( ": " );
                      if is_null( Q, Column_Index_Type( i ) ) then
                         put_retry( inverse( "NULL" ) );
                         wasNull := true;
                      elsif i = 3 then -- column 3 and 4 are attributes
                         put_retry( bold( to_string( ToEscaped( to_unbounded_string( pg_userattributes_to_string( value( Q, Column_Index_Type( i ) ), Value( Q, Column_Index_Type( i ) ) ) ) ) ) ) );
                      else
                         put_retry( bold( to_string( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) );
                      end if;
                      new_line_retry;
                   end if;
                end if;
            end loop;
            new_line_retry;
        end loop;
     end if;

     -- Draw the summary line

     if tuples( Q ) = 1 then
        put_retry( " 1 Row" );
     else
        put_retry( Tuple_Index_Type'image( tuples( Q ) ) );
        put_retry( " Rows" );
     end if;
     if wasNull then
        put_retry( " with nulls" );
     end if;
     if columns( Q ) = 1 then
        put_retry( " and 1 Column" );
     else
        put_retry( " and" );
        put_retry( integer'image( columns( Q ) ) );
        put_retry( " Columns" );
     end if;
     new_line_retry;
     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMUsers;

#else

procedure ParseDBMUsers renames not_configured;

#end if;
#if POSTGRES

procedure ParseDBMDatabases is
  -- Syntax: dbm.databases( c )
  -- Source: N/A
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
  connectId : identifier;
  connection : resPtr;
  Q : APQ.PostgreSQL.Client.Query_Type;
begin
  expect( dbm_databases_t );
  ParseSingleInOutParameter( dbm_databases_t, connectId, dbm_connection_t );
  if isExecutingCommand then
     begin
       findConnection( connectId, connection );
     if is_connected( connection.PG_C ) then
        -- Show tablename and kind, lookup owner from another table.
        -- Don't show tables owned by postgres (user 1), TOAST tables or indexes
        prepare( Q, "select d.datname as " & '"' & "Name" & '"' &
                    ", u.usename as " & '"' & "Owner" & '"' &
                    " from pg_database d, pg_user u where u.usesysid = d.datdba order by d.datname" );
        execute( Q, connection.PG_C );

        -- Initially, the columns widths are the widths of the headings

        for i in 1..columns( Q ) loop
            columnWidths( i ) := column_name( Q, Column_Index_Type( i ) )'length;
            if columnWidths( i ) < 4 then -- room for NULL on tabular display
               columnWidths( i ) := 4;
            end if;
            if headingWidth < columnWidths( i ) then
               headingWidth := columnWidths( i );
            end if;
        end loop;

        -- Check query results and adjust the columns widths for the longest
        -- results.

        while not end_of_query( Q ) loop
              fetch( Q );
              for i in 1..columns( Q ) loop
                 if not is_null( Q, Column_Index_Type( i ) ) then
                    if i = 3 then -- column 2 is table type
                       width := ada.strings.unbounded.length( to_unbounded_string( pg_kind_to_string( Value( Q, Column_Index_Type( i ) ) ) ) );
                    else
                       width := ada.strings.unbounded.length( to_unbounded_string( Value( Q, Column_Index_Type( i ) ) ) );
                    end if;
                    if width > 256 then
                       width := 256;
                    end if;
                    if width > columnWidths( i ) then
                       columnWidths( i ) := width;
                    end if;
                 end if;
              end loop;
        end loop;

        -- Add up all columns for the total width for a tabular display

        totalWidth := 2;                                        -- left/right marg
        for i in 1..columns( Q ) loop
            totalWidth := totalWidth + columnWidths( i );       -- width of column
            if i /= columns(Q) then                             -- not last col?
               totalWidth := totalWidth + 3;                    -- 3 char sep
            end if;
        end loop;

        -- Rewind the clear and prepare to show the results

        Rewind( Q );
        new_line_retry;

        -- Use a tabular display only if will fit in the current display

        tabularDisplay := totalWidth <= integer( displayInfo.col );

        -- Draw the columns

        if tabularDisplay then
           put_retry( " " );
           for i in 1..columns( Q ) loop
               put_retry(
                  to_string(
                      ada.strings.unbounded.Head(
                          to_unbounded_string(
                              column_name( Q, Column_Index_Type( i ) ) )
                      , columnWidths( i ) )
                  )
               );
               if i /= columns( Q ) then
                  put_retry( " " & utf_verticalLine & " " );
               end if;
           end loop;
           new_line_retry;
           put_retry( utf_horizontalLine );
           for i in 1..columns( Q ) loop
               put_retry( ada.strings.unbounded.to_string( columnWidths( i ) * utf_horizontalLine ) );
               if i /= columns( Q ) then
                  put_retry( utf_horizontalLine & utf_crossedLines & utf_horizontalLine );
               else
                  put_retry( utf_horizontalLine );
               end if;
           end loop;
           new_line_retry;
        end if;

        -- Draw the query results

        while not end_of_query( Q ) loop
            fetch( Q );
            if tabularDisplay then
               put_retry( " " );
            end if;
            for i in 1..columns( Q ) loop
                if tabularDisplay then
                   if is_null( Q, Column_Index_Type( i ) ) then
                      put_retry( inverse( to_string( ada.strings.unbounded.Head( to_unbounded_string( "NULL" ), columnWidths( i ) ) ) ) );
                      wasNull := true;
                   elsif i = 3 then -- column 2 is table type
                      put_retry( to_string( Head( ToEscaped( to_unbounded_string( pg_kind_to_string( value( Q, Column_Index_Type( i ) ) ) ) ), columnWidths( i ) ) ) );
                   else
                      put_retry( to_string( Head( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ), columnWidths( i ) ) ) );
                   end if;
                   if i /= columns( Q ) then
                      put_retry( " " & utf_verticalLine & " " );
                   end if;
                else
                   put_retry( to_string( ada.strings.unbounded.head( to_unbounded_string( column_name( Q, Column_Index_Type( i ) ) ), headingWidth ) ) );
                   put_retry( ": " );
                   if is_null( Q, Column_Index_Type( i ) ) then
                      put_retry( inverse( "NULL" ) );
                      wasNull := true;
                   elsif i = 3 then
                      put_retry( bold( to_string( ToEscaped( to_unbounded_string( pg_kind_to_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) ) );
                   else
                      put_retry( bold( to_string( ToEscaped( to_unbounded_string( value( Q, Column_Index_Type( i ) ) ) ) ) ) );
                   end if;
                   new_line_retry;
                end if;
            end loop;
            new_line_retry;
        end loop;
     end if;

     -- Draw the summary line

     if tuples( Q ) = 1 then
        put_retry( " 1 Row" );
     else
        put_retry( Tuple_Index_Type'image( tuples( Q ) ) );
        put_retry( " Rows" );
     end if;
     if wasNull then
        put_retry( " with nulls" );
     end if;
     if columns( Q ) = 1 then
        put_retry( " and 1 Column" );
     else
        put_retry( " and" );
        put_retry( integer'image( columns( Q ) ) );
        put_retry( " Columns" );
     end if;
     new_line_retry;
     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMDatabases;

#else

procedure ParseDBMDatabases renames not_configured;

#end if;
#if POSTGRES

--procedure DoSQLSelect( sqlcmd : unbounded_string ) is
--begin
--  if isExecutingCommand then
--     prepare( Q, to_string( sqlcmd ) );
--     DBShowIt;
--  end if;
--end DoSQLSelect;
--
--procedure DoSQLStatement( sqlcmd : unbounded_string ) is
--begin
--  if isExecutingCommand then
--     prepare( Q, to_string( sqlcmd ) );
--     begin
--       Execute( Q, C );
--     exception when not_connected =>
--       err( "not connected" );
--     when abort_state =>
--       err( "in abort state" );
--     when sql_error =>
--       err( Error_Message( Q ) );
--     when others =>
--       err( "exception raised" );
--     end;
--  end if;
--end DoSQLStatement;

-----------------------------------------------------------------------------
--  NEW CONNECTION
--
-- Syntax: dbm.new_connection( c )
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBMNewConnection is
  resId : resHandleId;
  ref : reference;
begin
  expect( dbm_new_connection_t );
  ParseSingleOutParameter( dbm_new_connection_t, ref, dbm_connection_t );
  if baseTypesOK( ref.kind, dbm_connection_t ) then
      null;
  end if;
  if isExecutingCommand then
     identifiers( ref.id ).resource := true;
     declareResource( resId, postgresql_connection, getIdentifierBlock( ref.id ) );
     AssignParameter( ref, to_unbounded_string( resId ) );
  end if;
end ParseDBMNewConnection;

#else

procedure ParseDBMNewConnection renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  NEW QUERY
--
-- Syntax: dbm.new_connection( q )
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBMNewQuery is
  resId : resHandleId;
  ref : reference;
begin
  expect( dbm_new_query_t );
  ParseSingleOutParameter( dbm_new_query_t, ref, dbm_query_t );
  if baseTypesOK( ref.kind, dbm_query_t ) then
      null;
  end if;
  if isExecutingCommand then
     identifiers( ref.id ).resource := true;
     declareResource( resId, postgresql_query, getIdentifierBlock( ref.id ) );
     AssignParameter( ref, to_unbounded_string( resId ) );
  end if;
end ParseDBMNewQuery;

#else

procedure ParseDBMNewQuery renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  FETCH VALUES
--
-- Syntax: dbm.fetch_values( Q, C, r );
-- Source: N/A
-- Fetch a row, reading all values into record r.  The column names must match
-- the fields in the record (the record fields need not be in the same order
-- as the query results).
-----------------------------------------------------------------------------

procedure ParseDBMFetchValues is
  queryId : identifier;
  query : resPtr;
  connectionId : identifier;
  connection : resPtr;
  id : identifier;
  --ref : reference;
begin
  expect( dbm_fetch_values_t );
  ParseFirstInOutParameter( dbm_fetch_values_t, queryId, dbm_query_t );
  ParseNextInOutParameter( dbm_fetch_values_t, connectionId, dbm_connection_t );
  -- TODO: ref type is meaningless here since you can't autodeclare
  ParseLastInOutRecordParameter( dbm_fetch_values_t, id  );
-- TODO: is kind in the reference?
  if identifiers( getBaseType( identifiers( id ).kind ) ).kind /= root_record_t then
     err( +"Record type expected" );
  end if;
  if isExecutingCommand then
     declare
       fieldsInRecord : long_integer;
       searchName : unbounded_string;
       found : boolean;
       field : unbounded_string;
       elementKind : identifier;
     begin
       -- get the resources
       findConnection( connectionId, connection );
       findConnection( queryId, query );

       -- fetch the next row
       Fetch( query.pg_q );

       -- confirm the length
-- TODO: is kind in the reference?
       fieldsInRecord := long_integer'value( to_string( identifiers( identifiers( id ).kind ).value.all ) );
--put_line( "fields in record = " &fieldsInRecord'img ); -- DEBUG
--put_line( "fields in query = " & integer'image( columns( query.Q ) ) ); -- DEBUG
       if long_integer( columns( query.PG_Q ) ) /= fieldsInRecord then
          err( pl( "record has" & fieldsInRecord'img & " field(s) but the query returns" & integer'image( columns( query.PG_Q ) ) ) );
       else
          for fieldNumber in 1..fieldsInRecord loop

          -- we have a label and a value.  the record field is stored in the
          -- symbol table as rec.field.  Prepend the record name and search
          -- the symbol table for the record field.  When found, cast the
          -- value and assign it.  Otherwise, if the field is not found, it
          -- is an error.
             found := false;

             searchName := identifiers( id ).name & "." & column_name( query.PG_Q, column_index_type( fieldNumber ) );
             for j in reverse 1..identifiers_top-1 loop
                 if identifiers( j ).name = searchName then
                    found := true;
                    if not error_found then
                       field := to_unbounded_string( value( query.PG_Q, Column_Index_Type( fieldNumber ) ) );
                       elementKind := getBaseType( identifiers( j ).kind );
                       if elementKind = boolean_t then
                          -- a PostgreSQL boolean isn't exactly the same as an Ada boolean
                          declare
                            lf : numericValue;
                          begin
                            lf := to_numeric( field );
                            if lf = 0.0 then
                               identifiers( j ).value.all := identifiers( false_t ).value.all;
                            else
                               identifiers( j ).value.all := identifiers( true_t ).value.all;
                            end if;
                          exception when constraint_error =>
                            err( pl( to_string( searchName ) & " is boolean but query value is not numeric" ) );
                          end;
                       --elsif getUniType( elementKind ) = root_enumerated_t then
                       -- TODO: non-boolean enumerated.  See scanner.adb
                       -- for how to search for an enumerated item.
                       -- Not trying to map to PostgreSQL enumerated types.
                       elsif getUniType( elementKind ) = uni_string_t then
-- TODO: shouldn't catToType be used here to guarantee character values are
-- only one letter long (probably doesn't matter for JSON, but matters here)
                          -- identifiers( j ).value := field;
                          identifiers( j ).value.all := castToType( field,
                            identifiers( j ).kind );
                       elsif getUniType( elementKind ) = uni_numeric_t then
                          declare
                            lf : numericValue;
                          begin
                            lf := to_numeric( field );
                            identifiers( j ).value.all := castToType( field,
                              identifiers( j ).kind );
                          exception when constraint_error =>
                            err( pl( to_string( searchName ) & " is numeric but query value is not numeric" ) );
                          end;
                       elsif getUniType( elementKind ) = universal_t then
                            identifiers( j ).value.all := field;
                       else
                          err( +"unsupported data type" );
                       end if;
                    end if;
                 end if;
             end loop;
             if not found then
                err( unb_em( searchName ) & pl( " does not exist" ) );
             end if;
          end loop;
       end if;

     exception when no_tuple =>
       err( +"no tuple" );
     when null_value =>
       err( +"null value" );
     when no_column =>
       err( +"no column" );
     when no_result =>
       err( +"no result" );
     --when sql_error =>
     --  err( Error_Message( Q ) );
     when others =>
       err_exception_raised;
       --if sourceLen = long_integer'value( to_string( identifiers( identifiers( target_var_id ).kind ).value ) ) then
-- TODO: no_coumn, no_result, null_value, no_tuple, etc exception handling
     end;
null;
  end if;
end ParseDBMFetchValues;

#else

procedure ParseDBMFetchValues renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND FOR INSERT
--
-- Syntax: dbm.append_for_insert( Q, C, r );
-- Source: N/A
-- append the fields of record r to the query in the format of an ANSI SQL insert
-- " ( a, b, ... ) VALUES ( 'a', 'b', ... )"
-----------------------------------------------------------------------------

procedure ParseDBMAppendForInsert is
  queryId : identifier;
  query : resPtr;
  connectionId : identifier;
  connection : resPtr;
  id : identifier;
begin
  expect( dbm_append_for_insert_t );
  ParseFirstInOutParameter( dbm_append_for_insert_t, queryId, dbm_query_t );
  ParseNextInOutParameter( dbm_append_for_insert_t, connectionId, dbm_connection_t );
  -- TODO: ref type is meaningless here since you can't autodeclare
  ParseLastInOutRecordParameter( dbm_append_for_insert_t, id  );
-- TODO: is kind in the reference?
  if identifiers( getBaseType( identifiers( id ).kind ) ).kind /= root_record_t then
     err( +"Record type expected" );
  end if;
  if isExecutingCommand then
     declare
       fieldName : unbounded_string;
       fieldSuffix : unbounded_string;
       dotPos : natural;
       field_t : identifier;
       elementKind : identifier;
       elementUniKind : identifier;
       firstField : boolean := true;
     begin
       -- get the resources
       findConnection( connectionId, connection );
       findConnection( queryId, query );

       append( query.PG_Q, " (" );

       -- The basic logic is copied from DoRecordToJson()
       for i in 1..integer'value( to_string( identifiers( identifiers( id ).kind ).value.all ) ) loop
           for j in 1..identifiers_top-1 loop
               if identifiers( j ).field_of = identifiers( id ).kind then
                  if integer'value( to_string( identifiers( j ).value.all )) = i then
                     fieldName := identifiers( j ).name;
                     dotPos := length( fieldName );
                     while dotPos > 1 loop
                        exit when element( fieldName, dotPos ) = '.';
                        dotPos := dotPos - 1;
                     end loop;
                     fieldSuffix := delete( fieldName, 1, dotPos );
                     fieldName := identifiers( id ).name & "." & fieldSuffix;
                     findIdent( fieldName, field_t );

                     if firstField then
                        firstField := false;
                     else
                        Append( query.PG_Q, "," );
                     end if;
                     Append( query.PG_Q, fieldSuffix );
                  end if;
               end if;
           end loop;
       end loop;

       append( query.PG_Q, " ) VALUES ( " );
       firstField := true;

       for i in 1..integer'value( to_string( identifiers( identifiers( id ).kind ).value.all ) ) loop
           for j in 1..identifiers_top-1 loop
               if identifiers( j ).field_of = identifiers( id ).kind then
                  if integer'value( to_string( identifiers( j ).value.all )) = i then
                     if firstField then
                        firstField := false;
                     else
                        Append( query.PG_Q, "," );
                     end if;
                     fieldName := identifiers( j ).name;
                     dotPos := length( fieldName );
                     while dotPos > 1 loop
                        exit when element( fieldName, dotPos ) = '.';
                        dotPos := dotPos - 1;
                     end loop;
                     fieldSuffix := delete( fieldName, 1, dotPos );
                     fieldName := identifiers( id ).name & "." & fieldSuffix;
                     findIdent( fieldName, field_t );

                     elementKind := getBaseType( identifiers( field_t ).kind );
                     elementUniKind := getUniType( identifiers( field_t ).kind );

                     if elementKind = boolean_t then
                        Append( query.PG_Q, to_string( identifiers( field_t ).value.all ) );
                     elsif elementUniKind = uni_string_t then
-- TODO: shouldn't catToType be used here to guarantee character values are
-- only one letter long (probably doesn't matter for JSON, but matters here)
                          -- identifiers( j ).value := field;
                        Append_Quoted( query.PG_Q, connection.PG_C, to_string( identifiers( field_t ).value.all ) );
                     elsif elementUniKind = uni_numeric_t then
                        Append( query.PG_Q, to_string( identifiers( field_t ).value.all ) );
                     elsif elementUniKind = universal_t then
                        Append_Quoted( query.PG_Q, connection.PG_C, to_string( identifiers( field_t ).value.all ) );
                     else
                         err( +"unsupported data type" );
                     end if;
                  end if;
               end if;
           end loop;
       end loop;
       append( query.PG_Q, " )" );

     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMAppendForInsert;

#else

procedure ParseDBMAppendForInsert renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND FOR UPDATE
--
-- Syntax: dbm.append_for_update( Q, C, r );
-- Source: N/A
-- append the fields of record r to the query in the format of an ANSI SQL update
-- " SET a = 'a', b = 'b', ..."
-----------------------------------------------------------------------------

procedure ParseDBMAppendForUpdate is
  queryId : identifier;
  query : resPtr;
  connectionId : identifier;
  connection : resPtr;
  id : identifier;
begin
  expect( dbm_append_for_update_t );
  ParseFirstInOutParameter( dbm_append_for_update_t, queryId, dbm_query_t );
  ParseNextInOutParameter( dbm_append_for_update_t, connectionId, dbm_connection_t );
  -- TODO: ref type is meaningless here since you can't autodeclare
  ParseLastInOutRecordParameter( dbm_append_for_update_t, id  );
-- TODO: is kind in the reference?
  if identifiers( getBaseType( identifiers( id ).kind ) ).kind /= root_record_t then
     err( +"Record type expected" );
  end if;
  if isExecutingCommand then
     declare
       fieldName : unbounded_string;
       fieldSuffix : unbounded_string;
       dotPos : natural;
       field_t : identifier;
       elementKind : identifier;
       elementUniKind : identifier;
       firstField : boolean := true;
     begin
       -- get the resources
       findConnection( connectionId, connection );
       findConnection( queryId, query );

       Append( query.PG_Q, " SET " );
       -- The basic logic is copied from DoRecordToJson()
     for i in 1..integer'value( to_string( identifiers( identifiers( id ).kind ).value.all ) ) loop
         for j in 1..identifiers_top-1 loop
             if identifiers( j ).field_of = identifiers( id ).kind then
                if integer'value( to_string( identifiers( j ).value.all )) = i then
                   fieldName := identifiers( j ).name;
                   dotPos := length( fieldName );
                   while dotPos > 1 loop
                      exit when element( fieldName, dotPos ) = '.';
                      dotPos := dotPos - 1;
                   end loop;
                   fieldSuffix := delete( fieldName, 1, dotPos );
                   fieldName := identifiers( id ).name & "." & fieldSuffix;
                   findIdent( fieldName, field_t );

                   elementKind := getBaseType( identifiers( field_t ).kind );
                   elementUniKind := getUniType( identifiers( field_t ).kind );

                   if firstField then
                      firstField := false;
                   else
                      Append( query.PG_Q, "," );
                   end if;
                   Append( query.PG_Q, fieldSuffix & "=" );

                   if elementKind = boolean_t then
                      Append( query.PG_Q, identifiers( field_t ).value.all );
                   elsif elementUniKind = uni_string_t then
-- TODO: shouldn't catToType be used here to guarantee character values are
-- only one letter long (probably doesn't matter for JSON, but matters here)
                          -- identifiers( j ).value := field;
                      Append_Quoted( query.PG_Q, connection.PG_C, identifiers( field_t ).value.all );
                   elsif getUniType( elementKind ) = uni_numeric_t then
                      Append( query.PG_Q, identifiers( field_t ).value.all );
                   elsif getUniType( elementKind ) = universal_t then
                      Append_Quoted( query.PG_Q, connection.PG_C, identifiers( field_t ).value.all );
                   else
                       err( +"unsupported data type" );
                   end if;
                 end if;
             end if;
         end loop;
       end loop;
       Append( query.PG_Q, " " );

     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBMAppendForUpdate;

#else

procedure ParseDBMAppendForUpdate renames not_configured;

#end if;

-----------------------------------------------------------------------------
-- Housekeeping
-----------------------------------------------------------------------------

procedure StartupDBM is
begin
  declareNamespace( "dbm" );

  declareIdent( dbm_connection_t, "dbm.connection", positive_t, typeClass );
  identifiers( dbm_connection_t ).usage := limitedUsage;
  identifiers( dbm_connection_t ).resource := true;

  declareIdent( dbm_query_t, "dbm.query", positive_t, typeClass );

  declareIdent( dbm_column_index_type_t, "dbm.column_index_type",
    positive_t, typeClass );

  declareIdent( dbm_tuple_index_type_t, "dbm.tuple_index_type",
    positive_t, typeClass );

  declareIdent( dbm_tuple_count_type_t, "dbm.tuple_count_type",
    db_tuple_index_type_t, subClass );

--  declareIdent( db_trace_mode_type_t, "db.trace_mode_type",
--    root_enumerated_t, typeClass );
--  declareStandardConstant( db_trace_none_t, "db.trace_none",
--    db_trace_mode_type_t, "0" );
--  declareStandardConstant( db_trace_db_t, "db.trace_db",
--    db_trace_mode_type_t, "1" );
--  declareStandardConstant( db_trace_apq_t, "db.trace_apq",
--    db_trace_mode_type_t, "2" );
--  declareStandardConstant( db_trace_full_t, "db.trace_full",
--    db_trace_mode_type_t, "3" );

  declareIdent( dbm_mode_type_t, "dbm.mode_type",
    root_enumerated_t, typeClass );
  declareStandardConstant( dbm_read_t, "dbm.read",
    db_mode_type_t, "0" );
  declareStandardConstant( dbm_write_t, "dbm.write",
    db_mode_type_t, "1" );
  declareStandardConstant( dbm_read_write_t, "dbm.read_write",
    db_mode_type_t, "2" );

--  declareIdent( db_fetch_mode_type_t, "db.fetch_mode_type",
--    root_enumerated_t, typeClass );
--  declareStandardConstant( db_sequential_fetch_t, "db.sequential_fetch",
--    db_fetch_mode_type_t, "0" );
--  declareStandardConstant( db_random_fetch_t, "db.random_fetch",
--    db_fetch_mode_type_t, "1" );

--  declareIdent( db_database_type_t, "db.database_type",
--    root_enumerated_t, typeClass );
--  declareStandardConstant( db_engine_postgresql_t, "db.engine_postgresql",
--    db_database_type_t, "0" );
--  declareStandardConstant( db_engine_mysql_t, "db.engine_mysql",
--    db_database_type_t, "1" );
--  declareStandardConstant( db_engine_oracle_t, "db.engine_oracle",
--    db_database_type_t, "2" );
--  declareStandardConstant( db_engine_sybase_t, "db.engine_sybase",
--    db_database_type_t, "3" );
--  declareStandardConstant( db_engine_db2_t, "db.engine_db2",
--    db_database_type_t, "4" );

  declareProcedure( dbm_new_connection_t, "dbm.new_connection", ParseDBMNewConnection'access );
  declareProcedure( dbm_new_query_t, "dbm.new_query", ParseDBMNewQuery'access );
  declareProcedure( dbm_connect_t, "dbm.connect", ParseDBMConnect'access );
  declareProcedure( dbm_disconnect_t, "dbm.disconnect", ParseDBMDisconnect'access );
  declareFunction(  dbm_is_connected_t, "dbm.is_connected", ParseDBMIsConnected'access );
  declareProcedure( dbm_reset_t, "dbm.reset", ParseDBMReset'access );
  declareFunction(  dbm_error_message_t, "dbm.error_message", ParseDBMErrorMessage'access );
  declareFunction(  dbm_notice_message_t, "dbm.notice_message", ParseDBMNoticeMessage'access );
  declareFunction(  dbm_in_abort_state_t, "dbm.in_abort_state", ParseDBMInAbortState'access );
  declareFunction(  dbm_options_t, "dbm.options", ParseDBMOptions'access );
  declareFunction(  dbm_will_rollback_on_finalize_t, "dbm.will_rollback_on_finalize", ParseDBMWillRollbackOnFinalize'access );
  declareProcedure( dbm_set_rollback_on_finalize_t, "dbm.set_rollback_on_finalize", ParseDBMSetRollbackOnFinalize'access );
  declareProcedure( dbm_open_db_trace_t, "dbm.open_db_trace", ParseDBMOpenDBTrace'access );
  declareProcedure( dbm_close_db_trace_t, "dbm.close_db_trace", ParseDBMCloseDBTrace'access );
  declareProcedure( dbm_set_trace_t, "dbm.set_trace", ParseDBMSetTrace'access );
  declareFunction(  dbm_is_trace_t, "dbm.is_trace", ParseDBMIsTrace'access );
  declareProcedure( dbm_clear_t, "dbm.clear", ParseDBMClear'access );
  declareProcedure( dbm_prepare_t, "dbm.prepare", ParseDBMPrepare'access );
  declareProcedure( dbm_append_t, "dbm.append", ParseDBMAppend'access );
  declareProcedure( dbm_append_line_t, "dbm.append_line", ParseDBMAppendLine'access );
  declareProcedure( dbm_append_quoted_t, "dbm.append_quoted", ParseDBMAppendQuoted'access );
  declareProcedure( dbm_execute_t, "dbm.execute", ParseDBMExecute'access );
  declareProcedure( dbm_execute_checked_t, "dbm.execute_checked", ParseDBMExecuteChecked'access );
  declareProcedure( dbm_raise_exceptions_t, "dbm.raise_exceptions", ParseDBMRaiseExceptions'access );
  declareProcedure( dbm_report_errors_t, "dbm.report_errors", ParseDBMReportErrors'access );
  declareProcedure( dbm_begin_work_t, "dbm.begin_work", ParseDBMBeginWork'access );
  declareProcedure( dbm_commit_work_t, "dbm.commit_work", ParseDBMCommitWork'access );
  declareProcedure( dbm_rollback_work_t, "dbm.rollback_work", ParseDBMRollbackWork'access );
  declareProcedure( dbm_rewind_t, "dbm.rewind", ParseDBMRewind'access );
  declareProcedure( dbm_fetch_t, "dbm.fetch", ParseDBMFetch'access );
  declareFunction(  dbm_end_of_query_t, "dbm.end_of_query", ParseDBMEndOfQuery'access );
  declareFunction(  dbm_tuple_t, "dbm.tuple", ParseDBMTuple'access );
  declareFunction(  dbm_tuples_t, "dbm.tuples", ParseDBMTuples'access );
  declareFunction(  dbm_columns_t, "dbm.columns", ParseDBMColumns'access );
  declareFunction(  dbm_column_name_t, "dbm.column_name", ParseDBMColumnName'access );
  declareFunction(  dbm_column_index_t, "dbm.column_index", ParseDBMColumnIndex'access );
  --declareFunction(  dbm_column_type_t, "dbm.column_type" );
  declareFunction(  dbm_is_null_t, "dbm.is_null", ParseDBMIsNull'access );
  declareFunction(  dbm_value_t, "dbm.value", ParseDBMValue'access );
  declareFunction(  dbm_engine_of_t, "dbm.engine_of", ParseDBMEngineOf'access );
  declareProcedure( dbm_show_t, "dbm.show", ParseDBMShow'access );
  declareProcedure( dbm_list_t, "dbm.list", ParseDBMList'access );
  declareProcedure( dbm_schema_t, "dbm.schema", ParseDBMSchema'access );
  declareProcedure( dbm_users_t, "dbm.users", ParseDBMUsers'access );
  declareProcedure( dbm_databases_t, "dbm.databases", ParseDBMDatabases'access );

  declareProcedure( dbm_fetch_values_t, "dbm.fetch_values", ParseDBMFetchValues'access );
  declareProcedure( dbm_append_for_insert_t, "dbm.append_for_insert", ParseDBMAppendForInsert'access );
  declareProcedure( dbm_append_for_update_t, "dbm.append_for_update", ParseDBMAppendForUpdate'access );

  --declareFunction( db_do_t, "db.do" );
  --declareFunction( db_fetchrow_t, "dbi.fetchrow" );

  --declareFunction( dbi_prepare_t, "dbi.prepare" );

  declareNamespaceClosed( "dbm" );
end StartupDBM;

procedure ShutdownDBM is
begin
  null;
end ShutdownDBM;

end parser_dbm;
