|
midrange.com
Some-one else may find this useful.
Command exccmdlst -- execute a sequence of commands, delimited by ;
(semicolon).
Intended to reduce the number of times one must write and compile a trivial
CL program, or write a REXX procedure. The VM/CMS monitor had this
capability in 1983. (We won't mention what's possible with UNIX...)
I use it for: PDM options, e.g. to send an object from one AS/400 to
another, create a PDM option SO:
exccmdlst 'crtsavf qtemp/&n; savobj &n &l *SAVF &t savf(qtemp/&n)
updhst(*no) dtacpr(*YES); sndnetf qtemp/&n tousrid(( Myself OtherSystem
)); dltf qtemp/&n'
You could set up another PDM option to submit a network job to restore the
object from the save file on the other AS/400.
Also useful for one-off batch jobs: SBMJOB CMD( exccmdlst 'ovrdbf
custmast tofile(testcust) ovrscope(*JOB); call testpgm1; call testpgm2' )
Limitations: Command string limited to 500 characters (easily changed).
Execution stops if one command fails. Uses command CPYBAKMSGS to return
error messages. No command prompting, but since most programmers use PCs,
"cut and paste" ameliorates this.
source code: command source EXCCMDLST
/*$ DLTOBJ NAME(*CURLIB/EXCCMDLST ) OBJTYP(*CMD) */
/*$ CRTCMD CMD(EXCCMDLST ) + */
/*$ PGM(ZEXCCMDLST) ALLOW(*ALL) */
/*-----------------------------------------------------------------*/
/* Execute sequence of commands separated by a semicolon. */
/* Greg van Paassen, 1995 */
/*-----------------------------------------------------------------*/
CMD PROMPT('Exec list of commands')
PARM KWD(CMDS) TYPE(*CHAR) LEN(500) VARY(*YES *INT2) +
CASE(*MIXED) CHOICE('separate commands by ;') +
PROMPT('Cmd1; Cmd2 (parms); Cmd3')
Command processing CL program ZEXCCMDLST:
/*$ CRTCLPGM ZEXCCMDLST QCLSRC option(*NOXREF) */
/* Greg van Passen, 1995 */
PGM PARM(&LenCmds)
DCL &LenCmds *CHAR 502
DCL &Len *DEC ( 3 0 )
DCL &Cmds *CHAR 500
DCL &Cmd *CHAR 500 /*initial*/ value('*N')
DCL &Cmdlen *DEC ( 15 5 )
DCL &Char *CHAR 1
DCL &Separator *CHAR 1 value(';')
DCL &Apost *CHAR 1 value('''')
DCL &Apos *LGL
DCL &Quote *CHAR 1 value('"')
DCL &Quo *LGL
DCL &Start *Dec ( 3 0 )
DCL &I *Dec ( 3 0 )
DCL &MSGID *CHAR 7
DCL &MSGDTA *CHAR 100
DCL &MSGF *CHAR 10
DCL &MSGFLIB *CHAR 10
Dcl &Error *LGL
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
Chgvar &Len %Bin(&LenCmds 1 2 )
Chgvar &Cmds %sst(&LenCmds 3 500 )
If ( ( &len = 0 ) | ( &Cmds = ' ' ) ) Return
Nextcmd:
Chgvar &Start ( &I + 1 )
If ( &Start > &len ) goto end
NextChar:
Chgvar &I ( &I + 1 )
If ( &I > &len ) goto endchar
Chgvar &Char (%sst(&Cmds &I 1 ))
If ( &Char = &Apost ) ( chgvar &Apos (¬&Apos) )
If ( &Char = &Quote ) ( chgvar &Quo (¬&Quo) )
If ( &Char = &Separator ) do
/*In a string: */ If &Apos goto Nextchar
/*In a string: */ If &Quo goto Nextchar
/*not in a string: */ goto Endchar
Enddo
goto Nextchar
endchar:
If ( &I > &Start ) do
Chgvar &CmdLen ( &I - &Start )
/*NB. the above will exclude the semicolon itself. */
Chgvar &Cmd %sst( &Cmds &Start &Cmdlen )
call qcmdexc parm(&Cmd &Cmdlen)
Enddo
goto Nextcmd
End:
RETURN
ERROR:
If &Error return
Chgvar &Error '1'
RCVMSG MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB) msgtype(*EXCP)
Cpybakmsgs
IF (&MSGID *NE ' ') (DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) msgtype(*ESCAPE)
MONMSG MSGID(CPF0000)
ENDDO
ENDPGM
Command and command-processing program for CPYBAKMSGS:
/*T: Copy messages on program's message queue back to caller */
/*$: CRTCMD CPYBAKMSGS PGM(ZCPYBAKMSG) ALLOW(*BPGM *IPGM) */
/* Greg van Paassen 1993 */
Cmd Prompt('Copy pgm messages to caller')
----------
/*T: CPYBAKMSGS: copy messages on a program msgq to its caller */
/*Z: CRTCLPGM ZCPYBAKMSG LOG(*NO) */
/*H: Greg van Paassen, 1993 */
PGM PARM( /* NONE */ +
)
DCL &MSGID *CHAR ( 7 )
DCL &MSGF *CHAR ( 10 )
DCL &MSGFLIB *CHAR ( 10 )
DCL &MSGDTA *CHAR ( 256 )
DCL &MSG *CHAR ( 512 )
DCL &Rtntype *CHAR ( 2 )
DCL &Error *LGL
DCL &Sender *CHAR ( 80 )
DCL &Caller *CHAR ( 10 )
DCL &Mstype *CHAR ( 7 )
/* Message return types: +
| 01 Completion _ +
| 02 Diagnostic _ +
| 04 Information +
| 05 Inquiry ² +
| 06 Copy +
| 08 Request n +
| 10 Request with prompting n +
| 14 Notify _ +
| 15 Escape _ +
| 21 Reply, not Vchecked +
| 22 Reply, checked +
| 23 Reply, msg dft +
| 24 Reply, sys dft +
| 25 Reply, SYSRPYL used +
| Notes: _ Only appear on program message queues +
| ² Only appear on non-program message queues or *EXT +
| n Must be an impromptu message (ie no msgid) +
*/
Monmsg CPF0000
If &Error (goto End_pgm)
Chgvar &Error '1'
Getmsg:
Rcvmsg pgmq(*PRV *) +
msgid(&msgid) msgf(&msgf) msgflib(&msgflib) msgdta(&msgdta) +
msg(&msg) +
rtntype(&Rtntype ) +
sender(&Sender)
If ( ( &msg = ' ' ) & ( &msgid = ' ' ) ) return
Chgvar &Caller %SST( &Sender 56 10 ) /*Receiver of the message*/
If (&Msgid ¬= ' ') do
Chgvar &mstype '*INFO'
If ( &Rtntype = '01' ) +
(Chgvar &mstype '*COMP')
If ( &Rtntype = '02' ) +
(Chgvar &mstype '*DIAG')
If ( &Rtntype = '04' ) +
(Chgvar &mstype '*INFO')
If ( &Rtntype = '05' ) /*inquiry*/ +
(Chgvar &mstype '*INFO')
If ( &Rtntype = '06' ) /*copy */ +
(Chgvar &mstype '*INFO')
If ( &Rtntype = '08' ) +
(Chgvar &mstype '*RQS')
If ( &Rtntype = '14' ) +
(Chgvar &mstype '*NOTIFY')
If ( &Rtntype = '15' ) +
(Chgvar &mstype '*DIAG') /* escape -> diag */
sndpgmmsg Msgid(&Msgid) msgf(&msgflib/&msgf) msgdta(&msgdta) +
msgtype(&Mstype) topgmq(*PRV &Caller)
Goto Getmsg
enddo
Else do
sndpgmmsg msg(&msg) msgtype(*INFO) topgmq(*PRV &Caller)
goto Getmsg
Enddo
End_pgm: Endpgm
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This is the RPG/400 Discussion Mailing List! To submit a new *
* message, send your mail to "RPG400-L@midrange.com". To unsubscribe *
* from this list send email to MAJORDOMO@midrange.com and specify *
* 'unsubscribe RPG400-L' in the body of your message. Questions should *
* be directed to the list owner / operator: david@midrange.com *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
