Showing posts with label examples. Show all posts
Showing posts with label examples. Show all posts

Monday, May 19, 2008

API Example - Deleting Old Spooled Files

Deleting Old Spooled Files

The following application program runs using the Delete Old Spooled Files (DLTOLDSPLF) command. This example has three major parts:

The DLTOLDSPLF command calls the delete old spooled files (DLTOLDSPLF) program in one of the following languages:
OPM RPG
OPM COBOL
ILE C

The DLTOLDSPLF program is supplied in OPM RPG, OPM COBOL, and ILE C. It does the following:
Creates a user space (QUSCRTUS API).
Generates a list of spooled files (QUSLSPL API).
Retrieves information from a user space using one of the following:
QUSRTVUS API
QUSPTRUS API
Retrieves more spooled file attribute information received from the user space (QUSRSPLA API).
Calls the CLDLT program to delete the spooled files.
Sends a message to the user (QMHSNDM API).
Deletes the user space (QUSDLTUS API).

The CL delete (CLDLT) program does the following:
Deletes the specified spooled files (DLTSPLF command).
Sends a message if the spooled file was deleted (SNDPGMMSG command).
DLTOLDSPLF Command Source

The command source for the DLTOLDSPLF command follows:

/****************************************************************/
/* */
/* CMD: DLTOLDSPLF */
/* */
/* LANGUAGE: CL COMMAND SOURCE */
/* */
/* DESCRIPTION: COMMAND SOURCE FOR THE DLTOLDSPLF COMMAND WHICH*/
/* INVOKES THE DLTOLDSPLF PROGRAM. */
/* */
/****************************************************************/
CMD PROMPT('DELETE OLD SPOOLED FILES')
/* PARAMETERS FOR LIST OF SPOOLED FILES (QUSLSPL) */
PARM KWD(USRPRFNME) +
TYPE(*SNAME) +
LEN(10) +
MIN(1) +
SPCVAL(*ALL) +
PROMPT('User Profile Name:')
PARM KWD(OUTQUEUE) +
TYPE(QUAL1) +
MIN(1) +
PROMPT('Output Queue:')
/* INFORMATION NEEDED FOR PROGRAM */
PARM KWD(DELETEDATE) +
TYPE(*DATE) +
PROMPT('Last Deletion Date:')
QUAL1: QUAL TYPE(*NAME) LEN(10) SPCVAL(*ALL)
QUAL TYPE(*NAME) LEN(10) SPCVAL(*LIBL *CURLIB ' ') +
PROMPT('Library Name:')


To create the CL command, specify the following:
CRTCMD CMD(QGPL/DLTOLDSPLF) PGM(QGPL/DLTOLDSPLF) +
SRCFILE(QGPL/QCMDSRC) ALLOW(*IPGM *BPGM)
To delete old spooled files, you can use one of the application programs provided in the following languages:

RPG
COBOL
ILE C
RPG DLTOLDSPLF Program

To delete old spooled files, use the following RPG program:


