-- I/O utilities
-- This example assumes package Long_Float_Text_IO
-- has been instantiated to use the D_FLOAT format.
--
with text_io;                 use text_io;
with integer_text_io;         use integer_text_io;
with short_integer_text_io;   use short_integer_text_io;
with long_float_text_io;      use long_float_text_io;

-- Declare the SQLCA and the SQLDA records
exec sql include sqlca;
exec sql include sqlda;

-- Dynamic SQL statement and cursor
exec sql declare stmt statement;
exec sql declare csr cursor for stmt;

--
-- Program: SQL_Monitor
-- Purpose: Main entry of SQL Monitor application.
--

procedure SQL_Monitor is
     exec sql begin declare section;
        dbname: String(1..50) := (1..50 => ' '); -- Database name
        dblen:  Natural;
       dbrun:  Boolean := false;               -- connected to db
     exec sql end declare section;

     -- Global SQLDA. Discriminant SQLN is implicitly set
     -- to IISQ_MAX_COLS
     sqlda: IISQLDA(IISQ_MAX_COLS);

     --
     -- Constants and types needed to declare global storage for
     -- SELECT results.
     --
     -- Length of large string pool from which slices will
     -- be allocated
     MAX_STRING: constant := 3000;

     -- Different numeric types for result variables
     type Numerics is
         record
             n_int: Integer;       -- 4-byte integers
             n_flt: Long_Float;    -- 8-byte floating-points
             n_ind: Short_Integer; -- 2-byte null indicators
         end record;

     type Numerics_Array is array(Short_Integer range <>)
                        of Numerics;

     -- Large string pool from which to allocate slices
     type Strings is
             record
                s_len: Integer;                 -- Length used
                s_data: String(1..MAX_STRING);  -- and data area
           end record;

      -- Record of numerics and strings
      type Results is
              record
                    nums: Numerics_Array(1..IISQ_MAX_COLS);
                    str:  Strings;
              end record;

      --
      -- Global result storage area - set up by Print_Header,
      -- filled when executing the FETCH statement, and
      -- displayed by Print_Row.
      --
      res: Results;

      -- Forward defined procedures and functions
      -- Main body of monitor
      procedure Run_Monitor;

      -- Execute dynamic SELECT statements
      function Execute_Select return Integer;

      -- Print the column headers for a dynamic SELECT
      function Print_Header return Boolean;

      -- Print a result row for a dynamic SELECT
      procedure Print_Row;

      -- Print an error message
      procedure Print_Error;

      -- Read a statement from input
      procedure Read_Stmt(stmt_num: in Integer; stmt_buf:
                            in out String);

      --
      -- Procedure: Run_Monitor
      -- Purpose: Run the SQL monitor. Initialize the global
      --          SQLDA with the number of SQLVAR elements.
      --          Loop while prompting
      --          the user for input and processing the SQL
      --          statement; if end-of-file is typed then control
      --          is returned to the main program exception
      --          handler from Read_Stmt.
      --
      --          If the statement is not a SELECT statement
      --          then execute it, otherwise open a cursor and
      --          process a dynamic select statement
      --          (using Execute_Select).
      --
      procedure Run_Monitor is
      exec sql begin declare section;

        stmt_buf: String(1..1000); -- SQL statement input buffer
        stmt_num: Integer;         -- SQL statement number
        rows: Integer;             -- # of rows affected
      exec sql end declare section;

