?? TITLE := 'NOS/VE Permanent Files : Catalog Access' ??
MODULE pfm$catalog_access;
?? RIGHT := 110 ??

?? NEWTITLE := '  Global Declarations Referenced by this module' ??
?? PUSH (LISTEXT := ON) ??
*copyc pfc$max_selection_id_ordinal
*copyc pfe$error_condition_codes
*copyc pfe$selection_errors
*copyc pft$p_collected_info_array
*copyc pft$selection_identifier
*copyc pft$selection_record
?? POP ??
*copyc amp$close
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc osp$append_status_integer
*copyc osp$set_status_abnormal
*copyc pfp$find_cycle_array
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$get_multi_item_info
*copyc pfp$process_unexpected_status
*copyc pfp$report_unexpected_status
*copyc pmp$get_unique_name
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by this module', EJECT ??

  VAR
    p_collected_info_array: [STATIC] pft$p_collected_info_array := NIL;

?? TITLE := '*** PFP$COLLECT_FILE_INFORMATION ***', EJECT ??

*copyc pfh$collect_file_information

  PROCEDURE [XDCL, #GATE] pfp$collect_file_information
    (    path: pft$path;
         file_selections: pft$file_selections;
     VAR selection_id: pft$selection_identifier;
     VAR status: ost$status);

    VAR
      catalog_info_selections: pft$catalog_info_selections,
      close_status: ost$status,
      file_id: amt$file_identifier,
      file_info_selections: pft$file_info_selections,
      group: pft$group,
      local_status: ost$status,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      sequence_pointer: ^SEQ ( * ),
      selection_id_ordinal: pft$selection_id_ordinal;


    PROCEDURE find_free_entry
      (VAR id_ordinal: pft$selection_id_ordinal;
       VAR status: ost$status);

      VAR
        local_id_ordinal: 1 .. pfc$max_selection_id_ordinal + 1;

      IF p_collected_info_array = NIL THEN
        ALLOCATE p_collected_info_array;
        IF p_collected_info_array = NIL THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error, 'Unable to allocate.',
                status);
          RETURN; {----->
        IFEND;

        FOR local_id_ordinal := 1 TO pfc$max_selection_id_ordinal DO
          p_collected_info_array^ [local_id_ordinal].entry_type := pfc$free;
        FOREND;
      IFEND;

      local_id_ordinal := 1;
      WHILE (local_id_ordinal <= pfc$max_selection_id_ordinal) AND
            (p_collected_info_array^ [local_id_ordinal].entry_type = pfc$used) DO
        local_id_ordinal := local_id_ordinal + 1;
      WHILEND;

      IF local_id_ordinal > pfc$max_selection_id_ordinal THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$collection_limit_exceeded, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, pfc$max_selection_id_ordinal, 10, FALSE,
              status);
      ELSE
        id_ordinal := local_id_ordinal;
        status.normal := TRUE;
      IFEND;
    PROCEND find_free_entry;


    local_status.normal := TRUE;

    IF file_selections = $pft$file_selections [] THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$null_file_selections, '', local_status);
    ELSE
      find_free_entry (selection_id_ordinal, local_status);
    IFEND;

    IF local_status.normal THEN
      create_scratch_sequence (sequence_pointer, file_id, local_status);
    IFEND;

    IF local_status.normal THEN
      group.group_type := pfc$public;

      IF pfc$catalog_names IN file_selections THEN
        catalog_info_selections := $pft$catalog_info_selections [pfc$catalog_description];
      ELSE
        catalog_info_selections := $pft$catalog_info_selections [];
      IFEND;

      IF pfc$file_names IN file_selections THEN
        file_info_selections := $pft$file_info_selections [pfc$file_description];
      ELSE
        file_info_selections := $pft$file_info_selections [];
      IFEND;

      IF pfc$cycle_numbers IN file_selections THEN
        file_info_selections := file_info_selections + $pft$file_info_selections
              [pfc$file_description, pfc$file_cycles];
      IFEND;

      pfp$get_multi_item_info (path, group, catalog_info_selections, file_info_selections, sequence_pointer,
            local_status);

      IF local_status.normal THEN
        RESET sequence_pointer;
        pfp$find_next_info_record (sequence_pointer, p_info_record, local_status);
        IF local_status.normal AND (p_info_record = NIL) THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
                'NIL p_info_record returned.', local_status);
        IFEND;
      IFEND;

      IF local_status.normal THEN
        pfp$find_directory_array (p_info_record, p_directory_array, local_status);
        IF local_status.normal AND (p_directory_array = NIL) THEN
          osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$no_records_collected, '', local_status);
        IFEND;
      IFEND;

      IF local_status.normal THEN
        p_collected_info_array^ [selection_id_ordinal].entry_type := pfc$used;
        p_collected_info_array^ [selection_id_ordinal].file_selections := file_selections;
        p_collected_info_array^ [selection_id_ordinal].file_id := file_id;
        p_collected_info_array^ [selection_id_ordinal].p_directory_array := p_directory_array;
        p_collected_info_array^ [selection_id_ordinal].directory_array_index := 0;

        IF pfc$catalog_names IN file_selections THEN
          p_collected_info_array^ [selection_id_ordinal].info_type := pfc$catalog_names;
        ELSE
          p_collected_info_array^ [selection_id_ordinal].info_type := pfc$file_names;
        IFEND;

        IF pfc$cycle_numbers IN file_selections THEN
          p_collected_info_array^ [selection_id_ordinal].cycle_numbers_selected := TRUE;
          p_collected_info_array^ [selection_id_ordinal].p_body := ^p_info_record^.body;
          p_collected_info_array^ [selection_id_ordinal].p_cycle_array := NIL;
          p_collected_info_array^ [selection_id_ordinal].cycle_array_index := 0;
        ELSE
          p_collected_info_array^ [selection_id_ordinal].cycle_numbers_selected := FALSE;
        IFEND;

        find_next_info_index (p_collected_info_array^ [selection_id_ordinal], local_status);
      IFEND;

      IF local_status.normal THEN
        selection_id.ordinal := selection_id_ordinal;
        selection_id.sequence := file_id.sequence;
      ELSE
        p_collected_info_array^ [selection_id_ordinal].entry_type := pfc$free;
        amp$close (file_id, close_status);
        pfp$process_unexpected_status (close_status);
      IFEND;
    IFEND;

    status := local_status;

  PROCEND pfp$collect_file_information;
