------------------------------------------------------------------------------
-- 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.text_io,
#if POSTGRES
     APQ.PostgreSQL.Client,
     pegasoft.pg,
#end if;
     spar_os.tty,
     signal_flags,
     pegasoft.strings,
     pegasoft.user_io,
     world.utf8,
     scanner,
     scanner.communications,
     parser,
     parser_params;
use  ada.text_io,
#if POSTGRES
     APQ,
     APQ.PostgreSQL,
     APQ.PostgreSQL.Client,
     pegasoft.pg,
#end if;
     spar_os.tty,
     signal_flags,
     pegasoft,
     pegasoft.strings,
     pegasoft.user_io,
     world,
     world.utf8,
     scanner,
     scanner.communications,
     parser,
     parser_params;

package body parser_db is

------------------------------------------------------------------------------
-- Database package identifiers
--
-- These will eventually be moved to the Database parser
------------------------------------------------------------------------------

db_connect_t      : identifier;
db_disconnect_t   : identifier;
db_is_connected_t : identifier;
db_reset_t        : identifier;
db_error_message_t: identifier;
db_notice_message_t: identifier;
db_in_abort_state_t: identifier;
db_options_t      : identifier;
db_will_rollback_on_finalize_t : identifier;
db_set_rollback_on_finalize_t : identifier;
db_open_db_trace_t: identifier;
db_close_db_trace_t: identifier;
db_set_trace_t    : identifier;
db_is_trace_t     : identifier;
db_clear_t        : identifier;
db_prepare_t      : identifier;
db_append_t       : identifier;
db_append_line_t  : identifier;
db_append_quoted_t: identifier;
db_execute_t      : identifier;
db_execute_checked_t : identifier;
db_raise_exceptions_t : identifier;
db_report_errors_t : identifier;
db_begin_work_t   : identifier;
db_commit_work_t  : identifier;
db_rollback_work_t : identifier;
db_rewind_t : identifier;
db_fetch_t : identifier;
db_end_of_query_t : identifier;
db_tuple_t        : identifier;
db_tuples_t       : identifier;
db_columns_t      : identifier;
db_column_name_t  : identifier;
db_column_index_t : identifier;
--db_column_type_t  : identifier;
db_is_null_t      : identifier;
db_value_t        : identifier;
db_engine_of_t    : identifier;
db_show_t         : identifier;
db_list_t         : identifier;
db_schema_t       : identifier;
db_users_t        : identifier;
db_databases_t    : identifier;

#if POSTGRES

Q : Query_Type;
C : Connection_Type;
-- for the time being, a single query

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

procedure ParseDBConnect is
  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;
