==============
CL Source Code
==============
/******************************************************************************/
/* OBJECT NAME....: CVTSPLHTMC */
/* DESCRIPTION....: Convert spooled file to HTML. */
/* RELEASE........: V4R2 */
/* COMPILE NOTES..: 1) Execute the following prior to compile: */
/* CRTPF FILE(QTEMP/CVTSPLHTMZ) RCDLEN(133) + */
/* MBR(*FILE) OPTION(*NOSOURCE) SIZE(*NOMAX) */
/* DATE WRITTEN...: 02/08/2001 */
/* AUTHOR.........: Eric Nepsund */
/******************************************************************************/
PGM PARM(&SPLFNAME &DESTFIL &DESTFLR &PMQUALJOB +
&SPLNBR)
/* Input variables */
DCL VAR(&SPLFNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&DESTFIL) TYPE(*CHAR) LEN(8)
DCL VAR(&DESTFLR) TYPE(*CHAR) LEN(80)
DCL VAR(&PMQUALJOB) TYPE(*CHAR) LEN(26)
DCL VAR(&SPLNBR) TYPE(*DEC) LEN(4)
/* Input variables (Qualified names) */
DCL VAR(&PMJBNM) TYPE(*CHAR) LEN(10)
DCL VAR(&PMUSNM) TYPE(*CHAR) LEN(10)
DCL VAR(&PMJBNO) TYPE(*CHAR) LEN(6)
/* Program variables */
DCL VAR(&PAGLEN) TYPE(*CHAR) LEN(3)
DCL VAR(&SPLNBRA) TYPE(*CHAR) LEN(4)
DCL VAR(&DESTFIL1) TYPE(*CHAR) LEN(12)
/* Program variables for default spool file number & page length */
DCL VAR(&PAGLENOVR) TYPE(*CHAR) LEN(3)
DCL VAR(&SPLNBROVR) TYPE(*CHAR) LEN(4)
DCL VAR(&SPLNMBGET) TYPE(*CHAR) LEN(5)
DCL VAR(&SPLRECTYP) TYPE(*CHAR) LEN(21)
/* Program variables for creating folder(s) to store HTML documents */
DCL VAR(&NWFLRFRM) TYPE(*DEC) LEN(3) VALUE(001)
DCL VAR(&NWFLRTO) TYPE(*DEC) LEN(3) VALUE(000)
DCL VAR(&NWFLRLEN) TYPE(*DEC) LEN(3) VALUE(000)
DCL VAR(&INFLRLEN) TYPE(*DEC) LEN(3) VALUE(1)
DCL VAR(&INFLR) TYPE(*CHAR) LEN(63)
DCL VAR(&NWFLR) TYPE(*CHAR) LEN(12)
DCL VAR(&FLRCNT) TYPE(*DEC) LEN(3) VALUE(000)
DCL VAR(&SCNSTR) TYPE(*CHAR) LEN(80)
DCL VAR(&SCNSTRLEN) TYPE(*DEC) LEN(3) VALUE(80)
DCL VAR(&SCNBEGPOS) TYPE(*DEC) LEN(3)
DCL VAR(&SCNPAT) TYPE(*CHAR) LEN(1)
DCL VAR(&SCNPATLEN) TYPE(*DEC) LEN(3)
DCL VAR(&SCNXLT) TYPE(*CHAR) LEN(1) VALUE('1')
DCL VAR(&SCNTRM) TYPE(*CHAR) LEN(1) VALUE('1')
DCL VAR(&SCNWLDCRD) TYPE(*CHAR) LEN(1) VALUE(' ')
DCL VAR(&SCNRTNVAL) TYPE(*DEC) LEN(3)
/* Standard variables. */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100)
DCL VAR(&MSGERR) TYPE(*LGL) LEN(1) VALUE('0')
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
/* Files */
DCLF FILE(CVTSPLHTMZ)
/******************************************************************************/
/* Standard logic */
/******************************************************************************/
/* Global message monitor. */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(MSGSTART))
/* Global message monitor. */
CHGVAR VAR(&PMJBNM) VALUE(%SST(&PMQUALJOB 1 10))
CHGVAR VAR(&PMUSNM) VALUE(%SST(&PMQUALJOB 11 10))
CHGVAR VAR(&PMJBNO) VALUE(%SST(&PMQUALJOB 21 6))
/******************************************************************************/
/* Main logic. */
/******************************************************************************/
/* Delete temporary files, if they exist */
DLTF FILE(QTEMP/CVTSPLHTMX)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/CVTSPLHTMY)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/CVTSPLHTMZ)
MONMSG MSGID(CPF0000)
/* Retrieve job defaults. */
IF COND(&PMQUALJOB *EQ '*') THEN(DO)
RTVJOBA JOB(&PMJBNM) USER(&PMUSNM) NBR(&PMJBNO)
ENDDO
/* Set defaults for page length & spooled file number */
CHGVAR VAR(&PAGLEN) VALUE('068') /* Default */
CHGVAR VAR(&SPLNBRA) VALUE(&SPLNBR)
/* Retrieve default spooled file number for *LAST & *FIRST special */
/* values, and also the actual page length of the spooled file. */
CHGVAR VAR(&PAGLENOVR) VALUE(' ')
CHGVAR VAR(&SPLNBROVR) VALUE(' ')
CHGVAR VAR(&SPLNMBGET) VALUE(' ')
IF COND(&SPLNBR *EQ -1) THEN(DO)
CHGVAR VAR(&SPLNMBGET) VALUE('*LAST')
ENDDO
IF COND(&SPLNBR *EQ 0) THEN(DO)
CHGVAR VAR(&SPLNMBGET) VALUE('*ONLY')
ENDDO
IF COND(&SPLNMBGET *EQ ' ') THEN(DO)
CHGVAR VAR(&SPLNMBGET) VALUE(&SPLNBR)
ENDDO
CRTPF FILE(QTEMP/CVTSPLHTMZ) RCDLEN(133) +
MBR(*FILE) OPTION(*NOSOURCE) SIZE(*NOMAX)
OVRPRTF FILE(QPRTSPLQ) PRTTXT(*BLANK) HOLD(*YES) +
USRDTA(@TEMP@)
WRKSPLFA FILE(&SPLFNAME) JOB(&PMJBNO/&PMUSNM/&PMJBNM) +
SPLNBR(&SPLNMBGET) OUTPUT(*PRINT)
DLTOVR FILE(QPRTSPLQ)
CPYSPLF FILE(QPDSPSFA) TOFILE(CVTSPLHTMZ) +
SPLNBR(*LAST) MBROPT(*REPLACE) +
CTLCHAR(*FCFC)
DLTSPLF FILE(QPDSPSFA) SPLNBR(*LAST)
READLP: RCVF RCDFMT(CVTSPLHTMZ)
MONMSG CPF0864 EXEC(GOTO READLPX)
/* Retrieve spooled file number */
CHGVAR VAR(&SPLRECTYP) VALUE(%SST(&CVTSPLHTMZ 46 21))
IF COND(&SPLRECTYP *EQ 'Number . . . . . . :') THEN(DO)
IF COND(&SPLNMBGET *EQ '*LAST' *OR +
&SPLNMBGET *EQ '*ONLY') THEN(DO)
CHGVAR VAR(&SPLNBROVR) VALUE(%SST(&CVTSPLHTMZ 72 4))
IF COND((%SST(&SPLNBROVR 4 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&SPLNBROVR) VALUE(%SST(&SPLNBROVR 1 4))
GOTO CMDLBL(READLP)
ENDDO
IF COND((%SST(&SPLNBROVR 3 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&SPLNBROVR) VALUE('0' *CAT %SST(&SPLNBROVR 1 3))
GOTO CMDLBL(READLP)
ENDDO
IF COND((%SST(&SPLNBROVR 2 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&SPLNBROVR) +
VALUE('00' *CAT %SST(&SPLNBROVR 1 2))
GOTO CMDLBL(READLP)
ENDDO
IF COND((%SST(&SPLNBROVR 1 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&SPLNBROVR) +
VALUE('000' *CAT %SST(&SPLNBROVR 1 1))
GOTO CMDLBL(READLP)
ENDDO
IF COND((%SST(&SPLNBROVR 1 4)) *EQ ' ') THEN(DO)
CHGVAR VAR(&SPLNBROVR) VALUE('0000')
GOTO CMDLBL(READLP)
ENDDO
ENDDO
ENDDO
/* Retrieve page length */
CHGVAR VAR(&SPLRECTYP) VALUE(%SST(&CVTSPLHTMZ 4 21))
IF COND(&SPLRECTYP *EQ ' Length . . . . . . .') THEN(DO)
CHGVAR VAR(&PAGLENOVR) VALUE(%SST(&CVTSPLHTMZ 48 3))
IF COND((%SST(&PAGLENOVR 3 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&PAGLENOVR) VALUE(%SST(&PAGLENOVR 1 3))
GOTO CMDLBL(READLPX)
ENDDO
IF COND((%SST(&PAGLENOVR 2 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&PAGLENOVR) VALUE('0' *CAT %SST(&PAGLENOVR 1 2))
GOTO CMDLBL(READLPX)
ENDDO
IF COND((%SST(&PAGLENOVR 1 1)) *NE ' ') THEN(DO)
CHGVAR VAR(&PAGLENOVR) VALUE('00' *CAT %SST(&PAGLENOVR 1 1))
GOTO CMDLBL(READLPX)
ENDDO
IF COND((%SST(&PAGLENOVR 1 3)) *EQ ' ') THEN(DO)
CHGVAR VAR(&PAGLENOVR) VALUE('000')
GOTO CMDLBL(READLPX)
ENDDO
GOTO CMDLBL(READLPX)
ENDDO
GOTO CMDLBL(READLP)
READLPX: IF COND(&SPLNBROVR *GE '0001' +
*AND &SPLNBROVR *LE '9999') THEN(DO)
CHGVAR VAR(&SPLNBR) VALUE(&SPLNBROVR)
CHGVAR VAR(&SPLNBRA) VALUE(&SPLNBROVR)
ENDDO
IF COND(&PAGLENOVR *GE '001' +
*AND &PAGLENOVR *LE '999') THEN(DO)
CHGVAR VAR(&PAGLEN) VALUE(&PAGLENOVR)
ENDDO
/* Convert to HTML format in physical file */
CRTPF FILE(QTEMP/CVTSPLHTMX) RCDLEN(202) SIZE(*NOMAX)
CRTPF FILE(QTEMP/CVTSPLHTMY) RCDLEN(1024) SIZE(*NOMAX)
CPYSPLF FILE(&SPLFNAME) TOFILE(QTEMP/CVTSPLHTMX) +
JOB(&PMJBNO/&PMUSNM/&PMJBNM) +
SPLNBR(&SPLNBR) MBROPT(*ADD) CTLCHAR(*PRTCTL)
OVRDBF FILE(FILEIN) TOFILE(QTEMP/CVTSPLHTMX) MBR(*FIRST)
OVRDBF FILE(FILEOUT) TOFILE(QTEMP/CVTSPLHTMY) MBR(*FIRST)
CALL PGM(*LIBL/CVTSPLHTMR) PARM(&PAGLEN)
DLTOVR FILE(FILEIN)
DLTOVR FILE(FILEOUT)
/* Create QDLS folder(s) if they do not exist */
CHGVAR VAR(&SCNSTR) VALUE(&DESTFLR)
CHGVAR VAR(&SCNPAT) VALUE('/')
CHGVAR VAR(&SCNPATLEN) VALUE(001)
CHGVAR VAR(&SCNBEGPOS) VALUE(001)
IF COND(&SCNSTR *NE ' ') THEN(DO)
FLDRLP: CALL QCLSCAN PARM(&SCNSTR &SCNSTRLEN &SCNBEGPOS &SCNPAT +
&SCNPATLEN &SCNXLT &SCNTRM &SCNWLDCRD &SCNRTNVAL)
/* 2 or more folders */
IF COND(&SCNRTNVAL *GT 0) THEN(DO)
CHGVAR VAR(&FLRCNT) VALUE(&FLRCNT + 1)
CHGVAR VAR(&NWFLRFRM) VALUE(&SCNBEGPOS)
CHGVAR VAR(&NWFLRTO) VALUE(&SCNRTNVAL -1)
CHGVAR VAR(&NWFLRLEN) VALUE(&NWFLRTO - &NWFLRFRM +1)
CHGVAR VAR(&NWFLR) VALUE(%SST(&SCNSTR &NWFLRFRM &NWFLRLEN))
IF COND(&NWFLRFRM *EQ 1) THEN(DO)
CHGVAR VAR(&INFLR) VALUE('*NONE')
ENDDO
IF COND(&NWFLRFRM *GT 1) THEN(DO)
CHGVAR VAR(&INFLRLEN) VALUE(&NWFLRFRM -2)
CHGVAR VAR(&INFLR) VALUE(%SST(&SCNSTR 1 &INFLRLEN))
ENDDO
CRTFLR FLR(&NWFLR) INFLR(&INFLR) TEXT('Created by +
CVTSPLHTM command')
MONMSG MSGID(CPF0000)
CHGVAR VAR(&SCNBEGPOS) VALUE(&SCNRTNVAL +1)
GOTO CMDLBL(FLDRLP)
ENDDO
/* Only 1 folder */
IF COND(&FLRCNT *LE 0) THEN(DO)
CHGVAR VAR(&NWFLRFRM) VALUE(&SCNBEGPOS)
CHGVAR VAR(&NWFLRTO) VALUE(&SCNBEGPOS + 12)
CHGVAR VAR(&NWFLRLEN) VALUE(12)
CHGVAR VAR(&NWFLR) VALUE(%SST(&SCNSTR &NWFLRFRM &NWFLRLEN))
CHGVAR VAR(&INFLR) VALUE('*NONE')
CRTFLR FLR(&NWFLR) INFLR(&INFLR) TEXT('Created by +
CVTSPLHTM command')
MONMSG MSGID(CPF0000)
ENDDO
/* Pickup last folder, if 2 or more folders */
IF COND(&FLRCNT *GE 1) THEN(DO)
CHGVAR VAR(&NWFLRFRM) VALUE(&SCNBEGPOS)
CHGVAR VAR(&NWFLRTO) VALUE(&SCNBEGPOS + 12)
CHGVAR VAR(&NWFLRLEN) VALUE(12)
CHGVAR VAR(&NWFLR) VALUE(%SST(&SCNSTR &NWFLRFRM &NWFLRLEN))
IF COND(&NWFLRFRM *GT 1) THEN(DO)
CHGVAR VAR(&INFLRLEN) VALUE(&NWFLRFRM -2)
CHGVAR VAR(&INFLR) VALUE(%SST(&SCNSTR 1 &INFLRLEN))
ENDDO
CRTFLR FLR(&NWFLR) INFLR(&INFLR) TEXT('Created by +
CVTSPLHTM command')
MONMSG MSGID(CPF0000)
ENDDO
ENDDO
/* Move HTML document into folder */
CHGVAR VAR(&DESTFIL1) VALUE(&DESTFIL *TCAT '.htm')
CPYTOPCD FROMFILE(*LIBL/CVTSPLHTMY) TOFLR(&DESTFLR) +
FROMMBR(*FIRST) TODOC(&DESTFIL1) +
REPLACE(*YES)
DLTF FILE(QTEMP/CVTSPLHTMX)
DLTF FILE(QTEMP/CVTSPLHTMY)
/* Return. */
RETRN: RETURN
/******************************************************************************/
/* Standard message handling routine. */
/******************************************************************************/
MSGSTART: IF COND(&MSGERR *EQ '1') THEN(SNDPGMMSG +
MSGID(CPF9999) MSGF(QCPFMSG) +
MSGTYPE(*ESCAPE))
CHGVAR VAR(&MSGERR) VALUE('1')
/* Move the diagnostic messages up to the next level. */
MSGDIAG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF COND(&MSGID *EQ ' ') THEN(GOTO +
CMDLBL(MSGCOMP))
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO CMDLBL(MSGDIAG)
/* Move the completion messages up to the next level. */
MSGCOMP: RCVMSG MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF COND(&MSGID *EQ ' ') THEN(GOTO +
CMDLBL(MSGESC))
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*COMP)
GOTO CMDLBL(MSGCOMP)
/* Re-send the last escape message (if there is one). */
MSGESC: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF COND(&MSGID *EQ ' ') THEN(RETURN)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM