Rafraîchissement d’une base iSeries de développement
Le CL qui suit copie entre deux AS/400 des fichiers physiques d’une bibliothèque donnée. Pour des raisons particulières (comme la préservation optimale de la place disque disponible), ce CL procède fichier par fichier. Points intéressants :
- Lire les conditions de fonctionnement dans les commentaires en tête de listing.
- Récupération du nom du CL et de sa bibliothèque par le biais d’un SNDPGMMSG suivi par RCVMSG. Ainsi, on n’a pas besoin de manipuler *LIBL ou d’avoir un nom de bibliothèque en dur pour appeler les programmes ou membres sources.
- Utilisation via RCVF de la liste des fichiers obtenue par DSPOBJD (fichier déclaré par la commande DCLF.).
- Les variables ODOBNM (nom du fichier) et ODOBAT (attribut du fichier) ne font pas l’objet d’un DCL. Elles proviennent en fait de la description externe du fichier créé par le DSPOBJD. La commande DSPFFD, ou la liste de compilation donnent la liste de ces zones. On peut aussi se servir de STRSQL pour connaître leurs caractéristiques.
- Utilisation de RUNRMTCMD pour lancer sur le système distant les commandes de restauration et autres.
- Ce CL envoie uniquement les fichiers physiques. Pour les fichiers logiques, il suffit de faire une autre version, très peu différente : tester ODOBAT = LF au lieu de PF. Les RGZPFM et RUNSQLSTM (CL ENVBREO) seront inutiles.
Prompt et commande de lancement
CMD PROMPT('Rafraichir la base de test')
PARM KWD(BIBIN) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('Bibliothèque à dupliquer')
PARM KWD(SYSTEM2) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('Système de destination')
PARM KWD(BIBOUT ) TYPE(*CHAR) LEN(10) +
PROMPT('Bibl. destination (facultatif)')
PARM KWD(SCRIPT ) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('Nom du script FTP')
PARM KWD(USR ) TYPE(*CHAR) LEN(10) +
CONSTANT('SERVICE ')
PARM KWD(PSW ) TYPE(*CHAR) LEN(10) +
CONSTANT('SERVICE333')
Création de la commande : CRTCMD BIBLIO/ENVB BIBLIO/ENVB BIBLIO/QCMDSRC SRCMBR(ENVB)
Programme CL général
Nommé ENVB dans la commande ci-dessus.
/* ENVOI VERS UN AUTRE SYSTEME DES PF D'UNE BIBLIOTHEQUE */
/* Conditions de fonctionnement : */
/* - Existence sur les deux systèmes d'un même profil de service */
/* avec le même mot de passe. */
/* - Sur le système d'arrivée : */
/* - l'objet QSYS/RSTOBJ doit avoir le droit PUBLIC *USE */
/* - l'utilisateur de servic a des droits suffisants */
/* - le serveur REXEC doit fonctionner ; lancement : */
/* STRTCPSVR SERVER(*REXEC) */
/* Les scripts FTP contiennent en "dur" : */
/* - l'userid et le psw commun aux deux systèmes */
/* - le nom de la bibliothèque où sont envoyés les fichiers */
/* - PARAMETRES : */
/* - Nom de la bibliothèque lue en entrée */
/* - Nom du systeme de destination */
/* - Nom de la bibliothèque en sortie (facultatif) */
/* - Nom du script FTP */
/* - Nom de l'utilisateur commun aux deux systèmes */
/* - Mot de passe commun aux deux systèmes */
PGM (&BIBIN &SYSTEM2 &BIBOUT &SCRIPT &USR &PSW)
DCL &BIBIN *CHAR 10
DCL &SYSTEM2 *CHAR 10
DCL &BIBOUT *CHAR 10
DCL &SCRIPT *CHAR 10
DCL &USR *CHAR 10
DCL &PSW *CHAR 10
DCL &SENDER *CHAR 128 /* Zone de travail pour SNDPGMMSG-RCVMSG */
DCL &MSGKEY *CHAR 4 /* Zone de travail pour SNDPGMMSG-RCVMSG */
DCL &BIBPGM *CHAR 010 /* Bibliothèque du programme */
DCL &NOMPGM *CHAR 010 /* Nom du programme */
DCL &NOMFIC *CHAR 10 /* Nom du fichier */
DCL &CMDLTF *CHAR 256 /* Commande distante DLTF */
DCLF LISTFIC /* Permettra de lire le fichier dans ce CL */
/* Récupère le nom du CL en cours et sa bibliothèque */
SNDPGMMSG MSG('TRUCMUCHE') TOPGMQ( *SAME ) KEYVAR( &MSGKEY )
RCVMSG MSGKEY( &MSGKEY ) SENDER( &SENDER )
CHGVAR &NOMPGM (%SST(&SENDER 56 10 ))
CHGVAR &BIBPGM (%SST(&SENDER 78 10 ))
/* Sort une liste des fichiers */
/* Faire le DSPOBJD à la main avant de compiler ce CL */
/* (pas dans QTEMP, la compil en batch ne le verrait pas...) */
DLTF QTEMP/LISTFIC
MONMSG CPF0000
DSPOBJD &BIBIN/*ALL *FILE OUTPUT(*OUTFILE) OUTFILE(QTEMP/LISTFIC)
MONMSG MSGID(CPF2110) EXEC(GOTO CMDLBL(FINFIN))
CRTSAVF QTEMP/SAUVE
MONMSG CPF0000
DLTF QTEMP/LOGFTP
MONMSG CPF0000
/* Par défaut, la bibliothèque de destination a le même nom que */
/* que celle d'origine */
IF COND(&BIBOUT *EQ ' ') THEN(CHGVAR &BIBOUT VALUE(&BIBIN))
/* Boucle de lecture de la liste sortie dans LISTFIC */
LECTURE: RCVF
MONMSG CPF0864 EXEC(GOTO CMDLBL(FIN)) /* DERNIER ENREGISTREMENT */
/* Envoi du fichier */
IF COND(&ODOBAT *EQ 'PF ') THEN(DO)
CHGVAR &NOMFIC &ODOBNM
CALL &BIBPGM/ENVBFIC +
(&BIBIN &SYSTEM2 &BIBOUT &SCRIPT &NOMFIC &BIBPGM &USR &PSW)
/* SQL et RGZ */
SBMJOB CMD(CALL &BIBPGM/ENVBREO +
(&SYSTEM2 &BIBOUT &NOMFIC &BIBPGM &USR &PSW)) +
JOB(&NOMFIC) JOBQ(QBATCH)
ENDDO
GOTO LECTURE
FIN:
/* Suppression finale du fichier SAVF sur le système distant */
CHGVAR VAR(&CMDLTF) VALUE('DLTF FILE(' *TCAT +
&BIBOUT *TCAT '/SAUVE)')
RUNRMTCMD CMD(&CMDLTF) RMTLOCNAME(&SYSTEM2 *IP) +
RMTUSER(&USR) RMTPWD(&PSW)
MONMSG CPF0000
/*PPFM QTEMP/LOGFTP /* VISU DU LOG FTP */
/*NMSG CPF0000 */
DLTF QTEMP/LISTFIC
MONMSG CPF0000
DLTF QTEMP/SAUVE
MONMSG CPF0000
/* *************** ENVOI DES FICHIERS LOGIQUES ******************* */
CALL &BIBPGM/ENVL (&BIBIN &SYSTEM2 &BIBOUT &SCRIPT &USR &PSW)
MONMSG CPF0000
FINFIN: ENDPGM
ENVBFIC est le module de traîtement de chaque fichier sélectionné.
/* Envoi FTP d'un fichier mis dans un SAVF */
/* Avec restauration par la commande RUNRMTCMD */
/* Voir les commentaires en tête du CL ENVB */
/* - PARAMETRES : */
/* - Nom de la bibliothèque lue en entrée */
/* - Nom du systeme de destination */
/* - Nom de la bibliothèque en sortie (facultatif) */
/* - Nom du script FTP */
/* - Nom du fichier traîté */
/* - Nom de la bibliothèque des CL et scripts */
/* - Nom de l'utilisateur commun aux deux systèmes */
/* - Mot de passe commun aux deux systèmes */
PGM (&BIBIN &SYSTEM2 &BIBOUT &SCRIPT &NOMFIC &BIBPGM &USR &PSW)
DCL &BIBIN *CHAR 10
DCL &SYSTEM2 *CHAR 10
DCL &BIBOUT *CHAR 10
DCL &SCRIPT *CHAR 10
DCL &NOMFIC *CHAR 10
DCL &BIBPGM *CHAR 10
DCL &USR *CHAR 10
DCL &PSW *CHAR 10
DCL &CMDRST *CHAR 256 /* Commande distante RSTOBJ */
CLRSAVF QTEMP/SAUVE
MONMSG CPF0000
/* Fichier mis dans un SAVF. *SYNCLIB = sauvegarde en MAJ */
SAVOBJ OBJ(&NOMFIC) LIB(&BIBIN) DEV(*SAVF) +
OBJTYPE(*FILE) SAVF(QTEMP/SAUVE) +
SAVACT(*SYSDFN ) ACCPTH(*NO ) DTACPR(*YES)
MONMSG CPF3770 EXEC(DO)
RETURN
ENDDO
/* Traîtement d'envoi par FTP */
CALL &BIBPGM/ENVBFTP (&SYSTEM2 &BIBOUT &BIBPGM &SCRIPT)
/* Restauration sur le système distant */
CHGVAR VAR(&CMDRST) VALUE('RSTOBJ OBJ(*ALL) SAVLIB(' +
*TCAT &BIBIN *TCAT ') DEV(*SAVF) SAVF(' *TCAT &BIBOUT +
*TCAT '/SAUVE) RSTLIB(' *TCAT &BIBOUT *TCAT ') MBROPT(*ALL)')
RUNRMTCMD CMD(&CMDRST) RMTLOCNAME(&SYSTEM2 *IP) +
RMTUSER(&USR) RMTPWD(&PSW)
MONMSG CPF0000
DLTSPLF QSYSPRT SPLNBR(*LAST) /* MENAGE SPOOL */
MONMSG CPF0000
ENDPGM
ENVBFTP est le CL chargé de la copie par FTP.
/* Transfert de fichier par FTP */ PGM (&SYSTEM2 &BIBOUT &BIBPGM &SCRIPT) DCL &SYSTEM2 *CHAR 10 /* Système de destination */ DCL &BIBOUT *CHAR 10 /* Bibliothèque en sortie */ DCL &BIBPGM *CHAR 10 /* Bibliothèque du CL */ DCL &SCRIPT *CHAR 10 /* Script à utiliser */ DLTOVR INPUT MONMSG CPF0000 DLTOVR OUTPUT MONMSG CPF0000 CRTSRCPF QTEMP/LOGFTP 128 /* Créé fichier LOG */ MONMSG CPF0000 OVRDBF INPUT &BIBPGM/QCLSRC &SCRIPT /* Nom du script FTP */ OVRDBF OUTPUT QTEMP/LOGFTP LOGFTP /* Redirige la sortie LOG */ FTP &SYSTEM2 /* LANCE LE TRANSFERT */ DLTOVR INPUT MONMSG CPF0000 DLTOVR OUTPUT MONMSG CPF0000 ENDPGM
Ci-dessous le script FTP. Selon l’OVRDBF supra, il s’agit d’un membre source de type TXT dans QCLSRC. On adaptera le nom d’utilisateur et son mot de passe dans la première ligne. Dans la seconde il conviendra de spécifier la bibliothèque de réception. Ce sera la seule différence entre les différentes versions de scripts qu’on pourra être amené à créer.
[USERID] [MOTDEPASSE] CD [bibliothèque sortie] LCD QTEMP QUOTE RCMD CRTSAVF SAUVE QUOTE RCMD CLRSAVF SAUVE BINARY PUT QTEMP/SAUVE QUIT
ENVBREO est le module chargé de la purge et réorganisation des fichiers physiques sur le système éloigné.
/* REORGANISATION A DISTANCE */
/* - PARAMETRES : */
/* - Nom du systeme de destination */
/* - Nom de la bibliothèque en sortie */
/* - Nom du fichier traîté */
/* - Nom de la bibliothèque des CL et scripts */
/* - Nom de l'utilisateur commun aux deux systèmes */
/* - Mot de passe commun aux deux systèmes */
PGM (&SYSTEM2 &BIBOUT &NOMFIC &BIBPGM &USR &PSW)
DCL &SYSTEM2 *CHAR 10
DCL &BIBOUT *CHAR 10
DCL &NOMFIC *CHAR 10
DCL &BIBPGM *CHAR 10
DCL &USR *CHAR 10
DCL &PSW *CHAR 10
DCL &CMDSQL *CHAR 256 /* Commande distante RUNSQLSTM */
DCL &CMDRGZ *CHAR 256 /* Commande distante RGZPFM */
/* Lancement à distance du SQL de purge */
CHGVAR &CMDSQL +
VALUE('RUNSQLSTM SRCFILE(' *TCAT &BIBPGM *TCAT +
'/QCLSRC) SRCMBR(' *TCAT &NOMFIC *TCAT ') COMMIT(*NONE)')
RUNRMTCMD CMD(&CMDSQL) RMTLOCNAME(&SYSTEM2 *IP) +
RMTUSER(&USR) RMTPWD(&PSW)
MONMSG CPF0000
DLTSPLF QSYSPRT SPLNBR(*LAST) /* MENAGE SPOOL */
MONMSG CPF0000
/* Réorg du fichier sur système distant */
CHGVAR &CMDRGZ VALUE('RGZPFM FILE(' *TCAT +
&BIBOUT *TCAT '/' *TCAT &NOMFIC *TCAT ')')
RUNRMTCMD CMD(&CMDRGZ) RMTLOCNAME(&SYSTEM2 *IP) +
RMTUSER(&USR) RMTPWD(&PSW)
MONMSG CPF0000
DLTSPLF QSYSPRT SPLNBR(*LAST) /* MENAGE SPOOL */
MONMSG CPF0000
ENDPGM
Exemples de script SQL de purge
Suppression d’enregistrements datés de plus de deux ans.
DELETE FROM BIBLIO/CMDESENTET WHERE ETDDAT <
'20'!!SUBSTR(CHAR(CURRENT DATE- 2 YEAR), 7, 2)
!!SUBSTR(CHAR(CURRENT DATE- 2 YEAR), 4, 2)
!!SUBSTR(CHAR(CURRENT DATE- 2 YEAR), 1, 2)
Suppression d’enregistrements correspondant à un code inexistant dans un autre fichier.
DELETE FROM BIBLIO/CMDESDET WHERE NOT EXISTS (SELECT CLINUM FROM BIBLIO/FICREF WHERE CLINUM=OFCNUMD)