TIPS AS400 IBMi

DSPDTAARA QUSRSYS/QSS1MRI

Votre source a été supprimé?
Comment vérifier si il existe une copie de sauvegarde quelque part sur la machine?

SELECT * FROM syspartitionstat WHERE system_table_member = 'MONSOURCE'

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.

EXCEPT en SQL permet d’extraire les différences entre 2 tables.

Exemple : 2 tables article avec des contenus différents

1) Extraire les lignes de ARTICLE qui ne sont pas dans ARTICLE2 :
SELECT * FROM article
EXCEPT
SELECT * FROM article2
Résultat : Casquette jaune

2) Extraire les lignes de ARTICLE2 qui ne sont pas dans ARTICLE :
SELECT * FROM article2
EXCEPT
SELECT * FROM article
Résultat : Beret noir

3) Il est possible de comparer sur une ou plusieurs colonnes choisies.
Par exemple, extraire les couleurs de ARTICLE2 qui ne sont pas dans ARTICLE :
SELECT couleur FROM article2
EXCEPT
SELECT couleur FROM article
Résultat : noir

A noter, il est possible de comparer 2 fichiers source avec EXCEPT :
1- OVRDBF FILE(SOURCE1) TOFILE(BIB1/QRPGSRC) MBR(PGM1)
2- OVRDBF FILE(SOURCE2) TOFILE(BIB2/QRPGSRC) MBR(PGM2)
3- SELECT * FROM source1 EXCEPT SELECT * FROM source2

1. CRTPF FILE(QTEMP/SPOULE) RCDLEN(132)
2. CPYSPLF FILE(NOM_SPOULE) TOFILE(QTEMP/SPOULE)
3. CPYTOSTMF FROMMBR('/QSYS.LIB/QTEMP.LIB/SPOULE.FILE/SPOULE.MBR') TOSTMF('/home/mon_user/spoule.txt') STMFCCSID(*PCASCII)

Metabase est un outil de visualisation des données sous forme d’un dashboard graphique.
Exemple d’utilisation :

Requêtes utilisées pour cette exemple :
1) % occupation disque
SELECT SYSTEM_ASP_USED FROM qsys2.system_status_info

2) Nombre de travaux intéractifs
SELECT count(*) FROM TABLE(active_job_info()) where job_type=’INT’

3) Nombre de travaux en message
SELECT count(*) FROM TABLE(active_job_info()) WHERE job_status='MSGW'

4) Palmarès du nombre de spoules par utilisateur
SELECT job_user , count(*) AS nombre FROM TABLE(QSYS2.SPOOLED_FILE_INFO(USER_NAME =>'*'))
WHERE job_user'QTCP'
GROUP BY job_user
ORDER BY nombre DESC
LIMIT 10

5) Palmarès des plus gros fichiers
SELECT objlib concat '/' concat objname , objsize
FROM TABLE(QSYS2.OBJECT_STATISTICS('*ALLUSR', 'FILE'))
WHERE objowner NOT LIKE 'Q%' AND objattribute='PF'
ORDER BY objsize DESC LIMIT 15

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;

– Création du savf (par exemple dans qtemp) :
CRTSAVF FILE(QTEMP/MONSAVF)
– Importation du savf depuis l’IFS :
CPYFRMSTMF FROMSTMF('/home/monprofil/monsavf') TOMBR('/qsys.lib/qtemp.lib/monsavf.file') MBROPT(*REPLACE)

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'

SELECT item ,
LISTAGG(TRIM(couleur), ',') WITHIN GROUP(ORDER BY couleur)
AS couleurs
FROM article
GROUP BY item

Explications :
LISTAGG permet de lister dans une colonne les données issues de plusieurs lignes.
LISTAGG(colonne_à_concaténer , 'séparateur') WITHIN GROUP(ORDER BY colonne_de_tri)

Dans l’exemple donné, le SQL transforme le fichier article suivant

en 2 lignes composées de la colonne item et d’une colonne de couleurs séparées par la virgule

Sur une ligne de commande : CALL QCMD

On obtient 4 lignes :

Et pour avoir encore plus grand : F11=Plein écran

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.

CHGTCPDMN + F4

DELETE FROM monfichier a
WHERE RRN(a) NOT IN ( SELECT MAX(RRN(b)) FROM monfichier b
WHERE (a.cle1, a.cle2) = (b.cle1, b.cle2) )

Explications :
La fonction RRN permet de récupérer le numéro d’enregistrement de la ligne.
Le SQL supprime donc les doublons (clé1+clé2 dans l’exemple) qui ne correspondent pas au dernier numéro d’enregistrement.

Si on veut conserver le premier doublon et non le dernier doublon, il faut remplacer MAX par MIN :
DELETE FROM monfichier a
WHERE RRN(a) NOT IN ( SELECT MIN(RRN(b)) FROM monfichier b
WHERE (a.cle1, a.cle2) = (b.cle1, b.cle2) )

Pour simplement chercher les doublons, on peut utiliser :
SELECT * FROM monfichier a
WHERE RRN(a) NOT IN ( SELECT RRN(b) FROM monfichier b
WHERE (a.cle1, a.cle2) = (b.cle1, b.cle2) )

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);