[Dica] O que está rodando / Quem chamou - dinamicamente

Dúvidas, dicas e truques de PL/SQL. Aqui também vão assuntos relacionados a pacotes, triggers, funções, Java-Stored Procedures, etc
Responder
Avatar do usuário
dr_gori
Moderador
Moderador
Mensagens: 5024
Registrado em: Seg, 03 Mai 2004 3:08 pm
Localização: Portland, OR USA
Contato:
Thomas F. G

Você já respondeu a dúvida de alguém hoje?
https://glufke.net/oracle/search.php?search_id=unanswered

As vezes precisamos saber em uma procedure/função "quem chamou" a rotina. Ou saber qual é a procedure ou package que está sendo executada...
Esta rotina faz exatamente isto!

Selecionar tudo

create or replace procedure who_called_me( owner      out varchar2,
                         name       out varchar2,
                         lineno     out number,
                         caller_t   out varchar2 )
as
    call_stack  varchar2(4096) default dbms_utility.format_call_stack;
    n           number;
    found_stack BOOLEAN default FALSE;
    line        varchar2(255);
    cnt         number := 0;
begin
--
    loop
        n := instr( call_stack, chr(10) );
        exit when ( cnt = 3 or n is NULL or n = 0 );
--
        line := substr( call_stack, 1, n-1 );
        call_stack := substr( call_stack, n+1 );
--
        if ( NOT found_stack ) then
            if ( line like '%handle%number%name%' ) then
                found_stack := TRUE;
            end if;
        else
            cnt := cnt + 1;
            -- cnt = 1 is ME
            -- cnt = 2 is MY Caller
            -- cnt = 3 is Their Caller
            if ( cnt = 3 ) then
                lineno := to_number(substr( line, 13, 6 ));
                line   := substr( line, 21 );
                if ( line like 'pr%' ) then
                    n := length( 'procedure ' );
                elsif ( line like 'fun%' ) then
                    n := length( 'function ' );
                elsif ( line like 'package body%' ) then
                    n := length( 'package body ' );
                elsif ( line like 'pack%' ) then
                    n := length( 'package ' );
                elsif ( line like 'anonymous%' ) then
                    n := length( 'anonymous block ' );
                else
                    n := null;
                end if;
                if ( n is not null ) then
                   caller_t := ltrim(rtrim(upper(substr( line, 1, n-1 ))));
                else
                   caller_t := 'TRIGGER';
                end if;

                line := substr( line, nvl(n,1) );
                n := instr( line, '.' );
                owner := ltrim(rtrim(substr( line, 1, n-1 )));
                name  := ltrim(rtrim(substr( line, n+1 )));
            end if;
        end if;
    end loop;
end;
/

create or replace function who_am_i return varchar2 
is
    l_owner        varchar2(30);
    l_name      varchar2(30);
    l_lineno    number;
    l_type      varchar2(30);
begin
   who_called_me( l_owner, l_name, l_lineno, l_type );
   return l_owner || '.' || l_name;
end;
/

Aí vai um exemplo

Selecionar tudo

SQL> create or replace procedure demo
  2  as
  3  begin
  4     dbms_output.put_line( who_am_i );
  5  end;
  6  /

Procedure created.

SQL> exec demo;
SCOTT.DEMO
Renato Menezes Viana
Rank: Analista Pleno
Rank: Analista Pleno
Mensagens: 128
Registrado em: Sáb, 18 Nov 2006 11:51 am
Localização: Rio de Janeiro - RJ

Fiz umas correções talvez por causa do meu ambiente. São apenas QUATRO, confira aí. Muito boa sua rotina. Beleza mesmo!

Selecionar tudo

create or replace procedure who_called_me( owner      out varchar2,
                         name       out varchar2,
                         lineno     out number,
                         caller_t   out varchar2 )
as
    call_stack  varchar2(4096); --default dbms_utility.format_call_stack; ---PRIMEIRA
    n           number;
    found_stack BOOLEAN default FALSE;
    line        varchar2(255);
    cnt         number := 0;
begin
--
    call_stack := dbms_utility.format_call_stack; -- now default --- SEGUNDA
    loop
        n := instr( call_stack, chr(10) );
        exit when ( cnt = 3 or n is NULL or n = 0 );
--
        line := substr( call_stack, 1, n-1 );
        call_stack := substr( call_stack, n+1 );
