%TITLE 'CONTROL_PARSING'
MODULE CONTROL_PARSING (IDENT='V1.0-1', ADDRESSING_MODE (EXTERNAL=LONG_RELATIVE, NONEXTERNAL=LONG_RELATIVE)) =
BEGIN
!++
! FACILITY: 	    MX_MAILSHR
!
! ABSTRACT: 	    Parses control line in an outbound VMS MAIL message.
!
! MODULE DESCRIPTION:
!
!   description
!
! AUTHOR:   	    M. Madison
!
! Copyright (c) 2008, Matthew Madison.
! 
! All rights reserved.
! 
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 
!     * Redistributions of source code must retain the above
!       copyright notice, this list of conditions and the following
!       disclaimer.
!     * Redistributions in binary form must reproduce the above
!       copyright notice, this list of conditions and the following
!       disclaimer in the documentation and/or other materials provided
!       with the distribution.
!     * Neither the name of the copyright owner nor the names of any
!       other contributors may be used to endorse or promote products
!       derived from this software without specific prior written
!       permission.
! 
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! CREATION DATE:    16-JUL-1998
!
! MODIFICATION HISTORY:
!
!   16-JUL-1998	V1.0	Madison	    Initial coding.
!   12-AUG-1999	V1.0-1	Madison	    Fix NOTIFY=NEVER bug.
!--
    LIBRARY 'SYS$LIBRARY:STARLET';
    LIBRARY 'SYS$LIBRARY:TPAMAC';
    LIBRARY 'MX_SRC_COMMON:MX';
    LIBRARY 'MX_MAILSHR_LIB';

    FORWARD ROUTINE
    	PARSE_DSN_CONTROL,
    	pdc_store;

    EXTERNAL ROUTINE
    	G_HAT (LIB$TPARSE, STR$UPCASE);

    LITERAL
    	PDC_K__LO   	    	= 2,
    	PDC_K_STORE_DSN_NEVER	= 2,
    	PDC_K_STORE_DSN_FAILURE	= 3,
    	PDC_K_STORE_DSN_DELAY	= 4,
    	PDC_K_STORE_DSN_SUCCESS	= 5,
    	PDC_K_STORE_DSN_HDRS	= 6,
    	PDC_K_STORE_DSN_FULL	= 7,
    	PDC_K__HI   	    	= 7;

    MACRO
    	TPA_A_P1    	=   TPA$C_LENGTH0+00,0,32,0%,
    	TPA_A_P2    	=   TPA$C_LENGTH0+04,0,32,0%,
    	TPA_A_P3    	=   TPA$C_LENGTH0+08,0,32,0%,
    	TPA_A_P4    	=   TPA$C_LENGTH0+12,0,32,0%,
    	TPA_A_P5    	=   TPA$C_LENGTH0+16,0,32,0%,
    	TPA_A_P6    	=   TPA$C_LENGTH0+20,0,32,0%,
    	TPA_A_P7    	=   TPA$C_LENGTH0+24,0,32,0%,
    	TPA_A_P8    	=   TPA$C_LENGTH0+28,0,32,0%;
    
    $INIT_STATE (PDC_STATE, PDC_KEY)

    $STATE (pdc_init,
    	('NOTIFY', parse_notify),
    	('RETURN', parse_return));

    $STATE (pdc_notify_only,
    	('NOTIFY', parse_notify));

    $STATE (pdc_return_only,
    	('RETURN', parse_return));

    $STATE (parse_return,
    	('='),
    	(':'));

    $STATE (parse_return_value,
    	('HEADERS', pdc_after_return, pdc_store,,, PDC_K_STORE_DSN_HDRS),
    	('FULL',    pdc_after_return, pdc_store,,, PDC_K_STORE_DSN_FULL));

    $STATE (pdc_after_return,
    	(TPA$_EOS, TPA$_EXIT),
    	(TPA$_LAMBDA, pdc_notify_only));

    $STATE (pdc_after_notify,
    	(TPA$_EOS, TPA$_EXIT),
    	(TPA$_LAMBDA, pdc_return_only));

    $STATE (pdc_eos,
    	(TPA$_EOS, TPA$_EXIT));

    $STATE (parse_notify,
    	('='),
    	(':'));

    $STATE (parse_never_or_notify_values,
    	('NEVER',   pdc_eos,	pdc_store,,, PDC_K_STORE_DSN_NEVER),
    	(TPA$_LAMBDA, parse_notify_values));

    $STATE (parse_notify_values,
    	('SUCCESS', pnv_comma,	pdc_store,,, PDC_K_STORE_DSN_SUCCESS),
    	('DELAY',   pnv_comma,	pdc_store,,, PDC_K_STORE_DSN_DELAY),
    	('FAILURE', pnv_comma,	pdc_store,,, PDC_K_STORE_DSN_FAILURE));
    $STATE (pnv_comma,
    	(',', parse_notify_values),
    	(TPA$_LAMBDA, pdc_after_notify));


