COBOL TIPS #34
by
Shawn M. Gordon
President S.M.Gordon & Associates
Well I am back with some COBOL tips again, and I think I have enough for the next 3 or 4 months. I want to thank everyone for their suggestions and input.
Recently I wanted to write a program that converted fixed width, ASCII files into byte stream files. The reason for this, was that I am using Netware on the HP 3000 to basically maintain this network available disk bubble on the HP. This is kind of cool because you can programatically get files down to your network with just a COPY command basically, no FTP or emulator file transfers.
Since I needed to support the POSIX HFS name space, and byte stream files, I needed to use HPFOPEN for the output file. Since I wasn’t familiar with the syntax to this intrinsic from COBOL, I decided to turn to the HP-3000 listserver.
I got two very good answers, one from Rick Gilligan, and the other from Jeff Sargeant (thank you both). So the first thing we do is get source and destination file names. We support this in two fashions, they can either be entered interactively, or passed in the INFO string. So we use GETINFO to check for a value, then UNSTRING it into our two file names (make sure you only have one space between the two names).
We use the FLABELINFO instrinsic to get the record size of our source file to make sure our FREAD later uses the correct size. We also use FLABELINFO to make sure that the destination file doesn’t exist. Now I could get tricky and prompt till they get it right, or allow them to overwrite the existing file, but I am going to be user hostile and just abort.
Now an interesting thing about file names for HPFOPEN is that they have to have a delimiter at the beginning and end of the string. In COBOL it is pretty easy to determine the length of the data in a string by using the INSPECT statement, then using a few byte referenced MOVE’s to get the data into our variable correctly.
A nice thing about HPFOPEN, as opposed to FOPEN, is that each parameter is a seperate item, and doesn’t have to be calculated as a bit mask and converted to OCTAL. What is tricky is that the FNUM that is returned by HPFOPEN is 32 bits, but all the old file instrinsics use a 16 bit value. So we have to redefine the item so that we get the last 16 bits as a seperate item so it can be used for our FWRITE. I’ll let you look up all the fields for the parameters, it will be good for you to take a look at the intrinsics manual. Make sure it’s a current one, otherwise you won’t be able to find some of the items or values.
Now we have a very simple loop that reads, and then writes the data. I really should be scanning each line and removing the trailing blanks, by changing the record width on the write. It’s nice that the file system handles converting the single record write, to ‘n’ single bytes written to our new file. There are probably other things you may want to do with this as well. For example, this could be used to create a POSIX name space HTML file based on a data file in the MPE domain (of course you have to put the HTML in yourself). There are other possibilities as well.
So next month I think I may talk about auto sensing terminal emulators and initiating file transfers automatically.
$CONTROL USLINIT,BOUNDS
IDENTIFICATION DIVISION.
PROGRAM-ID. REC2BYTE.
AUTHOR. SHAWN GORDON.
INSTALLATION. S.M.GORDON & ASSOCIATES.
DATE-WRITTEN. MON, OCT 21, 1996.
DATE-COMPILED.
*
**************************************************
* This program converts standard MPE files to byte stream files
* It is relativly unforgiving, it wants a fixed ASCII file as
* input.
* Shawn M. Gordon.
**************************************************
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. HP-3000.
OBJECT-COMPUTER. HP-3000.
SPECIAL-NAMES.
CONDITION-CODE IS CC.
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
01 S1 PIC S9(4) COMP VALUE 0.
01 RW PIC S9(4) COMP VALUE 0.
01 GET-INFO.
03 GI-KEY PIC X(256) VALUE SPACES.
03 GI-LEN PIC S9(4) COMP VALUE 256.
03 GI-RESULT PIC S9(4) COMP VALUE 0.
*
01 FOPEN-PARMS.
03 FP-FNUM PIC S9(4) COMP VALUE 0.
03 ERR PIC S9(4) COMP VALUE 0.
03 ERR-LEN PIC S9(4) COMP VALUE 0.
03 ERR-MSG PIC X(78) VALUE SPACES.
03 READ-BUFF PIC X(256) VALUE SPACES.
*
01 HPFOPEN-PARMS.
03 HP-CONST-0 PIC S9(9) COMP SYNC VALUE 0.
03 HP-CONST-1 PIC S9(9) COMP SYNC VALUE 1.
03 HP-CONST-2 PIC S9(9) COMP SYNC VALUE 2.
03 HP-CONST-4 PIC S9(9) COMP SYNC VALUE 4.
03 HP-CONST-9 PIC S9(9) COMP SYNC VALUE 9.
03 HP-FILE-NAME PIC X(256) VALUE SPACES.
03 HP-FNUM-D PIC S9(9) COMP SYNC.
03 HP-FNUM-D-REDEF REDEFINES HP-FNUM-D.
05 PIC X(02).
05 HP-FNUM PIC S9(4) COMP.
03 HP-STATUS PIC S9(9) COMP SYNC.
01 ITEMNUM.
03 PIC S9(4) COMP VALUE 14.
03 PIC S9(4) COMP VALUE 0.
*
01 ITEMS.
03 RECSIZE PIC S9(4) COMP VALUE 0.
01 ITEMERR.
03 IE1 PIC S9(4) COMP VALUE 0.
01 SOURCE-FILE PIC X(26) VALUE SPACES.
01 DEST-FILE PIC X(254) VALUE SPACES.
*
PROCEDURE DIVISION.
*
A1000-INIT.
DISPLAY 'Fixed Record to Byte Stream file converter'.
DISPLAY SPACES.
CALL INTRINSIC "GETINFO" USING GI-KEY, GI-LEN, \\
GIVING GI-RESULT.
IF GI-KEY <> SPACES
UNSTRING GI-KEY DELIMITED BY SPACES INTO
SOURCE-FILE DEST-FILE
GO TO A1000-TAG.
DISPLAY 'Enter source file name: ' NO ADVANCING.
ACCEPT SOURCE-FILE FREE.
IF SOURCE-FILE = SPACES
STOP RUN.
DISPLAY SPACES.
DISPLAY 'Enter destination file name: ' NO ADVANCING.
ACCEPT DEST-FILE FREE.
IF DEST-FILE = SPACES
STOP RUN.
A1000-TAG.
* get the record width of input file for subsequent FOPEN
CALL INTRINSIC 'FLABELINFO' USING SOURCE-FILE, 2, ERR,
ITEMNUM, ITEMS, ITEMERR.
IF CC < 0
DISPLAY 'Flabelinfo Failed ' IE1
STOP RUN.
* get a positive byte count for our record buffer.
COMPUTE RW = RECSIZE * -1.
* Make sure the destination file doesn't exist
CALL INTRINSIC 'FLABELINFO' USING DEST-FILE, 2, ERR,
ITEMNUM, ITEMS, ITEMERR.
IF CC = 0
DISPLAY 'Destination file exists'
STOP RUN.
* Need to have a delimiter at beginning and end of file name
INSPECT DEST-FILE TALLYING S1 FOR CHARACTERS BEFORE ' '.
MOVE '%' TO HP-FILE-NAME(1:1).
MOVE DEST-FILE(1:S1) TO HP-FILE-NAME(2:).
MOVE '%' TO HP-FILE-NAME(S1 + 2:1).
* Use a standard FOPEN on source file name.
CALL INTRINSIC "FOPEN" USING SOURCE-FILE, %2005, %304
GIVING FP-FNUM.
IF CC <> 0
DISPLAY SOURCE-FILE
CALL INTRINSIC 'FCHECK' USING FP-FNUM, ERR
CALL INTRINSIC 'FERRMSG' USING ERR, ERR-MSG, ERR-LEN
DISPLAY ERR-MSG
STOP RUN.
* Now use HPFOPEN on the destination file.
CALL INTRINSIC "HPFOPEN" USING HP-FNUM-D,
HP-STATUS,
2, HP-FILE-NAME,
3, HP-CONST-4,
5, HP-CONST-0,
6, HP-CONST-9,
7, HP-CONST-0,
11, HP-CONST-1,
13, HP-CONST-1,
19, HP-CONST-1,
41, HP-CONST-2,
50, HP-CONST-1,
53, HP-CONST-1,
0.
IF HP-STATUS <> 0
DISPLAY 'Error in HPFOPEN'
STOP RUN.
*
B1000-COPY.
CALL INTRINSIC "FREAD" USING FP-FNUM,
READ-BUFF(1:RW),
RECSIZE.
IF CC > 0
GO TO C9000-EOJ.
IF CC < 0
CALL INTRINSIC 'FCHECK' USING FP-FNUM, ERR
CALL INTRINSIC 'FERRMSG' USING ERR, ERR-MSG, ERR-LEN
DISPLAY ERR-MSG
GO TO C9000-EOJ.
CALL INTRINSIC "FWRITE" USING HP-FNUM,
READ-BUFF(1:RW),
RECSIZE,
0.
IF CC <> 0
CALL INTRINSIC 'FCHECK' USING HP-FNUM, ERR
CALL INTRINSIC 'FERRMSG' USING ERR, ERR-MSG, ERR-LEN
DISPLAY ERR-MSG
GO TO C9000-EOJ.
GO TO B1000-COPY.
B1000-EXIT. EXIT.
*
C9000-EOJ.
MOVE 0 TO RW.
INSPECT SOURCE-FILE TALLYING RW FOR CHARACTERS BEFORE ' '.
DISPLAY 'Copied ' SOURCE-FILE(1:RW) ' to ' DEST-FILE(1:S1).
CALL INTRINSIC "FCLOSE" USING FP-FNUM, 0, 0.
CALL INTRINSIC "FCLOSE" USING HP-FNUM, %1, 0.
STOP RUN.
RUN REC2BYTE.PROGNM;INFO="OLDFILE /usr/netware/sys/NEWFILE.TXT"
Fixed Record to Byte Stream file converter
Copied OLDFILE to /usr/netware/sys/NEWFILE.TXT