Add RCDLCKDSP
This commit is contained in:
SJLennon
@@ -27,3 +27,7 @@ Many shops are still using 5250 "green screen" applications and these need to be
|
||||
## BASE36
|
||||
|
||||
A service program to add 1 to an alpha-numeric string of any length.
|
||||
|
||||
## RCDLCKDSP
|
||||
|
||||
A standardized way to handle locked records in an interactive program, and display information about who is holding the lock. For programs that use native IO.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 10 KiB |
@@ -0,0 +1,68 @@
|
||||
*==============================================================
|
||||
* Program that locks a record and then waits for input from
|
||||
* the operator.
|
||||
*
|
||||
* Call this program in two different sessions to see the effect.
|
||||
* Second program will typically get a error:
|
||||
* 'Unable to allocate a record in file' (RNX1218)
|
||||
* and the end user typically choses and unhelpful response.
|
||||
*==============================================================
|
||||
* Note: This is a poor technique because the record remains
|
||||
* locked to all other users until the transaction is
|
||||
* completed, which may be in a few seconds or after lunch.
|
||||
* It is used here to demonstate the RCDLCKDSP processing.
|
||||
*
|
||||
*Note: Pgm reads by RRN for convenience. This is not a gopd
|
||||
* idea is a production program.
|
||||
*
|
||||
*Note: DSPLY is use to simulate a display file interaction
|
||||
* with the user.
|
||||
*
|
||||
*Note: QIWS/QCUSTCDT: believed to be on virtually all systems.
|
||||
*==============================================================
|
||||
|
||||
H DEBUG(*YES) OPTION(*NODEBUGIO:*SRCSTMT:*NOUNREF)
|
||||
H DFTACTGRP(*NO) ACTGRP(*NEW)
|
||||
|
||||
FQCUSTCDT UF E DISK USROPN EXTDESC('QIWS/QCUSTCDT')
|
||||
F RECNO(RRN)
|
||||
F* INFSR(*PSSR)
|
||||
|
||||
D QCmdexc PR EXTPGM('QCMDEXC')
|
||||
D CMD 512A
|
||||
D lgth 15P 5 const
|
||||
|
||||
D RRN s 10p 0 inz(10)
|
||||
D reply S 1A inz('*')
|
||||
D Cmd S 512A
|
||||
|
||||
/free
|
||||
*inlr = *on;
|
||||
|
||||
// Set update file to a short wait time. Otherwise the file or
|
||||
// system default wait time applies.
|
||||
cmd = ' OVRDBF FILE(QCUSTCDT) TOFILE(QIWS/QCUSTCDT) WAITRCD(1)';
|
||||
QCMDEXC(cmd:512);
|
||||
open QCUSTCDT;
|
||||
|
||||
chain RRN QCUSTCDT;
|
||||
|
||||
if %found(QCUSTCDT);
|
||||
// Logic to update the record would be here.
|
||||
dsply 'Read for update' ' ' reply;
|
||||
else;
|
||||
// Logic for record not found would be here
|
||||
dsply 'Record not found' ' ' reply;
|
||||
endif;
|
||||
|
||||
// === End of Program =========================================
|
||||
// Close file before returning
|
||||
close QCUSTCDT;
|
||||
return;
|
||||
|
||||
// Often found in old programs. Uncomment INFSR(*PSSR) in the
|
||||
// F-SPEC to make this active.
|
||||
BEGSR *PSSR;
|
||||
dsply 'In the *PSSR' ' ' reply;
|
||||
dump(a);
|
||||
ENDSR '*CANCL';
|
||||
@@ -0,0 +1,93 @@
|
||||
*==============================================================
|
||||
* Program that locks a record and then waits for input from
|
||||
* the operator.
|
||||
*
|
||||
* Call this program in two different sessions to see the effect.
|
||||
*==============================================================
|
||||
* - Locking the record first is a poor technique because
|
||||
* the record remains locked to all other users until the
|
||||
* transaction is completed, which may be in a few seconds or
|
||||
* after lunch.
|
||||
* It is used here to demonstate the RCDLCKDSP processing.
|
||||
*==============================================================
|
||||
* - Pgm reads by RRN for convenience. This is generally not a
|
||||
* good idea is a production program.
|
||||
*
|
||||
*- DSPLY is use to simulate a display file interaction with
|
||||
* the user. Not normally done in production.
|
||||
*
|
||||
* - QIWS/QCUSTCDT: believed to be on virtually all systems.
|
||||
*==============================================================
|
||||
|
||||
H DEBUG(*YES) OPTION(*NODEBUGIO:*SRCSTMT:*NOUNREF)
|
||||
H DFTACTGRP(*NO) ACTGRP(*NEW)
|
||||
|
||||
FQCUSTCDT UF E DISK USROPN EXTDESC('QIWS/QCUSTCDT')
|
||||
F RECNO(RRN)
|
||||
F* INFSR(*PSSR)
|
||||
|
||||
D RCDLCKDSP PR EXTPGM('RCDLCKDSP')
|
||||
D poReply 1A
|
||||
D piPSDS *
|
||||
|
||||
D QCmdexc PR EXTPGM('QCMDEXC')
|
||||
D CMD 512A
|
||||
D lgth 15P 5 const
|
||||
|
||||
D RRN s 10p 0 inz(10)
|
||||
D reply S 1A inz('*')
|
||||
D Cmd S 512A
|
||||
|
||||
D myPSDS SDS
|
||||
D myPSDS_ptr S * inz(%addr(myPSDS))
|
||||
|
||||
/free
|
||||
*inlr = *on;
|
||||
// Set update file to a short wait time. Otherwise the file or
|
||||
// system default wait time applies.
|
||||
cmd = ' OVRDBF FILE(QCUSTCDT) TOFILE(QIWS/QCUSTCDT) WAITRCD(1)';
|
||||
QCMDEXC(cmd:512);
|
||||
open QCUSTCDT;
|
||||
|
||||
dou not %error;
|
||||
chain(e) RRN QCUSTCDT;
|
||||
if %error;
|
||||
RCDLCKDSP(reply: myPSDS_ptr);
|
||||
if reply = 'R';
|
||||
iter;
|
||||
endif;
|
||||
if reply = 'C';
|
||||
exsr Prog_Cancelled;
|
||||
endif;
|
||||
if reply = 'D';
|
||||
dump(a);
|
||||
exsr Prog_Cancelled;
|
||||
endif;
|
||||
endif;
|
||||
enddo;
|
||||
|
||||
if %found(QCUSTCDT);
|
||||
// Logic to update the record would be here.
|
||||
dsply 'Read for update' ' ' reply;
|
||||
else;
|
||||
// Logic for record not found would be here
|
||||
dsply 'Record not found' ' ' reply;
|
||||
endif;
|
||||
|
||||
// === End of Program =========================================
|
||||
// Close file before returning
|
||||
close QCUSTCDT;
|
||||
return;
|
||||
|
||||
begsr Prog_Cancelled;
|
||||
close QCUSTCDT;
|
||||
// Put graceful ending logic & notification to user here
|
||||
return;
|
||||
endsr;
|
||||
|
||||
// Often found in old programs. Uncomment INFSR(*PSSR) in the
|
||||
// F-SPEC to make this active.
|
||||
BEGSR *PSSR;
|
||||
dsply 'In the *PSSR' ' ' reply;
|
||||
dump(a);
|
||||
ENDSR '*CANCL';
|
||||
@@ -0,0 +1,202 @@
|
||||
*==============================================================
|
||||
* When an interactive program tries to update a record that is
|
||||
* locked by another user, often the program doesn't handle it.
|
||||
* The RPG error routines kick in and give the user a confusing
|
||||
* error message.
|
||||
*
|
||||
* Instead, trap the error and handle it by calling this program.
|
||||
*
|
||||
* This program communicates info about a locked record to an
|
||||
* interactive user telling who has the lock.
|
||||
|
||||
* See program RCDLCKDEMO for a usage example.
|
||||
*
|
||||
* RCDLCKDSP accepts a continuation reply from the user and
|
||||
* passes it back to the caller.
|
||||
*
|
||||
* If the status is not 1218, then it is considered an
|
||||
* unexpected error and a slightly different dialog is
|
||||
* presented, asking the user to contact IT. You can
|
||||
* customize this as you see fit. Or add other statuses.
|
||||
*
|
||||
* Information is retrieved from the *PSDS passed from the caller.
|
||||
*
|
||||
*==============================================================
|
||||
* Parameters
|
||||
* ==========
|
||||
* 1 Output CL1 User's reply about what to do:
|
||||
* R - Retry the IO operation that failed
|
||||
* C - Cancel the program
|
||||
* D - DUmp the program and cancel
|
||||
* 2 Input * Pointer to the *PSDS in the calling program.
|
||||
* (A pointer is used because the *PDSD is not
|
||||
* always the same length in a program.)
|
||||
*==============================================================
|
||||
* Create with CRTBNDRPG
|
||||
* New activation group so we destroy nothing in the caller.
|
||||
* No worries about overhead since rarely called.
|
||||
h OPTION(*NODEBUGIO: *SRCSTMT)
|
||||
H DFTACTGRP(*NO) ACTGRP(*NEW)
|
||||
*==============================================================
|
||||
|
||||
FrcdlckdspdCF E WORKSTN
|
||||
|
||||
d RCDLCKDSP pr
|
||||
D poReply 1A
|
||||
D piPSDS *
|
||||
|
||||
d RCDLCKDSP pi
|
||||
D poReply 1A
|
||||
D piPSDS *
|
||||
|
||||
* === The caller's Program Status Data Structure ===============
|
||||
* Many fields not currently used.
|
||||
D PSDS DS qualified based(piPSDS)
|
||||
D PROC_NAME 1 10 * Procedure name
|
||||
D PGM_STATUS 11 15s 0 * Status code
|
||||
D PRV_STATUS 16 20S 0 * Previous status
|
||||
D LINE_NUM 21 28 * Src list line num
|
||||
D ROUTINE 29 36 * Routine name
|
||||
D PARMS 37 39 * Num passed parms
|
||||
D EXCP_TYPE 40 42 * Exception type
|
||||
D EXCP_NUM 43 46 * Exception number
|
||||
D PGM_LIB 81 90 * Program library
|
||||
D EXCP_DATA 91 170 * Exception data
|
||||
D EXCP_ID 171 174 * Exception Id
|
||||
D LAST_FILE_IO 175 184 * Last file used
|
||||
D DATE 191 198 * Date (*DATE fmt)
|
||||
D YEAR 199 200S 0 * Year (*YEAR fmt)
|
||||
D LAST_FILE 201 208 * Last file used
|
||||
D FILE_INFO_STATUS...
|
||||
D 209 213S 0 * Last file status
|
||||
D * Code
|
||||
D FILE_INFO_OPCODE...
|
||||
D 214 219 * Last file opcode
|
||||
D FILE_INFO_ROUTINE...
|
||||
D 220 227 * Last file RPG
|
||||
D * routine
|
||||
D FILE_INFO_LIST_NUM...
|
||||
D 228 235 * Last file listing
|
||||
D * line
|
||||
D FILE_INFO_RECORD...
|
||||
D 236 243I 0 * Last file record
|
||||
D * name
|
||||
D JOB_NAME 244 253 * Job name
|
||||
D USER 254 263 * User name
|
||||
D JOB_NUM 264 269S 0 * Job number
|
||||
D JOB_DATE 270 275S 0 * Date (UDATE fmt)
|
||||
D RUN_DATE 276 281S 0 * Run date (UDATE)
|
||||
D RUN_TIME 282 287S 0 * Run time (UDATE)
|
||||
D CRT_DATE 288 293 * Create date
|
||||
D CRT_TIME 294 299 * Create time
|
||||
D CPL_LEVEL 300 303 * Compiler level
|
||||
D SRC_FILE 304 313 * Source file
|
||||
D SRC_LIB 314 323 * Source file lib
|
||||
D SRC_MBR 324 333 * Source file mbr
|
||||
D PROC_PGM 334 343 * Pgm Proc is in
|
||||
D PROC_MOD 344 353 * Mod Proc is in
|
||||
D LINE_NUM_SRCID...
|
||||
D 354 355I 0 * Src list source ID
|
||||
D FILE_INFO_LIST_NUM_SRCID...
|
||||
D 356 357I 0 * Last file listing
|
||||
D * source ID
|
||||
D CURR_USER 358 367 * Current user
|
||||
D * profile
|
||||
D EXTERNAL_RC 368 371I 0 * External return
|
||||
D * code
|
||||
D NUM_XML_ELEMS 372 379I 0 * Number of XML
|
||||
d * elements
|
||||
*=== My Variables ==============================================
|
||||
D MyPSDS sDS
|
||||
D MyName 1 10 * This program
|
||||
|
||||
D User c 'User: '
|
||||
D UserPrf S 10A inz(' ')
|
||||
D UserName S 40A inz(' ')
|
||||
|
||||
D wkI s 10I 0
|
||||
D wkJ s 10I 0
|
||||
|
||||
d myStatus s 4S 0
|
||||
D*AAA DS likeds(PSDS)
|
||||
/FREE
|
||||
// AAA = PSDS; // Eases Debugging...
|
||||
|
||||
SH_PGM = MyName;
|
||||
|
||||
// Sometimes the Status is not numeric
|
||||
monitor;
|
||||
myStatus = psds.FILE_INFO_STATUS;
|
||||
on-error;
|
||||
myStatus = -0;
|
||||
ENDMON;
|
||||
|
||||
// Display fields are prefixed with SC_.
|
||||
select;
|
||||
when myStatus = 1218; //Record locked
|
||||
SC_USER1 = 'Cannot continue until the user below completes';
|
||||
SC_USER2 = 'their transaction or exits their application.';
|
||||
exsr GetUserPrf;
|
||||
//exsr GetUserName;
|
||||
|
||||
// Fill in user profile and user name
|
||||
select;
|
||||
when UserPrf = ' ' and UserName = ' ';
|
||||
SC_USER3 = User + '*Unknown* -- Call IT Now.';
|
||||
when UserName = ' ';
|
||||
SC_USER3 = User + UserPrf;
|
||||
other;
|
||||
SC_USER3 = User + UserName;
|
||||
endsl;
|
||||
|
||||
SC_INSTR = 'Enter R to Retry, C to Cancel';
|
||||
|
||||
other; //Unknown error
|
||||
SC_USER1 = 'An unexpected error has occurred.';
|
||||
SC_USER2 = 'Please contact IT now.';
|
||||
SC_INSTR = 'IT: D=Dump, C=Cancel; R=Retry';
|
||||
endsl;
|
||||
|
||||
// We try to fill in this info for all conditions
|
||||
SC_IT_PGM = PSDS.PROC_NAME;
|
||||
SC_IT_STS = myStatus;
|
||||
SC_IT_FILE = PSDS.LAST_FILE;
|
||||
SC_IT_OPCD = PSDS.FILE_INFO_OPCODE;
|
||||
|
||||
SC_IT_EM1 = %subst(PSDS.EXCP_DATA: 1: %len(SC_IT_EM1));
|
||||
SC_IT_EM2 = %subst(PSDS.EXCP_DATA: %len(SC_IT_EM1)+1);
|
||||
|
||||
exfmt dspwin;
|
||||
|
||||
poReply = 'R'; //Default to R
|
||||
if SC_RESP = 'C' or SC_RESP = 'R' or SC_RESP = 'D';
|
||||
poReply = SC_RESP;
|
||||
endif;
|
||||
|
||||
*inlr = *on;
|
||||
return;
|
||||
|
||||
begsr GetUserPrf;
|
||||
// Dig the user profile out of the error message (EXCP_DATA)
|
||||
// which looks like this:
|
||||
// Record 3317 in use by job 018249/SLENNON/MISREMSAM
|
||||
UserPrf = ' ';
|
||||
wkI = %scan('/':PSDS.EXCP_DATA);
|
||||
if wkI <> 0;
|
||||
wkI = wkI +1;
|
||||
wkJ = %scan('/' :PSDS.EXCP_DATA: wkI);
|
||||
if WkJ <> 0;
|
||||
wkJ = WkJ - wkI;
|
||||
if wkI > 0;
|
||||
UserPrf = %subst(PSDS.EXCP_DATA: wkI: wkJ);
|
||||
endif;
|
||||
endif;
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
begsr GetUserName;
|
||||
// If you have a way to connect a user name to a user
|
||||
// then set UserName here.
|
||||
UserName = ' ';
|
||||
endsr;
|
||||
/END-FREE
|
||||
@@ -0,0 +1,41 @@
|
||||
A DSPSIZ(24 80 *DS3)
|
||||
A R DSPWIN
|
||||
A WINDOW(7 15 11 50)
|
||||
A OVERLAY
|
||||
A KEEP
|
||||
A SH_PGM 10A O 1 1
|
||||
A 1 33DATE
|
||||
A EDTWRD(' / / ')
|
||||
A 1 42TIME
|
||||
A SC_USER1 49A O 2 1DSPATR(HI)
|
||||
A COLOR(WHT)
|
||||
A SC_USER2 49A O 3 1DSPATR(HI)
|
||||
A COLOR(WHT)
|
||||
A SC_USER3 49A O 4 1DSPATR(HI)
|
||||
A COLOR(WHT)
|
||||
A SC_RESP 1A I 5 1DSPATR(HI)
|
||||
A SC_INSTR 47A O 5 3DSPATR(HI)
|
||||
A COLOR(WHT)
|
||||
A 6 1'__________________________________-
|
||||
A _______________'
|
||||
A 7 1'IT Information'
|
||||
A 7 18'Pgm:'
|
||||
A SC_IT_PGM 10A O 7 23
|
||||
A 7 35'Status:'
|
||||
A SC_IT_STS 5D 0O 7 43
|
||||
A 8 1'Opcode:'
|
||||
A SC_IT_OPCD 6A O 8 9
|
||||
A 8 28'Last File:'
|
||||
A SC_IT_FILE 10A O 8 39
|
||||
A SC_IT_EM1 48A O 9 1
|
||||
A SC_IT_EM2 48A O 10 1
|
||||
A*===============================================================
|
||||
A* If ASSUME is specified for any record format within a
|
||||
A* display file, OS/400 does not erase the display when the
|
||||
A* file is opened. Even though DUMMY is never used in a
|
||||
A* WRITE or EXFMT, it keeps the calling program's screen
|
||||
A* from being blanked out when this program is called.
|
||||
A R DUMMY TEXT('Never used. For ASSU
|
||||
A ')
|
||||
A ASSUME
|
||||
A 1 3' '
|
||||
@@ -0,0 +1,52 @@
|
||||
# RCDLCKDSP - Displaying Locked Record Info in Interactive Programs
|
||||
|
||||
Older interactive programs often read a record for update, then displayed it on the screen and wait for the user to make changes. The record might remain locked for a short time while date was keyed or it might wait until after a rest break or a phone call or some other interruption.
|
||||
|
||||
This requires less code, but is a poor technique that can increase Support/Help Desk call. It still exists in many older programs and some packaged software.
|
||||
|
||||
When an interactive program tries to update a record that is locked by another user and the program doesn't handle it the RPG error routines kick in and give the user a confusing, and potentially dangerous, error message.
|
||||
|
||||
In new programs, it is much better to trap the locked record condition and handle it by calling RCDLCKDSP. It shows who has the record locked so you can ask them to finsh up what they were doing and free up the record. It allows you to retry your update or allows you to cancel what you are doing.
|
||||
|
||||
Locking information is provided in a window, like this:
|
||||
|
||||
|
||||
|
||||
The top half of the window is information for the current user of the interactive program.
|
||||
|
||||
The bottom half provides information for the IT Department should the need arise.
|
||||
|
||||
## RCDLCKDSP
|
||||
|
||||
This is the standalone RPG program that handles the window display. It is passed two parameters:
|
||||
|
||||
| | | | |
|
||||
|---|---|------------|---|
|
||||
|1. |Output |CL1|
|
||||
||| User's reply about what to do:
|
||||
|||R - Retry the IO operation that failed
|
||||
|||C - Cancel the program
|
||||
|||D - DUmp the program and cancel
|
||||
|2. |Input|\*
|
||||
|||Pointer to the *PSDS in the calling program.
|
||||
|||(A pointer is used because the *PDSD is not always the same length in the calling program.)
|
||||
|
||||
See RCDLCKDEMO for a sample call.
|
||||
|
||||
## RCDLCKDSPD
|
||||
|
||||
This is the display file for the window.
|
||||
|
||||
## RCDLCKDEMO
|
||||
|
||||
This program demonstrates the consistent way to handle the situation in an interactive program where the record you are reading for update may be locked by another program.
|
||||
|
||||
Call it in two separate sessions to see a RCDLCKDSP pop up a window.
|
||||
|
||||
## RCDLCKBAD
|
||||
|
||||
This program demonstates what happens if you fail to account for the record you want to update is locked by someone else. Typically the user get a message like this:
|
||||
|
||||
```Unable to allocate a record in file QCUSTCDT (R C G D F).```
|
||||
|
||||
None of the possible responses is particularly useful.
|
||||
Reference in New Issue
Block a user