4. Embedded SQL for Fortran : Sample Applications : The Table Editor Table Field Application
 
Share this page                  
The Table Editor Table Field Application
This application edits the Person table in the Personnel database. It is a forms application that allows the user to update a person's values, remove the person, or add new persons. Various table field utilities are provided with the application to demonstrate how they work.
The objects used in this application are shown in the following table:
Object
Description
personnel
The program's database environment.
person
A table in the database, with three columns:
      name (char(20))
      age (smallint)
      number (integer)
Number is unique.
personfrm
The VIFRED form with a single table field.
persontbl
A table field in the form, with two columns:
      name (char(20))
      age (integer)
When initialized, the table field includes the hidden column number (integer).
At the start of the application, a database cursor is opened to load the table field with data from the "person table". After loading the table field, you can browse and edit the displayed values. You can add, update or delete entries. When finished, the values are unloaded from the table field, and your updates are transferred back into the "person" table.
The application runs in UNIX, VMS, and Windows environments.
C
C Program: TableEdit
C Purpose: entry point to edit the "person"
C           table in the database,
C           via a table field.

      program TableEdit
      exec sql include sqlca
      exec sql declare person table
     1 (name  char(20),
     2 age    integer2,
     3 number integer4)

      exec sql begin declare section
C Person information
           character*20   pname
           integer        page
           integer        pnum
           integer maxid

C Table field entry information
C State of data set entry
           integer state 
C Record number
           integer    recnum 
C Last row in table field
           integer    lastrow
C Utility buffers
C Message buffer
           character*100 msgbuf 
C Response buffer for prompts
           character*20 respbuf
      exec sql end declare section

C Update error from database
      logical updaterr
C Transaction aborted
      logical xaborted
C Function to fill table field
      integer LoadTable

C Table field row states
C Empty or undefined row
      parameter (rowundef = 0)
C Appended by user
      parameter (rownew = 1)
C Loaded by program - not updated
      parameter (rowunchanged = 2)
C Loaded by program - since changed
      parameter (rowchanged = 3)
C Deleted by program
      parameter (rowdeleted = 4)
C SQL value for no rows
      parameter (notfound = 100)

C Set up error handling for main program
      exec sql whenever sqlwarning continue
      exec sql whenever not found continue
      exec sql whenever sqlerror stop
C Start up Ingres and the FORMS system
      exec sql connect 'personnel'
      exec frs forms

C Verify that the user can edit the "person" table 
   exec frs prompt noecho ('Password for table editor: ', :respbuf)

      if (respbuf .ne. 'MASTER_OF_ALL') then
           exec frs endforms
           exec sql disconnect
           stop 'No permission for task. Exiting . . .'
      endif
C Assume no SQL errors can happen during screen updating 
      exec sql whenever sqlerror continue
      exec frs message 'Initializing Person Form . . .' 
      exec frs forminit personfrm

C
C Initialize "persontbl" table field with a data set in FILL mode,
C so that the runtime user can append rows. To keep track of
C events occurring to original rows loaded into the table field,
C hide the unique person number.
C
    exec frs inittable personfrm persontbl fill (number = integer4)

      maxid = LoadTable()
      exec frs display personfrm update
      exec frs initialize
      exec frs activate menuitem 'Top'
      exec frs begin
C
C Provide menu items to scroll to both extremes of
C the table field.
C
           exec frs scroll personfrm persontbl to 1
      exec frs end
      exec frs activate menuitem 'Bottom'
      exec frs begin
           exec frs scroll personfrm persontbl to end 
      exec frs end
      exec frs activate menuitem 'Remove'
      exec frs begin
C
C Remove the person in the row the user's cursor is on.
C If there are no persons, exit operation with message.
C Note that this check cannot really happen, as there is
C always an UNDEFINED row in FILL mode.
C
           exec frs inquire_frs table personfrm
     1           (lastrow = lastrow(persontbl))
           if (lastrow .eq. 0) then
                exec frs message 'Nobody to Remove'
                exec frs sleep 2
                exec frs resume field persontbl
           endif

C Record it later
           exec frs deleterow personfrm persontbl
      exec frs end
      exec frs activate menuitem 'Find'
      exec frs begin
C
C Scroll user to the requested table field entry.
C Prompt the user for a name, and if one is typed in,
C loop through the data set searching for it.
C
          exec frs prompt ('Person''s name : ', :respbuf)
          if (respbuf(1:1) .eq. ' ') then
               exec frs resume field persontbl
          endif
          exec frs unloadtable personfrm persontbl
     1           (:pname  = name,
     2            :recnum = _record,
     3            :state  = _state)
          exec frs begin

