From:	MERC::"uunet!CRVAX.SRI.COM!RELAY-INFO-VAX"  5-JUN-1992 05:11:40.85
To:	STEVENS@RAD.HUP.UPENN.EDU, info-vax@sri.com
CC:	GWDGI::"info-vax@sri.com"@CRVAX.SRI.COM, MOELLER@CRVAX.SRI.COM
Subj:	RE: Capture contents of REPLY/TO in DCL ?

Fred Stevens <STEVENS@RAD.HUP.UPENN.EDU> asks:
> If a DCL procedure does a "REQUEST/REPLY" is there any way for it to
> capture the contents of the "REPLY/TO=nn" which the operator does
> in response?

I've come up with the following DCL code. It happens to be a SUBROUTINE
for inclusion into another command procedure.

Wolfgang J. Moeller, GWDG, D-3400 Goettingen, F.R.Germany | Disclaimer ...
PSI%(0262)45050352008::MOELLER      Phone: +49 551 201516 | No claim intended!
Internet: moeller@gwdgv1.dnet.gwdg.de   | This space intentionally left blank.

$reqreply: subroutine
$ ver = 'f$verify(0,f$envir("verify_image"))'
$!
$! DCL request/reply with operator reply returned in global symbol _REPLY
$! p1		request string (must not contain `"')
$! p2 (opt.)	"/TO=class" specification
$!
$!*****
$!
$ tmpfn = "SYS$SCRATCH:REQREPLY_" + f$getj(0,"pid") + ".TMP;"
$!
$ set noon
$!
$ create 'tmpfn'			! make sure we get a NEW file
$ rstat = $status
$ if .not.rstat then goto done
$!
$ oldmsg = f$envir("message")
$ set message/fac/sev/ident/text
$!
$ define/user SYS$OUTPUT 'tmpfn'	! this will APPEND
$ request/reply 'p2' &p1
$ rstat = $status
$ if .not.rstat then goto cleanup
$!
$ repline = ""
$ open/read/error=ioerr REQREPLY_TMPFILE 'tmpfn'
$rloop:
$ read/error=ioerr/end=reof REQREPLY_TMPFILE tmpline
$ if tmpline.nes."" .and.-
     f$locate("%OPCOM-S-OPREPLY,",tmpline).eq.0 then repline = tmpline
$ goto rloop
$reof:
$ close REQREPLY_TMPFILE
$!
$! expect repline: "%OPCOM-S-OPREPLY, <cr><lf>text_of_reply<cr><lf>more text"
$!
$ crlf[0,8] = 13
$ crlf[8,8] = 10
$ i = f$locate(crlf,repline)
$ if i.eq.f$length(repline) then goto badreply
$ reptext = f$extract(i + 2, f$length(repline) - i - 2, repline)
$ i = f$locate(crlf,reptext)
$ if i.eq.f$length(reptext) then goto badreply
$ _reply == f$extract(0,i,reptext)
$ rstat = 1
$ goto cleanup
$!
$ioerr:
$ rstat = $status
$ close/nolog REQREPLY_TMPFILE
$ goto cleanup
$badreply:	! something wrong ...
$ rstat = 2
$ goto cleanup
$!
$cleanup:
$ delete 'tmpfn'
$ set message 'oldmsg'
$done:
$ exit rstat.and.(.not.%x10000000) + f$verify(ver,f$envir("verify_image"))*0
$ exit 4	! ...
$!
$ endsubroutine	! reqreply

Wolfgang J. Moeller, GWDG, D-3400 Goettingen, F.R.Germany | Disclaimer ...
PSI%(0262)45050352008::MOELLER      Phone: +49 551 201516 | No claim intended!
Internet: moeller@gwdgv1.dnet.gwdg.de   | This space intentionally left blank.

