I’m building a very simple set of Oracle Forms for a customer who has very simple requirements. The form will allow one set of users to enter “payments”, which eventually get turned into requests for cheques to be sent out from the organisation. Each payment must go through an approval process – another set of users will open another form which will list all the payments that have been entered, select some or all of them and mark them as “Approved”.
To implement this design, I have one form which allows the users to enter the payment details; this form allows users to both insert new payments and update existing ones. Once a payment has been marked as “Approved”, they can only view but not edit them.
I’ve created a second form for the approvers, which lists all the payments that have not yet been approved, and gives them a simple checkbox. They tick any or all of the payments that they wish to approve, and click the “Approve” button. The button just sends an array of payment IDs to a database procedure which does a bulk update on the payments, setting their status as appropriate. Simple, right?
The one complication here is that this is a multi-user system, and it is quite likely that a users might try to update a payment at the same time as the approver is trying to mark them as approved. My first test of the forms indicated that this would cause a record locking issue:
In session #1, I open the payments form, query an existing payment, and start editing one of the fields. Oracle Forms automatically locks the record for update.
In session #2, I open the approvals form, tick the same payment, and click the “Approve” button. The form complains that it cannot reserve the record for update and the error logged is “FRM-40735 WHEN-BUTTON-PRESSED trigger raised unhandled exception ORA-04068.”
To solve this, I go to the checkbox item in the approvals form and add this code to the when-checkbox-changed trigger (the checkbox item is called PAYMENTS.SELECTED):
IF :PAYMENTS.SELECTED = 'Y' THEN
LOCK_RECORD;
IF NOT FORM_SUCCESS THEN
:PAYMENTS.SELECTED := 'N';
RAISE FORM_TRIGGER_FAILURE;
END IF;
END IF;
Now, when the user tries to tick a payment that is currently locked, the LOCK_RECORD causes the form to attempt to lock the record. The “unable to reserve record for update” error still appears, after which the trigger un-ticks the record automatically.
If the approve gets to a payment first and ticks it, the record will now be locked until the form commits the status change; this ensures that other users cannot modify the record until the approver either approves the payment or cancels out of the form.
This is just a story about a really weird bit of code. It was the type of code you look at and say, “that’s obviously wrong” and delete straight away.
One of the requirements was to rebuild an Oracle form, a data-entry form for receipts (cash, cheque, credit card, etc). Some of the cashiers use these cheque readers to read the numbers off the MICR band, and with the first release of the new form they reported a defect – “the cheque readers don’t work”.
I didn’t have access to a cheque reader when I was developing the form, but assumed that it would be a normal cheque reader – they put the cheque in, it reads it, it sends a series of digits to the computer. The form should work no different than if the operator keyed in the numbers manually (which they have to do, anyway, if the cheque reader doesn’t work for a particular cheque).
So to investigate the defect I requisitioned a cheque reader, along with some test cheques; after some difficulty (turns out these things don’t work alongside my USB keyboard, I had to get a PS2 keyboard), it was working.
It didn’t take long to discover that the cheque reader was sending the cheque number and BSB in the wrong order, as far as the form is concerned; thus why the validation was failing.
I opened up the old form again, and had a good hard look at the fields. Turns out, what I missed originally is that there is a custom KEY-NEXT-ITEM trigger on the bank code field (which is where the operator puts the focus before using the cheque reader). It looks something like this:
DECLARE
v_data VARCHAR2(50) := REPLACE(REPLACE(:rct.bak_code
,' ','')
,CHR(9),'');
BEGIN
IF LENGTH(v_data) > 4 THEN
IF LENGTH(v_data) < 14 THEN
NULL;
ELSE
:rct.cheque_no := SUBSTR(v_data,1,6);
:rct.bak_code := SUBSTR(v_data,7,3);
:rct.branch := SUBSTR(v_data,10,3);
go_field('RCT.CHEQUE_TYPE');
END IF;
ELSE
go_field('RCT.BRANCH');
END IF;
END;
It turns out that:
(a) the REPLACE(REPLACE( code to remove spaces and tab characters (CHR(9)) is redundant, since the cheque reader never sends spaces, and when it sends a TAB, Oracle Forms doesn’t put a CHR(9) into the field anyway; instead it fires the KEY-NEXT-ITEM trigger
(b) if the length of the data is between 5 and 13, the KEY-NEXT-ITEM trigger does nothing; which means the focus stays in the bak_code field
It’s (b) that is the reason this worked. The trigger fires three times when the cheque reader is used; the third time the trigger fires, it’s got enough digits lumped together in the bak_code field, which it then splits apart, and moves the relevant bits to the cheque_no and branch fields.
A normal, sane person, building this form, would have designed the form to accept the cheque number, bank code and branch in the same order that they are read from the cheque reader; that way, no special code is required – the cheque reader just tabs through the fields, filling them in as it goes.
Oh well – it’s too late to do a screen redesign now, so I’ve had to pretty much replicate the same behaviour in the new form; except that my new code is a little bit smarter – it can also read money orders, which I’ve been told will make the cashiers very happy.
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;
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.”
I’ll only create those things which I find become generally useful for a particular site. If something’s not used, get rid of it. That said, most of these things I’ve created because I use them frequently.
PROCEDURE assert (truth IN BOOLEAN, module IN VARCHAR2) IS
BEGIN
IF truth THEN
NULL;
ELSE --truth may be null or false
PKG_MESSAGE.error('Assertion failed in ' || module);
END IF;
END assert;
PROCEDURE check_package_failure IS
-- (this is generated automatically by Oracle Forms when a block
-- relation is created)
-- This should be called after various builtins that, instead of
-- doing the honourable thing (raising an exception), set
-- FORM_SUCCESS. These builtins are*:
-- CALL_FORM CALL_QUERY CANCEL_QUERY CLEAR_BLOCK CLEAR_FORM
-- CLEAR_ITEM CLEAR_RECORD COUNT_QUERY DELETE_RECORD DOWN
-- DO_KEY DUPLICATE_ITEM DUPLICATE_RECORD EDIT_TEXTITEM ENTER
-- ENTER_QUERY EXECUTE_QUERY EXECUTE_TRIGGER EXIT_FORM
-- FETCH_RECORDS FIRST_RECORD FORMS_DDL GO_BLOCK GO_FORM
-- GO_ITEM GO_RECORD HOST INSERT_RECORD LAST_RECORD
-- LIST_VALUES LOCK_RECORD LOGON LOGON_SCREEN LOGOUT
-- NEW_FORM NEXT_BLOCK NEXT_ITEM NEXT_FORM NEXT_KEY
-- NEXT_RECORD NEXT_SET OPEN_FORM PREVIOUS_BLOCK
-- PREVIOUS_FORM PREVIOUS_ITEM PREVIOUS_BLOCK UP
-- * if you notice any builtins missing from, or that should not be
-- included in this list - please let me know!
BEGIN
IF NOT ( Form_Success ) THEN
RAISE Form_Trigger_Failure;
END IF;
END check_package_failure;
PROCEDURE msg (text IN VARCHAR2) IS
-- just a convenient wrapper for PKG_DEBUG.msg
BEGIN
PKG_DEBUG.msg(text);
END msg;
PKG_DEBUG definition
Form-level trigger: pre-select
msg(:SYSTEM.LAST_QUERY);
Form-level trigger: on-error
msg('on-error ' || ERROR_TYPE || '-' || ERROR_CODE || ' ' || ERROR_TEXT);
-- add handlers here for errors that we don't want to spit the dummy on (i.e. handle gracefully)
CASE
WHEN ERROR_TYPE||'-'||ERROR_CODE IN
('FRM-41105' --"You cannot query records without a saved parent record."
) THEN
-- the default message is a little obtuse - give a standard response
MESSAGE('That function is not allowed here.', ACKNOWLEDGE);
RAISE FORM_TRIGGER_FAILURE;
WHEN ERROR_TYPE||'-'||ERROR_CODE IN
('FRM-40202' --"Field must be entered."
,'FRM-40203' --"Field must be entered completely."
,'FRM-40207' --"Must be in range x to y"
,'FRM-40209' --"Field must be of form x."
,'FRM-40212' --"Invalid value for field x."
,'FRM-40356' --"Invalid number in example record. Query not issued."
,'FRM-40357' --"Invalid string in example record. Query not issued."
,'FRM-40358' --"Invalid date in example record. Query not issued."
,'FRM-40359' --"Invalid date or time in example record. Query not issued."
,'FRM-40501' --"ORACLE error: unable to reserve record for update or delete."
,'FRM-40654' --"Record has been updated by another user. Re-query to see change."
,'FRM-40657' --"Record changed or deleted by another user."
,'FRM-41106' --"You cannot create records without a parent record."
) THEN
-- show the error message in a popup and raise FTF
PKG_FORM.error(ERROR_TEXT);
WHEN ERROR_TYPE||'-'||ERROR_CODE
BETWEEN 'FRM-50000' AND 'FRM-51000' THEN
-- almost all the FRM-5xxxx errors are to do with data format issues, e.g. date
-- fields, numbers, etc
PKG_FORM.error(ERROR_TEXT);
WHEN ERROR_TYPE||'-'||ERROR_CODE IN
('FRM-40100' --"At first record."
,'FRM-40102' --"Record must be entered or deleted first."
,'FRM-40110' --"At first block."
,'FRM-40111' --"At last block."
,'FRM-40200' --"Field is protected against update."
,'FRM-40201' --"Field is full. Can't insert character."
,'FRM-40401' --"No changes to save."
,'FRM-40405' --"No changes to apply."
,'FRM-41026' --"Field does not understand operation." (e.g. F9 on item with no list)
,'FRM-41050' --"You cannot update this record."
,'FRM-41051' --"You cannot create records here."
) THEN
-- just display the default error message on the status bar (or popup if >1 message in quick succession)
MESSAGE(ERROR_TEXT, ACKNOWLEDGE);
RAISE FORM_TRIGGER_FAILURE;
ELSE
PKG_DEBUG.on_error;
END CASE;
Form-level trigger: on-message
msg('on-message ' || MESSAGE_TYPE || '-' || MESSAGE_CODE || ' ' || MESSAGE_TEXT);
-- trap some messages and replace with more user-friendly message
CASE
WHEN MESSAGE_TYPE||'-'||MESSAGE_CODE IN
('FRM-40350' --"Query caused no records to be retrieved."
) THEN
PKG_FORM.note('No matching receipts found.', 'Search Results');
WHEN MESSAGE_TYPE||'-'||MESSAGE_CODE IN
('FRM-41800' --"List of Values not available for this field."
,'FRM-40400' --"Transaction complete: %s records applied and saved."
) THEN
-- the default message is user-friendly enough to show on the status bar
MESSAGE(MESSAGE_TEXT, ACKNOWLEDGE);
ELSE
PKG_DEBUG.on_message;
END CASE;
This is just a post to document the 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.”
Forms Package Specification: PKG_MESSAGE
PACKAGE PKG_MESSAGE IS
PROCEDURE error
(message IN VARCHAR2
,popup_title IN VARCHAR2 := 'Error');
PROCEDURE note
(message IN VARCHAR2
,popup_title IN VARCHAR2 := 'Note');
PROCEDURE warning
(message IN VARCHAR2
,popup_title IN VARCHAR2 := 'Warning');
END PKG_MESSAGE;
Forms Package Body: PKG_MESSAGE
PACKAGE PKG_MESSAGE IS
PROCEDURE error
(message IN VARCHAR2
,popup_title IN VARCHAR2 := 'Error') IS
-- requires a suitable alert called "ERROR"
n NUMBER;
BEGIN
msg('PKG_MESSAGE.error('''||message||''','''||popup_title||''')');
SET_ALERT_PROPERTY('ERROR', TITLE, popup_title);
SET_ALERT_PROPERTY('ERROR', ALERT_MESSAGE_TEXT, message);
n := SHOW_ALERT('ERROR');
RAISE FORM_TRIGGER_FAILURE;
END error;
PROCEDURE note
(message IN VARCHAR2
,popup_title IN VARCHAR2 := 'Note') IS
--requires a suitable alert "NOTE"
n NUMBER;
BEGIN
msg('PKG_MESSAGE.note('''||message||''','''||popup_title||''')');
SET_ALERT_PROPERTY('NOTE', TITLE, popup_title);
SET_ALERT_PROPERTY('NOTE', ALERT_MESSAGE_TEXT, message);
n := SHOW_ALERT('NOTE');
END note;
PROCEDURE warning
(message IN VARCHAR2
,popup_title IN VARCHAR2 := 'Warning') IS
-- requires a suitable alert "WARNING"
n NUMBER;
BEGIN
msg('PKG_MESSAGE.warning('''||message||''','''||popup_title||''')');
SET_ALERT_PROPERTY('WARNING', TITLE, popup_title);
SET_ALERT_PROPERTY('WARNING', ALERT_MESSAGE_TEXT, message);
n := SHOW_ALERT('WARNING');
END warning;
END PKG_MESSAGE;
If you have a multi-record block, and you use the handy Current Record Visual Attribute (CRVA) to set, say, a different background colour on all the items in the currently selected record, you may have run into this problem.
If you want to conditionally switch the visual attribute for certain items, at the item instance (i.e. record) level, this causes the CRVA to be overwritten, and the current record won’t be consistently highlighted. To get around this problem, a bit more code is required.
For example, let’s say you have a multi-record block called EMP, and it has two items that are sometimes gray, sometimes white – SALARY and ROLE. You have defined the following visual attributes:
EDITABLE_ITEM – white background
READONLY_ITEM – gray background
CURRENT_RECORD – blue background
Package Specification
PACKAGE EMP_BLOCK IS
PROCEDURE highlight_current_record;
PROCEDURE when_clear_block;
PROCEDURE when_remove_record;
END EMP_BLOCK;
Package Body
PACKAGE EMP_BLOCK IS
record_highlighted INTEGER;
PROCEDURE highlight_current_record IS
rec INTEGER := GET_BLOCK_PROPERTY('EMP', CURRENT_RECORD);
PROCEDURE set_visattr
(itemn IN VARCHAR2
,rec IN NUMBER
,visattr IN VARCHAR2) IS
BEGIN
IF visattr IS NULL THEN
-- (we could, if needed, make this more intelligent about
-- detecting whether the record is NEW/INSERT/CHANGED,
-- and examine the INSERT_ALLOWED/UPDATE_ALLOWED
-- properties accordingly)
IF GET_ITEM_INSTANCE_PROPERTY
(itemn
,record_highlighted
,UPDATE_ALLOWED) = 'TRUE' THEN
set_visattr(itemn, record_highlighted, 'EDITABLE_ITEM');
ELSE
set_visattr(itemn, record_highlighted, 'READONLY_ITEM');
END IF;
ELSE
SET_ITEM_INSTANCE_PROPERTY
(itemn
,rec
,VISUAL_ATTRIBUTE
,visattr);
END IF;
END set_visattr;
BEGIN
-- Note: if record_highlighted is null, then no record
-- is currently highlighted
IF rec != record_highlighted THEN
--un-highlight the record that was highlighted
set_visattr('EMP.SALARY', record_highlighted);
set_visattr('EMP.ROLE', record_highlighted);
END IF;
--highlight the newly selected record
set_visattr('EMP.SALARY', rec, 'CURRENT_RECORD');
set_visattr('EMP.ROLE', rec, 'CURRENT_RECORD');
record_highlighted := rec;
END highlight_current_record;
PROCEDURE when_clear_block IS
BEGIN
record_highlighted := NULL;
END when_clear_block;
PROCEDURE when_remove_record IS
BEGIN
IF record_highlighted = :SYSTEM.TRIGGER_RECORD THEN
record_highlighted := NULL;
END IF;
END when_remove_record;
END EMP_BLOCK;
Block-level triggers on EMP:
when-new-record-instance
EMP_BLOCK.highlight_current_record;
when-clear-block
EMP_BLOCK.when_clear_block;
when-remove-record
EMP_BLOCK.when_remove_record;
Also, whenever your code modifies the UPDATE_ALLOWED property on SALARY or ROLE, it must then call EMP_BLOCK.highlight_current_record again.
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
PACKAGE PKG_FORM IS
PROCEDURE centre_window (windown IN VARCHAR2);
PROCEDURE check_record_is_saved;
PROCEDURE commit;
FUNCTION current_record (blockn IN VARCHAR2) RETURN INTEGER;
FUNCTION current_record_status (blockn IN VARCHAR2) RETURN VARCHAR2;
PROCEDURE delay_action (timern IN VARCHAR2);
PROCEDURE set_current_record_status
(blockn IN VARCHAR2
,istatus IN NUMBER);
PROCEDURE set_mdi_window_title (clock IN BOOLEAN := TRUE);
-- gets the date/time from the app server
FUNCTION system_datetime RETURN DATE;
END PKG_FORM;
Package Body
PACKAGE PKG_FORM IS
cAPP_TITLE CONSTANT VARCHAR2(100) := '[insert app title here]';
PROCEDURE centre_window (windown IN VARCHAR2) IS
cMAIN_WINDOW CONSTANT VARCHAR2(100) := '[insert main window name here]';
x NUMBER;
y NUMBER;
main_win WINDOW := FIND_WINDOW(cMAIN_WINDOW);
window_id WINDOW := FIND_WINDOW(windown);
BEGIN
x := GET_WINDOW_PROPERTY(main_win,X_POS)
+ (GET_WINDOW_PROPERTY(main_win,WIDTH )
- GET_WINDOW_PROPERTY(window_id,WIDTH )) / 2;
y := GET_WINDOW_PROPERTY(main_win,Y_POS)
+ (GET_WINDOW_PROPERTY(main_win,HEIGHT)
- GET_WINDOW_PROPERTY(window_id,HEIGHT)) / 2;
SHOW_WINDOW(window_id, x, y);
END centre_window;
PROCEDURE check_record_is_saved IS
BEGIN
IF :SYSTEM.FORM_STATUS = 'CHANGED' THEN
PKG_MESSAGE.error('Please save or cancel your changes first.');
END IF;
END check_record_is_saved;
PROCEDURE commit IS
msglevel VARCHAR2(2) := :SYSTEM.MESSAGE_LEVEL;
BEGIN
msg('PKG_FORM.commit');
-- set message level to avoid FRM-40401 "No changes to save."
:SYSTEM.MESSAGE_LEVEL := '5';
COMMIT_FORM;
:SYSTEM.MESSAGE_LEVEL := msglevel;
IF :SYSTEM.FORM_STATUS != 'QUERY' THEN
PKG_MESSAGE.error('Unable to save changes.');
END IF;
END commit;
FUNCTION current_record (blockn IN VARCHAR2) RETURN INTEGER IS
BEGIN
RETURN GET_BLOCK_PROPERTY(blockn, CURRENT_RECORD);
END current_record;
FUNCTION current_record_status (blockn IN VARCHAR2) RETURN VARCHAR2 IS
BEGIN
RETURN GET_RECORD_PROPERTY(
GET_BLOCK_PROPERTY(blockn, CURRENT_RECORD),
blockn,
STATUS);
END current_record_status;
PROCEDURE delay_action (timern IN VARCHAR2) IS
-- requires a suitable WHEN-TIMER-EXPIRED form-level trigger
timer_id TIMER;
BEGIN
IF ID_NULL(FIND_TIMER(timern)) THEN
msg('CREATE_TIMER('||timern||')');
timer_id := CREATE_TIMER(timern,1,NO_REPEAT);
END IF;
END delay_action;
PROCEDURE set_current_record_status
(blockn IN VARCHAR2
,istatus IN NUMBER) IS
BEGIN
SET_RECORD_PROPERTY(
GET_BLOCK_PROPERTY(blockn, CURRENT_RECORD),
blockn,
STATUS,
istatus);
END set_current_record_status;
PROCEDURE set_mdi_window_title (clock IN BOOLEAN := TRUE) IS
--scaling factor is the number of milliseconds in a second
cSCALING_FACTOR CONSTANT NUMBER := 1000;
--don't update the time more than once every 10 seconds
cMIN_UPDATE_FREQUENCY CONSTANT NUMBER := 10;
date_time DATE;
timer_id TIMER;
seconds PLS_INTEGER;
ms PLS_INTEGER;
BEGIN
IF clock THEN
date_time := system_datetime;
SET_WINDOW_PROPERTY(FORMS_MDI_WINDOW, TITLE,
cAPP_TITLE || ' - '
|| TO_CHAR(date_time,'Dy FMDD Mon YYYY HHFM:MIpm'));
IF ID_NULL(FIND_TIMER('CLOCK')) THEN
--get the seconds portion of the current time
seconds := (date_time - TRUNC(date_time,'MI')) * 86400;
--update the time at the end of the minute (or thereabouts)
ms := GREATEST((61 - seconds) * cSCALING_FACTOR
,cMIN_UPDATE_FREQUENCY * cSCALING_FACTOR);
timer_id := CREATE_TIMER('CLOCK', ms, NO_REPEAT);
END IF;
ELSE
SET_WINDOW_PROPERTY(FORMS_MDI_WINDOW, TITLE, cAPP_TITLE);
END IF;
END set_mdi_window_title;
FUNCTION system_datetime RETURN DATE IS
-- gets the date/time from the app server
-- should perform better than calling SYSDATE all the time
-- WARNING: this assumes that the builtin date format includes the time component!
BEGIN
RETURN TO_DATE(:SYSTEM.EFFECTIVE_DATE,
GET_APPLICATION_PROPERTY(BUILTIN_DATE_FORMAT));
END system_datetime;
END PKG_FORM;
Example form-level trigger: when-timer-expired
DECLARE
timern VARCHAR2(100) := GET_APPLICATION_PROPERTY(TIMER_NAME);
BEGIN
msg('when-timer-expired ' || timern);
CASE timern
WHEN 'CLOCK' THEN
PKG_FORM.set_mdi_window_title;
WHEN 'PKGNAME_XYZ' THEN
PKGNAME.xyz;
-- ... etc. ...
ELSE
PKG_MESSAGE.error('Unexpected timer name: ' || timern, 'System Error');
END CASE;
END;
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).
I’ve been trying a number of strategies to improve the performance of a very complex form (Oracle Forms 6i) currently in development. We’ve already done a fair amount of work making the code as efficient as possible, while still being reasonably maintainable, so there don’t seem to be any more low-hanging fruit we can pick off easily.
One aspect of the performance is the form startup time, which is on the order of 9-17 seconds. The kinds of changes I’m testing don’t make a very visible change to this time, so to work out whether the changes are worthwhile I have to be a bit more scientific about performance measurement. That means I have to use statistics (Disclaimer: I am not a statistician, so take what I say with a grain of salt and do your own research!). I test the form with the original code and with the modified code to see whether a particular code change makes any difference to the performance.
I start the form up, wait for it to load, then run our debug tool which tells me the times (to the nearest second) when the form started and when control was passed to the user. I then record these times in a spreadsheet, then close the form and try again two or three times, recording each result. Then I take the average and write that down. I’ll then change back to the original (unimproved) code, run the whole test again, then compare the average results. Sometimes the average is better, worse or the same as the original.
This is what I was doing today – I’d made a change which I thought might knock off a second or two off the startup time, and so I ran my 2-phase timing test:
Improved code timings: 19s, 8s, 7s, 7s
Original code timings: 9s, 8s, 8s
What can I conclude from these data? What I did conclude was that the first timing (19s) was an outlier – it was the first time I’d run the form today so it probably had to load various caches and possibly even perform hard-parses for some of the queries. The original code had an average startup time of 8.3 seconds, and the improved code loaded in 7.3 seconds on average (discounting the outlier). My improvement saved 1 second!
Or did it? These tests were performed between 8:16 and 8:27 on a Tuesday morning. I later thought of a slightly different way of doing the code improvement, implemented it and ran the whole test again:
Improved(#2) code timings: 11s, 9s, 12s, 9s
Original code timings: 11s, 12s, 11s, 7s, 8s
The averages have risen to 10.3 and 9.8 seconds, and the “improved” code actually looks worse here! This second battery of tests were performed between 9:13 and 9:22 on the same morning. You’ll also notice that I ran the test more often this time. Why? Well, I couldn’t believe that the improved code slowed the form to an average 10.6 seconds, so ran it a fourth time; and due to my increasing suspicion that these timings were more random than I’d realised, I ran the final test five times. In the end I decided the slower times must be because more and more developers have arrived by 9am and so the app server is busier, throwing my test results into confusion.
One thing I’ll confess is that I’ve had to resist a temptation all along to only include timings that seem “reasonable” – e.g. if the form took 19 seconds to load I’d immediately suspect some other process on the server had slowed my session down, and so I’d be tempted to not include it in the results spreadsheet. I knew enough about statistics to know that doing this would run the risk of introducing confirmation bias into the results, so I diligently recorded every result I observed.
After considering the apparent failure of my attempt to prove my code change made a discernable difference to the performance of the code, I started thinking a bit more about what was going on as I ran the tests and recorded the results. I realised that a more subtle form of confirmation bias has crept into my results because I didn’t decide firsthand how many tests I would run. I simply ran the test three or our times, depending on whether I was in a hurry, and if it didn’t seem to be coming up with the numbers I was expecting, I’d keep running it until it did!
Writing it out like that, it seems blatently obvious, but when you’re in the middle of running these tests and recording results it’s very easy to slip up.
What did I learn from all this? Before running any tests, write down exactly how many tests will be run, and at what times of the day. In other words, try to eliminate irrelevant variables such as concurrent activity on the server by spreading the tests randomly throughout the day, and try to avoid confirmation bias by predicting ahead of time how many tests will be needed to reduce the impact of outliers on the average result.
Jeffrey Kemp
24 February 2009
Forms /
There are several reasons you might get this error in Oracle Forms, e.g. another user has modified the record before you saved it (as the error message suggests), or a table trigger has modified the record and your form’s DML Returning Value is set to No.
Another cause to chalk up is what one of my colleagues got today. He made a form with a simple table-based block, he would insert a record and save successfully, then try to modify it and consistently got FRM-40654 when he tried to save. No other user was trying to update the row, and there were no triggers on the table.
The answer? The table is an index-organised table, but the block on the form had Key Mode set to Automatic. I suspect the form is comparing the ROWID of the before-and-after change, but because the table is index-organised the ROWID is not necessarily constant. Whatever the reason, changing the Key Mode to Updateable or Non-Updateable solves the problem.
