create or replace package body aop_processor is -- @AOP_NEVER g_during_advise boolean:= false; function during_advise return boolean is begin return g_during_advise; end during_advise; function get_body ( p_object_name in varchar2 , p_object_owner in varchar2 ) return clob is l_code clob; begin -- make sure that dbms_metadata does return the package body DBMS_METADATA.SET_TRANSFORM_PARAM ( transform_handle => dbms_metadata.SESSION_TRANSFORM , name => 'BODY' , value => true , object_type => 'PACKAGE' ); -- make sure that dbms_metadata does not return the package specification as well DBMS_METADATA.SET_TRANSFORM_PARAM ( transform_handle => dbms_metadata.SESSION_TRANSFORM , name => 'SPECIFICATION' , value => false , object_type => 'PACKAGE' ); l_code:= dbms_metadata.get_ddl('PACKAGE', p_object_name, p_object_owner); return l_code; end get_body; -- finds a string that starts after p_find, ends before the first occurrence of p_end and has all p_to_trim characters removed -- for example: @AOP( advice =LOG); p_find = @AOP function find_first_string_after ( p_string in varchar2 -- for example @AOP( advice =LOG) , p_find in varchar2 -- for example @AOP , p_start in varchar2 -- for example advice , p_end in varchar2 -- for example ) , p_to_trim in varchar2 -- for example ' = , p_occurrence in number default 1 , p_last_pos in number default null ) return varchar2 is l_pos number(5); l_pos2 number(5); l_result varchar2(32700); -- from http://www.oracle.com/technology/oramag/oracle/06-jan/o16plsql.html by Steven Feuerstein FUNCTION stripped_string ( string_in IN VARCHAR2 , strip_characters_in IN VARCHAR2 ) RETURN VARCHAR2 IS -- With REGEXP_REPLACE, each character to be replaced with NULL, -- must be followed by a "*". c_asterisk CONSTANT CHAR (1) := '*'; l_strip_characters VARCHAR2 (32767); l_length PLS_INTEGER; l_character VARCHAR2 (2); BEGIN l_length := LENGTH (strip_characters_in); IF l_length > 0 THEN FOR l_index IN 1 .. l_length LOOP l_character := SUBSTR (strip_characters_in, l_index, 1); IF l_character = c_asterisk THEN l_character := '\' || c_asterisk; END IF; l_strip_characters := l_strip_characters || l_character || c_asterisk; END LOOP; END IF; RETURN regexp_replace (string_in, l_strip_characters); END stripped_string; begin l_pos:= regexp_instr( p_string, p_find, 1, 1,0,'i'); if l_pos > 0 then l_pos2:= regexp_instr( p_string, p_start, l_pos, p_occurrence,0,'i'); -- find the first instance of p_start, starting from position l_pos in the p_string if l_pos2 > 0 and l_pos2 < nvl(p_last_pos, l_pos2+1) then l_result := substr(p_string, l_pos2, regexp_instr(p_string,p_end,l_pos2,1,0,'i') - l_pos2 ); l_result:= stripped_string (l_result, p_to_trim); end if; end if; return l_result; end find_first_string_after; -- this function tries to locate the next pointcut (position of @AOP keyword) as well as the advice -- It is somewhat rudimentary: it locates the @AOP keyword, then continues to look for the first occurrence of -- the string procedure or function, preceded and followed by a space character (no real PL/SQL parsing is done!) -- It continues to locate the first begin following the presumed start of the program unit (without regard for embedded program units). -- The end of the program unit is located by looking for end - even though that is not required syntax in PL/SQL function get_pointcut ( p_program_unit_to_advise out varchar2 , p_advice out varchar2 , p_begin_of_unit out number -- the position in p_code of the "begin" of the program unit , p_end_of_unit out number -- the position in p_code of the "end" of the program unit , p_code in varchar2 , p_start_pos in out number -- where in p_code should we start looking ) return boolean -- indicating whether a pointcut was found is l_pos number(5); -- position of the @AOP string l_pos2 number(5);-- position of the first chr(10) following the keyword l_program_unit_to_advise varchar2(250); l_begin_of_unit number; -- the position in p_code of the "begin" of the program unit l_end_of_unit number; -- the position in p_code of the "end" of the program unit begin l_pos:= instr( p_code, '@AOP', p_start_pos); if l_pos > 0 then p_advice := substr(find_first_string_after(substr(p_code, l_pos), '@AOP','advice','\)',' ='),7); p_program_unit_to_advise := find_first_string_after(substr(p_code, l_pos), 'procedure|function',' ','\(|return | is',' '); p_begin_of_unit:= instr(lower( p_code),'begin', l_pos); p_end_of_unit:= instr(lower( p_code),'end '||p_program_unit_to_advise||';', l_pos); p_start_pos:= l_pos + 5; return true; end if; return false; end get_pointcut; procedure remove_aop_advices(p_code in out clob) is l_pos number:=1; l_pos2 number:=0; begin for i in 1..250 loop l_pos:= instr( p_code, '-- AOP-ADVICE', l_pos); l_pos2:= instr( p_code, '-- END OF AOP-ADVICE', l_pos); if l_pos > 0 then p_code:= substr(p_code, 1, l_pos-1)||substr(p_code, l_pos2+22); else exit; end if; end loop; end remove_aop_advices; function weave ( p_code in out clob , p_package_name in varchar2 ) return boolean is l_advice_type varchar2(250); l_program_unit_to_advise varchar2(250); l_begin_of_unit number; -- the position in p_code of the "begin" of the program unit l_end_of_unit number; -- the position in p_code of the "end" of the program unit l_advised boolean:= false; l_start_pos number(5):=1; l_advice varchar2(32000); l_param_name varchar2(4000); procedure start_advice ( p_code in out varchar2 ) is begin p_code:= p_code ||chr(13)||chr(10) ||' -- AOP-ADVICE:'||l_advice_type||' ; Added by AOP_PROCESSOR on ' ||to_char(systimestamp,'DD-MM-YYYY HH24:MI:SS') ; end start_advice; procedure end_advice ( p_code in out varchar2 ) is begin p_code:= p_code ||chr(13)||chr(10) ||' -- END OF AOP-ADVICE' ; end end_advice; begin while get_pointcut ( p_program_unit_to_advise => l_program_unit_to_advise , p_advice => l_advice_type , p_begin_of_unit => l_begin_of_unit , p_end_of_unit => l_end_of_unit , p_code => p_code , p_start_pos => l_start_pos ) loop if l_advice_type ='LOG' then start_advice(l_advice); -- invoke the CENTRAL_LOGGER.log_program_unit_execution procedure l_advice:= l_advice ||chr(13)||chr(10) ||' declare' ||chr(13)||chr(10) ||' l_parameters CENTRAL_LOGGER.parameter_table;' ||chr(13)||chr(10) ||' begin' ; -- now we have to find each in & in out parameter in this program unit -- then we can add a line to l_advice as follows: -- l_advice:= l_advice -- ||chr(13)||chr(10) -- ||' l_parameters('''||param_name||'''):= param_name;' -- we will keep it simple: -- starting after the first ( after the string procedure or function or after the first , following -- the previous parameter we will find the parameters for i in 1..50 loop l_param_name:= trim ( leading '(' from find_first_string_after ( p_string => substr(p_code, l_start_pos) , p_find => 'procedure|function' , p_start => ',|\(' , p_end => 'in|inout|in out|out in' , p_to_trim => ' ,' , p_occurrence => i , p_last_pos => l_begin_of_unit - l_start_pos ) ); if nvl(length(l_param_name),0) =0 then exit; end if; l_advice:= l_advice ||chr(13)||chr(10) ||' l_parameters('''||l_param_name||'''):= '||l_param_name||';' ; end loop; l_advice:= l_advice ||chr(13)||chr(10) ||' CENTRAL_LOGGER.log_program_unit_execution' ||chr(13)||chr(10) ||' ( p_program_unit => '''||p_package_name||'.'||l_program_unit_to_advise||'''' ||chr(13)||chr(10) ||' , p_parameters => l_parameters' ||chr(13)||chr(10) ||' );' ||chr(13)||chr(10) ||' end;' ; end_advice(l_advice); p_code:= substr(p_code, 1, l_begin_of_unit+5) ||l_advice ||substr(p_code, l_begin_of_unit+5); end if; l_advised:= true; l_start_pos:= l_end_of_unit; l_advice:=''; end loop; return l_advised; end weave; procedure advise_package ( p_object_name in varchar2 , p_object_type in varchar2 , p_object_owner in varchar2 ) is l_body clob; l_advised boolean := false; begin g_during_advise:= true; -- test for state of package; no sense in trying to post-process an invalid package -- if valid then retrieve source l_body:= get_body( p_object_name, p_object_owner); -- check if perhaps the AOP_NEVER string is included that indicates that no AOP should be applied to a program unit -- (this bail-out is primarily used for this package itself, riddled as it is with AOP instructions) if instr(l_body, '@AOP_NEVER') > 0 then return; end if; -- remove all current advices from the package body remove_aop_advices(l_body); -- manipulate source by weaving in aspects as required; do not weave if the key @AOP_NONE is included in the package body if instr(l_body, '@AOP_CLEAN') = 0 then l_advised := weave( p_code => l_body, p_package_name => p_object_name ); end if; -- (re)compile the source if any advises have been applied if l_advised then -- submit a job to recompile the package with the source including the newly woven aspects -- note: we cannot use execute immediate l_body, as compilation is not a legal operation from a system event trigger (ORA-30511 is raised when we try) execute immediate cast(l_body as varchar2); end if; g_during_advise:= false; exception when others then g_during_advise:= false; for i in 1..5 loop dbms_output.put_line(substr(DBMS_UTILITY.FORMAT_ERROR_BACKTRACE, 1+(i-1)*255,255)); end loop; raise; end advise_package; procedure reapply_aspect ( p_aspect in varchar2 -- for example LOG ) is l_body clob; begin for p in (select object_name package_name, owner from all_objects where object_type ='PACKAGE BODY') loop l_body:= get_body( p.package_name, p.owner); if regexp_instr(l_body,'@aop.*\(.*advice.*LOG.*\)' ,1,1,0,'i') > 0 then advise_package( p_object_name => p.package_name, p_object_type => 'PACKAGE BODY', p_object_owner => p.owner); end if; end loop; end reapply_aspect; end aop_processor; /