Intercepter les erreurs SQL en RPG ile
ven 15 novembre 2019SQL c’est bien MAIS !
En RPG ile, quand une requête SQL se passe mal, le SQLCODE est négatif tout le monde le sait. Cependant dans le cas du code SQL embarqué dans du RPG ile, si le code SQL est inférieur à zéro, le RPG ne peux pas l’intercepter avec un monitor par exemple.
La solution est d’écrire une procédure qui va provoquer une erreur interprétable par les opérations d’interception (Monitor, *PSSR, Exception/error system…).
**FREE
ctl-opt nomain;
ctl-opt datedit(*ymd) decedit('0,');
ctl-opt option(*nodebugio:*srcstmt:*nounref) CCSIDCVT(*LIST);
ctl-opt bnddir('QC2LE');
// API d'information des JOBs
Dcl-pr rtvJobInf EXTPGM('QUSRJOBI');
Receiver char(100) OPTIONS(*VARSIZE); // Receiver variable
RcvLen int(10:0) CONST; // Length of receiver
FmtName char(8) CONST; // Format name
ObjName char(20) CONST; // Object and library
ObjType char(10) CONST; // Object type
// Optional 1
ErrorCode char(32767) OPTIONS(*VARSIZE:*NOPASS); // Error Code
end-pr;
// Job information
dcl-ds jobi0100 LikeDS(JOBI0100_t);
//----------------------------------------------------------------
// QMHSNDPM - send program messages
//----------------------------------------------------------------
dcl-pr QMHSNDPM extpgm('QMHSNDPM');
*n char(7) const; // MessageId
*n char(20) const; // MessageFile
*n char(512) const options(*varsize); // MessageData
*n bindec(9) const; // MessageDataL
*n char(10) const; // MessageType
*n char(128) const options(*varsize); // CallStkEntry
*n bindec(9) const; // CallStkCount
*n char(4) const; // MessageKey
*n char(120) options(*varsize); // ErrApi
end-pr;
// send program message
dcl-ds sndpgmmsg;
msgid char(7) inz('CPF9898');
msgfile char(20) inz('QCPFMSG QSYS ');
msgdataL bindec(9) inz(512);
msgtype char(10) inz('*COMP ');
msgmsgq char(11) inz('* ');
msgstack bindec(9) inz(1);
msgkey char(4);
end-ds;
dcl-s msgdata char(512);
//----------------------------------------------------------------
// sql communication area
//----------------------------------------------------------------
dcl-ds SQLCA;
SQLCAID char(8);
SQLCABC bindec(9);
SQLCODE bindec(9);
SQLERRML bindec(4);
SQLERRMC char(70);
SQLERRP char(8);
SQLERRD char(24);
SQLER1 bindec(9) overlay(sqlerrd:1);
SQLER2 bindec(9) overlay(sqlerrd:5);
SQLER3 bindec(9) overlay(sqlerrd:9);
SQLER4 bindec(9) overlay(sqlerrd:13);
SQLER5 bindec(9) overlay(sqlerrd:17);
SQLER6 char(4) overlay(sqlerrd:21);
SQLWARN char(11);
SQLSTATE char(5);
P_SQLCA char(136) pos(1);
end-ds;
dcl-pr Sleep int(10) extproc('sleep');
*n uns(10) value; // Seconds
end-pr;
dcl-s rc int(10);
//----------------------------------------------------------------
dcl-proc SQLErreur export;
dcl-pi SQLErreur;
pSqlca char(136) const;
pStop ind options( *nopass );
end-pi;
dcl-s wStop ind inz(*on);
Jobi0100.Job = '*';
Jobi0100.IntJobID = *Blanks;
Jobi0100.Status = 'JOBI0100';
if %Parms =2;
wStop = pStop;
endif;
P_SQLCA = pSqlca;
select;
// Erreur détectée
when SQLCODE < 0;
msgtype = '*DIAG';
// cpf message...
If SQLER1 > 0;
msgid = %editw(%dec(SQLER1:7:0):'0 ');
%subst(msgid:1:3) = 'CPF';
else;
// cpd message...
If SQLER2 > 0;
msgid = %editw(%dec(SQLER2:7:0):'0 ');
%subst(msgid:1:3) = 'CPD';
else;
msgid = %editw(%dec(SQLCODE*-1:7:0):'0 ');
%subst(msgid:1:3) = 'SQL';
%subst(msgfile:1:10) = 'QSQLMSG';
EndIf;
EndIf;
// Avertissement
when SQLCODE > 0;
msgid = %editw(%dec(SQLCODE:7:0):'0 ');
%subst(msgid:1:3) = 'SQL';
%subst(msgfile:1:10) = 'QSQLMSG';
// Exécution SQL OK
other;
msgid = 'SQL' + SQLER6;
%subst(msgfile:1:10) = 'QSQLMSG';
endsl;
// message text
If SQLERrml > 0;
msgdata = SQLERrmc;
msgdataL = SQLERrml;
EndIf;
// Retrouve les attributs du Job en cours
rtvJobInf (jobi0100:Jobi0100.BytesRet:Jobi0100.Status:
Jobi0100.Job:Jobi0100.IntJobID:Errapi);
// Job inter-actif ?
If Jobi0100.Type = 'I';
msgtype = '*STATUS';
msgmsgq = '*EXT';
msgstack = 0;
QMHSNDPM (msgid:msgfile:msgdata:msgdataL:msgtype:
msgmsgq:msgstack:msgkey:ErrApi);
rc = sleep(1);
msgtype = '*DIAG';
msgmsgq = '*';
Endif;
// Message d'échappement
If SQLCODE < 0 and wStop;
QMHSNDPM (msgid:msgfile:msgdata:msgdataL:
'*ESCAPE':'*CTLBDY':1:msgkey:ErrApi);
EndIf;
end-proc;Voici ci-dessous les explications sur la procédure utilisée :
- Lignes 9 à 17, nous déclarons le prototype de réception de l’API QUSRJOBI.
- Ligne 20 nous déclarons la DS du format JOBI100 de l’API QUSRJOBI
- Lignes 25 à 35, nous déclarons le prototype de l’API QMHSNDPM qui nous servira en envoyé des messages programme
- Lignes 38 à 46 la DS sndpgmmsg va recueillir les informations relatives à l’erreur SQL interceptée. Elle est initialisé avec le code message CPF9898, puis selon le code SQL reçu, elle sera mise à jour avec des informations supplémentaires.
- Ligne 48 est déclarée la variable msgdata qui reçoit les valeurs qui prennent la place des parties variables du message (SQLERRMC).
- Lignes 54 à 71, SQLCA est déclaré car ce source est déclaré en type RPGILE.
- Lignes 73 à 75 prototype de la procédure sleep qui a pour fonction de faire un délai, comme la commande CL DLYJOB.
- Ligne 80 à 84 déclaration de l’interface procédure, le 1er paramètre contient le SQLCA de la requête que l’on souhaite et qui sera contrôlée pour extraire une erreur éventuelle. Le 2me paremètre indique s’il faut ou non envoyé un message d’échappement en cas de SQLcode négatif, par défaut « oui ».
- Lignes 95 à 123, contrôles des différents niveaux de SQLERR pour déterminer quels type de message (CPF, CPD, SQL) il s’agit. Les numéro de message sont extrait des variables SQLERRx.
- Lignes 125 à 129, on extrait le texte du message.
- Lignes 131 à 143, on affiche un message en cas de travail interactif.
- Lignes 145 à 148, si le SQLcode est négatif et que l’on souhaite une interception de message par le système, on envoi un message d’échappement.
