TIPS AS400 IBMi RPG

Permet de repérer les programmes RPG qui vont planter en erreur de niveau suite à une évolution de la base de données.

1) Lister les références des programmes dans un fichier temporaire :
DSPPGMREF PGM(BIBPGM/*ALL) OUTPUT(OUTFILE) OBJTYPE(*PGM) OUTFILE(QTEMP/LISTEPGM)

2) Croiser les « format level ID » entre la liste des références des programmes et la liste des fichiers
SELECT whlib, whpnam, whlnam, whfnam, whrfnm
FROM qtemp.listepgm
LEFT JOIN sysfiles ON whfnam=system_table_name AND whrfnm=format_name
WHERE whrfsn <> format_level_id
AND system_table_schema IN ('BIBFICHIER1' , 'BIBFICHIER2')

On obtient la liste des programmes de la bibliothèque BIBPGM en erreur de niveau sur les fichiers des bibliothèques BIBFICHIER1 et BIBFICHIER2 :

Il n’y a plus qu’à recompiler le ou les programmes trouvés (dans l’exemple BIBPGM/ADDCUST). La méthode fonctionne aussi pour les PRTF et les DSPF.

Exemple : Lecture de la table utilisateur en filtrant les habitants de PARIS

**FREE
// Déclaration des variables
dcl-s nom char(30);
dcl-s prenom char(30);
dcl-s ville char(20) inz('PARIS');

// Définition du curseur C01
exec sql
  declare C01 cursor for
  select NOM , PRENOM
  from UTILISATEUR
  where VILLE = :ville
  order by NOM , PRENOM;

// Ouverture du curseur 
exec sql
  open C01;

// Boucle de lecture
dow sqlcode = 0;
  exec sql
    fetch C01 into :nom , :prenom ;
  if sqlcode = 0;
    // lecture réussie, je fais mon traitement ici
  endif;
enddo;

// Fermeture du curseur
exec sql
  close C01;

*inlr = *on;
return;

Utilisation de %SCANRPL( from : to : source { : start } )

**FREE
dcl-s chaine varchar(50);
chaine = 'AZ500 IBMi AZ500 IBMi AZ500';
chaine = %SCANRPL('Z5' : 'S4' : chaine); // chaine = 'AS400 IBMi AS400 IBMi AS400'
chaine = %SCANRPL(' IBMi ' : ' ' : chaine); // chaine = 'AS400 AS400 AS400'chaine = %SCANRPL(' ' : '' : chaine); // chaine = 'AS400AS400AS400'

Permet dans un RPG d’identifier son programme appelant. Cela peut servir par exemple pour conditionner certaines actions ou laisser une trace dans un fichier log.

en SQLRPGLE :
dcl-ds N PSDS;
nom_du_pgm CHAR(10) POS(1);
end-ds;
dcl-s appelant char(10);

EXEC SQL
SELECT program_name INTO :appelant
FROM TABLE(stack_info('*'))
WHERE program_name not in (' ' , :nom_du_pgm)
AND ordinal_position <
( SELECT ordinal_position FROM TABLE(stack_info('*')) WHERE
program_name=:nom_du_pgm LIMIT 1)
LIMIT 1;

Explications :
stack_info permet de récupérer la pile de programme en cours. Le SQL proposé identifie dans la pile le programme au dessus du programme en cours.

Permet d’affecter à la variable jour le numéro du jour de la semaine du jour comme suit :
1:Lundi 2:Mardi 3:Mercredi 4:Jeudi 5:Vendredi 6:Samedi 7:Dimanche
(et sans s’appuyer sur un calendrier!)

en SQLRPGLE :
EXEC SQL
SET :jour= (CASE WHEN DAYOFWEEK(CURRENT_DATE) = 1 THEN 7 ELSE DAYOFWEEK(CURRENT_DATE)-1 END);

Explications : la fonction SQL DAYOFWEEK permet de récupérer le numéro de jour d’une date dans sa numérotation anglaise (1:Dimanche 2:Lundi 3:Mardi …) d’où le dayofweek()-1

Free RPG :
dcl-s dateDuJour char(8);
dateDuJour = %char(%date():*ISO0);