?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := ' NOS/VE Backup/Restore Utilities:  backup_file_output ', EJECT ??
MODULE pum$backup_file_output;
{PURPOSE:
{     This module contains procedures required to produce the
{  physical BACKUP copies.

?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pus$literals
*copyc pud$backup_file
*copyc pud$hierarchy_list
*copyc pue$error_condition_codes
*copyc ost$caller_identifier
*copyc put$file_identifier
*copyc stt$set_name
?? POP ??
*copyc amp$close
*copyc amp$get_file_attributes
*copyc mmp$close_segment
*copyc osp$append_status_integer
*copyc osp$set_status_abnormal
*copyc pfp$open_file_segment
*copyc pup$advised_put_next
*copyc pup$allow_job_termination
*copyc pup$display_blank_lines
*copyc pup$display_integer
*copyc pup$display_line
*copyc pup$open_file_for_seg_access
*copyc pup$put_next
*copyc pup$put_partial
*copyc pup$write_logical_partition
*copyc pup$write_status_to_listing
*copyc pfv$reserved_cycle_info
*copyc puv$bacpf_backup_file_version
*copyc puv$exclude_catalog_information
*copyc puv$global_backup_file_id
*copyc puv$read_data_on_null_bf
*copyc puv$trace_selected
?? TITLE := '    Global Variables', EJECT ??
?? TITLE := '    [XDCL] pup$abort_output ', EJECT ??

  PROCEDURE [XDCL] pup$abort_output
    (    pf_utility_entry: put$entry;
     VAR pf_backup_file_id: put$file_identifier;
         bad_status: ost$status;
     VAR status: ost$status);

    pup$write_status_to_listing (pf_utility_entry, bad_status, status);
    IF puv$global_backup_file_id.backup_file_open THEN
      pup$write_logical_partition (pf_backup_file_id, status);
    IFEND;
  PROCEND pup$abort_output;

?? TITLE := '    [XDCL] pup$output_catalog ', EJECT ??

  PROCEDURE [XDCL] pup$output_catalog (catalog_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
        info: put$backup_item_info;
        pf_utility_hierarchy_list: put$hierarchy_list;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    IF (pf_backup_file_id.device_class = rmc$null_device) OR puv$exclude_catalog_information THEN
      pup$allow_job_termination;
      status.normal := TRUE;
      RETURN;
    IFEND;

    output_backup_version_name (pf_backup_file_id, status);
    IF status.normal THEN
      output_backup_item_path (catalog_entry, pf_utility_catalog_header, pf_backup_file_id, status);
      IF status.normal THEN
        output_item_info (catalog_entry, info, pf_backup_file_id, status);
        IF status.normal THEN
          output_hierarchy_list (pf_utility_hierarchy_list, pf_backup_file_id, status);
          IF status.normal THEN
            pup$write_logical_partition (pf_backup_file_id, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$output_catalog;

?? TITLE := '    [XDCL] pup$output_cycle ', EJECT ??

  PROCEDURE [XDCL] pup$output_cycle (lfn: amt$local_file_name;
        cycle_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
        cycle_info: put$backup_item_info;
        cycle_array_entry: pft$cycle_array_entry_version_2;
        cycle_label_exists: boolean;
        cycle_label: SEQ ( * );
        pf_utility_hierarchy_list: put$hierarchy_list;
        cycle_length: amt$file_length;
        data_exists: boolean;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    VAR
      pfid: amt$file_identifier;

    IF (pf_backup_file_id.device_class = rmc$null_device) AND NOT puv$read_data_on_null_bf THEN
      pup$allow_job_termination;
      status.normal := TRUE;
      RETURN;
    IFEND;

    output_backup_version_name (pf_backup_file_id, status);
    IF status.normal THEN
      output_backup_item_path (cycle_entry, pf_utility_catalog_header, pf_backup_file_id, status);
      IF status.normal THEN
        output_item_info (cycle_entry, cycle_info, pf_backup_file_id, status);
        IF status.normal THEN
          pup$output_system_label (cycle_label_exists, cycle_label, pf_backup_file_id, status);
          IF status.normal THEN
            output_hierarchy_list (pf_utility_hierarchy_list, pf_backup_file_id, status);
            IF data_exists AND status.normal THEN
              output_cycle_data (lfn, cycle_array_entry, cycle_length, pf_backup_file_id, status);
            IFEND;
            IF status.normal THEN
              pup$write_logical_partition (pf_backup_file_id, status);
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$output_cycle;

?? TITLE := '    [XDCL] pup$output_family ', EJECT ??

  PROCEDURE [XDCL] pup$output_family (family_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
        info: put$backup_item_info;
        pf_utility_hierarchy_list: put$hierarchy_list;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);


    IF (pf_backup_file_id.device_class = rmc$null_device) OR puv$exclude_catalog_information THEN
      pup$allow_job_termination;
      status.normal := TRUE;
      RETURN;
    IFEND;

    output_backup_version_name (pf_backup_file_id, status);
    IF status.normal THEN
      output_backup_item_path (family_entry, pf_utility_catalog_header, pf_backup_file_id, status);
      IF status.normal THEN
        output_item_info (family_entry, info, pf_backup_file_id, status);
        IF status.normal THEN
          output_hierarchy_list (pf_utility_hierarchy_list, pf_backup_file_id, status);
          IF status.normal THEN
            pup$write_logical_partition (pf_backup_file_id, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$output_family;

?? TITLE := '    [XDCL] pup$output_file ', EJECT ??

  PROCEDURE [XDCL] pup$output_file (pf_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
        info: put$backup_item_info;
        pf_utility_hierarchy_list: put$hierarchy_list;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);


    IF (pf_backup_file_id.device_class = rmc$null_device) OR puv$exclude_catalog_information THEN
      pup$allow_job_termination;
      status.normal := TRUE;
      RETURN;
    IFEND;

    output_backup_version_name (pf_backup_file_id, status);
    IF status.normal THEN
      output_backup_item_path (pf_entry, pf_utility_catalog_header, pf_backup_file_id, status);
      IF status.normal THEN
        output_item_info (pf_entry, info, pf_backup_file_id, status);
        IF status.normal THEN
          output_hierarchy_list (pf_utility_hierarchy_list, pf_backup_file_id, status);
          IF status.normal THEN
            pup$write_logical_partition (pf_backup_file_id, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$output_file;

?? TITLE := '    [XDCL] pup$output_set ', EJECT ??

  PROCEDURE [XDCL] pup$output_set (set_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
        info: put$backup_item_info;
        pf_utility_hierarchy_list: put$hierarchy_list;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);


    IF (pf_backup_file_id.device_class = rmc$null_device) OR puv$exclude_catalog_information THEN
      pup$allow_job_termination;
      status.normal := TRUE;
      RETURN;
    IFEND;

    output_backup_version_name (pf_backup_file_id, status);
    IF status.normal THEN
      output_backup_item_path (set_entry, pf_utility_catalog_header, pf_backup_file_id, status);
      IF status.normal THEN
        output_item_info (set_entry, info, pf_backup_file_id, status);
        IF status.normal THEN
          output_hierarchy_list (pf_utility_hierarchy_list, pf_backup_file_id, status);
          IF status.normal THEN
            pup$write_logical_partition (pf_backup_file_id, status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$output_set;

?? TITLE := '    pup$output_system_label ', EJECT ??

  PROCEDURE pup$output_system_label (label_exists: boolean;
        label: SEQ ( * );
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    VAR
      record_header: put$backup_file_record_header;

    record_header.kind := puc$backup_system_label;
    IF label_exists THEN
      record_header.size := #SIZE (label);
      pup$put_partial (pf_backup_file_id, ^record_header, #SIZE (record_header), amc$start, status);
      IF status.normal THEN
        pup$put_partial (pf_backup_file_id, ^label, #SIZE (label), amc$terminate, status);
      IFEND;
    ELSE
      record_header.size := 0;
      pup$put_next (pf_backup_file_id, ^record_header, #SIZE (record_header), status);
    IFEND;
  PROCEND pup$output_system_label;

?? TITLE := ' open_reserved_cycle ', EJECT ??

  PROCEDURE open_reserved_cycle
    (    system_file_id: gft$system_file_identifier;
         caller_id: ost$caller_identifier;
     VAR segment_pointer: mmt$segment_pointer;
     VAR status: ost$status);

    display (' pfp$open_file_segment');
    pfp$open_file_segment (system_file_id, caller_id.ring, segment_pointer, status);
    RESET segment_pointer.seq_pointer;

  PROCEND open_reserved_cycle;

?? TITLE := '    output_backup_item_path ', EJECT ??

  PROCEDURE output_backup_item_path
   (    pf_utility_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    VAR
      p_backup_file_item_path: ^put$backup_file_item_path;

    PUSH p_backup_file_item_path: [LOWERBOUND (pf_utility_catalog_header.path) .. UPPERBOUND
          (pf_utility_catalog_header.path)];

    p_backup_file_item_path^.item_path_descriptor.catalog_header := pf_utility_catalog_header;
    p_backup_file_item_path^.item_path_descriptor.pf_utility_entry := pf_utility_entry;

    p_backup_file_item_path^.item_path_header.kind := puc$backup_item_identifier;
    p_backup_file_item_path^.item_path_header.size := UPPERBOUND (p_backup_file_item_path^.
          item_path_descriptor.catalog_header.path);
    pup$put_next (pf_backup_file_id, p_backup_file_item_path, #SIZE (p_backup_file_item_path^), status);
  PROCEND output_backup_item_path;

?? TITLE := '    output_backup_version_name ', EJECT ??

  PROCEDURE [INLINE] output_backup_version_name (VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    VAR
      backup_version_name: put$backup_file_version_name;

    backup_version_name := puv$bacpf_backup_file_version;
    pup$put_next (pf_backup_file_id, ^backup_version_name, #SIZE (backup_version_name), status);
  PROCEND output_backup_version_name;

?? TITLE := '    output_cycle_data ', EJECT ??

  PROCEDURE output_cycle_data (lfn: amt$local_file_name;
        cycle_array_entry: pft$cycle_array_entry_version_2;
        file_length: amt$file_length;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      file_segment_pointer: mmt$segment_pointer,
      local_status: ost$status,
      p_backup_file_item_header: ^put$backup_file_record_header,
      user_file_id: amt$file_identifier;

    PUSH p_backup_file_item_header;
    p_backup_file_item_header^.kind := puc$backup_cycle_data;
    p_backup_file_item_header^.size := file_length;
    IF p_backup_file_item_header^.size = 0 THEN
      pup$put_next (pf_backup_file_id, p_backup_file_item_header, #SIZE (p_backup_file_item_header^), status);
    ELSE
      pup$put_next (pf_backup_file_id, p_backup_file_item_header, #SIZE (p_backup_file_item_header^), status);
      IF status.normal THEN
        #CALLER_ID (caller_id);
        IF cycle_array_entry.cycle_reservation.cycle_reserved THEN
          open_reserved_cycle (pfv$reserved_cycle_info.p_reserved_cycles^
                [cycle_array_entry.cycle_reservation.reserved_cycle_index].system_file_id, caller_id,
                file_segment_pointer, status);
        ELSE
          pup$open_file_for_seg_access (lfn, file_segment_pointer, status);
        IFEND;
        IF status.normal THEN
          pup$advised_put_next (pf_backup_file_id, file_segment_pointer.seq_pointer, file_length,
                status);
          mmp$close_segment (file_segment_pointer, caller_id.ring, local_status);
          IF status.normal AND NOT local_status.normal THEN
            status := local_status;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND output_cycle_data;

?? TITLE := '    output_hierarchy_list ', EJECT ??

  PROCEDURE output_hierarchy_list (pf_utility_hierarchy_list: put$hierarchy_list;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);

    VAR
      p_hierarchy_list_record: ^put$backup_file_hierarchy_list;

    PUSH p_hierarchy_list_record: [LOWERBOUND (pf_utility_hierarchy_list.catalog_header.path) .. UPPERBOUND
          (pf_utility_hierarchy_list.catalog_header.path)];

    p_hierarchy_list_record^.hierarchy_list_header.kind := puc$backup_hierarchy_list;
    p_hierarchy_list_record^.hierarchy_list_header.size := UPPERBOUND (pf_utility_hierarchy_list.
          catalog_header.path);
    p_hierarchy_list_record^.hierarchy_list := pf_utility_hierarchy_list;
    pup$put_next (pf_backup_file_id, p_hierarchy_list_record, #SIZE (p_hierarchy_list_record^), status);
  PROCEND output_hierarchy_list;

?? TITLE := '    output_item_info ', EJECT ??

  PROCEDURE output_item_info (pfu_entry: put$entry;
        info: put$backup_item_info;
    VAR pf_backup_file_id: put$file_identifier;
    VAR status: ost$status);


{    The size field in the record header for the item_record (pf_entry,
{  catalog_entry , family_entry, AND set_entry should be the size
{  of the adaptable sequence part of the info record.

    VAR
      p_backup_file_record_header: ^put$backup_file_record_header;

    PUSH p_backup_file_record_header;
    CASE pfu_entry.entry_type OF
    = puc$valid_cycle_entry =
      p_backup_file_record_header^.kind := puc$backup_cycle_info;
      p_backup_file_record_header^.size := info.cycle_item_info.body_size;
      pup$put_partial (pf_backup_file_id, p_backup_file_record_header, #SIZE (p_backup_file_record_header^),
            amc$start, status);
      IF status.normal THEN
        pup$put_partial (pf_backup_file_id, info.cycle_item_info.body, info.cycle_item_info.body_size,
              amc$terminate, status);
      IFEND;
    = puc$valid_pf_entry =
      p_backup_file_record_header^.kind := puc$backup_file_info;
      p_backup_file_record_header^.size := (info.file_item_info^.body_size);
      pup$put_partial (pf_backup_file_id, p_backup_file_record_header, #SIZE (p_backup_file_record_header^),
            amc$start, status);
      IF status.normal THEN
        pup$put_partial (pf_backup_file_id, info.file_item_info, #SIZE (info.file_item_info^), amc$terminate,
              status);
      IFEND;
    = puc$valid_catalog_entry =
      {output catalog info
      p_backup_file_record_header^.kind := puc$backup_catalog_info;
      p_backup_file_record_header^.size := (info.catalog_item_info^.body_size);
      pup$put_partial (pf_backup_file_id, p_backup_file_record_header, #SIZE (p_backup_file_record_header^),
            amc$start, status);
      IF status.normal THEN
        pup$put_partial (pf_backup_file_id, info.catalog_item_info, #SIZE (info.catalog_item_info^),
              amc$terminate, status);
      IFEND;
    = puc$valid_family_entry =
      p_backup_file_record_header^.kind := puc$backup_family_info;
      p_backup_file_record_header^.size := (info.family_item_info^.body_size);
      pup$put_partial (pf_backup_file_id, p_backup_file_record_header, #SIZE (p_backup_file_record_header^),
            amc$start, status);
      IF status.normal THEN
        pup$put_partial (pf_backup_file_id, info.family_item_info, #SIZE (info.family_item_info^),
              amc$terminate, status);
      IFEND;
    = puc$valid_set_entry =
      p_backup_file_record_header^.kind := puc$backup_set_info;
      p_backup_file_record_header^.size := (info.set_item_info^.body_size);
      pup$put_partial (pf_backup_file_id, p_backup_file_record_header, #SIZE (p_backup_file_record_header^),
            amc$start, status);
      IF status.normal THEN
        pup$put_partial (pf_backup_file_id, info.set_item_info, #SIZE (info.set_item_info^), amc$terminate,
              status);
      IFEND;
    ELSE
    CASEND;
  PROCEND output_item_info;

MODEND pum$backup_file_output;
