rem rem $Header: L:\\\\model\\repman40\\api\\RCS\\rmdbg.rpb 1.2 1998/08/03 16:28:44 cvanes Exp $ rem rem NAME rem rmdbg.pkb - Package Body rem DESCRIPTION rem RM DeBuG support package rem rem This package provides services to aid debugging of PL/SQL code. rem It utilises ORACLE7's pipe technology and allows messages to be rem displayed in a seperate window (via a pipe reader/displayer utility) rem whilst PL/SQL code is executing. rem rem Features:- rem Enable, Disable debugging rem Debug Levels rem Some simple timing rem NOTES rem The dbms_pipe package must have been installed before rmdbg can rem be loaded. rem rem Messages are sent to a pipe named 'PIPE username/password>'. rem rem A public boolean variable 'enabled' can be used to determine if rem debugging is on or off. This allows calls to the rmdbg package rem to be made only if debugging is on. rem If 'print' is called and debug is off, messages will not be rem displayed. rem PUBLIC FUNCTION(S) rem enable : RMDBG - ENABLE debugging rem disable : RMDBG - DISABLE debugging rem timing : RMDBG - Enable/Disable timing rem print : RMDBG - Print a message rem pipename : RMDBG - Set the name of the pipe to send messages to rem trace : RMDBG - Write trace information to a file. rem close_trace : RMDBG - Close trace file. rem flush_trace : RMDBG - Force buffered info to the disk. rem write_file : RMDBG - Write information to a file. rem rem MODIFIED (MM/DD/YY) rem aloevold 02/06/97 - Disabled initialized to false. Left on by mistake. rem aloevold 01/16/97 - Minor improvments rem aloevold 10/11/96 - Added apend mode to trace rem aloevold 04/11/96 - Added trace to file Rem cvanes 07/21/95 - Creation rem jhyde 02/10/94 - add to_number(b boolean) rem dcaruana 12/17/93 - Add Debug Switches rem dcaruana 06/03/93 - Add abort functionality Rem dcaruana 05/27/93 - Creation create or replace package body rmdbg as -- -- Private declarations -- RMDBG_ABORT_MSG CONSTANT varchar2( 80 ) := 'RMDBG: Abort Signal Raised'; file_handle UTL_FILE.FILE_TYPE; -- -- Private Types -- -- -- Private variables -- dtiming boolean; -- Timing Enabled Flag duration boolean; -- Timing Duration Flag aborting boolean; -- Abort Enabled Flag ctime date; -- Current time for duration dlevel binary_integer; -- Current Debug Level dswitch binary_integer; -- Current Debug Switch uname varchar2( 80 ); -- User Name pname varchar2( 80 ); -- Pipe Name aname varchar2( 80 ); -- Alert Name buf varchar2( 256 ); -- Buffer for un-flushed messages buf_len binary_integer; -- The length of the string in buf switch switches; -- Debug Switches -- -- Private Procedures -- -- display_switches function display_switch( dswitch in binary_integer ) return varchar2 is on_switches varchar2(240); begin on_switches := null; for i in 1..switch.cnt loop if bitand(switch.bitflag(i),rmdbg.dswitch) !=0 then on_switches := on_switches || switch.name(i) || ' '; end if; end loop; return on_switches; end display_switch; -- -- Get trace directory. Function use dynamic pl/sql because select on -- v$parameter isn't granted to public. To make the -- trace facility write to file the repository owner -- must be granted select on v$parameter and -- initSID.ora entry utl_file_dir must contain a valid -- directory. function get_directory return varchar2 is value varchar2(512); cursor_pointer integer; rows integer; ignore integer; begin cursor_pointer := dbms_sql.open_cursor; dbms_sql.parse(cursor_pointer,'select value from v$parameter where upper(name) = ''UTL_FILE_DIR''',DBMS_SQL.V7); dbms_sql.define_column(cursor_pointer,1,value,512); ignore := dbms_sql.execute(cursor_pointer); if (dbms_sql.fetch_rows(cursor_pointer) > 0) then dbms_sql.column_value(cursor_pointer,1,value); dbms_sql.close_cursor(cursor_pointer); return value; else dbms_sql.close_cursor(cursor_pointer); return null; end if; exception when others then return null; end get_directory; -- -- Public Procedures -- /*----------------------------- enable -----------------------------------*/ /* enable : RMDBG - ENABLE debugging */ procedure enable( dlevel in binary_integer default null ,dswitch in binary_integer default null ) is begin rmdbg.enabled := true; if ( dlevel is not null ) then rmdbg.dlevel := dlevel; end if; if ( dswitch is not null ) then rmdbg.dswitch := switch.bitflag(dswitch); end if; print( 'Pipe Debug : Now enabled' ); print( 'Pipe Debug : Debug Level is ' || rmdbg.dlevel ); print( 'Pipe Debug : Debug switches are ' || display_switch(rmdbg.dswitch)); timing( rmdbg.dtiming, rmdbg.duration ); catch_abort( false ); end; /*---------------------------- disable -----------------------------------*/ /* disable : RMDBG - DISABLE debugging */ procedure disable is begin print( 'Pipe Debug : Now Disabled' ); rmdbg.enabled := false; close_trace; end; /*---------------------------- is_enabled --------------------------------*/ /* is_enabled : RMDBG - Check whether debugging level exceeds value */ function is_enabled( dlevel in binary_integer default 0 ,dswitch in binary_integer default SW_ALL ) return boolean is begin return ( rmdbg.enabled = true and is_enabled.dlevel < rmdbg.dlevel and bitand(switch.bitflag(is_enabled.dswitch),rmdbg.dswitch) !=0 ); end is_enabled; /*------------------------- initialise_switches -------------------------*/ /* initialise_switches : RMDBG - Initialise Debug Switches */ procedure initialise_switches( debug_switches in rmdbg.switches ) is begin for i in 1..debug_switches.cnt loop switch.name(i) := debug_switches.name(i); switch.bitflag(i) := debug_switches.bitflag(i); switch.pipename(i) := debug_switches.pipename(i); end loop; switch.cnt := debug_switches.cnt; exception when no_data_found then raise_application_error( -20000, 'initialise_switches: Invalid Debug Switches' ); end initialise_switches; /*----------------------------- timing -----------------------------------*/ /* timing : RMDBG - Enable/Disable timing */ procedure timing( flag in boolean default true, duration in boolean default false ) is begin rmdbg.dtiming := flag; rmdbg.duration := duration; if ( rmdbg.dtiming = true ) then print( 'Pipe Debug : Timing is On' ); else print( 'Pipe Debug : Timing is Off' ); end if; end; /*-------------------------- catch_abort ----------------------------------*/ /* catch_abort : RMDBG - Enable/Disable catching of abort */ procedure catch_abort( flag in boolean default true ) is begin rmdbg.aborting := flag; if ( rmdbg.aborting = true ) then print( 'Pipe Debug : Catch Abort is enabled' ); else print( 'Pipe Debug : Catch Abort is disabled' ); end if; end; /*--------------------------- send_abort ----------------------------------*/ /* send_abort : RMDBG - Send abort signal */ procedure send_abort( message in varchar2 default null ) is abort_msg varchar2( 240 ); begin if ( message is null ) then abort_msg := RMDBG_ABORT_MSG; else abort_msg := message; end if; abort_msg := abort_msg || ' sent by ' || uname; -- dbms_alert.signal(aname, abort_msg); -- commit; end; /*----------------------------- print ------------------------------------*/ /* print : RMDBG - Print a message */ procedure print( text in varchar2 , dlevel in binary_integer default 0 , flush in binary_integer default 240 , dswitch in binary_integer default SW_INFO ) is status integer; alert_status integer; stime date; abort_msg varchar2( 80 ); prefix varchar2( 256 ); line_len binary_integer; text_offset binary_integer; -- saves us having to re-assign text text_len binary_integer; -- length(text) - text_offset pipe_name varchar2( 80 ); begin if ( rmdbg.aborting = true ) then -- dbms_alert.waitone(aname, abort_msg, alert_status, 0 ); -- if ( alert_status = 0 ) then -- Alert occured -- raise_application_error( -20000, abort_msg ); -- end if; null; end if; if ( flush > 256 or flush is null ) then line_len := 256; -- enforce maximum line length else line_len := flush; end if; if ( rmdbg.enabled = false or rmdbg.dlevel < dlevel or bitand(switch.bitflag(dswitch),rmdbg.dswitch) =0 ) then return; end if; pipe_name := nvl(switch.pipename(dswitch),pname); text_len := nvl(length(text),0); if ( flush is null and buf_len + text_len < line_len ) then buf := buf || text; buf_len := buf_len + text_len; return; end if; if ( rmdbg.dtiming = true ) then if ( rmdbg.duration = true ) then stime := sysdate; /* prefix := '$1$D' || */ prefix := to_char(sysdate,'HH24:MI:SS') || ' ' || to_char((stime-ctime)*86400, 'S9999') || ': '; ctime := sysdate; else /* prefix := '$1$D' || */ prefix := to_char(sysdate,'HH24:MI:SS') || ': '; end if; else /* prefix := '$1$D';*/ prefix := null; end if; text_offset := 1; /* Writing to file instead of to a pipe. */ trace(prefix || buf || text); return; /* loop -- Now find out how much of (buf || text) we can output without exceeding -- the line length. It might be -- 1. all of it -- 2. all of buf and part of buf -- 3. part of buf if ( buf_len + text_len < line_len ) then -- print the lot, then return dbms_pipe.pack_message( prefix || buf || substrb(text,text_offset) ); status := dbms_pipe.send_message( pipe_name ); buf := ''; buf_len := 0; return; elsif ( buf_len < line_len ) then -- print all of buf and part of text dbms_pipe.pack_message( prefix || buf || substrb(text, text_offset, line_len - buf_len) ); text_offset := text_offset + ( line_len - buf_len ); text_len := text_len - ( line_len - buf_len ); buf := ''; buf_len := 0; status := dbms_pipe.send_message( pipe_name ); else -- print part of buf dbms_pipe.pack_message( prefix || substrb( buf, 1, line_len ) ); buf := substrb( buf, line_len+1 ); buf_len := buf_len - line_len; status := dbms_pipe.send_message( pipe_name ); end if; -- Even if we didn't want to flush, we might have been forced to do so -- because the buffer filled up. If there's now less than a line of text -- we quit while there's still something in the buffer. if ( flush is null and buf_len + text_len < line_len ) then buf := buf || substrb(text,text_offset); buf_len := buf_len + text_len; return; end if; end loop; */ end; /*---------------------------- pipename ----------------------------------*/ /* pipename : RMDBG - Set the name of the pipe to send messages to */ procedure pipename( newname in varchar2 ,dswitch in binary_integer default null ) is begin if dswitch is null then pname := newname; else for i in 1..switch.cnt loop if bitand(switch.bitflag(i),dswitch) !=0 then switch.pipename(i) := newname; end if; end loop; end if; end pipename; /*----------------------------- prompt ------------------------------------*/ /* prompt : RMDBG - Prompt pipe listener for reply */ procedure prompt(text in varchar2, reply out varchar2) is status integer; oreply varchar2(240); begin /* Don't use pipes any more. if rmdbg.enabled = true and rmdbg.dlevel >= dlevel then dbms_pipe.pack_message( '$1$P' || text ); status := dbms_pipe.send_message( pname ); status := dbms_pipe.receive_message( pname||' - REPLY'); if status<>0 then dbms_pipe.pack_message( 'rmdbg.prompt: status from receive_message = '||status); status := dbms_pipe.send_message(pname); end if; while true loop dbms_pipe.unpack_message(oreply); if substrb(oreply,1,1)='$' and substrb(oreply,4,1)='R' then exit; end if; end loop; reply := substrb(oreply,5,length(oreply)-4); else reply := null; end if; */ null; end prompt; /*---------------------------- to_number ---------------------------------*/ /* to_number : RMDBG - Convert a boolean value to {0,1} */ function to_number(b in boolean) return binary_integer is begin if b then return 1; else return 0; end if; end to_number; /*---------------------------- trace -------------------------------------*/ /* trace : RMDBG - Write trace information in parameter to a file. */ procedure trace(info in varchar2) as begin trace(info,null,false); end; /*---------------------------- trace -------------------------------------*/ /* trace : RMDBG - Write trace information to a file if diagnostic */ /* is enabled. If rows is provided it prints number */ /* of rows affected by last sql statement. Had to */ /* provide it as a parameter because sql%rowcont is */ /* reset when calling a procedure. If sqlinfo is set*/ /* trace print content of sqlerror and sqlerrmsg. */ procedure trace(info in varchar2,rows in number,sqlinfo in boolean default false) as cursor cdi_version is select repository_version from rm$repositories; cursor rm_version is select code_version || ' ' || schema_version || ' ' || nls_language from rm_repositories; rm_version_text varchar2(250); version rm$repositories.repository_version%type; msg varchar2(2500); filename varchar2(12); get_directory_test varchar2(512); begin if (rmdbg.enabled) then msg := to_char(sysdate,'YY.MM.DD HH24:MI:SS') || ' ' || initcap(user) || '.' || info || '.'; if (rows is not null) then -- sql%rowcount is passed as a parameter. msg := msg || ' Rows : ' || to_char(rows) || '.'; end if; if (sqlinfo) then -- write oracle errorcode and message. msg := msg || ' Sqlcode : ' || to_char(sqlcode) || ' ' || sqlerrm; end if; if (utl_file.is_open(file_handle)) then write_file(msg); else -- first time, some init things to do. filename := lpad(userenv('sessionid'),8,'0') || '.trc'; begin -- open file /* file_handle := utl_file.fopen(get_directory,filename,'a'); Bug 502140 */ get_directory_test := get_directory; if get_directory_test is not null then file_handle := utl_file.fopen(get_directory_test,filename,'w'); end if; /* dbms_output.put_line('- append');*/ /* dbms_output.put_line(filename);*/ exception when utl_file.invalid_path then dbms_output.put_line('- file location or name was invalid'); null; when utl_file.invalid_mode then dbms_output.put_line('- the open_mode string was invalid'); null; when utl_file.invalid_operation then file_handle := utl_file.fopen(get_directory,filename,'w'); dbms_output.put_line('- write'); dbms_output.put_line(filename); when others then null; end; open cdi_version; fetch cdi_version into version; close cdi_version; write_file('Trace started : ' || to_char(sysdate,'YY.MM.DD HH24:MI:SS')||' for user : '||user); write_file('Repository version : ' || version); open rm_version; fetch rm_version into rm_version_text; close rm_version; write_file('Rm version : ' || rm_version_text); write_file(msg); flush_trace; end if; end if; exception when utl_file.invalid_path then /* dbms_output.put_line('- file location or name was invalid');*/ null; when utl_file.invalid_mode then /* dbms_output.put_line('- the open_mode string was invalid');*/ null; when utl_file.invalid_operation then /* dbms_output.put_line('- file could not be opened as request');*/ /* dbms_output.put_line(get_directory);*/ /* dbms_output.put_line(filename);*/ null; when others then null; end trace; /*------------------------- close trace ----------------------------------*/ /* trace : RMDBG - Close already open trace file. Write goodby */ /* message and write buffer before closing. */ procedure close_trace is begin if (utl_file.is_open(file_handle)) then utl_file.put_line(file_handle,'Tracefile closed : ' || to_char(sysdate,'YY.MM.DD HH24:MI:SS')); utl_file.fflush(file_handle); utl_file.fclose(file_handle); end if; end close_trace; /*------------------------- flush trace ----------------------------------*/ /* trace : RMDBG - Flush content of trace to file. Useful when */ /* debugging to read trace information before */ /* program has terminated. */ procedure flush_trace is begin if (utl_file.is_open(file_handle)) then utl_file.fflush(file_handle); end if; end flush_trace; /*------------------------- write file -----------------------------------*/ /* trace : RMDBG - Write information to a file. */ procedure write_file(info in varchar2) as filename varchar2(12); begin if (utl_file.is_open(file_handle)) then utl_file.put_line(file_handle,info); else -- first time, some init things to do. filename := lpad(userenv('sessionid'),8,'0') || '.trc'; begin -- open file /* file_handle := utl_file.fopen(get_directory,filename,'a'); Bug 502140 */ file_handle := utl_file.fopen(get_directory,filename,'w'); /* dbms_output.put_line('- append');*/ /* dbms_output.put_line(filename);*/ exception when utl_file.invalid_path then /* dbms_output.put_line('- file location or name was invalid');*/ null; when utl_file.invalid_mode then /* dbms_output.put_line('- the open_mode string was invalid');*/ null; when utl_file.invalid_operation then file_handle := utl_file.fopen(get_directory,filename,'w'); /* dbms_output.put_line('- write');*/ /* dbms_output.put_line(filename);*/ when others then null; end; utl_file.put_line(file_handle,info); end if; exception when utl_file.invalid_path then /* dbms_output.put_line('- file location or name was invalid');*/ null; when utl_file.invalid_mode then /* dbms_output.put_line('- the open_mode string was invalid');*/ null; when utl_file.invalid_operation then /* dbms_output.put_line('- file could not be opened as request');*/ /* dbms_output.put_line(get_directory);*/ /* dbms_output.put_line(filename);*/ null; when others then null; end write_file; -- -- Package Instantiation -- begin /* Initialise Debug Flags */ enabled := false; duration := false; aborting := false; dtiming := false; dlevel := 0; dswitch := SW_ALL; ctime := sysdate; buf := ''; buf_len := 0; /* Initialise user name */ select user into uname from sys.dual; /* Initialise the Pipe Name */ pname := 'Pipe ' || uname; /* Initialise the alert Name */ aname := 'Abort ' || uname; /* Initialise Switches table */ switch.name(SW_NONE) := 'None'; switch.bitflag(SW_NONE) := 0; switch.pipename(SW_NONE) := null; switch.name(SW_ALL) := 'All'; switch.bitflag(SW_ALL) := 2147483647; switch.pipename(SW_ALL) := null; /* Initialise Default Switches */ declare default_switches switches; begin default_switches.name(SW_INFO) := 'Info'; default_switches.bitflag(SW_INFO) := power(2,0); default_switches.pipename(SW_INFO) := null; default_switches.name(SW_TRACE) := 'Trace'; default_switches.bitflag(SW_TRACE) := power(2,1); default_switches.pipename(SW_TRACE) := null; default_switches.cnt := 2; initialise_switches( default_switches ); end; /* Register the alert */ -- dbms_alert.register(aname); end rmdbg; /