Forms Library: PKG_ITEM

This is just a post to document a standard library that I like to create in Oracle Forms, 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.”

Specification
The main point of this package is to (a) easily make form items more proactive regarding business requirements, e.g. by making it simple to make items conditionally editable, readonly or mandatory; and (b) mitigate the pain of diagnosing bugs with the way items work (by logging when most of these procedures are called).

PACKAGE PKG_ITEM IS

-- set item to value, without changing item state if possible
PROCEDURE assign (itemn IN VARCHAR2, value IN VARCHAR2);

FUNCTION current_record (itemn IN VARCHAR2) RETURN INTEGER;
PROCEDURE disable_button (itemn IN VARCHAR2);
PROCEDURE enable_button (itemn IN VARCHAR2);
PROCEDURE go_next (itemn IN VARCHAR2);
PROCEDURE go_prev (itemn IN VARCHAR2);
PROCEDURE hide (itemn IN VARCHAR2);
FUNCTION is_navigable (itemn IN VARCHAR2) RETURN BOOLEAN;
PROCEDURE set_editable
  (itemn    IN VARCHAR2
  ,rec      IN INTEGER  := NULL
  ,editable IN BOOLEAN  := TRUE
  ,set_null IN BOOLEAN  := FALSE);
PROCEDURE set_readonly (itemn IN VARCHAR2, rec IN INTEGER := NULL);
PROCEDURE set_required (itemn IN VARCHAR2, rec IN INTEGER := NULL);
PROCEDURE set_valid (itemn IN VARCHAR2);
PROCEDURE set_visattr (itemn IN VARCHAR2, currec IN BOOLEAN);
PROCEDURE show (itemn IN VARCHAR2);

END PKG_ITEM;

Package Body

PACKAGE PKG_ITEM IS

cVISATTR_NORMAL CONSTANT VARCHAR2(100) := 'NORMAL_ITEM';
cVISATTR_CURRENT CONSTANT VARCHAR2(100) := 'CURRENT_RECORD';
cVISATTR_DISPLAY CONSTANT VARCHAR2(100) := 'DISPLAY_ITEM';
cVISATTR_REQUIRED CONSTANT VARCHAR2(100) := 'REQUIRED_ITEM';

PROCEDURE assign (itemn IN VARCHAR2, value IN VARCHAR2) IS
-- set item to value, without changing item state if possible
BEGIN
  IF NAME_IN(itemn) != value
    OR (NAME_IN(itemn) IS NULL AND value IS NOT NULL)
    OR (NAME_IN(itemn) IS NOT NULL AND value IS NULL) THEN
    PKG_DEBUG.msg(itemn || ':=' || value);
    COPY(value, itemn);
  END IF;
END assign;

FUNCTION current_record (itemn IN VARCHAR2) RETURN INTEGER IS
--gets the record number for the block for the given item
BEGIN
  RETURN GET_BLOCK_PROPERTY
    (SUBSTR(itemn,1,INSTR(itemn,'.')-1)
    ,CURRENT_RECORD);
END current_record;

PROCEDURE disable_button (itemn IN VARCHAR2) IS
BEGIN
  msg('PKG_ITEM.disable_button('||itemn||')');
  IF :SYSTEM.CURSOR_ITEM = UPPER(itemn) THEN
    DO_KEY('NEXT_ITEM');
    check_package_failure;
  END IF;
  SET_ITEM_PROPERTY(itemn, ENABLED, PROPERTY_FALSE);
END disable_button;

PROCEDURE enable_button (itemn IN VARCHAR2) IS
  item_id ITEM := FIND_ITEM(itemn);
BEGIN
  msg('PKG_ITEM.enable_button('||itemn||')');
  SET_ITEM_PROPERTY(item_id, ENABLED, PROPERTY_TRUE);
  SET_ITEM_PROPERTY(item_id, NAVIGABLE, PROPERTY_TRUE);
END enable_button;