begin
  expect( db_connect_t );
  if engineOpen then
     err( +"only one database connection may be open" );
     return;
  end if;
  ParseFirstStringParameter( db_connect_t, dbnameExpr, dbnameType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( db_connect_t, userExpr, userType, string_t );
     hasUser := true;
     if token = symbol_t and identifiers( token ).value.all = "," then
        ParseNextStringParameter( db_connect_t, pswdExpr, pswdType, string_t );
        if token = symbol_t and identifiers( token ).value.all = "," then
           ParseNextStringParameter( db_connect_t, hostExpr, hostType, string_t );
           hasHost := true;
           if token = symbol_t and identifiers( token ).value.all = "," then
              ParseNextNumericParameter( db_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
       begin
         Set_DB_Name( 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( 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( 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( C, integer( to_numeric( portExpr ) ) );
          exception when others =>
             err( pl ( "Internal error: set_port " ) &
                  em_value( portExpr ) &
                  pl( " failed" ) );
          end;
       end if;
       Connect( 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( C ) & ", Password " & Password( C )
           & ", Host " & Host_Name( C ) & "and Port " & integer'image( Port( C ) ) & " " & DB_Name( 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 ParseDBConnect;

#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 ParseDBConnect renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  ENGINE OF
--
-- Syntax: b := db.engine_of;
-- Source: APQ.Engine_Of
-----------------------------------------------------------------------------

procedure ParseDBEngineOf( result : out unbounded_string; kind : out identifier ) is
begin
  kind := db_database_type_t;
  expect( db_engine_of_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( integer'image( Database_Type'pos( Engine_Of( 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 ParseDBEngineOf;

#else

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

#end if;
#if POSTGRES

-- this is not used
--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;

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

procedure ParseDBPrepare is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  afterExpr : unbounded_string;
  afterType : identifier;
  hasAfter  : boolean := false;
begin
  expect( db_prepare_t );
  ParseFirstStringParameter( db_prepare_t, sqlExpr, sqlType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( db_prepare_t, afterExpr, afterType, string_t );
     hasAfter := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       if hasAfter then
          Prepare( Q, to_string( sqlExpr ), to_string( afterExpr ) );
       else
          Prepare( Q, to_string( sqlExpr ) );
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBPrepare;

#else

procedure ParseDBPrepare renames not_configured;

#end if;
#if POSTGRES

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

procedure ParseDBAppend is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  afterExpr : unbounded_string;
  afterType : identifier;
  hasAfter  : boolean := false;
begin
  expect( db_append_t );
  ParseFirstStringParameter( db_append_t, sqlExpr, sqlType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( db_append_t, afterExpr, afterType, string_t );
     hasAfter := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       if hasAfter then
          Append( Q, to_string( sqlExpr ), to_string( afterExpr ) );
       else
          Append( Q, to_string( sqlExpr ) );
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBAppend;

#else

procedure ParseDBAppend renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND LINE
--
-- Syntax: db.append_line( sqlstmt );
-- Source: APQ.Append_Line
-----------------------------------------------------------------------------

procedure ParseDBAppendLine is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
begin
  expect( db_append_line_t );
  ParseSingleStringParameter( db_append_line_t, sqlExpr, sqlType, string_t );
  if isExecutingCommand then
     begin
       Append_Line( Q, to_string( sqlExpr ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBAppendLine;

#else

procedure ParseDBAppendLine renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  APPEND QUOTED
--
-- Syntax: db.append_quoted( sqlstmt [,after] );
-- Source: APQ.Quoted
-----------------------------------------------------------------------------

procedure ParseDBAppendQuoted is
  sqlExpr   : unbounded_string;
  sqlType   : identifier;
  afterExpr : unbounded_string;
  afterType : identifier;
  hasAfter  : boolean := false;
begin
  expect( db_append_quoted_t );
  ParseFirstStringParameter( db_append_quoted_t, sqlExpr, sqlType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( db_append_quoted_t, afterExpr, afterType, string_t );
     hasAfter := true;
  end if;
  expect( symbol_t, ")" );
  if isExecutingCommand then
     begin
       if hasAfter then
          Append_Quoted( Q, C, to_string( sqlExpr ), to_string( afterExpr ) );
       else
          Append_Quoted( Q, C, to_string( sqlExpr ) );
       end if;
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBAppendQuoted;

#else

procedure ParseDBAppendQuoted renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  EXECUTE
--
-- Syntax: db.execute
-- Source: APQ.Execute
-----------------------------------------------------------------------------

procedure ParseDBExecute is
begin
  expect( db_execute_t );
  if isExecutingCommand then
     begin
       Execute( Q, C );
     exception when not_connected =>
       err( +"not connected" );
     when abort_state =>
       err( +"in abort state" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBExecute;

#else

procedure ParseDBExecute renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  EXECUTE CHECKED
--
-- Syntax: db.execute_checked( [ msg ] );
-- Source: APQ.Execute_Checked
-----------------------------------------------------------------------------

procedure ParseDBExecuteChecked is
  msgExpr   : unbounded_string;
  msgType   : identifier;
  hasMsg    : boolean := false;
begin
  expect( db_execute_checked_t );
  if token = symbol_t and identifiers( token ).value.all = "(" then
     ParseSingleStringParameter( db_execute_checked_t, msgExpr, msgType, string_t );
     hasMsg := true;
  end if;
  if isExecutingCommand then
     begin
       if hasMsg then
          Execute_Checked( Q, C, to_string( msgExpr ) );
       else
          Execute_Checked( Q, C );
       end if;
     exception when not_connected =>
       err( +"not connected" );
     when abort_state =>
       err( +"in abort state" );
     when sql_error =>
       err( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBExecuteChecked;

#else

procedure ParseDBExecuteChecked 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: db.disconnect;
-- Source: APQ.Disconnect
-----------------------------------------------------------------------------

procedure ParseDBDisconnect is
begin
  expect( db_disconnect_t );
  if isExecutingCommand then
     begin
        Disconnect( 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 ParseDBDisconnect;

#else

procedure ParseDBDisconnect renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  IS CONNECTED
--
-- Syntax: db.is_connected
-- APQ.Is_Connected
-----------------------------------------------------------------------------

procedure ParseDBIsConnected( result : out unbounded_string; kind : out identifier ) is
begin
  kind := boolean_t;
  expect( db_is_connected_t );
  if isExecutingCommand then
     begin
       result := to_bush_boolean( is_connected( C ) );
     exception when others =>
       result := to_bush_boolean( false );
     end;
  end if;
end ParseDBIsConnected;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  RESET
--
-- Syntax: db.reset
-- Source: APQ.Reset
-----------------------------------------------------------------------------

procedure ParseDBReset is
begin
  expect( db_reset_t );
  if isExecutingCommand then
     begin
       Reset( C );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBReset;

#else

procedure ParseDBReset renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  ERROR MESSAGE
--
-- Syntax: db.error_message
-- Source: APQ.Error_Message
-----------------------------------------------------------------------------

procedure ParseDBErrorMessage( result : out unbounded_string; kind : out identifier ) is
begin
  kind := string_t;
  expect( db_error_message_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Error_Message( C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBErrorMessage;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  NOTICE MESSAGE
--
-- Syntax: db.notice_message
-- Source: APQ.Notice_Message
-----------------------------------------------------------------------------

procedure ParseDBNoticeMessage( result : out unbounded_string; kind : out identifier ) is
begin
  kind := string_t;
  expect( db_notice_message_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Notice_Message( C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBNoticeMessage;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  IN ABORT STATE
--
-- Syntax: b := db.in_abort_state
-- Source: APQ.In_Abort_State
-----------------------------------------------------------------------------

procedure ParseDBInAbortState( result : out unbounded_string; kind : out identifier ) is
begin
  kind := boolean_t;
  expect( db_in_abort_state_t );
  if isExecutingCommand then
     begin
       result := to_bush_boolean( In_Abort_State( C ) );
     exception when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBInAbortState;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  OPTIONS
--
-- Syntax: db.options
-- Source: APQ.Options
-----------------------------------------------------------------------------

procedure ParseDBOptions( result : out unbounded_string; kind : out identifier ) is
begin
  kind := string_t;
  expect( db_options_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Options( C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBOptions;

#else

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

#end if;
#if POSTGRES

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

procedure ParseDBSetRollbackOnFinalize is
  rollExpr : unbounded_string;
  rollType : identifier;
begin
  expect( db_set_rollback_on_finalize_t );
  ParseSingleEnumParameter( db_set_rollback_on_finalize_t, rollExpr, rollType, boolean_t );
  if isExecutingCommand then
     declare
       rollback : constant boolean := rollExpr = to_unbounded_string( "1" );
     begin
       Set_Rollback_On_Finalize( C, rollback );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBSetRollbackOnFinalize;

#else

procedure ParseDBSetRollbackOnFinalize renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  WILL ROLLBACK ON FINALIZE
--
-- Syntax: b := db.will_rollback_on_finalize( b );
-- Source: APQ.Will_Rollback_On_Finalize
-----------------------------------------------------------------------------

procedure ParseDBWillRollbackOnFinalize( result : out unbounded_string; kind : out identifier ) is
begin
  kind := boolean_t;
  expect( db_will_rollback_on_finalize_t );
  if isExecutingCommand then
     begin
       result := to_bush_boolean( Will_Rollback_On_Finalize( C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBWillRollbackOnFinalize;

#else

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

#end if;
#if POSTGRES

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

procedure ParseDBOpenDBTrace is
  fnameExpr : unbounded_string;
  fnameType : identifier;
  modeExpr  : unbounded_string;
  modeType  : identifier;
  traceMode : trace_mode_type;
  hasMode  : boolean := false;
begin
  expect( db_open_db_trace_t );
  ParseFirstStringParameter( db_open_db_trace_t, fnameExpr, fnameType, string_t );
  if token = symbol_t and identifiers( token ).value.all = "," then
     ParseNextStringParameter( db_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
       if hasMode then
          Open_DB_Trace( C, to_string( fnameExpr ), traceMode );
       else
          Open_DB_Trace( 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 ParseDBOpenDBTrace;

#else

procedure ParseDBOpenDBTrace renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  CLOSE DB TRACE
--
-- Syntax: db.close_db_trace( f );
-- Source: APQ.Close_DB_Trace
-----------------------------------------------------------------------------

procedure ParseDBCloseDBTrace is
begin
  expect( db_close_db_trace_t );
  if isExecutingCommand then
     begin
       Close_DB_Trace( C );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBCloseDBTrace;

#else

procedure ParseDBCloseDBTrace renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  SET DB TRACE
--
-- Syntax: db.set_trace( b );
-- Source: APQ.Set_Trace
-----------------------------------------------------------------------------

procedure ParseDBSetTrace is
  traceExpr : unbounded_string;
  traceType : identifier;
begin
  expect( db_set_trace_t );
  ParseSingleEnumParameter( db_set_trace_t, traceExpr, traceType, boolean_t );
  if isExecutingCommand then
     declare
       traceback : constant boolean := traceExpr = to_unbounded_string( "1" );
     begin
       Set_Trace( C, traceback );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBSetTrace;

#else

procedure ParseDBSetTrace renames not_configured;

#end if;
#if POSTGRES

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

procedure ParseDBIsTrace( result : out unbounded_string; kind : out identifier ) is
begin
  kind := boolean_t;
  expect( db_is_trace_t );
  if isExecutingCommand then
     begin
       result := to_bush_boolean( Is_Trace( C ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBIsTrace;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  CLEAR
--
-- Syntax: db.clear;
-- Source: APQ.Clear
-----------------------------------------------------------------------------

procedure ParseDBClear is
begin
  expect( db_clear_t );
  if isExecutingCommand then
     begin
       Clear( Q );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBClear;

#else

procedure ParseDBClear renames not_configured;

#end if;
#if POSTGRES

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

procedure ParseDBRaiseExceptions is
  raiseExpr : unbounded_string;
  raiseType : identifier;
begin
  expect( db_raise_exceptions_t );
  if token = symbol_t and identifiers( token ).value.all = "(" then
     ParseSingleEnumParameter( db_raise_exceptions_t, raiseExpr, raiseType, boolean_t );
  else
     raiseExpr := to_unbounded_string( "1" );
  end if;
  if isExecutingCommand then
     declare
       raise_them : constant boolean := raiseExpr = to_unbounded_string( "1" );
     begin
       Raise_Exceptions( Q, raise_them );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBRaiseExceptions;

#else

procedure ParseDBRaiseExceptions renames not_configured;

#end if;
#if POSTGRES

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

procedure ParseDBReportErrors is
  reportExpr : unbounded_string;
  reportType : identifier;
begin
  expect( db_report_errors_t );
  if token = symbol_t and identifiers( token ).value.all = "(" then
     ParseSingleStringParameter( db_report_errors_t, reportExpr, reportType, boolean_t );
  else
     reportExpr := to_unbounded_string( "1" );
  end if;
  if isExecutingCommand then
     declare
       report_them : constant boolean := reportExpr = to_unbounded_string( "1" );
     begin
       Report_Errors( Q, report_them );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBReportErrors;

#else

procedure ParseDBReportErrors renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  BEGIN WORK
--
-- Syntax: db.begin_work;
-- Source: APQ.Begin_Work
-----------------------------------------------------------------------------

procedure ParseDBBeginWork is
begin
  expect( db_begin_work_t );
  if isExecutingCommand then
     begin
       Begin_Work( Q, C );
     exception when abort_state =>
       err( +"in abort state" );
     when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBBeginWork;

#else

procedure ParseDBBeginWork renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  ROLLBACK WORK
--
-- Syntax: db.rollback_work;
-- Source: APQ.Rollback_Work
-----------------------------------------------------------------------------

procedure ParseDBRollbackWork is
begin
  expect( db_rollback_work_t );
  if isExecutingCommand then
     begin
       Rollback_Work( Q, C );
     exception when abort_state =>
       err( +"in abort state" );
     when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBRollbackWork;

#else

procedure ParseDBRollbackWork renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COMMIT WORK
--
-- Syntax: db.commit_work;
-- Source: APQ.Commit_Work
-----------------------------------------------------------------------------

procedure ParseDBCommitWork is
begin
  expect( db_commit_work_t );
  if isExecutingCommand then
     begin
       Commit_Work( Q, C );
     exception when abort_state =>
       err( +"in abort state" );
     when not_connected =>
       err( +"not connected" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBCommitWork;

#else

procedure ParseDBCommitWork renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  REWIND
--
-- Syntax: db.rewind;
-- Source: APQ.Rewind
-----------------------------------------------------------------------------

procedure ParseDBRewind is
begin
  expect( db_rewind_t );
  if isExecutingCommand then
     begin
       Rewind( Q );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBRewind;

#else

procedure ParseDBRewind renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  FETCH
--
-- Syntax: db.fetch;
-- Source: APQ.Fetch
-----------------------------------------------------------------------------

procedure ParseDBFetch is
  expr_val : unbounded_string;
  expr_type : identifier;
  haveIndex : boolean := false;
begin
  expect( db_fetch_t );
  if token = symbol_t and identifiers( token ).value.all = "(" then
     ParseSingleNumericParameter( db_fetch_t, expr_val, expr_type, db_tuple_index_type_t );
     haveIndex := true;
  end if;
  if isExecutingCommand then
     begin
       if haveIndex then
          Fetch( Q, Tuple_Index_Type( to_numeric( expr_val ) ) );
       else
          Fetch( 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 ParseDBFetch;

#else

procedure ParseDBFetch renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  END OF QUERY
--
-- Syntax: b := db.end_of_query;
-- Source: APQ.End_Of_Query
-----------------------------------------------------------------------------

procedure ParseDBEndOfQuery( result : out unbounded_string; kind : out identifier ) is
begin
  kind := boolean_t;
  expect( db_end_of_query_t );
  if isExecutingCommand then
     begin
       result := to_bush_boolean( End_Of_Query( Q ) );
     exception when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBEndOfQuery;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  TUPLE
--
-- Syntax: t := db.tuple;
-- Source: APQ.Tuple
-----------------------------------------------------------------------------

procedure ParseDBTuple( result : out unbounded_string; kind : out identifier ) is
begin
  kind := db_tuple_index_type_t;
  expect( db_tuple_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Tuple_Index_Type'image( Tuple( Q ) ) );
     exception when no_tuple =>
       err( +"no tuple" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBTuple;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  TUPLE
--
-- Syntax: n := db.tuples;
-- Source: APQ.Tuples
-----------------------------------------------------------------------------

procedure ParseDBTuples( result : out unbounded_string; kind : out identifier ) is
begin
  kind := db_tuple_count_type_t;
  expect( db_tuples_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Tuple_Count_Type'image( Tuples( Q ) ) );
     exception when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBTuples;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COLUMNS
--
-- Syntax: n := db.columns;
-- Source: APQ.Columns
-----------------------------------------------------------------------------

procedure ParseDBColumns( result : out unbounded_string; kind : out identifier ) is
begin
  kind := natural_t;
  expect( db_columns_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Natural'image( Columns( Q ) ) );
     exception when no_result =>
       err( +"no result" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBColumns;

#else

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

#end if;
#if POSTGRES

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

procedure ParseDBColumnName( result : out unbounded_string; kind : out identifier ) is
  exprVal : unbounded_string;
  exprType : identifier;
begin
  kind := string_t;
  expect( db_column_name_t );
  ParseSingleNumericParameter( db_column_name_t, exprVal, exprType, db_column_index_type_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string(
          Column_Name( Q, Column_Index_Type( to_numeric( exprVal ) ) )
       );
     exception when no_column =>
       err( +"no column" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBColumnName;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  COLUMN INDEX
--
-- Syntax: n := db.column_index;
-- Source: APQ.Column_Index
-----------------------------------------------------------------------------

procedure ParseDBColumnIndex( result : out unbounded_string; kind : out identifier ) is
  exprVal : unbounded_string;
  exprType : identifier;
begin
  kind := db_column_index_type_t;
  expect( db_column_index_t );
  ParseSingleStringParameter( db_column_index_t, exprVal, exprType, string_t );
  if isExecutingCommand then
     begin
       result := to_unbounded_string( Column_Index_Type'image(
           Column_Index( Q, to_string( exprVal ) )
       ) );
     exception when no_column =>
       err( +"no column" );
     when others =>
       err_exception_raised;
     end;
  end if;
end ParseDBColumnIndex;

#else

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

#end if;

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

#if POSTGRES

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

procedure ParseDBIsNull( result : out unbounded_string; kind : out identifier ) is
  exprVal : unbounded_string;
  exprType : identifier;
begin
  kind := boolean_t;
  expect( db_is_null_t );
  ParseSingleNumericParameter( db_is_null_t, exprVal, exprType, db_column_index_type_t );
  if isExecutingCommand then
     begin
       result := to_bush_boolean(
          Is_Null( 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 ParseDBIsNull;

#else

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

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  VALUE
--
-- Syntax: n := db.value;
-- Source: APQ.Value;
-----------------------------------------------------------------------------

procedure ParseDBValue( result : out unbounded_string; kind : out identifier ) is
  exprVal  : unbounded_string;
  exprType : identifier;
begin
  kind := universal_t;
  expect( db_value_t );
  ParseSingleNumericParameter( db_value_t, exprVal, exprType, db_column_index_type_t );
  if isExecutingCommand then
     begin
       result := Value( 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 ParseDBValue;

#else

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

#end if;
#if POSTGRES

procedure DBShowIt is
-- run SQL command and display results in tabular format
  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 ) then
        execute( Q, 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 := ada.strings.unbounded.length( 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( 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;
                   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 DBShowIt;

-----------------------------------------------------------------------------
--  SHOW
--
-- Syntax: db.show;
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBShow is
begin
  expect( db_show_t );
  DBShowIt;
end ParseDBShow;

#else

procedure ParseDBShow renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  LIST
--
-- Syntax: db.list
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBList is
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
begin
  expect( db_list_t );
  if isExecutingCommand then
     begin
     if is_connected( 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, 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;
              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 ParseDBList;

#else

procedure ParseDBList renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  SCHEMA
--
-- Syntax: db.schema( "table" );
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBSchema is
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
  exprType       : identifier;
  exprVal        : unbounded_string;
begin
  expect( db_schema_t );
  expect( symbol_t, "(" );
  ParseExpression( exprVal, exprType );
  if baseTypesOK( exprType, string_t ) then
     expect( symbol_t, ")" );
  end if;
  if isExecutingCommand then
     begin
     if is_connected( 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, 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, 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 ParseDBSchema;

#else

procedure ParseDBSchema renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  USERS
--
-- Syntax: db.users
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBUsers is
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
begin
  expect( db_users_t );
  if isExecutingCommand then
     begin
     if is_connected( 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, 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 ParseDBUsers;

#else

procedure ParseDBUsers renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  DATABASES
--
-- Syntax: db.databases
-- Source: N/A
-----------------------------------------------------------------------------

procedure ParseDBDatabases is
  tabularDisplay : boolean := false;
  headingWidth   : integer := 0;
  wasNull        : boolean := false;
  columnWidths   : array( 1..32 ) of integer;
  totalWidth     : integer;
  width          : integer;
begin
  expect( db_databases_t );
  if isExecutingCommand then
     begin
     if is_connected( 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, 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;
        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 ParseDBDatabases;

#else

procedure ParseDBDatabases renames not_configured;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  SELECT
--
-----------------------------------------------------------------------------

procedure DoSQLSelect( sqlcmd : unbounded_string ) is
begin
  if isExecutingCommand then
     prepare( Q, to_string( sqlcmd ) );
     DBShowIt;
  end if;
end DoSQLSelect;

#else

procedure DoSQLSelect( sqlcmd : unbounded_string ) is
begin
  err( +"PostgreSQL support not configured" );
end DoSQLSelect;

#end if;
#if POSTGRES

-----------------------------------------------------------------------------
--  SQL STATEMENT
--
-----------------------------------------------------------------------------

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( pl( Error_Message( Q ) ) );
     when others =>
       err_exception_raised;
     end;
  end if;
end DoSQLStatement;

#else

procedure DoSQLStatement( sqlcmd : unbounded_string ) is
begin
  err( +"PostgreSQL support not configured" );
end DoSQLStatement;

#end if;

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

procedure StartupDB is
begin
  declareNamespace( "db" );
  declareIdent( db_column_index_type_t, "db.column_index_type",
    positive_t, typeClass );

  declareIdent( db_tuple_index_type_t, "db.tuple_index_type",
    positive_t, typeClass );

  declareIdent( db_tuple_count_type_t, "db.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( db_mode_type_t, "db.mode_type",
    root_enumerated_t, typeClass );
  declareStandardConstant( db_read_t, "db.read",
    db_mode_type_t, "0" );
  declareStandardConstant( db_write_t, "db.write",
    db_mode_type_t, "1" );
  declareStandardConstant( db_read_write_t, "db.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( db_connect_t, "db.connect", ParseDBConnect'access );
  declareProcedure( db_disconnect_t, "db.disconnect", ParseDBDisconnect'access );
  declareFunction(  db_is_connected_t, "db.is_connected", ParseDBIsConnected'access );
  declareProcedure( db_reset_t, "db.reset", ParseDBReset'access );
  declareFunction(  db_error_message_t, "db.error_message", ParseDBErrorMessage'access );
  declareFunction(  db_notice_message_t, "db.notice_message", ParseDBNoticeMessage'access );
  declareFunction(  db_in_abort_state_t, "db.in_abort_state", ParseDBInAbortState'access );
  declareFunction(  db_options_t, "db.options", ParseDBOptions'access );
  declareFunction(  db_will_rollback_on_finalize_t, "db.will_rollback_on_finalize", ParseDBWillRollbackOnFinalize'access );
  declareProcedure( db_set_rollback_on_finalize_t, "db.set_rollback_on_finalize", ParseDBSetRollbackOnFinalize'access );
  declareProcedure( db_open_db_trace_t, "db.open_db_trace", ParseDBOpenDBTrace'access );
  declareProcedure( db_close_db_trace_t, "db.close_db_trace", ParseDBCloseDBTrace'access );
  declareProcedure( db_set_trace_t, "db.set_trace", ParseDBSetTrace'access );
  declareFunction(  db_is_trace_t, "db.is_trace", ParseDBIsTrace'access );
  declareProcedure( db_clear_t, "db.clear", ParseDBClear'access );
  declareProcedure( db_prepare_t, "db.prepare", ParseDBPrepare'access );
  declareProcedure( db_append_t, "db.append", ParseDBAppend'access );
  declareProcedure( db_append_line_t, "db.append_line", ParseDBAppendLine'access );
  declareProcedure( db_append_quoted_t, "db.append_quoted", ParseDBAppendQuoted'access );
  declareProcedure( db_execute_t, "db.execute", ParseDBExecute'access );
  declareProcedure( db_execute_checked_t, "db.execute_checked", ParseDBExecuteChecked'access );
  declareProcedure( db_raise_exceptions_t, "db.raise_exceptions", ParseDBRaiseExceptions'access );
  declareProcedure( db_report_errors_t, "db.report_errors", ParseDBReportErrors'access );
  declareProcedure( db_begin_work_t, "db.begin_work", ParseDBBeginWork'access );
  declareProcedure( db_commit_work_t, "db.commit_work", ParseDBCommitWork'access );
  declareProcedure( db_rollback_work_t, "db.rollback_work", ParseDBRollbackWork'access );
  declareProcedure( db_rewind_t, "db.rewind", ParseDBRewind'access );
  declareProcedure( db_fetch_t, "db.fetch", ParseDBFetch'access );
  declareFunction(  db_end_of_query_t, "db.end_of_query", ParseDBEndOfQuery'access );
  declareFunction(  db_tuple_t, "db.tuple", ParseDBTuple'access );
  declareFunction(  db_tuples_t, "db.tuples", ParseDBTuples'access );
  declareFunction(  db_columns_t, "db.columns", ParseDBColumns'access );
  declareFunction(  db_column_name_t, "db.column_name", ParseDBColumnName'access );
  declareFunction(  db_column_index_t, "db.column_index", ParseDBColumnIndex'access );
  --declareFunction(  db_column_type_t, "db.column_type", ParseDBColumnType'access );
  declareFunction(  db_is_null_t, "db.is_null", ParseDBIsNull'access );
  declareFunction(  db_value_t, "db.value", ParseDBValue'access );
  declareFunction(  db_engine_of_t, "db.engine_of", ParseDBEngineOf'access );
  declareProcedure( db_show_t, "db.show", ParseDBShow'access );
  declareProcedure( db_list_t, "db.list", ParseDBList'access );
  declareProcedure( db_schema_t, "db.schema", ParseDBSchema'access );
  declareProcedure( db_users_t, "db.users", ParseDBUsers'access );
  declareProcedure( db_databases_t, "db.databases", ParseDBDatabases'access );

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

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

  declareNamespaceClosed( "db" );
end StartupDB;

procedure ShutdownDB is
begin
  null;
end ShutdownDB;

end parser_db;