C Do not compare with deleted rows
              if ((pname .eq. respbuf) .and.
     1            (state .ne. rowdeleted)) then
                   exec frs scroll personfrm persontbl
     1                 to :recnum
                   exec frs resume field persontbl
              endif
          exec frs end

C Fell out of loop without finding name
          write (msgbuf, 10) respbuf 
10        format ('Person "', a, 
     1         '" not found in table [HIT RETURN] ')
          exec frs prompt noecho (:msgbuf, :respbuf)

      exec frs end
      exec frs activate menuitem 'Exit'
      exec frs begin
          exec frs validate field persontbl
          exec frs breakdisplay
      exec frs end
      exec frs finalize

C
C Exit person table editor and unload the table field. If any
C updates, deletions or additions were made, duplicate these
C changes in the source table. If the user added new people,
C assign a unique person id to each person before adding the person
C to the table. To do this, increment the previously-saved maximum
C id number with each insert.
C

C Do all the updates in a transaction
      exec sql savepoint savept

C
C Hard code the error handling in the UNLOADTABLE loop, in 
C order to cleanly exit the loop.
C
      exec sql whenever sqlerror continue
      updaterr = .false.
      xaborted = .false.

      exec frs message 'Exiting Person Application . . .'
      exec frs unloadtable personfrm persontbl
     1      (:pname = name, :page = age,
     2       :pnum = number, :state = _state)
      exec frs begin

C Appended by user. Insert with new unique id.
           if (state .eq. rownew) then
                maxid = maxid + 1
                exec sql insert into person (name, age, number)
     1                 values (:pname, :page, :maxid)

C Updated by user. Reflect in table.
           else if (state .eq. rowchanged) then
                exec sql update person set
     1               name = :pname, age = :page
     2               where number = :pnum
C
C Deleted by user, so delete from table. Note that only
C original rows, not rows appended at runtime, are saved
C by the program.
C
           else if (state .eq. rowdeleted) then
                exec sql delete from person
     1               where number = :pnum

C Ignore UNDEFINED or UNCHANGED - No updates
           endif

C
C Handle error conditions -
C If an error occurred, abort the transaction.
C If no rows were updated, inform user and prompt
C for continuation.
C
           if (sqlcod .lt. 0) then 
C SQL error
                exec sql inquire_sql (:msgbuf = errortext)
                exec sql rollback to savept
                updaterr = .true.
                xaborted = .true.
                exec frs endloop
           else if (sqlcod .eq. notfound) then
                write (msgbuf, 11) pname 
11              format ('Person "', a, 
     1                        '" not updated. Abort all updates?')
                exec frs prompt (:msgbuf, :respbuf)
                if ((respbuf(1:1) .eq. 'y') .or.
     1               (respbuf(1:1) .eq. 'y')) then
                     exec sql rollback to savept
                     xaborted = .true.
                     exec frs endloop
                endif
           endif
      exec frs end
      if (.not. xaborted) then
C Commit the updates
            exec sql commit
      endif

C Terminate the FORMS and Ingres
      exec frs endforms
      exec sql disconnect
        if (updaterr) then
            print *, 'Your updates were aborted because of error:'
            print *, msgbuf
        endif
        end

C
C Function:   LoadTable
C Purpose:        Load the table field from the 'person' table. The
C             columns 'name' and 'age' will be displayed, and
C             'number' will be hidden.
C Parameters: None
C Returns:    Maximum employee number
C
      integer function LoadTable()
      exec sql include sqlca
C
C Declare person information:
C The preprocessor already knows that these variables have been
C declared, from their declarations in the main program.
C
      character*20 pname
      integer      page
      integer      pnum

C Max person id number to return
      integer maxid
      exec sql declare loadtab cursor for
     1    select name, age, number
     2    from person

C Set up error handling for loading procedure
C Close loadtab
      exec sql whenever sqlerror go to 100 
C Close loadtab
      exec sql whenever not found go to 100
      exec frs message 'Loading Person Information . . .'
      maxid = 0

C Fetch the maximum person id number for later use 
      exec sql select max(number)
     1      into :maxid
     2      from person
      exec sql open loadtab

55    if (sqlcod .ne. 0) go to 555

C Fetch data into record and load table field
      exec sql fetch loadtab into :pname, :page, :pnum
      exec frs loadtable personfrm persontbl
     1      (name = :pname, age = :page, number = :pnum)

      go to 55

555   continue
      exec sql whenever sqlerror continue

100   exec sql close loadtab
      LoadTable = maxid
      end