Forms Library: PKG_DEBUG

This is just a post to document a standard utility functions that I like to create in a Oracle Forms library, if equivalents are not already available. Suggestions or critiques are welcome.

“No warranty is express or implied about the suitability of this code for any purpose.”

This package could do with some improvements:

  • use a database table type (instead of one defined in the forms package) so that we can just send it straight to the database package

  • perhaps a “level” for each log message (Debug/Info/Warning/Error/Fatal) plus the ability to switch the level up or down for each session

Database Objects

CREATE TABLE DEBUG_LOG
(
  log_id      NUMBER(12,0)   NOT NULL
 ,ts          TIMESTAMP      NOT NULL
 ,text        VARCHAR2(4000)
 ,sid         NUMBER
    DEFAULT SYS_CONTEXT('USERENV','SID')
 ,sessionid   NUMBER
    DEFAULT SYS_CONTEXT('USERENV','SESSIONID')
 ,module      VARCHAR2(48)
    DEFAULT SYS_CONTEXT('USERENV','MODULE')
 ,action      VARCHAR2(32)
    DEFAULT SYS_CONTEXT('USERENV','ACTION')
 ,client_info VARCHAR2(64)
    DEFAULT SYS_CONTEXT('USERENV','CLIENT_INFO')
 ,username    VARCHAR2(30)
    DEFAULT SYS_CONTEXT('USERENV','SESSION_USER')
)
CREATE SEQUENCE DEBUG_LOG_SEQ;
CREATE OR REPLACE PACKAGE DB_FORMS_DEBUG IS

TYPE logtable_type IS TABLE OF VARCHAR2(4000)
  INDEX BY BINARY_INTEGER;
TYPE date_table_type IS TABLE OF DATE
  INDEX BY BINARY_INTEGER;

PROCEDURE msg
  (text IN VARCHAR2
  ,ts IN TIMESTAMP := NULL);

PROCEDURE insert_form_debug_log
  (logtable IN logtable_type
  ,date_table IN date_table_type
  ,username IN VARCHAR2
  ,module IN VARCHAR2
  );

END DB_FORMS_DEBUG;
CREATE OR REPLACE PACKAGE BODY DB_FORMS_DEBUG IS

PROCEDURE msg
  (text IN VARCHAR2
  ,ts IN TIMESTAMP := NULL) IS
PRAGMA AUTONOMOUS_TRANSACTION;
BEGIN
  FOR i IN 0 .. LENGTH(text) / 4000 LOOP
    INSERT INTO DEBUG_LOG
      (log_id
      ,ts
      ,text)
    VALUES
      (DEBUG_LOG_SEQ.NEXTVAL
      ,NVL(ts, SYSTIMESTAMP)
      ,SUBSTR(text, i * 4000 + 1, 4000));
  END LOOP;
  COMMIT;
END msg;

PROCEDURE insert_form_debug_log
  (logtable IN logtable_type
  ,date_table IN date_table_type
  ,username IN VARCHAR2
  ,module IN VARCHAR2
  ) IS
PRAGMA AUTONOMOUS_TRANSACTION;
BEGIN
  FORALL i IN logtable.FIRST..logtable.LAST
    INSERT INTO DEBUG_LOG
      (log_id
      ,ts
      ,text
      ,module
      ,username)
    VALUES
      (DEBUG_LOG_SEQ.NEXTVAL
      ,date_table(i)
      ,logtable(i)
      ,insert_form_debug_log.module
      ,insert_form_debug_log.username);
  COMMIT;
END insert_form_debug_log;

END DB_FORMS_DEBUG;

Form Package Specification

PACKAGE PKG_DEBUG IS

-- store the log contents in a database table, then reset the log
PROCEDURE flush_to_table;
-- debug log message
PROCEDURE msg (text IN VARCHAR2);
-- spit out debug info when an unexpected error ocurs
PROCEDURE on_error;
-- spit out debug info when a message is issued to the user
PROCEDURE on_message;
--popup a window showing the contents of the debug log
PROCEDURE show_log;
-- log current useful status info
PROCEDURE status;

END PKG_DEBUG;

Form Package Body

PACKAGE BODY PKG_DEBUG IS

-- the debug log is a circular buffer of debug log messages
TYPE debug_log_table_type IS TABLE OF VARCHAR2(4000) INDEX BY BINARY_INTEGER;
TYPE log_ts_table_type IS TABLE OF DATE INDEX BY BINARY_INTEGER;
con_debug_log_size CONSTANT PLS_INTEGER := 200;
debug_log_table debug_log_table_type;
log_ts_table log_ts_table_type;
debug_log_pos PLS_INTEGER;

PROCEDURE flush_to_table IS
-- send the debug log buffer to database table DEBUG_LOG
  c INTEGER := 0;
  i INTEGER := 1;
  logtable DB_FORMS_DEBUG.logtable_type;
  ts_table DB_FORMS_DEBUG.ts_table_type;
