//BCHJOB JOB(JWULK) 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-22 16:47 */ /* To File : "JWULK" */ /* To Library : "NERONI2" */ /* To Text : "Wait unlock. 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 "JWULK.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:\JWULK.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JWULK.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(JWULK) 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/JWULK" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JWULK) MBR(JWULK.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Utility Claudio Neroni') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JWULK) CRTSRCPF FILE(NERONI2/JWULK) RCDLEN(112) + TEXT('Wait unlock. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(A.LEGGIMI) TOFILE(NERONI2/JWULK) + TOMBR(A.LEGGIMI) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(A.LEGGIMI) + SRCTYPE(TXT) + TEXT('Wait unlock.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JWULK) TOFILE(NERONI2/JWULK) + TOMBR(JWULK) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(JWULK) + SRCTYPE(CLLE) + TEXT('Wait unlock. Pgm') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JWULK.) TOFILE(NERONI2/JWULK) + TOMBR(JWULK.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(JWULK.) + SRCTYPE(CL) + TEXT('Wait unlock. Cjs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JWULKT) TOFILE(NERONI2/JWULK) + TOMBR(JWULKT) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(JWULKT) + SRCTYPE(RPGLE) + TEXT('Wait unlock. Test. PgmChain') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JWULKTA) TOFILE(NERONI2/JWULK) + TOMBR(JWULKTA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(JWULKTA) + SRCTYPE(RPGLE) + TEXT('Wait unlock. Test. FileFiller') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JWULKTREAD) TOFILE(NERONI2/JWULK) + TOMBR(JWULKTREAD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(JWULKTREAD) + SRCTYPE(RPGLE) + TEXT('Wait unlock. Test. PgmReade') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JWULKT1) TOFILE(NERONI2/JWULK) + TOMBR(JWULKT1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JWULK) MBR(JWULKT1) + SRCTYPE(PF) + TEXT('Wait unlock. Test. File') /*---------------------------------------------------------------------*/ //DATA FILE(A.LEGGIMI) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *** NOTE PER L'USO *** Questo clp o clle ha il pregio di non ricevere parametri e di non usare altri componenti. Con questa trappola ho reso sopportabili tutti i programmi ereditati da gente che non conosceva il multiutilizzo. L'utility è costtituita dal solo CLLE "JWULK". Tutto il resto permette di eseguire il test con un file di prova. *--------------------------------------------------------------------- * Per eseguire la prova: * 1) Riempi il file di test eseguendo * CALL JWULKTA * 2) Nel primo job esegui * CALL JWULKT 5 * Il primo job allocherà il record 5 del file di test * per 180 secondi. * 3) Nel secondo job esegui * CALL JWULKT 0 * Il secondo job segnalerà record occupato al primo job e * all'operatore fino a quando il primo job non andrà a fine. *--------------------------------------------------------------------- ------------------------------------------------------------------------------------- Esempio di chiamata da RPGLE dopo chain. ------------------------------------------------------------------------------------- Invece che l'istruzione semplice C x chain tstrcd 50 si mette il loop * Tenta all'infinito la lettura di un record. * Se il record è occupato, segnala C do *hival C x chain tstrcd 5099 C 99 call 'JWULK' C 99 enddo ------------------------------------------------------------------------------------- Dopo read occorre invece riposizionarsi prima di rileggere e non è così banale. *** FINE NOTE PER L'USO *** //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JWULK) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Wait unlock. Pgm */ /* Claudio Neroni 13/02/1990 Creato. */ /* Chiamato subito dopo il ricevimento di un messaggio di record */ /* allocato da antagonista, informa il video antagonista */ /* o, per i batch, l'operatore affinché l'antagonista */ /* si tolga di mezzo. */ /* */ PGM /* Libreria del record conteso. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* File del record conteso. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Membro del record conteso. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Nome del lavoro corrente. */ DCL VAR(&CURJOB) TYPE(*CHAR) LEN(10) /* Utente del lavoro corrente. */ DCL VAR(&CURUSR) TYPE(*CHAR) LEN(10) /* Numero del lavoro corrente, */ DCL VAR(&CURNBR) TYPE(*CHAR) LEN(6) /* Tipo del lavoro corrente. */ DCL VAR(&CURTYP) TYPE(*CHAR) LEN(1) /* Nome del lavoro antagonista. */ DCL VAR(&LCKJOB) TYPE(*CHAR) LEN(10) /* Utente del lavoro antagonista. */ DCL VAR(&LCKUSR) TYPE(*CHAR) LEN(10) /* Numero del lavoro antagonista. */ DCL VAR(&LCKNBR) TYPE(*CHAR) LEN(10) /* Contatore di comodo. */ DCL VAR(&X) TYPE(*DEC) LEN(3 0) /* Contatore di comodo. */ DCL VAR(&Y) TYPE(*DEC) LEN(3 0) /* Chiave di riferimento del messaggio. */ DCL VAR(&MRK) TYPE(*CHAR) LEN(4) /* Chiave di partenza per la ricezione del prossimo messaggio. */ DCL VAR(&TOPORMRK) TYPE(*CHAR) LEN(4) /* Dati del messaggio. */ DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(108) /* Identificazione del messaggio. */ DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Chiave di riferimento del messaggio da cancellare. */ DCL VAR(&MRKDLT) TYPE(*CHAR) LEN(4) /* Prenotazione di cancellazione messaggio. */ DCL VAR(&DLT) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO + CMDLBL(RCLRSC)) /* Emette un messaggio di stato di avanzamento lavoro. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Attendo + liberazione record.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) DLYJOB DLY(02) /* Recupera le caratteristiche del lavoro corrente. */ RTVJOBA JOB(&CURJOB) USER(&CURUSR) NBR(&CURNBR) + TYPE(&CURTYP) /* Ricezione messaggio. */ RCVMSG: /* Riceve il prossimo messaggio dalla coda del programma chiamante. */ RCVMSG PGMQ(*PRV) RMV(*NO) KEYVAR(&MRK) + MSGDTA(&MSGDTA) MSGID(&MSGID) /* Se deve cancellare un messaggio. */ IF COND(&DLT) THEN(DO) /* Rimuove il messaggio. */ RCVMSG PGMQ(*PRV) MSGKEY(&MRKDLT) RMV(*YES) /* Annota l'eseguita cancellazione. */ CHGVAR VAR(&DLT) VALUE('0') /* Se deve cancellare un messaggio. */ ENDDO /* Se non ha trovato un messaggio, salta ad attività finali. */ IF COND(&MRK *EQ ' ') THEN(GOTO CMDLBL(RCLRSC)) /* Assume la chiave trovata come prossima chiave di partenza. */ CHGVAR VAR(&TOPORMRK) VALUE(&MRK) /* Se il messaggio riguarda un record conteso. */ IF COND(&MSGID *EQ CPF5027) THEN(DO) /* Annota chiave e prenotazione di cancellazione. */ CHGVAR VAR(&MRKDLT) VALUE(&MRK) CHGVAR VAR(&DLT) VALUE('1') /* Estrae dal messaggio il File del record conteso. */ CHGVAR VAR(&FILE) VALUE(%SST(&MSGDTA 11 10)) /* Estrae dal messaggio la Libreria del record conteso. */ CHGVAR VAR(&LIB) VALUE(%SST(&MSGDTA 21 10)) /* Estrae dal messaggio il Membro del record conteso. */ CHGVAR VAR(&MBR) VALUE(%SST(&MSGDTA 31 10)) /* -------------------------------------------------------------- */ /* Il nome job antagonista è scritto nel messaggio nella forma */ /* "NNNNNN/UUUUUUUUUU/JJJJJJJJJJ" di 28 caratteri. */ /* Tuttavia, sia UUUUUUUUUU (utente) che JJJJJJJJJJ (nome job) */ /* possono essere più corti; ad esempio, nella forma */ /* "123456/USER1/JOB99 " sempre di 28 caratteri. */ /* L'estrazione tiene perciò conto dei posizionamenti */ /* ballerini di fine utente e di inizio e fine nomejob */ /* con opportuni espedienti. */ /* -------------------------------------------------------------- */ /* Estrae dal messaggio il Numero del lavoro antagonista. */ CHGVAR VAR(&LCKNBR) VALUE(%SST(&MSGDTA 81 6)) /* Estrae dal messaggio l'Utente del lavoro antagonista. */ CHGVAR VAR(&LCKUSR) VALUE(' ') CHGVAR VAR(&X) VALUE(88) CHGVAR VAR(&Y) VALUE(1) USR: IF COND(&Y *GT 10) THEN(GOTO CMDLBL(USREND)) IF COND(%SST(&MSGDTA &X 1) *EQ '/') THEN(GOTO + CMDLBL(USREND)) CHGVAR VAR(%SST(&LCKUSR &Y 1)) VALUE(%SST(&MSGDTA &X + 1)) CHGVAR VAR(&X) VALUE(&X + 1) CHGVAR VAR(&Y) VALUE(&Y + 1) GOTO CMDLBL(USR) USREND: /* Estrae dal messaggio il Nome del lavoro antagonista. */ CHGVAR VAR(&LCKJOB) VALUE(' ') CHGVAR VAR(&X) VALUE(&X + 1) CHGVAR VAR(&Y) VALUE(1) JOB: IF COND(&Y *GT 10) THEN(GOTO CMDLBL(JOBEND)) IF COND(%SST(&MSGDTA &X 1) *EQ ' ') THEN(GOTO + CMDLBL(JOBEND)) CHGVAR VAR(%SST(&LCKJOB &Y 1)) VALUE(%SST(&MSGDTA &X + 1)) CHGVAR VAR(&X) VALUE(&X + 1) CHGVAR VAR(&Y) VALUE(&Y + 1) GOTO CMDLBL(JOB) JOBEND: /* Emette un messaggio di stato di avanzamento lavoro. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Utente' + *BCAT &LCKUSR *BCAT 'su' *BCAT &LCKJOB + *BCAT 'liberi' *BCAT &LIB *TCAT '/' *CAT + &FILE *BCAT 'mbr' *BCAT &MBR *TCAT '!') + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Se il lavoro corrente è interattivo. */ IF COND(&CURTYP *EQ '1') THEN(DO) /* Messaggia l'antagonista. */ SNDBRKMSG MSG('Libera urgentemente il record che occupi + nel file' *BCAT &LIB *TCAT '/' *TCAT &FILE + *BCAT 'membro' *BCAT &MBR *TCAT '.') + TOMSGQ(&LCKJOB) MONMSG MSGID(CPF0000) /* Messaggia l'operatore di sistema. */ SNDMSG MSG('Il lavoro interattivo' *BCAT &CURJOB *BCAT + &CURUSR *BCAT &CURNBR *BCAT 'chiede la + liberazione urgente di un record nel file' + *BCAT &LIB *TCAT '/' *TCAT &FILE *BCAT + 'membro' *BCAT &MBR *BCAT 'dal lavoro' + *BCAT &LCKJOB *BCAT &LCKUSR *BCAT &LCKNBR + *TCAT '.') TOMSGQ(XSYSOPR) MONMSG MSGID(CPF0000) /* Se il lavoro corrente è interattivo. */ ENDDO /* Se il lavoro corrente non è interattivo. */ IF COND(&CURTYP *NE '1') THEN(DO) /* Batch */ /* Messaggia l'operatore. */ SNDMSG MSG('Il lavoro a blocchi' *BCAT &CURJOB *BCAT + &CURUSR *BCAT &CURNBR *BCAT 'chiede la + liberazione urgente di un record nel file' + *BCAT &LIB *TCAT '/' *TCAT &FILE *BCAT + 'membro' *BCAT &MBR *BCAT 'dal lavoro' + *BCAT &LCKJOB *BCAT &LCKUSR *BCAT &LCKNBR + *TCAT '.') TOMSGQ(XSYSOPR) MONMSG MSGID(CPF0000) /* Se il lavoro corrente non è interattivo. */ ENDDO /* Se il messaggio riguarda un record conteso. */ ENDDO /* Salta a Ricezione messaggio. */ GOTO CMDLBL(RCVMSG) /* Label di esecuzione delle attività finali. */ RCLRSC: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Attende contro i loop stretti. */ DLYJOB DLY(05) /* Ritorna. */ RETURN ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JWULK.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JWULK.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 13/02/1990 Creato. */ /* JWULK */ /* Wait unlock. */ /* Prerequisiti: nessuno. */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTPGM PGM(NERONI2/JWULK) DLTF FILE(NERONI2/JWULKT1) DLTPGM PGM(NERONI2/JWULKT) DLTPGM PGM(NERONI2/JWULKTA) DLTPGM PGM(NERONI2/JWULKTREAD) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JWULK) SRCFILE(JWULK) DBGVIEW(*ALL) CRTPF FILE(NERONI2/JWULKT1) SRCFILE(JWULK) SIZE(*NOMAX) WAITRCD(5) CRTBNDRPG PGM(NERONI2/JWULKT) SRCFILE(JWULK) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JWULKTA) SRCFILE(JWULK) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JWULKTREAD) SRCFILE(JWULK) DBGVIEW(*ALL) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JWULKT) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Wait unlock. Test. PgmChain * Claudio Neroni 17/12/2000 Creato. * Prova l'utility "Wait unlock". *--------------------------------------------------------------------- * Per eseguire la prova: * 1) Riempi il file di test eseguendo * CALL JWULKTA * 2) Nel primo job esegui * CALL JWULKT 5 * Il primo job allocherà il record 5 del file di test * per 180 secondi. * 3) Nel secondo job esegui * CALL JWULKT 0 * Il secondo job segnalerà record occupato al primo job e * all'operatore fino a quando il primo job non andrà a fine. *--------------------------------------------------------------------- * File di test. FJwulkt1 uf e disk *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve il numero di record su cui attendere per 180 secondi. C parm wn 15 5 * Elabora i record dal file di test. C do 10 x 3 0 * Tenta all'infinito la lettura di un record. * Se il record è occupato, segnala C do *hival C x chain tstr 5099 C 99 call 'JWULK' C 99 enddo * Se il record non esiste, abbandona. C 50 leave * Se il record corrente deve restare allocato a lungo, attende. C if x=wn C call 'QCMDEXC' C parm 'dlyjob 180 'cmd1 12 C parm 12 len 15 5 C endif * Rilascia il record. C unlock Jwulkt1 * Elabora i record dal file di test. C enddo * Prenota chiusura. C seton lr *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JWULKTA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Wait unlock. Test. FileFiller * Claudio Neroni 17/12/2000 Creato. * Riempie il file di test. *--------------------------------------------------------------------- * File di test. FJwulkt1 o e disk usropn *--------------------------------------------------------------------- * Comando di pulizia file. D cmd1 s 100 inz('clrpfm Jwulkt1') * Valori per i record del file di test. D valueskey s 3 dim(10) ctdata perrcd(1) D valuesfld s 10 dim(10) alt(valueskey) *--------------------------------------------------------------------- * Pulisce il file di test. C call 'QCMDEXC' C parm cmd1 C parm 100 len 15 5 * Apre il file di test. C open Jwulkt1 * Scrive i record nel file di test. C do 10 x 3 0 C movel(p) valueskey(x) tstkey C movel(p) valuesfld(x) tstfld C write tstr C enddo * Prenota chiusura. C seton lr *--------------------------------------------------------------------- ** values X A X BB X CCC Z DDDD Z EEEEE Z FFFFFF Z GGGGGGG Z HHHHHHHH Z IIIIIIIII Z JJJJJJJJJJ //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JWULKTREAD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Wait unlock. Test. PgmReade * Claudio Neroni 17/12/2000 Creato. * Prova l'utility "Wait unlock". *--------------------------------------------------------------------- * Per eseguire la prova: * 1) Riempi il file di test eseguendo * CALL JWULKTA * 2) Nel primo job esegui * CALL JWULKT 5 * Il primo job allocherà il record 5 del file di test * per 180 secondi. * 3) Nel secondo job esegui * CALL JWULKTREAD Z * Il secondo job segnalerà record occupato al primo job e * all'operatore fino a quando il primo job non andrà a fine. *--------------------------------------------------------------------- * File di test. FJwulkt1 uf e k disk * Stampa. Fqprint o F 132 printer *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve la chiave del gruppo di record. C parm key 3 * Si posiziona ad inizio gruppo. C key setll tstr * Elabora i record del gruppo dal file di test. C do *hival * Pulisce annotazione di fatica. C clear fatica 6 * Tenta all'infinito la lettura di un record. * Se il record è occupato, segnala C do *hival C key reade tstr 9950 C 99 call 'JWULK' * Annota fatica. C 99 eval fatica='fatica' C 99 enddo * Se il record non esiste, abbandona. C 50 leave * Stampa il record. C except rcd * Rilascia il record. C unlock Jwulkt1 * Elabora i record del gruppo dal file di test. C enddo * Prenota chiusura. C seton lr *--------------------------------------------------------------------- * Stampa il record. Oqprint e rcd O tstkey O tstfld O fatica + 1 *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JWULKT1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Claudio Neroni 17/12/2000 Creato. A R TSTR A TEXT('Wait unlock. Test. File') A TSTKEY 3 A COLHDG('Key') A TSTFLD 10 A COLHDG('Field') A K TSTKEY A K TSTFLD //ENDSRC //ENDBCHJOB