$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 [return].
* 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 [return]'.
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.
*