%title 'CliGet -- Specialized Cli routines'

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

begin

%sbttl 'module declarations'

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


%sbttl 'CLI_GET_NUMBER -- Get Value and convert to number'

global routine CLI_GET_NUMBER (Cli_Label: ref $dsc, Number: ref vector[1]) =
(
    external routine
	CLI$GET_VALUE: addressing_mode (general),
	OTS$CVT_TI_L: addressing_mode (general),
	STR$FREE1_DX: addressing_mode (general);
    local
	sts: VMS_sts,
	Number_dsc: $dsc_dynamic;


    sts = CLI$GET_VALUE (.Cli_Label, Number_dsc);
    if not .sts then return .sts;

    sts = OTS$CVT_TI_L (Number_dsc, Number[0], %size (vector[1]), 0);
    if not .sts then
	signal (MBM_Error (CVTTIL, .Cli_Label), .sts);

    STR$FREE1_DX (Number_dsc);
    return .sts
);


%sbttl 'Pro_Table -- state table for parsing protection'

own
    TPA_Protection;

own
    Pro_Param: $bblock[TPA$K_LENGTH0] initial (TPA$K_COUNT0, TPA$M_ABBREV,
	rep TPA$K_LENGTH0 - 2*%upval of byte (0));

$init_state (Pro_Table, Pro_Key_Table);

$state (Group_Keyword,
    ['SYSTEM', Sys_Pro],
    ['OWNER',  Own_Pro],
    ['GROUP',  Gro_Pro],
    ['WORLD',  Wor_Pro]
	);
$state (Sys_Pro,
    ['='],
    [':']
	);
$state (Sys_Pro1,
    ['R', Sys_Pro1,, 1 ^ 0, TPA_Protection],
    ['W', Sys_Pro1,, 1 ^ 1, TPA_Protection],
    ['P', Sys_Pro1,, 1 ^ 2, TPA_Protection],
    ['L', Sys_Pro1,, 1 ^ 3, TPA_Protection],
    [TPA$_EOS, TPA$_EXIT]
	);
$state (Own_Pro,
    ['='],
    [':']
	);
$state (Own_Pro1,
    ['R', Own_Pro1,, 1 ^ 4, TPA_Protection],
    ['W', Own_Pro1,, 1 ^ 5, TPA_Protection],
    ['P', Own_Pro1,, 1 ^ 6, TPA_Protection],
    ['L', Own_Pro1,, 1 ^ 7, TPA_Protection],
    [TPA$_EOS, TPA$_EXIT]
	);
$state (Gro_Pro,
    ['='],
    [':']
	);
$state (Gro_Pro1,
    ['R', Gro_Pro1,, 1 ^ 8, TPA_Protection],
    ['W', Gro_Pro1,, 1 ^ 9, TPA_Protection],
    ['P', Gro_Pro1,, 1 ^ 10, TPA_Protection],
    ['L', Gro_Pro1,, 1 ^ 11, TPA_Protection],
    [TPA$_EOS, TPA$_EXIT]
	);
$state (Wor_Pro,
    ['='],
    [':']
	);
$state (Wor_Pro1,
    ['R', Wor_Pro1,, 1 ^ 12, TPA_Protection],
    ['W', Wor_Pro1,, 1 ^ 13, TPA_Protection],
    ['P', Wor_Pro1,, 1 ^ 14, TPA_Protection],
    ['L', Wor_Pro1,, 1 ^ 15, TPA_Protection],
    [TPA$_EOS, TPA$_EXIT]
	);


%sbttl 'CLI_GET_PROTECTION -- Get Value and convert to protection mask'

global routine CLI_GET_PROTECTION (
    Cli_Label: ref $dsc, Protection: ref vector[1, word]) =
(
    external routine
	CLI$GET_VALUE: addressing_mode (general),
	LIB$TPARSE: addressing_mode (general),
	STR$FREE1_DX: addressing_mode (general);
    local
	sts: VMS_sts,
	Pro_dsc: $dsc_dynamic;


    TPA_Protection = 0;

    while CLI$GET_VALUE (.Cli_Label, Pro_dsc) do
    (
	Pro_Param[TPA$L_STRINGCNT] = .Pro_dsc[DSC$W_LENGTH];
	Pro_Param[TPA$L_STRINGPTR] = .Pro_dsc[DSC$A_POINTER];

	sts = LIB$TPARSE (Pro_Param, Pro_Table, Pro_Key_Table);
	if not .sts then
	    signal (MBM_Error (TPARSE, Pro_dsc), .sts);
	
	STR$FREE1_DX (Pro_dsc);
	if not .sts then return .sts;
    );

    Protection[0] = not .TPA_Protection;
    return .sts
);


%sbttl 'CLI_GET_TIME -- Get Value and convert to time'

global routine CLI_GET_TIME (Cli_Label: ref $dsc, Time: ref vector[2]) =
(
    external routine
	CLI$GET_VALUE: addressing_mode (general),
	STR$FREE1_DX: addressing_mode (general);
    local
	sts: VMS_sts,
	Time_dsc: $dsc_dynamic;


    sts = CLI$GET_VALUE (.Cli_Label, Time_dsc);
    if not .sts then return .sts;

    sts = $BINTIM (timbuf = Time_dsc, timadr = .Time);
    if not .sts then
	signal (MBM_Error (BINTIM, Time_dsc), .sts);

    STR$FREE1_DX (Time_dsc);
    return .sts
);


end
eludom