RPGLE in i5/OS V5R4
IDEs:
wiki context:
------------------------------------------------------------------------------
C | RPG
----------------------+-------------------------------------------------------
int x | D x 10I 0 VALUE
long x | D x 10I 0 VALUE
long long x | D x 20I 0 VALUE
unsigned int x | D x 10U 0 VALUE
unsigned long x | D x 10U 0 VALUE
unsigned long long x | D x 20U 0 VALUE
double x | D x 8F VALUE
|
short *x | D x 5I 0
int *x | D x 10I 0
long *x | D x 10I 0
long long *x | D x 20I 0
unsigned short *x | D x 5U 0
unsigned int *x | D x 10U 0
unsigned long *x | D x 10U 0
unsigned long long *x | D x 20U 0
float *x | D x 4F
double *x | D x 8F
------------------------------------------------------------------------------
C | RPG
----------------------+-------------------------------------------------------
struct SSS s | D s VALUE LIKE(SSS)
struct SSS *s | D s LIKE(SSS)
TTT t | D t VALUE LIKE(TTT)
TTT *t | D t LIKE(TTT)
char *s | D s * VALUE OPTIONS(*STRING)
|OR D s nA
void *p | D p * VALUE
|OR D s LIKE(SSS)
wchar_t a | D a 1C VALUE
wchar_t a |OR D a 1G VALUE
wchar_t *a | D a nC
wchar_t *a |OR D a nG
------------------------------------------------------------------------------
Java Data Type | ILE RPG Data Type | RPG Definitions
------------------+-----------------------------+-----------------------------
boolean | indicator | N
byte 1 | integer | 3I 0
| character | 1A
byte[] | character length > 1 | nA
| array of character length=1 | 1A DIM(x)
| date | D
| time | T
| timestamp | Z
short | 2-byte integer | 5I 0
char | UCS-2 length=1 | 1C
char[] | UCS-2 length>1 | nC
| array of UCS-2 length=1 | 1C DIM(x)
int | 4-byte integer | 10I 0
long | 8-byte integer | 20I 0
float | 4-byte float | 4F
double | 8-byte float | 8F
any java object | object | O CLASS(x)
any array | array of equivalent type | DIM(x)
------------------------------------------------------------------------------
CALL MYLIB/MYPGM (HELLO)
*-------------------------------------------------------------------------- D action S 10a D testname s 10a C *ENTRY PLIST C PARM testname /free // if you dont pass a parameter, the program cant run monitor; action = %trim(''+testname); on-error; action = ''; endmon; select; when action = 'SC'; exsr search_for_cod_art; OTHER; dsply 'no valid action specified(SC,...)'; endsl; /end-free
uppercase
D U_case C CONST('ABCDEFGHIJKLMNOPQRST- D UVWXYZAEEIOU') D L_Case C CONST('abcdefghijklmnopqrst- D uvwxyzàèéìòù') $$_des = %xlate(l_case:u_case:$$_des);
strpos
D $oo S 5i 0 $oo=%scan(%trim(priceV):$$_des:1); if $oo >= 1; endif;
// itera un'array a per settare un valore all'indice i numrec = %elem(a); for i=1 to numrec; a(i) = val; endfor;
iterare una DS
D CustomerInfo DS QUALIFIED BASED(@) D Name 20A D Address 50A D ProductInfo DS QUALIFIED BASED(@) D Number 5A D Description 20A D Cost 9P 2 D SalesTransaction... D DS QUALIFIED D Buyer LIKEDS(CustomerInfo) D Seller LIKEDS(CustomerInfo) D NumProducts 10I 0 D Products LIKEDS(ProductInfo) D DIM(10) /free TotalCost = 0; for i = 1 to SalesTransation.Numproducts; TotalCost = TotalCost + SalesTransaction.Products (i).Cost; dsply SalesTransaction.Products (i).Cost; endfor; dsply ('Total cost is ' + %char(TotalCost)); /end-free
select/switch
/free Select; When sqlstt='00000'; // row was received, normal ReturnVar=*on; When sqlstt='02000'; // same as %eof, sooner or later this is normal ReturnVar=*off; Other; // alert the troops! ReturnVar=*off; EndSl; return ReturnVar; /end-free
/free MONITOR; OPEN FILE; DOW getNextRecord(); X = X + 1; nameList(X) = name; ENDDO; CLOSE FILE; ON-ERROR 1216; DSPMSG ('Error opening file FILE':%status); RETURN; ON-ERROR 121; DSPMSG ('Array NAME is too small':%status); RETURN; ON-ERROR *ALL; DSPMSG ('Unexpected error':%status); RETURN; ENDMON; // parola chiave *PSSR; // error handling routine begsr *PSSR; o_errmsg='PSSR status:'+%char(%status()); errore=*on; *inlr=*on; return; endsr; *------------------------------------------------------------------------- * PROTOTIPI *------------------------------------------------------------------------- * TODO: gestione degli errori standard d o_err 80a dim(30) d o_errn 3s 0 D set_error PR D msg 80a VALUE /end-free
%status() BIF ritorna un errore numerico, la lista degli errori di sistema si ottien con:
DSPMSGD RANGE(*FIRST *LAST) MSGF(QRNXMSG) DETAIL(*BASIC)
es.
907 Si } verificato un errore di dati decimali
D $cmd s 1000a D exec pr extpgm('QCMDEXC') D cmd 32702a const D cmdlen 15p 5 const $cmd = 'CHGLIBL LIBL(MY_DAT)'; exec($cmd:%len(%trim($cmd)));
D calc_int PR 10I 0 D parm1 5I 0 VALUE * must match the corresponding prototype * (PI is optional if the SubR does not return and does not have any parameters) * Other def of variables, constants and prototypes, are LOCAL definitions * Calc may refer to both local and global definitions * SubR must contain a RETURN operation P calc_int B D calc_int PI 10I 0 D parm1 5I 0 VALUE D Result S 10I 0 /free Result = parm1 +1; return Result; /end-free P E D quote PR 99a VARYING D sql 99a VALUE * ritorna una stringapreparata per SQL P quote B D quote PI 99a VARYING D sql 99a VALUE D $ap C const('''') /free return $ap+%trim(sql)+$ap; /end-free P E
* tabela base: controlla il file specification per sapere il tracciato record Fintct30L uf a e k disk rename(intct0:intct_30) F prefix(t_) D OrdRecKeys ds likerec(intct_30:*key) /free // vantaggi %KDS: sempre aggiornata, tutti i campi disponibili, dimensioni corrette // la DS *key è automaticamente qualified OrdRecKeys.t_tcoage = i_coage; OrdRecKeys.t_tanord = i_anord; OrdRecKeys.t_tnuord = i_nuord; chain(e) %kds(OrdRecKeys) intct_30; if %error; // TODO: report key not found endif; if %found(); if t_tdaord; // ... elabora il record come in fixed endif; endif; /end-free
basic setup
/free exec SQL SET OPTION COMMIT=*NONE, CloSQLCsr =*ENDMOD, DatFmt =*ISO, TimFmt =*ISO, SqlPath=*LIBL /end-free
/free exec SQL SET PATH = system path, php_obj; // PATH is only used to find "programs" but not "data", CURRENT SCHEMA is used for data exec SQL SET CURRENT PATH = *LIBL exec SQL SET PATH = *LIBL // uses the *LIBL for unqualified access exec sql SET OPTION NAMING = *SYS; // you can get only unqualfied access for files within current library exec sql SET OPTION NAMING = *SQL; /end-free
The CURRENT SCHEMA is either the library/schema with the same name as the user profile or is set by executing the SQL Command SET CURRENT SCHEMA.
/free exec sql SET CURRENT SCHEMA = X; /end-free
to access tables outside *LIBL, you need to qualify SQL tables used
SQL operation result:
// The SQLCODE is also set by the database manager after each SQL // statement is executed as follows: // - If SQLCODE = 0 and SQLWARN0 is blank, execution was successful. // - If SQLCODE = 100, no data was found. For example, a FETCH // statement returned no data, because the cursor was positioned // after the last row of the result table. // - If SQLCODE > 0 and not = 100, execution was successful with a warning // - If SQLCODE = 0 and SQLWARN0 = 'W', execution was successful with a warning // - If SQLCODE < 0, execution was not successful Psql_found B D PI N /free return (SQLCOD >= 0) and (SQLCOD<>100); /end-free Psql_found E
select values:
/FREE exec SQL SELECT FName, LName, email INTO :fstname,:lstname,:email FROM contacts WHERE cstnbr = :client FETCH FIRST ROW ONLY; if (SQLSTATE >= '02000'); // Record not found? // NOT FOUND processing here. else; We got it! // FOUND processing here. endif /end-free
/FREE exec sql insert into contacts values(DEFAULT, 'Bob', 'Cozzi', DEFAULT, :email); // IDENTITY_VAL_LOCAL() returns the most recently generated IDENTITY value exec sql VALUES IDENTITY_VAL_LOCAL() INTO :client_id; // modifica seguente exec sql update contacts set FName = 'Bob', LName = 'Cozzi', email = :email where cstnbr = :client_id; /end-free
SQL paginazione con cursore
// ritorna da $pos, $nrows righe exec sql FETCH RELATIVE :$pos FROM C1 FOR :$nrows ROWS INTO :$rs_ec;
SQL lanciare una query e leggere il risultato
embed SQL tutorial
* prototipo D calcTotOrdine PR 8s 2 D inuord 5I 0 VALUE D icocli 6a VALUE * definire all afine della C spec, dopo *PSSR P calcTotOrdine B D calcTotOrdine PI 8s 2 D inuord 5I 0 VALUE D icocli 6a VALUE D* Result S 10I 0 D $rs_row ds OCCURS(1000) INZ QUALIFIED D ipreva 8S 2 D iquaor 5I 0 D $sqlSelectRow S 32000a varying D $nrSelect S 5I 0 D $nRecRead S 5I 0 D $i S 5I 0 D $result S 8s 2 inz(0) /free $sqlSelectRow = ' select xxx, yyyy ' +' from xsxs00f ' +' where ' +' icocli= '+FQ+TCOCLI+FQ +' and inuord='+%char(TNUORD) +' and itipre<>' +FQ + 'A' +FQ ; // TODO: rinomina S4 e C2 exec sql prepare S4 FROM :$sqlSelectRow; if SQLCOD<>0; errore = *on; o_errmsg = 'sql error SQLCOD: '+%char(SQLCOD) ; endif; exec sql DECLARE C2 INSENSITIVE SCROLL CURSOR FOR S4; exec sql OPEN C2; exec sql get diagnostics :$nrSelect = DB2_NUMBER_ROWS; if $nrSelect = 0; exec sql close C2; return 0; endif; exec sql FETCH RELATIVE 1 FROM C2 FOR :$nrSelect ROWS INTO :$rs_row; if SQLCOD<>0; errore = *on; o_errmsg = 'fetch error SQLCOD: '+%char(SQLCOD); endif; exec sql get diagnostics :$nRecRead = ROW_COUNT; // if $n_rec_read <= 0; // o_errmsg = '0 rec found'; // leavesr; // endif; for $i=1 to $nRecRead; %OCCUR($rs_row) = $i; $result += ($rs_row.ipreva * $rs_row.iquaor); endfor; exec sql close C2; return $result; /end-free P E
* per estrarre tutti i campi D $zntcl E DS QUALIFIED OCCURS( 50 ) INZ D EXTNAME( zntcl00f )
SELECT INTO DS**
D $matM2 ds QUALIFIED D des1 70a D des2 70a exec sql select padem1, padem2 into :$MATM2 from MATM200f where key = :var FETCH FIRST ROW ONLY; if SQLCOD<>0; errore = '1'; o_errstr = 'SQL error SQLCOD: '+%char(SQLCOD) ; o_errn = SQLCOD; endif;
per debuggare SQL, controlla risultati della singola operazione
EV SQLCODE // return code EV SQLSTT // stato EV SQLERM // err message // better error message DSPMSGD RANGE(SQL0326) MSGF(QSQLMSG)
call stored procedure:
/free exec SQL SET PATH *LIBL; exec SQL Call SP_MYPROC(:param); /end-free
/copy espande inserisce sorgente nel listato(si vede da joblog) temporaneo da compilare
** copy di prototipi /copy *libl/srccpy,cpy_protxx ** copy di una DS /copy *libl/srccpy,cpy_pssr01 ** copy di una C spec /copy *LIBL/srccpy,cpy_errsql
per proteggere da include multipli dovuti a dipendenze multiple
/IF NOT DEFINED __HTTPAPI_H__ /DEFINE __HTTPAPI_H__ // code goes here /ENDIF /if defined(__HTTPAPI_H__) /eof /endif
la direttiva /include è uguale a /copy ma non funziona con i file .sqlrpgle
"Errore di livello nel file" : ricompilare il programma che accede a un file con una signature vecchia
Causa . . . . . : La procedura RPG MYPGM001 nel programma MYOBJ/MYPGM001 ha ricevuto il messaggio CPF4131 durante l'esecuzione di un'operazione OPEN implicita sul file AABBC30L. Il file effettivo è AABBC30L. Correzione . . . :Controllare la registrazione lavori per una descrizione
It's a record format level check. This means that the record format in the file you are opening does not have the same format level ID that was found when the program was compiled.
You should enter the command DSPFD against the file, near the bottom you'll find the format name and the format identification level and fields count, then enter the command DSPPGMREF against the program that fail, find the format id required, than look at runtime *LIBL of the program and which file it will use, the error says it has a different signature. compile with correct signature or change runtime *LIBL
// verificare errori di compilazione // e vedi quali files con percorso assoluto sono utilizzati WRKSPLF SELECT(*CURRENT *ALL *ALL *ALL *ALL OR*) // job in esebuzione bloccati? // con quale *LIBL gira il programma? WRKUSRJOB USER(PHPWEB) WRKACTJOB job(PHPJOB) // quali files vengono utilizzati dal programma DSPPGMREF PHP_OBJ/MYPROGRAM004 // id formato file, numero campi, lunghezza record dei files coinvolti DSPFD MILIB/MYFILE00L
Partita Iva: 02360450205
Content of this site is licensed under Creative Commons Attribution-Share Alike License.