--
        if ( NOT found_stack ) then
            if ( line like '%handle%number%name%' ) then
                found_stack := TRUE;
            end if;
        else
            cnt := cnt + 1;
            -- cnt = 1 is ME
            -- cnt = 2 is MY Caller
            -- cnt = 3 is Their Caller
            if ( cnt = 3 ) then
                lineno := to_number(substr( line, 13, 8 )); -- line, 13,6 -- TERCEIRA
                line   := substr( line, 23 ); -- line, 21 -- QUARTA
                if ( line like 'pr%' ) then
                    n := length( 'procedure ' );
                elsif ( line like 'fun%' ) then
                    n := length( 'function ' );
                elsif ( line like 'package body%' ) then
                    n := length( 'package body ' );
                elsif ( line like 'pack%' ) then
                    n := length( 'package ' );
                elsif ( line like 'anonymous%' ) then
                    n := length( 'anonymous block ' );
                else
                    n := null;
                end if;
                if ( n is not null ) then
                   caller_t := ltrim(rtrim(upper(substr( line, 1, n-1 ))));
                else
                   caller_t := 'TRIGGER';
                end if;

                line := substr( line, nvl(n,1) );
                n := instr( line, '.' );
                owner := ltrim(rtrim(substr( line, 1, n-1 )));
                name  := ltrim(rtrim(substr( line, n+1 )));
            end if;
        end if;
    end loop;
end;
Renato Menezes Viana
Rank: Analista Pleno
Rank: Analista Pleno
Mensagens: 128
Registrado em: Sáb, 18 Nov 2006 11:51 am
Localização: Rio de Janeiro - RJ

Com base na WHO_CALLED_ME e WHO_AM_I, foi criada a WHO_TRACE_ME
que ajuda no registro do comportamento de uma aplicação.

Selecionar tudo

create or replace procedure who_trace_me(
 dctrace in out varchar2,
 qifeitas in out number)
as

PRAGMA AUTONOMOUS_TRANSACTION;

    l_owner     varchar2(30);
    l_name      varchar2(30);
    l_lineno    number;
    l_type      varchar2(30);

    t_owner     varchar2(30);
    t_name      varchar2(30);
    t_lineno    number;
    t_type      varchar2(30);

  sid                NUMBER;
  session_user       VARCHAR2(30);
  db_name            VARCHAR2(30);
  os_user            VARCHAR2(30);
  os_terminal        VARCHAR2(30);
  ip_address         VARCHAR2(30);

    
    v_number    number;
    v_length    number;
    v_first     number := 0;
    v_last      number := 0;