%SBTTL 'PARSE_DSN_CONTROL'
GLOBAL ROUTINE PARSE_DSN_CONTROL (context_a_a, bufptr, len) = 
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!   Parses the following control directives that may appear in the first
!   line of text of a message originating in VMS MAIL:
!
!   /NOTIFY=NEVER or /NOTIFY=[FAILURE,SUCCESS,DELAY]
!   /FROM=rfc822-address
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   PARSE_DSN_CONTROL  bufptr, len, fromstr, flags
!
!   bufptr: 	char_string, read only, by reference
!   len:    	word (unsigned), read only, by value
!   fromstr:	char_string, write only, by descriptor
!   flags:  	longword (unsigned), write only, by reference
!   
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:	    None.
!--
    LITERAL
    	TPA_C_LENGTH	= TPA$C_LENGTH0 + 4,
    	TPA_K_COUNT 	= TPA$K_COUNT0  + 1;

    LOCAL
    	tpablk	: BLOCK [TPA_C_LENGTH,BYTE],
    	tmpbuf	: VECTOR [2048,BYTE],
    	dsc1	: BLOCK [DSC$K_S_BLN,BYTE],
    	dsc2	: BLOCK [DSC$K_S_BLN,BYTE];

    IF .len GTR %ALLOCATION (tmpbuf) THEN len = %ALLOCATION (tmpbuf);
    INIT_SDESC (dsc1, .len, .bufptr);
    INIT_SDESC (dsc2, .len, tmpbuf);
    STR$UPCASE (dsc2, dsc1);

    CH$FILL (%CHAR (0), TPA_C_LENGTH, tpablk);
    tpablk [TPA$L_COUNT] = TPA_K_COUNT;
    tpablk [TPA$V_ABBREV] = 1;
    tpablk [TPA$L_STRINGCNT] = .len;
    tpablk [TPA$L_STRINGPTR] = tmpbuf;
    tpablk [TPA_A_P1] = .context_a_a;

    LIB$TPARSE (tpablk, pdc_state, pdc_key)

END; ! PARSE_DSN_CONTROL

%SBTTL 'pdc_store'
TPA_ROUTINE (pdc_store, (options, stringcnt, stringptr, tokencnt, tokenptr, char, number, param, context_a_a))
!++
! FUNCTIONAL DESCRIPTION:
!
!   TPARSE action routine for PARSE_DSN_CONTROL
!
! RETURNS:  	cond_value, longword (unsigned), write only, by value
!
! PROTOTYPE:
!
!   PDC_STORE opt, scnt, sptr, tcnt, tptr, chr, num, par, p1, p2, p3
!
! IMPLICIT INPUTS:  None.
!
! IMPLICIT OUTPUTS: None.
!
! COMPLETION CODES:
!
!   SS$_NORMAL:	    	normal successful completion.
!
! SIDE EFFECTS:	    None.
!--
    BIND
    	context	= .context_a_a	    	    	    : REF MXPDEF,
    	flags	= context [MXP_L_NTFYFLGS];

    CASE .param FROM PDC_K__LO TO PDC_K__HI OF
    SET

    [PDC_K_STORE_DSN_NEVER] :
    	BEGIN
    	    flags<4,1,0> = 1;
    	    flags<1,3,0> = 0;
    	END;

    [PDC_K_STORE_DSN_DELAY] :
    	BEGIN
    	    flags<3,1,0> = 1;
    	    flags<4,1,0> = 0;
    	END;

    [PDC_K_STORE_DSN_FAILURE] :
    	BEGIN
    	    flags<2,1,0> = 1;
    	    flags<4,1,0> = 0;
    	END;

    [PDC_K_STORE_DSN_SUCCESS] :
    	BEGIN
    	    flags<1,1,0> = 1;
    	    flags<4,1,0> = 0;
    	END;

    [PDC_K_STORE_DSN_HDRS] :
    	BEGIN
    	    context [MXP_V_DSN_FULL] = 0;
    	    context [MXP_V_DSN_HDRSONLY] = 1;
    	END;

    [PDC_K_STORE_DSN_FULL] :
    	BEGIN
    	    context [MXP_V_DSN_FULL] = 1;
    	    context [MXP_V_DSN_HDRSONLY] = 0;
    	END;

    [INRANGE,OUTRANGE] :;

    TES;

    SS$_NORMAL

END; ! pdc_store

END
ELUDOM