|
|
|
ALLBASE/SQL FORTRAN Application Programming Guide: HP 3000 MPE/iX Computer Systems > Chapter 8 Processing with Cursors
Program Using UPDATE WHERE CURRENT |
|
The flow chart in Figure 8-4 summarizes the functionality of program forex8. This program uses a cursor and the UPDATE WHERE CURRENT command to update column ReceivedQty in table PurchDB.OrderItems. The runtime dialog for forex8 appears in Figure 8-5, and the source code in Figure 8-6. The main program 1 first executes subroutine DeclareCursor 9, which contains the DECLARE CURSOR command. This command is a preprocessor directive and is not executed at runtime. At runtime, subroutine DeclareCursor only displays the message Declare Cursor. The DECLARE CURSOR command defines a cursor named OrderReview. The cursor is associated with a SELECT command that retrieves the following columns for all rows in table PurchDB.OrderItems having a specific order number but no null values in column VendPartNumber:
OrderNumber (defined NOT NULL)
ItemNumber (defined NOT NULL)
VendPartNumber
ReceivedQty
Cursor OrderReview has a FOR UPDATE clause naming column ReceivedQty to allow the user to change the value in this column. Next, to establish a DBE session, program forex8 executes function ConnectDBE 3. This function evaluates to TRUE when the CONNECT command for the sample DBEnvironment, PartsDBE, is successfully executed. The program then executes function FetchUpdate 13 until the Done flag is set to TRUE. Function FetchUpdate 13 prompts for an order number or a 0. When the user enters a 0, FetchUpdate is set to FALSE, which in turn sets the Done flag to FALSE, and the program terminates. When the user enters an order number, the program begins a transaction by executing subroutine BeginTransaction 6, which executes the BEGIN WORK command. Cursor OrderReview is then opened by invoking function OpenCursor 10. This function, which executes the OPEN CURSOR command, evaluates to TRUE when the command is successful. A row at a time is retrieved and optionally updated until the Fetch flag is set to FALSE. This flag becomes false when:
The FETCH command 13B names an indicator variable for ReceivedQty, the only column in the query result that may contain a null value. If the FETCH command is successful, the program executes subroutine DisplayUpdate 12 to display the current row and optionally update it. Subroutine DisplayUpdate 12 executes subroutine DisplayRow 8 to display the current row. If column ReceivedQty in the current row contains a null value, the message ReceivedQty is NULL is displayed. The user is then asked whether he wants to update the current ReceivedQty value 12A. If so, the user is prompted for a new entry. Depending on the user's response, the program assigns an appropriate value to the indicator variable ReceivedQtyInd, and then issues the UPDATE WHERE CURRENT command 12B. If the user enters a 0, the indicator variable is set to -1 and a null value is assigned to this column. If the user enters a non-zero value, the indicator variable is set to 0 and the user-entered value is assigned to the column. The program then asks whether to FETCH another row. If so, the FETCH command is re-executed. If not, the program asks whether the user wants to make permanent any updates he may have made in the active set. To keep any row changes, the program executes subroutine CommitWork 6, which executes the COMMIT WORK command. To undo any row changes, the program executes subroutine RollBackWork 7, which executes the ROLLBACK WORK command. The COMMIT WORK command is also executed when ALLBASE/SQL sets SQLCode to 100 following execution of the FETCH command. SQLCode is set to 100 when no rows qualify for the active set or when the last row has already been fetched. If the FETCH command fails for some other reason, the ROLLBACK WORK command is executed instead. Before any COMMIT WORK or ROLLBACK WORK command is executed, cursor OrderReview is closed. Although the cursor is automatically closed whenever a transaction is terminated, it is good programming practice to use the CLOSE command to close open cursors prior to terminating transactions. When the program user enters a 0 in response to the order number prompt 13A, the program terminates by executing subroutine TerminateProgram 4, which executes the RELEASE command 2. Explicit status checking is used throughout this program. After each embedded SQL command is executed, SQLCA.SQLCode is checked. If SQLCode is less than 0, the program executes subroutine SQLStatusCheck 2, which executes the SQLEXPLAIN command. Figure 8-5 Runtime Dialog of Program forex8
:run forex8
Program to UPDATE OrderItems table via a CURSOR -- forex8
Event List:
CONNECT TO PartsDBE
Prompt for Order Number
BEGIN WORK
OPEN Cursor
FETCH a row
Display the retrieved row
Prompt for new Received Quantity
UPDATE row within OrderItems table
FETCH the next row, if any, with the same Order Number
Repeat the above five steps until no more rows qualify
CLOSE Cursor
COMMIT WORK or ROLLBACK WORK
Repeat the above eleven steps until user enters 0
RELEASE PartsDBE
Declare Cursor OrderReview
CONNECT TO PartsDBE
Enter Order Number or a 0 to STOP >30520
BEGIN WORK
OPEN the Declared Cursor OrderReview
OrderNumber: 30520
ItemNumber: 1
VendPartNumber: 9375
ReceivedQty: 9
Do you want to change ReceivedQty (Y/N)? > n
Do you want to see another row (Y/N)? > y
OrderNumber: 30520
ItemNumber: 2
VendPartNumber: 9105
ReceivedQty: 3
Do you want to change ReceivedQty (Y/N)? > y
Enter New ReceivedQty or a 0 for NULL> 15
Do you want to see another row (Y/N)? > y
OrderNumber: 30520
ItemNumber: 3
VendPartNumber: 9135
ReceivedQty: 3
Do you want to change ReceivedQty (Y/N)? > n
Do you want to see another row (Y/N)? > y
Row not found or no more rows!
Do you want to save your changes (Y/N)? > n
CLOSE the Declared Cursor OrderReview
ROLLBACK WORK
No Rows Changed!
Enter Order Number or a 0 to STOP > 30510
BEGIN WORK
OPEN the Declared Cursor OrderReview
OrderNumber: 30510
ItemNumber: 1
VendPartNumber: 1001
ReceivedQty: 3
Do you want to change ReceivedQty (Y/N)? > n
Do you want to see another row (Y/N)? > n
CLOSE the Declared Cursor OrderReview
COMMIT WORK
Enter Order Number or a 0 to STOP > 0
User entered a 0
RELEASE PartsDBE
:
Figure 8-6 Program forex8: Using UPDATE WHERE CURRENT
PROGRAM forex8
C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C* This program illustrates the use of UPDATE WHERE CURRENT *
C* with a Cursor to update a single row at a time. *
C* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IMPLICIT NONE
LOGICAL*2 Done, ConnectDBE, FetchUpdate
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Beginning of the Main Program *) 1
WRITE (*,*) CHAR(27), 'U'
WRITE (*,*) 'Program to UPDATE OrderItems table via a
1CURSOR -- forex8'
WRITE (*,*) ' '
WRITE (*,*) 'Event List:'
WRITE (*,*) ' CONNECT TO PartsDBE'
WRITE (*,*) ' Prompt for Order Number'
WRITE (*,*) ' BEGIN WORK'
WRITE (*,*) ' OPEN Cursor'
WRITE (*,*) ' FETCH a row'
WRITE (*,*) ' Display the retrieved row'
WRITE (*,*) ' Prompt for new Received Quantity'
WRITE (*,*) ' UPDATE row within OrderItems table'
WRITE (*,*) ' FETCH the next row, if any, with the
1same Order Num
1ber'
WRITE (*,*) ' Repeat the above five steps until no
1more rows qual
1ify'
WRITE (*,*) ' CLOSE Cursor'
WRITE (*,*) ' COMMIT WORK or ROLLBACK WORK'
WRITE (*,*) ' Repeat the above eleven steps until
1user enters 0'
WRITE (*,*) ' RELEASE PartsDBE'
CALL DeclareCursor
WRITE (*,*) ' '
IF (ConnectDBE()) THEN
Done = .TRUE.
DO WHILE (Done)
Done = FetchUpdate()
END DO
CALL TerminateProgram
ELSE
WRITE (*,*) 'Cannot Connect to your DBEnvironment!'
ENDIF
STOP
END
C (* End of Main Program *)
C (* Beginning of the Sub-Routines *)
SUBROUTINE SQLStatusCheck 2
C**** SUBROUTINE SQLStatusCheck checks status of SQL commands
C**** and print HPSQL error messages.
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
LOGICAL*2 Abort, Check
INTEGER DeadLock
PARAMETER (DeadLock = -14024)
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
CHARACTER*120 SQLMessage
EXEC SQL END DECLARE SECTION
C (* End Host Variable Declarations *)
Abort = .FALSE.
IF (SQLCode .LT. DeadLock) THEN
Abort = .TRUE.
WRITE (*,*) 'A serious error has occurred.'
ENDIF
Check = .TRUE.
DO WHILE (Check)
EXEC SQL SQLEXPLAIN :SQLMessage
WRITE(*, 100) SQLMessage
100 FORMAT(A120)
IF (SQLCode .EQ. 0) THEN
Check = .FALSE.
ENDIF
END DO
IF (Abort) THEN
CALL TerminateProgram
STOP 'Program Aborted'
END IF
RETURN
END
C (* End of Subroutine SQLStatusCheck *)
LOGICAL*2 FUNCTION ConnectDBE() 3
C**** FUNCTION to connect to PartsDBE
INTEGER*2 OK
PARAMETER (OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
WRITE (*, *) 'CONNECT TO PartsDBE'
EXEC SQL CONNECT TO 'PartsDBE'
ConnectDBE = .TRUE.
IF (SQLCode .NE. OK) THEN
ConnectDBE = .FALSE.
CALL SQLStatusCheck
ENDIF
RETURN
END
C (* End of Function ConnectDBE *)
SUBROUTINE TerminateProgram 4
C**** SUBROUTINE to release from PartsDBE
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
WRITE(*,*) ' '
WRITE(*,*) 'RELEASE PartsDBE'
EXEC SQL RELEASE
RETURN
END
C (* End of Subroutine TerminateProgram *)
SUBROUTINE BeginTransaction 5
C**** SUBROUTINE to begin work
INTEGER*2 OK
PARAMETER (OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
WRITE (*,*) 'BEGIN WORK'
EXEC SQL BEGIN WORK
IF (SQLCode .NE. OK) THEN
CALL SQLStatusCheck
CALL TerminateProgram
ENDIF
RETURN
END
C (* End of Subroutine BeginTransaction *)
SUBROUTINE CommitWork 6
C**** SUBROUTINE to commit work
INTEGER*2 OK
PARAMETER (OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
WRITE(*,*) 'COMMIT WORK'
EXEC SQL COMMIT WORK
IF (SQLCode .NE. OK) THEN
CALL SQLStatusCheck
CALL TerminateProgram
ENDIF
RETURN
END
C (* End of Subroutine CommitWork *)
SUBROUTINE RollBackWork 7
C**** SUBROUTINE to RollBack Work
INTEGER*2 OK
PARAMETER (OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
WRITE(*,*) 'ROLLBACK WORK'
EXEC SQL ROLLBACK WORK
IF (SQLCode .NE. OK) THEN
CALL SQLStatusCheck
CALL TerminateProgram
ENDIF
RETURN
END
C (* End of Subroutine RollBackWork *)
SUBROUTINE DisplayRow (OrderNumber,ItemNumber,VendPartNumber,
1 ReceivedQty, ReceivedQtyInd) 8
C**** SUBROUTINE to display OrderItems table rows
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
INTEGER OrderNumber
INTEGER ItemNumber
CHARACTER*16 VendPartNumber
INTEGER ReceivedQty
SQLIND ReceivedQtyInd
CHARACTER*120 SQLMessage
EXEC SQL END DECLARE SECTION
C (* End Host Variable Declarations *)
WRITE(*,*) ' '
WRITE(*, '('' OrderNumber: '',I10)') OrderNumber
WRITE(*, '('' ItemNumber: '',I10)') ItemNumber
WRITE(*, '('' VendPartNumber: '',A16)') VendPartNumber
IF (ReceivedQtyInd .LT. 0) THEN
WRITE(*,*) ' ReceivedQty is NULL'
ELSE
WRITE(*, '('' ReceivedQty: '',I5)') ReceivedQty
ENDIF
WRITE(*,*) ' '
RETURN
END
C (* End of Subroutine DisplayRow *)
SUBROUTINE DeclareCursor 9
C**** SUBROUTINE to declare the Cursor
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
INTEGER OrderNumber
INTEGER ItemNumber
CHARACTER*16 VendPartNumber
INTEGER ReceivedQty
SQLIND ReceivedQtyInd
CHARACTER*120 SQLMessage
EXEC SQL END DECLARE SECTION
C (* End Host Variable Declarations *)
WRITE (*,*) ' '
WRITE (*,*) 'Declare Cursor OrderReview'
WRITE (*,*) ' '
EXEC SQL DECLARE OrderReview
1 CURSOR FOR
2 SELECT OrderNumber,
3 ItemNumber,
4 VendPartNumber,
5 ReceivedQty
6 FROM PurchDB.OrderItems
7 WHERE OrderNumber = :OrderNumber
8 AND VendPartNumber IS NOT NULL
9 FOR UPDATE OF ReceivedQty
RETURN
END
C (* End of Subroutine DeclareCursor *)
LOGICAL*2 FUNCTION OpenCursor(OrderNumber, ItemNumber,10
1 VendPartNumber, ReceivedQty, ReceivedQtyInd)
C**** FUNCTION to open the Cursor
INTEGER OK
PARAMETER (OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
C (* End Host Variable Declarations *)
OpenCursor = .TRUE.
WRITE (*,*) ' '
WRITE (*,*) 'OPEN the Declared Cursor OrderReview'
WRITE (*,*) ' '
EXEC SQL OPEN OrderReview
IF (SQLCode .NE. OK) THEN
OpenCursor = .FALSE.
CALL SQLStatusCheck
CALL RollBackWork
ENDIF
RETURN
END
C**** (End of Function OpenCursor)
SUBROUTINE CloseCursor 11
C**** SUBROUTINE to close the Cursor
INTEGER OK
PARAMETER (OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
EXEC SQL END DECLARE SECTION
C (* End Host Variable Declarations *)
WRITE (*,*) ' '
WRITE (*,*) 'CLOSE the Declared Cursor OrderReview'
WRITE (*,*) ' '
EXEC SQL CLOSE OrderReview
IF (SQLCode .NE. OK) THEN
CALL SQLStatusCheck
CALL TerminateProgram
ENDIF
RETURN
END
C**** (End of Subroutine CloseCursor)
SUBROUTINE DisplayUpdate(OrderNumber, ItemNumber, 12
1 VendPartNumber, ReceivedQty, ReceivedQtyInd,
2 RowCounter,Fetch)
C**** SUBROUTINE to Display and Update a row from PurchDB.OrderItems
LOGICAL*2 Fetch
CHARACTER Response
INTEGER NotFound,MultipleRows,OK,RowCounter
PARAMETER (NotFound = 100,
1 MultipleRows = -10002,
2 OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
INTEGER OrderNumber
INTEGER ItemNumber
CHARACTER*16 VendPartNumber
INTEGER ReceivedQty
SQLIND ReceivedQtyInd
CHARACTER*120 SQLMessage
EXEC SQL END DECLARE SECTION
CALL DisplayRow(OrderNumber, ItemNumber, VendPartNumber,
1 ReceivedQty, ReceivedQtyInd)
WRITE (*,100) 12A
100 FORMAT (/$, ' Do you want to change ReceivedQty (Y/N)? > ')
READ (*, 110) Response
110 FORMAT(A1)
IF ((Response .EQ. 'Y') .OR. (Response .EQ. 'y')) THEN
WRITE (*,120)
120 FORMAT (/$,'Enter New ReceivedQty or a 0 for NULL > ')
READ (*,130) ReceivedQty
130 FORMAT(I5)
IF (ReceivedQty .EQ. 0) THEN
ReceivedQtyInd = -1
ELSE
ReceivedQtyInd = 0
ENDIF
EXEC SQL UPDATE PurchDB.OrderItems 12B
1 SET ReceivedQty = :ReceivedQty :ReceivedQtyInd
2 WHERE CURRENT OF OrderReview
IF (SQLCode .NE. OK) THEN
CALL SQLStatusCheck
ELSE
RowCounter = RowCounter +1
ENDIF
ENDIF
WRITE (*,140)
140 FORMAT (/$, 'Do you want to see another row (Y/N)? > ')
READ (*, 150) Response
150 FORMAT (A1)
IF ((Response .EQ. 'N') .OR. (Response .EQ. 'n')) THEN
IF (RowCounter .GT. 0) THEN
WRITE (*,160)
160 FORMAT (/$, 'Do you want to save your changes (Y/N)? >')
READ (*, 170) Response
170 FORMAT (A1)
IF ((Response .EQ. 'N') .OR. (Response .EQ. 'n')) THEN
CALL CloseCursor
CALL RollBackWork
Fetch = .FALSE.
WRITE (*,*) 'No Row(s) Changed! '
ELSE
CALL CloseCursor
CALL CommitWork
Fetch = .FALSE.
WRITE (*, '('' Row(s) Changed: '',I2)') RowCounter
ENDIF
ELSEIF (RowCounter .EQ. 0) THEN
CALL CloseCursor
CALL CommitWork
Fetch = .FALSE.
ENDIF
ENDIF
RETURN
END
C**(End of Subroutine DisplayUpdate)
LOGICAL*2 FUNCTION FetchUpdate() 13
C**FUNCTION to Fetch rows from PurchDB.OrderItems table.
CHARACTER Response
LOGICAL*2 Fetch,OpenCursor
INTEGER NotFound,MultipleRows,OK,RowCounter
PARAMETER (NotFound = 100,
1 MultipleRows = -10002,
2 OK = 0)
C (* Begin SQL Communication Area *)
EXEC SQL INCLUDE SQLCA
C (* Begin Host Variable Declarations *)
EXEC SQL BEGIN DECLARE SECTION
INTEGER OrderNumber
INTEGER ItemNumber
CHARACTER*16 VendPartNumber
INTEGER ReceivedQty
SQLIND ReceivedQtyInd
CHARACTER*120 SQLMessage
EXEC SQL END DECLARE SECTION
C (* End Host Variable Declarations *)
RowCounter = 0
FetchUpdate = .TRUE.
WRITE (*,100) 13A
100 FORMAT(/$, 'Enter Order Number or a 0 to stop > ')
READ (*,110) OrderNumber
110 FORMAT(I10)
IF (OrderNumber .NE. 0) THEN
CALL BeginTransaction
IF (OpenCursor(OrderNumber,ItemNumber,
1 VendPartNumber,ReceivedQty,ReceivedQtyInd)) THEN
Fetch = .TRUE.
DO WHILE (Fetch)
EXEC SQL FETCH OrderReview 13B
1 INTO :OrderNumber,
1 :ItemNumber,
2 :VendPartNumber,
3 :ReceivedQty :ReceivedQtyInd
IF (SQLCode .EQ. OK) THEN
CALL DisplayUpdate(OrderNumber,ItemNumber,VendPartNumber,
1 ReceivedQty, ReceivedQtyInd, RowCounter,Fetch)
ELSEIF (SQLCode .EQ. NotFound) THEN
Fetch = .FALSE.
WRITE (*,*) ' '
WRITE (*,*) 'Row not found or no more rows!'
IF (RowCounter .GT. 0) THEN
WRITE (*,120)
120 FORMAT (/$, 'Do you want to save your changes (Y/N)? > ' )
READ (*,130) Response
130 FORMAT(A1)
IF ((Response .EQ. 'N') .OR. (Response .EQ. 'n')) THEN
CALL CloseCursor
CALL RollBackWork
WRITE (*,*) 'No Row(s) Changed! '
ELSE
CALL CloseCursor
CALL CommitWork
WRITE (*, '('' Row(s) Changed: '',I2)') RowCounter
ENDIF
ELSEIF (RowCounter .EQ. 0) THEN
CALL CloseCursor
CALL CommitWork
ENDIF
ELSEIF (SQLCode .EQ. MultipleRows) THEN
Fetch = .FALSE.
WRITE(*,*) ' '
WRITE (*,*) 'WARNING: More than one row qualifies!'
CALL SQLStatusCheck
ELSE
Fetch = .FALSE.
CALL SQLStatusCheck
CALL CloseCursor
CALL RollBackWork
ENDIF
END DO
ELSE
FetchUpdate = .FALSE.
WRITE (*,*) 'Failed to Open Cursor'
ENDIF
ELSE
FetchUpdate = .FALSE.
WRITE (*,*) 'User entered an 0'
ENDIF
RETURN
END
C (* End of Subroutine FetchUpdate *)
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
![[Flow Chart of Program forex8]](img/x0601.gif)