H* ***************************************************************
H* ***************************************************************
H* *
H* MODULE: DLTOLDSPLF *
H* *
H* LANGUAGE: RPG *
H* *
H* FUNCTION: THIS APPLICATION WILL DELETE OLD SPOOLED FILES *
H* FROM THE SYSTEM, BASED ON THE INPUT PARAMETERS. *
H* *
H* APIs USED: *
H* QUSCRTUS -- Create User Space *
H* QUSLSPLF -- List Spooled Files *
H* QUSRTVUS -- Retrieve User Space *
H* QUSRSPLA -- Retrieve Spooled File Attributes *
H* QMHSNDPM -- Send Program Message *
H* QUSDLTUS -- Delete User Space *
H* *
H* ***************************************************************
H* ***************************************************************
E/COPY QRPGSRC,EUSRSPLA
I 'NUMBER OF SPOOLED - C MSGTXT
I 'FILES DELETED: '
IMSGDTA DS
I 1 35 MSGDT1
I 36 400DLTCNT
ISTRUCT DS
I B 1 40USSIZE
I B 5 80GENLEN
I B 9 120RTVLEN
I B 13 160STRPOS
I B 17 200RCVLEN
I B 21 240SPLF#
I B 25 280MSGDLN
I B 29 320MSGQ#
I 33 38 FIL#
I 39 42 MSGKEY
I I 'DLTOLDSPLFQTEMP ' 43 62 USRSPC
I I '*REQUESTER ' 63 82 MSGQ
ITGTDAT DS
I 1 1 TGTCEN
I 2 3 TGTYR
I 4 5 TGTMTH
I 6 7 TGTDAY
I/COPY QRPGSRC,QUSGEN
I/COPY QRPGSRC,QUSLSPL
I/COPY QRPGSRC,QUSRSPLA
I*****************************************************************
I* The following is copied from QSYSINC/QRPGSRC member QUSEC
I* so that the variable length field QUSBNG can be defined
I* as 100 bytes for exception data. The defined field is
I* named EXCDTA.
I*****************************************************************
IQUSBN DS
I* Qus EC
I B 1 40QUSBNB
I* Bytes Provided
I B 5 80QUSBNC
I* Bytes Available
I 9 15 QUSBND
I* Exception Id
I 16 16 QUSBNF
I* Reserved
I* 17 17 QUSBNG
I* Varying length
I 17 116 EXCDTA
IDATSTR DS
I 1 1 DATCEN
I 202 203 DATYR
I 204 205 DATMTH
I 206 207 DATDAY
C* ***************************************************************
C* ***************************************************************
C* *
C* EXECUTABLE CODE STARTS HERE *
C* *
C* ***************************************************************
C* ***************************************************************
C* *
C *ENTRY PLIST
C PARM USRNAM 10
C PARM OUTQ 20
C PARM DLTDAT 7
C MOVE DLTDAT TGTDAT
C Z-ADD0 DLTCNT
C MOVE *BLANKS QUSBN
C Z-ADD0 QUSBNB
C* *
C* CREATE A USER SPACE TO STORE THE LIST OF SPOOLED FILES. *
C* *
C CALL 'QUSCRTUS'
C PARM USRSPC
C PARM *BLANKS USEXAT 10
C PARM 1024 USSIZE
C PARM ' ' USINIT 1
C PARM '*CHANGE 'USAUTH 10
C PARM *BLANKS USTEXT 50
C PARM '*YES 'USREPL 10
C PARM QUSBN
C* *
C* FILL THE USER SPACE JUST CREATED WITH SPOOLED FILES AS *
C* DEFINED IN THE CL COMMAND. *
C* *
C CALL 'QUSLSPL'
C PARM USRSPC
C PARM 'SPLF0100'FMTNM1 8
C PARM USRNAM
C PARM OUTQ
C PARM '*ALL 'FRMTYP 10
C PARM '*ALL 'USRDTA 10
C PARM QUSBN
C* *
C* THE USER SPACE IS NOW FILLED WITH THE LIST OF SPOOLED FILES. *
C* NOW USE THE QUSRTVUS API TO FIND THE NUMBER OF ENTRIES AND *
C* THE OFFSET AND SIZE OF EACH ENTRY IN THE USER SPACE. *
C* *
C Z-ADD140 GENLEN
C Z-ADD1 STRPOS
C* *
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM GENLEN
C PARM QUSBP
C PARM QUSBN
C* *
C* CHECK THE GENERIC HEADER DATA STRUCTURE FOR NUMBER OF LIST *
C* ENTRIES, OFFSET TO LIST ENTRIES, AND SIZE OF EACH LIST ENTRY. *
C* *
C Z-ADDQUSBPQ STRPOS
C ADD 1 STRPOS
C Z-ADDQUSBPT RTVLEN
C Z-ADD209 RCVLEN
C Z-ADD1 COUNT 150
C* *
C* ***************************************************************
C* ***************************************************************
C* *
C* BEGINNING OF LOOP (DO WHILE COUNT <= QUSBPS) *
C* *
C* ***************************************************************
C* *
C COUNT DOWLEQUSBPS
C* *
C* RETRIEVE THE INTERNAL JOB IDENTIFIER AND INTERNAL SPOOLED FILE*
C* IDENTIFIER FROM THE ENTRY IN THE USER SPACE. THIS INFORMATION*
C* WILL BE USED TO RETRIEVE THE ATTRIBUTES OF THE SPOOLED FILE. *
C* THIS WILL BE DONE FOR EACH ENTRY IN THE USER SPACE. *
C* *
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM RTVLEN
C PARM QUSFT
C PARM QUSBN
C* *
C* NOW RETRIEVE THE SPOOLED FILE ATTRIBUTES USING THE QUSRSPLA *
C* API. *
C* *
C MOVE *BLANKS JOBINF
C MOVEL'*INT' JOBINF 26
C MOVE QUSFTH QUSFXD
C MOVE QUSFTJ QUSFXF
C MOVEL'*INT' SPLFNM 10
C MOVE *BLANKS SPLF#
C* *
C CALL 'QUSRSPLA'
C PARM QUSFX
C PARM RCVLEN
C PARM 'SPLA0100'FMTNM2 8
C PARM JOBINF
C PARM QUSFXD
C PARM QUSFXF
C PARM SPLFNM
C PARM SPLF#
C PARM QUSBN
C* *
C* CHECK QUSFX DATA STRUCTURE FOR DATE FILE OPENED. *
C* DELETE SPOOLED FILES THAT ARE OLDER THAN THE TARGET DATE *
C* SPECIFIED ON THE COMMAND. A MESSAGE IS SENT FOR EACH SPOOLED *
C* FILE DELETED. *
C* *
C* *
C MOVE QUSFX7 DATSTR

