The new test program, PCTB003B, looks like this (The cursor stuff can be found in the DISPLAY-ALL-RECORDS SECTION):
----+-*--1----+----2----+----3----+----4----+----5----+----6----+----7-*--+----8When i am done with it, interesting will be testing the whole stuff with subroutines, i will release a new version of the source code of the preprocessor.
**************************************************************************
* I D E N T I F I C A T I O N D I V I S I O N *
**************************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. PCTB003B.
AUTHOR. THE_PIPER.
DATE-WRITTEN. TODAY.
/
**************************************************************************
* D A T A D I V I S I O N *
**************************************************************************
DATA DIVISION.
/
**************************************************************************
* W O R K I N G S T O R A G E S E C T I O N *
**************************************************************************
WORKING-STORAGE SECTION.
*
* The needed working storage stuff for the framework
COPY POCTBBATWS.
*
* This will be displayed in the logfile at runtime
01 POCTB-VERSION PIC X(38)
VALUE '20120426 1.0 INITIAL RELEASE'.
*
01 FIELD1.
05 FIELD1-NUM PIC 9(08).
05 FILLER PIC X(12) VALUE SPACE.
01 FIELD2 PIC X(16).
01 FIELD3 PIC X(32).
*
01 T PIC S9(9) COMP.
*
* The communication area for the database
EXEC SQL
INCLUDE SQLCA.
END-EXEC.
/
**************************************************************************
* P R O C E D U R E D I V I S I O N *
**************************************************************************
PROCEDURE DIVISION.
* The framework itself, calling POCTB-ACTION to run the users coding
EXEC SQL
INCLUDE POCTBBAT REPLACING 'TTTTNNNB' BY 'PCTB003B'.
END-EXEC.
/
**************************************************************************
* P O C T B - A C T I O N S E C T I O N *
**************************************************************************
POCTB-ACTION SECTION.
*
DISPLAY 'In POCTB-ACTION.'
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Delete entire table'
*
EXEC SQL
DELETE
FROM example_table
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
*
DISPLAY 'Insert new records'
*
PERFORM VARYING T FROM 1 BY 1 UNTIL T > 1000
MOVE T TO FIELD1-NUM
EXEC SQL
INSERT
INTO example_table
(
FIELD1,
FIELD2,
FIELD3
)
VALUES
(
:FIELD1 ,
'Value2' ,
'Value3'
)
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
END-PERFORM
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Update the first record'
*
EXEC SQL
UPDATE example_table
SET FIELD1 = 'UpdatedValue1'
WHERE FIELD1 = '00000001'
END-EXEC.
* DISPLAY 'SQLCA-STATEMENT=' SQLCA-STATEMENT
* DISPLAY 'SQLCODE=' SQLCODE
* DISPLAY 'SQLCA-COUNT=' SQLCA-COUNT
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
*
PERFORM DISPLAY-ALL-RECORDS
*
DISPLAY 'Ende POCTB-ACTION.'
*
.
POCTB-ACTION-EXIT.
EXIT.
/
**************************************************************************
DISPLAY-ALL-RECORDS SECTION.
*
DISPLAY '-------------------------------------------'
* Attention !! Table name is CaSe sensitive!!!!!!!!!!!!!
EXEC SQL
DECLARE ALLROWS CURSOR FOR
SELECT FIELD1, FIELD2, FIELD3
INTO :FIELD1 :FIELD2 :FIELD3
FROM example_table
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
*
EXEC SQL
OPEN ALLROWS
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN DB-NOT-FOUND
CONTINUE
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
' FIELD3=' FIELD3
PERFORM UNTIL NOT DB-OK
EXEC SQL
FETCH ALLROWS
INTO :FIELD1 :FIELD2 :FIELD3
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
DISPLAY 'FIELD1=' FIELD1 ' FIELD2=' FIELD2
' FIELD3=' FIELD3
WHEN DB-NOT-FOUND
MOVE SPACE TO FIELD1
MOVE SPACE TO FIELD2
MOVE SPACE TO FIELD3
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
END-PERFORM
SET DB-OK TO TRUE
DISPLAY '-------------------------------------------'
*
EXEC SQL
CLOSE ALLROWS
END-EXEC.
EVALUATE TRUE
WHEN DB-OK
CONTINUE
WHEN OTHER
PERFORM DB-STATUS
END-EVALUATE
.
DISPLAY-ALL-RECORDS-EXIT.
EXIT.