rem 
rem $Header: prvtdesc.sql 7010300.1 94/02/24 18:23:42 snataraj Generic<base> $ 
rem 
Rem
Rem    NAME
Rem      prvtdesc.sql - describe stored procedures and functions
Rem    DESCRIPTION
Rem      These are private functions to be released in PL/SQL binary form.
Rem      Given a stored procedure, return a description of the 
Rem      arguments required to call that procedure.
Rem    RETURNS
Rem 
Rem    NOTES
Rem      The procedural option is needed to use this facility.
Rem      
Rem    MODIFIED   (MM/DD/YY)
Rem     adowning   02/04/94 -  Branch_for_patch
Rem     adowning   02/04/94 -  Creation
Rem     adowning   02/02/94 -  split file into public / private binary files
Rem     rkooi      11/26/92 -  change some comment 
Rem     rkooi      11/21/92 -  check for top level functions 
Rem     rkooi      11/17/92 -  get rid of database name 
Rem     rkooi      11/12/92 -  change name res stuff 
Rem     mmoore     11/01/92 -  Creation 

REM ********************************************************************
REM THIS PACKAGE MUST NOT BE MODIFIED BY THE CUSTOMER.  DOING SO
REM COULD CAUSE INTERNAL ERRORS AND SECURITY VIOLATIONS IN THE
REM RDBMS.  SPECIFICALLY, THE PSD* ROUTINES MUST NOT BE CALLED
REM DIRECTLY BY ANY CLIENT AND MUST REMAIN PRIVATE TO THE PACKAGE BODY.
REM ********************************************************************

create or replace package body dbms_describe is 
    procedure describe_procedure (object_name in varchar2,
        reserved1 in varchar2, reserved2 in varchar2,
        overload out number_table, position out number_table,
        level out number_table, argument_name out varchar2_table,
        datatype out number_table, default_value out number_table,
        in_out out number_table, length out number_table,
        precision out number_table, scale out number_table,
        radix out number_table, spare out number_table) is

      NOT_EXIST_OR_NO_PRIV exception;
      pragma EXCEPTION_INIT(NOT_EXIST_OR_NO_PRIV, -6564);
      PROC_NOT_IN_PKG exception;
      pragma EXCEPTION_INIT(PROC_NOT_IN_PKG, -6563);

      cursor get_procedure_args(obj_number binary_integer) is 
        select argument, overload#, position, type,
               nvl(default#,0) default#, nvl(in_out,0) in_out,
               nvl(level#,0) level#, nvl(length,0) length, 
               nvl(precision,0) precision, nvl(scale,0) scale, 
               nvl(radix,0) radix
        from argument$ 
        where obj# = obj_number
        order by obj#,procedure$,overload#,sequence#;

      cursor get_package_args(obj_number binary_integer,proc_name varchar2) is 
        select argument, overload#, position, type,
               nvl(default#,0) default#, nvl(in_out,0) in_out,
               nvl(level#,0) level#, nvl(length,0) length, 
               nvl(precision,0) precision, nvl(scale,0) scale, 
               nvl(radix,0) radix
        from argument$
        where obj# = obj_number and procedure$ = proc_name
        order by obj#,procedure$,overload#,sequence#;

      sch    varchar2(30);
      part1  varchar2(30);
      part2  varchar2(30);
      db     varchar2(128);
      typ    number;
      objno  number;
      i      binary_integer := 0;
      found  boolean := FALSE;
      status number;
      nm     varchar2(200);      -- tmp place to hold fully expanded name
                                 -- for error messages
      
    begin 
        
      begin
        dbms_utility.name_resolve(object_name, 1, sch, part1, part2, db, typ,
          objno);
      exception 
        when not_exist_or_no_priv or proc_not_in_pkg then
          raise;
        when others then
          raise_application_error(-20004, 'syntax error attempting to parse "'
            || object_name || '"', keeperrorstack => TRUE);
      end;

      nm := sch;
      if (part1 is not null) then nm := nm || '.' || part1; end if;
      if (part2 is not null) then nm := nm || '.' || part2; end if;
      if (db is not null)    then nm := nm || '@' || db;    end if;

      -- if the translated object is local then query the local dictionary
      if (db is null) then -- an equivalent test would 'typ != 5' (!synonym)
      
        if (part1 is not null and part2 is null) then
          raise_application_error(-20000,
            'ORU-10035: cannot describe a package (' || object_name ||
            '); only a procedure within a package');
        end if;

        -- see if object is valid
        select status into status from obj$ where obj#=objno;
        if status != 1 then
          raise_application_error(-20003, 'ORU-10036: object ' ||
             object_name || ' is invalid and cannot be described');
        end if;

        -- if part1 is a top level procedure or function
        if (typ = 7 or typ = 8) then
          
          -- load the procedure's arguments 
          for tab_rec in get_procedure_args(objno) loop
            i := i + 1;
            argument_name(i) := tab_rec.argument;
            overload(i)      := tab_rec.overload#;
            position(i)      := tab_rec.position;
            /* program interface does not support type 29 (SB4) yet so
               don't give impression that it does, map to DTYINT instead.
               We can get rid of this mapping later when the program
               interface is enhanced.  For compatibility, this mapping
               could be controlled by the future use of one of the
               'reserved' argments */
            if tab_rec.type = 29 then     -- internal sb4
              datatype(i)    := 3;        -- external native int
            elsif tab_rec.type = 69 then  -- internal rowid
              datatype(i)    := 11;       -- external rowid
            else
              datatype(i)    := tab_rec.type;
            end if;
            default_value(i) := tab_rec.default#;
            level(i)         := tab_rec.level#;
            in_out(i)        := tab_rec.in_out;
            length(i)        := tab_rec.length;
            precision(i)     := tab_rec.precision;
            scale(i)         := tab_rec.scale;
            radix(i)         := tab_rec.radix;
            spare(i)         := 0;
          end loop;
        else 
          -- get the procedure's arguments from within the package
          for tab_rec in get_package_args(objno, part2) loop
            i := i + 1;
            argument_name(i) := tab_rec.argument;
            overload(i)      := tab_rec.overload#;
            position(i)      := tab_rec.position;
            /* see comment above */
            if tab_rec.type = 29 then    -- internal sb4
              datatype(i)    := 3;       -- external native int
            elsif tab_rec.type = 69 then -- internal rowid
              datatype(i)    := 11;      -- external rowid
            else
              datatype(i)    := tab_rec.type;
            end if;
            default_value(i) := tab_rec.default#;
            in_out(i)        := tab_rec.in_out;
            level(i)         := tab_rec.level#;
            length(i)        := tab_rec.length;
            precision(i)     := tab_rec.precision;
            scale(i)         := tab_rec.scale;
            radix(i)         := tab_rec.radix;
            spare(i)         := 0;
          end loop;

          -- if no rows returned then the package did not have the procedure
          if i = 0 then
            raise_application_error(-20001, 
              'ORU-10032: procedure ' || part2 || ' within package ' ||
	      part1 || ' does not exist');
          end if;
        end if;
      else

        -- need to forward the describe call to the remote database, but
        -- don't support that yet.
        raise_application_error(-20002, 
            'ORU-10033: object ' || object_name ||
            ' is remote, cannot describe; expanded name: ' || nm);
      end if;
   end;
end;
/  