?? TITLE := '*** PFP$GET_NEXT_FILE_SELECTION ***', EJECT ??

*copyc pfh$get_next_file_selection

  PROCEDURE [XDCL, #GATE] pfp$get_next_file_selection
    (    selection_id: pft$selection_identifier;
     VAR selection_record: pft$selection_record;
     VAR selection_position: pft$selection_position;
     VAR status: ost$status);

    VAR
      cycle_array_index: pft$cycle_array_index,
      directory_array_index: pft$directory_array_index,
      local_selection_record: pft$selection_record,
      local_status: ost$status;

    local_status.normal := TRUE;

    verify_selection_id (selection_id, local_status);

    IF local_status.normal AND (p_collected_info_array^ [selection_id.ordinal].selection_position =
          pfc$end_of_information) THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$get_next_at_eoi, '', local_status);
    IFEND;

    IF local_status.normal THEN
      CASE p_collected_info_array^ [selection_id.ordinal].info_type OF
      = pfc$catalog_names =
        directory_array_index := p_collected_info_array^ [selection_id.ordinal].directory_array_index;
        local_selection_record.kind := pfc$catalog_names;
        local_selection_record.catalog_name := p_collected_info_array^ [selection_id.ordinal].
              p_directory_array^ [directory_array_index].name;

      = pfc$file_names =
        directory_array_index := p_collected_info_array^ [selection_id.ordinal].directory_array_index;
        local_selection_record.kind := pfc$file_names;
        local_selection_record.file_name := p_collected_info_array^ [selection_id.ordinal].
              p_directory_array^ [directory_array_index].name;

      = pfc$cycle_numbers =
        cycle_array_index := p_collected_info_array^ [selection_id.ordinal].cycle_array_index;
        local_selection_record.kind := pfc$cycle_numbers;
        local_selection_record.cycle_number := p_collected_info_array^ [selection_id.ordinal].
              p_cycle_array^ [cycle_array_index].cycle_number;

      ELSE
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error, 'Bad info_type.',
              local_status);
      CASEND;
    IFEND;

    IF local_status.normal THEN
      find_next_info_index (p_collected_info_array^ [selection_id.ordinal], local_status);
    IFEND;

    IF local_status.normal THEN
      selection_record := local_selection_record;
      selection_position := p_collected_info_array^ [selection_id.ordinal].selection_position;
    IFEND;

    status := local_status;
  PROCEND pfp$get_next_file_selection;
?? TITLE := '*** PFP$RETURN_FILE_INFORMATION ***', EJECT ??