PROCEDURE go_next (itemn IN VARCHAR2) IS
--This is used when doing a GO_ITEM in order to implement a NEXT_ITEM.
--This will issue a NEXT_ITEM if the item we've just gone to
--is not currently navigable on the current record.
BEGIN
  msg('PKG_ITEM.go_next('||itemn||')');
  GO_ITEM(itemn);
  check_package_failure;
  IF GET_ITEM_INSTANCE_PROPERTY(:SYSTEM.CURSOR_ITEM
	,GET_BLOCK_PROPERTY(:SYSTEM.CURSOR_BLOCK, CURRENT_RECORD)
	,NAVIGABLE) = 'FALSE' THEN
    NEXT_ITEM;
    check_package_failure;
  END IF;
END go_next_if_not_navigable;

PROCEDURE go_prev (itemn IN VARCHAR2) IS
--This is used when doing a GO_ITEM in order to implement a PREVIOUS_ITEM.
--This will issue a PREVIOUS_ITEM if the item we've just gone to
--is not currently navigable on the current record.
BEGIN
  msg('PKG_ITEM.go_prev('||itemn||')');
  GO_ITEM(itemn);
  check_package_failure;
  IF GET_ITEM_INSTANCE_PROPERTY(:SYSTEM.CURSOR_ITEM
	,GET_BLOCK_PROPERTY(:SYSTEM.CURSOR_BLOCK, CURRENT_RECORD)
	,NAVIGABLE) = 'FALSE' THEN
    PREVIOUS_ITEM;
    check_package_failure;
  END IF;
END go_prev_if_not_navigable;

PROCEDURE hide (itemn IN VARCHAR2) IS
BEGIN
  msg('PKG_ITEM.hide('||itemn||')');
  IF :SYSTEM.CURSOR_ITEM = UPPER(itemn) THEN
    NEXT_ITEM;
    check_package_failure;
  END IF;
  SET_ITEM_PROPERTY(itemn, VISIBLE, PROPERTY_FALSE);
END hide;

FUNCTION is_navigable (itemn IN VARCHAR2) RETURN BOOLEAN IS
BEGIN
  RETURN GET_ITEM_PROPERTY(itemn, NAVIGABLE) = 'TRUE';
END is_navigable;

PROCEDURE set_editable
  (itemn    IN VARCHAR2
  ,rec      IN INTEGER  := NULL
  ,editable IN BOOLEAN  := TRUE
  ,set_null IN BOOLEAN  := FALSE) IS
  item_id ITEM;
BEGIN
  msg('PKG_ITEM.set_editable('||itemn||','||rec||')');
  IF editable THEN
    item_id := FIND_ITEM(itemn);
    IF rec IS NULL THEN
      IF :SYSTEM.CURSOR_ITEM != UPPER(itemn) THEN
        SET_ITEM_PROPERTY(item_id, VISIBLE, PROPERTY_TRUE);
        SET_ITEM_PROPERTY(item_id, ENABLED, PROPERTY_TRUE);
      END IF;
      SET_ITEM_PROPERTY(item_id, NAVIGABLE, PROPERTY_TRUE);
      SET_ITEM_PROPERTY(item_id, INSERT_ALLOWED, PROPERTY_TRUE);
      SET_ITEM_PROPERTY(item_id, UPDATE_ALLOWED, PROPERTY_TRUE);
      SET_ITEM_PROPERTY(item_id, VISUAL_ATTRIBUTE, cVISATTR_NORMAL);
    ELSE
      SET_ITEM_INSTANCE_PROPERTY(item_id, rec, NAVIGABLE, PROPERTY_TRUE);
      SET_ITEM_INSTANCE_PROPERTY(item_id, rec, INSERT_ALLOWED, PROPERTY_TRUE);
      SET_ITEM_INSTANCE_PROPERTY(item_id, rec, UPDATE_ALLOWED, PROPERTY_TRUE);
      SET_ITEM_INSTANCE_PROPERTY(item_id, rec, VISUAL_ATTRIBUTE, cVISATTR_NORMAL);
    END IF;
  ELSE
    set_readonly(itemn, rec);
    --clear any data the user may have entered into the item (current record only)
    IF set_null AND NAME_IN(itemn) IS NOT NULL THEN
      msg(itemn||':=NULL');
      COPY(NULL, itemn);
    END IF;
  END IF;
