program SQL_Monitor (input, output);

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

exec sql begin declare section;
var
     dbname: varying [50] of Char;      { Database name }
exec sql end declare section;

var
     sqlda: IIsqlda;              { Global SQLDA record }

exec sql declare stmt statement;      { Dynamic SQL statement }
exec sql declare csr cursor for stmt;     { Cursor for dynamic statement}

{
|Constants and types needed to declare global storage
|for SELECT results
}

const
    { Length of large string pool from which sub-strings
    | will be allocated
    }
    max_string = 3000;

type
     { Different numeric types for result variables }
    Numerics = record
            n_int: Integer;       { 4-byte integers }
            n_flt: Double;        { 8-byte floating points }
            n_ind: Indicator;     { 2-byte null indicators }
        end;

    { Large string pool from which to allocate sub-strings }
    Strings = record
            s_len: Integer; { Length used, and data }
            s_data: array [1..MAX_STRING] of Char;
        end;

var
    {
    | Global result storage area - set up by Print_Header, filled when
    | executing the FETCH statement, and displayed by Print_Row.
    | Record is declared volatile so that the IADDRESS and ADDRESS
    | functions can correctly point SQLDATA and SQLIND at the various
    | components.
    }
    res:         [volatile] record
                    nums: array [1..IISQ_MAX_COLS] of Numerics;
                    str: Strings;
                end;

{ Forward defined procedures and functions }

{ Main body of monitor }
procedure Run_Monitor; forward;

{ Execute dynamic SELECT statements }
function Execute_Select: Integer; forward;

{ Print the column headers for a dynamic SELECT }
function Print_Header: Boolean; forward;

{ Print a result row for a dynamic SELECT }
procedure Print_Row; forward;

{ Print an error message }
procedure Print_Error; forward;

