Monday, June 20, 2005

 

debug.sql


set echo off

create or replace
type Argv as
table of varchar2(4000);
/

create table debugTab(
userid varchar2(30) primary key,
modules varchar2(4000),
locat varchar2(4000),
filename varchar2(4000)
)
/

create or replace
trigger bi_fer_debugtab
before insert on debugtab for each row
begin
:new.modules := upper( :new.modules );
end;
/

create or replace
package debug as
--
-- version 1.0
-- clbeck - 13-OCT-98 - Initial version
--
-- PACKAGE TO DUMP DEBUG INFORMATION OF PL/SQL ROUTINE
-- TO A FILE DURING EXECUTION
--
--
-- This package allows the developer to selectively produce debug
-- iformation for pl/sql process.
--
-- Setup:
-- Make sure the utl_file_dir paramter is assigned in the init.ora
-- file. You need an entry for each dir that you want to be able to
-- write to.
-- eg.
-- utl_file_dir = /tmp
-- utl_file_dir = /home/clbeck/sql/debug
--
-- Usage:
-- There are two procedure to write debug information ( f and fa ).
-- Anywhere in your code that you want to print debug information use:
--
-- debug.f( 'Expected %s bytes, got %s bytes', l_expect, l_got );
--
-- This will replace the the first %s with the value of l_expect and the
-- second %s with the value of l_got.
--
-- If you have more than 10 %s in your string then you will need to use the fa
-- procedure like:
--
-- debug.fa( 'List: %s,%s,%s,%s,%s,%s',
-- argv( 1, 2, l_num, 'Chris', l_cnt, 10 ) );
--
-- Runtime:
-- To enable the debug run:
--
-- debug.init( 'myProc' );
--
-- This will cause only debug for the procedure/package named
-- myProc to be generated.
-- All other debug statements will generate no output.
-- To debug all procedures/packages,
-- set p_modules = 'ALL';
--
-- To stop debug run:
--
-- debug.clear;
--
-- Output:
-- The output looks like:
--
-- 981013 130530 (CLBECK.MYPROC, 221) this is my debug output
-- ^^^^^^ ^^^^^^ ^^^^^^^^^^^^^ ^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- date time owner.proc lineno message
--
--
-- Enhancements and Bugs:
--
-- Send all enhancements requests and bugs to me,
-- Christopher Beck (clbeck@us.oracle.com)
--
--

g_dir_locat constant varchar2(4000) := '/tmp';

emptyDebugArgv Argv;

--
-- Initializes the debuging for specified p_modules and will dump the
-- output to the p_dir directory on the server for the user p_user.
--
procedure init(
p_modules in varchar2 default 'ALL',
p_dir in varchar2 default g_dir_locat,
p_file in varchar2 default null,
p_user in varchar2 default user );

procedure f(
p_message in varchar2,
p_arg1 in varchar2 default null,
p_arg2 in varchar2 default null,
p_arg3 in varchar2 default null,
p_arg4 in varchar2 default null,
p_arg5 in varchar2 default null,
p_arg6 in varchar2 default null,
p_arg7 in varchar2 default null,
p_arg8 in varchar2 default null,
p_arg9 in varchar2 default null,
p_arg10 in varchar2 default null );

procedure fa(
p_message in varchar2,
p_args in Argv default emptyDebugArgv );

procedure clear(
p_user in varchar2 default user );

--
-- Returns the current status of debugging for the user p_user.
--
procedure status(
p_user in varchar2 default user,
p_modules out varchar2,
p_file out varchar2,
p_dir out varchar2 );

end debug;
/

show error

grant execute on debug to public
/

create or replace
package body debug as

g_owner varchar2(2000);
g_name varchar2(2000);
g_lineno number;
g_caller_t varchar2(2000);

g_file varchar2(2000);

procedure init(
p_modules in varchar2 default 'all',
p_dir in varchar2 default g_dir_locat,
p_file in varchar2 default null,
p_user in varchar2 default user ) is
--
r debugTab%rowtype;
begin
clear( p_user );
insert into debugTab values ( p_user, p_modules, p_dir, p_file );
end init;


procedure clear( p_user varchar2 default user ) is
begin
delete from debugTab where userid = p_user;
end clear;


procedure status(
p_user in varchar2 default user,
p_modules out varchar2,
p_file out varchar2,
p_dir out varchar2 ) is
begin
select modules, locat, filename
into p_modules, p_dir, p_file
from debugTab
where userid = p_user;
exception
when NO_DATA_FOUND then
p_modules := null;
p_dir := null;
p_file := null;
end status;

procedure who_called_me(
owner out varchar2,
name out varchar2,
lineno out number,
caller_t out varchar2 ) is
--
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 ' );
else
n := length( 'anonymous block ' );
end if;
caller_t := ltrim(rtrim(upper(substr( line, 1, n-1 ))));
line := substr( line, n );
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 who_called_me;

function is_number( n varchar2 ) return boolean is
begin
if n between '0' and '9' then
return true;
end if;
return false;
end is_number;

function parse_it(
p_message in varchar2,
p_args in argv default emptyDebugArgv ) return varchar2 is
--
l_tmp long := p_message;
l_str long := null;
l_idx number;

l_numstr1 varchar2(10);
l_numstr2 varchar2(10);

l_tmp1 long;
l_str1 long;

l_num number;
l_char long;
begin

for i in 1 .. p_args.count loop
l_idx := instr( l_tmp, '%' ) ;
exit when nvl(l_idx,0) = 0;

l_str := l_str || substr( l_tmp, 1, l_idx-1 );
l_tmp := substr( l_tmp, l_idx+1 );

