zOs/REXX/IFICOM

/* REXX */                                                              00010000
/*                                                              */      00020000
/* Sample DB2 Stored procedure, as described in                 */      00030000
/* Application Programming Guide                                */      00040000
/*                                                              */      00050000
/* SP executes DB2 Command via the IFI Interface                */      00060000
/*                                                              */      00070000
/* 'CALLRX01' in A979074.TSO.EXEC is a sample caller program    */      00080000
/*            for SP 'COMMAND'                                  */      00090000
/* 'CPROCX01' in A979074.RZ1.SPUFI.CNTL contains Proc Definition*/      00100000
/*                                                              */      00110000
/* CREATE PROCEDURE SYSPROC.COMMAND                             */      00120000
/*   (IN  CMDTEXT VARCHAR(254),                                 */      00130000
/*    OUT CMDRESULT VARCHAR(32704))                             */      00140000
/*   LANGUAGE REXX                                              */      00150000
/*   EXTERNAL NAME COMMAND                                      */      00160000
/*   NO COLLID                                                  */      00170000
/*   ASUTIME NO LIMIT                                           */      00180000
/*   PARAMETER STYLE GENERAL                                    */      00190000
/*   STAY RESIDENT NO                                           */      00200000
/*   RUN OPTIONS 'TRAP(ON)'                                     */      00210000
/*   WLM ENVIRONMENT DB2DSNR                                    */      00220000
/*   SECURITY DB2                                               */      00230000
/*   DYNAMIC RESULT SETS 1                                      */      00240000
/*   COMMIT ON RETURN NO                                        */      00250000
/*   ;                                                          */      00260000
/*                                                              */      00270000
/*                                                              */      00280000
/*                                                              */      00290000
PARSE UPPER ARG CMD /* Get the DB2 command text */                      00300000
                                                                        00310000
/* Remove enclosing quotes */                                           00320000
IF LEFT(CMD,2) = ""'" & RIGHT(CMD,2) = "'"" THEN                        00330000
   CMD = SUBSTR(CMD,2,LENGTH(CMD)-2)                                    00340000
ELSE                                                                    00350000
   IF LEFT(CMD,2) = """'" & RIGHT(CMD,2) = "'""" THEN                   00360000
      CMD = SUBSTR(CMD,3,LENGTH(CMD)-4)                                 00370000
                                                                        00380000
COMMAND = SUBSTR("COMMAND",1,18," ")                                    00390000
                                                                        00400000
say time(NORMAL)': Executing Command 'cmd                               00410000
                                                                        00420000
/****************************************************************/      00430000
/* Set up the IFCA, return area, and output area for the        */      00440000
/* IFI COMMAND call.                                            */      00450000
/****************************************************************/      00460000
IFCA = SUBSTR('00'X,1,180,'00'X)                                        00470000
IFCA = OVERLAY(D2C(LENGTH(IFCA),2),IFCA,1+0)                            00480000
IFCA = OVERLAY("IFCA",IFCA,4+1)                                         00490000
RTRNAREASIZE = 262144 /*1048572*/                                       00500000
RTRNAREA = D2C(RTRNAREASIZE+4,4)LEFT(' ',RTRNAREASIZE,' ')              00510000
OUTPUT = D2C(LENGTH(CMD)+4,2)||'0000'X||CMD                             00520000
BUFFER = SUBSTR(" ",1,16," ")                                           00530000
                                                                        00540000
                                                                        00550000
/****************************************************************/      00560000
/* Make the IFI COMMAND call.                                   */      00570000
/****************************************************************/      00580000
ADDRESS LINKPGM "DSNWLIR COMMAND IFCA RTRNAREA OUTPUT"                  00590000
WRC = RC                                                                00600000
RTRN= SUBSTR(IFCA,12+1,4)                                               00610000
REAS= SUBSTR(IFCA,16+1,4)                                               00620000
TOTLEN = C2D(SUBSTR(IFCA,20+1,4))                                       00630000
                                                                        00640000
                                                                        00650000
/****************************************************************/      00660000
/* Set up the host command environment for SQL calls.           */      00670000
/****************************************************************/      00680000
"SUBCOM DSNREXX" /* Host cmd env available? */                          00690000
IF RC THEN /* No--add host cmd env */                                   00700000
S_RC = RXSUBCOM('ADD','DSNREXX','DSNREXX')                              00710000
                                                                        00720000
                                                                        00730000
/****************************************************************/      00740000
/* Set up SQL statements to insert command output messages      */      00750000
/* into a temporary table.                                      */      00760000
/****************************************************************/      00770000
SQLSTMT='INSERT INTO SYSIBM.SYSPRINT(SEQNO,TEXT) VALUES(?,?)'           00780000
                                                                        00790000
ADDRESS DSNREXX "EXECSQL DECLARE C1 CURSOR FOR S1"                      00800000
IF SQLCODE <> 0 THEN CALL SQLCA                                         00810000
                                                                        00820000
