|
midrange.com
Hello Joe,
You wrote:
>If I wanted to put a few CL conmmands into a source member and just run them
>(kind of like old-fashioned OCL), can I do it? The last time I did this,
>many years ago, I used STRDBRDR, but that requires submitting to batch. Can
>it be done interactively?
Yes. Just read the source file, send each line as a request message, and
then give control to QCMDEXC.
Here is my version. I wrote this years ago and tidied it up just for you.
I'm sure you can write your own replacements for the EXTQUALOBJ and STDERR
commands but if you want them too then let me know.
/* ** Start of specifications ***********************************************
*/
/*PARMS PGM(STRCLRDRC) ALLOW(*INTERACT *IPGM *IMOD *IREXX)
*/
/*
*/
/* Command name . . . . . . : STRCLRDR
*/
/*
*/
/* Descriptive name . . . . : Start CL Reader
*/
/*
*/
/* Function . . . . . . . . : To interpret a CL source member.
*/
/*
*/
/* Copyright:
*/
/* (C) Copyright S.H. Coulter 1987, 2002. All rights reserved.
*/
/* (C) Copyright FlyByNight Software. 1987, 2002. All rights reserved.
*/
/*
*/
/* External references:
*/
/* Command processor . . . : STRCLRDRC
*/
/*
*/
/* Messages . . . . . . . :
*/
/*
*/
/* Help panel group . . . :
*/
/*
*/
/* Programs . . . . . . . :
*/
/*
*/
/* Files . . . . . . . . . :
*/
/*
*/
/* Data areas . . . . . . :
*/
/*
*/
/* Notes:
*/
/* Dependencies . . . . . :
*/
/*
*/
/* Restrictions . . . . . :
*/
/*
*/
/* Support . . . . . . . . : shc@flybynight.com.au
*/
/*
*/
/* Change activity:
*/
/* Rlse &
*/
/* Flag Reason Level Date Pgmr Comments
*/
/* ---- -------- ------ ------ ---------- -----------------------------------
*/
/* $A0= D 870228 SHC: Initial coding of command.
*/
/* $A1= D 920107 SHC: Support both S/38 and AS/400 syntax
*/
/* $A2= D 020926 SHC: Remove dumb defaults and make more
*/
/* like an IBM command.
*/
/*
*/
/* ** End of specifications *************************************************
*/
STRCLRDR: CMD PROMPT('Start CL Reader')
PARM KWD(SRCFILE) TYPE(Q1) MIN(1) PROMPT('Source +
file')
PARM KWD(SRCMBR) TYPE(*NAME) LEN(10) MIN(1) +
EXPR(*YES) PROMPT('Member')
Q1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB *CURLIB)) +
EXPR(*YES) PROMPT('Library')
/* ** Start of specifications ***********************************************
*/
/*PARMS
*/
/*
*/
/* Module name . . . . . . . : STRCLRDRC
*/
/*
*/
/* Descriptive name . . . . : Start CL Reader
*/
/*
*/
/* Function . . . . . . . . : Reads a CL source member and executes
*/
/* each CL statement by sending each line
*/
/* as a *RQS message to the *EXT message
*/
/* queue of the job and then calling the
*/
/* command executor to run them.
*/
/* Allows interactive CL interpretation of
*/
/* CL command groups similar to STRDBRDR.
*/
/*
*/
/* Copyright:
*/
/* (C) Copyright S.H. Coulter 1987, 2002. All rights reserved.
*/
/* (C) Copyright FlyByNight Software. 1987, 2002. All rights reserved.
*/
/*
*/
/* Module type:
*/
/* Processor . . . . . . . : CLP
*/
/*
*/
/* Module size . . . . . . :
*/
/*
*/
/* Attributes . . . . . . :
*/
/*
*/
/* Entry:
*/
/* Entry point . . . . . . : STRCLRDRC
*/
/*
*/
/* Purpose . . . . . . . . : (See function)
*/
/*
*/
/* Linkage . . . . . . . . : CPP for STRCLRDR
*/
/*
*/
/* Input . . . . . . . . . . : &QUALSRCF - Qualifed source file
*/
/* &SRCMBR - Member name
*/
/*
*/
/* Output . . . . . . . . . : *NONE
*/
/*
*/
/* External references:
*/
/* Routines . . . . . . . : STDERR - Standard error handler
*/
/* EXTQUALOBJ - Extract qualified object
*/
/*
*/
/* Files . . . . . . . . . :
*/
/*
*/
/* Data areas . . . . . . :
*/
/*
*/
/* Control blocks . . . . :
*/
/*
*/
/* References from UIM . . :
*/
/*
*/
/* Exits-- Normal . . . . . : Return to NSI
*/
/* -- Error . . . . . . : Resignal escape message to caller
*/
/*
*/
/* Messages:
*/
/* Generated . . . . . . . : CPF9898 - Impromptu messages
*/
/*
*/
/* Resignalled . . . . . . : *ESCAPE messages
*/
/* *NOTIFY messages
*/
/*
*/
/* Monitored . . . . . . . : CPF9999 - Function check exceptions
*/
/* CPF0864 - End of file.
*/
/*
*/
/* Macros/Includes . . . . . :
*/
/*
*/
/* Data/Tables . . . . . . . :
*/
/*
*/
/* Notes:
*/
/* Dependencies . . . . . : STDERR - Standard error handler
*/
/* EXTQUALOBJ - Extract qualified object
*/
/*
*/
/* Restrictions . . . . . :
*/
/*
*/
/* Register conventions . : N/A
*/
/*
*/
/* Patch label . . . . . . : N/A
*/
/*
*/
/* Support . . . . . . . . : shc@flybnight.com.au
*/
/*
*/
/* Change activity:
*/
/* Rlse &
*/
/* Flag Reason Level Date Pgmr Comments
*/
/* ---- -------- ------ ------ ---------- -----------------------------------
*/
/* $A0= D 870128 SHC: Initial coding of module.
*/
/* $A1= D 920107 SHC: Support both S/38 and AS/400 syntax
*/
/* $A2= D 020926 SHC: Remove dumb defaults and make more
*/
/* like an IBM command.
*/
/*
*/
/* ** End of specifications *************************************************
*/
STRCLRDRC: PGM PARM(&QUALSRCF &SRCMBR)
/* */
/* ---------------- Input Parameter Declarations ----------------- */
/* */
DCL VAR(&QUALSRCF) TYPE(*CHAR) LEN(20)
/* Qualified soucre file */
DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
/* Source member name */
/* */
/* ------------------- Program Declarations ---------------------- */
/* */
DCLF FILE(QCLSRC)
/* Source file template */
DCL VAR(&SRCF) TYPE(*CHAR) LEN(10)
/* Source file */
DCL VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)
/* Source file library */
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
/* Source member type */
DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10)
/* Source member type */
DCL VAR(&ERROR) TYPE(*LGL) LEN(1)
/* Error flag */
/* */
/* ---------------- Mnemonic Value Declarations ------------------ */
/* */
DCL VAR(&BLANK) TYPE(*CHAR) LEN(1) VALUE(X'40')
/* Mnemonic for 'blank' */
DCL VAR(&TRUE) TYPE(*LGL) LEN(1) VALUE('1')
/* Mnemonic for 'true' */
DCL VAR(&FALSE) TYPE(*LGL) LEN(1) VALUE('0')
/* Mnemonic for 'false' */
DCL VAR(&STAR) TYPE(*CHAR) LEN(1) VALUE('*')
/* Mnemonic for 'asterisk' */
DCL VAR("E) TYPE(*CHAR) LEN(1) VALUE('''')
/* Mnemonic for 'quote' */
DCL VAR(&BATCH) TYPE(*CHAR) LEN(1) VALUE('0')
/* Mnemonic for 'batch job' */
DCL VAR(&INTER) TYPE(*CHAR) LEN(1) VALUE('1')
/* Mnemonic for 'interactive job' */
DCL VAR(&ZERO) TYPE(*DEC) LEN(1 0) VALUE(0)
/* Mnemonic for 'zero' */
DCL VAR(&HEX00) TYPE(*CHAR) LEN(2) VALUE(X'0000')
/* Mnemonic for 'binary zero' */
/* */
/* ------------------- Copyright Declarations -------------------- */
/* */
DCL VAR(©RIGHT) TYPE(*CHAR) LEN(80) +
VALUE('Copyright (C) FlyByNight Software. +
1987, 2002')
/* */
/* -------------- Global Message Monitor Intercept --------------- */
/* */
MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(FAILED))
/* */
/* ---------- Force Copyright Notice in Executable Code ---------- */
/* */
CHGVAR VAR(©RIGHT) VALUE(©RIGHT)
/* Initialise error indicator */
CHGVAR VAR(&ERROR) VALUE(&FALSE)
/* Find out job type. Force SBMDBJOB in batch job. */
/* Belts and braces code - CDO not allowed in batch. */
RTVJOBA TYPE(&TYPE)
IF COND(&TYPE *EQ '0') THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('STRCLRDR +
is only valid in an interactive job. Use +
SBMDBJOB for batch execution') +
MSGTYPE(*ESCAPE)
ENDDO
/* Split out the qualified source file names. */
EXTQUALOBJ QUALOBJ(&QUALSRCF) OBJ(&SRCF) LIB(&SRCFLIB)
/* Ensure the source member exists and can be read. */
CHKOBJ OBJ(&SRCFLIB/&SRCF) OBJTYPE(*FILE) MBR(&SRCMBR) +
AUT(*USE)
/* Check that source type is valid for CL interpreter */
RTVMBRD FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR) SRCTYPE(&SRCTYPE)
IF COND( (&SRCTYPE *NE 'CL') *AND +
(&SRCTYPE *NE 'CL38') *AND +
(&SRCTYPE *NE 'CLP') *AND +
(&SRCTYPE *NE 'CLP38') *AND +
(&SRCTYPE *NE 'CLLE') ) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Source +
type of member' *BCAT &SRCMBR *BCAT 'in +
file' *BCAT &SRCF *BCAT 'in' *BCAT +
&SRCFLIB *BCAT 'must be CL, CL38, CLP, +
CLP38, or CLLE') MSGTYPE(*ESCAPE)
ENDDO
/* Point to the correct source member. */
OVRDBF FILE(QCLSRC) TOFILE(&SRCFLIB/&SRCF) MBR(&SRCMBR)
/* Read each record in the source member. */
READ: RCVF
MONMSG MSGID(CPF0864) EXEC(DO)
RCVMSG MSGTYPE(*LAST)
GOTO CMDLBL(EOF)
ENDDO
/* Send the command to the external queue as a */
/* request message. */
IF COND(&SRCDTA *NE &BLANK) THEN(DO)
SNDPGMMSG MSG(&SRCDTA) TOPGMQ(*EXT) MSGTYPE(*RQS)
ENDDO
GOTO CMDLBL(READ) /* Get the next command */
EOF: DLTOVR FILE(QCLSRC)
/* Send message to return control to the module */
/* after all source statements have been executed. */
SNDPGMMSG MSG(RETURN) TOPGMQ(*EXT) MSGTYPE(*RQS)
/* Execute the request messages */
/* -- QCL is used for System/38 commands */
IF COND((&SRCTYPE *EQ 'CL38') *OR +
(&SRCTYPE *EQ 'CLP38')) THEN(DO)
CALL PGM(QCL)
ENDDO
/* -- QCMD is used for AS/400 commands */
ELSE CMD(DO)
CALL PGM(QCMD)
ENDDO
/* */
/* -------------------- Send User a Message ---------------------- */
/* */
/* Send completion message. This does not guarantee */
/* SUCCESSFUL completion of all commands, only that */
/* the file was read and statements were processed. */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Commands in member' *BCAT &SRCMBR +
*BCAT 'in file' *BCAT &SRCF *BCAT 'in' +
*BCAT &SRCFLIB *BCAT 'completed') MSGTYPE(*COMP)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Check +
low-level messages for any errors +
encountered') MSGTYPE(*COMP)
EXIT: RETURN /* Normal end of program */
/* */
/* --------------------- Exception Routine ----------------------- */
/* */
FAILED: STDERR PGMTYPE(*CPP)
MONMSG MSGID(CPF9999) /* Just in case */
STRCLRDRX: ENDPGM
Regards,
Simon Coulter.
--------------------------------------------------------------------
FlyByNight Software AS/400 Technical Specialists
http://www.flybynight.com.au/
Phone: +61 3 9419 0175 Mobile: +61 0411 091 400 /"\
Fax: +61 3 9419 0175 mailto: shc@flybynight.com.au \ /
X
ASCII Ribbon campaign against HTML E-Mail / \
--------------------------------------------------------------------
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
