Inside COBOL #84 (Scanning Speedware with COBOL)
by
Shawn Gordon
President
The Kompany
In continuing my theme from last month, I’ve decided to share another little gem that makes COBOL useful for Speedware programmers. This was part of our Y2K research at one point in time and I evolved it into a more generic facility for searching Speedware spec files. Unlike Powerhouse, Speedware keeps an entire system in a single file that gets pseudo-compiled, so you will have screens, reports, logic sections, menus, jobs, everything in this single file. Some people find this daunting, but believe me, it has a lot of advantages. We were able to modify thousands of programs after updating a key field from an I2 to a Z10 in the database, in an afternoon and then roll the recompiled spec files into production over the weekend. In a conventional shop this would have been overwhelming.
The attached program will allow you to enter up to 10 files to scan and 10 search strings to scan for. The value of 10 is arbitrary, you can make it whatever you want. I’m embarrassed to say that the value of 10 is hard coded and not in a variable, which makes it a good exercise for you. The idea is a little more sophisticated than just finding a string in a file, we want to know the program name that the string is part of, this means that when we find our string, we have to back up in our reads until we find the program name.
This isn’t a long or overly complex program but it does make use of a number of interesting items that may not be familiar. We are using the FREADDIR intrinsic so that we can do absolute jumps around in the file to get the information we want, this of course means that we have to FOPEN the file for access. We are also using a couple of macros, as you can see I still wasn’t out of the habit of using my UPSHIFT macro instead of using the MOVE FUNCTION UPPER-CASE(VAR) TO VAR. Feature of the ‘89 addendum to COBOL. The other macro is just an example of making life easier when you are writing your code.
Take note of the call to FLABELINFO. While this is a rather inellegant and general purpose abort, the objective to this is to see if the file actually exists. FLABELINFO is a great intrinsic as you can get a good amount of information, including the first file label, without having to go through the overhead of FOPEN. So checking if the file exists becomes very simple, and then if it exists, we also grabbed some important pieces of information we will need for working with the file such as the record width and number of records.
Now this has been an example of using Speedware as a target with fixed delimiters for the program names. I could envision it being used as an XML scanning tool as well, then you could just use the meta data tags as the section delimiters for example. I’m sure you can come up with some interesting ideas as well.
$CONTROL USLINIT,SOURCE,BOUNDS IDENTIFICATION DIVISION. PROGRAM-ID. SPECSCAN. AUTHOR. SHAWN M.GORDON. DATE-WRITTEN. 03/19/97. DATE-COMPILED. *************************************************** * This program is primarily designed to scan through * spec files to search for a string, then backtrack * to find the program it is in. I makes some assumptions, * basically that the program will end with a colon followed * by at least 10 spaces. You first enter a file to scan, * then enter search parms, one per line, when you are done * just press. * Shawn M. Gordon *************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. HP-3000 WITH DEBUGGING MODE. OBJECT-COMPUTER. HP-3000. SPECIAL-NAMES. TOP IS NEW-PAGE CONDITION-CODE IS CC. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TEMPFILE ASSIGN TO "TEMPFILE". SELECT SPECSCAN ASSIGN TO "SPECSCAN,,,LP(CCTL)". SELECT SFILE ASSIGN TO "SFILE". DATA DIVISION. FILE SECTION. FD TEMPFILE DATA RECORD IS TEMPFILE-REC. 01 TEMPFILE-REC. 03 TR-SPEC PIC X(28). 03 TR-PROGRAM PIC X(60). 03 TR-REC PIC 9(06). 03 TR-RECORD PIC X(128). * FD SPECSCAN DATA RECORD IS PRINT-LINE. 01 PRINT-LINE PIC X(80). * SD SFILE RECORD CONTAINS 222 CHARACTERS. 01 SORT-LINE. 03 SKEY1 PIC X(28). 03 SKEY2 PIC X(60). 03 SKEY3 PIC 9(06). 03 PIC X(128). * WORKING-STORAGE SECTION. * 01 S1 PIC S9(4) COMP VALUE 0. 01 S2 PIC S9(4) COMP VALUE 0. 01 S3 PIC S9(4) COMP VALUE 0. 01 LINE-COUNT PIC 9(03) VALUE 99. 01 PAGE-COUNT PIC 9(02) VALUE ZEROES. 01 EDIT-PAGE PIC Z9. 01 EDIT-RECS PIC ZZZZZ9. 01 EDIT-IDX PIC 99. 01 EDIT-HITS PIC ZZ9. 01 GET-OUT PIC X VALUE SPACES. 01 IS-COMMENT PIC X VALUE SPACES. 01 SAVE-SPEC PIC X(28) VALUE SPACES. 01 SAVE-PROGRAM PIC X(60) VALUE SPACES. 01 SAVE-PRINT PIC X(80) VALUE SPACES. 01 PROG-NAME PIC X(08) VALUE "SPWXREF". * 01 FOPEN-STUFF. 03 FNUM PIC S9(04) COMP VALUE 0. 03 ERR PIC S9(04) COMP VALUE 0. 03 ERR-LEN PIC S9(04) COMP VALUE 78. 03 REC-NO PIC S9(09) COMP VALUE 0. 03 SAVE-RECNO PIC S9(09) COMP VALUE 0. 03 READ-BUFF PIC X(128) VALUE SPACES. 03 OUT-BUFF PIC X(78) VALUE SPACES. * 01 SEARCH-PARMS. 03 SP-IDX PIC S9(4) COMP VALUE 0. 03 FN-IDX PIC S9(4) COMP VALUE 0. 03 SP-RECORDS PIC X(360) VALUE SPACES. 03 SP-REC-REDEF REDEFINES SP-RECORDS OCCURS 10. 05 FILE-NAME PIC X(28). 05 SP-RW PIC S9(4) COMP. 05 SP-EOF PIC S9(9) COMP. 05 SP-HITS PIC S9(4) COMP. 03 SP-SEARCH PIC X(15000) VALUE SPACES. 03 SP-SEARCH-REDEF REDEFINES SP-SEARCH OCCURS 500. 05 SP-KEY PIC X(30). 01 ITEMNUM. 05 PIC S9(4) COMP VALUE 14. 05 PIC S9(4) COMP VALUE 19. 05 PIC S9(4) COMP VALUE 0. * 01 ITEM. 03 REC-WIDTH PIC S9(4) COMP VALUE 0. 03 EOF PIC S9(9) COMP VALUE 0. * 01 ITEMERR. 03 IE-ARRAY PIC S9(4) COMP OCCURS 2 TIMES. * ********************************** * PROCEDURE DIVISION. $INCLUDE DEBUG.I * SPECSCAN-SECT01 SECTION 1. * A0000-MACROS. $DEFINE %UPSHIFT= INSPECT !1 CONVERTING 'abcdefghijklmnopqrstuvwxyz' to 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'# * $DEFINE %WRITE= ADD !1 TO LINE-COUNT IF LINE-COUNT > 55 ADD 1 TO PAGE-COUNT MOVE 2 TO LINE-COUNT MOVE PAGE-COUNT TO EDIT-PAGE MOVE PRINT-LINE TO SAVE-PRINT MOVE SPACES TO PRINT-LINE MOVE CURRENT-DATE TO PRINT-LINE(1:8) MOVE "Page:" TO PRINT-LINE(70:5) MOVE EDIT-PAGE TO PRINT-LINE(76:2) MOVE "Speedware Spec Scanner" TO PRINT-LINE(29:22) WRITE PRINT-LINE AFTER ADVANCING NEW-PAGE MOVE SPACES TO PRINT-LINE WRITE PRINT-LINE AFTER ADVANCING 1 LINE MOVE SAVE-PRINT TO PRINT-LINE END-IF WRITE PRINT-LINE AFTER ADVANCING !1 LINES# * A1000-INIT. CALL "MYPRIV" USING PROG-NAME. DISPLAY 'SPECSCAN Version 11.70915 ' '(S.M.Gordon & Associates (C) 1997)'. DISPLAY SPACES. DISPLAY 'You can enter up to 10 files to scan, ' 'when you want to start '. DISPLAY 'entering search strings, press '. DISPLAY SPACES. MOVE ZEROES TO FN-IDX. OPEN OUTPUT TEMPFILE. A1000-EXIT. A1050-FILE. ADD 1 TO FN-IDX. IF FN-IDX > 10 GO TO A1100-STRING. MOVE FN-IDX TO EDIT-IDX. MOVE ZEROES TO SP-HITS(FN-IDX). DISPLAY 'Scan SPEC file (' EDIT-IDX '): '. MOVE SPACES TO FILE-NAME(FN-IDX). ACCEPT FILE-NAME(FN-IDX). %UPSHIFT(FILE-NAME(FN-IDX)#). IF FILE-NAME(FN-IDX) = "EXIT" STOP RUN. IF FILE-NAME(FN-IDX) = SPACES IF FN-IDX = 1 DISPLAY 'SPEC file name cannot be blank' STOP RUN ELSE GO TO A1100-STRING. CALL INTRINSIC 'FLABELINFO' USING FILE-NAME(FN-IDX), 2, ERR, ITEMNUM, ITEM, ITEMERR. IF (ERR <> 0) AND (ERR <> -1) DISPLAY 'Error in ' FILE-NAME(FN-IDX) ' for FLABELINFO' DISPLAY 'Aborting....' STOP RUN. MOVE REC-WIDTH TO SP-RW(FN-IDX). MOVE EOF TO SP-EOF(FN-IDX). GO TO A1050-FILE. A1050-EXIT. EXIT. * A1100-STRING. DISPLAY SPACES. DISPLAY 'Enter up to 10 search strings (no spaces), ' 'when you want to start'. DISPLAY 'the search press .'. DISPLAY SPACES. A1100-PROMPT. ADD 1 TO SP-IDX. MOVE SP-IDX TO EDIT-IDX. DISPLAY 'Enter search string (' EDIT-IDX '): '. MOVE SPACES TO SP-KEY(SP-IDX) ACCEPT SP-KEY(SP-IDX). %UPSHIFT(SP-KEY(SP-IDX)#). IF SP-KEY(SP-IDX) = SPACES IF SP-IDX = 1 DISPLAY 'No search parameters entered, aborting...' STOP RUN ELSE GO TO B1000-SEARCH. GO TO A1100-PROMPT. A1100-EXIT. EXIT. * ************************* * B1000-SEARCH. MOVE ZEROES TO FN-IDX. B1000-LOOP. ADD 1 TO FN-IDX. IF FILE-NAME(FN-IDX) = SPACES GO TO C1000-REPORT. CALL INTRINSIC "FOPEN" USING FILE-NAME(FN-IDX), %2005, %2300, SP-RW(FN-IDX) GIVING FNUM. IF CC <> 0 DISPLAY 'Failure in FOPEN of ' FILE-NAME(FN-IDX) CALL INTRINSIC 'FCHECK' USING FNUM, ERR CALL INTRINSIC 'FERRMSG' USING ERR, OUT-BUFF, ERR-LEN DISPLAY OUT-BUFF STOP RUN. DISPLAY '.....Search : ' FILE-NAME(FN-IDX). MOVE SP-EOF(FN-IDX) TO EDIT-RECS. DISPLAY '.....Num Recs: ' EDIT-RECS. PERFORM VARYING SP-IDX FROM 1 BY 1 UNTIL SP-KEY(SP-IDX) = SPACES MOVE SP-IDX TO EDIT-IDX DISPLAY '.....Parm(' EDIT-IDX '): ' SP-KEY(SP-IDX) END-PERFORM. DISPLAY SPACES. MOVE ZEROES TO SP-IDX. MOVE -1 TO REC-NO. PERFORM B2000-PRINT THRU B2000-EXIT. CALL INTRINSIC 'FCLOSE' USING FNUM, 0, 0. GO TO B1000-LOOP. B1000-EXIT. EXIT. * B2000-PRINT. ADD 1 TO REC-NO. IF REC-NO >= SP-EOF(FN-IDX) GO TO B2000-EXIT. MOVE SPACES TO READ-BUFF. CALL INTRINSIC "FREADDIR" USING FNUM, READ-BUFF, SP-RW(FN-IDX), REC-NO. IF CC > 0 GO TO B2000-EXIT. IF CC < 0 CALL INTRINSIC "FCHECK" USING FNUM, ERR DISPLAY "FREADDIR FAILED - FSERR " ERR CALL INTRINSIC "FERRMSG" USING ERR, OUT-BUFF, ERR-LEN DISPLAY OUT-BUFF CALL INTRINSIC "PRINTFILEINFO" USING FNUM GO TO B2000-EXIT. IF READ-BUFF(1:5) = "#NOTE" MOVE 'Y' TO IS-COMMENT. IF READ-BUFF(1:8) = "#ENDNOTE" MOVE 'N' TO IS-COMMENT. MOVE ZEROES TO S1 S2 INSPECT READ-BUFF TALLYING S1 FOR ALL " USING " S2 FOR ALL ":". IF (READ-BUFF(1:6) = "LOGIC-" OR READ-BUFF(1:5) = "TEXT-" OR READ-BUFF(1:5) = "MENU-" OR READ-BUFF(1:7) = "SCREEN-" OR READ-BUFF(1:7) = "REPORT-" OR READ-BUFF(1:9) = "DOCUMENT-" OR READ-BUFF(1:7) = "GLOBAL-" OR READ-BUFF(1:8) = "INCLUDE-") AND (S1 = 0) AND (S2 > 0) MOVE SPACES TO TEMPFILE-REC MOVE READ-BUFF TO TR-PROGRAM GO TO B2000-PRINT. PERFORM VARYING SP-IDX FROM 1 BY 1 UNTIL SP-KEY(SP-IDX) = SPACES MOVE 0 TO S1 S2 PERFORM VARYING S1 FROM 29 BY -1 UNTIL S1 = 1 OR SP-KEY(SP-IDX)(S1:1) <> ' ' CONTINUE END-PERFORM INSPECT READ-BUFF TALLYING S2 FOR ALL SP-KEY(SP-IDX)(1:S1) IF S2 > 0 * We found our string, now scan to find the program name, then pri * the line number and line that we found afterward MOVE SPACES TO TR-RECORD MOVE FILE-NAME(FN-IDX) TO TR-SPEC IF IS-COMMENT = 'Y' STRING "*" READ-BUFF(1:127) DELIMITED BY SIZE INTO TR-RECORD ELSE MOVE READ-BUFF TO TR-RECORD END-IF ADD 1 TO SP-HITS(FN-IDX) ADD 1 TO REC-NO GIVING TR-REC WRITE TEMPFILE-REC END-IF END-PERFORM. GO TO B2000-PRINT. B2000-EXIT. EXIT. * B3000-FIND. SUBTRACT 1 FROM REC-NO. IF REC-NO = 0 GO TO B3000-EXIT. CALL INTRINSIC "FREADDIR" USING FNUM, READ-BUFF, SP-RW(FN-IDX), REC-NO IF CC <> 0 CALL INTRINSIC "FCHECK" USING FNUM, ERR DISPLAY "FREADDIR FAILED - FSERR " ERR CALL INTRINSIC "FERRMSG" USING ERR, OUT-BUFF, ERR-LEN DISPLAY OUT-BUFF CALL INTRINSIC "PRINTFILEINFO" USING FNUM GO TO B3000-EXIT. IF S1 > 0 OR S2 > 0 OR S3 > 0 GO TO B3000-EXIT. GO TO B3000-FIND. B3000-EXIT. EXIT. * C1000-REPORT. CLOSE TEMPFILE. SORT SFILE ON ASCENDING KEY SKEY1, SKEY3, SKEY2 USING TEMPFILE GIVING TEMPFILE. OPEN INPUT TEMPFILE OUTPUT SPECSCAN. C1000-READ. READ TEMPFILE AT END GO TO C1000-END. IF TR-SPEC <> SAVE-SPEC MOVE SPACES TO PRINT-LINE STRING "Scanning Specfile: " DELIMITED BY SIZE TR-SPEC DELIMITED BY SPACES INTO PRINT-LINE MOVE 99 TO LINE-COUNT %WRITE(1#) MOVE TR-SPEC TO SAVE-SPEC PERFORM VARYING SP-IDX FROM 1 BY 1 UNTIL SP-KEY(SP-IDX) = SPACES MOVE SP-IDX TO EDIT-IDX MOVE SPACES TO PRINT-LINE STRING '....String(' EDIT-IDX ') = ' SP-KEY(SP-IDX) DELIMITED BY SIZE INTO PRINT-LINE %WRITE(1#) END-PERFORM. IF TR-PROGRAM <> SAVE-PROGRAM MOVE TR-PROGRAM TO PRINT-LINE %WRITE(2#) MOVE TR-PROGRAM TO SAVE-PROGRAM. MOVE SPACES TO PRINT-LINE. MOVE TR-REC TO EDIT-RECS. IF TR-RECORD(1:1) = "*" STRING EDIT-RECS ":" TR-RECORD(1:70) DELIMITED BY SIZE INTO PRINT-LINE ELSE STRING EDIT-RECS ": " TR-RECORD(1:70) DELIMITED BY SIZE INTO PRINT-LINE. %WRITE(1#). GO TO C1000-READ. C1000-END. MOVE 'I searched the following spec files:' TO PRINT-LINE. MOVE 88 TO LINE-COUNT. %WRITE(1#). PERFORM VARYING FN-IDX FROM 1 BY 1 UNTIL FILE-NAME(FN-IDX) = SPACES MOVE SPACES TO PRINT-LINE MOVE FN-IDX TO EDIT-IDX MOVE SP-EOF(FN-IDX) TO EDIT-RECS MOVE SP-HITS(FN-IDX) TO EDIT-HITS STRING '(' EDIT-IDX ') = ' FILE-NAME(FN-IDX) ' with ' EDIT-RECS ' records' * EDIT-HITS ' matches' DELIMITED BY SIZE INTO PRINT-LINE %WRITE(1#) END-PERFORM. MOVE 'For the following strings:' TO PRINT-LINE. %WRITE(2#). PERFORM VARYING SP-IDX FROM 1 BY 1 UNTIL SP-KEY(SP-IDX) = SPACES MOVE SPACES TO PRINT-LINE MOVE SP-IDX TO EDIT-IDX STRING '(' EDIT-IDX ') = ' SP-KEY(SP-IDX) DELIMITED BY SIZE INTO PRINT-LINE %WRITE(1#) END-PERFORM. MOVE SPACES TO PRINT-LINE. STRING "An * at the beginning of a line denotes that " "code is part of a #NOTE" DELIMITED BY SIZE INTO PRINT-LINE. %WRITE(3#). MOVE "Another fine product from S.M.Gordon & Assoc." TO PRINT-LINE. %WRITE(1#). CLOSE TEMPFILE. CLOSE SPECSCAN. GO TO C9000-EOJ. C1000-EXIT. EXIT. * C9000-EOJ. DISPLAY SPACES. DISPLAY 'Normal termination of SPECSCAN @ ' TIME-OF-DAY. STOP RUN. *