begin                               -- Run_Monitor
      -- Now we are set for input
      stmt_num := 0;

      -- Loop till end-of-file is detected.
      loop
            --
            -- Prompt and read the next statement. If Read_Stmt
            -- end-of-file was detected then end_error is signaled
            -- and control is returned to the main program.
            --
            stmt_num := stmt_num + 1;
            Read_Stmt(stmt_num, stmt_buf);

            -- Handle database errors
            exec sql whenever sqlerror goto Stmt_Err;

            --
            -- PREPARE and DESCRIBE the statement. If the
            -- statement is not a SELECT then EXECUTE it,
            -- otherwise inspect the
            -- contents of the SQLDA and call Execute_Select.
            --
            exec sql prepare stmt from :stmt_buf;
            exec sql describe stmt into :sqlda;

            --
            -- If SQLD = 0 then this is not a SELECT
            -- statement. Otherwise call Execute_Select to process
            -- a dynamic cursor.
            if (sqlda.sqld = 0) then
                exec sql execute stmt;
                rows := sqlca.sqlerrd(3);

            else
                rows := Execute_Select;

            end if;                      -- If SELECT or not
            exec sql whenever sqlerror continue;

            <<Stmt_Err>>
            --
            -- Only display error message if we arrived here
            -- because of the SQLERROR condition. Otherwise print
            -- the rows processed and continue with the loop.
            if (sqlca.sqlcode < 0) then
                    Print_Error;
            else
                  put("[");
                  put(rows, 1);
                  put_line(" row(s)]");
            end if;

            end loop; -- While reading statements

 

end Run_Monitor;
--
-- Function: Execute_Select
-- Purpose:  Run a dynamic SELECT statement. The SQLDA has
--           already been described. This routine calls
--           Print_Header to print column headers
--           and set up result storage information.
--           A Dynamic SQL cursor is then opened
--           and each row is fetched and printed by Print_Row.
--           Any error causes the cursor to be closed.
-- Returns:
--           Number of rows fetched from the cursor.
--

 

function Execute_Select return Integer is
            rows: Integer := 0;             -- Counter of rows fetched

begin                       -- Execute_Select
    --
    -- Print result column names and set up the result data types
    -- and variables. Print_Header returns FALSE if the dynamic
    -- set-up fails.
    --
    if (Print_Header) then
          exec sql whenever sqlerror goto Select_Error;
          -- Open the dynamic cursor
          exec sql open csr for readonly;

          -- Fetch and print each row
          rows := 0;
          while (sqlca.sqlcode = 0) loop
              exec sql fetch csr using descriptor :sqlda;
              if (sqlca.sqlcode = 0) then
                  rows := rows + 1; -- Count the rows
                  Print_Row;
              end if;

          end loop;                  -- While there are more rows
        <<Select_Error>>
          -- Display error message if SQLERROR condition is set.
          if (sqlca.sqlcode < 0) then
                     Print_Error;
          end if;

                    exec sql whenever sqlerror continue;
                     exec sql close csr;

        end if; -- If Print_Header
        return rows;

end Execute_Select;

--
-- Function: Print_Header
-- Purpose: A statement has just been described so set up the
--          SQLDA for result processing. Print all the column
--          names and allocate result variables for retrieving
--          data. The result variables are allocated out of
--          a pool of numeric variables (integers, floats and
--          2-byte indicators) and a large character buffer.
--          The SQLDATA and SQLIND fields are pointed at the
--          addresses of the result variables.
-- Returns:
--          TRUE if successfully set up the SQLDA for result
--          variables, FALSE if an error occurred.
--

 

function Print_Header return Boolean is
      nullable: Boolean;     -- Null indicator required
      chlen: Short_Integer;  -- Current string length