*copyc pfh$return_file_information

  PROCEDURE [XDCL, #GATE] pfp$return_file_information
    (    selection_id: pft$selection_identifier;
     VAR status: ost$status);

    VAR
      close_status: ost$status,
      local_status: ost$status;

    local_status.normal := TRUE;

    verify_selection_id (selection_id, local_status);

    IF local_status.normal THEN
      amp$close (p_collected_info_array^ [selection_id.ordinal].file_id, close_status);
      pfp$process_unexpected_status (close_status);

      p_collected_info_array^ [selection_id.ordinal].entry_type := pfc$free;
    IFEND;

    status := local_status;

  PROCEND pfp$return_file_information;
?? TITLE := ' *** CREATE_SCRATCH_SEQUENCE  *** ', EJECT ??

  PROCEDURE create_scratch_sequence
    (VAR sequence_pointer: ^SEQ ( * );
     VAR file_identifier: amt$file_identifier;
     VAR status: ost$status);

{  The purpose of this procedure is to create a scratch sequence.
{  The file containing the sequence is returned when the file is closed.

    VAR
      file_attribute: array [1 .. 1] of amt$access_selection,
      file_name: amt$local_file_name,
      segment_pointer: amt$segment_pointer;

    pmp$get_unique_name (file_name, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    file_attribute [1].key := amc$return_option;
    file_attribute [1].return_option := amc$return_at_close;
    amp$open (file_name, amc$segment, ^file_attribute, file_identifier, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    RESET segment_pointer.sequence_pointer;
    sequence_pointer := segment_pointer.sequence_pointer;
  PROCEND create_scratch_sequence;
?? TITLE := '*** FIND_NEXT_INFO_INDEX ***', EJECT ??

  PROCEDURE find_next_info_index
    (VAR collected_info: pft$collected_info_entry;
     VAR status: ost$status);

    VAR
      directory_array_index: pft$directory_array_index,
      info_type: pft$file_information,
      name_type: pft$name_type,
      p_cycle_array: pft$p_cycle_array,
      p_info_record: pft$p_info_record,
      upper_info_type: pft$file_information;

    directory_array_index := collected_info.directory_array_index;

    IF collected_info.cycle_numbers_selected AND (collected_info.cycle_array_index = 0) AND
          (collected_info.info_type = pfc$file_names) AND (directory_array_index <> 0) THEN
      pfp$find_direct_info_record (collected_info.p_body, collected_info.
            p_directory_array^ [directory_array_index].info_offset, p_info_record, status);
      IF NOT status.normal THEN
        pfp$report_unexpected_status (status);
        RETURN; {----->
      ELSEIF p_info_record = NIL THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
              'NIL p_info_record returned.', status);
        RETURN; {----->
      IFEND;

      pfp$find_cycle_array (p_info_record, p_cycle_array, status);
      IF NOT status.normal THEN
        pfp$report_unexpected_status (status);
        RETURN; {----->
      ELSEIF p_cycle_array = NIL THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$pf_system_error,
              'NIL p_cycle_array returned.', status);
        RETURN; {----->
      IFEND;

      collected_info.info_type := pfc$cycle_numbers;
      collected_info.p_cycle_array := p_cycle_array;
    IFEND;

    status.normal := TRUE;

    IF collected_info.info_type = pfc$cycle_numbers THEN
      IF collected_info.cycle_array_index = UPPERBOUND (collected_info.p_cycle_array^) THEN
        collected_info.info_type := pfc$file_names;
        collected_info.p_cycle_array := NIL;
        collected_info.cycle_array_index := 0;
      ELSE
        collected_info.cycle_array_index := collected_info.cycle_array_index + 1;
        RETURN; {----->
      IFEND;
    IFEND;

    IF collected_info.file_selections = $pft$file_selections [pfc$catalog_names] THEN
      upper_info_type := pfc$catalog_names;
    ELSE
      upper_info_type := pfc$file_names;
    IFEND;

    FOR info_type := collected_info.info_type TO upper_info_type DO
      FOR directory_array_index := directory_array_index + 1 TO
            UPPERBOUND (collected_info.p_directory_array^) DO
        name_type := collected_info.p_directory_array^ [directory_array_index].name_type;
        IF ((name_type = pfc$catalog_name) AND (info_type = pfc$catalog_names)) OR
              ((name_type = pfc$file_name) AND (info_type = pfc$file_names)) THEN
          collected_info.directory_array_index := directory_array_index;
          collected_info.info_type := info_type;
          collected_info.selection_position := pfc$end_of_record;
          RETURN; {----->
        IFEND;
      FOREND;

      directory_array_index := 0;
    FOREND;

    collected_info.selection_position := pfc$end_of_information;
  PROCEND find_next_info_index;
?? TITLE := '*** VERIFY_SELECTION_ID ***', EJECT ??

  PROCEDURE verify_selection_id
    (    selection_id: pft$selection_identifier;
     VAR status: ost$status);

    IF (selection_id.ordinal < 1) OR (pfc$max_selection_id_ordinal < selection_id.ordinal) OR
          (p_collected_info_array = NIL) OR (p_collected_info_array^ [selection_id.ordinal].entry_type =
          pfc$free) OR (selection_id.sequence <> p_collected_info_array^ [selection_id.ordinal].file_id.
          sequence) THEN
      osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$improper_selection_id, '', status);
    ELSE
      status.normal := TRUE;
    IFEND;
  PROCEND verify_selection_id;
?? SKIP := 4 ??
MODEND pfm$catalog_access;