C DATCEN IFLT TGTCEN
C EXSR CLDLT
C ELSE
C DATCEN IFEQ TGTCEN

C DATYR IFLT TGTYR
C EXSR CLDLT
C ELSE
C DATYR IFEQ TGTYR
C DATMTH IFLT TGTMTH
C EXSR CLDLT
C ELSE NOT LT MTH
C DATMTH IFEQ TGTMTH
C DATDAY IFLE TGTDAY
C EXSR CLDLT
C END FOR LE DAY
C END FOR EQ MTH
C END FOR ELSE MTH
C END FOR EQ YR
C END FOR ELSE YR

C END FOR EQ CEN
C END FOR ELSE CEN

C* *
C* GO BACK AND PROCESS THE REST OF THE ENTRIES IN THE USER *
C* SPACE. *
C QUSBPT ADD STRPOS STRPOS
C 1 ADD COUNT COUNT
C END
C* ************************************************************* *
C* ************************************************************* *
C* *
C* END OF LOOP *
C* *
C* ************************************************************* *
C* ************************************************************* *
C* *
C* AFTER ALL SPOOLED FILES HAVE BEEN DELETED THAT MET THE *
C* REQUIREMENTS, SEND A FINAL MESSAGE TO THE USER. *
C* DELETE THE USER SPACE OBJECT THAT WAS CREATED. *
C* *
C MOVELMSGTXT MSGDT1
C CALL 'QMHSNDM'
C PARM *BLANKS MSGID 7
C PARM *BLANKS MSGFIL 20
C PARM MSGDTA
C PARM 40 MSGDLN
C PARM '*INFO 'MSGTYP 10
C PARM MSGQ
C PARM 1 MSGQ#
C PARM *BLANKS RPYMQ 10
C PARM MSGKEY
C PARM QUSBN
C* *
C* DELETE THE USER SPACE OBJECT THAT WAS CREATED. *
C* *
C CALL 'QUSDLTUS'
C PARM USRSPC
C PARM QUSBN
C* *
C* *
C* ************************************************************* *
C* ************************************************************* *
C* *
C* END OF PROGRAM *
C* *
C* ************************************************************* *
C RETRN
C*
C* ************************************************************* *
C* *
C* CLDLT SUBROUTINE *
C* *
C* THIS SUBROUTINE CALLS A CL PROGRAM THAT WILL DELETE A SPOOLED *
C* FILE AND SEND A MESSAGE THAT THE SPOOLED FILE WAS DELETED. *
C* *
C* ************************************************************* *
C* *
C CLDLT BEGSR
C* *
C* KEEP A COUNTER OF HOW MANY SPOOLED FILES ARE DELETED. *
C* *
C ADD 1 DLTCNT
C MOVE QUSFXL FIL#
C CALL 'CLDLT'
C PARM QUSFXK
C PARM QUSFXJ
C PARM QUSFXH
C PARM QUSFXG
C PARM FIL#
C PARM QUSFXM
C PARM QUSFXN
C ENDSR

To create the RPG program, specify the following:

CRTRPGPGM PGM(QGPL/DLTOLDSPLF) SRCFILE(QGPL/QRPGSRC)
COBOL DLTOLDSPLF Program

To delete spooled files, you can use this COBOL DLTOLDSPLF program:


***************************************************************
* *
* PROGRAM: DLTOLDSPLF *
* *
* LANGUAGE: COBOL *
* *
* DESCRIPTION: DELETE OLD SPOOLED FILES *
* *
* APIs USED: QUSCRTUS, QUSLSPL, QUSRTVUS, QUSRSPLA, QUSDLTUS,*
* AND QMHSNDM. *
***************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. DLTOLDSPLF.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
COPY QUSGEN OF QSYSINC-QLBLSRC.
COPY QUSLSPL OF QSYSINC-QLBLSRC.
COPY QUSRSPLA OF QSYSINC-QLBLSRC.
*****************************************************************
* VALUES USED FOR ERROR CODE *
*****************************************************************
* The following is copied from QSYSINC/QLBLSRC member QUSEC
* so that the variable length field EXCEPTION-DATA can be defined
* as 100 bytes for exception data.
*****************************************************************
01 QUS-EC.
05 BYTES-PROVIDED PIC S9(00009) BINARY.
05 BYTES-AVAILABLE PIC S9(00009) BINARY.
05 EXCEPTION-ID PIC X(00007).
05 RESERVED PIC X(00001).
* 05 EXCEPTION-DATA PIC X(00001).
*
* Varying length
05 EXCEPTION-DATA PIC X(100).