{ Read a statement from input }
function Read_Stmt(stmt_num: Integer;
        var stmt_buf: varying[len] of char): Boolean; forward;

    {
    | 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; if
    | end-of-file is detected then return to the main program.
    |
    | 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;

        label
            Exec_Error;                 { SQL error in statement }
        exec sql begin declare section;

        var
            stmt_buf: varying[1000] of Char;     { SQL statement input buffer }
            stmt_num: Integer;             { SQL statement number }
            rows: Integer;             { # of rows affected }
        exec sql end declare section;

        var
            reading: Boolean;             { While reading statements }
    begin                     { Run_Monitor }
        sqlda.sqln := IISQ_MAX_COLS; { Initialize the SQLDA }
        { Now we are set for input }
        stmt_num := 0;
        reading := TRUE;

        while (reading) do begin
        stmt_num := stmt_num + 1;

        {
        | Prompt and read the next statement. If Read_Stmt
        | returns FALSE then end-of-file was detected.
        }
        reading := Read_Stmt(stmt_num, stmt_buf);

        if (reading) then begin
            { Handle database errors }
            exec sql whenever sqlerror goto Exec_Error;

            {
            | 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 }
            if (sqlda.sqld = 0) then begin
                exec sql execute stmt;
                rows := sqlca.sqlerrd[3];

            end else begin             { This is a SELECT }
                { Are there enough result variables }
                if (sqlda.sqld < sqlda.sqln) then begin
                    rows := Execute_Select;
                end else begin             { Too few result variables }
                    writeln('SQL Error: SQLDA requires ',
                        sqlda.sqld:1,
                        ' variables, but has only ',
                        sqlda.sqln:1, '.');
                    rows := 0;
                end;             { If enough result variables }
            end;             { If SELECT or not }
            { Display number of rows processed }
            writeln('[', rows:1, ' row(s)]');

        Exec_Error:
            exec sql whenever sqlerror continue;
            { If we have an error then display the error message }
            if (sqlca.sqlcode < 0) then
                Print_Error;
        end;                 { If reading a statement }
    end;                     { While reading statements }

end;                         { Run_Monitor }

{
| Function: Execute_Select
| Purpose: Run a dynamic SELECT statement. The SQLDA has
| already been described, so print the column header
| (names), open a cursor, and retrieve and print the
| results. Accumulate the number or rows processed.
| Returns: Number of rows processed.
}

function Execute_Select;
            { : Integer; }
    label
        Select_Error;             { SQL error in statement }
    var
        rows:     Integer;         { Counter of rows fetched }

begin                         { Execute_Select }
    Execute_Select := 0;

    {
    | Print result column names, set up the result types and
    | variables.Print_Header returns FALSE if the dynamic
    |    set-up failed.
    }
    if (Print_Header) then begin
        exec sql whenever sqlerror goto Select_Error;

        exec sql open csr for readonly;     { Open the dynamic cursor }
        { Fetch and print each row }
        rows := 0;
        while (sqlca.sqlcode = 0) do begin
            exec sql fetch csr using descriptor :sqlda;
            if (sqlca.sqlcode = 0) then begin
                rows := rows + 1;     { Count the rows }
                Print_Row;
            end;

        end;                 { While there are more rows }
    Select_Error:
        {
        |If we got here because of an error then print
        |the error message
        }
        if (sqlca.sqlcode < 0) then
                Print_Error;
        exec sql whenever sqlerror continue;
        exec sql close csr;

        Execute_Select := rows;
    end;                     { If Print_Header }
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 (point at) result variables for
| retrieving data. The result variables are chosen
| out of a pool of variables (integers, floats and
| a large character string space). 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;
{ : Boolean; }

var
        col:     Integer;     { Index into SQLVAR }
        col_err: Boolean;     { Error processing column }
        col_null: Boolean;    { Null indicator required }
        cur_len: Integer;     { Current string length }

begin                      { Print_Header }
    res.str.s_len := 1;         { No strings used yet }
    col := 1;
    col_err := FALSE;

    while (col <= sqlda.sqld) and (not col_err) do begin
        with sqlda.sqlvar[col] do begin
            {
            | For each column display the number and name, ie:
            | [1] sal [2] name [3] age
            }
            write('[', col:1, '] ', sqlname);
            if (col < sqlda.sqld) then
                write(' ');     { Separator space }
            {
            | Determine the data type of the column and to
            | where SQLDATA and SQLIND must point in order to
            | retrieve data-compatible results. Use the global
            | result storage area to allocate the result variables.
            |
            | Collapse all different types into Integers, Floats
            | or Characters.
            }
            if (sqltype < 0) then     { Null indicator handled later }
                col_null := TRUE
            else
                col_null := FALSE;

            case (abs(sqltype)) of
                IISQ_INT_TYPE:         { Integers }
                    begin
                        sqltype := IISQ_INT_TYPE;
                        sqllen := 4;
                        sqldata := iaddress(res.nums[col].n_int);
                    end;

                IISQ_MNY_TYPE,         { Floating points }
                IISQ_FLT_TYPE:
                    begin
                         sqltype := IISQ_FLT_TYPE;
                        sqllen := 8;
                        sqldata := iaddress(res.nums[col].n_flt);
                    end;

                IISQ_DTE_TYPE, { Characters }
                IISQ_CHA_TYPE,
                IISQ_VCH_TYPE:
                    begin
                        { First determine required length }
                        if (abs(sqltype) = IISQ_DTE_TYPE) then
                            cur_len := IISQ_DTE_LEN
                        else
                            cur_len := sqllen;

                        { Enough room in large string buffer ? }
                        if ((res.str.s_len + cur_len)
                                <= MAX_STRING) then
                         begin
                         { Point at a sub-string in buffer }
                         sqltype := IISQ_CHA_TYPE;
                         sqllen := cur_len;
                         sqldata :=
                         iaddress(res.str.s_data[res.str.s_len]);
                         res.str.s_len := res.str.s_len + cur_len;
                        end else begin
                         writeln;
                         writeln('SQL Error: Character result
                             data','overflow.');
                         col_err := TRUE;
                    end;             { If room in string }
                end;
            end;                 { Case of data types }
            { Assign pointers to null indicators and toggle type }
            if (col_null) then begin
                sqltype := -sqltype;
                sqlind     := iaddress(res.nums[col].n_ind);
            end else begin
                sqlind := 0;
            end;

        end;                 { With current column }
        col := col + 1;

    end;                     { While processing columns }
    writeln;                 { Print separating line }
    writeln('---------------------------------------');

    Print_Header := not col_err;
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 a column name printed earlier in Print_Header.
| If the value is NULL print "N/A".
}

procedure Print_Row;

    var
        col:     Integer;        { Index into SQLVAR }
        ch:         Integer;     { Index into sub-strings }

begin                            { Print_Row }
    res.str.s_len := 1;          { Reset string counter }
    col := 1;
    for col := 1 to sqlda.sqld do begin
        with sqlda.sqlvar[col] do begin
            { For each column display the number and value }
            write('[', col:1, '] ');

            if (sqltype < 0) and (res.nums[col].n_ind = -1) then begin
                write('N/A');

            end else begin
                {
                | Using the base type set up in Print_Header
                | determine how to print the results. All types
                | are printed using default formats.
                }
                case (abs(sqltype)) of
                    IISQ_INT_TYPE:
                        write(res.nums[col].n_int:1);

                IISQ_FLT_TYPE:
                    write(res.nums[col].n_flt);

                IISQ_CHA_TYPE:
                    begin
                        for ch := 0 to sqllen - 1 do begin
                            write(res.str.s_data
                                [res.str.s_len + ch]);
                        end;
                        res.str.s_len := res.str.s_len + sqllen;
                    end;
                end;         { Case of data types }
            end;             { If null or not }
        end;                 { With current column }
        if (col < sqlda.sqld) then     { Add trailing space }
            write(' ');

    end;                     { While processing columns }
    writeln; { Print end of line }

end; { Print_Row }

{
| Procedure: Print_Error
| Purpose: SQLCA error detected. Retrieve the error message and print it.
}
procedure Print_Error;

        exec sql begin declare section;
        var
            error_buf: varying[400] of Char; { SQL error text retrieval }
        exec sql end declare section;

begin
        exec sql inquire_sql (:error_buf = errortext);
        writeln('SQL Error:');
        writeln(error_buf);

end;                         { Print_Error }

{
| Function: Read_Stmt
| Purpose: Reads a statement from standard input. This routine
| prompts the user for input (using a statement number)
| and returns the response. The routine can be extended
| to scan for tokens that delimit the statement, such
| as semicolons and quotes, in order to allow the
| statement to be continued over multiple lines.
| Parameters:
| stmt_num - Statement number for prompt.
| stmt_buf - Buffer to fill for input.
| Returns:
| TRUE if a statement was read,
| FALSE if end-of-file typed.
}

function Read_Stmt;
            { (stmt_num:Integer;
              var stmt_buf: Varying of Char) : Boolean; }

begin
        write(stmt_num:1, '> ');         { Prompt for SQL statement }
        if (not eof) then begin
            readln(stmt_buf);
            Read_Stmt := TRUE;
        end else begin
            stmt_buf := '';
            Read_Stmt := FALSE;
        end;

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 }
        open(output, record_length :=
                MAX_STRING);             { For large result lines }
        write('SQL Database: ');         { Prompt for database name }
        readln(dbname);

        writeln(' -- SQL Terminal Monitor --');

        { Treat connection errors as fatal errors }
        exec sql whenever sqlerror stop;
        exec sql connect :dbname;

        Run_Monitor;

        exec sql whenever sqlerror continue;

        writeln('SQL: Exiting monitor program.');
        exec sql rollback;
        exec sql disconnect;

end. { Main Program }