-- Declare the SQLCA and SQLDA records

exec sql include sqlca;
exec sql include sqlda;

--
-- Program:
--              Dynamic_FRS
-- Purpose:
--              Main entry of Dynamic SQL forms application
--

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

    -- String object maximums
    MAX_NAME: constant := 40;      -- Input name size
    MAX_STRING: constant := 3000;  -- Large string buffer size
    MAX_STMT: constant := 1000;    -- SQL statement string size

    --
    -- Result storage pool for Dynamic SQL and FRS statements.
    -- This result pool consists of arrays of 4-byte integers,
    -- 8-byte floating-points, 2-byte indicators, and a large
    -- string buffer from which slices will be allocated. Each
    -- SQLDA SQLVAR sets its SQLDATA and SQLIND address pointers
    -- to variables from this pool.

    --
    integers:array(1..IISQ_MAX_COLS) of Integer; -- 4-byte integer
    floats: array(1..IISQ_MAX_COLS) of Long_Float; -- 8-byte float
    indicators:array(1..IISQ_MAX_COLS) of Short_Integer; -- 2-byte
                                                       -- indicator
    characters: String(1..MAX_STRING);              -- String pool
    exec sql begin declare section;
        dbname:   String(1..MAX_NAME); -- Database name
        formname: String(1..MAX_NAME); -- Form name
        tabname:  String(1..MAX_NAME); -- Database table name
        sel_buf:  String(1..MAX_STMT); -- Prepared SELECT and
        ins_buf:  String(1..MAX_STMT); -- INSERT statements
        err:      Integer;             -- Error status
        ret:      String(1..1);        -- Prompt error buffer
    exec sql end declare section;

    --
    -- Function:
    --         Describe_Form
    -- Purpose:
    --        Profile the specified form for name and data type
    --        information.Using the DESCRIBE FORM statement, the
    --        SQLDA is loaded with field information from the
    --        form. This procedure processes this information to
    --        allocate result storage, point at storage for
    --        dynamic FRS data
    --        retrieval and assignment, and build SQL statements
    --        strings for subsequent dynamic SELECT and
    --        INSERT statements. For example, assume the form
    --        (and table) 'emp' has the following fields:

    --
    --           Field Name Type        Nullable?
    --           ---------- ----        ---------
    --            name      char(10)      No
    --            age       integer4      Yes
    --            salary    money       Yes

    --
    --   Based on 'emp', this procedure will construct the SQLDA.
    --   The procedure allocates variables from a result variable
    --   pool (integers, floats and a large character
    --   string space). The SQLDATA and SQLIND fields are pointed
    --   at the addresses of the result variables in the pool.
    --   The following SQLDA is built:

    --
    --               sqlvar(1)
    --                    sqltype = IISQ_CHA_TYPE
    --                    sqllen  = 10
    --                    sqldata = pointer into characters array
    --                    sqlind  = null
    --                    sqlname = 'name'

    --               sqlvar(2)
    --                    sqltype = -IISQ_INT_TYPE
    --                    sqllen  = 4
    --                    sqldata = address of integers(2)
    --                    sqlind  = address of indicators(2)
    --                    sqlname = 'age'
    --               sqlvar(3)
    --                    sqltype = -IISQ_FLT_TYPE
    --                    sqllen  = 8
    --                    sqldata = address of floats(3)
    --                    sqlind  = address of indicators(3)
    --                    sqlname = 'salary'

    --
    -- This procedure also builds two dynamic SQL statements
    -- strings. Note that the procedure should be extended to
    -- verify that the statement strings do fit into the
    -- statement buffers (this was not done in this example).
    -- The above example would construct the following
    -- statement strings:
    --
    --     'SELECT name, age, salary FROM emp ORDER BY name'
    --     'INSERT INTO emp (name, age, salary) VALUES (?, ?, ?)'

    --
    -- Parameters (globals):
    --   formname - (in)  Name of form to profile.
    --   tabname  - (in)  Name of database table.
    --   sel_buf  - (out) Buffer to hold SELECT statement string.
    --   ins_buf  - (out) Buffer to hold INSERT statement string.
    -- Returns:
    --       TRUE/FALSE - Success/failure - will fail on error
    --                    or upon finding a table field.
    --

    function Describe_Form return Boolean is
        names:    String(1..MAX_STMT); -- Names for SQL statements
        name_cur: Integer;             -- Current name length
        name_cnt: Integer;             -- Bytes used in 'names'
        marks:    String(1..MAX_STMT); -- Place holders for INSERT
        mark_cnt: Integer;             -- Bytes used in 'marks
        nullable: Boolean;            -- Is nullable (SQLTYPE < 0)
        char_cnt: Integer;            -- Total string length
        char_cur: Integer;             -- Current string length
    begin                 -- Describe_Form

        --
        -- DESCRIBE the form - if we cannot fully describe the
        -- form (our SQLDA is too small) then report an error and
        -- return.
        exec frs describe form :formname all into :sqlda;
        exec frs inquire_frs frs (:err = ERRORNO);
        if (err > 0) then

              return FALSE;             -- Error already displayed
        elsif (sqlda.sqld > sqlda.sqln) then
            exec frs prompt noecho
              ('SQLDA is too small for form :', :ret);
            return FALSE;
        elsif (sqlda.sqld = 0) then
            exec frs prompt noecho
               ('There are no fields in the form :', :ret);
            return FALSE;
        end if;

        --
        -- For each field determine the size and type of the
        -- result data area. This data area will be allocated out
        -- of the result variable pool (integers, floats and
        -- characters) and will be pointed at by SQLDATA and
        -- SQLIND.

        --
        -- If a table field type is returned then issue an error.
        --
        -- Also, for each field add the field name to the 'names'
        -- buffer and the SQL place holders '?' to the 'marks'
        -- buffer, which will be used to build the final SELECT
        -- and INSERT statements.
        --

        char_cnt := 1;             -- No strings used yet
        for i in 1 .. sqlda.sqld loop
            declare
              sqv: IISQL_VAR renames sqlda.sqlvar(i); -- Shorthand
              col: Integer := Integer(i);

            begin
             --
             -- Collapse all different types into Integers, Floats
             -- or Characters.
             --
          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 := integers(col)'Address;

                  -- Floating points - use 8-byte floats
                  when IISQ_MNY_TYPE | IISQ_FLT_TYPE =>
                      sqv.sqltype := IISQ_FLT_TYPE;
                      sqv.sqllen := 8;
                      sqv.sqldata := floats(col)'Address;

                  -- Character strings
                  when
                  IISQ_DTE_TYPE | IISQ_CHA_TYPE | IISQ_VCH_TYPE =>
                      --
                      -- Determine the length of the slic
                      -- 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
                          char_cur := IISQ_DTE_LEN;
                      else
                          char_cur := Integer(sqv.sqllen);
                      end if;

                      -- Enough room in large string buffer ?
                      if (char_cnt + char_cur >
                       characters'length) then
                          exec frs prompt noecho
                       ('Character pool buffer overflow :', :ret);
                          return FALSE;
                      end if;

                      -- Allocate slice out of buffer
                      sqv.sqltype = IISQ_CHA_TYPE;
                      sqv.sqllen  = Short_Integer(char_cur);
                      sqv.sqldata = characters(char_cnt)'Address;
                      char_cnt    = char_cnt + char_cur;

                  when IISQ_TBL_TYPE =>
                      exec frs prompt noecho
                          ('Table field found in form :', :ret);
                      return FALSE;

                  when others =>
                      exec frs prompt noecho
                           ('Invalid field type :', :ret);
                      return FALSE;

              end case;                    -- Of data types
            -- Assign pointers to null indicators and toggle type
              if (nullable) then
                   sqv.sqltype := -sqv.sqltype;
                   sqv.sqlind := indicators(col)'Address;
              else
                   sqv.sqlind := IISQ_ADR_ZERO;
              end if;

             --
             -- Store field names and place holders (separated by
             -- commas) for the SQL statements.
             --
              if (col = 1) then
                  name_cnt = 1;
                  mark_cnt := 1;
              else
                  names(name_cnt) = ',';
                  name_cnt := name_cnt + 1;
                  marks(mark_cnt) = ',';
                  mark_cnt := mark_cnt + 1;
              end if;
              name_cur := Integer(sqv.sqlname.sqlnamel);
              names(name_cnt..name_cnt+name_cur-1) :=
                     sqv.sqlname.sqlnamec(1..name_cur);
              name_cnt := name_cnt + name_cur;
              marks(mark_cnt) := '?';
              mark_cnt := mark_cnt + 1;

          end;            -- Declare (renames) block
      end loop;           -- While processing columns
      --
      -- Create final SELECT and INSERT statements. For the
      -- SELECT statement ORDER BY the first field.
      --
      sel_buf := (1..sel_buf'length => ' ');
      ins_buf := (1..ins_buf'length => ' ');
      name_cur := Integer(sqlda.sqlvar(1).sqlname.sqlnamel);
      sel_buf(1..7 + name_cnt-1 + 6 + tabname'length +
                      10 + name_cur)
                  := "SELECT " & names(1..name_cnt-1) &
                    " FROM " & tabname &
                    " ORDER BY " &
                    sqlda.sqlvar(1).sqlname.sqlnamec(1..name_cur);
      ins_buf(1..12 + tabname'length + 2 + name_cnt-1 + 10 +
              mark_cnt-1 + 1)
                := "INSERT INTO " & tabname & " (" &
                     names(1..name_cnt-1) & ") VALUES (" &
                     marks(1..mark_cnt-1) & ")";
            return TRUE;

        end Describe_Form;

--
-- Program:
--            Dynamic_FRS Main
-- Purpose:
--         Main body of Dynamic SQL forms application. Prompt for
--         database, form and table name. Call Describe_Form
--         to obtain a profile of the form and set up the SQL
--        statements. Then allow the user to interactively browse
--        the database table and append new data.
--

begin                          -- Dynamic_FRS Main
    exec sql declare sel_stmt statement;        -- Dynamic SQL
                                                -- SELECT statement
    exec sql declare ins_stmt statement;        -- Dynamic SQL
                                                -- INSERT statement
    exec sql declare csr cursor for sel_stmt;   -- Cursor for
                                                -- SELECT statement
    exec frs forms;

    -- Prompt for database name - will abort on errors
    exec sql whenever sqlerror stop;
    exec frs prompt ('Database name: ', :dbname);
    exec sql connect :dbname;

    exec sql whenever sqlerror call sqlprint;

    --
    -- Prompt for table name - later a Dynamic SQL SELECT
    -- statement will be built from it.
    --
    exec frs prompt ('Table name: ', :tabname);

    --
    -- Prompt for form name. Check forms errors reported
    -- through INQUIRE_FRS.
    --
    exec frs prompt ('Form name: ', :formname);
    exec frs message 'Loading form ...';
    exec frs forminit :formname;
    exec frs inquire_frs frs (:err = ERRORNO);
    if (err > 0) then
          exec frs message 'Could not load form. Exiting.';
          exec frs endforms;
          exec sql disconnect;
          return;
    end if;

    -- Commit any work done so far - access of forms catalogs
    exec sql commit;

    -- Describe the form and build the SQL statement strings
    if (not Describe_Form) then
        exec frs message 'Could not describe form. Exiting.';
        exec frs endforms;
        exec sql disconnect;
        return;
    end if;

    --
    -- PREPARE the SELECT and INSERT statements that correspond
    -- to the menu items Browse and Insert. If the Save menu item
    -- is chosen the statements are reprepared.
    --
    exec sql prepare sel_stmt from :sel_buf;
    err := sqlca.sqlcode;
    exec sql prepare ins_stmt from :ins_buf;
    if ((err < 0) or (sqlca.sqlcode < 0)) then
        exec frs message 'Could not prepare SQL statements. Exiting.';
        exec frs endforms;
        exec sql disconnect;
        return;
    end if;

    --
    -- Display the form and interact with user, allowing browsing
    -- and the inserting of new data.
    --
    exec frs display :formname fill;
    exec frs initialize;
    exec frs activate menuitem 'Browse';
    exec frs begin;
        --
        -- Retrieve data and display the first row on the form,
        -- allowing the user to browse through successive rows.
        -- If data types from the database table are not
        -- consistent with data descriptions obtained from the
        -- form, a retrieval error
        -- will occur. Inform the user of this or other errors.
        --
        -- Note that the data will return sorted by the first
        -- field that was described, as the SELECT statement,
        -- sel_stmt, included an ORDER BY clause.
        --
        exec sql open csr;

        -- Fetch and display each row
        while (sqlca.sqlcode = 0) loop
            exec sql fetch csr using descriptor :sqlda;
            if (sqlca.sqlcode <= 0) then
                exec sql close csr;
                exec frs prompt noecho ('No more rows :', :ret);
                exec frs clear field all;
                exec frs resume;
            end if;

            exec frs putform :formname using descriptor :sqlda;
            exec frs inquire_frs frs (:err = ERRORNO);
            if (err > 0) then
               exec sql close csr;
               exec frs resume;
            end if;

            -- Display data before prompting user with submenu
            exec frs redisplay;

            exec frs submenu;
            exec frs activate menuitem 'Next', frskey4;
            exec frs begin;
                -- Continue with cursor loop
                exec frs message 'Next row ...';
                exec frs clear field all;
            exec frs end;
            exec frs activate menuitem 'End', frskey3;
            exec frs begin;
                exec sql close csr;
                exec frs clear field all;
                exec frs resume;
            exec frs end;

       end loop;                  -- While there are more rows
    exec frs end;

    exec frs activate menuitem 'Insert';
    exec frs begin;
        exec frs getform :formname using descriptor :sqlda;
        exec frs inquire_frs frs (:err = ERRORNO);
        if (err > 0) then
              exec frs clear field all;
              exec frs resume;
        end if;
        exec sql execute ins_stmt using descriptor :sqlda;
        if ((sqlca.sqlcode < 0) or (sqlca.sqlerrd(3) = 0)) then
             exec frs prompt noecho ('No rows inserted :', :ret);
        else
             exec frs prompt noecho ('One row inserted :', :ret);
        end if;
    exec frs end;

    exec frs activate menuitem 'Save';
    exec frs begin;
        --
        -- COMMIT any changes and then re-PREPARE the SELECT and
        -- INSERT statements as the COMMIT statements discards
        -- them.
        --
        exec sql commit;
        exec sql prepare sel_stmt FROM :sel_buf;
        err := sqlca.sqlcode;
        exec sql prepare ins_stmt FROM :ins_buf;
        if ((err < 0) or (sqlca.sqlcode < 0)) then
            exec frs prompt noecho
                ('Could not reprepare SQL statements :', :ret);
            exec frs breakdisplay;
        end if;
    exec frs end;

    exec frs activate menuitem 'Clear';
    exec frs begin;
         exec frs clear field all;
    exec frs end;

    exec frs activate menuitem 'Quit', frskey2;
    exec frs begin;
        exec sql rollback;
        exec frs breakdisplay;
    exec frs end;
    exec frs finalize;

    exec frs endforms;
    exec sql disconnect;

    exception
        when others =>
            exec frs prompt noecho
                 ('Unexpected exception encountered :', :ret);
            raise;

end Dynamic_FRS;