***************************************************************
* VALUES USED FOR THE QUSCRTUS PROGRAM *
***************************************************************
01 CRTUS-INFO.
05 CRT-SPCNAME PIC X(20)
VALUE "DLTOLDSPLFQTEMP ".
05 CRT-EXTATTR PIC X(10) VALUE SPACE.
05 CRT-SPCSIZE PIC S9(9) BINARY VALUE 1024.
05 CRT-INITSPACE PIC X VALUE " ".
05 CRT-AUTHORITY PIC X(10) VALUE "*CHANGE ".
05 CRT-DESCRIPTION PIC X(50) VALUE SPACE.
05 CRT-USRRPL PIC X(10) VALUE "*YES ".

***************************************************************
* VALUES USED FOR THE QUSRTVUS PROGRAM *
***************************************************************
01 RTV-START-POS PIC S9(9) BINARY VALUE 1.
01 RTV-LENGTH PIC S9(9) BINARY VALUE 140.

01 RTVSPLA-JOB-ID PIC X(26) VALUE "*INT".

***************************************************************
* VALUES USED FOR THE QUSLSPL AND QUSRSPLA PROGRAM *
***************************************************************
01 RSPLA-DATE.
05 R-CENTURY PIC X.
05 R-YEAR PIC X(2).
05 R-MONTH PIC X(2).
05 R-DAY PIC X(2).
01 LSPLA-FORMAT PIC X(8) VALUE "SPLF0100".
01 LSPLA-USERDATA PIC X(10) VALUE "*ALL ".
01 LSPLA-FORMTYPE PIC X(10) VALUE "*ALL ".
01 RSPLA-JOB-NAME PIC X(26) VALUE "*INT".
01 RSPLA-NAME PIC X(10) VALUE "*INT".
01 RSPLA-NUMBER PIC S9(9) BINARY VALUE -1.
01 RSPLA-FORMAT PIC X(10) VALUE "SPLA0100 ".
01 SPLA-VAR-LENGTH PIC S9(9) BINARY VALUE 800.
01 DLT-COUNT PIC 9(15) VALUE 0.
01 DLT-SPL-NUMBER PIC 9(6).

***************************************************************
* VALUES USED FOR THE QMHSNDM PROGRAM *
***************************************************************
01 MSG-ID PIC X(7) VALUE SPACE.
01 MSG-FL-NAME PIC X(20) VALUE SPACE.
01 MSG-DATA.
05 DATA-MD PIC X(34)
VALUE "NUMBER OF SPOOLED FILES DELETED : ".
05 DLT-NUM-MD PIC X(20) VALUE SPACE.
01 MSG-DATA-LEN PIC S9(9) BINARY VALUE 54.
01 MSG-TYPE PIC X(10) VALUE "*INFO ".
01 MSG-QUEUE PIC X(20)
VALUE "*REQUESTER ".
01 MSG-Q-NUM PIC S9(9) BINARY VALUE 1.
01 RPY-MSG PIC X(10) VALUE SPACE.
01 MSG-KEY PIC X(4) VALUE SPACE.

***************************************************************
* PARAMETERS THAT ARE PASSED TO THIS PROGRAM FROM THE COMMAND *
***************************************************************
LINKAGE SECTION.
01 PARM-USERNAME PIC X(10).
01 PARM-OUTQ PIC X(20).
01 PARM-DATE.
05 P-CENTURY PIC X.
05 P-YEAR PIC X(2).
05 P-MONTH PIC X(2).
05 P-DAY PIC X(2).

***************************************************************
* BEGINNING OF EXECUTABLE CODE. *
***************************************************************
PROCEDURE DIVISION USING PARM-USERNAME,
PARM-OUTQ,
PARM-DATE.

MAIN-PROGRAM.

* **********************************************************
* * INITIALIZE ERROR CODE STRUCTURE. *
* **********************************************************

MOVE 116 TO BYTES-PROVIDED.
MOVE 0 TO BYTES-AVAILABLE.
MOVE SPACES TO EXCEPTION-ID.
MOVE SPACES TO RESERVED OF QUS-EC.
MOVE SPACES TO EXCEPTION-DATA.