--*====================================================================
--* Procedure..:  who_trace_me
--* Descricao..:  Registra Descrição do Trace SID.OWNER.PROCESSO requisitante
--*               na Tabela SYS_TRACE com controle de interações.
--*               É um PRAGMA AUTONOMOUS_TRANSACTION onde seu commit não
--*               interfere na lógica da aplicação "em trace".
--*               IMPORTANTE:
--*               ==========
--*               dctrace é um parâmetro IN OUT varchar2 tamanho mínimo(3)/máximo(500); 
--*               sua função é conter dados que auxiliem o registro do Trace
--*               de um Processo (Nº da Inscrição sendo processada);
--*               qifeitas também é um parâmetro IN OUT number;
--*               sua função é informar/controlar as interações feitas E SEU USO
--*               É EXCLUSIVO da who_trace_me, embora seja IN.
--*
--*               AS PRIMEIRAS TRÊS POSIÇÔES do dctrace QUANDO NUMÉRICAS são
--*               utilizadas para controle da Quantidade de Interações (QI). 
--*
--*               Caso QI seja < 2 a procedure NÃO EXECUTA NENHUMA AÇÃO.
--*               Caso DCTRACE tenha menos de 3 posições a procedure NÃO EXECUTA NENHUMA AÇÃO. 
--*
--*               QI NÂO SENDO NUMÉRICA a rotina assume 002 para o USO DEFAULT.
--*
--*               QI sendo diferente de ZEROS, who_trace_me faz no mínimo o INSERT
--*               INICIAL (traced_begin_end = 'B') e o OUTRO INSERT na última interação
--*               (traced_begin_end = 'E').
--*               Assim, por exemplo, sendo QI = 100 e a who_trace_me for executada
--*               1000 vezes, acontece 20 INSERTs, ou seja, 2 INSERTs a cada 100 QI:
--*
--*               1(B)..100(E),101(B)..200(E),....500(B)..501(E),........901(B)..1000(E) 
--*
--*               O USO DEFAULT é visto como aquele que tem por objetivo registrar o
--*               HORÁRIO DE INÍCIO, TÉRMINO e CONDIÇÃO NORMAL DE TÉRMINO, assim a
--*               variável DCTRACE NÃO NECESSITA SER INICIALIZADA e terá a mesma
--*               funcionalidade descrita no código abaixo:  
--*    BEGIN
--*       dctrace := '002';
--*       who_trace_me (dctrace, qifeitas);
--*       select COLUNA_X into v_inscricao from TABELA_X when COLUNA_Y = VARIAVEL_Z;
--*       ...
--*       ...
--*       loop
--*       ...
--*         dctrace_loop := '100 Inscrição:' || v_inscricao;
--*         who_trace_me (dctrace_loop, qi_loop);
--*       end loop;
--*       ...
--*       commit;
--*       pscderro := 'OK';
--*       who_trace_me (dctrace, qifeitas);
--*   END
--*
--*               NOTE que existe um who_trace_me "mais interno" sendo responsável
--*               pelo trace do LOOP e assim usa variáveis próprias para controle
--*               deste "TRACE_LOOP".
--*
--*               Das colunas registradas na BNF_TRACE está a SID (Session ID)
--*               permitindo unificar o registro de uma aplicação independente
--*               da quantidade de OBJETOS chamados.
--*
--* Programa...:  Esta procedure chama who_called_me (QUEM_ME_CHAMOU) para
--*               ter além do OWNER.OBJETO "em trace" ter também
--*               o OWNER.OBJETO ORIGINADOR (CHAMADOR DO "em trace").
--*
--* Data.......:  15/03/2013
--* Autor .....:  Renato Viana
--* Revisões...:
--* Data.......:
--* Autor Rev..:
--*=====================================================================


begin
  
   if dctrace is null then
      dctrace := '002';
      qifeitas := 002;
   end if;  

   if length(dctrace) < 3 then
     return;
   end if; 
       
   v_length := length(dctrace);
   if v_length > 500 then
     dctrace := substr(dctrace,1,500);
     v_length := length(dctrace);
   end if; 


     BEGIN
     v_number := to_number(substr(dctrace,1,3));
     EXCEPTION
       WHEN OTHERS THEN
         v_number := 002;
         if v_length > 3 then
         dctrace := '002' || substr(dctrace,4,v_length - 3);
         else
         dctrace := '002';
         end if;  
         qifeitas := 002;
     END;
     
          
   v_length := length(dctrace);
   
   if v_number < 2 then
     return;
   end if;
   
   if qifeitas is null or qifeitas > v_number or qifeitas < 1 then
     qifeitas := v_number;
   end if;
   
  if qifeitas = v_number then
     v_first := 1;
     qifeitas := qifeitas - 1;
  else
  
     
  if qifeitas = 1 then
     v_last := 1;
     qifeitas := v_number;
  end if;
  
  end if;
   
          
  if v_first = 0 and v_last = 0 then
    qifeitas := qifeitas - 1;
    return;
  end if;
  
  
      SELECT SYS_CONTEXT( 'USERENV', 'SID' ) INTO sid FROM DUAL;
      SELECT SYS_CONTEXT( 'USERENV', 'IP_ADDRESS' ) INTO ip_address FROM DUAL;
      SELECT SYS_CONTEXT( 'USERENV', 'TERMINAL' ) INTO os_terminal FROM DUAL;
      SELECT SYS_CONTEXT( 'USERENV', 'OS_USER' ) INTO os_user FROM DUAL;
      SELECT SYS_CONTEXT( 'USERENV', 'DB_NAME' ) INTO db_name FROM DUAL;
      SELECT SYS_CONTEXT( 'USERENV', 'SESSION_USER' ) INTO session_user FROM DUAL;

-- Caso Execução na Web
      if os_user is null then
      SELECT SYS_CONTEXT( 'USERENV', 'HOST' ) INTO os_user FROM DUAL;
      end if; 
      
      if os_terminal is null then
      SELECT SYS_CONTEXT( 'USERENV', 'SERVER_HOST' ) INTO os_terminal FROM DUAL;
      end if;
         
  who_called_me( l_owner, l_name, l_lineno, l_type, 4 );
  who_called_me( t_owner, t_name, t_lineno, t_type, 3 );


  INSERT INTO SYS_TRACE
