390 lines
17 KiB
Rexx
390 lines
17 KiB
Rexx
|
/* REXX ALIST Display the user's current allocations
|
|||
|
|
|
|||
|
|
Written by Frank Clarke, Oldsmar, FL
|
|||
|
|
|**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**|
|
|||
|
|
| |
|
|||
|
|
| WARNING: EMBEDDED COMPONENTS. |
|
|||
|
|
| |
|
|||
|
|
|**-***-***-***-***-***-***-***-***-***-***-***-***-***-***-***-**|
|
|||
|
|
*/
|
|||
|
|
address TSO /* default address */
|
|||
|
|
tv = ""
|
|||
|
|
signal on syntax
|
|||
|
|
parse source sys_id how_invokt exec_name DD_nm DS_nm as_invokt cmd_env,
|
|||
|
|
addr_spc usr_tokn
|
|||
|
|
if ds_nm <> "?" then do /* explicit invocation */
|
|||
|
|
say exec_name "cannot be invoked explicitly."
|
|||
|
|
say " "
|
|||
|
|
say " It must be part of your SYSPROC or SYSEXEC allocation,"
|
|||
|
|
say " and invoked implicitly because it requires ISPF facilities"
|
|||
|
|
say " and these are incompatible with a command library which is"
|
|||
|
|
say " not part of your defined environment."
|
|||
|
|
say " "
|
|||
|
|
exit
|
|||
|
|
end
|
|||
|
|
if Sysvar("sysispf") = "NOT ACTIVE" then do
|
|||
|
|
arg line
|
|||
|
|
line = line "(( RESTARTED" /* tell the next invocation */
|
|||
|
|
"ISPSTART CMD("exec_name line")" /* Invoke ISPF if nec. */
|
|||
|
|
exit /* ...and restart it */
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
arg target "((" opts
|
|||
|
|
opts = Strip( opts , "T" , ")" ) /* clip trailing paren */
|
|||
|
|
if Word(target,1) = "?" then call HELP /* ...and don't come back */
|
|||
|
|
|
|||
|
|
parse var opts "TRACE" tv .
|
|||
|
|
parse value tv "O" with tv .
|
|||
|
|
rc = Trace(tv)
|
|||
|
|
address ISPEXEC /* default address for ISPF */
|
|||
|
|
"CONTROL ERRORS RETURN"
|
|||
|
|
|
|||
|
|
call A_INIT /* -*/
|
|||
|
|
call B_GET_ALLOCATIONS /* -*/
|
|||
|
|
call C_LOAD_TABLE /* -*/
|
|||
|
|
call D_TABLE_OPS /* -*/
|
|||
|
|
call E_REDO_ALLOC /* -*/
|
|||
|
|
|
|||
|
|
exit /*@ ALIST */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
A_INIT: /*@ */
|
|||
|
|
address TSO
|
|||
|
|
|
|||
|
|
restarted = WordPos("RESTARTED",opts)>0/* called from READY-mode ? */
|
|||
|
|
parse value "0 ISR00000 YES" with,
|
|||
|
|
got_one zerrhm zerralrm zerrsm zerrlm
|
|||
|
|
t_nam = "T"Right(Time(s),5,0) /* T32855 maybe #*/
|
|||
|
|
|
|||
|
|
parse value "?" with,
|
|||
|
|
ddname dsnames. disp. tk_globalvars ,
|
|||
|
|
ddlist ,
|
|||
|
|
.
|
|||
|
|
|
|||
|
|
return /*@ A_INIT */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
B_GET_ALLOCATIONS: /*@ */
|
|||
|
|
address TSO
|
|||
|
|
|
|||
|
|
tgt_list = ""
|
|||
|
|
|
|||
|
|
do ii = 1 to Words(target) /* for every target spec */
|
|||
|
|
this_tgt = Word(target,ii)
|
|||
|
|
if this_tgt = "ISPF" then, /* expand ISPF */
|
|||
|
|
tgt_list = tgt_list "ISPPLIB ISPMLIB ISPSLIB ISPTLIB",
|
|||
|
|
"ISPTABL ISPLLIB ISPPROF"
|
|||
|
|
else,
|
|||
|
|
if this_tgt = "CMDS" |, /* expand CMDS */
|
|||
|
|
this_tgt = "COMMANDS" then,
|
|||
|
|
call BA_Q_ALTLIB /* -*/
|
|||
|
|
/* tgt_list = tgt_list "SYSPROC SYSEXEC" */
|
|||
|
|
else, /* just add to the list */
|
|||
|
|
tgt_list = tgt_list this_tgt
|
|||
|
|
end /* ii */
|
|||
|
|
|
|||
|
|
ln. = "" /* setup array */
|
|||
|
|
rc = Outtrap("ln.") /* open trap */
|
|||
|
|
"LISTA ST"
|
|||
|
|
rc = Outtrap("off") /* close trap */
|
|||
|
|
call BB_GET_STACKS /* -*/
|
|||
|
|
|
|||
|
|
dds_to_realloc = ""
|
|||
|
|
ds_stack. = ""
|
|||
|
|
redo_alloc = "0"
|
|||
|
|
|
|||
|
|
return /*@ B_GET_ALLOCATIONS */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
BA_Q_ALTLIB: /*@ */
|
|||
|
|
address TSO
|
|||
|
|
|
|||
|
|
$x = Outtrap("alt.") /* set up outtrap */
|
|||
|
|
"ALTLIB DISPLAY" /* get ddname-list */
|
|||
|
|
$x = Outtrap("OFF") /* release trap */
|
|||
|
|
|
|||
|
|
do bax = 1 to alt.0
|
|||
|
|
parse var alt.bax "DDNAME=" baxddn .
|
|||
|
|
tgt_list = tgt_list baxddn
|
|||
|
|
end /* bax */
|
|||
|
|
|
|||
|
|
return /*@ BA_Q_ALTLIB */
|
|||
|
|
/*
|
|||
|
|
Build lists of DSNames by DDName and store in a stem array indexed
|
|||
|
|
by DDName.
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
BB_GET_STACKS: /*@ */
|
|||
|
|
address TSO
|
|||
|
|
/* Build DDName stack */
|
|||
|
|
do bbx = 1 to ln.0, /* for each trapped line */
|
|||
|
|
until Substr(ln.bbx,1,1) <> "-" /* ...skip the header */
|
|||
|
|
end /* bbx */
|
|||
|
|
|
|||
|
|
start = bbx
|
|||
|
|
do bbx = start to ln.0 /* for each trapped line */
|
|||
|
|
if Left(ln.bbx,1) = ' ' then do /* it's a DDname */
|
|||
|
|
if Substr(ln.bbx,3,1) <> " " then do /* new DDName */
|
|||
|
|
parse var ln.bbx ddname disp .
|
|||
|
|
ddlist = ddlist ddname
|
|||
|
|
end /* DDName */
|
|||
|
|
dsnames.ddname = dsnames.ddname dsname
|
|||
|
|
disp.ddname = disp
|
|||
|
|
end /* DDname */
|
|||
|
|
else dsname = Word(ln.bbx,1) /* it's a DSName */
|
|||
|
|
end /* bbx */
|
|||
|
|
|
|||
|
|
return /*@ BB_GET_STACKS */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
C_LOAD_TABLE: /*@ */
|
|||
|
|
address ISPEXEC
|
|||
|
|
|
|||
|
|
if tgt_list = "" then tgt_list = ddlist
|
|||
|
|
|
|||
|
|
"TBCREATE " t_nam " NAMES(DDNAME DSNAME DISP) NOWRITE"
|
|||
|
|
disp = "?"
|
|||
|
|
|
|||
|
|
do Words(tgt_list) /* every DDName */
|
|||
|
|
parse var tgt_list ddname tgt_list
|
|||
|
|
ds_stack.ddname = dsnames.ddname
|
|||
|
|
disp = disp.ddname
|
|||
|
|
do Words(dsnames.ddname)
|
|||
|
|
parse var dsnames.ddname dsname dsnames.ddname
|
|||
|
|
"TBADD" t_nam /* add to table #*/
|
|||
|
|
got_one = "1"
|
|||
|
|
end /* dsnames */
|
|||
|
|
end /* Words(tgt_list) */
|
|||
|
|
|
|||
|
|
return /*@ C_LOAD_TABLE */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
D_TABLE_OPS: /*@ */
|
|||
|
|
address ISPEXEC
|
|||
|
|
|
|||
|
|
if got_one then do
|
|||
|
|
call DEIMBED /* expose the panel -*/
|
|||
|
|
$ddn = $ddn.PLIB
|
|||
|
|
"LIBDEF ISPPLIB LIBRARY ID("$ddn") STACK"
|
|||
|
|
|
|||
|
|
"TBTOP" t_nam /* */
|
|||
|
|
"CONTROL DISPLAY SAVE" /* In case of re-invocation */
|
|||
|
|
do forever
|
|||
|
|
"TBDISPL" t_nam "PANEL(FCALLOC) CURSOR(ACTION) AUTOSEL(NO)"
|
|||
|
|
if rc > 4 then leave
|
|||
|
|
do ztdsels
|
|||
|
|
curact = Translate(action)
|
|||
|
|
"CONTROL DISPLAY SAVE"
|
|||
|
|
select
|
|||
|
|
when curact = "E" then do /* Edit */
|
|||
|
|
"EDIT DATASET('"dsname"')"
|
|||
|
|
save_rc = rc
|
|||
|
|
end /* Edit */
|
|||
|
|
when curact = "V" then do /* View */
|
|||
|
|
"VIEW DATASET('"dsname"') CONFIRM(NO)"
|
|||
|
|
save_rc = rc
|
|||
|
|
end /* View */
|
|||
|
|
when curact = "B" then do /* Browse */
|
|||
|
|
"BROWSE DATASET('"dsname"')"
|
|||
|
|
save_rc = rc
|
|||
|
|
end /* Browse */
|
|||
|
|
when curact = "D" then do /* DUP */
|
|||
|
|
address TSO "DUP '"dsname"' ID"
|
|||
|
|
save_rc = rc
|
|||
|
|
if rc <> 0 then do
|
|||
|
|
ZERRSM = "RC ="rc
|
|||
|
|
ZERRLM = "DUP ended abnormally"
|
|||
|
|
end
|
|||
|
|
end /* CLONE */
|
|||
|
|
when curact = "F" then do /* Free */
|
|||
|
|
redo_alloc = "1"
|
|||
|
|
if WordPos(ddname,dds_to_realloc) = 0 then,/* new DDName */
|
|||
|
|
dds_to_realloc = dds_to_realloc ddname
|
|||
|
|
dsid = WordPos(dsname,ds_stack.ddname) /* in the list ? */
|
|||
|
|
if dsid > 0 then,
|
|||
|
|
ds_stack.ddname = DelWord(ds_stack.ddname,dsid,1)
|
|||
|
|
end /* Free */
|
|||
|
|
when curact = "X" then do /* UnDisplay */
|
|||
|
|
"TBDELETE" t_nam /* drop this row */
|
|||
|
|
end /* UnDisplay */
|
|||
|
|
otherwise nop
|
|||
|
|
end /* Select */
|
|||
|
|
"CONTROL DISPLAY RESTORE"
|
|||
|
|
if save_rc <> 0 then,
|
|||
|
|
"SETMSG MSG(ISRZ002)"
|
|||
|
|
save_rc = 0
|
|||
|
|
if ztdsels = 1 then, /* never do the last one */
|
|||
|
|
ztdsels = 0
|
|||
|
|
else "TBDISPL" t_nam /* next row #*/
|
|||
|
|
end /* ztdsels */
|
|||
|
|
action = "" /* clear for re-display */
|
|||
|
|
end /* forever */
|
|||
|
|
"CONTROL DISPLAY RESTORE" /* In case of re-invocation */
|
|||
|
|
|
|||
|
|
"LIBDEF ISPPLIB"
|
|||
|
|
"TBCLOSE" t_nam
|
|||
|
|
address TSO "FREE FI("$ddn")"
|
|||
|
|
end /* got_one */
|
|||
|
|
else do
|
|||
|
|
"TBEND" t_nam /* #*/
|
|||
|
|
ZERRSM = "No datasets" /* short message */
|
|||
|
|
ZERRLM = "No datasets were allocated as specified/implied."
|
|||
|
|
"SETMSG MSG(ISRZ002)"
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
return /*@ D_TABLE_OPS */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
E_REDO_ALLOC: /*@ */
|
|||
|
|
address TSO /* ready for some TSO work */
|
|||
|
|
|
|||
|
|
if redo_alloc then do
|
|||
|
|
do fidx = 1 to Words(dds_to_realloc)/* for each DDName */
|
|||
|
|
ddname = Word(dds_to_realloc,fidx) /* grab it */
|
|||
|
|
alloc_list = "" /* initialize */
|
|||
|
|
|
|||
|
|
if Words(ds_stack.ddname) > 0 then,
|
|||
|
|
do didx = 1 to Words(ds_stack.ddname) /* for each DSName */
|
|||
|
|
alloc_list = alloc_list "'"Word(ds_stack.ddname,didx)"'"
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
if alloc_list <> "" then, /* re-ALLOC */
|
|||
|
|
"ALLOC FI("ddname") DA("alloc_list") SHR REU"
|
|||
|
|
else "FREE FI("ddname")"
|
|||
|
|
end /* fidx */
|
|||
|
|
end /* redo_alloc */
|
|||
|
|
|
|||
|
|
return /*@ E_REDO_ALLOC */
|
|||
|
|
/*
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
HELP: /*@ */
|
|||
|
|
address TSO "CLEAR"
|
|||
|
|
say " "
|
|||
|
|
say " ALIST displays a scrollable list of allocated datasets."
|
|||
|
|
say " The list may be limited to specific DDNames or "
|
|||
|
|
say " specific sets of DDNames. "
|
|||
|
|
say " "
|
|||
|
|
say " Syntax: ALIST [ddname-list] [CMDS] [ISPF] "
|
|||
|
|
say " [ ? ] "
|
|||
|
|
say " "
|
|||
|
|
say " [ddname-list] is a blank-delimited list of filenames "
|
|||
|
|
say " to be displayed. "
|
|||
|
|
say " [CMDS] is equivalent to 'SYSPROC SYSEXEC' "
|
|||
|
|
say " [ISPF] is equivalent to 'ISPPLIB ISPMLIB ISPSLIB "
|
|||
|
|
say " ISPTLIB ISPLLIB ISPPROF ISPTABL' "
|
|||
|
|
say " "
|
|||
|
|
say " ALIST may be invoked from READY-mode. "
|
|||
|
|
say " "
|
|||
|
|
exit /*@ HELP */
|
|||
|
|
|
|||
|
|
/* ----------------------------------------------------------------- */
|
|||
|
|
SYNTAX: /*@ */
|
|||
|
|
errormsg = "REXX error" rc "in line" sigl":" errortext(rc)
|
|||
|
|
say errormsg
|
|||
|
|
say sourceline(sigl)
|
|||
|
|
trace "?r"
|
|||
|
|
nop
|
|||
|
|
exit /*@ SYNTAX */
|
|||
|
|
/*
|
|||
|
|
Parse out the embedded components at the back of the source code.
|
|||
|
|
. ----------------------------------------------------------------- */
|
|||
|
|
DEIMBED: Procedure expose, /*@ */
|
|||
|
|
(tk_globalvars) ddnlist $ddn. daid.
|
|||
|
|
|
|||
|
|
address TSO
|
|||
|
|
|
|||
|
|
fb80po.0 = "NEW UNIT(VIO) SPACE(5 5) TRACKS DIR(40)",
|
|||
|
|
"RECFM(F B) LRECL(80) BLKSIZE(0)"
|
|||
|
|
parse value "" with ddnlist $ddn. daid.
|
|||
|
|
|
|||
|
|
lastln = sourceline()
|
|||
|
|
currln = lastln /* */
|
|||
|
|
if Left(sourceline(currln),2) <> "*/" then return
|
|||
|
|
|
|||
|
|
currln = currln - 1 /* previous line */
|
|||
|
|
"NEWSTACK"
|
|||
|
|
do while sourceline(currln) <> "/*"
|
|||
|
|
text = sourceline(currln) /* save with a short name ! */
|
|||
|
|
if Left(text,3) = ")))" then do /* package the queue */
|
|||
|
|
parse var text ")))" ddn mbr . /* PLIB PANL001 maybe */
|
|||
|
|
if Pos(ddn,ddnlist) = 0 then do /* doesn't exist */
|
|||
|
|
ddnlist = ddnlist ddn /* keep track */
|
|||
|
|
$ddn = ddn || Random(999)
|
|||
|
|
$ddn.ddn = $ddn
|
|||
|
|
"ALLOC FI("$ddn")" fb80po.0
|
|||
|
|
address ISPEXEC "LMINIT DATAID(DAID) DDNAME("$ddn")"
|
|||
|
|
daid.ddn = daid
|
|||
|
|
end
|
|||
|
|
daid = daid.ddn
|
|||
|
|
address ISPEXEC "LMOPEN DATAID("daid") OPTION(OUTPUT)"
|
|||
|
|
do queued()
|
|||
|
|
parse pull line
|
|||
|
|
address ISPEXEC "LMPUT DATAID("daid") MODE(INVAR)",
|
|||
|
|
"DATALOC(LINE) DATALEN(80)"
|
|||
|
|
end
|
|||
|
|
address ISPEXEC "LMMADD DATAID("daid") MEMBER("mbr")"
|
|||
|
|
address ISPEXEC "LMCLOSE DATAID("daid")"
|
|||
|
|
end /* package the queue */
|
|||
|
|
else push text /* onto the top of the stack */
|
|||
|
|
currln = currln - 1 /* previous line */
|
|||
|
|
end /* while */
|
|||
|
|
"DELSTACK"
|
|||
|
|
|
|||
|
|
return /*@ DEIMBED */
|
|||
|
|
/*
|
|||
|
|
)))PLIB FCALLOC
|
|||
|
|
)ATTR
|
|||
|
|
% TYPE(TEXT) INTENS(HIGH) SKIP(ON)
|
|||
|
|
+ TYPE(TEXT) INTENS(LOW) SKIP(ON)
|
|||
|
|
_ TYPE(INPUT) INTENS(HIGH)
|
|||
|
|
! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON)
|
|||
|
|
)BODY EXPAND(||)
|
|||
|
|
%|-| Current Allocations |-|
|
|||
|
|
%COMMAND ===>_ZCMD
|
|||
|
|
%SCROLL ===>_AMT +
|
|||
|
|
+
|
|||
|
|
+ DDName DSName Disp
|
|||
|
|
)MODEL
|
|||
|
|
_Z+ !DDNAME + !DSNAME + !DISP +
|
|||
|
|
)INIT
|
|||
|
|
.ZVARS = '(ACTION)'
|
|||
|
|
.HELP = FCALLOCH
|
|||
|
|
)REINIT
|
|||
|
|
IF (&MSG = ' ')
|
|||
|
|
&ACTION = ' '
|
|||
|
|
REFRESH (&ACTION)
|
|||
|
|
)END
|
|||
|
|
)))PLIB FCALLOCH
|
|||
|
|
)ATTR
|
|||
|
|
% TYPE(TEXT) INTENS(HIGH) SKIP(ON)
|
|||
|
|
+ TYPE(TEXT) INTENS(LOW) SKIP(ON)
|
|||
|
|
_ TYPE(INPUT) INTENS(HIGH)
|
|||
|
|
! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON)
|
|||
|
|
@ TYPE(OUTPUT) INTENS(LOW) SKIP(ON)
|
|||
|
|
)BODY EXPAND(<EFBFBD><EFBFBD>)
|
|||
|
|
%TUTORIAL <EFBFBD>-<EFBFBD> Current Allocations <EFBFBD>-<EFBFBD> TUTORIAL
|
|||
|
|
%Next Selection ===>_ZCMD
|
|||
|
|
|
|||
|
|
+
|
|||
|
|
Panel FCALLOC shows the current allocations for the DDNames you specified
|
|||
|
|
(or ALL DDNames).
|
|||
|
|
|
|||
|
|
For each shown dataset you may select among several actions:
|
|||
|
|
|
|||
|
|
%B+-%BROWSE +Browse the selected dataset.
|
|||
|
|
|
|||
|
|
%E+-%EDIT +Edit the selected dataset.
|
|||
|
|
|
|||
|
|
%V+-%VIEW +View the selected dataset.
|
|||
|
|
|
|||
|
|
%D+-%DUP +You may make a copy (either filled or empty) of the
|
|||
|
|
selected dataset. Subroutine DUP will be called to
|
|||
|
|
perform this function.
|
|||
|
|
|
|||
|
|
%F+-%FREE +This is effective only for DDNames which are not under
|
|||
|
|
the control of ISPF since those files are necessarily
|
|||
|
|
OPEN while ISPF is active.
|
|||
|
|
|
|||
|
|
)PROC
|
|||
|
|
)END
|
|||
|
|
*/
|