4. Embedded QUEL for Fortran : Sample Applications : UNIX and VMS--The Table Editor Table Field Application
 
Share this page                  
UNIX and VMS--The Table Editor Table Field Application
This EQUEL/FORMS application uses a table field to edit the Person table in the Personnel database. It 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 their use and their interaction with an Ingres database.
The application uses the following objects:
Object
Description
personnel
The program's database environment.
person
A table in the database with three columns:
name (c20)
age (i2)
number (i4)
personfrm
The VIFRED form with a single table field.
persontbl
A table field in the form with two columns:
name (c20)
age (i4)
When initialized, the table field includes the hidden number (i4) column.
At the beginning of the application, a retrieve statement is issued 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, in a multi-statement transaction, your updates are transferred back into the Person table.
The application runs in the UNIX and VMS environments.
UNIX: The following create statement describes the format of the Person database table:
##    create person
##        (name    = c20   /* Person name */
##         age     = i2,   /* Age */
##         number  = i4)   /* Unique id number */

C
C    Procedure: MAIN
C    Purpose: Entry point into Table Editor program.
C
##   program main

C    Table field row states
C              Empty or undefine row
     parameter (stUDEF=0)
C              Appended by user
     parameter (stNEW=1)
C              Loaded by program - not updated
     parameter (stUCHG=2)
C              Loaded by program - since changed
     parameter (stCHG=3)
C              Deleted by program
     parameter (stDEL=4)

##   declare forms
C    Table field entry information
C              State of date set entry
##   integer*4 state
C              Record number
##   integer*4 row
C              Last row in table field
##   integer*4 lstrow

C    Utility buffers
C              Message buffer
##   character*256 msgbuf
C              Response buffer
##   character*20 rspbuf
C    Status variables
C              Update error from database
##   integer*4 upderr
C              Number of rows updated
##   integer*4 updrow
C              Transaction aborted
     logical xactq
C              Save changes for quit
     logical savchg

C    The following variables correspond to the 'person' table
C              Full name
##   character*20 pname
C              Age of person
##   integer*4               page
C              Unique person number
##   integer*4               pnum
C              Max person id
##   integer*4               maxid

C    Start up Ingres and the FORMS system
##   INGRES 'personnel'

##   forms
C    Verify that the user can edit the 'person' table
##   prompt noecho ('Password for table editor: ', rspbuf)

     if ( rspbuf .NE. 'MASTER_OF_ALL') then
##        message 'No permission for task. Exiting . . .'
##        endforms
##        exit
          call exit(-1)
     endif

##   message 'Initializing Person Form . . .'

##   range of p IS person
##   forminit person
C
C    Initialize 'persontbl' table field with a data set in FILL 
C    mode so that the runtime user can append rows. To keep track
C    of events occurring to original rows that will be loaded into
C    the table field, hide the unique person number.

##   inittable person persontbl fill (number = integer)
     call LdTab(pers)

##   display person update
##   initialize

##   activate menuitem 'Top', frskey5
##   {

C         Provide menu, as well as the system FRS key to scroll
C         to both extremes of the table field.

##        scroll person persontbl TO 1
##   }  

##   activate menuitem 'Bottom', frskey6
##   {
##        scroll person persontbl to end  /* Forward */
##   }

##   activate menuitem 'Remove'
##   {

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.

##        inquire_frs table person (lstrow = lastrow(persontbl))

        if (lstrow .EQ. 0) then
##             message 'Nobody to Remove'
##             sleep 2
##             resume field persontbl
        endif

##      deleterow person persontbl /* Record later */
##   }

##   activate menuitem 'Find', frskey7
##   {

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.

##       prompt ('Enter name of person: ', rspbuf)
         if (rspbuf .EQ. ' ') then
##           resume field persontbl
         endif  
##       unloadtable person persontbl 
##           (pname = name, row = _RECORD, state = _STATE)
##       {
C    Do not compare with deleted rows
         if ( (pname .EQ. rspbuf) .AND. 
&             (state .NE. stDEL) ) then
##            scroll person persontbl to row
##            resume field persontbl
         endif

##     }