(
 DTINICIO
,SID
,CALLED_TRACED_OWNER
,CALLED_TRACED_NAME
,CALLED_TRACED_LINE
,CALLED_TRACED_TYPE
,TRACED_OWNER
,TRACED_NAME
,TRACED_LINE
,TRACED_TYPE
,TRACED_BEGIN_END
,DCTRACE
,SESSION_USER
,DB_NAME
,OS_USER
,OS_TERMINAL
,IP_ADDRESS
)
VALUES
(
 SYSTIMESTAMP
,SID
,l_owner
,l_name
,l_lineno
,l_type
,t_owner
,t_name
,t_lineno
,t_type
,CASE WHEN v_first = 1 THEN 'B' ELSE 'E' END
,dctrace
,session_user
,db_name
,os_user
,os_terminal
,ip_address
);

commit;
return;

     EXCEPTION
       WHEN OTHERS THEN
         return;

end;

Selecionar tudo

create or replace procedure who_called_me( owner      out varchar2,
                         name       out varchar2,
                         lineno     out number,
                         caller_t   out varchar2, n_called in number ) -- caller_t   out varchar2)
as
    call_stack  varchar2(4096); --default dbms_utility.format_call_stack;
    n           number;
    found_stack BOOLEAN default FALSE;
    line        varchar2(255);
    cnt         number := 0;
    
