plgdesc.spb

Oracle PL/SQL procedure generator (second generator type)

CREATE OR REPLACE
PACKAGE BODY             PLGdesc
IS
/*----------------------------------------------------------------
||                  PL/Vision Professional
||----------------------------------------------------------------
||    File: PLGdesc.spb
||  Author: Steven Feuerstein
||
|| This is a part of the PL/Vision Professional Code library.
|| Copyright (C) 1996-99 Quest Software, Inc.
|| All rights reserved.
||
|| For more information, call Quest Software at 1-800-REVEAL4
|| or check out our Web page: www.Quest Software.com
||
-----------------------------------------------------------------*/

/***************** Modification History **************************
|| Date     By     Description
||	-------- ------ -----------------------------------------------
|| 10/99    SEF    Re-architect to work directly from ALL_ARGUMENTS
||                 and not DBMS_DESCRIBE.
||
|| 7/98     SEF    Created for use in PL/Generator.
******************************************************************/
   g_object_name VARCHAR2 (200);
   c_delim CONSTANT CHAR(1) := CHR(8);

   FUNCTION identifier_fit (str IN VARCHAR2) RETURN VARCHAR2
   IS
   BEGIN
      RETURN SUBSTR (str, 1, 30);
   END;

   /* Returns list of distinct program units in specified object. */
   FUNCTION progs (
      sch IN VARCHAR2,
      pkg IN VARCHAR2,
      obj IN VARCHAR2 ) RETURN prog_tt
   IS
      retval prog_tt;
      temp prog_tt;
   BEGIN
      progs (sch, pkg, obj, retval/*, temp, NULL*/);
      RETURN retval;
   END;

   PROCEDURE progs (
      sch IN VARCHAR2,
      pkg IN VARCHAR2,
      obj IN VARCHAR2,
      progtab IN OUT prog_tt,
      startrow IN PLS_INTEGER := NULL
      )
   IS
      CURSOR progs_cur (sch VARCHAR2, pkg VARCHAR2, obj VARCHAR2)
      IS
         SELECT DISTINCT A.object_name
           FROM ALL_ARGUMENTS A
          WHERE ((package_name = pkg AND obj IS NULL) OR
                 (package_name IS NULL AND pkg IS NULL AND object_name = obj) OR
                 (package_name = pkg AND object_name = obj))
            AND A.owner = sch;

      v_row PLS_INTEGER := NVL (startrow, NVL (progtab.LAST, 0) + 1);
   BEGIN
      FOR rec IN progs_cur
         (NVL (sch, USER), UPPER (pkg), UPPER (obj))
      LOOP
         progtab (v_row).progname := rec.object_name;
         v_row := v_row + 1;
      END LOOP;
   END;
   
   PROCEDURE args (
      sch IN VARCHAR2,
      pkg IN VARCHAR2,
      obj IN VARCHAR2,
      arglist_out IN OUT arglist_tt,
      startrow IN PLS_INTEGER := NULL
      )
   IS
      CURSOR arg_cur (own VARCHAR2, pkg VARCHAR2, obj VARCHAR2)
      IS
         SELECT *
           FROM ALL_ARGUMENTS
          WHERE owner = own
            AND ((package_name = pkg AND obj IS NULL) OR
                 (package_name IS NULL AND pkg IS NULL AND object_name = obj) OR
                 (package_name = pkg AND object_name = obj))
          ORDER BY package_name, object_name;

      v_start PLS_INTEGER := NVL (startrow, 1);
      v_row PLS_INTEGER;
   BEGIN
      FOR rec IN arg_cur (NVL (sch, USER), UPPER (pkg), UPPER (obj))
      LOOP
         v_row := NVL (arglist_out.LAST, 0) + v_start;
         arglist_out (v_row).OWNER := rec.OWNER;
         arglist_out (v_row).OBJECT_NAME := rec.OBJECT_NAME;
         arglist_out (v_row).PACKAGE_NAME := rec.PACKAGE_NAME;
         arglist_out (v_row).OBJECT_ID := rec.OBJECT_ID;
         arglist_out (v_row).OVERLOAD := rec.OVERLOAD;
         arglist_out (v_row).ARGUMENT_NAME := rec.ARGUMENT_NAME;
         arglist_out (v_row).POSITION := rec.POSITION;
         arglist_out (v_row).SEQUENCE := rec.SEQUENCE;
         arglist_out (v_row).DATA_LEVEL := rec.DATA_LEVEL;
         arglist_out (v_row).DATA_TYPE := rec.DATA_TYPE;
         arglist_out (v_row).DEFAULT_VALUE := rec.DEFAULT_VALUE;
         arglist_out (v_row).DEFAULT_LENGTH := rec.DEFAULT_LENGTH;
         -- Convert IN/OUT to IN OUT
         arglist_out (v_row).IN_OUT := TRANSLATE (rec.IN_OUT, '/', ' ');
         arglist_out (v_row).DATA_LENGTH := rec.DATA_LENGTH;
         arglist_out (v_row).DATA_PRECISION := rec.DATA_PRECISION;
         arglist_out (v_row).DATA_SCALE := rec.DATA_SCALE;
         arglist_out (v_row).RADIX := rec.RADIX;
         
         /* Oracle8 only */
         &authidopen
         arglist_out (v_row).CHARACTER_SET_NAME := rec.CHARACTER_SET_NAME;
         arglist_out (v_row).TYPE_OWNER := rec.TYPE_OWNER;
         arglist_out (v_row).TYPE_NAME := rec.TYPE_NAME;
         arglist_out (v_row).TYPE_SUBNAME := rec.TYPE_SUBNAME;
         arglist_out (v_row).TYPE_LINK := rec.TYPE_LINK;
         &authidclose
      END LOOP;
   END;

   PROCEDURE set_data_type (itype IN VARCHAR2, otype IN OUT VARCHAR2)
   IS
   BEGIN
      IF itype = g_datatype_names (c_boolean)
      THEN
         otype := 'BOOLEAN';
      ELSIF itype = g_datatype_names (c_integer)
      THEN
         otype := 'INTEGER';
      ELSE
         otype := itype;
      END IF;
   END;
   
   PROCEDURE get_prog_info (
      sch IN VARCHAR2,
      pkg IN VARCHAR2,
      obj IN VARCHAR2,
      proglist IN OUT prog_tt,
      arglist IN OUT arglist_tt,
      retarglist IN OUT arglist_tt,
      progstart IN PLS_INTEGER := NULL,
      argstart IN PLS_INTEGER := NULL
      )
   IS
      CURSOR arg_cur (own VARCHAR2, pkg VARCHAR2, obj VARCHAR2)
      IS
         SELECT *
           FROM ALL_ARGUMENTS
          WHERE owner = own
            AND ((package_name = pkg AND obj IS NULL) OR
                 (package_name IS NULL AND pkg IS NULL AND object_name = obj) OR
                 (package_name = pkg AND object_name = obj))
          ORDER BY package_name, object_name;
      rec arg_cur%ROWTYPE;
      
      v_pkg PLGadmin.identifier := UPPER (pkg);
      v_obj PLGadmin.identifier := UPPER (obj);
      
      v_argstart PLS_INTEGER := NVL (argstart, 1);
      v_progstart PLS_INTEGER := NVL (progstart, 1);
      v_argrow PLS_INTEGER;
      v_RETargrow PLS_INTEGER;
      v_progrow PLS_INTEGER;
      v_lastprog PLGadmin.identifier := '*';
      v_lastover PLS_INTEGER;
      v_setretarg BOOLEAN := FALSE;
      
      PROCEDURE set_retarg_end_values IS
      BEGIN
         proglist(v_progrow).ret_endrow := v_retargrow;
         proglist(v_progrow).ret_argcount := 
            proglist(v_progrow).ret_endrow - 
            proglist(v_progrow).ret_startrow + 1;
         v_setretarg := FALSE;
      END;
      
      PROCEDURE set_end_values IS
      BEGIN                    
         IF v_setretarg
         THEN
            set_retarg_end_values;
            
            /* Last program was a function that did not have
               any non-return arguments. So calculate the 
               end row for the return information. */
            proglist(v_progrow).argcount := 0;
         ELSE
            IF proglist(v_progrow).startrow IS NULL
            THEN
               /* Procedure has no arguments at all... */
               proglist(v_progrow).endrow := NULL;
               proglist(v_progrow).argcount := 0;
            ELSE
               proglist(v_progrow).endrow := v_argrow;
               proglist(v_progrow).argcount := 
                  proglist(v_progrow).endrow - proglist(v_progrow).startrow + 1;
            END IF;
         END IF;
      END;

      PROCEDURE set_prog_info (rec IN arg_cur%ROWTYPE)
      IS
         v_addit BOOLEAN := FALSE;
         v_atfirst BOOLEAN := v_lastprog = '*';
      BEGIN
         v_addit :=
            rec.object_name != v_lastprog  OR
            (rec.object_name = v_lastprog AND
             v_lastover != NVL (rec.overload, -1));

         IF v_addit
         THEN
            v_lastprog := rec.object_name;
            
            IF v_atfirst
            THEN
               /* Don't set last arg row information. */
               NULL;
            ELSE
               set_end_values;
            END IF;

            v_lastover := rec.overload;
            v_progrow := NVL (proglist.LAST, 0) + v_progstart;
            proglist(v_progrow).progname := rec.OBJECT_NAME;
            proglist(v_progrow).pkgname := v_pkg;
            proglist(v_progrow).isoverloaded := rec.overload IS NOT NULL;
            proglist(v_progrow).overload := rec.overload;
            
            IF rec.position = 0 /* We have a function. */
            THEN
               v_setretarg := TRUE;
               v_retargrow := NVL (retarglist.LAST, 0) + 1;

               proglist(v_progrow).progtype := 'FUNCTION';
               proglist(v_progrow).isfunction := TRUE;
               proglist(v_progrow).isprocedure := FALSE;
               set_data_type (rec.data_type, proglist(v_progrow).ret_data_type);
               proglist(v_progrow).ret_startrow := v_retargrow;
               proglist(v_progrow).ret_has_composite := 
                  based_on_type (rec.data_type);
               
               /* Don't want to set startrow until after the return argument
                  information has been moved to the retarg list. */
            ELSE
               proglist(v_progrow).progtype := 'PROCEDURE';
               proglist(v_progrow).isfunction := FALSE;
               proglist(v_progrow).isprocedure := TRUE;
               
               IF rec.sequence = 0
               THEN
                  /* No parameters for the procedure at all! */
                  proglist(v_progrow).startrow := NULL;               
               ELSE
                  v_argrow := NVL (arglist.LAST, 0) + v_argstart;
                  proglist(v_progrow).startrow := v_argrow;               
               END IF;
            END IF;
         
         /* Same program, but perhaps done with return argument */
         ELSIF v_setretarg
         THEN
            /* If level has gone back to 0, then that is the end
               of my return argument information. */
            IF rec.data_level = 0
            THEN
               set_retarg_end_values;
               v_argrow := NVL (arglist.LAST, 0) + v_argstart;
               proglist(v_progrow).startrow := v_argrow;               
            ELSE
               v_retargrow := NVL (retarglist.LAST, 0) + 1;
            END IF;   
         ELSE
            v_argrow := NVL (arglist.LAST, 0) + v_argstart;         
         END IF; 
      END;
      
      PROCEDURE set_arg_info (rec IN arg_cur%ROWTYPE)
      IS
      BEGIN
         IF rec.sequence = 0 /* Dummy entry for procedure without any args */
         THEN
            NULL;
         ELSE
            arglist (v_argrow).OWNER := rec.OWNER;
            arglist (v_argrow).OBJECT_NAME := rec.OBJECT_NAME;
            arglist (v_argrow).PACKAGE_NAME := rec.PACKAGE_NAME;
            arglist (v_argrow).OBJECT_ID := rec.OBJECT_ID;
            arglist (v_argrow).OVERLOAD := rec.OVERLOAD;
            arglist (v_argrow).ARGUMENT_NAME := rec.ARGUMENT_NAME;
            arglist (v_argrow).POSITION := rec.POSITION;
            arglist (v_argrow).SEQUENCE := rec.SEQUENCE;
            arglist (v_argrow).DATA_LEVEL := rec.DATA_LEVEL;
            set_data_type (rec.data_type, arglist (v_argrow).DATA_TYPE);
            arglist (v_argrow).DEFAULT_VALUE := rec.DEFAULT_VALUE;
            arglist (v_argrow).DEFAULT_LENGTH := rec.DEFAULT_LENGTH;
            -- Convert IN/OUT to IN OUT
            arglist (v_argrow).IN_OUT := TRANSLATE (rec.IN_OUT, '/', ' ');
            arglist (v_argrow).DATA_LENGTH := rec.DATA_LENGTH;
            arglist (v_argrow).DATA_PRECISION := rec.DATA_PRECISION;
            arglist (v_argrow).DATA_SCALE := rec.DATA_SCALE;
            arglist (v_argrow).RADIX := rec.RADIX;