text: create or replace package body ut_annotation_parser as
    /*
    utPLSQL - Version 3
    Copyright 2016 - 2019 utPLSQL Project
  
    Licensed under the Apache License, Version 2.0 (the "License"):
    you may not use this file except in compliance with the License.
    You may obtain a copy of the License at
  
        http://www.apache.org/licenses/LICENSE-2.0
  
    Unless required by applicable law or agreed to in writing, software
    distributed under the License is distributed on an "AS IS" BASIS,
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.
    */
  
    ------------------------------
    --private definitions
  
    type tt_comment_list is table of varchar2(32767) index by binary_integer;
  
    gc_annotation_qualifier        constant varchar2(1) := '%';
    gc_annot_comment_pattern       constant varchar2(30) := '^( |'||chr(09)||')*-- *('||gc_annotation_qualifier||'.*?)$'; -- chr(09) is a tab character
    gc_comment_replacer_patter     constant varchar2(50) := '{COMMENT#%N%}';
    gc_comment_replacer_regex_ptrn constant varchar2(25) := '{COMMENT#(\d+)}';
    gc_regexp_identifier           constant varchar2(50) := '[a-zA-Z][a-zA-Z0-9#_$]*';
    gc_annotation_block_pattern    constant varchar2(200) := '(({COMMENT#.+}'||chr(10)||')+)( |'||chr(09)||')*(procedure|function)\s+(' ||
                                                             gc_regexp_identifier || ')';
    gc_annotation_pattern          constant varchar2(50) := gc_annotation_qualifier || gc_regexp_identifier || '[ '||chr(9)||']*(\(.*?\)\s*?$)?';
  
  
    procedure add_annotation(
      a_annotations in out nocopy ut_annotations,
      a_position positiven,
      a_comment varchar2,
      a_subobject_name varchar2 := null
    ) is
      l_annotation_str   varchar2(32767);
      l_annotation_text  varchar2(32767);
      l_annotation_name  varchar2(1000);
    begin
      -- strip everything except the annotation itself (spaces and others)
      l_annotation_str := regexp_substr(a_comment, gc_annotation_pattern, 1, 1, modifier => 'i');
      if l_annotation_str is not null then
  
        -- get the annotation name and it's parameters if present
        l_annotation_name := lower(regexp_substr(l_annotation_str ,'%(' || gc_regexp_identifier || ')', subexpression => 1));
        l_annotation_text := trim(regexp_substr(l_annotation_str, '\((.*?)\)\s*$', subexpression => 1));
  
        a_annotations.extend;
        a_annotations( a_annotations.last) :=
          ut_annotation(a_position, l_annotation_name, l_annotation_text, a_subobject_name);
      end if;
    end;
  
    procedure delete_processed_comments( a_comments in out nocopy tt_comment_list, a_annotations ut_annotations ) is
      l_loop_index       binary_integer := 1;
    begin
      l_loop_index := a_annotations.first;
      while l_loop_index is not null loop
        a_comments.delete( a_annotations(l_loop_index).position );
        l_loop_index := a_annotations.next( l_loop_index );
      end loop;
    end;
  
    procedure add_annotations(
      a_annotations in out nocopy ut_annotations,
      a_source varchar2,
      a_comments tt_comment_list,
      a_subobject_name varchar2 := null
    ) is
      l_loop_index       binary_integer := 1;
      l_annotation_index binary_integer;
    begin
      -- loop while there are unprocessed comment blocks
      while 0 != nvl(regexp_instr(srcstr        => a_source
                                 ,pattern       => gc_comment_replacer_regex_ptrn
                                 ,occurrence    => l_loop_index
                                 ,subexpression => 1)
                    ,0) loop
  
        -- define index of the comment block and get it's content from cache
        l_annotation_index := regexp_substr( a_source ,gc_comment_replacer_regex_ptrn ,1 ,l_loop_index ,subexpression => 1);
        add_annotation( a_annotations, l_annotation_index, a_comments( l_annotation_index ), a_subobject_name );
        l_loop_index := l_loop_index + 1;
      end loop;
  
    end add_annotations;
  
    procedure add_procedure_annotations(a_annotations in out nocopy ut_annotations, a_source clob, a_comments in out nocopy tt_comment_list) is
      l_proc_comments         varchar2(32767);
      l_proc_name             varchar2(250);
      l_annot_proc_ind        number;
      l_annot_proc_block      varchar2(32767);
    begin
      -- loop through procedures and functions of the package and get all the comment blocks just before it's declaration
      l_annot_proc_ind := 1;
      loop
        --find annotated procedure index
        l_annot_proc_ind := regexp_instr(srcstr     => a_source
                                        ,pattern    => gc_annotation_block_pattern
                                        ,occurrence => 1
                                        ,modifier   => 'i'
                                        ,position   => l_annot_proc_ind);
        exit when l_annot_proc_ind = 0;
  
        --get the annotations with procedure name
        l_annot_proc_block := regexp_substr(srcstr     => a_source
                                           ,pattern    => gc_annotation_block_pattern
                                           ,position   => l_annot_proc_ind
                                           ,occurrence => 1
                                           ,modifier   => 'i');
  
        --extract the annotations
        l_proc_comments := trim(regexp_substr(srcstr        => l_annot_proc_block
                                             ,pattern       => gc_annotation_block_pattern
                                             ,modifier      => 'i'
                                             ,subexpression => 1));
        --extract the procedure name
        l_proc_name     := trim(regexp_substr(srcstr        => l_annot_proc_block
                                             ,pattern       => gc_annotation_block_pattern
                                             ,modifier      => 'i'
                                             ,subexpression => 5));
  
        -- parse the comment block for the syntactically correct annotations and store them as an array
        add_annotations(a_annotations, l_proc_comments, a_comments, l_proc_name);
  
        l_annot_proc_ind := instr(a_source, ';', l_annot_proc_ind + length(l_annot_proc_block) );
      end loop;
    end add_procedure_annotations;
  
    function extract_and_replace_comments(a_source in out nocopy clob) return tt_comment_list is
      l_comments         tt_comment_list;
      l_comment_pos      binary_integer;
      l_comment_line     binary_integer;
      l_comment_replacer varchar2(50);
      l_source           clob := a_source;
    begin
      l_comment_pos := 1;
      loop
  
        l_comment_pos := regexp_instr(srcstr     => a_source
                                     ,pattern    => gc_annot_comment_pattern
                                     ,occurrence => 1
                                     ,modifier   => 'm'
                                     ,position   => l_comment_pos);
  
        exit when l_comment_pos = 0;
  
        -- position index is shifted by 1 because gc_annot_comment_pattern contains ^ as first sign
        -- but after instr index already points to the char on that line
        l_comment_pos := l_comment_pos-1;
        l_comment_line := length(substr(a_source,1,l_comment_pos))-length(replace(substr(a_source,1,l_comment_pos),chr(10)))+1;
        l_comments(l_comment_line) := trim(regexp_substr(srcstr        => a_source
                                                              ,pattern       => gc_annot_comment_pattern
                                                              ,occurrence    => 1
                                                              ,position      => l_comment_pos
                                                              ,modifier      => 'm'
                                                              ,subexpression => 2));
  
        l_comment_replacer := replace(gc_comment_replacer_patter, '%N%', l_comment_line);
  
        l_source    := regexp_replace(srcstr     => a_source
                                     ,pattern    => gc_annot_comment_pattern
                                     ,replacestr => l_comment_replacer
                                     ,position   => l_comment_pos
                                     ,occurrence => 1
                                     ,modifier   => 'm');
        dbms_lob.freetemporary(a_source);
        a_source := l_source;
        dbms_lob.freetemporary(l_source);
        l_comment_pos := l_comment_pos + length(l_comment_replacer);
  
      end loop;
  
      ut_utils.debug_log(a_source);
      return l_comments;
    end extract_and_replace_comments;
  
    ------------------------------------------------------------
    --public definitions
    ------------------------------------------------------------
  
    function parse_object_annotations(a_source clob) return ut_annotations is
      l_source           clob := a_source;
      l_comments         tt_comment_list;
      l_annotations      ut_annotations := ut_annotations();
      l_result           ut_annotations;
      l_comment_index    positive;
    begin
  
       l_source := ut_utils.replace_multiline_comments(l_source);
  
      -- replace all single line comments with {COMMENT#12} element and store it's content for easier processing
      -- this call modifies l_source
      l_comments := extract_and_replace_comments(l_source);
  
      add_procedure_annotations(l_annotations, l_source, l_comments);
  
      delete_processed_comments(l_comments, l_annotations);
  
      --at this point, only the comments not related to procedures are left, so we process them all as top-level
      l_comment_index := l_comments.first;
      while l_comment_index is not null loop
        add_annotation( l_annotations, l_comment_index, l_comments( l_comment_index ) );
        l_comment_index := l_comments.next(l_comment_index);
      end loop;
  
      dbms_lob.freetemporary(l_source);
  
      select value(x) bulk collect into l_result from table(l_annotations) x order by x.position;
  
      -- printing out parsed structure for debugging
      $if $$ut_trace $then
        print_parse_results(l_result);
        dbms_output.put_line('Annotations count: ' || l_result.count);
        for i in 1 .. l_result.count loop
          dbms_output.put_line(xmltype(l_result(i)).getclobval());
        end loop;
      $end
      return l_result;
    end parse_object_annotations;
  
    function parse_object_annotations(a_source_lines dbms_preprocessor.source_lines_t, a_object_type varchar2) return ut_annotations is
      l_processed_lines dbms_preprocessor.source_lines_t;
      l_source          clob;
      l_annotations     ut_annotations := ut_annotations();
      ex_package_is_wrapped exception;
      pragma exception_init(ex_package_is_wrapped, -24241);
  
    begin
      if a_source_lines.count > 0 then
        --convert to post-processed source clob
        begin
          --get post-processed source
          if a_object_type = 'TYPE' then
            l_processed_lines := a_source_lines;
          else
            l_processed_lines := sys.dbms_preprocessor.get_post_processed_source(a_source_lines);
          end if;
          --convert to clob
          for i in 1..l_processed_lines.count loop
            ut_utils.append_to_clob(l_source, replace(l_processed_lines(i), chr(13)||chr(10), chr(10)));
          end loop;
          --parse annotations
          l_annotations := parse_object_annotations(l_source);
          dbms_lob.freetemporary(l_source);
        exception
          when ex_package_is_wrapped then
            null;
        end;
      end if;
      return l_annotations;
    end;
  
  end ut_annotation_parser;
  /
  