Skip to content

Commit af1f785

Browse files
SJLennonSJLennon
committed
Initial commit
1 parent 22158fd commit af1f785

File tree

5 files changed

+194
-0
lines changed

5 files changed

+194
-0
lines changed

‎PGM_REFS/Images/Sample1.png

118 KB
Loading

‎PGM_REFS/Readme.MD

+36
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
# SQL Procedure to find Program Usage recursively using DSPPGMREF
2+
3+
Given a program (or any of the objects that DSPPGMREF handles), the PGM_REFS procedure will find all the obects that the program uses, and then recursively find all that objects that they use, and so on, to an essentally unlimited depth.
4+
5+
This is the product of my experimentation with PL/SQL. It may be short on error handling, and it doesn't do any validity checking on the paremeters.
6+
7+
If you have more experience than me, please feel free to suggest better coding techniques.
8+
9+
So far I have not found a decent manual or turorial. If you have any I'd like to know.
10+
11+
My primary source was trial and error, with help
12+
from these articles by Ted Holt in IT Jungle:
13+
[Ted HolT Article 1](https://www.itjungle.com/2017/06/12/guru-error-handling-sql-pl-part-1/) and
14+
[Ted Holt Article 2](https://www.itjungle.com/2017/10/16/guru-error-handling-sql-pl-part-2/)
15+
and browsing [Scott Forstie Gists on Github](https://gist.github.com/forstie
16+
)
17+
18+
In no way does this replace a real cross reference utilily, such as Hawkeye
19+
or X-Analysis. If you don't have one, this might be somewhat useful.
20+
21+
## pgm_refs_Tbl.sql
22+
23+
This is the DDL to create the file that the procedure builds.
24+
25+
Change the library and then run this first.
26+
27+
## pgm_refs.sql
28+
This is the code to create the PGM_REFS procedure. The library in which the REFS file is build needs to be changed to suit your environment.
29+
30+
## pgm_refs_test.SQL
31+
32+
These are some samples of calling the procedure to test it. I used iACS Run SQL scripts. You could also call it in a CL program using the RUNSQLSTM command.
33+
34+
## Sample Output File Contents
35+
36+
![Sample ](Images/Sample1.png)

‎PGM_REFS/pgm.refs_Tbl.sql

+22
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
-- Table created by the PGM_REFS SQL procedure
2+
-- Change LENNONSB to your library name to suit and make
3+
-- a similar change in PGM_REFS.
4+
DROP TABLE LENNONSB.REFS;
5+
create or replace TABLE LENNONSB.REFS (
6+
DEPTH integer
7+
,CALLER_LIBRARY VarCHAR(10) NOT NULL
8+
,CALLER_NAME VarCHAR(10) NOT NULL
9+
,CALLER_TYPE VarCHAR(10) NOT NULL
10+
,CALLER_TEXT Varchar(30) NOT NULL
11+
,USES_LIBRARY VarCHAR(10) NOT NULL
12+
,USES_NAME VarCHAR(10) NOT NULL
13+
,USES_TYPE VarCHAR(10) NOT NULL
14+
,CONSTRAINT LENNONSB.refs_pk PRIMARY KEY (
15+
CALLER_LIBRARY
16+
,CALLER_NAME
17+
,CALLER_TYPE
18+
,USES_LIBRARY
19+
,USES_NAME
20+
,USES_TYPE
21+
)
22+
);

‎PGM_REFS/pgm_refs.sql

+117
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,117 @@
1+
-- Procedure to run DPSPGMREF, then run DSPPGMREF on each of its objects
2+
-- by calling itself recursively.
3+
-- Result is a file named REFS containing all the objects that
4+
-- DSPPGMREF knows about an object, to an essentially unlimited depth.
5+
CREATE OR REPLACE PROCEDURE PGM_REFS (
6+
IN p_INLIB varCHAR(10)
7+
,IN p_INPGM varCHAR(10)
8+
,IN p_INTYPE varCHAR(10) default '*PGM'
9+
,in p_Depth integer default(0)
10+
)
11+
LANGUAGE SQL
12+
NOT DETERMINISTIC
13+
MODIFIES SQL DATA
14+
SET OPTION dbgview = *source, commit = *none
15+
begin
16+
-- Define DSPPGMREF library and file names
17+
declare WrkLib varchar(10) default 'QTEMP';
18+
declare WrkFileOS varchar(20) default '/WRK' ;
19+
declare WrkFileSQL varchar(20) default '.WRK';
20+
21+
declare sqlstate char(5);
22+
declare my_sqlstate char(5);
23+
declare no_more_data char(5) default '02000';
24+
declare duplicate_key char(5) default '23505';
25+
26+
declare Cmd varchar(1024);
27+
declare ref_cursor_txt varchar(512) default
28+
'select WHLIB, WHPNAM, WHTEXT, WHLNAM, WHFNAM, WHOTYP
29+
from ' ;
30+
31+
-- Our cross ref fields for the REFS file
32+
declare CALLER_LIBRARY varchar(10);
33+
declare CALLER_NAME varchar(10);
34+
declare CALLER_TYPE varchar(10);
35+
declare CALLER_TEXT varchar(30);
36+
declare USES_LIBRARY varchar(10);
37+
declare USES_NAME varchar(10);
38+
declare USES_TYPE varchar(10);
39+
declare USES_TEXT varchar(30);
40+
41+
declare duplicate_object condition for sqlstate '23505';
42+
declare ref_cursor cursor for ref_cursor_stmt;
43+
44+
declare continue handler for duplicate_object
45+
begin
46+
set my_sqlstate = duplicate_key;
47+
end;
48+
49+
-- Build pgm refs work file from DSPPGMREF command.
50+
set WrkFileOS = WrkLib
51+
concat trim(WrkFileOS)
52+
concat trim(char(p_Depth));
53+
set Cmd ='DSPPGMREF PGM('
54+
concat trim(p_INLIB)
55+
concat '/' concat trim(p_INPGM) concat ')'
56+
concat ' OBJTYPE(' concat p_INTYPE CONCAT ')'
57+
concat ' OUTPUT(*OUTFILE)'
58+
concat ' OUTFILE(' concat WrkFileOS concat ')'
59+
;
60+
CALL QSYS2.QCMDEXC (Cmd);
61+
62+
-- Open cursor over the outfile from DSPPGMREF
63+
set WrkFileSQL = WrkLib
64+
concat trim(WrkFileSQL)
65+
concat trim(char(p_Depth));
66+
set ref_cursor_txt = ref_cursor_txt concat WrkFileSQL;
67+
prepare ref_cursor_stmt from ref_cursor_txt;
68+
open ref_cursor;
69+
-- Read through the records from DSPPGMREF
70+
Refs_Loop: loop
71+
fetch from ref_cursor into
72+
CALLER_LIBRARY
73+
,CALLER_NAME
74+
,CALLER_TEXT
75+
,USES_LIBRARY
76+
,USES_NAME
77+
,USES_TYPE
78+
;
79+
if sqlstate = no_more_data then
80+
leave Refs_Loop;
81+
end if;
82+
-- <<<< Change this table library >>>>>
83+
insert into lennonsb.refs values (
84+
p_Depth
85+
,CALLER_LIBRARY
86+
,CALLER_NAME
87+
,p_INTYPE
88+
,CALLER_TEXT
89+
,USES_LIBRARY
90+
,USES_NAME
91+
,USES_TYPE
92+
);
93+
-- If used object already exists don't add again
94+
if my_sqlstate = duplicate_key then
95+
set my_sqlstate = ' ';
96+
iterate Refs_Loop;
97+
end if;
98+
-- Don't expand IBM stuff further
99+
if substr(USES_NAME, 1, 1) = 'Q' then
100+
iterate Refs_Loop;
101+
end if;
102+
-- No further expansion if DSPPGMREF doesn't handle object
103+
if USES_TYPE not in
104+
( '*PGM', '*SRVPGM', '*MODULE', '*QRYDFN', '*SQLPKG') then
105+
iterate Refs_Loop;
106+
end if;
107+
-- Recursively expand this object
108+
call pgm_refs(
109+
USES_LIBRARY, USES_NAME, trim(USES_TYPE), p_Depth+1);
110+
end loop;
111+
112+
close ref_cursor;
113+
set Cmd = 'DLTF FILE(' concat WrkFileOS concat ')';
114+
CALL QSYS2.QCMDEXC (Cmd);
115+
116+
-- drop table WrkFileSQL;
117+
end;

‎PGM_REFS/pgm_refs_test.sql

+19
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
-- Depth field starts at 0, type of *PGM assumed
2+
call lennons1.pgm_refs('LENNONS1', 'MTNCUSTR');
3+
call lennons1.pgm_refs(p_inlib => 'LENNONS1', p_inpgm => 'MTNCUSTR');
4+
5+
-- Depth field starts at 6789, an arbitrary number
6+
call lennons1.pgm_refs('LENNONS1', 'MTNCUSTR','*PGM', 6789);
7+
call lennons1.pgm_refs(p_depth => 6789, p_inlib => 'LENNONS1', p_inpgm => 'MTNCUSTR');
8+
9+
-- Start with a *MODULE
10+
call lennons1.pgm_refs(p_inlib => 'LENNONSB', p_inpgm => 'ART300', p_INTYPE => '*MODULE');
11+
12+
-- Start with a *SRVPGMMODULE
13+
call lennons1.pgm_refs(p_inlib => 'LENNONSB', p_inpgm => 'FVAT', p_INTYPE => '*SRVPGM');
14+
15+
-- List the output file of objects used
16+
select * from lennonsb.refs
17+
order by DEPTH, CALLER_LIBRARY, CALLER_NAME, CALLER_TYPE,
18+
USES_LIBRARY, USES_NAME, USES_TYPE;
19+

0 commit comments

Comments
 (0)