midrange.com code scratchpad
Name:
SQLRPGLE UDTF
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/12/2019 05:04:23 pm
IP:
Logged
Description:
Part 1 of 2.
Code:
  1. Create Function Retrieve_Program_Information(                       
  2. …
  3. Input parms…
  4. …
  5. )                                            
  6. Returns Table                                                       
  7. (                                                                   
  8. …
  9. )                                                                   
  10. external name 'ROB/UDTF000001(RETRIEVE_PROGRAM_INFORMATION)'  
  11. language rpgle                                                      
  12. parameter style db2sql                                              
  13. not deterministic                                                   
  14. disallow parallel
  15. ;
  16.  
  17. This program, being SQLRPGLE, does have it’s own SQL.  It has a cursor for reading from an IBM service.
  18.   begsr doOpen;
  19.     //
  20.     if object_type = '*ALL' or object_type='ALL';
  21.       object_type_list = '*PGM, *SRVPGM';
  22.     ELSE;
  23.       object_type_list = object_type;
  24.     ENDIF;
  25.     cursor_statement =
  26.      'select objlib, objname, objtype +
  27.       from table(QSYS2.OBJECT_STATISTICS(?, ?';
  28.           // library_name + ''', ''' +
  29.           // object_type_list +'';
  30.     if n_object_name = parm_notnull;
  31.       cursor_statement += ', ?';
  32.       // object_name +'';
  33.     ENDIF;
  34.     cursor_statement += ')) as x';
  35.     exec sql PREPARE P1 from :cursor_statement;
  36.     exec sql DECLARE Obj cursor for P1;
  37.     if n_object_name = parm_notnull;
  38.       exec sql OPEN Obj using :library_name, :object_type_list, :object_name;
  39.     else;
  40.       exec sql OPEN Obj using :library_name, :object_type_list;
  41.     endif;
  42.     sql_state = sqlstate;
  43.   ENDSR;
  44.  
  45.   begsr doFetch;
  46.     exec sql fetch Obj into :Obj_objlib, :Obj_objname, :Obj_objtype;
  47.     sql_state = sqlstate;
  48.     if sqlstate='02000';
  49.       exsr ErrorParm;
  50.       errorMsg='';
  51.       return;
  52.     ENDIF;
  53.     exsr ExtractProgramInformation;
  54.     If ERRC0100.BytesAvail > 0;
  55.       exsr ErrorParm;
  56.       sql_state = '38999';
  57.       errorMsg = 'Unable to retrieve information for ' +
  58.                  %trim(Obj_objname) + ' in ' +
  59.                  %trim(Obj_objlib) + ' of type '+
  60.                  Obj_objtype + '. ' +
  61.                  errc0100.ExceptionId + ': ' +
  62.                  errc0100.ExceptData;
  63.     ENDIF;
  64.   ENDSR;
  65.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css