The package below wraps DBMS_APPLICATION_INFO and introduces a SET_EXIT routine to allow invoking procedure MODULE and ACTION to be reinstated after a called function/procedure is returned.
ALTER SESSION SET plsql_warnings = 'enable:all'; CREATE OR REPLACE PACKAGE pkg_app_info AUTHID DEFINER AS gk_module_length CONSTANT NUMBER := 42; gk_action_length CONSTANT NUMBER := 30; PROCEDURE set_module ( pi_module IN VARCHAR2, pi_action IN VARCHAR2 ); PROCEDURE set_action ( pi_action IN VARCHAR2 ); PROCEDURE set_exit ( pi_module IN VARCHAR2 ); END pkg_app_info; / show errors -------------------------------------------------------------------------------- CREATE OR REPLACE PACKAGE BODY pkg_app_info AS TYPE proc_stack_module IS TABLE OF VARCHAR2(42) INDEX BY BINARY_INTEGER; TYPE proc_stack_action IS TABLE OF VARCHAR2(30) INDEX BY PLS_INTEGER; gi_stack_depth PLS_INTEGER := 0; gs_module_name proc_stack_module; gs_action_name proc_stack_action; PROCEDURE set_module ( pi_module IN VARCHAR2, pi_action IN VARCHAR2 ) IS BEGIN DBMS_APPLICATION_INFO.set_module(pi_module, pi_action); IF gi_stack_depth = 0 OR pi_module != gs_module_name(gi_stack_depth-1) THEN gs_module_name(gi_stack_depth) := SUBSTR(pi_module, 1, gk_module_length); gs_action_name(gi_stack_depth) := SUBSTR(pi_action, 1, gk_action_length); gi_stack_depth := gi_stack_depth + 1; END IF; END set_module; PROCEDURE set_action ( pi_action IN VARCHAR2 ) IS BEGIN DBMS_APPLICATION_INFO.set_action(pi_action); gs_action_name(gi_stack_depth-1) := pi_action; END set_action; PROCEDURE set_exit ( pi_module IN VARCHAR2 ) IS ln_loop NUMBER; BEGIN IF pi_module = gs_module_name(gi_stack_depth-1) THEN gi_stack_depth := gi_stack_depth - 1; IF gi_stack_depth > 0 THEN DBMS_APPLICATION_INFO.set_module(gs_module_name(gi_stack_depth-1), gs_action_name(gi_stack_depth-1)); ELSE DBMS_APPLICATION_INFO.set_module(gs_module_name(gi_stack_depth), 'Exited'); END IF; ELSE -- Handle a previously missed set_exit call FOR ln_loop IN REVERSE 0..(gi_stack_depth-1) LOOP IF pi_module = gs_module_name(ln_loop) THEN IF ln_loop > 0 THEN DBMS_APPLICATION_INFO.set_module(gs_module_name(ln_loop-1), gs_action_name(ln_loop-1)); ELSE DBMS_APPLICATION_INFO.set_module(gs_module_name(ln_loop), 'Exited'); END IF; gi_stack_depth := ln_loop + 1; RETURN; END IF; END LOOP; DBMS_OUTPUT.put_line('PKG_APP_INFO.set_exit: exit module not found'); END IF; END set_exit; END pkg_app_info; / show errors
With test harness package:
ALTER SESSION SET plsql_warnings = 'enable:all'; CREATE OR REPLACE PACKAGE tst_app_info AUTHID DEFINER AS gb_display_success BOOLEAN := TRUE; PROCEDURE set_module ( pi_test_number IN NUMBER, pi_module IN VARCHAR2, pi_action IN VARCHAR2, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ); PROCEDURE set_action ( pi_test_number IN NUMBER, pi_action IN VARCHAR2, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ); PROCEDURE set_exit ( pi_test_number IN NUMBER, pi_module IN VARCHAR2, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ); PROCEDURE run_test; END tst_app_info; / show errors -------------------------------------------------------------------------------- CREATE OR REPLACE PACKAGE BODY tst_app_info AS PROCEDURE test_expectation ( pi_test_number IN NUMBER, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ) IS ln_module VARCHAR2(100); ln_action VARCHAR2(100); BEGIN DBMS_APPLICATION_INFO.read_module(ln_module, ln_action); IF ln_module = pi_expect_module AND ln_action = pi_expect_action THEN IF gb_display_success THEN DBMS_OUTPUT.put_line('Passed ' || TO_CHAR(pi_test_number, '9990') || ' ' || RPAD(ln_module, PKG_APP_INFO.gk_module_length) || ' ' || ln_action); END IF; ELSE DBMS_OUTPUT.put_line('Failed ' || TO_CHAR(pi_test_number, '9990') || ' ' || RPAD(ln_module, PKG_APP_INFO.gk_module_length) || ' ' || ln_action); DBMS_OUTPUT.put_line('-> expected: ' || RPAD(pi_expect_module, PKG_APP_INFO.gk_module_length) || ' ' || pi_expect_action); END IF; END test_expectation; PROCEDURE set_module ( pi_test_number IN NUMBER, pi_module IN VARCHAR2, pi_action IN VARCHAR2, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ) IS BEGIN PKG_APP_INFO.set_module(pi_module, pi_action); test_expectation(pi_test_number, pi_expect_module, pi_expect_action); END set_module; PROCEDURE set_action ( pi_test_number IN NUMBER, pi_action IN VARCHAR2, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ) IS BEGIN PKG_APP_INFO.set_action(pi_action); test_expectation(pi_test_number, pi_expect_module, pi_expect_action); END set_action; PROCEDURE set_exit ( pi_test_number IN NUMBER, pi_module IN VARCHAR2, pi_expect_module IN VARCHAR2, pi_expect_action IN VARCHAR2 ) IS BEGIN PKG_APP_INFO.set_exit(pi_module); test_expectation(pi_test_number, pi_expect_module, pi_expect_action); END set_exit; PROCEDURE run_test IS BEGIN set_module(1, 'Level 1', 'Action 1', 'Level 1', 'Action 1'); set_action(2, 'Action 2', 'Level 1', 'Action 2'); set_action(3, 'Action 3', 'Level 1', 'Action 3'); set_module(4, 'Level 2', 'Action 4', 'Level 2', 'Action 4'); set_module(5, 'Level 3', 'Action 5', 'Level 3', 'Action 5'); set_action(6, 'Action 6', 'Level 3', 'Action 6'); set_exit( 7, 'Level 3', 'Level 2', 'Action 4'); set_module(8, 'Level 3a', 'Action 7', 'Level 3a', 'Action 7'); set_action(9, 'Action 8', 'Level 3a', 'Action 8'); set_exit( 10, 'Level 2', 'Level 1', 'Action 3'); set_action(11, 'Action 9', 'Level 1', 'Action 9'); set_exit( 12, 'Level 1', 'Level 1', 'Exited'); set_module(13, 'Level 1', 'Action 10', 'Level 1', 'Action 10'); set_module(14, 'Level 2', 'Action 11', 'Level 2', 'Action 11'); set_exit( 15, 'Level 1', 'Level 1', 'Exited'); END run_test; BEGIN DBMS_OUTPUT.put_line('Success Test ' || RPAD('Module', PKG_APP_INFO.gk_module_length+2) || 'Action'); DBMS_OUTPUT.put_line('======= ==== ' || RPAD('=', PKG_APP_INFO.gk_module_length, '=') || ' ' || RPAD('=', PKG_APP_INFO.gk_action_length, '=')); END tst_app_info; / show errors set serveroutput on size unlimited set lines 132 exec TST_APP_INFO.run_test