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
## (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
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.
C
## inittable person persontbl fill (number = integer)
call LdTab(pers)
## display person update
## initialize
## activate menuitem 'Top', frskey5
## {
C
C Provide menu, as well as the system FRS key to scroll
C to both extremes of the table field.
C
## scroll person persontbl TO 1
## }
## activate menuitem 'Bottom', frskey6
## {
## scroll person persontbl to end /* Forward */
## }
## activate menuitem 'Remove'
## {
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
## 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
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
## prompt ('Enter name of person: ', rspbuf)
if (rspbuf .EQ. ' ') then
## resume field persontbl
endif
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.
C
## inittable person persontbl fill (number = integer)
call LdTab(pers)
## display person update
## initialize
## activate menuitem 'Top', frskey5
## {
C
C Provide menu, as well as the system FRS key to scroll
C to both extremes of the table field.
C
## scroll person persontbl TO 1
## }
## activate menuitem 'Bottom', frskey6
## {
## scroll person persontbl to end /* Forward */
## }
## activate menuitem 'Remove'
## {
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
## 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
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
## 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
## (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
C Do all the updates in a transaction (for simplicity,
C this transaction does not restart on DEADLOCK error: 4700)
C
## 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
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.
C
## repeat delete from p where p.number = @pnum
else
C state .EQ. UNCHANGED or UNDEFINED - No updates
endif
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
C Do all the updates in a transaction (for simplicity,
C this transaction does not restart on DEADLOCK error: 4700)
C
## 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
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.
C
## 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.
C
## 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 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.
C
## 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
C
## 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
C Fetch the maximum person id number for later use
C PERFORMANCE max() will do sequential scan of table
C
## 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
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
C
## 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
C Fetch the maximum person id number for later use
C PERFORMANCE max() will do sequential scan of table
C
## 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
## (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 */
## }
## 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
## {
!
! 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
## (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
! 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
! 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
! 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
Last modified date: 01/30/2023