* **********************************************************
* * CREATE THE USER SPACE USING INPUT PARMS FOR THE CALL *
* **********************************************************

CALL "QUSCRTUS" USING CRT-SPCNAME,
CRT-EXTATTR,
CRT-SPCSIZE,
CRT-INITSPACE,
CRT-AUTHORITY,
CRT-DESCRIPTION,
CRT-USRRPL,
QUS-EC.

* **********************************************************
* * LIST THE SPOOLED FILES TO THE USER SPACE OBJECT. *
* **********************************************************

CALL "QUSLSPL" USING CRT-SPCNAME,
LSPLA-FORMAT,
PARM-USERNAME,
PARM-OUTQ,
LSPLA-FORMTYPE,
LSPLA-USERDATA,
QUS-EC.

* **********************************************************
* * RETRIEVE ENTRY INFORMATION FROM THE USER SPACE. *
* **********************************************************

CALL "QUSRTVUS" USING CRT-SPCNAME,
RTV-START-POS,
RTV-LENGTH,
QUS-GENERIC-HEADER-0100,
QUS-EC.

* **********************************************************
* * IF ANY SPOOLED FILES WERE FOUND MATCHING THE SEARCH *
* * CRITERIA, RETRIEVE DETAILED INFORMATION AND DECIDE *
* * WHETHER TO DELETE THE FILE OR NOT. *
* **********************************************************

IF NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100
GREATER THAN ZERO THEN
ADD 1 TO OFFSET-LIST-DATA OF QUS-GENERIC-HEADER-0100
GIVING RTV-START-POS.
PERFORM CHECK-AND-DELETE THROUGH
CHECK-AND-DELETE-END NUMBER-LIST-ENTRIES
OF QUS-GENERIC-HEADER-0100 TIMES.

* **********************************************************
* * CALL THE QUSDLTUS API TO DELETE THE USER SPACE *
* * WE CREATED, AND TO SEND A MESSAGE TELLING HOW MANY *
* * SPOOLED FILES WERE DELETED. *
* **********************************************************

CALL "QUSDLTUS" USING CRT-SPCNAME,
QUS-EC.

MOVE DLT-COUNT TO DLT-NUM-MD.
CALL "QMHSNDM" USING MSG-ID,
MSG-FL-NAME,
MSG-DATA,
MSG-DATA-LEN,
MSG-TYPE,
MSG-QUEUE,
MSG-Q-NUM,
RPY-MSG,
MSG-KEY,
QUS-EC.

STOP RUN.

* **********************************************************
* * CHECK THE DATE OF THE SPOOLED FILE. IF IT IS OLDER *
* * OR EQUAL TO THE DATE PASSED IN, CALL THE PROCEDURE *
* * TO DELETE THE SPOOLED FILE. *
* **********************************************************

CHECK-AND-DELETE.
CALL "QUSRTVUS" USING CRT-SPCNAME,
RTV-START-POS,
SIZE-EACH-ENTRY OF
QUS-GENERIC-HEADER-0100,
QUS-SPLF0100,
QUS-EC.

* **********************************************************
* * ADVANCE TO NEXT SPOOLED FILE FOR PROCESSING THE CHECK *
* * AND DELETE. *
* **********************************************************

ADD SIZE-EACH-ENTRY OF QUS-GENERIC-HEADER-0100 TO
RTV-START-POS GIVING RTV-START-POS.

* **********************************************************
* * RETRIEVE THE ATTRIBUTES FOR THE SPOOLED FILE TO GET *
* * THE CREATE DATE FOR THE SPOOLED FILE. *
* **********************************************************

CALL "QUSRSPLA" USING QUS-SPLA0100,
SPLA-VAR-LENGTH,
RSPLA-FORMAT,
RSPLA-JOB-NAME,
INT-JOB-ID OF QUS-SPLF0100,
INT-SPLF-ID OF QUS-SPLF0100,
RSPLA-NAME,
RSPLA-NUMBER,
QUS-EC.

MOVE DATE-FILE-OPEN OF QUS-SPLA0100 TO RSPLA-DATE.

* **********************************************************
* * COMPARE THE CREATE DATE WITH THE DATE THAT WAS PASSED *
* * IN AS PARAMETER. *
* **********************************************************

IF R-CENTURY IS LESS THAN P-CENTURY THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END
ELSE
IF R-CENTURY IS EQUAL TO P-CENTURY THEN

