CL Source Code

==============
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 

Dig deeper on iSeries programming commands

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close