if substr( l_tmp, 1, 1 ) = 's' or
substr( l_tmp, 1, 1 ) = 'd' then
l_str := l_str || p_args(i);
l_tmp := substr( l_tmp, 2 );
elsif is_number( substr( l_tmp, 1, 1 ) ) or
substr( l_tmp, 1, 1 ) = '.' then

l_numstr1 := null;
l_numstr2 := null;

l_tmp1 := l_tmp;
l_str1 := l_str;

loop
exit when not is_number( substr( l_tmp1, 1, 1 ) );
l_numstr1 := l_numstr1 || substr( l_tmp1, 1, 1 );
l_tmp1 := substr( l_tmp1, 2 );
end loop;

if substr( l_tmp1, 1, 1 ) = '.' then
l_tmp1 := substr( l_tmp1, 2 );
if is_number( substr( l_tmp1, 1, 1 ) ) then
loop
exit when not is_number( substr( l_tmp1, 1, 1 ) );
l_numstr2 := l_numstr2 || substr( l_tmp1, 1, 1 );
l_tmp1 := substr( l_tmp1, 2 );
end loop;
else
l_tmp1 := '!' || l_tmp1;
end if;
end if;

begin
if substr( l_tmp1, 1, 1 ) = 's' then
l_tmp := substr( l_tmp1, 2 );
if l_numstr2 is null then
l_tmp1 := p_args(i);
else
l_tmp1 := substr( p_args(i), 1, l_numstr2 );
end if;
if l_numstr1 is not null then
l_tmp1 := lpad( l_tmp1, l_numstr1 );
end if;
l_str := l_str1 || l_tmp1;
elsif substr( l_tmp1, 1, 1 ) = 'd' then
l_tmp := substr( l_tmp1, 2 );
if l_numstr1 is null then
l_tmp1 := lpad( '9', 39, '9' );
else
l_tmp1 := lpad( '9', l_numstr1, '9' );
end if;
if l_numstr2 is not null then
l_tmp1 := substr( l_tmp1, 1, l_numstr1-l_numstr2 ) || '.' ||
substr( l_tmp1, -l_numstr2 );
end if;
l_str := l_str1 || to_char( to_number( p_args(i) ), l_tmp1 );
else
l_str := l_str || '%';
end if;
exception
when others then
l_str := l_str1 || 'XXXXXXXXXX';
end;

else
l_str := l_str || '%';
end if;

end loop;

return l_str || l_tmp;

exception
when others then
return l_str || l_tmp;
end parse_it;


procedure internal_f(
p_message in varchar2,
p_args in Argv default emptyDebugArgv ) is
--
l_locat varchar2(4000);
l_modules varchar2(4000);
l_filename varchar2(4000);
l_message long := null;
l_file utl_file.file_type;
l_date varchar2(255);
begin

select modules, locat, filename, to_char( sysdate, 'YYMMDD HH24MISS' )
into l_modules, l_locat, l_filename, l_date
from debugTab
where userid = user;

if instr( l_modules, nvl(g_name,'BLAH') ) = 0 and l_modules <> 'ALL' then
return;
end if;

if l_filename is not null then
g_file := l_filename;
end if;

l_message := parse_it( p_message, p_args );
/*
l_message := p_message;

begin
for i in 1 .. p_args.count loop
if instr( l_message, '%s' ) = 0 then
exit;
else
l_message := substr( l_message, 1, instr( l_message, '%s' )-1 ) ||
p_args(i) ||
substr( l_message, instr( l_message, '%s' )+2 );
end if;
end loop;
exception
when others then
null;
end;
*/

l_message := replace( l_message, '\n', chr(10) );
l_message := replace( l_message, '\t', chr(9) );

l_file := utl_file.fopen( l_locat, g_file, 'a', 32767 );
if not utl_file.is_open( l_file ) then
dbms_output.put_line( 'File not opened' );
end if;
if g_owner is null then
g_owner := user;
g_name := 'ANONYMOUS BLOCK';
end if;
utl_file.put( l_file, '' );
utl_file.put_line( l_file,
l_date ||
' (' || lpad( g_owner || '.' || g_name, 20 ) || ',' ||
lpad(g_lineno,4) || ') ' || l_message );
utl_file.fclose( l_file );

exception
when NO_DATA_FOUND then
-- dbms_output.put_line( sqlerrm );
null;
end internal_f;


procedure fa(
p_message in varchar2,
p_args in Argv default emptyDebugArgv ) is
begin
who_called_me( g_owner, g_name, g_lineno, g_caller_t );
internal_f( p_message, p_args );
end fa;


procedure f(
p_message in varchar2,
p_arg1 in varchar2 default null,
p_arg2 in varchar2 default null,
p_arg3 in varchar2 default null,
p_arg4 in varchar2 default null,
p_arg5 in varchar2 default null,
p_arg6 in varchar2 default null,
p_arg7 in varchar2 default null,
p_arg8 in varchar2 default null,
p_arg9 in varchar2 default null,
p_arg10 in varchar2 default null ) is
begin
who_called_me( g_owner, g_name, g_lineno, g_caller_t );
internal_f( p_message,
argv( substr( p_arg1, 1, 4000 ),
substr( p_arg2, 1, 4000 ),
substr( p_arg3, 1, 4000 ),
substr( p_arg4, 1, 4000 ),
substr( p_arg5, 1, 4000 ),
substr( p_arg6, 1, 4000 ),
substr( p_arg7, 1, 4000 ),
substr( p_arg8, 1, 4000 ),
substr( p_arg9, 1, 4000 ),
substr( p_arg10, 1, 4000 ) ) );
end f;

begin

g_file := 'DEBUGF_'||userenv('SESSIONID');

end debug;
/

show error

This page is powered by Blogger. Isn't yours?