Rem Rem $Header: wpiutl7.sql 12-apr-98.20:55:26 nle Exp $ Rem Rem dbmspbx.sql Rem Rem Copyright (c) Oracle Corporation 1998. All Rights Reserved. Rem Rem NAME Rem wpiutl.sql - PL/SQL describe API for webdb Rem Rem NOTES Rem A portion of this file is copied from diutil.sql. Because this Rem package is specificly for webdb, we didn't want to add its Rem functionality into package diutil.sql. If we ever make these more Rem generic, we should merge these code into diutil.sql Rem Rem MODIFIED (MM/DD/YY) Rem ehlee 03/06/01 - fix optimized fix failed type desc (bug#1658132) Rem ehlee 02/20/01 - fix quoted parameters (bug#1644973) Rem ehlee 02/20/01 - optimize fix failed type description Rem ehlee 02/06/01 - fix failed type description Rem nle 10/14/99 - Port wpiutl to 7.x version Rem create or replace package sys.wpiutl as TYPE tvarchar IS table of varchar2(512) index by binary_integer; TYPE tchar3 IS table of CHAR(3) index by binary_integer; TYPE tvchar3 IS table of VARCHAR2(3) index by binary_integer; SUBTYPE ptnod IS pidl.ptnod; -- Constant for errors s_ok CONSTANT NUMBER := 0; -- successful s_subpnotfound CONSTANT NUMBER := 1; -- subprogram NOT found s_notinpackage CONSTANT NUMBER := 2; -- PACKAGE found, proc NOT found s_notasub CONSTANT NUMBER := 3; -- found, but not a subprog s_notunique CONSTANT NUMBER := 4; -- too many matches (overloading error) s_nomatch CONSTANT NUMBER := 5; -- found, but param names not matched s_typenotmatch CONSTANT NUMBER := 6; -- name match, type doesn't match -- The following t_ constants can NOT exceed 999 t_scalar CONSTANT CHAR(3) := '000'; t_v7array CONSTANT CHAR(3) := '001'; -- subpparam: -- IN: name name of the subprogram, package, or owner -- subname name of subprogram if not null -- prename name of owner if not null -- pnames names of formal parameter -- OUT: ptnames names of formal parameter types -- ptypes characteristic of the types: scalar, V7_array, ... -- status error code = s_ok : subprogram found -- s_subpnotfound : not found in schema -- s_notinpackage : not found in package -- s_notasub : found, but not a subprog -- s_notunique : too many matches. -- s_nomatch : found, but no match -- -- This function analyzes the following types of names: -- -- . -- .. -- It resolves overloading subprograms by parameter names (i.e. PNAMES), -- and returns types of the parameters that are listed in pnames -- may not be NULL while prename and subname may. -- -- pnames, ptnames, and ptypes are optional. -- PROCEDURE subpparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2, prename VARCHAR2, status OUT NUMBER, misdef OUT VARCHAR2, nename OUT VARCHAR2); PROCEDURE subpparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2, prename VARCHAR2, pnames IN OUT tvarchar, ptnames IN OUT tvarchar, ptypes IN OUT tvchar3, status OUT NUMBER, misdef OUT VARCHAR2, nename OUT VARCHAR2); -- This is similar to subpparam but used for flexible parameter -- Note: different from subpparam, pnames and ptypes are INput only PROCEDURE subpfparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2, prename VARCHAR2, pnames IN tvarchar, ptnames IN OUT tvarchar, ptypes IN tvchar3, status OUT NUMBER, misdef OUT VARCHAR2, nename OUT VARCHAR2); end; / create or replace package body sys.wpiutl as TYPE tptnod is table of ptnod index by binary_integer; TYPE tbool is table of boolean index by binary_integer; TYPE tnumber is table of number index by binary_integer; owner_prefix VARCHAR2(31); package_prefix VARCHAR2(31); -- These two variables are used when users pass an array of values -- to a scalar parameter MatchTypes tvchar3; MatchList tptnod; MLcnt NUMBER; OLnums tnumber; CharList tbool; -- Error message variables missing_defaults VARCHAR2(4096); non_exist_names VARCHAR2(4096); posterr BOOLEAN; posnotunique BOOLEAN; -- flag for posibility of not unique -------------------------------- -- List of private subprograms -------------------------------- -- Driving the whole process PROCEDURE driver(objnum NUMBER, ownerName VARCHAR2, objname VARCHAR2, subname VARCHAR2, pnames IN OUT tvarchar, ptnames IN OUT tvarchar, ptypes IN OUT tvchar3, status OUT NUMBER); -- Setting error messages PROCEDURE setErrMsg(misdef OUT VARCHAR2, nename OUT VARCHAR2); -- Find subprograms and describe the parameters PROCEDURE describe(objn NUMBER, name VARCHAR2, subname VARCHAR2, usr VARCHAR2, pnames IN OUT tvarchar, ptnames IN OUT tvarchar, ptypes IN OUT tvchar3, status OUT NUMBER); -- name of an identifier FUNCTION idname(n ptnod) RETURN VARCHAR2; -- name of a subprogram FUNCTION procname(k ptnod) RETURN VARCHAR2; -- name of a type FUNCTION typename(k ptnod) RETURN VARCHAR2; -- check if a type is a character type FUNCTION isCharType(tname VARCHAR2) RETURN BOOLEAN; -- read type nodes from a subprog for parameters listed in pnames. PROCEDURE getTypeNodes(subnod ptnod, pnames tvarchar, pnodes OUT tptnod); -- check if a package subprog has parameter names matching with given names FUNCTION ismatched(subnod ptnod, pnames IN OUT tvarchar, pnodes OUT tptnod) RETURN BOOLEAN; -- Get types and type names of given parameters (in pnodes) PROCEDURE gettypes(pnodes tptnod, ptypes IN OUT tvchar3, objn NUMBER, subname VARCHAR2, olnum NUMBER, pnames tvarchar); PROCEDURE gettnames(pnodes tptnod, ptnames IN OUT tvarchar, parent_list pidl.ptseqnd); -- Get type and type name of one parameter FUNCTION gettname(parnod ptnod, parent_list pidl.ptseqnd) RETURN VARCHAR2; FUNCTION gettype(parnod ptnod, objn NUMBER, subname VARCHAR2, olnum NUMBER, pname VARCHAR2) RETURN VARCHAR2; FUNCTION descType(objn NUMBER, subname VARCHAR2, olnum number, pname varchar2) RETURN VARCHAR2; -- Get text version of all diana nodes PROCEDURE exprtext(x ptnod, rv IN OUT VARCHAR2); -- Normalize names FUNCTION normalname(name VARCHAR2) RETURN VARCHAR2; -- enquote special name FUNCTION coatname(name VARCHAR2) RETURN VARCHAR2; -- Concatenate names into one FUNCTION concatNames(prename VARCHAR2, name VARCHAR2, subname VARCHAR2) RETURN VARCHAR2; ------------------------------------------------------------------------ -- Public suprogram implementation -- ------------------------------------------------------------------------ PROCEDURE subpparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2, prename VARCHAR2, status OUT NUMBER, misdef OUT VARCHAR2, nename OUT VARCHAR2) IS pnames tvarchar; ptnames tvarchar; ptypes tvchar3; BEGIN driver(objnum,prename,name,subname,pnames,ptnames,ptypes,status); setErrMsg(misdef, nename); END; PROCEDURE subpparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2, prename VARCHAR2, pnames IN OUT tvarchar, ptnames IN OUT tvarchar, ptypes IN OUT tvchar3, status OUT NUMBER, misdef OUT VARCHAR2, nename OUT VARCHAR2) IS BEGIN driver(objnum,prename,name,subname,pnames,ptnames,ptypes,status); setErrMsg(misdef, nename); END; PROCEDURE subpfparam(objnum NUMBER, name VARCHAR2, subname VARCHAR2, prename VARCHAR2, pnames IN tvarchar, ptnames IN OUT tvarchar, ptypes IN tvchar3, status OUT NUMBER, misdef OUT VARCHAR2, nename OUT VARCHAR2) IS vpnames tvarchar; vptypes tvchar3; BEGIN vpnames(1) := pnames(2); vpnames(2) := pnames(3); vptypes(1) := ptypes(2); vptypes(2) := ptypes(3); driver(objnum,prename,name,subname,vpnames,ptnames,vptypes,status); setErrMsg(misdef, nename); IF (status != s_ok) THEN vpnames := pnames; vptypes := ptypes; driver(objnum,prename,name,subname,vpnames,ptnames,vptypes,status); IF (status = s_ok) THEN misdef := NULL; nename := NULL; END IF; END IF; END; ------------------------------------------------------------------------ -- -- -- Private subprogram implementation -- -- -- ------------------------------------------------------------------------ PROCEDURE driver(objnum NUMBER, ownerName VARCHAR2, objname VARCHAR2, subname VARCHAR2, pnames IN OUT tvarchar, ptnames IN OUT tvarchar, ptypes IN OUT tvchar3, status OUT NUMBER) IS PROCEDURE setPrefix(prefix VARCHAR2) is BEGIN IF (prefix = user) THEN -- no need to prefix owner name to types owner_prefix := NULL; ELSE owner_prefix := prefix; END IF; END setPrefix; BEGIN setPrefix(ownerName); missing_defaults := NULL; non_exist_names := NULL; posterr := TRUE; describe(objnum, objname, subname, ownerName, pnames, ptnames, ptypes, status); END driver; PROCEDURE setErrMsg(misdef OUT VARCHAR2, nename OUT VARCHAR2) IS BEGIN IF (posterr) THEN misdef := missing_defaults; nename := non_exist_names; ELSE misdef := NULL; nename := NULL; END IF; END; PROCEDURE describe(objn NUMBER, name VARCHAR2, subname VARCHAR2, usr VARCHAR2, pnames IN OUT tvarchar, ptnames IN OUT tvarchar, ptypes IN OUT tvchar3, status OUT NUMBER) is oroot ptnod; -- object root subnod ptnod; -- subprogram tree node pnodes tptnod; -- array of tree nodes for given pnames dummy tptnod; -- array of tree nodes for given pnames fmcnt NUMBER; readTypes tvchar3; seq pidl.ptseqnd := 0; len INTEGER; olnum NUMBER; -- overload number found_name boolean; di_status diutil.ub4; PROCEDURE filterByArrayStatus(nodlis tptnod) IS keepbest BOOLEAN := TRUE; keepnew BOOLEAN := TRUE; ptype CHAR(3); rtype CHAR(3); mtype CHAR(3); BEGIN gettypes(nodlis, readTypes, objn, subname, olnum, pnames); -- If this is the first call, assign value and return. IF (fmcnt = 0) THEN MLcnt := 1; MatchList(MLcnt) := subnod; OLnums(MLcnt) := olnum; FOR i IN 1..ptypes.count LOOP IF (ptypes(i) = readTypes(i)) THEN MatchTypes(i) := ptypes(i); ELSE MatchTypes(i) := NULL; END IF; END LOOP; RETURN; END IF; -- Find the bestmatches sofar FOR i IN 1..ptypes.count LOOP ptype := ptypes(i); mtype := MatchTypes(i); rtype := readTypes(i); IF (ptype = rtype AND (mtype is NULL OR ptype != mtype)) THEN MatchTypes(i) := ptype; keepbest := FALSE; ELSIF (ptype = mtype AND ptype != rtype) THEN keepnew := FALSE; END IF; END LOOP; IF (keepnew != keepbest) THEN -- Keep only one of them IF (keepnew) THEN -- Keep only new one and destroy the current matchlist. MLcnt := 1; MatchList(MLcnt) := subnod; OLnums(MLcnt) := olnum; END IF; ELSE -- Either keep both or destroy both. IF (keepnew) THEN MLcnt := MLcnt+1; MatchList(MLcnt) := subnod; OLnums(MLcnt) := olnum; ELSE MLcnt := 0; END IF; END IF; END; PROCEDURE findMatch(nodlis OUT tptnod) IS BEGIN IF (ismatched(subnod, pnames, nodlis)) THEN filterByArrayStatus(nodlis); fmcnt := fmcnt+1; END IF; END; PROCEDURE filterByCharType(matchnod OUT ptnod, oln OUT NUMBER) IS anod ptnod; mb BOOLEAN; nb BOOLEAN; elimbest BOOLEAN; elimnew BOOLEAN; BEGIN FOR i in 1..MLcnt LOOP anod := MatchList(i); getTypeNodes(anod, pnames, dummy); IF (i = 1) THEN gettypes(dummy, MatchTypes, objn, subname, olnum, pnames); FOR j IN 1..dummy.count LOOP CharList(j) := (MatchTypes(j) = t_scalar) AND (isCharType(gettname(dummy(j),seq))); END LOOP; matchnod := anod; oln := OLnums(i); ELSE elimbest := FALSE; elimnew := FALSE; FOR j IN 1..dummy.count LOOP IF (MatchTypes(j) = t_scalar) THEN mb := CharList(j); nb := isCharType(gettname(dummy(j),seq)); IF (mb != nb) THEN IF (nb) THEN CharList(j) := nb; elimbest := TRUE; ELSE elimnew := TRUE; END IF; END IF; END IF; END LOOP; IF (elimbest != elimnew) THEN IF (elimbest) THEN matchnod := anod; oln := OLnums(i); END IF; ELSE -- since we can only keep one, get rid of both of them matchnod := NULL; END IF; END IF; END LOOP; END; BEGIN status := s_ok; -- Looking for the object in the schema diutil.get_diana(name, usr, NULL, NULL, di_status, oroot, diutil.libunit_type_spec, diutil.load_source_yes); IF (oroot is NULL OR oroot = 0) THEN status := s_subpnotfound; RETURN; END IF; -- Object is found -- Check if it's a subprog and return the type names subnod := diana.a_unit_b(oroot); -- Normalize name before comparison FOR i IN 1..pnames.count LOOP pnames(i) := normalname(pnames(i)); END LOOP; IF (subname IS NULL OR subname = '') THEN IF (pidl.ptkin(subnod) = diana.d_p_decl) THEN status := s_notasub; ELSIF (ismatched(subnod, pnames, pnodes)) THEN -- No overloading gettypes(pnodes, ptypes, objn, NULL, NULL, pnames); gettnames(pnodes,ptnames,seq); ELSE status := s_nomatch; END IF; RETURN; END IF; -- search FOR subname among ALL func/proc IN the PACKAGE IF (pidl.ptkin(subnod) != diana.d_p_decl) THEN status := s_notasub; RETURN; END IF; posnotunique := FALSE; package_prefix := name; subnod := diana.a_packag(subnod); seq := diana.as_list(diana.as_decl1(subnod)); len := pidl.ptslen(seq) - 1; found_name := FALSE; olnum := 0; MLcnt := 0; fmcnt := 0; FOR i IN 0..len LOOP subnod := pidl.ptgend(seq, i); IF (procname(subnod) = subname) THEN olnum := olnum+1; found_name := TRUE; -- If there's already a match, we pass a dummy, -- so we won't overwrite pnodes -> optimize the non-overload case IF (fmcnt = 0) THEN findmatch(pnodes); ELSE findmatch(dummy); END IF; END IF; END LOOP; IF (fmcnt = 0) THEN IF (found_name) THEN status := s_nomatch; ELSE status := s_notinpackage; END IF; RETURN; END IF; -- No overloading IF (fmcnt = 1) THEN ptypes := readtypes; gettnames(pnodes,ptnames,seq); RETURN; END IF; -- No match for array types IF (MLcnt = 0) THEN status := s_typenotmatch; RETURN; END IF; IF (MLcnt = 1) THEN subnod := MatchList(1); olnum := OLnums(1); ELSE filterByCharType(subnod, olnum); IF (subnod is NULL) THEN status := s_notunique; RETURN; END IF; END IF; getTypeNodes(subnod, pnames, pnodes); gettypes(pnodes, ptypes, objn, subname, olnum, pnames); gettnames(pnodes,ptnames,seq); END describe; ----------------------- -- idname ----------------------- FUNCTION idname(n ptnod) RETURN VARCHAR2 IS seq pidl.ptseqnd; len BINARY_INTEGER; BEGIN seq := diana.as_list(n); len := pidl.ptslen(seq); RETURN normalname(diana.l_symrep(pidl.ptgend(seq, len-1))); END idname; ----------------------- -- procname ----------------------- FUNCTION procname(k ptnod) RETURN VARCHAR2 IS x ptnod; xkind pidl.ptnty; BEGIN IF (k IS NULL OR k = 0) THEN RETURN NULL; END IF; IF (pidl.ptkin(k) != diana.d_s_decl) THEN RETURN NULL; END IF; x := diana.a_d_(k); xkind := pidl.ptkin(x); IF ( xkind != diana.di_funct AND xkind != diana.di_proc AND xkind != diana.d_def_op) THEN RETURN NULL; END IF; RETURN diana.l_symrep(x); END; ----------------------- -- typename ----------------------- FUNCTION typename(k ptnod) RETURN VARCHAR2 IS ktype pidl.ptnty; BEGIN IF (k IS NOT NULL AND k != 0) THEN ktype := pidl.ptkin(k); IF (ktype = diana.d_type OR ktype = diana.d_subtyp) THEN RETURN diana.l_symrep(diana.a_id(k)); END IF; END IF; RETURN NULL; END; ----------------------- -- ischartype ----------------------- FUNCTION isCharType(tname VARCHAR2) RETURN BOOLEAN IS BEGIN return (tname LIKE '%CHAR%') OR (tname = 'STRING') OR (tname = 'LONG') OR (tname LIKE '%RAW%') OR (tname LIKE '%ROWID'); END; ----------------------- -- getTypeNodes ----------------------- PROCEDURE getTypeNodes(subnod ptnod, pnames tvarchar, pnodes OUT tptnod) IS parseq pidl.ptseqnd; parnum NATURAL; parnod ptnod; parname VARCHAR2(128); actnum NATURAL; BEGIN parseq := diana.as_list(diana.as_p_(diana.a_header(subnod))); parnum := pidl.ptslen(parseq); actnum := pnames.count; FOR j IN 1..actnum LOOP FOR i IN 1..parnum LOOP parnod := pidl.ptgend(parseq, i-1); parname := idname(diana.as_id(parnod)); IF (parname = pnames(j)) THEN pnodes(j) := parnod; GOTO found_matched; END IF; END LOOP; <> null; END LOOP; END; ----------------------- -- ismatched ----------------------- FUNCTION ismatched(subnod ptnod, pnames IN OUT tvarchar, pnodes OUT tptnod) RETURN BOOLEAN IS parseq pidl.ptseqnd; parnum NATURAL; parnod ptnod; parname VARCHAR2(128); defval ptnod; retval boolean := TRUE; actnum NATURAL; BEGIN parseq := diana.as_list(diana.as_p_(diana.a_header(subnod))); parnum := pidl.ptslen(parseq); actnum := pnames.count; IF (missing_defaults IS NOT NULL OR non_exist_names IS NOT NULL) THEN posterr := FALSE; END IF; IF (parnum = 0 AND actnum = 0) THEN RETURN TRUE; END IF; FOR i IN 1..actnum LOOP pnodes(i) := 0; END LOOP; -- First, make sure each formal parameter has an actual value FOR i IN 1..parnum LOOP parnod := pidl.ptgend(parseq, i-1); parname := idname(diana.as_id(parnod)); FOR j IN 1..actnum LOOP IF (parname = pnames(j)) THEN pnodes(j) := parnod; GOTO found_matched; END IF; END LOOP; defval := diana.a_exp_vo(parnod); IF (defval IS NULL OR defval = 0) THEN IF (posterr) THEN IF (missing_defaults IS NULL) THEN missing_defaults := parname; ELSE missing_defaults := missing_defaults || ',' || parname; END IF; END IF; retval := FALSE; END IF; <> null; END LOOP; -- Second, make sure all actual values have associated formal parameters FOR i IN 1..actnum LOOP IF (pnodes(i) = 0) THEN IF (posterr) THEN IF (non_exist_names IS NULL) THEN non_exist_names := pnames(i); ELSE non_exist_names := non_exist_names || ',' || pnames(i); END IF; END IF; retval := FALSE; END IF; END LOOP; RETURN retval; END; ------------------------------- -- gettypes ------------------------------- PROCEDURE gettypes(pnodes tptnod, ptypes IN OUT tvchar3, objn NUMBER, subname VARCHAR2, olnum NUMBER, pnames tvarchar) IS parnum NATURAL; BEGIN parnum := pnodes.count; FOR i IN 1..parnum LOOP ptypes(i) := gettype(pnodes(i), objn, subname, olnum, pnames(i)); END LOOP; END; ------------------------------- -- gettnames ------------------------------- PROCEDURE gettnames(pnodes tptnod, ptnames IN OUT tvarchar, parent_list pidl.ptseqnd) IS parnum NATURAL; BEGIN parnum := pnodes.count; FOR i IN 1..parnum LOOP ptnames(i) := gettname(pnodes(i), parent_list); END LOOP; END; ------------------------------------------------------------------- -- gettname -- This function does name-resolution for two cases: -- * var A_TYPE -- * var A_OWNER.A_PACK.A_TYPE -- For these two case it will look for the package or owner of -- the type and prefix the type name with that. -- No name-resolution for others. We'll print the type name as is ------------------------------------------------------------------- FUNCTION gettname(parnod ptnod, parent_list pidl.ptseqnd) RETURN VARCHAR2 IS tnod ptnod; prenod1 ptnod; prenod2 ptnod; tkind pidl.ptnty; name VARCHAR2(512) := NULL; typname VARCHAR2(512) := NULL; -- Check if a type is defined in the package FUNCTION isInPackage(oname VARCHAR2) RETURN BOOLEAN IS len NATURAL; typnod ptnod; BEGIN len := pidl.ptslen(parent_list)-1; FOR i IN 0..len LOOP typnod := pidl.ptgend(parent_list, i); IF (typename(typnod) = oname) THEN RETURN TRUE; END IF; END LOOP; RETURN FALSE; END; -- Check if a type is defined in the owner's schema FUNCTION isInSchema(oname VARCHAR2) RETURN BOOLEAN IS cnt NUMBER; BEGIN SELECT count(*) INTO cnt FROM all_objects WHERE owner=owner_prefix AND object_name=oname; IF (cnt = 0) THEN RETURN FALSE; END IF; RETURN TRUE; END; BEGIN tnod := diana.a_name(parnod); <> tkind := pidl.ptkin(tnod); -- CASE: (var A_TYPE) IF (tkind = diana.di_u_nam) THEN typname := diana.l_symrep(tnod); IF (parent_list != 0 AND isInPackage(typname)) THEN typname := package_prefix || '.' || typname; ELSIF (NOT isInSchema(typname)) THEN RETURN typname; END IF; IF (owner_prefix IS NOT NULL) THEN typname := owner_prefix || '.' || typname; END IF; -- CASE: (var A_PACK.A_TYPE) or (var A_OWNER.A_PACK.A_TYPE) ELSIF (tkind = diana.d_s_ed) THEN typname := diana.l_symrep(diana.a_d_char(tnod)); prenod2 := diana.a_name(tnod); tkind := pidl.ptkin(prenod2); IF (tkind = diana.di_u_nam) THEN name := diana.l_symrep(prenod2); typname := name || '.' || typname; IF (owner_prefix IS NOT NULL AND isInSchema(name)) THEN typname := owner_prefix || '.' || typname; END IF; ELSIF (tkind = diana.d_s_ed) THEN prenod1 := diana.a_name(prenod2); IF (pidl.ptkin(prenod1) = diana.di_u_nam) THEN typname := diana.l_symrep(prenod1) || '.' || diana.l_symrep(diana.a_d_char(prenod2)) || '.' || typname; END IF; END IF; END IF; -- OTHER CASES: unknown shape of types; no name resolution IF (typname IS NULL) THEN exprtext(tnod, typname); END IF; RETURN typname; END; --------------------------------- -- Get characteristic of the type --------------------------------- FUNCTION gettype(parnod ptnod, objn NUMBER, subname VARCHAR2, olnum NUMBER, pname VARCHAR2) RETURN VARCHAR2 IS tnod ptnod; tkind pidl.ptnty; BEGIN tnod := diana.a_name(parnod); tkind := pidl.ptkin(tnod); IF (tkind = diana.d_s_ed) THEN tnod := diana.a_d_char(tnod); tkind := pidl.ptkin(tnod); END IF; IF (tkind = diana.di_u_nam) THEN tnod := diana.s_defn(tnod); -- First check for DI_TYPE IF (pidl.ptkin(tnod) = diana.di_type AND pidl.ptkin(diana.s_t_spec(tnod)) = diana.d_array) THEN RETURN t_v7array; END IF; -- Second check for DI_SUBTY IF (pidl.ptkin(tnod) = diana.di_subty) THEN tnod := diana.s_t_spec(tnod); IF (pidl.ptkin(tnod) = diana.d_constr) THEN tnod := diana.s_base_t(tnod); IF (pidl.ptkin(tnod) = diana.d_array) THEN RETURN t_v7array; END IF; END IF; END IF; -- Couldn't find the type in diana, look for it in the database IF (tnod = 0) THEN RETURN desctype(objn, subname, olnum, pname); END IF; END IF; RETURN t_scalar; END; ------------------------------------------------------- -- describe kind of types when it's not granted to user ------------------------------------------------------- FUNCTION descType(objn NUMBER, subname VARCHAR2, olnum number, pname varchar2) RETURN VARCHAR2 IS tkind VARCHAR2(4) := t_scalar; typnum NUMBER; BEGIN IF (subname IS NULL) THEN SELECT type INTO typnum FROM argument$ WHERE obj#=objn AND argument=pname; ELSE BEGIN SELECT type INTO typnum FROM argument$ WHERE obj#=objn AND procedure$=subname AND argument=pname; EXCEPTION WHEN too_many_rows THEN SELECT type INTO typnum FROM argument$ WHERE obj#=objn AND procedure$=subname AND overload#=olnum AND argument=pname; END; END IF; IF (typnum = 251) THEN tkind := t_v7array; END IF; return tkind; END; ------------------------------- -- exprtext: -- general unparsing FUNCTION ------------------------------- PROCEDURE exprtext(x ptnod, rv IN OUT VARCHAR2) IS -------------------- -- etext: -------------------- PROCEDURE etext(n ptnod) IS nkind pidl.ptnty; BEGIN IF (n IS NOT NULL) THEN nkind := pidl.ptkin(n); -- simple expr IF (nkind = diana.di_u_nam OR nkind = diana.d_used_b OR nkind = diana.di_u_blt OR nkind = diana.di_funct OR nkind = diana.di_proc OR nkind = diana.di_packa OR nkind = diana.di_var OR nkind = diana.di_type OR nkind = diana.di_subty OR nkind = diana.di_in OR nkind = diana.di_out OR nkind = diana.di_in_ou) THEN rv := rv || coatname(diana.l_symrep(n)); ELSIF (nkind = diana.d_s_ed) THEN -- x.y etext(diana.a_name(n)); rv := rv || '.'; etext(diana.a_d_char(n)); ELSIF (nkind = diana.d_string OR nkind = diana.d_used_c OR nkind = diana.d_def_op) THEN rv := rv || '''' || diana.l_symrep(n) || ''''; ELSIF (nkind = diana.d_attrib) THEN etext(diana.a_name(n)); rv := rv || '%'; etext(diana.a_id(n)); ELSIF (nkind = diana.d_numeri) THEN rv := rv || diana.l_numrep(n); ELSIF (nkind = diana.d_constr) THEN -- constraint etext(diana.a_name(n)); ELSE rv := ''; END IF; END IF; END etext; BEGIN -- exprText etext(x); END exprtext; ----------------------- -- normalname: RETURN a normalized name. ----------------------- FUNCTION normalname(name VARCHAR2) RETURN VARCHAR2 IS firstchar VARCHAR2(4); len NUMBER; BEGIN IF (name IS NULL OR name = '') THEN RETURN name; END IF; firstchar := substr(name, 1, 1); IF (firstchar = '"') THEN len := length(name); IF (len > 1 AND substr(name, len, 1) = '"') THEN IF (len > 33) THEN len := 31; ELSE len := len-2; END IF; RETURN substr(name, 2, len); END IF; END IF; RETURN upper(name); END normalname; ----------------------- -- coatname: enquote name IF necessary ----------------------- FUNCTION coatname(name VARCHAR2) RETURN VARCHAR2 IS BEGIN IF (name != upper(name)) THEN RETURN '"' || name || '"'; ELSE RETURN name; END IF; END coatname; FUNCTION concatNames(prename VARCHAR2, name VARCHAR2, subname VARCHAR2) RETURN VARCHAR2 AS fullname VARCHAR2(128) := NULL; BEGIN IF (subname IS NOT NULL) THEN fullname := subname; END IF; IF (name IS NOT NULL) THEN IF (fullname IS NOT NULL) THEN fullname := name || '.' || fullname; ELSE fullname := name; END IF; END IF; IF (prename IS NOT NULL) THEN IF (fullname IS NOT NULL) THEN fullname := prename || '.' || fullname; ELSE fullname := prename; END IF; END IF; RETURN fullname; END; END; / show errors; grant execute on sys.wpiutl to public /