Code:
- **free
- // Select Product QSZSLTPR API
-
- // matching DDL:
- // create function buck.lstprd()
- // returns table
- // ( product_id char(7),
- // product_option char(5),
- // release_level char(6),
- // installed char(1),
- // supported char(1),
- // registration_type char(2),
- // registration_value char(14),
- // description char(132)
- // )
- // language rpgle
- // parameter style db2sql
- // not deterministic
- // reads sql data
- // returns null on null input
- // external action
- // not fenced
- // program type main
- // no final call
- // disallow parallel
- // no scratchpad
- // external name BUCK.LSTPRD
- // cardinality 100;
- //
- // sample usage:
- // select * from table(buck.lstprd()) as prod;
- //
- // documentation at
- // https://www.ibm.com/support/knowledgecenter/ssw_ibm_i_73/apis/qszsltpr.htm
-
- /copy qrpglesrc,stdhspec
-
- /copy qsysinc/qrpglesrc,QSZSLTPR
- /copy qsysinc/qrpglesrc,QUSEC
-
-
- dcl-pr LSTPRD;
- // input parms (none)
-
- // output parms
- prdID char(7);
- prdOpt char(5);
- rlsLvl char(6);
- installed char(1);
- supported char(1);
- registration_type char(2);
- registration_value char(14);
- description char(132);
-
- // input parms null map (none)
-
- // output parms null map
- prdID_null like(IS_NULL);
- prdOpt_null like(IS_NULL);
- rlsLvl_null like(IS_NULL);
- installed_null like(IS_NULL);
- supported_null like(IS_NULL);
- registration_type_null like(IS_NULL);
- registration_value_null like(IS_NULL);
- description_null like(IS_NULL);
-
- // SQL feedback
- sqlstate_out char(5);
- functname varchar(517) const options(*varsize);
- specname varchar(128) const options(*varsize);
- errormsg varchar(70) options(*varsize);
- calltype int(10);
- end-pr;
-
- dcl-pi LSTPRD;
- // input parms (none)
-
- // output parms
- prdID char(7);
- prdOpt char(5);
- rlsLvl char(6);
- installed char(1);
- supported char(1);
- registration_type char(2);
- registration_value char(14);
- description char(132);
-
- // input parms null map (none)
-
- // output parms null map
- prdID_null like(IS_NULL);
- prdOpt_null like(IS_NULL);
- rlsLvl_null like(IS_NULL);
- installed_null like(IS_NULL);
- supported_null like(IS_NULL);
- registration_type_null like(IS_NULL);
- registration_value_null like(IS_NULL);
- description_null like(IS_NULL);
-
- // SQL feedback
- sqlstate_out char(5);
- functname varchar(517) const options(*varsize);
- specname varchar(128) const options(*varsize);
- errormsg varchar(70) options(*varsize);
- calltype int(10);
- end-pi;
-
-
- // work fields
- dcl-c SQL_NORMAL const('00000');
- dcl-c SQL_NODATA const('02000');
- dcl-s IS_NULL int(5) inz(-1);
- dcl-s NOT_NULL int(5) inz(0);
- dcl-s r int(10);
-
-
- dcl-pr sltPrd extpgm('QSZSLTPR');
- prdList like(prdList);
- inpInfo like(inpInfo) const;
- format char(8) const;
- inpList like(inpList) const;
- outInfo like(outInfo);
- errcde like(qusec);
- end-pr;
-
- dcl-s prdList like(QSZS0200) dim(100);
-
- dcl-ds inpInfo qualified;
- nbrrcds int(10);
- nbrprods char(10);
- initial_view char(1);
- allow_exit char(1);
- prdoptions char(10);
- prod char(10);
- rcdsinlist int(10);
- end-ds;
-
- dcl-s inpList char(18) inz(*blanks);
-
- dcl-ds outInfo qualified;
- recsize int(10);
- recsavail int(10);
- action int(10);
- end-ds;
-
-
- // External UDTFs like this get called many times for a given SQL statement
- // once for open (-1)
- // many times each for fetch (0)
- // once for close (1)
- // WE tell the database when we're done by setting the outbound SQLstate
-
- sqlstate_out = SQL_NORMAL;
-
- select;
- when calltype = -1;
- exsr UDTF_open;
- when calltype = 0;
- exsr UDTF_fetch;
- when calltype = 1;
- exsr UDTF_close;
- *inlr = *on;
- endsl;
-
- // No LR until we're really done done.
- return;
-
- //------------------------------------------------------------------
- begsr UDTF_open;
-
- // number of rows retrieved so far
- r = 0;
-
- inpInfo.allow_exit = '1';
- inpInfo.initial_view = '1';
- inpInfo.nbrprods = '*ALL';
- inpInfo.nbrrcds = %elem(prdList);
- inpInfo.prod = '*INSTLD';
- inpInfo.prdoptions = '*ALL';
- inpInfo.rcdsinlist = 0;
-
- QUSBPRV = 0;
- QUSBAVL = 0;
-
- // get the list
- sltPrd(prdList(1): inpInfo: 'PRDS0200': inpList: outInfo: QUSEC);
-
- // if abnormal, forward SQLSTATE to the database manager and quit
- if outInfo.action <> 0;
- sqlstate_out = SQL_NODATA;
- dump(a) 'open()';
- *inlr = *on;
- endif;
-
- endsr;
-
- //------------------------------------------------------------------
- begsr UDTF_fetch;
-
- // get the next record in the array
- r += 1;
- if r > outInfo.recsavail;
- // return to database manager with NODATA set
- // the next call to the UDTF will be to CLOSE
- sqlstate_out = SQL_NODATA;
- return;
- endif;
-
- QSZS0200 = prdList(r);
- prdID = QSZPI03;
- prdOpt = QSZPO05;
- rlsLvl = QSZRL06;
- installed = QSZIF00;
- supported = QSZSF00;
- registration_type = QSZRT00;
- registration_value = QSZRV00;
- description = QSZDT00;
-
- endsr;
-
-
- //------------------------------------------------------------------
- begsr UDTF_close;
- // called by DB2 after we've told it we are at NODATA
- *inlr = *on;
- endsr;
|
|