IF R-YEAR IS LESS THAN P-YEAR THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END
ELSE
IF R-YEAR IS EQUAL TO P-YEAR THEN
IF R-MONTH IS LESS THAN P-MONTH THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END
ELSE
IF R-MONTH IS EQUAL TO P-MONTH THEN
IF R-DAY IS LESS THAN OR EQUAL TO P-DAY THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END.

CHECK-AND-DELETE-END.

* **********************************************************
* * THIS IS THE PROCEDURE TO DELETE THE SPOOLED FILE. *
* * ALL OF THE SPOOLED FILES WITH CREATE DATE OLDER OR *
* * EQUAL TO THE DATE PASSED IN AS PARAMETER WILL BE *
* * DELETED. *
* **********************************************************

DLT-SPLF.
ADD 1 TO DLT-COUNT.
MOVE SPLF-NUMBER OF QUS-SPLA0100 TO DLT-SPL-NUMBER.

CALL "CLDLT" USING SPLF-NAME OF QUS-SPLA0100,
JOB-NUMBER OF QUS-SPLA0100,
USR-NAME OF QUS-SPLA0100,
JOB-NAME OF QUS-SPLA0100,
DLT-SPL-NUMBER,
FORM-TYPE OF QUS-SPLA0100,
USR-DATA OF QUS-SPLA0100.

DLT-SPLF-END.

To create the COBOL program, specify the following:

CRTCBLPGM PGM(QGPL/DLTOLDSPLF) SRCFILE(QGPL/QCBLSRC)
ILE C DLTOLDSPLF Program

To delete spooled files, you can use this ILE C DLTOLDSPLF program:


/*******************************************************************/
/* PROGRAM: DLTOLDSPLF */
/* */
/* LANGUAGE: ILE C for OS/400 */
/* */
/* DESCRIPTION: THIS IS AN EXAMPLE PROGRAM FOR THE USE OF */
/* USER SPACES WRITTEN IN ILE C for OS/400. */
/* THE FLOW OF THIS PROGRAM IS AS FOLLOWS: */
/* (1) CREATE A USER SPACE USING QUSCRTUS */
/* (2) GET LIST OF SPOOLED FILES IN THE USER SPACE */
/* USING QUSLSPL */
/* (3) KEEP POINTER TO ENTRY LIST IN THE USER SPACE */
/* (4) ENTER LOOP */
/* RETRIEVE LIST ENTRY */
/* RETRIEVE MORE INFORMATION USING QUSRSPLA */
/* IF SPOOLED FILE IS TOO OLD */
/* DELETE SPOOLED FILE */
/* INCREMENT DELETE COUNTER */
/* END LOOP */
/* (5) DELETE USER SPACE */
/* */
/* APIs USED: QUSCRTUS, QUSLSPL, QUSRSPLA, QUSPTRUS, QUSDLTUS, */
/* QMHSNDPM, AND QMHSNDM. */
/* */
/*******************************************************************/
#include /*strcpy, strncpy, strcmp */
#include
#include /*Error code structures */
#include /*General user space structures */
#include /*Linkage info, structures for QUSCRTUS */
#include /*Linkage info, structures for QUSLSPL */
#include /*Linkage info, structures for QUSPTRUS */
#include /*Linkage info, structures for QUSRSPLA */
#include /*Linkage info, structures for QUSDLTUS */
#include /*Linkage info, structures for QMHSNDM */
#include /*Linkage info, structures for QMHSNDPM */


#pragma linkage(CLDLT,OS)
void CLDLT (char file_name[10],
char job_number[6],
char usr_name[10],
char job_name[10],
char file_number[6],
char form_type[10],
char usr_data[10]);

void error_check (void);

