?? RIGHT := 110 ??
MODULE dfm$return_family_state;

{
{ This module provides a temporary place for the command
{ processor to return information about a family.  This
{ interface is a temporary interface provided for integration.
{ This also contains a simple interface to determine if a family
{ is a served family.

?? PUSH (LISTEXT := ON) ??
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc clp$validate_name
*copyc clp$write_variable
*copyc dfe$error_condition_codes
*copyc dfp$fetch_served_family_entry
*copyc dfp$find_mainframe_id
*copyc dfp$get_served_family_names
*copyc dfp$locate_every_served_family
*copyc dft$family_info_list
*copyc dft$family_info_record
*copyc osp$convert_to_real_model_num
*copyc osp$get_family_names
*copyc osp$get_set_name
*copyc osp$set_status_condition
*copyc pfe$error_condition_codes
*copyc pme$program_services_exceptions
*copyc pmp$convert_binary_mainframe_id
?? POP ??
?? EJECT ??
*copyc dfh$get_family_list
  PROCEDURE [XDCL, #GATE] dfp$get_family_list
    (VAR family_info_list: dft$family_info_list;
     VAR number_of_families: integer;
     VAR status: ost$status);

    VAR
      family: integer,
      family_end_index: pmt$family_name_count,
      list_full: boolean,
      local_family_count: pmt$family_name_count,
      p_family_list: ^pmt$family_name_list,
      server_family_count: pmt$family_name_count;

    PUSH p_family_list: [1 .. UPPERBOUND (family_info_list)];
    dfp$get_served_family_names (p_family_list^, server_family_count, status);
    list_full := NOT status.normal;
    number_of_families := server_family_count;
    family_end_index := number_of_families;
    IF number_of_families >= UPPERBOUND (family_info_list) THEN
      family_end_index := UPPERBOUND (family_info_list);
      list_full := TRUE;
    IFEND;

  /get_server_family_status/
    FOR family := 1 TO family_end_index DO
      dfp$get_family_status (p_family_list^ [family], family_info_list [family], status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND /get_server_family_status/;

    osp$get_family_names (p_family_list^, local_family_count, status);
    number_of_families := server_family_count + local_family_count;
    IF NOT list_full THEN
      family_end_index := number_of_families;
      IF number_of_families > UPPERBOUND (family_info_list) THEN
        family_end_index := UPPERBOUND (family_info_list);
        list_full := TRUE;
      IFEND;

    /get_local_family_status/
      FOR family := (server_family_count + 1) TO family_end_index DO
        dfp$get_family_status (p_family_list^ [family - server_family_count], family_info_list [family],
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND /get_local_family_status/;
    IFEND;

    IF list_full THEN
      osp$set_status_condition (pme$result_array_too_small, status);
    IFEND;
  PROCEND dfp$get_family_list;
?? EJECT ??
*copyc dfh$get_family_status

{ NOTE:
{   This procedure returns the REAL processor model number.

  PROCEDURE [XDCL, #GATE] dfp$get_family_status
    (    family_name: ost$family_name;
     VAR family_state: dft$family_info_record;
     VAR status: ost$status);

    VAR
      converted_family_name: ost$family_name,
      family_served: boolean,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_served_family_entry: ^dft$served_family_table_entry,
      queue_index: dft$queue_index,
      served_family_table_index: dft$served_family_table_index,
      server_mainframe_id: pmt$binary_mainframe_id,
      server_state: dft$server_state;

    status.normal := TRUE;
    clp$validate_name (family_name, converted_family_name, status.normal);
    IF NOT status.normal THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$bad_family_name, family_name, status);
      RETURN;
    IFEND;
    family_state.family_name := converted_family_name;
    dfp$locate_every_served_family (converted_family_name, family_served, served_family_table_index,
          server_mainframe_id, p_queue_interface_table, queue_index, server_state);
    IF family_served THEN
      family_state.family_state := server_state;
      family_state.access_type := dfc$server_access;
      family_state.server_binary_mainframe_id := server_mainframe_id;
      osp$convert_to_real_model_num (server_mainframe_id.model_number,
            family_state.server_binary_mainframe_id.model_number);
      pmp$convert_binary_mainframe_id (server_mainframe_id, family_state.server_mainframe_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dfp$fetch_served_family_entry (served_family_table_index, p_served_family_entry, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      family_state.family_access := p_served_family_entry^.family_access;
    ELSE
      osp$get_set_name (converted_family_name, family_state.set_name, status);
      IF status.normal THEN
        family_state.access_type := dfc$set_access;
        family_state.family_state := dfc$active;
      IFEND;
    IFEND;
  PROCEND dfp$get_family_status;
?? EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$return_family_state
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{  pdt fetch_family_state (
{     family_name, fn: name = $required
{     family_state, fs: VAR of string = $required
{     status)

?? PUSH (LISTEXT := ON) ??

    VAR
      fetch_family_state: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^fetch_family_state_names, ^fetch_family_state_params];

    VAR
      fetch_family_state_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
            clt$parameter_name_descriptor := [['FAMILY_NAME', 1], ['FN', 1], ['FAMILY_STATE', 2], ['FS', 2],
            ['STATUS', 3]];

    VAR
      fetch_family_state_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of
            clt$parameter_descriptor := [

{ FAMILY_NAME FN

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ FAMILY_STATE FS

      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$string_value]],

{ STATUS

      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

?? POP ??

    VAR
      family_info: dft$family_info_record,
      family_name: ost$name,
      family_state: ^record
        size: ost$string_size,
        value: string ( * ),
      recend,
      family_state_area: ^SEQ ( * ),
      family_state_variable: ^array [1 .. * ] of cell,
      server_state: dft$server_state,
      server_state_string: string (17),
      value: clt$value;

    clp$scan_parameter_list (parameter_list, fetch_family_state, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('FAMILY_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    family_name := value.name.value;

    clp$get_value ('FAMILY_STATE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$get_family_status (family_name, family_info, status);
    IF status.normal THEN
      CASE family_info.access_type OF
      = dfc$server_access =
        CASE family_info.family_state OF
        = dfc$active =
          server_state_string := 'SERVER_ACTIVE';
        = dfc$inactive, dfc$deactivated, dfc$awaiting_recovery, dfc$recovering =
          server_state_string := 'SERVER_INACTIVE';
        = dfc$terminated =
          server_state_string := 'SERVER_TERMINATED';
        ELSE
          server_state_string := 'UNKNOWN';
        CASEND;
      ELSE
        server_state_string := 'LOCAL';
      CASEND;
    ELSE { Unknown or deleted family
      status.normal := TRUE;
      server_state_string := 'UNKNOWN';
    IFEND;

    PUSH family_state_area: [[REP UPPERBOUND (value.var_ref.value.string_value^) OF cell]];
    RESET family_state_area;
    NEXT family_state: [value.var_ref.value.max_string_size] IN family_state_area;
    family_state^.size := 17;
    family_state^.value := server_state_string;
    RESET family_state_area;
    NEXT family_state_variable: [1 .. UPPERBOUND (value.var_ref.value.string_value^)] IN family_state_area;
    value.var_ref.value.string_value := family_state_variable;
    clp$write_variable (value.var_ref.reference.value (1, value.var_ref.reference.size), value.var_ref.value,
          status);

  PROCEND dfp$return_family_state;
MODEND dfm$return_family_state;
