5. Embedded SQL for Ada : Sample Applications : A Dynamic SQL/Forms Database Browser
 
Share this page                  
A Dynamic SQL/Forms Database Browser
This program lets the user browse data from and insert data into any table in any database, using a dynamically defined form. The program uses Dynamic SQL and Dynamic FRS statements to process the interactive data. You should already have used VIFRED to create a Default Form based on the database table that you want to browse. VIFRED will build a form with fields that have the same names and data types as the columns of the specified database table.
When run, the program prompts the user for the name of the database, the table, and the form. The form is profiled using the describe form statement, and the field name, data type, and length information is processed. From this information, the program fills in the SQLDA data and null indicator areas and builds two Dynamic SQL statement strings to select data from and insert data into the database.
The Browse menu item retrieves the data from the database using an SQL cursor associated with the dynamic select statement, and displays that data using the dynamic putform statement. A submenu allows the user to continue with the next row or return to the main menu. The Insert menu item retrieves the data from the form using the dynamic getform statement, and adds the data to the database table using a prepared insert statement. The Save menu item commits the changes and, because prepared statements are discarded, reprepares the select and insert statements. When the Quit menu item is selected, all pending changes are rolled back and the program is terminated.
Sample Application
-- 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;