begin                        -- Print_Header
    --
    -- Verify that there are enough result variables.
    -- If not print an error and return.
    --
    if (sqlda.sqld >= sqlda.sqln) then
        put("SQL Error: SQLDA requires ");
        put(sqlda.sqld, 1);
        put(" variables, but has only ");
        put(sqlda.sqln, 1);
        put_line(".);
        return FALSE;
    end if; -- If enough result variables
    --
    -- For each column print the number and title. For example:
    --    [1] name [2] age [3] salary
    -- While processing each column determine the column type
    -- and to where SQLDATA and SQLIND must point in order to
    -- retrieve type-compatible results.
    --
    res.str.s_len := 1;               -- No string space used yet
    for col in 1 .. sqlda.sqld loop    -- For each column
        declare
                         sqv: IISQL_VAR renames sqlda.sqlvar(col); -- Shorthand
        begin
            -- Print column name and number
            put("[");
            put(col, 1);
            put("] ");
            put(sqv.sqlname.sqlnamec(1..Integer
                        (sqv.sqlname.sqlnamel)));
            if (col < sqlda.sqld) then
                 put(" ");      -- Separator space
            end if;

            --
            -- Process the column for type and length
            -- information. Use
            -- result storage area from which variables can
            -- be allocated.

            if (sqv.sqltype < 0) then
                          -- Null indicator handled later
                nullable := TRUE;
            else
                nullable := FALSE;
            end if;

            case (abs(sqv.sqltype)) is
                - Integers - use 4-byte integer
                when IISQ_INT_TYPE =>
                      sqv.sqltype := IISQ_INT_TYPE;
                      sqv.sqllen := 4;
                      sqv.sqldata := res.nums(col).n_int'Address;
                -- Floating points - use 8-byte float
                when IISQ_MNY_TYPE | IISQ_FLT_TYPE =>
                      sqv.sqltype := IISQ_FLT_TYPE;
                      sqv.sqllen := 8;
                      sqv.sqldata := res.nums(col).n_flt'Address;

                -- Character strings
           when IISQ_DTE_TYPE | IISQ_CHA_TYPE | IISQ_VCH_TYPE =>
                  --
                  -- Determine the length of the slice required
                  -- from the large character buffer. If we have
                  -- enough space left then point at the start of
                  -- the corresponding slice, otherwise print an
                  -- error and return.
                      --
                      -- Note that for DATE types we must set the
                      -- length.
                      --
                      if (abs(sqv.sqltype) = IISQ_DTE_TYPE) then
                          chlen := IISQ_DTE_LEN;
                      else
                          chlen := sqv.sqllen;
                      end if;

                      -- Enough room in large string buffer ?
                  if (res.str.s_len + Integer(chlen) > MAX_STRING)
                          then
                          new_line;
                        put_line("SQL Error: Character result data "
                                   & "overflow.");
                          return FALSE;
                      end if;

                  --
                  -- Allocate space out of the large character
                  -- buffer and keep track of the amount of space
                  -- used so far.
                  --
                      sqv.sqltype := IISQ_CHA_TYPE;
                      sqv.sqllen  := chlen;
                      sqv.sqldata :=
                           res.str.s_data(res.str.s_len)'Address;
                  res.str.s_len := res.str.s_len + Integer(chlen);
                -- Bad data type
                when others =>
                      new_line;
                  put("SQL Error: Unknown data type returned: ");
                      put(sqv.sqltype, 1);
                      put_line(".);
                      return FALSE;

            end case;                 -- Of data types
            -- If nullable then point at null indicator and
            -- toggle type id
            if (nullable) then
                  sqv.sqltype := -sqv.sqltype;
                  sqv.sqlind := res.nums(col).n_ind'Address;
            else
                  sqv.sqlind := IISQ_ADR_ZERO;
            end if;

        end;                             -- Declare (rename) block
    end loop;                            -- For processing columns
    new_line;                            -- Print separating line
    put_line("---------------------------------------");
    return TRUE;

end Print_Header;

--
--  Procedure: Print_Row
--  Purpose:  For each element inside the SQLDA, print the value.
--            Print its column number too in order to identify it
--            with the column name printed earlier. If the value
--            is NULL print "N/A". This routine prints the values
--            using very basic formats and does not try to
--             tabulate the results.
--

procedure Print_Row is
    chlen: Short_Integer; -- Index into string slices

begin                   -- Print_Row
    --
    -- For each column, print the column number and the data. The
    -- number identifies the column with the column name printed
    -- in Print_Header. NULL columns are printed as "N/A".
    --
    res.str.s_len := 1;       -- No characters printed yet
    for col in 1 .. sqlda.sqld loop
        declare
            sqv: IISQL_VAR renames sqlda.sqlvar(col); -- Shorthand
        begin
            put("[");              -- Print column number
            put(col, 1);
            put("] ");
            -- If nullable and is NULL then print "N/A"
            if (sqv.sqltype < 0) and (res.nums(col).n_ind = -1) then
                put("N/A");
            else
                --
                -- Using the base type set up in Print_Header
                -- determine how to print the results. All types
                -- are printed using
                -- very basic formats.
                --
                case (abs(sqv.sqltype)) is
                            when IISQ_INT_TYPE =>
                            put(res.nums(col).n_int, 1);

                            when IISQ_FLT_TYPE =>
                            put(res.nums(col).n_flt, 1, 4, 0);

                            when IISQ_CHA_TYPE =>
                        -- Use a current-length slice from the
                        -- large character buffer, as allocated
                        -- in Print_Header.
                        -- Track number of characters printed.
                        chlen := sqv.sqllen;
                        put(res.str.s_data(res.str.s_len ..
                             res.str.s_len + Integer(chlen) - 1));
                        res.str.s_len :=
                               res.str.s_len + Integer(chlen);

                            when others => -- Bad data type
                        put("<type = ");
                        put(sqv.sqltype, 1);
                        put(">");
                end case;                 -- Of data types
            end if;                       -- If null or not
        end;                              -- Declare (rename) block
        if (col < sqlda.sqld) then       -- Add trailing space
             put(" ");
        end if;

    end loop;                             -- For processing columns
    new_line;                             -- Print end of line
end Print_Row;
--
-- Procedure:  Print_Error
-- Purpose:    SQLCA error detected. Retrieve the error message
--             and print it.
--

procedure Print_Error is
      exec sql begin declare section;
            error_buf: String(1..200); -- SQL error text retrieval
      exec sql end declare section;

begin
      exec sql inquire_sql (:error_buf = ERRORTEXT);
      put_line("SQL Error:");
      put_line(error_buf);

end Print_Error;

--
-- Procedure: Read_Stmt
-- Purpose:   Reads a statement from standard input. This routine
--          issues a prompt with the current statement number,
--          and reads the response into the parameter "stmt_buf".
--          No special scanning is done to look for terminators,
--          string delimiters or line continuations.
--
--          On eof-of-file end_error is raised and processed in
--          the main program.
--
--       The routine can be extended to allow line continuations,
--       SQL-style comments and a semicolon terminator.
-- Parameters:
--            stmt_num - Statement number for prompt.
--            stmt_buf - Buffer to fill from input.
--

procedure Read_Stmt (stmt_num: in Integer; stmt_buf: in out String) is
        slen: Natural;

begin                     -- Read_Stmt
      stmt_buf := (1..stmt_buf'length => ' ');
      slen := 0;

      while (slen = 0) loop          -- Ignore empty lines
             put(stmt_num, 3);
             put("> ");
             get_line(stmt_buf, slen);
      end loop;

end Read_Stmt;

--
-- Program: SQL_Monitor Main
-- Purpose: Main entry of SQL Monitor application. Prompt for
--           database name and connect to the database. Run the
--           monitor and disconnect from the database. Before
--           disconnecting roll
--           back any pending updates.
--

begin                                 -- Main Program
      put("SQL Database: ");           -- Prompt for database name
      get_line(dbname, dblen);
      if (dblen = 0) then
           return;
      end if;

      put_line("-- SQL Terminal Monitor --");
      -- Treat connection errors as fatal errors
      exec sql whenever sqlerror stop;
      exec sql connect :dbname;

      dbrun := TRUE;

      Run_Monitor;

      exec sql whenever sqlerror continue;

      exception
          when others =>       -- exit on EOF and other errors
              if (dbrun) then
                    put_line("SQL: Exiting monitor program.");
                    exec sql rollback;
                    exec sql disconnect;
              end if;

end SQL_Monitor;