ADDRESS DSNREXX "EXECSQL PREPARE S1 FROM :SQLSTMT"                      00830000
IF SQLCODE <> 0 THEN CALL SQLCA                                         00840000
                                                                        00850000
                                                                        00860000
/****************************************************************/      00870000
/* Extract messages from the return area and insert them into   */      00880000
/* the temporary table.                                         */      00890000
/****************************************************************/      00900000
SEQNO = 0                                                               00910000
OFFSET = 4+1                                                            00920000
DO WHILE ( OFFSET < TOTLEN )                                            00930000
   LEN = C2D(SUBSTR(RTRNAREA,OFFSET,2))                                 00940000
   SEQNO = SEQNO + 1                                                    00950000
   TEXT = SUBSTR(RTRNAREA,OFFSET+4,LEN-4-1)                             00960000
   ADDRESS DSNREXX "EXECSQL EXECUTE S1 USING :SEQNO,:TEXT"              00970000
   IF SQLCODE <> 0 THEN CALL SQLCA                                      00980000
   OFFSET = OFFSET + LEN                                                00990000
END                                                                     01000000
                                                                        01010000
                                                                        01020000
/****************************************************************/      01030000
/* Set up a cursor for a result set that contains the command   */      01040000
/* output messages from the temporary table.                    */      01050000
/****************************************************************/      01060000
                                                                        01070000
SQLSTMT='SELECT SEQNO,TEXT FROM SYSIBM.SYSPRINT ORDER BY SEQNO'         01080000
ADDRESS DSNREXX "EXECSQL DECLARE C2 CURSOR FOR S2"                      01090000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01100000
                                                                        01110000
ADDRESS DSNREXX "EXECSQL PREPARE S2 FROM :SQLSTMT"                      01120000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01130000
                                                                        01140000
                                                                        01150000
/****************************************************************/      01160000
/* Open the cursor to return the message output result set to   */      01170000
/* the caller.                                                  */      01180000
/****************************************************************/      01190000
ADDRESS DSNREXX "EXECSQL OPEN C2"                                       01200000
IF SQLCODE <> 0 THEN CALL SQLCA                                         01210000
                                                                        01220000
                                                                        01230000
S_RC = RXSUBCOM('DELETE','DSNREXX','DSNREXX') /* REMOVE CMD ENV */      01240000
EXIT SUBSTR(RTRNAREA,1,TOTLEN+4)                                        01250000
                                                                        01260000
                                                                        01270000
/****************************************************************/      01280000
/* Routine to display the SQLCA                                 */      01290000
/****************************************************************/      01300000
SQLCA:                                                                  01310000
SAY 'SQLCODE ='SQLCODE                                                  01320000
SAY 'SQLERRMC ='SQLERRMC                                                01330000
SAY 'SQLERRP ='SQLERRP                                                  01340000
                                                                        01350000
SAY 'SQLERRD ='SQLERRD.1',',                                            01360000
|| SQLERRD.2',',                                                        01370000
|| SQLERRD.3',',                                                        01380000
|| SQLERRD.4',',                                                        01390000
|| SQLERRD.5',',                                                        01400000
|| SQLERRD.6                                                            01410000
                                                                        01420000
SAY 'SQLWARN ='SQLWARN.0',',                                            01430000
|| SQLWARN.1',',                                                        01440000
|| SQLWARN.2',',                                                        01450000
|| SQLWARN.3',',                                                        01460000
|| SQLWARN.4',',                                                        01470000
|| SQLWARN.5',',                                                        01480000
|| SQLWARN.6',',                                                        01490000
|| SQLWARN.7',',                                                        01500000
|| SQLWARN.8',',                                                        01510000
|| SQLWARN.9',',                                                        01520000
|| SQLWARN.10                                                           01530000
                                                                        01540000
SAY 'SQLSTATE='SQLSTATE                                                 01550000
SAY 'SQLCODE ='SQLCODE                                                  01560000
EXIT 'SQLERRMC ='SQLERRMC';' ,                                          01570000
|| 'SQLERRP ='SQLERRP';' ,                                              01580000
|| 'SQLERRD ='SQLERRD.1',',                                             01590000
|| SQLERRD.2',',                                                        01600000
|| SQLERRD.3',',                                                        01610000
|| SQLERRD.4',',                                                        01620000
|| SQLERRD.5',',                                                        01630000
|| SQLERRD.6';' ,                                                       01640000
|| 'SQLWARN ='SQLWARN.0',',                                             01650000
|| SQLWARN.1',',                                                        01660000
|| SQLWARN.2',',                                                        01670000
|| SQLWARN.3',',                                                        01680000
|| SQLWARN.4',',                                                        01690000
|| SQLWARN.5',',                                                        01700000
|| SQLWARN.6',',                                                        01710000
|| SQLWARN.7',',                                                        01720000
|| SQLWARN.8',',                                                        01730000
|| SQLWARN.9',',                                                        01740000
|| SQLWARN.10';' ,                                                      01750000
|| 'SQLSTATE='SQLSTATE';'                                               01760000
                                                                        01770000
                                                                        01780000