Le web de Dominique Guebey – IBM AS/400 iSeries

Page : http://www.dg77.net/tekno/as400/as400ftp.htm


   D o m i n i q u e   G u e b e y    J u n g l e     IBM AS/400 iSeries

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 :

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)