BEGIN
  LOOP
    EXIT WHEN i IS NULL;
    c := c + 1;
    logtable(c) := debug_log_table(i);
    ts_table(c) := log_ts_table(i);
    i := i + 1;
    --wrap to the top of the buffer
    IF i = con_debug_log_size THEN
      i := 1;
    END IF;
    EXIT WHEN i = debug_log_pos OR NOT debug_log_table.EXISTS(i);
  END LOOP;
  IF logtable.COUNT > 0 THEN
    --this log message will only survive if the db call fails
    DB_FORMS_DEBUG.insert_form_debug_log
      (logtable => logtable
      ,date_table => ts_table
      ,module => NAME_IN('SYSTEM.CURRENT_FORM')
      ,username => [user name/id...]);
    debug_log_table.DELETE;
    log_ts_table.DELETE;
    debug_log_pos := NULL;
  END IF;
END flush_to_table;

PROCEDURE msg (text IN VARCHAR2) IS
-- add debug log message to the scrolling log
BEGIN                              
  debug_log_pos := MOD(NVL(debug_log_pos,0) + 1, con_debug_log_size);
  debug_log_table(debug_log_pos) := SUBSTR(text,1,4000);
  log_ts_table(debug_log_pos) := PKG_FORM.system_datetime;
END msg;

PROCEDURE on_error IS
-- Catch-all error handler for unexpected errors.
BEGIN
  -- This should only ever be called when an *unexpected* error occurs.
  --
  -- If an error is expected in some circumstance, it should be handled (e.g. by putting
  -- code in the on-error trigger to do something intelligent instead of calling this
  -- catch-all procedure).
  --
  msg('DBMS ERROR    : ' || DBMS_ERROR_CODE || ' ' || RTRIM(DBMS_ERROR_TEXT,CHR(10)));
  status;
  flush_to_table; -- so that support personnel may investigate
  PKG_MESSAGE.error(ERROR_TYPE || '-' || ERROR_CODE || ' ' || ERROR_TEXT, 'System Error ' || ERROR_TYPE || '-' || ERROR_CODE);
END on_error;

PROCEDURE on_message IS
BEGIN
  status;
  MESSAGE(SUBSTR(MESSAGE_TYPE || '-' || MESSAGE_CODE || ' ' || MESSAGE_TEXT, 1, 200), ACKNOWLEDGE);
END on_message;

PROCEDURE show_log IS
  i INTEGER := debug_log_pos;
BEGIN
  -- fill the onscreen item CONTROL.DEBUGLOG starting
  -- with the most recent debug line, and go backwards until
  -- it is filled or there are no more debug log messages to show
  -- It would be better for this to be done in a separate
  -- form specifically for this purpose, to avoid problems
  -- when we want to show the debug log without
  -- firing validation triggers.
  :CONTROL.debuglog := NULL;
  LOOP
    EXIT WHEN i IS NULL;
      -- "64K should be enough for everybody"
      IF :CONTROL.debuglog IS NOT NULL THEN
        :CONTROL.debuglog := SUBSTR(CHR(10) || :CONTROL.debuglog, 1, 65534);
        EXIT WHEN LENGTH(:CONTROL.debuglog) = 65534;
      END IF;
      :CONTROL.debuglog := SUBSTR(
        TO_CHAR(i,'FM0000')
        || ' ' || TO_CHAR(log_ts_table(i),'HH24:MI:SS')
        || ' ' || debug_log_table(i)
        || :CONTROL.debuglog
        , 1, 65534);
      EXIT WHEN LENGTH(:CONTROL.debuglog) = 65534;
      i := i - 1;
      --wrap to the top of the buffer
      IF i = 0 THEN
        i := con_debug_log_size - 1;
      END IF;
      EXIT WHEN i = debug_log_pos OR NOT debug_log_table.EXISTS(i);
  END LOOP;
  GO_ITEM('CONTROL.debuglog');
  check_package_failure;
END show_log;

PROCEDURE status IS
BEGIN
  msg('FORM STATUS   : ' || :SYSTEM.FORM_STATUS);
  msg('RECORD STATUS : ' || :SYSTEM.RECORD_STATUS);
  msg('TRIGGER ITEM  : ' || NVL(:SYSTEM.TRIGGER_ITEM, :SYSTEM.TRIGGER_BLOCK)
    || ' RECORD #' || :SYSTEM.TRIGGER_RECORD);
  msg('CURSOR ITEM   : ' || :SYSTEM.CURSOR_ITEM
    || ' RECORD #' || :SYSTEM.CURSOR_RECORD);
END status;

END PKG_DEBUG;
In Oracle, ” = NULL but NULL != ”
Purge all Recyclebins without SYSDBA

Leave a Reply

Your email address will not be published / Required fields are marked *