Moderniser votre code RPG avec Agilité – Partie 3
lun 6 juillet 2020Pour certaines spécifications autres que C(Calculation), il existe un outil développé, parmi plein d’autres, par Craig Rutledge et que Thomas Raddatz a complété avec un plugin pour Rdi afin d’y faciliter son utilisation.
Cette outil s’appelle JCRHFD et transforme les spécifications H, F et D « colonné » en free-form.
- H en Ctl-opt
- F en Dcl‑F
- D en Dcl‑D
La commande JCRHFD demande les paramètres du membre source en entrée et du nouveau source en sortie.
L’aide fournit par Craig en français :
Lit le source RPGLE sélectionné et génère un nouveau membre source avec Les spécifications H, F et D converties en format libre.
Règles de conversions :
- CLASS, DATFMT, PROCPTR et TIMFMT sont convertis en type de données extensions.
- Le mot-clé VARYING a été supprimé et le type de données VARCHAR est utilisé.
- *NEXT est supprimé si le mot-clé OVERLAY contient un nom de structure de données.
- DS LEN n’est pas autorisé avec EXTNAME. Cela nécessite le changement de EXTNAME.
- *DELETE est ajouté au mot clé USAGE si un enregistrement est supprimé dans la procédure principale ou dans une sous-procédure.
- La taille des singes + ou – fait désormais partie de l’extension du type de données, Packed(1 : +2).
- L’UDS exige la DTAARA{{(nom)} {*AUTO}. Le format fixe autorise IN et OUT avec UDS. Il faut changer *AUTO en *USERCTL si on utilise ces codes opération.
- Les noms de DATA AREA sont entre quotes et écrits en majuscules.
- Le modificateur *VAR de déclaration de DATA AREA est supprimé. Ils ne seront ni entre quotes ni en majuscules.
- Les lignes de suite (+ et -) sont reformatées selon que les mots clés sont élargi/supprimé.
- Les fichiers décrits dans le programme avec l’EADD sur la sortie doit être E seulement après conversion.
- Les noms externes et les formats d’enregistrement sont entre quotes.
dcl-ds ScreenFieldDS extname(JCRFFDF) end-ds ; n’est pas valable sauf si JCRFFDF est une constante ou un nom de champ défini. - Suppression de toutes les déclarations /free et /end-free.
- Les spécifications H avec des directives de compilateur intégrées ne seront pas converties.
- Revoir les directives intégrées du compilateur dans le membre source avant conversion. Supprimez toutes les directives sur la version du système d’exploitation car après la conversion cela ne fonctionnera que sur v7 et supérieur. Les source avec des directives intégrées devrait être réexaminé après la conversion, car le convertisseur ne tient pas compte des directives.
- Si des constantes, inz ou *java sont plus longs que 2048, remplacer 2048 dans le source jcrhfdr et modifier la taille de la dernière variable dans FspecDS de JCRCMDSCPY avant de recompiler jcrgetfilr et jcrhfdr
Sour Rdi, on peut utiliser la fonction sur le source directement ouvert en édition dans Lpex , l’option se trouve à cet emplacement :
Avec le source de gestion de liste du personnel présent dans le précédent billet, cela donne :
ctl-opt debug decedit('0,') datedit(*dmy.);
//*********************************************************************
// CC 01/01/2009
// Liste du personnel
//*********************************************************************
// Déclaration des fichiers
dcl-f PGMF01FM workstn sfile(sfl01 :wran01) infds(dssfl1);
dcl-f FIC02L keyed infds(fic);
// Déclaration des variables
dcl-s WDAT char(8);
dcl-s WHEU char(6);
dcl-s W14 packed(14);
dcl-s WSNOM char(35);
dcl-s WSNOP char(35);
dcl-s I packed(3);
// La DS du programme, noter le S indispensable
dcl-ds DSPROG PSDS;
WNPROG char(10) pos(1);
WSTATP zoned(5) pos(11);
WSTAPR zoned(5) pos(16);
WSQSRC char(8) pos(21);
WSBROU char(8) pos(29);
WNPARM zoned(3) pos(37);
WTYEXC char(3) pos(40);
WNMSGM char(7) pos(40);
WNMEXC char(4) pos(43);
WINSMC char(4) pos(47);
WZOMSG char(30) pos(51);
WLBPGM char(10) pos(81);
WSFDTA char(80) pos(91);
WCDERR char(4) pos(171);
WLSFIL char(8) pos(201);
WLSINF char(35) pos(209);
WJOB char(10) pos(244);
WUSER char(10) pos(254);
WNJOB zoned(6) pos(264);
end-ds;
// La DS du sous=fichier
dcl-ds DSSFL1;
WPOSC int(5) pos(370);
WRRNG int(5) pos(376);
WRNGP int(5) pos(378);
WNBRSF int(5) pos(380);
end-ds;
// La DS du fichier
dcl-ds FIC;
WNRC01 int(10) pos(397);
end-ds;
dcl-ds WDSFIC;
WCDFIL char(8) pos(1);
WOPENF char(1) pos(9);
WSTSFI zoned(5) pos(11);
WOPCOD char(6) pos(16);
WRPGSQ char(8) pos(30);
WRPGNR char(8) pos(38);
WERRFI char(7) pos(46);
WNFICH char(10) pos(83);
WNLIBR char(10) pos(93);
WSPNAM char(10) pos(103);
WSPLIB char(10) pos(113);
WSPNUM int(5) pos(123);
WLIMBR char(10) pos(129);
WNBPUT int(10) pos(243);
WNBGET int(10) pos(247);
WNBPG int(10) pos(251);
WNBIO int(10) pos(255);
WRCDFT char(10) pos(261);
WNBRCD int(10) pos(283);
WNRCFI int(10) pos(397);
end-ds;
// la clé d'accés au fichier
C KEY001 KLIST
C KFLD FIFON
C KFLD FINOM
// le nombre de lignes afichables, déclaration a la volée
C Z-ADD 14 NBLIS1 4 0
// initialisation des variables générales
C MOVEL WNPROG ZPGM
EXSR DATHEU;
C MOVE WDAT ZDATE
C MOVE WHEU ZHEUR
C MOVEL WUSER ZUSER
C MOVEL WJOB ZJOB
// Initialisation du sous=fichier des messages
C MOVEL '* ' WPGMQ
C MOVEL 'CC01' WMGKEY
*IN09 = *ON;
*IN10 = *ON;
// Indicateur fin
*IN50 = *ON;
// Debut du traitement,
EXSR INITSF;
// Boucle d'attente de sortie
DOW *IN50 = '1';
EXSR TRTSFL;
ENDDO;
// Indicateur de fin de programme
*INLR = *ON;
// Les procédures
// Traitement de l'écran
BEGSR TRTSFL;
// Effacement du sous=fichier de messages
C MOVEL '3' PTYP
C MOVEL *BLANK PFIM
C MOVEL *BLANK PMID
C CALL 'PGM001CL'
C PARM PTYP 1
C PARM PFIM 10
C PARM PMID 7
C PARM PMDT 99
WRITE WSFCTL;
// Ecriture de l'écran
*IN04 = *ON;
*IN05 = *ON;
WRITE FORE1;
*IN70 = %EOF;
WRITE FORB1;
// Attente lecture
READ FORE1;
*IN70 = %EOF;
// Une touche a été actionnée
// Chargement de l'heure
C TIME ZHEUR
// Indicateur pour ne pas tester d'autres actions
*IN51 = *ON;
IF *IN02 = '1';
// page suivante
EXSR CHGPAG;
*IN51 = *OFF;
ENDIF;
//
C 51 IF WSNOP <> ZSNOM
// Test si selection/ si changé on initialise
EXSR INITSF;
*IN51 = *OFF;
ENDIF;
// touches F3 et F12
IF *INKC = '1' OR
*INKL = '1';
// on met l'indicateur à Off = fin du programme
*IN50 = *OFF;
*IN51 = *OFF;
ENDIF;
//
IF *INKE = '1';
// F5 Rafraichissement de l'écran
EXSR INITSF;
*IN51 = *OFF;
ENDIF;
//
IF *INKF = '1';
// F6 création d'un nouveau matricule
C MOVEL 'CR' PCHX
C MOVEL *BLANK NREC
C CALL 'PGMF02'
C PARM PCHX 2
C PARM NREC 10
EXSR INITSF;
*IN51 = *OFF;
ENDIF;
IF *INKH = '1';
// F8 impression du fichier
C MOVEL *BLANK PMAT
// On appelle le CL de routage sans soumission, sinon PGMF20CL
C CALL 'PGMF2SCL'
C PARM PMAT 10
*IN51 = *OFF;
ENDIF;
// On ne fait ceci que s'il n'y a eu rien d'autre
IF *IN51 = '1';
EXSR TRTOPT;
ENDIF;
// On recommence la boucle d'attente
ENDSR;
// Initialisation du sous-fichier
BEGSR INITSF;
// l'indicateur 20 conditionne la zone OPT (protection)
*IN20 = *OFF;
// Initialisation de la variable de sélection
C MOVEL ZSNOM WSNOP
C MOVEL *BLANK WSNOM
// Initialisation de la clé pour positionnement
C MOVEL *BLANK FIFON
C MOVEL *BLANK FINOM
*IN84 = *OFF;
*IN85 = *OFF;
IF ZSNOM <> *BLANK;
// Si différent de blank il y a selection
*IN84 = *ON;
C Z-ADD 0 I
C '*' SCAN ZSNOM I 85
IF I > 0;
C I SUB 1 I
C I SUBST (P) ZSNOM:1 WSNOM 90
// On est dans le cas d'une sélection générique
*IN85 = *ON;
// On se positionnera juste au bon endroit dans le fichier
C MOVEL WSNOM FINOM
ENDIF;
ENDIF;
// La dernière ligne écrite
C Z-ADD 0 LSTLIG 4 0
// Le compteur de ligne par page
C Z-ADD 0 NBRLIG 4 0
// Le fameux WRAN01
C Z-ADD 0 WRAN01 4 0
// Effacement du sous=fichier
*IN06 = *ON;
*IN07 = *ON;
*IN04 = *OFF;
*IN05 = *OFF;
WRITE FORE1;
*IN06 = *OFF;
*IN04 = *ON;
*IN05 = *ON;
// Positionnement en début de fichier
SETLL KEY001 FICF;
*IN70 = %EQUAL;
// Chargement de la première page
EXSR CHGPAG;
ENDSR;
// Traitement des options, on ne lit que les enregistrements modifiés
BEGSR TRTOPT;
// Lecture des enregistrements modifiés
C Z-ADD 1 WRAN01
// Top pour rafraichir l'écran, si besoin
*IN86 = *OFF;
C N70 READC SFL01 7070
//
DOW *IN70 = '0';
C MOVE HNREC NREC
IF HTOUT = '1';
IF ZOPT='2' OR ZOPT='3' OR ZOPT='4' OR ZOPT='99';
// Si l'employé à quitté on ne peut plus rien modifier
C MOVE '5 ' ZOPT
ENDIF;
ENDIF;
*IN85 = *ON;
// Selection en fonction du choix saisi
SELECT;
WHEN (ZOPT = '2') OR (ZOPT = ' 2');
C MOVEL 'MO' PCHX
WHEN (ZOPT = '3') OR (ZOPT = ' 3');
C MOVEL 'CO' PCHX
WHEN (ZOPT = '4') OR (ZOPT = ' 4');
C MOVEL 'SU' PCHX
WHEN (ZOPT = '5') OR (ZOPT = ' 5');
C MOVEL 'AF' PCHX
WHEN (ZOPT = '6') OR (ZOPT = ' 6');
C MOVE HMATR PMAT
C CALL 'PGMF2SCL'
C PARM PMAT 10
*IN85 = *OFF;
WHEN (ZOPT = '99');
C MOVEL 'PE' PCHX
OTHER;
// La saisie ne correspond à rien
*IN85 = *OFF;
// Envoyer un message pour dire que l'option n'existe pas
C MOVEL '1' PTYP
C MOVEL 'FICMSG ' PFIM
C MOVEL 'MSG0002' PMID
C CALL 'PGM001CL'
C PARM PTYP 1
C PARM PFIM 10
C PARM PMID 7
C PARM PMDT 99
ENDSL;
IF HTOUT = '0';
// Pour ne pas perdre l'attribut couleur
*IN30 = *OFF;
ELSE;
*IN30 = *ON;
ENDIF;
// Nettoyage
C MOVEL *BLANK ZOPT
UPDATE(E) SFL01;
*IN90 = %ERROR;
// On aurait pu aussi faire IF..., en tout cas le choix est bon
C 85 CALL 'PGMF02'
C PARM PCHX 2
C PARM NREC 10
C 85 SETON 86
// On continue de boucler si autre option
READC(E) SFL01;
*IN70 = %ERROR OR %EOF;
ENDDO;
// Potentiellement il y a eu mise à jour, on pourrait affiner
C 86 EXSR INITSF
ENDSR;
// Chargement d'une page
BEGSR CHGPAG;
// Il faut positionner correctement les indicateurs et les variables
*IN08 = *OFF;
// SETON 04
C Z-ADD LSTLIG WRAN01
// Lexture de l'enregistrement suivant
READ FICF;
*IN70 = %EOF;
// Remise à zéro du compteur de ligne, mais on pourrait faire autrement
C Z-ADD 0 NBRLIG 4 0
//
DOW *IN70 = '0'
AND NBRLIG < 14;
// Remplissage des zones écran
*IN86 = *ON;
// Test s il y a selection
IF *IN84 = '1' OR *IN85 = '1';
IF *IN84 = '1' AND *IN85 = '0';
// On recherche la stricte égalité de nom
IF FINOM <> ZSNOM;
*IN86 = *OFF;
ENDIF;
ELSE;
// On recherche si le nom commence par la valeur avant le '*'
C I SUBST (P) FINOM:1 WXNOM 35 90
// Petite entorse de flemmard WXNOM est déclarée au fil de l'eau
IF WXNOM <> WSNOM;
*IN86 = *OFF;
ENDIF;
ENDIF;
ENDIF;
// L'indicateur est à '1' si sélection OK ou pas de sélection
IF *IN86 = '1';
C MOVEL FINOM ZNOM
C MOVEL FIPR1 ZPR1
C MOVEL FIFON ZFONC
C Z-ADD FIMAT ZMATR
C MOVEL FICPO ZCPO
C MOVEL FIC WDSFIC
C Z-ADD WNRCFI HNREC
C MOVE FIMAT HMATR
IF FIDAS = 0;
// Top salarié licencié
C MOVE '0' HTOUT
*IN30 = *OFF;
ELSE;
C MOVE '1' HTOUT
*IN30 = *ON;
ENDIF;
// Les compteurs, attention au WRAN01
C ADD 1 NBRLIG
C ADD 1 LSTLIG
C ADD 1 WRAN01
// Ecriture de la ligne
WRITE SFL01;
ENDIF;
// Lecture du suivant
READ FICF;
*IN70 = %EOF;
ENDDO;
// On quitte la boucle soit en fin de page
// soit en fin de fichier
IF *IN70 = '1';
// Le caractère de suite, on est en fin de fichier
*IN07 = *ON;
ELSE;
*IN07 = *OFF;
ENDIF;
// Si le fichier est vide
IF WRAN01 = 0;
C Z-ADD 1 NBRLIG
C Z-ADD 1 LSTLIG 4 0
// Un petit message
C Z-ADD 1 WRAN01
// Pas de saisie d'option
*IN20 = *ON;
IF ZSNOM = *BLANK;
// Si on a un vieil AS400 du siècle dernier
C MOVEL 'Fic. Vide' ZNOM
ELSE;
// En RPG ILE
ZNOM = 'Sélection Vide';
ENDIF;
// Ne pas oublier de remettre à blanc
C MOVEL *BLANK ZPR1
C MOVEL *BLANK ZFONC
C Z-ADD 0 ZMATR
C MOVEL *BLANK ZCPO
C MOVEL *BLANK WDSFIC
C Z-ADD 0 HNREC
// Ecriture du message sur la première ligne
WRITE SFL01;
ENDIF;
// le WRAN01 à 1 pour afficher le premier enregistrement
// Z-ADD LSTLIG WRAN01
ENDSR;
// Lecture date et heure systeme
BEGSR DATHEU;
C TIME W14
C MOVE W14 WDAT
C MOVEL W14 WHEU
ENDSR; 
[…] Moderniser votre code RPG avec Agilité – Partie 3 […]
[…] Moderniser votre code RPG avec Agilité – Partie 3 […]