 |
 |
|
|
|||
 |
|||
Putting your COPYLIB on the Web
$CONTROL USLINIT
IDENTIFICATION DIVISION.
PROGRAM-ID. CL2HTML.
*
***********************************************
* This program will read a COBOL copylib file
* and generate a byte stream HTML file that is
* self indexed.
***********************************************
*
AUTHOR. Shawn M. Gordon.
INSTALLATION. SMGA.
DATE-WRITTEN. TUE, NOV 23, 1999.
DATE-COMPILED.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. HP-3000.
OBJECT-COMPUTER. HP-3000.
SPECIAL-NAMES.
CONDITION-CODE IS CC.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INFILE ASSIGN TO DUMMY USING WS-COPYLIB.
SELECT TEMPFILE ASSIGN TO "ZMHF83,,,,1000000".
DATA DIVISION.
FILE SECTION.
FD INFILE
RECORD CONTAINS 86 CHARACTERS.
01 INFILE-RECORD.
03 IR-COBOL-CODE PIC X(72).
03 IR-COPY-NAME PIC X(08).
03 PIC X(06).
FD TEMPFILE
RECORD CONTAINS 100 CHARACTERS.
01 TEMPFILE-RECORD PIC X(100).
WORKING-STORAGE SECTION.
01 S1 PIC S9(4) COMP VALUE 0.
01 WS-COPYLIB PIC X(26) VALUE SPACES.
01 DEST-FILE PIC X(254) VALUE SPACES.
01 SAVE-NAME PIC X(08) VALUE SPACES.
01 ERR PIC S9(4) COMP VALUE 0.
01 ERR-LEN PIC S9(4) COMP VALUE 0.
01 ERR-MSG PIC X(78) VALUE SPACES.
01 DATE-BUFF PIC X(27) VALUE SPACES.
01 INDEX-TABLE.
03 IT-FORMAT-INDEX OCCURS 1000.
05 ITFI-ANCHOR PIC X(100).
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.
PROCEDURE DIVISION.
A1000-INIT.
DISPLAY 'Begin run of CL2HTML @ ' TIME-OF-DAY.
DISPLAY 'Enter COPYLIB file name to process: '
NO ADVANCING.
ACCEPT WS-COPYLIB FREE.
IF WS-COPYLIB = SPACES
DISPLAY 'Early termination of CL2HTML @ ' TIME-OF-DAY
STOP RUN.
DISPLAY 'Enter output file name: ' NO ADVANCING.
ACCEPT DEST-FILE FREE.
IF DEST-FILE = SPACES
DISPLAY 'Early termination of CL2HTML @ ' TIME-OF-DAY
STOP RUN.
OPEN INPUT INFILE
OUTPUT TEMPFILE.
* 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).
* 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 ' HP-STATUS
STOP RUN.
* Create our standard html headers into our dump table.
* In the following section "[" and "]" substitute for "<" and ">"
* to display correctly in this article's Web display
CALL INTRINSIC 'DATELINE' USING DATE-BUFF.
MOVE SPACES TO INDEX-TABLE.
STRING "[HTML][HEAD][TITLE]" DELIMITED BY SIZE
WS-COPYLIB DELIMITED BY SPACES
"[/TITLE][/HEAD]" DELIMITED BY SIZE
INTO ITFI-ANCHOR(1).
STRING "[CENTER][H3]" DELIMITED BY SIZE
WS-COPYLIB DELIMITED BY SPACES
" Generated on " DATE-BUFF
"[/H3][/CENTER]" DELIMITED BY SIZE
INTO ITFI-ANCHOR(2).
STRING "[P][H4][CENTER]CL2HTML Copylib to HTML convertor, "
"copyright 1999, " DELIMITED BY SIZE
INTO ITFI-ANCHOR(3)
STRING "S.M.Gordon & Associates"
"[/CENTER][/H4][P][BR][UL]" DELIMITED BY SIZE
INTO ITFI-ANCHOR(4)
MOVE 4 TO S1.
MOVE "[PRE]" TO TEMPFILE-RECORD.
WRITE TEMPFILE-RECORD.
A1000-EXIT. EXIT.
A1100-READ.
READ INFILE
AT END
MOVE "[/PRE]" TO TEMPFILE-RECORD
WRITE TEMPFILE-RECORD
GO TO B1000-INDEX.
IF IR-COPY-NAME <> SAVE-NAME
MOVE IR-COPY-NAME TO SAVE-NAME
ADD 1 TO S1
* write the html anchor tag in the body of the document.
MOVE SPACES TO TEMPFILE-RECORD
STRING '[P][A NAME="' DELIMITED BY SIZE
IR-COPY-NAME DELIMITED BY SPACES
'"][/A][FONT SIZE="5"][B][CENTER]' DELIMITED BY SIZE
IR-COPY-NAME DELIMITED BY SPACES
'[/CENTER][/B][/FONT]' DELIMITED BY SIZE
INTO TEMPFILE-RECORD
WRITE TEMPFILE-RECORD
* Create the header html in our table for later dump to file.
STRING '[LI][A HREF="#' DELIMITED BY SIZE
IR-COPY-NAME DELIMITED BY SPACES
'"]' DELIMITED BY SIZE
IR-COPY-NAME DELIMITED BY SPACES
'[/A]' DELIMITED BY SIZE
INTO ITFI-ANCHOR(S1).
MOVE SPACES TO TEMPFILE-RECORD.
IF IR-COBOL-CODE(1:6) IS NUMERIC
STRING "[BR]" IR-COBOL-CODE(7:) DELIMITED BY SIZE
INTO TEMPFILE-RECORD
ELSE
STRING "[BR]" IR-COBOL-CODE DELIMITED BY SIZE
INTO TEMPFILE-RECORD.
WRITE TEMPFILE-RECORD.
GO TO A1100-READ.
A1100-EXIT. EXIT.
*
B1000-INDEX.
CLOSE TEMPFILE.
OPEN INPUT TEMPFILE.
ADD 1 TO S1.
MOVE "[/UL][PRE][BR]" TO ITFI-ANCHOR(S1).
PERFORM VARYING S1 FROM 1 BY 1 UNTIL ITFI-ANCHOR(S1) = SPACES
CALL INTRINSIC "FWRITE" USING HP-FNUM,
ITFI-ANCHOR(S1),
-80,
0
IF CC <> 0
CALL INTRINSIC 'FCHECK' USING HP-FNUM, ERR
CALL INTRINSIC 'FERRMSG' USING ERR, ERR-MSG, ERR-LEN
DISPLAY ERR-MSG
STOP RUN
END-IF
END-PERFORM.
B1000-READ.
READ TEMPFILE
AT END
GO TO C9000-EOJ.
CALL INTRINSIC "FWRITE" USING HP-FNUM,
TEMPFILE-RECORD,
-80,
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-READ.
B1000-EXIT. EXIT.
*
C9000-EOJ.
CLOSE INFILE
TEMPFILE.
CALL INTRINSIC "FCLOSE" USING HP-FNUM, %1, 0.
DISPLAY 'Normal termination of CL2HTML @ ' TIME-OF-DAY.
STOP RUN.
Copyright The 3000 NewsWire. All rights reserved.