1 package body wpiutl as
2
3 --------------------------------
4 -- List of private subprograms
5 --------------------------------
6 -- Driving the whole process
7 PROCEDURE driver(objnum NUMBER, ownerName VARCHAR2, objname VARCHAR2,
8 subname VARCHAR2, pnames IN OUT tvarchar,
9 ptnames IN OUT tvarchar, ptypes IN OUT tvchar3,
10 status OUT PLS_INTEGER, misdef OUT VARCHAR2,
11 nename OUT VARCHAR2);
12
13 -- Find subprograms and describe the parameters
14 PROCEDURE describe(objn NUMBER, name VARCHAR2, subname VARCHAR2,
15 usr VARCHAR2, prefix VARCHAR2, pnames tvarchar,
16 ptnames IN OUT tvarchar, ptypes IN OUT tvchar3,
17 status OUT PLS_INTEGER, misdef OUT VARCHAR2,
18 nename OUT VARCHAR2);
19 pragma interface(C, describe); /* first entry of this package ICD */
20
21 -- Normalize names
22 FUNCTION normalname(name VARCHAR2) RETURN VARCHAR2;
23
24 ------------------------------------------------------------------------
25 -- Public suprogram implementation --
26 ------------------------------------------------------------------------
27 PROCEDURE subpparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2,
28 prename VARCHAR2, status OUT NUMBER, misdef OUT VARCHAR2,
29 nename OUT VARCHAR2) IS
30 pnames tvarchar;
31 ptnames tvarchar;
32 ptypes tvchar3;
33 BEGIN
34 driver(objnum, prename, name, subname, pnames, ptnames, ptypes,
35 status, misdef, nename);
36 END;
37
38 PROCEDURE subpparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2,
39 prename VARCHAR2, pnames IN OUT tvarchar,
40 ptnames IN OUT tvarchar, ptypes IN OUT tvchar3,
41 status OUT NUMBER, misdef OUT VARCHAR2,
42 nename OUT VARCHAR2) IS
43 BEGIN
44 driver(objnum, prename, name, subname, pnames, ptnames, ptypes,
45 status, misdef, nename);
46 END;
47
48 PROCEDURE subpfparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2,
49 prename VARCHAR2, pnames IN tvarchar,
50 ptnames IN OUT tvarchar, ptypes IN tvchar3,
51 status OUT NUMBER, misdef OUT VARCHAR2,
52 nename OUT VARCHAR2) IS
53 vpnames tvarchar;
54 vptypes tvchar3;
55 tmisdef VARCHAR2(4096);
56 tnename VARCHAR2(4096);
57 tstatus PLS_INTEGER;
58 BEGIN
59 vpnames(1) := pnames(2);
60 vpnames(2) := pnames(3);
61 vptypes(1) := ptypes(2);
62 vptypes(2) := ptypes(3);
63
64 driver(objnum, prename, name, subname, vpnames, ptnames, vptypes,
65 status, tmisdef, tnename);
66
67 IF (status != s_ok) THEN
68 vpnames := pnames;
69 vptypes := ptypes;
70 driver(objnum, prename, name, subname, vpnames, ptnames, vptypes,
71 tstatus, tmisdef, tnename);
72 IF (tstatus = s_ok) THEN
73 status := tstatus;
74 misdef := NULL;
75 nename := NULL;
76 END IF;
77 END IF;
78 END;
79
80
81 ------------------------------------------------------------------------
82 -- --
83 -- Private subprogram implementation --
84 -- --
85 ------------------------------------------------------------------------
86 PROCEDURE driver(objnum NUMBER, ownerName VARCHAR2, objname VARCHAR2,
87 subname VARCHAR2, pnames IN OUT tvarchar,
88 ptnames IN OUT tvarchar, ptypes IN OUT tvchar3,
89 status OUT PLS_INTEGER, misdef OUT VARCHAR2,
90 nename OUT VARCHAR2) IS
91 prefix dbms_quoted_id;
92
93 BEGIN
94 -- Get the prefix
95 IF (ownerName = user) THEN
96 -- no need to prefix owner name to types
97 prefix := NULL;
98 ELSE
99 prefix := ownerName || '.';
100 END IF;
101
102 -- Normalize name before comparison
103 FOR i IN 1..pnames.count LOOP
104 pnames(i) := normalname(pnames(i));
105 END LOOP;
106
107 describe(objnum, objname, subname, ownerName, prefix,
108 pnames, ptnames, ptypes, status, misdef, nename);
109 END driver;
110
111 -----------------------
112 -- normalname: RETURN a normalized name.
113 -----------------------
114 FUNCTION normalname(name VARCHAR2) RETURN VARCHAR2 IS
115 firstchar VARCHAR2(4);
116 len NUMBER;
117 BEGIN
118 IF (name IS NULL OR name = '') THEN RETURN name; END IF;
119 firstchar := substr(name, 1, 1);
120 IF (firstchar = '"') THEN
121 len := length(name);
122 IF (len > 1 AND substr(name, len, 1) = '"') THEN
123 IF (len > 33) THEN
124 len := 31;
125 ELSE
126 len := len-2;
127 END IF;
128 RETURN substr(name, 2, len);
129 END IF;
130 END IF;
131 RETURN upper(name);
132 END normalname;
133
134 end;