Accessible PL/SQL Programs in Oracle Database 18c

-- PARSEQUERY: Parse a SQL query and return in a CLOB as XML
-- PARAMS:
--      currUid         - UID of current user
--      schema          - schem to use for parse
--      sqltext         - the text of the query
--      lobloc          - a LOB locator to receive the parsed value

PROCEDURE parseQuery   (currUid IN NUMBER,
                        schema  IN VARCHAR2,
                        sqltext IN CLOB,
                        lobloc  IN OUT NOCOPY CLOB
                       )
  ACCESSIBLE BY (PACKAGE SYS.DBMS_METADATA);

WITH
   --
   -- remove multi-line comments from source
   --
   FUNCTION remove_ml_comments (in_source IN CLOB) RETURN CLOB IS
   BEGIN 
      RETURN regexp_replace(in_source, '/\*.*?\*/', NULL, 1, 0, 'n');
   END remove_ml_comments;
   --
   -- remove single-line comments from source
   --
   FUNCTION remove_sl_comments (in_source IN CLOB) RETURN CLOB IS
   BEGIN 
      RETURN regexp_replace(in_source, '--.*');
   END remove_sl_comments;
   --
   -- remove simple string literals from source
   --
   FUNCTION remove_simple_string_literals (in_source IN CLOB) RETURN CLOB IS
   BEGIN 
      RETURN regexp_replace(in_source, q'['.*?']', NULL, 1, 0, 'n');
   END remove_simple_string_literals;
   --
   -- remove quoted string literals from source
   -- supporting the following quote_delimiter pairs only: (), {}, [], <>, $, ##, @@, ££, "", //, ||, !!, ++, ~~
   --
   FUNCTION remove_quoted_string_literals (
      in_source IN CLOB
   ) RETURN CLOB IS
      co_pattern CONSTANT VARCHAR2(200) :=
         q'[n?q'((\(.*?\))|(\{.*?\})|(\[.*?\])|(<.*?>)|(\$.*?\$)|(#.*?#)|(@.*?@)|(£.*?£)|(".*?")|(/.*?/)|(\|.*?\|)|(!.*?!)|(\+.*?\+)|(~.*?~))']';
   BEGIN
      RETURN regexp_replace(in_source, co_pattern, NULL, 1, 0, 'in');
   END remove_quoted_string_literals;
   --
   -- remove all string literals and comments from source
   --
   FUNCTION remove_all (in_source IN CLOB) RETURN CLOB IS
      l_clob CLOB := in_source;
   BEGIN 
      l_clob := remove_sl_comments(l_clob);
      l_clob := remove_quoted_string_literals(l_clob);
      l_clob := remove_simple_string_literals(l_clob);
      l_clob := remove_ml_comments(l_clob);
      return l_clob;
   END remove_all;
   --
   -- get subprogram associated with the accessible_by_clause in JSON format, e.g.
   --    {
   --       "id": 5,
   --       "type": "PROCEDURE",
   --       "name": "parseQuery",
   --    }
   --
   -- return NULL if accessible_by_clause is for the PL/SQL unit
   --
   FUNCTION get_subprogram(
      in_object_type VARCHAR2,
      in_source      CLOB,
      in_pos         INTEGER
   ) RETURN VARCHAR2 IS
      l_subprogram json_object_t;
      co_pattern   CONSTANT VARCHAR2(100 CHAR) := '(function|procedure)(\s+)("?[a-zA-Z0-9_#$]+"?)';
      l_source     CLOB;
      l_count      INTEGER;
      l_match      VARCHAR2(4000 CHAR);
   BEGIN
      l_subprogram := json_object_t();
      IF in_object_type NOT IN ('FUNCTION', 'PROCEDURE') THEN
         l_source := regexp_replace(substr(in_source, 1, in_pos - 1), 'accessible\s+by\s*\(.*?\)', NULL, 1, 0, 'in');
         l_count := regexp_count(l_source, co_pattern, 1, 'in');
         IF l_count > 0 THEN
            l_match := regexp_substr(l_source, co_pattern, 1, l_count, 'in');
            l_subprogram.put('id', l_count);
            l_subprogram.put('type', regexp_substr(l_match, co_pattern, 1, 1, 'in', 1));
            l_subprogram.put('name', regexp_substr(l_match, co_pattern, 1, 1, 'in', 3));
         END IF;
      END IF;
      RETURN l_subprogram.to_string();
   END get_subprogram;
   --
   -- get the list of subprograms and its accessors as JSON array, e.g.
   --    [
   --        {
   --            "id": 5,
   --            "type": "PROCEDURE",
   --            "name": "parseQuery",
   --            "accessors": [
   --                {
   --                    "unit_kind": "PACKAGE",
   --                    "schema": "SYS",
   --                    "unit_name": "DBMS_METADATA"
   --                }
   --            ]
   --        }
   --    ]
   --
   FUNCTION get_accessors(
      in_object_type          VARCHAR2,
      in_source               CLOB,
      in_accessible_by_count  INTEGER
   ) RETURN CLOB IS
      co_full_clause_pattern CONSTANT VARCHAR2(100 CHAR) := 'accessible\s+by\s*\(.*?\)';
      co_accessor_pattern    CONSTANT VARCHAR2(200 CHAR) := 
         '(\(|,)(\s*)(function|procedure|package|trigger|type)?(\s*)("?[a-zA-Z0-9_#$]+"?\s*\.)?("?[a-zA-Z0-9_#$]+"?)';
      l_subprograms          json_array_t;
      l_subprogram           json_object_t;
      l_full_clause          VARCHAR2(4000 CHAR);
      l_accessors            json_array_t;
      l_accessor             json_object_t;
      l_pos                  INTEGER;
      l_accessor_count       INTEGER;
   BEGIN
      l_subprograms := json_array_t();
      <<accessible_by_clauses>>
      FOR i in 1 .. in_accessible_by_count LOOP
         l_pos := regexp_instr(in_source, co_full_clause_pattern, 1, i, 0, 'in');
         l_subprogram := json_object_t.parse(get_subprogram(in_object_type, in_source, l_pos));
         l_full_clause := regexp_substr(in_source, co_full_clause_pattern, 1, i, 'in');
         l_accessor_count := regexp_count(l_full_clause, co_accessor_pattern, 1, 'in');
         l_accessors := json_array_t();
         <<accessors>>
         FOR j in 1 .. l_accessor_count LOOP
            l_accessor := json_object_t();
            l_accessor.put('unit_kind', regexp_substr(l_full_clause, co_accessor_pattern, 1, j, 'in', 3));
            l_accessor.put('schema', replace(regexp_substr(l_full_clause, co_accessor_pattern, 1, j, 'in', 5),'.'));
            l_accessor.put('unit_name', regexp_substr(l_full_clause, co_accessor_pattern, 1, j, 'in', 6));
            l_accessors.append(l_accessor);
         END LOOP accessors;
         l_subprogram.put('accessors', l_accessors);
         l_subprograms.append(l_subprogram);
      END LOOP accessible_by_clauses;
      return l_subprograms.to_clob();
   END get_accessors;
   --
   -- ensure identifier matches case sensitive name in Orace data dictionary 
   --
   FUNCTION fix_identifier (in_identifier IN VARCHAR2) RETURN VARCHAR2 IS
      l_identifier VARCHAR2(128 CHAR);
   BEGIN
      IF in_identifier LIKE '"%"' THEN
         l_identifier := substr(in_identifier, 2, length(in_identifier) - 2);
      ELSE
         l_identifier := upper(in_identifier);
      END IF;
      RETURN l_identifier;
   END fix_identifier;
   --
   -- possible PL/SQL units with an accessible_by_clause (optimization step)
   -- false positives when keyword 'accessible' is not used in a accessible_by_clause
   --
   candidates AS (
      SELECT /*+ no_merge */ 
             s.owner, s.type AS object_type, s.name AS object_name, u.oracle_maintained
        FROM dba_users u
        JOIN dba_source s
          ON u.username = s.owner
       WHERE s.type IN ('FUNCTION', 'PROCEDURE', 'PACKAGE', 'TYPE')
         AND lower(text) LIKE '%accessible%'
       GROUP BY s.owner, s.type, s.name, u.oracle_maintained
   ),
   --
   -- extend result with source code (unmodified)
   --
   original_sources AS (
      SELECT owner, object_type, object_name, oracle_maintained,
             sys.dbms_metadata.get_ddl(
                schema      => owner,
                object_type => CASE object_type
                                  WHEN 'PACKAGE' THEN
                                     'PACKAGE_SPEC'
                                  WHEN 'TYPE' THEN
                                     'TYPE_SPEC'
                                  ELSE 
                                     object_type
                               END,
                name        => object_name
             ) AS source_code
        FROM candidates 
   ),
   --
   -- remove comments and string literals from source code to simplify parsing
   --
   reduced_sources AS (
      SELECT owner, 
             object_type, 
             object_name,
             oracle_maintained,
             remove_all(source_code) AS source_code
        FROM original_sources
   ),
   --
   -- extend result with number of accessible_by_clauses in source
   --
   counts AS (
      SELECT owner, 
             object_type, 
             object_name, 
             source_code,
             oracle_maintained,
             regexp_count(source_code, 'accessible\s+by\s*\(.*?\)', 1, 'in') accessible_by_count
        FROM reduced_sources
   ),
   --
   -- produce a row for every accessor and extend results by accessor related columns
   --
   procedure_accessors AS (
      SELECT c.owner,
             c.object_type,
             c.object_name,
             c.oracle_maintained,
             upper(a.subprogram_type)             AS subprogram_type,
             fix_identifier(a.subprogram_name)    AS procedure_name,
             coalesce(a.subprogram_id, 0)         AS subprogram_id,
             upper(a.accessor_unit_kind)          AS accessor_unit_kind,
             fix_identifier(a.accessor_schema)    AS accessor_schema,
             fix_identifier(a.accessor_unit_name) AS accessor_unit_name
        FROM counts c
       CROSS JOIN JSON_TABLE(
                get_accessors(c.object_type, c.source_code, c.accessible_by_count), 
                '$[*]' columns (
                   subprogram_type VARCHAR2(30 CHAR)  PATH '$.type',
                   subprogram_name VARCHAR2(128 CHAR) PATH '$.name',
                   subprogram_id   INTEGER            PATH '$.id',
                   nested path '$.accessors[*]' columns (
                      accessor_unit_kind VARCHAR2(30 CHAR)  PATH '$.unit_kind',
                      accessor_schema    VARCHAR2(128 CHAR) PATH '$.schema',
                      accessor_unit_name VARCHAR2(128 CHAR) PATH '$.unit_name'
                   )
                )
             ) a
       WHERE c.accessible_by_count > 0 
   ),
   --
   -- produce compact accessor column, remove duplicates from overloaded subprograms
   --
   aggr_procedure_accessors_base AS (
      SELECT DISTINCT 
             owner, 
             object_type, 
             object_name, 
             procedure_name,
             accessor_unit_kind,
             accessor_schema,
             accessor_unit_name,
             CASE
                WHEN accessor_unit_kind IS NOT NULL THEN
                   accessor_unit_kind || ' '
             END || 
             CASE
                WHEN accessor_schema IS NOT NULL THEN
                   accessor_schema || '.'
             END ||
             accessor_unit_name AS accessor,
             oracle_maintained
        FROM procedure_accessors
   ),
   --
   -- aggregated result per subprogram with accessor_list containing comma separated list of all accessors
   --
   aggr_procedure_accessors AS (
      SELECT owner, 
             object_type, 
             object_name, 
             procedure_name, 
             listagg (accessor, ', ') WITHIN GROUP(ORDER BY accessor) AS accessor_list 
        FROM aggr_procedure_accessors_base
       WHERE oracle_maintained = 'Y'
       GROUP BY owner, object_type, object_name, procedure_name
       ORDER BY owner, object_type, object_name, procedure_name
   )
-- main
SELECT *
  FROM aggr_procedure_accessors
/