C    Fell out of loop without finding name
           msgbuf = 'Person "' // rspbuf // 
&                   '" not found in table [HIT RETURN]'
##         prompt noecho (msgbuf, rspbuf)
##     }

##   activate menuitem 'Save', frskey8
##   {
##         validate field persontbl
           savchg = .TRUE.
##         breakdisplay
##   }

##   activate menuitem 'Quit', frskey2
##   {
           savchg = .FALSE.
##         breakdisplay
##   }
##   finalize

       if ( .NOT. savchg ) then
##          endforms
##          exit
            call exit(1)
       endif
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 we
C    must assign a unique person id before returning it to the
C    table. To do this, increment the previously saved maximum
C    id number with each insert.

C    Do all the updates in a transaction (for simplicity,
C    this transaction does not restart on DEADLOCK error: 4700)

##   begin transaction

     upderr = 0
     xactq = .FALSE.

##   message 'Exiting Person Application . . .';

##   unloadtable person persontbl 
##          (pname = name, page = age, 
##          pnum = number, state = _STATE)
##   {
            if (state .EQ. stNEW) then
C    Appended by user. Insert with new unique id
                  maxid = maxid + 1
##                repeat append to person (name = @pname, 
##                                         age = @page, 
##                                         number = @maxid)
            else if (state .EQ. stCHG) then
C    Updated by user. Reflect in table
##              repeat replace p (name = @pname, age = @page) 
##                     where p.number = @pnum
            else if (state .EQ. stDEL) then

C                 Deleted by user, so delete from table. Note that 
C                 only original rows are saved by the program, and 
C                 not rows appended at runtime.

##              repeat delete from p where p.number = @pnum
            else
C               state .EQ. UNCHANGED or UNDEFINED - No updates
            endif
C
C    Handle error conditions - 
C    If an error occurred, then ABORT the transaction.
C    If no rows were updated then inform user, and
C    prompt for continuation.

##      inquire_ingres (upderr = ERRORNO, updrow = ROWCOUNT)

          if (upderr .GT. 0) then
##            inquire_equel (msgbuf = errortext)
##            abort
              xactq = .true.
##            endloop
          else if (updrow .EQ. 0) then
              msgbuf = 'Person "' // pname // 
&                      '" not updated. Abort all updates? '
##            prompt (msgbuf, rspbuf)
              if ((rspbuf(1:1) .EQ. 'Y') .OR. 
&                  (rspbuf(1:1) .EQ. 'y')) then
##                 abort
                   xactq = .TRUE.
##                 endloop
               endif
           endif

##         }     /* end of UNLOADTABLE loop */

     if ( .NOT. xactq ) then
##             end transaction  /* Commit the updates */
     endif

##   endforms           /* Terminate the FORMS and Ingres */
##   exit

     if (upderr .NE. 0) then
           print *, 'Your updates were aborted because of error: '
           print *, msgbuf
     endif
C    end of main
##   end
C
C    Subroutine:    LdTab
C    Purpose:       Load the table field from the 'person' table.
C                   The columns 'name' and 'age' will be displayed,
C                   and 'number' will be hidden.
C Parameters:
C               None
C   Returns:
C               Nothing

##   subroutine LdTab(pers)
C    Set up error handling for loading procedure
##   declare forms

C    The following variables correspond to the 'person' table
C            Full name
##       character*20 pname
C            Age of person
##       integer*4 page
C            Unique person number
##       integer*4 pnum
C            Max person id number
##       integer*4 maxid

##   message 'Loading Person Information . . .'

C    Fetch the maximum person id number for later use
C    PERFORMANCE max() will do sequential scan of table

##   retrieve (maxid = max(p.number))

C    Fetch data, and load table field
##   retrieve (pname = p.name, page = p.age, 
##             pnum = p.number)
##   {
##         loadtable person persontbl 
##             (name = pname, age = page, 
##             number = pnum)
##   }
##   end  

VMS: The following create statement describes the format of the Person database table:
##      create person
##                (name    = c20,      /* Person name */
##                 age     = i2,       /* Age */
##                 number  = i4)       /* Unique id number */


