 |
HP COBOL
DBMS Database Programming Manual
8.2 Backing Up a Database
The PARTSBACK program in Example 8-2 unloads all PARTS database
records, independently of their pointers, into a series of sequential
data files. It is the first step in restructuring and reorganizing a
database. For example, after backing up the database, you can change
its contents. You can also create a new version of the database
including different keys or new set relationships.
The PARTS database consists of a NEW root file with a default extension
of .ROO describing the database instance and a series of .DBS storage
files containing the actual data records. PARTS is the schema relative
to the current position in CDD/Repository when the program is compiled.
In the DB statement, PARTS and NEW can be logical names. If PARTS is
not a logical name, HP COBOL appends PARTS to CDD$DEFAULT; for
example, CDD$DEFAULT.PARTS. If NEW is not a logical name, the DBCS
appends .ROO as the default file type; for example, NEW.ROO.
| Example 8-2 Backing Up a Database |
IDENTIFICATION DIVISION.
PROGRAM-ID. PARTSBACK.
*************************************************************
*
* This program unloads the PARTS database
*
*************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAKE-FILE
ASSIGN TO "DBM$PARTS:DBMMAKE.DAT".
SELECT BUY-FILE
ASSIGN TO "DBM$PARTS:DBMBUY.DAT".
SELECT VENDOR-FILE
ASSIGN TO "DBM$PARTS:DBMVENDOR.DAT".
SELECT EMPLOYEE-FILE
ASSIGN TO "DBM$PARTS:DBMEMPLOY.DAT".
SELECT COMPONENT-FILE
ASSIGN TO "DBM$PARTS:DBMCOMPON.DAT".
SELECT SUPPLY-FILE
ASSIGN TO "DBM$PARTS:DBMSUPPLY.DAT".
SELECT DIVISION-FILE
ASSIGN TO "DBM$PARTS:DBMSUPER.DAT".
SELECT RESP-FOR-FILE
ASSIGN TO "DBM$PARTS:DBMRESPON.DAT".
DATA DIVISION.
SUB-SCHEMA SECTION.
DB PARTSS1 WITHIN PARTS FOR NEW.
FILE SECTION.
FD MAKE-FILE
RECORD VARYING FROM 24 TO 80 CHARACTERS.
01 MAKE-PART-RECORD.
02 CONTROL-FIELD PIC X.
02 PART_ID PIC X(8).
02 PART_DESC PIC X(50).
02 PART_STATUS PIC X(1).
02 PART_PRICE PIC 9(6)V9(3).
02 PART_COST PIC 9(6)V9(3).
02 PART_SUPPORT PIC X(2).
01 MAKE-CLASS-RECORD.
02 CONTROL-FIELD PIC X.
02 CLASS_CODE PIC XX.
02 CLASS_DESC PIC X(20).
02 CLASS_STATUS PIC X.
FD BUY-FILE
RECORD VARYING FROM 24 TO 80 CHARACTERS.
01 BUY-PART-RECORD.
02 CONTROL-FIELD PIC X.
02 PART_ID PIC X(8).
02 PART_DESC PIC X(50).
02 PART_STATUS PIC X(1).
02 PART_PRICE PIC 9(6)V9(3).
02 PART_COST PIC 9(6)V9(3).
02 PART_SUPPORT PIC X(2).
01 BUY-CLASS-RECORD.
02 CONTROL-FIELD PIC X.
02 CLASS_CODE PIC XX.
02 CLASS_DESC PIC X(20).
02 CLASS_STATUS PIC X.
FD COMPONENT-FILE
LABEL RECORDS ARE STANDARD.
01 COMPONENT-RECORD.
02 COMP_SUB_PART PIC X(8).
02 COMP_OWNER_PART PIC X(8).
02 COMP_MEASURE PIC X.
02 COMP_QUANTITY PIC 9(5).
FD VENDOR-FILE
LABEL RECORDS ARE STANDARD.
01 VENDOR-RECORD.
02 VEND_ID PIC X(8).
02 VEND_NAME PIC X(40).
02 VEND_CONTACT PIC X(30).
02 VEND_ADDRESS OCCURS 3 TIMES PIC X(15).
02 VEND_PHONE PIC 9(10).
FD SUPPLY-FILE
RECORD VARYING FROM 37 TO 64 CHARACTERS.
01 SUPPLY-RECORD.
02 CONTROL-FIELD PIC X.
02 PART-ID PIC X(8).
02 VEND-NAME PIC X(40).
02 SUP_RATING PIC X.
02 SUP_TYPE PIC X(4).
02 SUP_LAG_TIME PIC X(10).
01 QUOTE-RECORD.
02 CONTROL-FIELD PIC X.
02 QUOTE_ID PIC X(7).
02 QUOTE_DATE PIC 9(6).
02 QUOTE_MIN_ORDER PIC X(5).
02 QUOTE_UNIT_PRIC PIC 9(6)V9(3).
02 QUOTE_QTY_PRICE PIC 9(6)V9(3).
FD EMPLOYEE-FILE
LABEL RECORDS ARE STANDARD.
01 EMPLOYEE-RECORD.
02 EMP_ID PIC 9(5).
02 EMP_NAME.
03 EMP_LAST_NAME PIC X(20).
03 EMP_FIRST_NAME PIC X(10).
02 EMP_PHONE PIC X(7).
02 EMP_LOC PIC X(5).
FD DIVISION-FILE
RECORD VARYING FROM 6 TO 26 CHARACTERS.
01 MANAGES-RECORD.
02 CONTROL-FIELD PIC X.
02 GROUP_NAME PIC X(20).
02 EMP_ID PIC 9(5).
01 CONSISTS-RECORD.
02 CONTROL-FIELD PIC X.
02 EMP_ID PIC 9(5).
FD RESP-FOR-FILE
LABEL RECORDS ARE STANDARD.
01 RESP-FOR-RECORD.
02 EMP_ID PIC 9(5).
02 PART_ID PIC X(8).
WORKING-STORAGE SECTION.
77 CLASS-COUNT PIC 999 VALUE IS 0.
77 PART-COUNT PIC 999 VALUE IS 0.
77 COMPONENT-COUNT PIC 999 VALUE IS 0.
77 VENDOR-COUNT PIC 999 VALUE IS 0.
77 SUPPLY-COUNT PIC 999 VALUE IS 0.
77 QUOTE-COUNT PIC 999 VALUE IS 0.
77 EMPLOYEE-COUNT PIC 999 VALUE IS 0.
PROCEDURE DIVISION.
DECLARATIVES.
100-DATABASE-EXCEPTIONS SECTION.
USE FOR DB-EXCEPTION ON OTHER.
100-PROCEDURE.
DISPLAY "DATABASE EXCEPTION CONDITION".
PERFORM 150-DISPLAY-MESSAGE.
150-DISPLAY-MESSAGE.
*
* DBM$SIGNAL displays diagnostic messages based on the
* status code in DB-CONDITION.
*
CALL "DBM$SIGNAL".
ROLLBACK.
STOP RUN.
END DECLARATIVES.
DB-PROCESSING SECTION.
INITIALIZATION-ROUT.
READY PROTECTED.
CONTROL-ROUT.
OPEN OUTPUT COMPONENT-FILE, SUPPLY-FILE.
OPEN OUTPUT MAKE-FILE.
PERFORM MAKE-UNLOAD THRU MAKE-UNLOAD-END.
CLOSE MAKE-FILE.
DISPLAY " ".
DISPLAY CLASS-COUNT, " CLASS records unloaded from MAKE".
DISPLAY PART-COUNT, " PART records unloaded from MAKE".
OPEN OUTPUT BUY-FILE.
MOVE 0 TO CLASS-COUNT.
MOVE 0 TO PART-COUNT.
PERFORM BUY-UNLOAD THRU BUY-UNLOAD-END.
CLOSE BUY-FILE, COMPONENT-FILE, SUPPLY-FILE.
DISPLAY " ".
DISPLAY CLASS-COUNT, " CLASS records unloaded from BUY".
DISPLAY PART-COUNT, " PART records unloaded from BUY".
DISPLAY " ".
DISPLAY SUPPLY-COUNT, " SUPPLY records unloaded".
DISPLAY QUOTE-COUNT, " QUOTE records unloaded".
DISPLAY COMPONENT-COUNT " COMPONENT records unloaded".
OPEN OUTPUT VENDOR-FILE.
PERFORM VENDOR-UNLOAD THRU VENDOR-UNLOAD-END.
CLOSE VENDOR-FILE.
DISPLAY " ".
DISPLAY VENDOR-COUNT, " VENDOR records unloaded".
OPEN OUTPUT EMPLOYEE-FILE, RESP-FOR-FILE, DIVISION-FILE.
PERFORM EMPLOYEE-UNLOAD THRU EMPLOYEE-UNLOAD-END.
CLOSE EMPLOYEE-FILE, RESP-FOR-FILE, DIVISION-FILE.
DISPLAY " ".
DISPLAY EMPLOYEE-COUNT, " EMPLOYEE records unloaded".
COMMIT.
STOP RUN.
MAKE-UNLOAD.
FETCH NEXT CATEGORY WITHIN MAKE
AT END GO TO MAKE-UNLOAD-END.
MOVE "C" TO CONTROL-FIELD OF MAKE-CLASS-RECORD.
MOVE CORR CATEGORY TO MAKE-CLASS-RECORD.
ADD 1 TO CLASS-COUNT.
WRITE MAKE-CLASS-RECORD.
MAKE-PART-LOOP.
FETCH NEXT PART WITHIN CLASS_PART RETAINING REALM
AT END GO TO MAKE-UNLOAD.
MOVE "P" TO CONTROL-FIELD OF MAKE-PART-RECORD.
MOVE CORR PART TO MAKE-PART-RECORD.
ADD 1 TO PART-COUNT.
WRITE MAKE-PART-RECORD.
PERFORM COMPONENT-SUPPLY-UNLOAD THRU
COMPONENT-SUPPLY-UNLOAD-END.
GO TO MAKE-PART-LOOP.
MAKE-UNLOAD-END.
EXIT.
BUY-UNLOAD.
FETCH NEXT CATEGORY WITHIN BUY
AT END GO TO BUY-UNLOAD-END.
MOVE "C" TO CONTROL-FIELD OF BUY-CLASS-RECORD.
MOVE CORR CATEGORY TO BUY-CLASS-RECORD.
ADD 1 TO CLASS-COUNT.
WRITE BUY-CLASS-RECORD.
BUY-PART-LOOP.
FETCH NEXT PART WITHIN CLASS_PART RETAINING REALM
AT END GO TO BUY-UNLOAD.
MOVE "P" TO CONTROL-FIELD OF BUY-PART-RECORD.
MOVE CORR PART TO BUY-PART-RECORD.
ADD 1 TO PART-COUNT.
WRITE BUY-PART-RECORD.
PERFORM COMPONENT-SUPPLY-UNLOAD THRU
COMPONENT-SUPPLY-UNLOAD-END.
GO TO BUY-PART-LOOP.
BUY-UNLOAD-END.
EXIT.
COMPONENT-SUPPLY-UNLOAD.
COMPONENT-UNLOAD.
FETCH NEXT COMPONENT WITHIN PART_USES RETAINING REALM
AT END GO TO SUPPLY-QUOTE-LOOP.
MOVE CORR COMPONENT TO COMPONENT-RECORD.
ADD 1 TO COMPONENT-COUNT.
WRITE COMPONENT-RECORD.
GO TO COMPONENT-UNLOAD.
SUPPLY-QUOTE-LOOP.
FETCH NEXT WITHIN PART_INFO RETAINING REALM
AT END GO TO COMPONENT-SUPPLY-UNLOAD-END.
IF DB-CURRENT-RECORD-NAME = "PR_QUOTE" THEN
MOVE CORR PR_QUOTE TO QUOTE-RECORD
MOVE "Q" TO CONTROL-FIELD OF QUOTE-RECORD
ADD 1 TO QUOTE-COUNT
WRITE QUOTE-RECORD
GO TO SUPPLY-QUOTE-LOOP
ELSE
MOVE CORR SUPPLY TO SUPPLY-RECORD
FETCH OWNER WITHIN VENDOR_SUPPLY
MOVE "S" TO CONTROL-FIELD OF SUPPLY-RECORD
MOVE VEND_NAME OF VENDOR TO VEND-NAME OF SUPPLY-RECORD
MOVE PART_ID OF PART TO PART-ID OF SUPPLY-RECORD
ADD 1 TO SUPPLY-COUNT
WRITE SUPPLY-RECORD
GO TO SUPPLY-QUOTE-LOOP.
COMPONENT-SUPPLY-UNLOAD-END.
EXIT.
VENDOR-UNLOAD.
FREE CURRENT WITHIN MARKET.
VENDOR-UNLOAD-LOOP.
FETCH NEXT VENDOR WITHIN MARKET
AT END GO TO VENDOR-UNLOAD-END.
ADD 1 TO VENDOR-COUNT.
MOVE VEND_ID OF VENDOR TO VEND_ID OF VENDOR-RECORD.
MOVE VEND_NAME OF VENDOR TO VEND_NAME OF VENDOR-RECORD.
MOVE VEND_CONTACT OF VENDOR TO VEND_CONTACT OF VENDOR-RECORD.
MOVE VEND_ADDRESS OF VENDOR (1) TO
VEND_ADDRESS OF VENDOR-RECORD (1).
MOVE VEND_ADDRESS OF VENDOR (2) TO
VEND_ADDRESS OF VENDOR-RECORD (2).
MOVE VEND_ADDRESS OF VENDOR (3) TO
VEND_ADDRESS OF VENDOR-RECORD (3).
MOVE VEND_PHONE OF VENDOR TO VEND_PHONE OF VENDOR-RECORD.
WRITE VENDOR-RECORD.
GO TO VENDOR-UNLOAD-LOOP.
VENDOR-UNLOAD-END.
EXIT.
EMPLOYEE-UNLOAD.
FETCH NEXT EMPLOYEE WITHIN ALL_EMPLOYEES
AT END GO TO EMPLOYEE-UNLOAD-END.
MOVE CORR EMPLOYEE TO EMPLOYEE-RECORD.
ADD 1 TO EMPLOYEE-COUNT.
WRITE EMPLOYEE-RECORD.
DIVISION-UNLOAD.
FETCH NEXT WITHIN MANAGES
AT END GO TO RESP-UNLOAD.
MOVE EMP_ID OF EMPLOYEE TO EMP_ID OF MANAGES-RECORD.
MOVE GROUP_NAME OF WK_GROUP TO GROUP_NAME OF MANAGES-RECORD.
MOVE "M" TO CONTROL-FIELD OF MANAGES-RECORD.
WRITE MANAGES-RECORD.
CONSISTS-UNLOAD.
FETCH NEXT WITHIN CONSISTS_OF RETAINING MANAGES ALL_EMPLOYEES
AT END GO TO DIVISION-UNLOAD.
MOVE "C" TO CONTROL-FIELD OF CONSISTS-RECORD.
MOVE EMP_ID OF EMPLOYEE TO EMP_ID OF CONSISTS-RECORD.
WRITE CONSISTS-RECORD.
GO TO CONSISTS-UNLOAD.
RESP-UNLOAD.
FETCH CURRENT WITHIN ALL_EMPLOYEES.
RESP-UNLOAD-LOOP.
FETCH NEXT WITHIN RESPONSIBLE_FOR
AT END GO TO EMPLOYEE-UNLOAD.
MOVE PART_ID OF PART TO PART_ID OF RESP-FOR-RECORD.
MOVE EMP_ID OF EMPLOYEE TO EMP_ID OF RESP-FOR-RECORD.
WRITE RESP-FOR-RECORD.
GO TO RESP-UNLOAD-LOOP.
EMPLOYEE-UNLOAD-END.
EXIT.
|
|