Qus_Generic_Header_0100_t *space;
char *list_section;
Qus_SPLF0100_t *entry_list;
Qus_SPLA0100_t *Rcv_Spl_Var;
/*****************************************************************/
/* PARMS FOR CLDLT */
/*****************************************************************/
char job_nmbr[6];
char usr_nm[10];
char job_nm[10];
char sp_job_name[10];
char sp_spl_number[6];
char File_Number[] = "*LAST ";
/*****************************************************************/
/* PARMS FOR QUSLSPL */
/*****************************************************************/
char frmt[8];
char usr[10];
char OutQ_Nm[20];
char ls_frm_typ[10];
char Usr_dat[10];
/*****************************************************************/
/* PARMS FOR QUSRSPLA */
/*****************************************************************/
char Rcv_Var[724];
int Rcv_lgth = 724;
char Rtv_Fmt[8];
char Qal_Jb_Nam[] = "*INT ";
char Splf_Name[] = "*INT ";
int Splf_Number = -1;
/*****************************************************************/
/* PARMS FOR QUSCRTUS */
/*****************************************************************/
char spc_name[20];
char ext_atr[10];
int initial_size;
char initial_value[1];
char auth[10];
char desc[50];
char replace[10];
/*****************************************************************/
/* PARMS FOR QMHSNDPM AND QMHSNDM */
/*****************************************************************/
char msg_id[7];
char msg_fl_name[20];
char msg_data[50];
int msg_data_len;
char msg_type[10];
char pgm_queue[10];
int pgm_stk_cnt;
char msg_key[4];
/*****************************************************************/
/* PARMS FOR QMHSNDM */
/*****************************************************************/
int msg_q_num;
char msg_queue[20];
char rpy_mq[10];
/*****************************************************************/
/* MISCELLANEOUS VARIABLES */
/*****************************************************************/
char pack_dlt_count[15];
int dlt_cnt;
int count;
char tmp_spl_number[7];
char dlt_date[7];
char spc_date[7];
int api_code;
Qus_EC_t err_code;

/*****************************************************************/
/* PROCEDURE TO CHECK THE ERRCODE RETURNED FROM CALLS TO APIs */
/*****************************************************************/
void error_check(void)
{
if (err_code.Bytes_Available != 0){
strncpy(msg_id,"CPF9898",7);
strncpy(msg_fl_name,"QCPFMSG *LIBL ",20);
strncpy(msg_data,"An error has occurred calling ",29);
switch (api_code){
case 1 : strncat(msg_data,"QUSCRTUS.",9);
case 2 : strncat(msg_data,"QUSLSPL. ",9);
case 3 : strncat(msg_data,"QUSPTRUS.",9);
case 4 : strncat(msg_data,"QUSRSPLA.",9);
case 5 : strncat(msg_data,"QUSDLTUS.",9);
case 6 : strncat(msg_data,"QMHSNDM. ",9);
default : strncat(msg_data,"UNKNOWN. ",9);
}
msg_data_len = 38;
strncpy(msg_type,"*ESCAPE ",10);
strncpy(pgm_queue,"* ",10);
pgm_stk_cnt = 1;

QMHSNDPM(msg_id,msg_fl_name,msg_data,msg_data_len,msg_type,
pgm_queue,pgm_stk_cnt,msg_key,&err_code);
}
}

/********************************************************************/
/* START OF MAINLINE */
/********************************************************************/