!   Procedure: MAIN
!   Purpose: Entry point into Table Editor program.

##  program main

    ! Table field row states
    parameter (stUNDEF=0)       ! Empty or undefined row
    parameter (stNEW=1)         ! Appended by user
    parameter (stUNCHANGED=2)   ! Loaded by program - not updated
    parameter (stCHANGE=3)      ! Loaded by program - since changed
    parameter (stDELETE=4)     ! Deleted by program

##  declare forms
                                    ! Table field entry information
##  integer*4 state                 ! State of data set entry
##  integer*4 row                   ! Record number
##  integer*4 lastrow              ! Last row in table field

    ! Utility buffers
##  character*256 msgbuf            ! Message buffer
##  character*20 respbuf            ! Response buffer

    ! Status variables
##  integer*4 update_error          ! Update error from database
##  integer*4 update_rows           ! Number of rows updated
    logical xact_aborted            ! Transaction aborted
    logical save_changes            ! Save changes or Quit

    ! structure person corresponds to 'person' table 
##  structure /person/
##             character*20 pname   ! Full name
##             integer*4 page       ! Age of person
##             integer*4 pnumber    ! Unique person number
##             integer*4 maxid      ! Max person id number
##  end structure
##  record /person/ pers
    ! Start up Ingres and the FORMS system
##  ingres 'personnel'

##  forms

    ! Verify that the user can edit the 'person' table
##  prompt noecho ('Password for table editor: ', respbuf)

    if ( respbuf .NE. 'MASTER_OF_ALL') then
##         message 'No permission for task. Exiting . . .'
##         endforms
##         exit
           call exit(-1)
    endif

##  message 'Initializing Person Form . . .'

##  range of p is person

##  forminit personfrm

    ! 
    !  Initialize 'persontbl' table field with a data set in 
    !  FILL mode so that the runtime user can append rows. 
    !  To keep track of events occurring to original rows that 
    !  will be loaded into the table field, hide the unique 
    !  person number.
    ! 
##  inittable personfrm persontbl fill (number = integer)

    call Load_Table(pers)

##  display personfrm update
##  initialize

##  activate menuitem 'Top', frskey5
##  {
            ! 
            ! Provide menu, as well as the system FRS key to scroll
            ! to both extremes of the table field.
            !
##           scroll personfrm persontbl to 1
##  }

##  activate menuitem 'Bottom', frskey6
##  {
##           scroll personfrm persontbl to end     /* Forward */
##  }
##  activate menuitem 'Remove'
##  {
         ! 
         ! Remove the person in the row the user's cursor is on.
         ! If there are no persons, exit operation with message.
         ! Note that this check cannot really happen as there is 
         ! always an UNDEFINED row in FILL mode.
         !
##       inquire_frs table personfrm (lastrow = lastrow(persontbl))

           if (lastrow .EQ. 0) then
##             message 'Nobody to Remove'
##             sleep 2
##             resume field persontbl
           endif

##         deleterow personfrm persontbl         /* Record later */
##  }
##  activate menuitem 'Find', frskey7
##  {
           !
           ! Scroll user to the requested table field entry.
           ! Prompt the user for a name, and if one is typed in
           ! loop through the data set searching for it.
           !
##         prompt ('Enter name of person: ', respbuf)
           if (respbuf .EQ. ' ') then
##             resume field persontbl
           endif
##         unloadtable personfrm persontbl 
##           (pers.pname = name, row = _RECORD, state = _STATE)
##         {
             ! Do not compare with deleted rows
             if ( (pers.pname .EQ. respbuf) .AND.
     1            (state .NE. stDELETE) ) then
##               Scroll personfrm persontbl to row
##               resume field persontbl
             endif

##         }

           ! Fell out of loop without finding name
           msgbuf = 'Person "' // respbuf //
     1              '" not found in table [HIT RETURN]'
##         prompt noecho (msgbuf, respbuf)
##         }

##         activate menuitem 'Save', frskey8
##         {
##               validate field persontbl
                 save_changes = .TRUE.
##               breakdisplay
##         }