END set_editable;

PROCEDURE set_readonly (itemn IN VARCHAR2, rec IN INTEGER := NULL) IS
  item_id ITEM := FIND_ITEM(itemn);
BEGIN
  msg('PKG_ITEM.set_readonly('||itemn||','||rec||')');
  IF rec IS NULL THEN
    SET_ITEM_PROPERTY(item_id, NAVIGABLE, PROPERTY_FALSE);
    SET_ITEM_PROPERTY(item_id, INSERT_ALLOWED, PROPERTY_FALSE);
    SET_ITEM_PROPERTY(item_id, UPDATE_ALLOWED, PROPERTY_FALSE);
    SET_ITEM_PROPERTY(item_id, VISUAL_ATTRIBUTE, cVISATTR_DISPLAY);
  ELSE
    SET_ITEM_INSTANCE_PROPERTY(item_id, rec, NAVIGABLE, PROPERTY_FALSE);
    SET_ITEM_INSTANCE_PROPERTY(item_id, rec, INSERT_ALLOWED, PROPERTY_FALSE);
    SET_ITEM_INSTANCE_PROPERTY(item_id, rec, UPDATE_ALLOWED, PROPERTY_FALSE);
    SET_ITEM_INSTANCE_PROPERTY(item_id, rec, VISUAL_ATTRIBUTE, cVISATTR_DISPLAY);
  END IF;
END set_readonly;

PROCEDURE set_required (itemn IN VARCHAR2, rec IN INTEGER := NULL) IS
BEGIN
  msg('PKG_ITEM.set_required('||itemn||','||rec||')');
  IF rec IS NULL THEN
    SET_ITEM_PROPERTY(itemn, REQUIRED, PROPERTY_TRUE);
    SET_ITEM_PROPERTY(itemn, VISUAL_ATTRIBUTE, cVISATTR_REQUIRED);
  ELSE
    SET_ITEM_INSTANCE_PROPERTY(itemn, rec, REQUIRED, PROPERTY_TRUE);
    SET_ITEM_INSTANCE_PROPERTY(itemn, rec, VISUAL_ATTRIBUTE, cVISATTR_REQUIRED);
  END IF;
END set_required;

PROCEDURE set_valid (itemn IN VARCHAR2) IS
BEGIN
  msg('PKG_ITEM.set_valid('||itemn||')');
  SET_ITEM_PROPERTY(itemn, ITEM_IS_VALID, PROPERTY_TRUE);
END set_valid;

PROCEDURE set_visattr (itemn IN VARCHAR2, currec IN BOOLEAN) IS
  rec INTEGER;
BEGIN
  msg('PKG_ITEM.set_visattr('||itemn||')');
  rec := item_current_record(itemn);
  IF currec THEN
    SET_ITEM_INSTANCE_PROPERTY(itemn, rec, VISUAL_ATTRIBUTE, cVISATTR_CURRENT);
  ELSE
    SET_ITEM_INSTANCE_PROPERTY(itemn, rec, VISUAL_ATTRIBUTE, cVISATTR_NORMAL);
  END IF;
END set_current_item_visattr;

PROCEDURE show (itemn IN VARCHAR2) IS
BEGIN
  msg('PKG_ITEM.show('||itemn||')');
  SET_ITEM_PROPERTY(itemn, VISIBLE, PROPERTY_TRUE);
END show;

END PKG_ITEM;

Example usage:

PKG_ITEM.set_editable('EMP.SALARY'
  ,rec      => PKG_FORM.current_record('MYBLOCK')
  ,editable => (:EMP.ROLE != 'CEO')
  );

The above example makes the SALARY item readonly if the employee’s role is ‘CEO’ – you would call this from the post-query trigger on the block, so on rows where the role is not ‘CEO’, SALARY will be editable.

Setting the visual attributes at the row level like this on multi-row blocks, however, has one side-effect. If you have a Current Record Visual Attribute (CRVA) set on the block (or the form), this code will overwrite that, so the CRVA will not be effective for these items. There is a workaround (to be published).

Negative, Captain
Forms Library: PKG_FORM

Leave a Reply

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