main(argc,argv)
int argc;
char *argv[];
{

/********************************************************************/
/* Read in and assign the command-line arguments to respective */
/* variables */
/********************************************************************/
strncpy(usr,argv[1],10);
strncpy(OutQ_Nm,argv[2],20);
strncpy(dlt_date,argv[3],7);

/********************************************************************/
/* Assign value to specific variables in the program */
/********************************************************************/
strcpy(spc_name,"DLTOLDSPLFQTEMP ");
memset(ext_atr,' ',10);
initial_size = 1024;
strcpy(initial_value," ");
strcpy(auth,"*CHANGE ");
memset(desc,' ',50);
strcpy(frmt,"SPLF0100");
strcpy(replace,"*YES ");
strcpy(ls_frm_typ,"*ALL ");
strcpy(Usr_dat,"*ALL ");
strcpy(Rtv_Fmt,"SPLA0100");

/********************************************************************/
/* Call external program to create a user space */
/********************************************************************/
err_code.Bytes_Provided = 0;
api_code = 1;
QUSCRTUS(spc_name,ext_atr,initial_size,initial_value,auth,desc,replace,
&err_code);
/********************************************************************/
/* Call external program to list spooled files into user space */
/********************************************************************/
api_code = 2;
QUSLSPL(spc_name,frmt,usr,OutQ_Nm,ls_frm_typ,Usr_dat,&err_code);
/********************************************************************/
/* Call external program to get a pointer to the user space */
/* and get addressability to the list data section. */
/********************************************************************/
api_code = 3;
QUSPTRUS(spc_name,&space,&err_code);
list_section = (char *)space;
list_section = list_section + space->Offset_List_Data;
entry_list = (Qus_SPLF0100_t *) list_section;
dlt_cnt = 0;
count = 1;

/********************************************************************/
/* Loop through the entry list and delete old spooled files */
/********************************************************************/
while (count <= space->Number_List_Entries) {
/********************************************************************/
/* Call external program to retrieve more spool information */
/********************************************************************/
api_code = 4;
QUSRSPLA(Rcv_Var,Rcv_lgth,Rtv_Fmt,Qal_Jb_Nam,
entry_list->Int_Job_ID,entry_list->Int_Splf_ID,
Splf_Name,Splf_Number,&err_code);
Rcv_Spl_Var = (Qus_SPLA0100_t *)Rcv_Var;
strncpy(spc_date,Rcv_Spl_Var->Date_File_Open,7);
/********************************************************************/
/* If spooled file is too old delete it */
/********************************************************************/
if (strncmp(spc_date,dlt_date,7) <= 0 ) {
strncpy(job_nm,Rcv_Spl_Var->Job_Name,10);
strncpy(job_nmbr,Rcv_Spl_Var->Job_Number,6);
strncpy(usr_nm,Rcv_Spl_Var->Usr_Name,10);
strncpy(sp_job_name,Rcv_Spl_Var->Splf_Name,10);
/********************************************************************/
/* Convert the spooled file number to character. */
/********************************************************************/
memcpy (sp_spl_number," ",6);
sprintf(tmp_spl_number,"%d",Rcv_Spl_Var->Splf_Number);
memcpy(sp_spl_number,tmp_spl_number,strlen(tmp_spl_number));
/********************************************************************/
/* Delete the spooled file. */
/********************************************************************/
CLDLT(sp_job_name,job_nmbr,usr_nm,
job_nm,sp_spl_number,ls_frm_typ,Usr_dat);
dlt_cnt++;
} /*IF*/
strcpy(spc_date," ");
count++;
entry_list++;
} /*WHILE*/
/********************************************************************/
/* Remove the user space */
/********************************************************************/
api_code = 5;
QUSDLTUS(spc_name, &err_code);

/********************************************************************/
/* Send final message to user indicating number of spooled files */
/* deleted. */
/********************************************************************/
api_code = 6;
strncpy(msg_id," ",7);
strncpy(msg_fl_name," ",20);
sprintf(msg_data,"Number of spooled files deleted: %d", dlt_cnt);
msg_data_len = strlen(msg_data);
strncpy(msg_type,"*INFO ",10);
strncpy(msg_queue,"*REQUESTER ",20);
msg_q_num = 1;
strncpy(rpy_mq," ",10);
QMHSNDM(msg_id,msg_fl_name,msg_data,msg_data_len,msg_type,
msg_queue,msg_q_num,rpy_mq,msg_key, &err_code);

}

To create an ILE C program, specify the following:

CRTBNDC PGM(QGPL/DLTOLDSPLF) SRCFILE(QGPL/QCSRC)
CL Delete (CLDLT) Program

The DLTOLDSPLF program, written in OPM RPG, OPM COBOL, or ILE C, calls a CL program named CLDLT. The CLDLT program deletes the spooled files and the user space. The following is the CL source for the CLDLT program.

/*********************************************************************/
/* */
/* PROGRAM: CLDLT */
/* */
/* LANGUAGE: CL */
/* */
/* DESCRIPTION: THIS PROGRAM WILL DELETE A SPECIFIC SPOOLED FILE */
/* USING THE DLTSPLF COMMAND AND SEND A MESSAGE WHEN */
/* THE FILE IS DELETED. */
/* */
/* */
/*********************************************************************/
/* */
PGM (&FILNAM &JOBNUM &USRNAM &JOBNAM &FILNUM &FRMTYP &USRDTA)
/* */
/* ***************************************************************** */
/* */
/* DECLARE SECTION */
/* */
/*********************************************************************/
/* */
DCL &FILNAM *CHAR 10
DCL &JOBNUM *CHAR 6
DCL &USRNAM *CHAR 10
DCL &JOBNAM *CHAR 10
DCL &FILNUM *CHAR 6
DCL &FRMTYP *CHAR 10
DCL &USRDTA *CHAR 10
MONMSG CPF0000
/* */
/*********************************************************************/
/* */
/* EXECUTABLE CODE */
/* */
/*********************************************************************/
/* */

DLTSPLF FILE(&FILNAM) +
JOB(&JOBNUM/&USRNAM/&JOBNAM) +
SPLNBR(&FILNUM) +
SELECT(&USRNAM *ALL &FRMTYP &USRDTA)
SNDPGMMSG MSG('Spooled file ' *CAT &FILNAM *CAT +
' number ' *CAT &FILNUM *CAT ' job ' +
*CAT &JOBNUM *CAT '/' +
*CAT &USRNAM *CAT '/' *CAT &JOBNAM *CAT +
' deleted.') +
TOUSR(*REQUESTER)
ENDPGM

To create the CL program, specify the following:

CRTCLPGM PGM(QGPL/CLDLT) SRCFILE(QGPL/QCLSRC)