| Use LIB$ESTABLISH() to handle the condition. Example included below,
a day late and a dollar short. -drew
Example-FORTRAN How To Recover From An Error In Send List/Callable Mail
Any party granted access to the following copyrighted information
(protected under Federal Copyright Laws), pursuant to a duly executed
Digital Service Agreement may, under the terms of such agreement copy
all or selected portions of this information for internal use and
distribution only. No other copying or distribution for any other
purpose is authorized.
Copyright (c) Digital Equipment Corporation 1992, 1993. All rights reserved
PRODUCT: DEC Fortran
OP/SYS: OpenVMS VAX
SOURCE: Digital Customer Support Center
OVERVIEW:
This article demonstrates how to recover in callable mail when a user's
nodename on the SEND_TO list does not exist. It sets up a condition handler
to deal with the condition.
*** CAUTION ***
This sample program has been tested using VAX FORTRAN version 5.9 on
OpenVMS VAX version 6.0. However, we cannot guarantee its
effectiveness because of the possibility of error in transmitting or
implementing it. It is meant to be used as a template for writing
your own program, and it may require modification for use on your
system.
PROGRAM NOTES:
This program uses a data file called MAIL_BODY.TXT for the body of the
mail message. You can create a test file with this name using an editor.
The text of the file can also be entered interactively with a slight
modification to this program.
To avoid possible "Undefined symbol" errors, this program should be
linked with an external MACRO program containing the following lines
(named MAILMSGDEF.MAR):
.TITLE MAILMSGDEF
$MAILMSGDEF GLOBAL
.END
This MACRO program must then be compiled as follows:
$MACRO MAILMSGDEF
The .OBJ file created must then be linked with this program:
$LINK MAIL_NODE, MAILMSGDEF
PROGRAM:
OPTIONS /EXTEND_SOURCE
PROGRAM mail_node
IMPLICIT INTEGER*4 (A-Z)
EXTERNAL MAIL$SEND_BEGIN, MAIL$SEND_ADD_ATTRIBUTE
EXTERNAL MAIL$SEND_ADD_ADDRESS, MAIL$SEND_ADD_BODYPART
EXTERNAL MAIL$SEND_MESSAGE, MAIL$SEND_END
EXTERNAL chand
C
C Include the MAILDEF and RMS constants and library routines.
C
INCLUDE '($RMSDEF)'
INCLUDE '($MAILDEF)'
C
C Set up the item list.
C
STRUCTURE /item_list/
UNION
MAP
INTEGER*2 buflen
INTEGER*2 itmcod
INTEGER*4 bufadr
INTEGER*4 retlen
END MAP
MAP
INTEGER*4 terminator
END MAP
END UNION
END STRUCTURE
RECORD /item_list/ mailitm1(3), mailitm2(4)
INTEGER*4 stat, context, context2, file_len
INTEGER*2 type, cont
INTEGER*4 LIB$SPAWN, LIB$FIND_FILE, LIB$FIND_FILE_END,
* LIB$STOP, LIB$SIGNAL
CHARACTER*255 to_name,from_name,subject_line,
* text_line,text_file,res_name
CHARACTER*1 prmpt
COMMON /out_name/ to_name,from_name,subject_line,
* text_line,text_file
C Initialize the condition handler.
CALL LIB$ESTABLISH(chand)
C
C Initialize the SEND context.
C
stat = MAIL$SEND_BEGIN (context, 0, 0)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
C
C Get the information for TO:, FROM:, and SUBJECT: lines.
C STR$UPCASE is used to capitalize some of the fields.
C This program expects a valid username to be entered for
C the TO field. It does not handle errors on that field.
C You might want to add error handling for cases where an
C invalid name is entered. It does contain error handling
C for an invalid node specification.
C
WRITE(6,20)
20 FORMAT (' FROM:? ',$)
READ (*, '(Q,A)') mailitm2(2).buflen, from_name
WRITE(6,*) ' '
stat = STR$UPCASE(from_name,from_name)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
WRITE(6,40)
40 FORMAT (' What should the SUBJECT: line contain? ',$)
READ (*, '(Q,A)') mailitm2(3).buflen, subject_line
WRITE(6,*) ' '
C
C Prepare the item list to supply TO:, FROM: and SUBJECT:
C information and add all of these attributes in one call to
C MAIL$SEND_ADD_ATTRIBUTE.
C
mailitm2(1).itmcod = mail$_send_to_line ! to:
mailitm2(1).bufadr = %LOC(to_name)
mailitm2(2).itmcod = MAIL$_SEND_FROM_LINE ! FROM:
mailitm2(2).bufadr = %LOC(from_name)
mailitm2(3).itmcod = MAIL$_SEND_SUBJECT ! SUBJECT:
mailitm2(3).bufadr = %LOC(subject_line)
mailitm2(4).terminator = 0
stat = MAIL$SEND_ADD_ATTRIBUTE (context, mailitm2, 0)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
cont = 1
do while (cont .eq. 1)
5 WRITE(6,10)
10 FORMAT (' What is the address the message should go to (TO:)? ',$)
READ (*, '(Q,A)') mailitm2(1).buflen, to_name
WRITE(6,*) ' '
stat = STR$UPCASE(to_name,to_name)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
C
C Specify the address of the person to receive the message.
C This call actually sets up the address to which the message
C will be sent.
type = MAIL$_TO
mailitm1(1).buflen = mailitm2(1).buflen
mailitm1(1).itmcod = MAIL$_SEND_USERNAME
mailitm1(1).bufadr = %LOC(to_name)
mailitm1(2).buflen = 2
mailitm1(2).itmcod = MAIL$_SEND_USERNAME_TYPE
mailitm1(2).bufadr = %LOC(type)
mailitm1(3).terminator = 0
stat = MAIL$SEND_ADD_ADDRESS (context, mailitm1, 0)
IF (.NOT. stat) CALL LIB$SIGNAL( %VAL( stat))
WRITE(6,17)
17 FORMAT (' Send to an additional user (Y/N)? ',$)
READ (5,18) prmpt
18 format (a)
IF ((prmpt .eq. 'n') .or. (prmpt .eq. 'N')) cont = 0
end do
C
C Display message body.
C
WRITE(6,*) ' '
WRITE(6,*) ' '
WRITE(6,*) ' This program uses a data file called MAIL_BODY.TXT'
WRITE(6,*) ' for the body of the mail message. You can create'
WRITE(6,*) ' a test file with this name using an editor. The'
WRITE(6,*) ' text of the file can also be entered interactively'
WRITE(6,*) ' with a slight modification to this program.'
WRITE(6,*) ' '
C
C Print out the body of the file for the user to see.
C After the end of file is reached, use MAIL$SEND_ADD_BODYPART
C to insert the text file as the body of the mail message.
C
WRITE(6,*) 'Here is the text of the file you are mailing:'
WRITE(6,*) ' '
C
C Use LIB$FIND_FILE to see if MAIL_BODY.TXT exists.
C
context2 = 0 !This must be initialized to 0
stat = LIB$FIND_FILE( 'MAIL_BODY.TXT', res_name, context2,,,,)
IF (stat .EQ. RMS$_FNF) THEN
WRITE(6,*) '*** The data file with the mail message ***'
WRITE(6,*) '*** cannot be found. ***'
GOTO 999
ELSE IF (.NOT. stat) THEN
CALL LIB$STOP(%VAL( stat))
ELSE
C Print out the body of the mail file.
stat = LIB$SPAWN('TYPE MAIL_BODY.TXT')
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
END IF
C
C Prepare the item list for the message body. Since we have an
C existing file with the message body, we can use MAIL$_SEND_FILENAME
C as the item code and make one call to MAIL$SEND_ADD_BODYPART.
C If we were sending individual lines of the body, we would use
C MAIL$_SEND_RECORD as the item code and make repeated calls to
C MAIL$SEND_ADD_BODYPART.
C
text_file = 'MAIL_BODY.TXT'
C Determine the length of the filename.
file_len = INDEX('MAIL_BODY.TXT',' ')
IF (file_len .EQ. 0) THEN
file_len = LEN('MAIL_BODY.TXT')
ELSE
file_len = file_len - 1
END IF
mailitm1(1).buflen = file_len
mailitm1(1).itmcod = MAIL$_SEND_FILENAME
mailitm1(1).bufadr = %LOC(text_file)
mailitm1(2).terminator = 0
stat = MAIL$SEND_ADD_BODYPART (context, mailitm1, 0)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
C
C Send the message.
C
stat = MAIL$SEND_MESSAGE (context, 0, 0)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
WRITE(6,*) ' '
WRITE(6,*) ' '
WRITE(6,*) '...Message sent...'
WRITE(6,*) ' '
WRITE(6,*) ' '
C
C Clean up the context.
C
999 stat = MAIL$SEND_END (context, 0, 0)
IF (.NOT. stat) CALL LIB$STOP( %VAL( stat))
C
C Clean up after file search.
stat = LIB$FIND_FILE_END (context2)
IF (.NOT. stat) CALL LIB$SIGNAL (%VAL(stat))
END
OPTIONS /EXTEND_SOURCE
INTEGER*4 FUNCTION chand (signal, mech)
C
C This routine is to be used as a condition handler
C for system service failures.
C
IMPLICIT INTEGER*4 (a-z)
INTEGER*4 signal(*), mech(5)
INTEGER*2 msglen
CHARACTER*120 errmsg
INCLUDE '($SSDEF)'
EXTERNAL MAIL$_LOGLINK
IF (signal(2) .eq. %LOC(MAIL$_LOGLINK)) THEN
TYPE *, 'Errors creating link to network node specified.'
chand = SS$_CONTINUE
ELSE
stat=SYS$GETMSG( %VAL(signal(3)), msglen,
1 errmsg,,)
IF (.NOT. stat) CALL LIB$STOP(%VAL(stat))
TYPE *, 'System service call failed with error:'
TYPE *, errmsg(1:msglen)
chand = SS$_CONTINUE
ENDIF
RETURN
END
|