//BCHJOB JOB(JRECURS) JOBD(QBATCH) OUTQ(QPRINT) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it di Claudio Neroni */ /* SE L'USO DELLA JOB DESCRIPTION "QBATCH" TI E' IMPEDITO, */ /* UTILIZZANE UNA DIVERSA. */ /* From System: "IUBICSVI" */ /* From Library: "UTI" */ /* Unload Time: 2008-10-23 14:40 */ /* To File : "JRECURS" */ /* To Library : "NERONI2" */ /* To Text : "Monitor and report recursion. Src" */ /********* INIZIO ISTRUZIONI *******************************************/ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI RICARICARE I SORGENTI. */ /* 1) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* CREARE UN FILE SORGENTE DI LUNGHEZZA RECORD 112: */ /* CRTSRCPF FILE(NERONI2/STRINGHE) RCDLEN(112) */ /* 2) SPOSTARE IL FILE "JRECURS.txt" NELL'INDIRIZZARIO */ /* DI UN PC CONNESSO IN RETE CON L'AS400 RICEVENTE */ /* (AD ES.: "c:\"). */ /* 3) DAL VIDEO COMANDI DEL PC CHIAMARE FTP: */ /* ftp nomeas400 */ /* 4) DIGITARE UTENTE E PASSWORD. */ /* 5) ESEGUIRE IL COMANDO DI COPIA DA FILE PC A MEMBRO AS400: */ /* put "c:\JRECURS.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JRECURS.mbr" */ /* 6) ABBANDONARE FTP: */ /* quit */ /* 7) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA COPIATA NEL MEMBRO SORGENTE: */ /* SBMDBJOB FILE(NERONI2/STRINGHE) MBR(JRECURS) JOBQ(QBATCH) */ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI CREARE L'UTILITY. */ /* 8) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA O LE STRINGHE SORGENTE DI TIPO SEU "CL" */ /* (IL CUI NOME TERMINA SEMPRE CON ".") */ /* PRESENTI NEL FILE RICARICATO "NERONI2/JRECURS" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JRECURS) MBR(JRECURS.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Utility di Claudio Neroni') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JRECURS) CRTSRCPF FILE(NERONI2/JRECURS) RCDLEN(112) + TEXT('Monitor and report recursion. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRECURS) TOFILE(NERONI2/JRECURS) + TOMBR(JRECURS) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRECURS) MBR(JRECURS) + SRCTYPE(CMD) + TEXT('Monitor and report recursion. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRECURS.) TOFILE(NERONI2/JRECURS) + TOMBR(JRECURS.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRECURS) MBR(JRECURS.) + SRCTYPE(CL) + TEXT('Monitor and report recursion. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRECURSI) TOFILE(NERONI2/JRECURS) + TOMBR(JRECURSI) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRECURS) MBR(JRECURSI) + SRCTYPE(CMD) + TEXT('Monitor and report recursion. CmdInter') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRECURS1) TOFILE(NERONI2/JRECURS) + TOMBR(JRECURS1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRECURS) MBR(JRECURS1) + SRCTYPE(CLLE) + TEXT('Monitor and report recursion. Cpp') /*---------------------------------------------------------------------*/ //DATA FILE(JRECURS) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CMD PROMPT('Monitor and report recursion') PARM KWD(PGM) TYPE(*NAME) MIN(1) PROMPT('Program + name') PARM KWD(RECURS) TYPE(*LGL) RTNVAL(*YES) + PROMPT('Var lgl I:DspErr O:Recurs') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRECURS.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JRECURS.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 06/04/1982 Creato. */ /* JRECURS */ /* Monitor and report recursion. */ /* Prerequisiti: nessuno */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTPGM PGM(NERONI2/JRECURS1) DLTCMD CMD(NERONI2/JRECURS) DLTCMD CMD(NERONI2/JRECURSI) DLTMSGF MSGF(NERONI2/JRECURS) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JRECURS1) SRCFILE(JRECURS) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JRECURS) PGM(JRECURS1) SRCFILE(JRECURS) + ALLOW(*IPGM *BPGM) PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JRECURSI) PGM(JRECURS1) SRCFILE(JRECURS) PRDLIB(NERONI2) CRTMSGF MSGF(NERONI2/JRECURS) TEXT('Monitor and report recursion. Msgf') /* Messaggi del Ccp. */ ADDMSGD MSGID(JRE0008) MSGF(NERONI2/JRECURS) MSG('Non riesco a + valutare se &1 è nella lista dei programmi attivi.') + SECLVL('Si è verificato un errore imprevisto mentre il + programma di utilità JRECURS cerca il programma &1 + nell''invocation stack del lavoro corrente o nella + lista delle librerie. Avvisa il programmatore.') + SEV(30) FMT((*CHAR 10)) ADDMSGD MSGID(JRE0009) MSGF(NERONI2/JRECURS) MSG('Il programma &1 non + può essere chiamato di nuovo.') SECLVL('Hai richiesto + il programma &1 che è ancora attivo ad un livello + precedente. La richiesta viene perciò rifiutata. Puoi + chiamare un altro programma o puoi tornare indietro + fino a ritornare sotto il controllo del programma che + ti interessa.') FMT((*CHAR 10)) ADDMSGD MSGID(JRE0010) MSGF(NERONI2/JRECURS) MSG('Il programma &1 non + esiste.') SECLVL('Hai richiesto il programma &1 che + non esiste ancora nell''ambiente elaborativo di tua + competenza. La richiesta viene perciò rifiutata. Puoi + chiamare un altro programma. E'' probabile che il + programmatore abbia previsto la funzione richiesta ma + non abbia ancora potuto installarla per mancanza di + risorse umane. Protesta per via gerarchica.') + FMT((*CHAR 10)) /* Messaggi del Cmd. */ //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRECURSI) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CMD PROMPT('Monitor and report recursion') PARM KWD(PGM) TYPE(*NAME) MIN(1) PROMPT('Program + name') PARM KWD(RECURS) TYPE(*LGL) CONSTANT('1') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRECURS1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Monitor and report recursion. */ /* Claudio Neroni 06/04/1982 Creato. */ /* */ /* Controlla e segnala recursione. */ /* */ /* Cerca il programma ricevuto nell'invocation stack */ /* e risponde errore se lo trova. */ /* Se la ricerca ha esito negativo, */ /* cerca il programma nella lista librerie */ /* e risponde errore se non lo trova. */ /* Se il parametro &ERRORE è on alla chiamata, */ /* visualizza all'utente i messaggi di esito con errore. */ /* */ PGM PARM(&PGM &ERRORE) /* Riceve */ /* Nome del programma da cercare in invocation stack e library list. */ DCL VAR(&PGM) TYPE(*CHAR) LEN(10) /* Riceve Richiesta di segnalazione errore (1). */ /* Restituisce Programma già in lista o non esistente (1). */ DCL VAR(&ERRORE) TYPE(*LGL) /* Richiesta di segnalazione. */ DCL VAR(&SEGNALA) TYPE(*LGL) VALUE('0') /* Identificatore del messaggio. */ DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Dati per i messaggi. */ DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132) /* Chiave del messaggio. */ DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4) /* Intercetta gli errori imprevisti. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Se il parametro &ERRORE è on alla chiamata. */ IF COND(&ERRORE) THEN(DO) /* Visualizzerà i messaggi di esito con errore. */ CHGVAR VAR(&SEGNALA) VALUE('1') /* End. */ ENDDO /* Assume che il programma cercato sia in invocation stack. */ CHGVAR VAR(&ERRORE) VALUE('1') /* Spedisce un messaggio al nome di programma ricevuto. */ SNDPGMMSG MSG('JRECURS.Msg per individuare presenza del + pgm ricevente in invocation stack.') + TOPGMQ(*SAME &PGM) MSGTYPE(*COMP) + KEYVAR(&KEYVAR) /* Se la spedizione è in errore, il programma non è in */ /* invocation stack. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Annota la non presenza. */ CHGVAR VAR(&ERRORE) VALUE('0') /* End. */ ENDDO /* Se il programma è presente in invocation stack. */ IF COND(&ERRORE) THEN(DO) /* Rimuove il messaggio di indagine. */ RCVMSG PGMQ(*SAME &PGM) MSGTYPE(*COMP) + MSGKEY(&KEYVAR) /* Predispone messaggio e dati da visualizzare. */ CHGVAR VAR(&MSGID) VALUE(JRE0009) CHGVAR VAR(&MSGDTA) VALUE(&PGM) /* Informa il chiamante. */ SNDPGMMSG MSGID(&MSGID) MSGF(JRECURS) MSGDTA(&MSGDTA) /* Se richiesta segnalazione a video. */ IF COND(&SEGNALA) THEN(DO) /* Visualizza in bella copia il messaggio scelto. */ /*********** §DSPMSG MSGID(&MSGID) MSGF(§MSGF) MSGDTA(&MSGDTA) ******/ SNDPGMMSG MSGID(&MSGID) MSGF(JRECURS) MSGDTA(&MSGDTA) + TOPGMQ(*EXT) /* End. */ ENDDO /* Salta alle attività finali. */ GOTO CMDLBL(FINE) /* End. */ ENDDO /* Controlla l'esistenza del programma nella lista librerie. */ CHKOBJ OBJ(*LIBL/&PGM) OBJTYPE(*PGM) /* Se il programma non è in lista librerie. */ MONMSG MSGID(CPF9801 CPF0001) EXEC(DO) /* Annota lo stato di errore. */ CHGVAR VAR(&ERRORE) VALUE('1') /* End. */ ENDDO /* Se il programma non è in lista librerie. */ IF COND(&ERRORE) THEN(DO) /* Predispone messaggio e dati da visualizzare. */ CHGVAR VAR(&MSGID) VALUE(JRE0010) CHGVAR VAR(&MSGDTA) VALUE(&PGM) /* Informa il chiamante. */ SNDPGMMSG MSGID(&MSGID) MSGF(JRECURS) MSGDTA(&MSGDTA) /* Se richiesta segnalazione a video. */ IF COND(&SEGNALA) THEN(DO) /* Visualizza in bella copia il messaggio scelto. */ /*********** §DSPMSG MSGID(&MSGID) MSGF(§MSGF) MSGDTA(&MSGDTA) ******/ SNDPGMMSG MSGID(&MSGID) MSGF(JRECURS) MSGDTA(&MSGDTA) + TOPGMQ(*EXT) /* End. */ ENDDO /* Salta alle attività finali. */ GOTO CMDLBL(FINE) /* End. */ ENDDO /* Label di attività finali. */ FINE: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Ritorna. */ RETURN /* Label di errore imprevisto. */ ERRORE: /* Annota errore nel flag di ritorno. */ CHGVAR VAR(&ERRORE) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Avverte l'utente. */ SNDPGMMSG MSGID(JRE0008) MSGF(JRECURS) MSGDTA(&PGM) + TOPGMQ(*EXT) MONMSG MSGID(CPF0000 MCH0000) /* Salta alle attività finali. */ GOTO CMDLBL(FINE) ENDPGM //ENDSRC //ENDBCHJOB