--*====================================================================
--* Funcao.....:  who_called_me (QUEM_ME_CHAMOU)
--* Descricao..:  Recupera o nome do OWNER, PROCESSO, LINHA, CHAMADOR corrente
--* Programa...:  Esta função é chamada pela who_am_i (QUEM_SOU_EU) 
--*               que posiciona n_called em 3 (Their Caller);
--*               Caso n_called <> 1, 2, 3 ou 4 no momento return.
--* Tabelas ...:
--* Revisões...:  Revisão da Funcao
--* Data.......:  08/03/2013
--* Autor Rev..:  Renato Viana (Fonte http://glufke.net/)
--* Revisões...:
--* Data.......:
--* Autor Rev..:
--*=====================================================================
       
begin
--
    if n_called is NULL or
      (n_called <> 1 and n_called <> 2 and n_called <> 3 and n_called <> 4) then --
      return;                                                     --
    end if;                                                       --
     
    call_stack := dbms_utility.format_call_stack; -- now default
    
    loop
        n := instr( call_stack, chr(10) );
        exit when ( cnt = n_called or n is NULL or n = 0 ); -- ( cnt = 3 or n is NULL or n = 0 );
--
        line := substr( call_stack, 1, n-1 );
        call_stack := substr( call_stack, n+1 );
--
        if ( NOT found_stack ) then
            if ( line like '%handle%number%name%' ) then
                found_stack := TRUE;
            end if;
        else
            cnt := cnt + 1;
            -- cnt = 1 is ME
            -- cnt = 2 is MY Caller
            -- cnt = 3 is Their Caller
            if ( cnt = n_called ) then -- ( cnt = 3 )
                lineno := to_number(substr( line, 13, 8 )); -- line, 13,6
                line   := substr( line, 23 ); -- line, 21
                if ( line like 'pr%' ) then
                    n := length( 'procedure ' );
                elsif ( line like 'fun%' ) then
                    n := length( 'function ' );
                elsif ( line like 'package body%' ) then
                    n := length( 'package body ' );
                elsif ( line like 'pack%' ) then
                    n := length( 'package ' );
                elsif ( line like 'anonymous%' ) then
                    n := length( 'anonymous block ' );
                else
                    n := null;
                end if;
                if ( n is not null ) then
                   caller_t := ltrim(rtrim(upper(substr( line, 1, n-1 ))));
                else
                   caller_t := 'TRIGGER';
                end if;

                line := substr( line, nvl(n,1) );
                n := instr( line, '.' );
                owner := ltrim(rtrim(substr( line, 1, n-1 )));
                name  := ltrim(rtrim(substr( line, n+1 )));
            end if;
        end if;
    end loop;
end;


Selecionar tudo

create or replace function who_am_i return varchar2 --
is
    l_owner        varchar2(30);
    l_name      varchar2(30);
    l_lineno    number;
    l_type      varchar2(30);
    
--*====================================================================
--* Funcao.....:  who_am_i (QUEM_SOU_EU)
--* Descricao..:  Recupera o nome do OWNER.PROCESSO corrente
--* Programa...:  Esta função chama who_called_me (QUEM_ME_CHAMOU)
--*
--* Exemplo uso:  V_VARCHAR := who_am_i
--*               O conteúdo da variável V_VARCHAR teria o nome do processo
--*               corrente, por exemplo GLUFKE.PROC0001
--*
--* Revisões...:  Revisão da Funcao
--* Data.......:  08/03/2013
--* Autor Rev..:  Renato Viana (Fonte http://glufke.net/)
--* Revisões...:
--* Data.......:
--* Autor Rev..:
--*=====================================================================
    
begin
   who_called_me( l_owner, l_name, l_lineno, l_type, 3 );
   return l_owner || '.' || l_name;
end;
Renato Menezes Viana
Rank: Analista Pleno
Rank: Analista Pleno
Mensagens: 128
Registrado em: Sáb, 18 Nov 2006 11:51 am
Localização: Rio de Janeiro - RJ

Pessoal:

Continuando com o assunto WHO_TRACED_ME, o comando abaixo podemos saber quanto tempo gastou uma procedure, entre o seu início (Begin) e fim (End), ou seja, quando pedidos que a WHO_TRACED_ME registre apenas duas vezes:

Selecionar tudo

substr(dctrace,1,3) = '002'
Query

Selecionar tudo

select dtinicio - lag(dtinicio) over (order by dtinicio) as GASTO, t.* from SYS_TRACE t
 where DTINICIO > '14-JUN-2013 02.39'
 and traced_name = 'MEPB0006' and substr(dctrace,1,3) = '002'
  
   	GASTO	                DTINICIO                           	SID		TRACED_NAME	DCTRACE
        ------------------------  -------------------------------------  ---            -----------------  -----------                                             
1		                        14-JUN-13 02.20.39.767514 PM	624		MEPB0006  	002
2	+000000000 00:00:00	14-JUN-13 02.20.39.768135 PM	624		MEPB0006	        002
3	+000000000 00:00:27	14-JUN-13 02.21.06.918714 PM	624		MEPB0006  	002
4	+000000000 00:00:00	14-JUN-13 02.21.06.919274 PM	624		MEPB0006  	002
5	+000000007 03:38:24	21-JUN-13 05.59.31.710551 PM	619		MEPB0006  	002
6	+000000000 00:00:01	21-JUN-13 05.59.33.150680 PM	619		MEPB0006  	002
7	+000000000 00:00:12	21-JUN-13 05.59.45.320152 PM	619		MEPB0006  	002
8	+000000000 00:37:56	21-JUN-13 06.37.41.507402 PM	619		MEPB0006  	002
Renato Menezes Viana
Rank: Analista Pleno
Rank: Analista Pleno
Mensagens: 128
Registrado em: Sáb, 18 Nov 2006 11:51 am
Localização: Rio de Janeiro - RJ

Anexei uma outra versão da WHO_I_AM bem bolada.

Selecionar tudo

create or replace 
FUNCTION FN_WHO_AM_I ( p_lvl  NUMBER DEFAULT 0) RETURN VARCHAR2
IS
/***********************************************************************************************
FN_WHO_AM_I returns the full ORACLE name of your object including schema and package names
--
FN_WHO_AM_I(0) - returns the name of your object
FN_WHO_AM_I(1) - returns the name of calling object
FN_WHO_AM_I(2) - returns the name of object, who called calling object
etc., etc., etc.... Up to to he highest level
-------------------------------------------------------------------------------------------------
Copyrigth GARBUYA 2010
*************************************************************************************************/
TYPE str_varr_t   IS VARRAY(2) OF CHAR(1);
TYPE str_table_t  IS TABLE OF VARCHAR2(256);
TYPE num_table_t  IS TABLE OF NUMBER;
v_stack           VARCHAR2(2048) DEFAULT UPPER(dbms_utility.format_call_stack);
v_tmp_1           VARCHAR2(1024);
v_tmp_2           VARCHAR2(1024);
v_pkg_name        VARCHAR2(32);
v_obj_type        VARCHAR2(32);
v_owner           VARCHAR2(32);
v_idx             NUMBER := 0;
v_pos1            NUMBER := 0;
v_pos2            NUMBER := 0;
v_line_nbr        NUMBER := 0;
v_blk_cnt         NUMBER := 0;
v_str_len         NUMBER := 0;
v_bgn_cnt         NUMBER := 0;
v_end_cnt         NUMBER := 0;
it_is_comment     BOOLEAN := FALSE;
it_is_literal     BOOLEAN := FALSE;
v_literal_arr     str_varr_t := str_varr_t ('''', '"');
v_blk_bgn_tbl     str_table_t := str_table_t (' IF '   , ' LOOP '   , ' CASE ', ' BEGIN ');
v_tbl             str_table_t := str_table_t();
v_blk_bgn_len_tbl num_table_t := num_table_t();


BEGIN

   v_stack := SUBSTR(v_stack,INSTR(v_stack,CHR(10),INSTR(v_stack,'FN_WHO_AM_I'))+1)||'ORACLE'; -- skip myself

   FOR v_pos2 in 1 .. p_lvl LOOP  -- advance to the input level
      v_pos1 := INSTR(v_stack, CHR(10));
      v_stack := SUBSTR(v_stack, INSTR(v_stack, CHR(10)) + 1);
   END LOOP;

   v_pos1 := INSTR(v_stack, CHR(10));
   IF v_pos1 = 0 THEN
      RETURN (v_stack);
   END IF;

   v_stack := SUBSTR(v_stack, 1, v_pos1 - 1);  -- get only current level
   v_stack := TRIM(SUBSTR(v_stack, instr(v_stack, ' ')));  -- cut object handle
   v_line_nbr := TO_NUMBER(SUBSTR(v_stack, 1, instr(v_stack, ' ') - 1));  -- get line number
   v_stack := TRIM(SUBSTR(v_stack, instr(v_stack, ' ')));  -- cut line number
   v_pos1 := INSTR(v_stack, ' BODY');
   IF v_pos1  = 0 THEN
      RETURN (v_stack);
   END IF;

   v_pos1 := INSTR(v_stack, ' ', v_pos1 + 2);  -- find end of object type
   v_obj_type := SUBSTR(v_stack, 1, v_pos1 - 1);  -- get object type
   v_stack := TRIM(SUBSTR(v_stack, v_pos1 + 1));  -- get package name
   v_pos1 := INSTR(v_stack, '.');
   v_owner := SUBSTR(v_stack, 1, v_pos1 - 1);  -- get owner
   v_pkg_name  := SUBSTR(v_stack, v_pos1 + 1);  -- get package name
   v_blk_cnt := 0;
   it_is_literal := FALSE;
   --
   FOR v_idx in v_blk_bgn_tbl.FIRST .. v_blk_bgn_tbl.LAST
   LOOP
      v_blk_bgn_len_tbl.EXTEND(1);
      v_blk_bgn_len_tbl (v_blk_bgn_len_tbl.last) := LENGTH(v_blk_bgn_tbl(v_idx));
   END LOOP;
   --
   FOR src
   IN ( SELECT ' '||REPLACE(TRANSLATE(UPPER(text), ';('||CHR(10), '   '),'''''',' ') ||' ' text
        FROM all_source
        where owner = v_owner
        and name    = v_pkg_name
        and type    = v_obj_type
        and line    < v_line_nbr
        ORDER  BY line
      )
   LOOP
      v_stack := src.text;
      IF it_is_comment THEN
         v_pos1 :=  INSTR (v_stack, '*/');
         IF v_pos1 > 0 THEN
            v_stack := SUBSTR (v_stack, v_pos1 + 2);
            it_is_comment := FALSE;
         ELSE
            v_stack := ' ';
         END IF;
      END IF;
      --
      IF v_stack != ' ' THEN
      --
         v_pos1 := INSTR (v_stack, '/*');
         WHILE v_pos1 > 0 LOOP
            v_tmp_1 := SUBSTR (v_stack, 1, v_pos1 - 1);
            v_pos2 := INSTR (v_stack, '*/');
            IF v_pos2 > 0 THEN
               v_tmp_2 := SUBSTR (v_stack, v_pos2 + 2);
               v_stack := v_tmp_1||v_tmp_2;
            ELSE
               v_stack := v_tmp_1;
               it_is_comment := TRUE;
            END IF;
            v_pos1 := INSTR (v_stack, '/*');
         END LOOP;
         --
         IF v_stack != ' ' THEN
            v_pos1 := INSTR (v_stack, '--');
            IF v_pos1 > 0 THEN
               v_stack := SUBSTR (v_stack, 1, v_pos1 - 1);
            END IF;
            --
            IF v_stack != ' ' THEN
               FOR v_idx in v_literal_arr.FIRST .. v_literal_arr.LAST
               LOOP
                  v_pos1 := INSTR (v_stack, v_literal_arr (v_idx) );
                  WHILE v_pos1 > 0  LOOP
                     v_pos2 := INSTR (v_stack, v_literal_arr (v_idx), v_pos1 + 1);
                     IF v_pos2 > 0 THEN
                        v_tmp_1 := SUBSTR (v_stack, 1, v_pos1 - 1);
                        v_tmp_2 := SUBSTR (v_stack, v_pos2 + 1);
                        v_stack := v_tmp_1||v_tmp_2;
                     ELSE
                        IF it_is_literal THEN
                           v_stack := SUBSTR (v_stack, v_pos1 + 1);
                           it_is_literal := FALSE;
                        ELSE
                           v_stack := SUBSTR (v_stack, 1, v_pos1 - 1);
                           it_is_literal := TRUE;
                        END IF;
                     END IF;
                     v_pos1 := INSTR (v_stack, v_literal_arr (v_idx) );
                  END LOOP;
               END LOOP;
               --
               IF v_stack != ' ' THEN
                  WHILE INSTR (v_stack, '  ') > 0
                  LOOP
                     v_stack := REPLACE(v_stack, '  ', ' ');
                  END LOOP;
                  v_stack := REPLACE(v_stack, ' END IF ', ' END ');
                  v_stack := REPLACE(v_stack, ' END LOOP ', ' END ');
                  --
                  IF v_stack != ' ' THEN
                     v_stack := ' '||v_stack;
                     v_pos1 := INSTR(v_stack, ' FUNCTION ') + INSTR(v_stack, ' PROCEDURE ');
                     IF v_pos1 > 0 THEN
                        v_obj_type := TRIM(SUBSTR(v_stack, v_pos1 + 1, 9));  -- get object type
                        v_stack := TRIM(SUBSTR(v_stack, v_pos1 + 10))||'  ';  -- cut object type
                        v_stack := SUBSTR(v_stack, 1,  INSTR(v_stack, ' ') - 1 );  -- get object name
                        v_tbl.EXTEND(1);
                        v_tbl (v_tbl.last) := v_obj_type||' '||v_owner||'.'||v_pkg_name||'.'||v_stack;
                     END IF;
                  --
                     v_pos1 := 0;
                     v_pos2 := 0;
                     v_tmp_1 := v_stack;
                     v_tmp_2 := v_stack;
                     FOR v_idx in v_blk_bgn_tbl.FIRST .. v_blk_bgn_tbl.LAST
                     LOOP
                        v_str_len := NVL(LENGTH(v_tmp_1),0);
                        v_tmp_1 := REPLACE(v_tmp_1,v_blk_bgn_tbl(v_idx), NULL);
                        v_bgn_cnt := NVL(LENGTH(v_tmp_1), 0);
                        v_pos1 := v_pos1 + (v_str_len - v_bgn_cnt)/v_blk_bgn_len_tbl(v_idx);
                        v_str_len := NVL(LENGTH(v_tmp_2),0);
                        v_tmp_2 := REPLACE(v_tmp_2,' END ', NULL);
                        v_end_cnt := NVL(LENGTH(v_tmp_2), 0);
                        v_pos2 := v_pos2 + (v_str_len - v_end_cnt)/5; --- 5 is the length(' END ') 
                     END LOOP;
                     IF v_pos1 > v_pos2 THEN
                        v_blk_cnt := v_blk_cnt + 1;
                     ELSIF v_pos1 < v_pos2 THEN
                        v_blk_cnt := v_blk_cnt - 1;
                        IF v_blk_cnt = 0 AND v_tbl.COUNT > 0 THEN
                           v_tbl.DELETE(v_tbl.last);
                        END IF;
                     END IF;
                  END IF;
               END IF;
            END IF;
         END IF;
      END IF;
   END LOOP;

   RETURN CASE v_tbl.COUNT WHEN 0 THEN 'UNKNOWN' ELSE v_tbl(v_tbl.LAST) END;

END;
Responder
  • Informação
  • Quem está online

    Usuários navegando neste fórum: Nenhum usuário registrado e 16 visitantes