##         activate menuitem 'Quit', frskey2
##         {
                 save_changes = .FALSE.
##               breakdisplay
##         }
##         finalize

           if ( save_changes .NE. .TRUE.) then
##              endforms
##              exit
                call exit(1)
           endif
     !
     ! Exit person table editor and unload the table field. If any
     ! updates, deletions or additions were made, duplicate these
     ! changes in the source table. If the user added new people we
     ! must assign a unique person id before returning it to 
     ! the table. To do this, increment the previously saved
     ! maximum id number with each insert.
     !
     ! Do all the updates in a transaction (for simplicity,
     ! this transaction does not restart on DEADLOCK error: 4700)
     !
##   begin transaction

     update_error = 0
     xact_aborted = .FALSE.

##   message 'Exiting Person Application . . .';

##   unloadtable personfrm persontbl 
##     (pers.pname = name, pers.page = age, 
##      pers.pnumber = number, state = _STATE)
##   {
        if (state .EQ. stNEW) then
            ! Appended by user. Insert with new unique id
            pers.maxid = pers.maxid + 1
##          repeat append to person    (name = @pers.pname, 
##                                      age = @pers.page, 
##                                      number = @pers.maxid)
        else if (state .EQ. stCHANGE) then
            ! Updated by user. Reflect in table
##          repeat replace p (name = @pers.pname, age = @pers.page) 
##                   where p.number = @pers.pnumber
        else if (state .EQ. stDELETE) then
            !
            ! Deleted by user, so delete from table. Note that only
            ! original rows are saved by the program, and not rows
            ! appended at runtime.
            !
##          repeat delete from p where p.number = @pers.pnumber
        else
             ! state .EQ. UNCHANGED or UNDEFINED - No updates
        endif
        !
        ! Handle error conditions - 
        ! If an error occurred, then ABORT the transaction.
        ! If no rows were updated then inform user, and
        ! prompt for continuation.
        !
##      inquire_ingres (update_error = ERRORNO, 
##            update_rows = ROWCOUNT)

        if (update_error .GT. 0) then              ! Error
##          inquire_equel (msgbuf = ERRORTEXT)
##          abort
            xact_aborted = .TRUE.
##          endloop
        else if (update_rows .EQ. 0) then
            msgbuf = 'Person "' // pers.pname //
    1                '" not updated. Abort all updates? '
##          prompt (msgbuf, respbuf)
            if  ((respbuf(1:1) .EQ. 'Y') .OR.
    1            (respbuf(1:1) .EQ. 'y')) then
##               abort
                 xact_aborted = .TRUE.
##             endloop
            endif
        endif

##    }         /* end of UNLOADTABLE loop */

    if (xact_aborted .EQ. .FALSE.) then
##       end transaction        /* Commit the updates */
    endif

##  endforms            /* Terminate the FORMS and Ingres */
##  exit

    if (update_error .NE. 0) then
         print *, 'Your updates were aborted because of error: '
         print *, msgbuf
    endif
##  end               ! Main Program
!
!   Subroutine: Load_Table
!   Purpose:    Load the table field from the 'person' table. The
!               columns 'name' and 'age' will be displayed, and 
!               'number' will be hidden.
!   Parameters:
!               None
!   Returns:
!               Nothing
!
##  subroutine Load_Table(pers)
    ! Set up error handling for loading procedure
##  declare forms

    ! structure person corresponds to 'person' table 
##  structure /person/
##             character*20 pname     ! Full name
##             integer*4 page         ! Age of person
##             integer*4 pnumber      ! Unique person number
##             integer*4 maxid        ! Max person id number
##  end structure
##  record /person/ pers

##  message 'Loading Person Information . . .'
    !
    ! Fetch the maximum person id number for later use
    ! PERFORMANCE max() will do sequential scan of table
    !
##  retrieve (pers.maxid = max(p.number))

    ! Fetch data, and load table field
##  retrieve (pers.pname = p.name, pers.page = p.age, 
##                 pers.pnumber = p.number)
##       {
##           loadtable personfrm persontbl 
##             (name = pers.pname, age = pers.page, 
##              number = pers.pnumber)
##       }

##  end