%title 'Delete -- MailBox Master command'

module Delete (
    ident = 'V4.0') =

begin

%sbttl 'module declarations'

library 'SYS$LIBRARY:STARLET';
library 'MBMLIB';


forward routine Delete_Mailbox;


literal DevNam_Size = 64;
own
    DevClass,
    DevNam: vector[DevNam_Size, byte],
    DevNam_dsc: $dsc preset (
	[DSC$B_DTYPE] = DSC$K_DTYPE_T,
	[DSC$B_CLASS] = DSC$K_CLASS_S,
	[DSC$A_POINTER] = DevNam);

bind
    ItmLst = uplit (DVI_ItmLst (
	<code = DEVCLASS, buffer = DevClass>,
	<code = DEVNAM, buflen = DevNam_Size,
	    buffer = DevNam, retlen = DevNam_dsc[DSC$W_LENGTH]>));


%sbttl 'Delete -- Delete mailbox command'

global routine Delete =
(
    external routine
	STR$FREE1_DX: addressing_mode (general),
	CLI$GET_VALUE: addressing_mode (general);
    local
	sts: VMS_sts initial (SS$_NORMAL),
	MailBox_dsc: $dsc_dynamic;


    while CLI$GET_VALUE (%ascid 'MailBox', MailBox_dsc) do
    (
	sts = $GETDVI (efn = 0, devnam = MailBox_dsc, itmlst = ItmLst);
	if .sts then
	(
	    $WAITFR (efn = 0);
	    if .DevClass eql DC$_MAILBOX then
		sts = Delete_Mailbox (MailBox_dsc)
	    else
	    (
		signal (MBM_Error (NOTMBX, MailBox_dsc, DevNam_dsc));
		sts = MBM_Cond (NOTMBX);
	    )
	)
	else
	    signal (MBM_Error (GETDVI, MailBox_dsc), SS_Error (.sts));

	STR$FREE1_DX (MailBox_dsc);
    );

    return .sts
);


%sbttl 'Delete_Mailbox -- delete a mailbox'

routine Delete_Mailbox (MailBox_dsc: ref $dsc) =
(
    local
	sts: VMS_sts,
	Channel: word;


    sts = $ASSIGN (devnam = DevNam_dsc, chan = Channel);
    if not .sts then
    (
	signal (MBM_Error (ASSIGN, .MailBox_dsc, DevNam_dsc), SS_Error (.sts));
	return .sts;
    );

    sts = $DELMBX (chan = .Channel);

    $DASSGN (chan = .Channel);

    if .sts then
	signal (MBM_Error (DELETE, .MailBox_dsc, DevNam_dsc))
    else
	signal (MBM_Error (DELMBX, .MailBox_dsc, DevNam_dsc), SS_Error (.sts));

    return .sts
);


end
eludom