* dataload.pco Portable data loader, Embedded Cobol version
* DWF 1/12/95
*
* This program is intended to conform to COBOL-85 and possibly later
* standards. I have omitted some customary Cobol-isms that are
* deprecated features.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. DATALOAD.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT REPTFT ASSIGN TO "REPTFT.DAT".
SELECT IMPLIC ASSIGN TO "IMPLIC.DAT".
SELECT TSTPRG ASSIGN TO "TSTPRG.DAT".
SELECT TSTCAS ASSIGN TO "TSTCAS.DAT".
SELECT TESTFT ASSIGN TO "TESTFT.DAT".
DATA DIVISION.
FILE SECTION.
FD REPTFT
DATA RECORD IS REPTFT-REC.
01 REPTFT-REC.
02 C11 PIC X(4).
02 PIC X.
02 C12 PIC X(30).
FD IMPLIC
DATA RECORD IS IMPLIC-REC.
01 IMPLIC-REC.
02 C21 PIC X(4).
02 PIC X.
02 C22 PIC X(4).
FD TSTPRG
DATA RECORD IS TSTPRG-REC.
01 TSTPRG-REC.
02 C31 PIC X(6).
02 PIC X.
02 C32 PIC X(18).
02 PIC X.
02 C33 PIC X(10).
FD TSTCAS
DATA RECORD IS TSTCAS-REC.
01 TSTCAS-REC.
02 C41 PIC X(4).
02 PIC X.
02 C42 PIC X(50).
02 PIC X.
02 C43 PIC X(6).
02 PIC X.
02 C44 PIC X(10).
02 PIC X.
02 C45 PIC 99.
FD TESTFT
DATA RECORD IS TESTFT-REC.
01 TESTFT-REC.
02 C51 PIC X(4).
02 PIC X.
02 C52 PIC X(4).
WORKING-STORAGE SECTION.
77 EOF PIC X.
EXEC SQL BEGIN DECLARE SECTION END-EXEC
77 UID PIC X(18).
77 UIDX PIC X(18).
77 COL11 PIC X(4).
77 COL12 PIC X(30).
77 COL21 PIC X(4).
77 COL22 PIC X(4).
77 COL31 PIC X(6).
77 COL32 PIC X(18).
77 COL33 PIC X(10).
77 COL33I PIC S9 BINARY.
77 COL41 PIC X(4).
77 COL42 PIC X(50).
77 COL43 PIC X(6).
77 COL44 PIC X(10).
77 COL44I PIC S9 BINARY.
77 COL45 PIC S99 BINARY.
77 COL51 PIC X(4).
77 COL52 PIC X(4).
77 SQLCODE PIC S9(9) USAGE COMP.
EXEC SQL END DECLARE SECTION END-EXEC
PROCEDURE DIVISION.
MAIN.
MOVE "HU " TO UID
PERFORM ATTACH-TO-DATABASE
PERFORM SAVEF
PERFORM DESTROY
PERFORM REPORTFEATURE
PERFORM IMPLICATION
PERFORM TESTPROG
PERFORM TESTCASE
PERFORM TESTFEATURE
PERFORM UNSAVEF
STOP RUN.
CHECKOK.
IF SQLCODE IS LESS THAN ZERO THEN
DISPLAY "SQLCODE is " SQLCODE
DISPLAY "SQL ERROR -- rolling back"
EXEC SQL ROLLBACK WORK END-EXEC
STOP RUN
END-IF.
ATTACH-TO-DATABASE.
CALL "AUTHID" USING UID
MOVE "not logged in, not" TO UIDX
EXEC SQL SELECT USER INTO :UIDX FROM ECCO END-EXEC
IF UID IS NOT EQUAL TO UIDX THEN
DISPLAY "ERROR: User " UID " expected."
DISPLAY "User " UIDX " connected."
STOP RUN
END-IF.
REPORTFEATURE.
DISPLAY "Loading reportfeature"
OPEN INPUT REPTFT
MOVE "F" TO EOF
PERFORM REPTFT-READ
PERFORM REPTFT-LOOP
UNTIL EOF IS EQUAL TO "T"
CLOSE REPTFT
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
REPTFT-READ.
MOVE SPACES TO C12
READ REPTFT
AT END MOVE "T" TO EOF
END-READ.
REPTFT-LOOP.
MOVE C11 TO COL11
MOVE C12 TO COL12
EXEC SQL INSERT INTO REPORTFEATURE
VALUES (:COL11, :COL12)
END-EXEC
PERFORM CHECKOK
PERFORM REPTFT-READ.
IMPLICATION.
DISPLAY "Loading implication"
OPEN INPUT IMPLIC
MOVE "F" TO EOF
PERFORM IMPLIC-READ
PERFORM IMPLIC-LOOP
UNTIL EOF IS EQUAL TO "T"
CLOSE IMPLIC
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
IMPLIC-READ.
MOVE SPACES TO C22
READ IMPLIC
AT END MOVE "T" TO EOF
END-READ.
IMPLIC-LOOP.
MOVE C21 TO COL21
MOVE C22 TO COL22
EXEC SQL INSERT INTO IMPLICATION
VALUES (:COL21, :COL22)
END-EXEC
PERFORM CHECKOK
PERFORM IMPLIC-READ.
TESTPROG.
DISPLAY "Loading testprog"
OPEN INPUT TSTPRG
MOVE "F" TO EOF
PERFORM TSTPRG-READ
PERFORM TSTPRG-LOOP
UNTIL EOF IS EQUAL TO "T"
CLOSE TSTPRG
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
TSTPRG-READ.
MOVE SPACES TO C33
READ TSTPRG
AT END MOVE "T" TO EOF
END-READ.
TSTPRG-LOOP.
MOVE C31 TO COL31
MOVE C32 TO COL32
MOVE C33 TO COL33
IF COL33 IS EQUAL TO "NULL " THEN
MOVE -1 TO COL33I
ELSE
MOVE ZERO TO COL33I
END-IF
EXEC SQL INSERT INTO TESTPROG
VALUES (:COL31, :COL32, :COL33:COL33I)
END-EXEC
PERFORM CHECKOK
PERFORM TSTPRG-READ.
TESTCASE.
DISPLAY "Loading testcase"
OPEN INPUT TSTCAS
MOVE "F" TO EOF
PERFORM TSTCAS-READ
PERFORM TSTCAS-LOOP
UNTIL EOF IS EQUAL TO "T"
CLOSE TSTCAS
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
TSTCAS-READ.
READ TSTCAS
AT END MOVE "T" TO EOF
END-READ.
TSTCAS-LOOP.
MOVE C41 TO COL41
MOVE C42 TO COL42
MOVE C43 TO COL43
MOVE C44 TO COL44
MOVE C45 TO COL45
IF COL44 IS EQUAL TO "NULL " THEN
MOVE -1 TO COL44I
ELSE
MOVE ZERO TO COL44I
END-IF
EXEC SQL INSERT INTO TESTCASE
VALUES (:COL41, :COL42, :COL43, :COL44:COL44I, :COL45)
END-EXEC
PERFORM CHECKOK
PERFORM TSTCAS-READ.
TESTFEATURE.
DISPLAY "Loading testfeature"
OPEN INPUT TESTFT
MOVE "F" TO EOF
PERFORM TESTFT-READ
PERFORM TESTFT-LOOP
UNTIL EOF IS EQUAL TO "T"
CLOSE TESTFT
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
TESTFT-READ.
MOVE SPACES TO C52
READ TESTFT
AT END MOVE "T" TO EOF
END-READ.
TESTFT-LOOP.
MOVE C51 TO COL51
MOVE C52 TO COL52
EXEC SQL INSERT INTO TESTFEATURE
VALUES (:COL51, :COL52)
END-EXEC
PERFORM CHECKOK
PERFORM TESTFT-READ.
SAVEF.
DISPLAY "Saving feature_claimed"
EXEC SQL DELETE FROM F_TEMP END-EXEC
PERFORM CHECKOK
EXEC SQL INSERT INTO F_TEMP
SELECT FEATURE1, 'AAAA', 'AAAA', 0
FROM FEATURE_CLAIMED
END-EXEC
PERFORM CHECKOK
EXEC SQL DELETE FROM FEATURE_CLAIMED END-EXEC
PERFORM CHECKOK
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
DESTROY.
DISPLAY "Clearing tables"
EXEC SQL DELETE FROM TESTFEATURE END-EXEC
PERFORM CHECKOK
EXEC SQL DELETE FROM TESTCASE END-EXEC
PERFORM CHECKOK
EXEC SQL DELETE FROM TESTPROG END-EXEC
PERFORM CHECKOK
EXEC SQL DELETE FROM IMPLICATION END-EXEC
PERFORM CHECKOK
EXEC SQL DELETE FROM REPORTFEATURE END-EXEC
PERFORM CHECKOK
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
UNSAVEF.
DISPLAY "Recovering feature_claimed"
EXEC SQL INSERT INTO FEATURE_CLAIMED
SELECT C1 FROM F_TEMP
END-EXEC
PERFORM CHECKOK
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK
EXEC SQL DELETE FROM F_TEMP END-EXEC
PERFORM CHECKOK
EXEC SQL COMMIT WORK END-EXEC
PERFORM CHECKOK.
¤ Dauer der Verarbeitung: 0.19 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|