products/sources/formale sprachen/Cobol/Test-Suite/SQL P image not shown  

Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: dataload.cob   Sprache: Cobol

      *  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)  ¤





Download des
Quellennavigators
Download des
sprechenden Kalenders

in der Quellcodebibliothek suchen




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.


Bot Zugriff