?? NEWTITLE := ' NOS/VE Backup/Restore Utilities:  backup_set ', EJECT ??
MODULE pum$backup_set;
?? RIGHT := 110 ??

{PURPOSE:
{  This module contains the procedures which produce a BACKUP copy of a specified set as well as a
{  BACKUP copy of each family, catalog,file, and cycle registered in the set.

?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pud$backup_file
*copyc pud$hierarchy_list
*copyc amt$local_file_name
*copyc clt$file
*copyc ost$status
*copyc ost$string
*copyc ost$user_identification
*copyc put$file_identifier
*copyc put$user_range_list
*copyc stt$set_name
?? POP ??
*copyc clp$evaluate_parameters
*copyc clp$get_value
*copyc clp$scan_command_line
*copyc clp$scan_parameter_list
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$get_family_info
*copyc pfp$get_family_item_info
*copyc pfp$get_family_set
*copyc pfp$get_master_catalog_info
*copyc pfp$get_set_list
*copyc pup$abort_output
*copyc pup$backup_catalog
*copyc pup$build_catalog_header
*copyc pup$build_entry
*copyc pup$build_hierarchy_list
*copyc pup$build_new_catalog_header
*copyc pup$check_if_item_excluded
*copyc pup$crack_boolean
*copyc pup$crack_user_range_list
*copyc pup$display_backup_output_total
*copyc pup$display_blank_lines
*copyc pup$display_excluded_item
*copyc pup$display_line
*copyc pup$get_status_severity
*copyc pup$get_summary_status
*copyc pup$initialize_backup_listing
*copyc pup$output_family
*copyc pup$output_set
*copyc pup$sort_directory
*copyc pup$verify_catalog_path
*copyc pup$verify_family_administrator
*copyc pup$verify_system_administrator
*copyc pup$write_catalog_header
*copyc pup$write_os_status
*copyc pup$write_path
*copyc pup$write_status_to_listing
*copyc puv$backup_file_id
*copyc puv$backup_information
*copyc puv$global_backup_file_id
?? TITLE := '    Global Variables', EJECT ??

  VAR
    user_range_list_container: [STATIC] put$user_range_list_container,

    puv$p_user_range_list: [XDCL] ^put$user_range_list := NIL;

  VAR
    puv$sort_users: [XDCL] boolean := FALSE;

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

  PROCEDURE [XDCL] pup$backup_all_files_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE backup_all_files (
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 5, 13, 13, 22, 4, 27],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$status = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      local_status: ost$status;

    pup$verify_system_administrator ('BACKUP_ALL_FILES               ', puv$p_user_range_list, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pup$display_line (' BACKUP ALL FILES: ', status);
    pup$backup_all_files_request (puv$backup_file_id, status);

  PROCEND pup$backup_all_files_command;
?? TITLE := '    [XDCL] pup$backup_set_command ', EJECT ??

  PROCEDURE [XDCL] pup$backup_set_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE backup_all_files (
{   set_name, sn: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 5, 13, 13, 23, 17, 254],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['SET_NAME                       ',clc$nominal_entry, 1],
    ['SN                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$set_name = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      dummy_cycle_selector: pft$cycle_selector,
      local_status: ost$status,
      p_hierarchy_list: ^put$hierarchy_list,
      set_entry: put$entry,
      set_name: stt$set_name,
      str: string (80),
      strl: integer,
      value: clt$value;

    pup$verify_system_administrator ('BACKUP_SET                     ', puv$p_user_range_list, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    set_name := pvt [p$set_name].value^.name_value;

    pup$build_entry (set_name, dummy_cycle_selector, puc$valid_set_entry, set_entry);
    PUSH p_hierarchy_list: [1 .. 1];
    pup$build_catalog_header (set_name, NIL, p_hierarchy_list^.catalog_header);
    pup$build_hierarchy_list (set_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^, status);
    IF status.normal THEN
      pup$initialize_backup_listing (p_hierarchy_list^, puv$backup_file_id, puv$backup_information, status);
      STRINGREP (str, strl, ' BACKUP SET: ', set_name);
      pup$display_line (str (1, strl), status);
      pup$backup_set_request (set_entry, p_hierarchy_list, puv$backup_file_id, status);
      pup$display_backup_output_total;
      pup$get_summary_status (status);
      pup$write_os_status (status, local_status);
    IFEND;

  PROCEND pup$backup_set_command;

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

  PROCEDURE pup$backup_all_files_request
    (VAR backup_file_id: put$file_identifier;
     VAR status: ost$status);

    VAR
      cset: stt$number_of_sets,
      dummy_cycle_selector: pft$cycle_selector,
      local_status: ost$status,
      number_of_sets: stt$number_of_sets,
      p_hierarchy_list: ^put$hierarchy_list,
      set_entry: put$entry,
      set_list: ^stt$set_list,
      set_name: stt$set_name,
      str: string (80),
      strl: integer;

    number_of_sets := 20;
    FOR cset := 1 TO 2 DO
      PUSH set_list: [1 .. number_of_sets];
      pfp$get_set_list (set_list^, number_of_sets, status);
    FOREND;
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    set_name := set_list^ [1];
    pup$build_entry (set_name, dummy_cycle_selector, puc$valid_set_entry, set_entry);
    PUSH p_hierarchy_list: [1 .. 1];
    pup$build_catalog_header (set_name, NIL, p_hierarchy_list^.catalog_header);
    pup$build_hierarchy_list (set_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^, status);
    IF status.normal THEN
      pup$initialize_backup_listing (p_hierarchy_list^, puv$backup_file_id, puv$backup_information, status);
      FOR cset := 1 TO number_of_sets DO
        STRINGREP (str, strl, ' BACKUP SET: ', set_list^ [cset]);
        pup$display_line (str (1, strl), status);
        set_name := set_list^ [cset];
        pup$build_entry (set_name, dummy_cycle_selector, puc$valid_set_entry, set_entry);
        pup$build_catalog_header (set_name, NIL, p_hierarchy_list^.catalog_header);
        pup$build_hierarchy_list (set_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^, status);
        pup$backup_set_request (set_entry, p_hierarchy_list, backup_file_id, status);
      FOREND;
      pup$display_backup_output_total;
      pup$get_summary_status (status);
      pup$write_os_status (status, local_status);
    IFEND;

  PROCEND pup$backup_all_files_request;

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

  PROCEDURE pup$backup_family
    (    family_entry: put$entry;
         pf_utility_catalog_header: put$catalog_header;
         pf_utility_hierarchy_list: put$hierarchy_list;
     VAR pf_backup_file_id: put$file_identifier;
     VAR family_item_info: pft$p_info_record;
     VAR family_content_info: pft$p_info_record;
     VAR status: ost$status);

    VAR
      backup_item_info: put$backup_item_info,
      catalog_entry: put$entry,
      cycle_selector: pft$cycle_selector,
      i: put$half_integer,
      local_status: ost$status,
      p_body: pft$p_info,
      p_item_record: pft$p_info_record,
      p_master_catalog_directory: pft$p_directory_array,
      p_new_catalog_header: ^put$catalog_header,
      status_severity: put$status_severity,
      user_excluded: boolean,
      user_in_range: boolean;

    pup$display_blank_lines (5, status);
    pup$write_catalog_header (pf_utility_catalog_header, status);
    backup_item_info.item_type := puc$backup_item_family_info;
    backup_item_info.family_item_info := family_item_info;
    pup$output_family (family_entry, pf_utility_catalog_header, backup_item_info, pf_utility_hierarchy_list,
          pf_backup_file_id, status);
    IF NOT status.normal THEN
      pup$abort_output (family_entry, pf_backup_file_id, status, local_status);
      RETURN; {----->
    IFEND;
    pfp$find_directory_array (family_content_info, p_master_catalog_directory, status);
    IF status.normal AND (p_master_catalog_directory <> NIL) THEN
      IF puv$sort_users THEN
        pup$sort_directory (p_master_catalog_directory^, p_master_catalog_directory^);
      IFEND;
      PUSH p_new_catalog_header: [LOWERBOUND (pf_utility_catalog_header.
            path) .. (UPPERBOUND (pf_utility_catalog_header.path) + 1)];
      FOR i := LOWERBOUND (p_master_catalog_directory^) TO UPPERBOUND (p_master_catalog_directory^) DO
        pup$check_if_user_in_range (family_entry.family_name, p_master_catalog_directory^ [i].name,
              user_in_range);
        IF user_in_range THEN
          pup$build_entry (p_master_catalog_directory^ [i].name, cycle_selector, puc$valid_catalog_entry,
                catalog_entry);
          pup$build_new_catalog_header (catalog_entry, pf_utility_catalog_header, p_new_catalog_header^);
          pup$check_if_item_excluded (catalog_entry, p_new_catalog_header^, user_excluded);
          IF user_excluded THEN
            pup$display_excluded_item (catalog_entry, p_new_catalog_header^, status);
          ELSE
            p_body := ^family_content_info^.body;
            pfp$find_direct_info_record (p_body, p_master_catalog_directory^ [i].info_offset, p_item_record,
                  status);
            IF status.normal THEN
              pup$backup_catalog (catalog_entry, p_new_catalog_header^, p_item_record,
                    pf_utility_hierarchy_list, pf_backup_file_id, status);
            IFEND;
            pup$write_status_to_listing (catalog_entry, status, local_status);
            IF NOT puv$global_backup_file_id.backup_file_open THEN
              {
              { pup$backup_catalog encountered an error writing to the backup_file and closed it.
              { Return the abnormal status to the caller.
              {
              RETURN; {----->
            IFEND;
            status.normal := TRUE;
          IFEND;
        IFEND;
      FOREND;
    IFEND;
  PROCEND pup$backup_family;

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

  PROCEDURE [XDCL] pup$backup_family_request
    (    set_name: stt$set_name;
         family_name: pft$name;
     VAR pf_backup_file_id: put$file_identifier;
     VAR status: ost$status);


    VAR
      backup_item_info: put$backup_item_info,
      dummy_cycle_selector: pft$cycle_selector,
      family_entry: put$entry,
      family_info: amt$segment_pointer,
      family_path: array [1 .. 1] of pft$name,
      local_set_name: stt$set_name,
      local_status: ost$status,
      master_catalog_info: amt$segment_pointer,
      p_body: pft$p_info,
      p_family_content: pft$p_info_record,
      p_family_directory: pft$p_directory_array,
      p_family_info: pft$p_info_record,
      p_hierarchy_list: ^put$hierarchy_list,
      p_info_record: pft$p_info_record;

    status.normal := TRUE;
    local_status.normal := TRUE;
    pup$build_entry (family_name, dummy_cycle_selector, puc$valid_family_entry, family_entry);
    family_path [1] := family_name;
    PUSH p_hierarchy_list: [1 .. 1];
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, family_info, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    RESET family_info.sequence_pointer;
    pfp$get_family_item_info (family_name, -$pft$catalog_info_selections [], local_set_name,
          family_info.sequence_pointer, status);
    IF status.normal THEN
      pup$build_catalog_header (local_set_name, ^family_path, p_hierarchy_list^.catalog_header);
      pup$build_hierarchy_list (family_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^, status);
      IF status.normal THEN
        RESET family_info.sequence_pointer;
        pfp$find_next_info_record (family_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          pup$initialize_backup_listing (p_hierarchy_list^, pf_backup_file_id, puv$backup_information,
                status);
          IF status.normal THEN
            pfp$find_directory_array (p_info_record, p_family_directory, status);
            p_body := ^p_info_record^.body;
            IF status.normal AND (p_family_directory <> NIL) THEN
              pfp$find_direct_info_record (p_body, p_family_directory^ [1].info_offset, p_family_info,
                    status);
              IF status.normal THEN
                mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, master_catalog_info, status);
              IFEND;
              IF status.normal THEN
                RESET master_catalog_info.sequence_pointer;
                pfp$get_master_catalog_info (local_set_name, family_name, -$pft$catalog_info_selections [],
                      master_catalog_info.sequence_pointer, status);
                IF status.normal THEN
                  RESET master_catalog_info.sequence_pointer;
                  pfp$find_next_info_record (master_catalog_info.sequence_pointer, p_family_content, status);
                  IF status.normal THEN
                    pup$backup_family (family_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^,
                          pf_backup_file_id, p_family_info, p_family_content, status);
                  IFEND;
                IFEND;
                mmp$delete_scratch_segment (master_catalog_info, local_status);
              IFEND;
            IFEND;
            pup$display_backup_output_total;
            pup$get_summary_status (status);
            pup$write_os_status (status, local_status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
    mmp$delete_scratch_segment (family_info, local_status);
  PROCEND pup$backup_family_request;
?? TITLE := '    pup$backup_set ', EJECT ??

  PROCEDURE pup$backup_set
    (    set_entry: put$entry;
         pf_utility_catalog_header: put$catalog_header;
         pf_utility_hierarchy_list: put$hierarchy_list;
     VAR pf_backup_file_id: put$file_identifier;
     VAR set_item_info: pft$p_info_record;
     VAR status: ost$status);

    VAR
      backup_item_info: put$backup_item_info,
      cycle_selector: pft$cycle_selector,
      family_entry: put$entry,
      family_excluded: boolean,
      family_in_range: boolean,
      i: put$half_integer,
      local_status: ost$status,
      master_catalog_info: amt$segment_pointer,
      p_body: pft$p_info,
      p_family_content: pft$p_info_record,
      p_family_directory: pft$p_directory_array,
      p_family_info: pft$p_info_record,
      p_new_catalog_header: ^put$catalog_header,
      set_name: stt$set_name,
      status_severity: put$status_severity;

    backup_item_info.item_type := puc$backup_item_set_info;
    backup_item_info.set_item_info := set_item_info;
    pup$output_set (set_entry, pf_utility_catalog_header, backup_item_info, pf_utility_hierarchy_list,
          pf_backup_file_id, status);
    IF NOT status.normal THEN
      pup$abort_output (set_entry, pf_backup_file_id, status, local_status);
      RETURN; {----->
    IFEND;
    pfp$find_directory_array (set_item_info, p_family_directory, status);
    IF status.normal AND (p_family_directory <> NIL) THEN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, master_catalog_info, status);
      IF status.normal THEN
        PUSH p_new_catalog_header: [LOWERBOUND (pf_utility_catalog_header.
              path) .. UPPERBOUND (pf_utility_catalog_header.path)];

        p_body := ^set_item_info^.body;

      /loop_through_families/
        FOR i := LOWERBOUND (p_family_directory^) TO UPPERBOUND (p_family_directory^) DO
          pfp$get_family_set (p_family_directory^ [i].name, set_name, status);
          IF set_name <> set_entry.set_name THEN
            CYCLE /loop_through_families/; {----->
          IFEND;
          pup$check_if_family_in_range (p_family_directory^ [i].name, family_in_range);
          IF family_in_range THEN
            pup$build_entry (p_family_directory^ [i].name, cycle_selector, puc$valid_family_entry,
                  family_entry);
            pup$build_new_catalog_header (family_entry, pf_utility_catalog_header, p_new_catalog_header^);
            pup$check_if_item_excluded (family_entry, p_new_catalog_header^, family_excluded);
            IF family_excluded THEN
              pup$display_excluded_item (family_entry, p_new_catalog_header^, status);
            ELSE
              pfp$find_direct_info_record (p_body, p_family_directory^ [i].info_offset, p_family_info,
                    status);
              IF status.normal THEN
                RESET master_catalog_info.sequence_pointer;
                pfp$get_master_catalog_info (set_entry.set_name, p_family_directory^ [i].name,
                      -$pft$catalog_info_selections [], master_catalog_info.sequence_pointer, status);
              IFEND;
              IF status.normal THEN
                RESET master_catalog_info.sequence_pointer;
                pfp$find_next_info_record (master_catalog_info.sequence_pointer, p_family_content, status);
                IF status.normal THEN
                  pup$backup_family (family_entry, p_new_catalog_header^, pf_utility_hierarchy_list,
                        pf_backup_file_id, p_family_info, p_family_content, status);
                IFEND;
              IFEND;
              pup$write_status_to_listing (family_entry, status, local_status);
              IF NOT puv$global_backup_file_id.backup_file_open THEN
                {
                { pup$backup_catalog encountered an error writing to the backup_file and closed it.
                { Return the abnormal status to the caller.
                {
                EXIT /loop_through_families/; {----->
              IFEND;
              status.normal := TRUE;
            IFEND;
          IFEND;
        FOREND /loop_through_families/;
        mmp$delete_scratch_segment (master_catalog_info, local_status);
      IFEND;
    IFEND;
  PROCEND pup$backup_set;

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

  PROCEDURE pup$backup_set_request
    (    set_entry: put$entry;
         p_hierarchy_list: ^put$hierarchy_list;
     VAR pf_backup_file_id: put$file_identifier;
     VAR status: ost$status);


    VAR
      family_info: amt$segment_pointer,
      local_status: ost$status,
      p_info_record: pft$p_info_record;

    status.normal := TRUE;
    local_status.normal := TRUE;
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, family_info, status);
    IF status.normal THEN
      RESET family_info.sequence_pointer;
      pfp$get_family_info (set_entry.set_name, -$pft$catalog_info_selections [], family_info.sequence_pointer,
            status);
      IF status.normal THEN
        RESET family_info.sequence_pointer;
        pfp$find_next_info_record (family_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          IF status.normal THEN
            pup$backup_set (set_entry, p_hierarchy_list^.catalog_header, p_hierarchy_list^, pf_backup_file_id,
                  p_info_record, status);
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (family_info, local_status);
    IFEND;

  PROCEND pup$backup_set_request;
?? TITLE := '    [XDCL] pup$check_if_family_in_range ', EJECT ??

  PROCEDURE [XDCL] pup$check_if_family_in_range
    (    family_name: pft$name;
     VAR family_in_range: boolean);

    VAR
      user_range_index: integer;

    family_in_range := FALSE;
    IF puv$p_user_range_list = NIL THEN
      family_in_range := TRUE;
    ELSE
      FOR user_range_index := 1 TO UPPERBOUND (puv$p_user_range_list^) DO
        IF (family_name >= puv$p_user_range_list^ [user_range_index] [clc$low] [pfc$family_name_index]) AND
              (family_name <= puv$p_user_range_list^ [user_range_index] [clc$high] [pfc$family_name_index])
              THEN
          family_in_range := TRUE;
          RETURN; {----->
        IFEND;
      FOREND;
    IFEND;
  PROCEND pup$check_if_family_in_range;

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

  PROCEDURE [XDCL] pup$check_if_user_in_range
    (    family_name: pft$name;
         user_name: pft$name;
     VAR user_in_range: boolean);

    VAR
      user_range_index: integer;

    user_in_range := FALSE;
    IF puv$p_user_range_list = NIL THEN
      user_in_range := TRUE;
    ELSE
      FOR user_range_index := 1 TO UPPERBOUND (puv$p_user_range_list^) DO
        IF (family_name >= puv$p_user_range_list^ [user_range_index] [clc$low] [pfc$family_name_index]) AND
              (family_name <= puv$p_user_range_list^ [user_range_index] [clc$high] [pfc$family_name_index])
              THEN
          IF (user_name >= puv$p_user_range_list^ [user_range_index] [clc$low]
                [pfc$master_catalog_name_index]) AND (user_name <=
                puv$p_user_range_list^ [user_range_index] [clc$high] [pfc$master_catalog_name_index]) THEN
            user_in_range := TRUE;
            RETURN; {----->
          IFEND;
        IFEND;
      FOREND;
    IFEND;

  PROCEND pup$check_if_user_in_range;
?? TITLE := '    [XDCL] pup$display_all_users_command ', EJECT ??

  PROCEDURE [XDCL] pup$display_all_users_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE display_all_users (
{   resolve_users, ru: boolean = true
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 5, 13, 13, 34, 3, 692],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['RESOLVE_USERS                  ',clc$nominal_entry, 1],
    ['RU                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$resolve_users = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      cset: stt$number_of_sets,
      number_of_sets: stt$number_of_sets,
      set_list: ^stt$set_list;

    pup$verify_system_administrator ('DISPLAY_ALL_USERS              ', puv$p_user_range_list, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF pvt [p$resolve_users].value^.boolean_value.value THEN
      number_of_sets := 20;
      FOR cset := 1 TO 2 DO
        PUSH set_list: [1 .. number_of_sets];
        pfp$get_set_list (set_list^, number_of_sets, status);
      FOREND;
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      FOR cset := 1 TO number_of_sets DO
        pup$display_set_request (set_list^ [cset], puv$sort_users, status);
      FOREND;
    ELSE
      display_user_range_list (status);
    IFEND;

  PROCEND pup$display_all_users_command;
?? TITLE := '    [XDCL] pup$display_directives ', EJECT ??

  PROCEDURE [XDCL] pup$display_directives
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE display_directives (
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 5, 13, 13, 20, 31, 518],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$status = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$scan_command_line (' DISPLAY_ALL_USERS FALSE', status);
    pup$write_os_status (status, status);

    IF puv$sort_users THEN
      pup$display_line (' SORTING USERS ON BACKUP', status);
    ELSE
      pup$display_line (' NOT sorting users ', status);
    IFEND;

    clp$scan_command_line (' DISPLAY_EXCLUDED_ITEMS ', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' DISPLAY_EXCLUDE_HIGHEST_CYCLES', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' DISPLAY_INCLUDED_CYCLES', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' DISPLAY_INCLUDE_EMPTY_CATALOGS ', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' DISPLAY_INCLUDED_VOLUMES', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' DISPLAY_LIST_OPTIONS', status);
    pup$write_os_status (status, status);

  PROCEND pup$display_directives;
?? TITLE := '    [XDCL] pup$display_set_request ', EJECT ??

  PROCEDURE [XDCL] pup$display_set_request
    (    set_name: stt$set_name;
         sort_users: boolean;
     VAR status: ost$status);

    VAR
      family_in_range: boolean,
      family_info: amt$segment_pointer,
      i: put$half_integer,
      local_status: ost$status,
      p_family_directory: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      p_sorted_directory: pft$p_directory_array;

    status.normal := TRUE;
    local_status.normal := TRUE;
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, family_info, status);
    IF status.normal THEN
      RESET family_info.sequence_pointer;
      pfp$get_family_info (set_name, -$pft$catalog_info_selections [], family_info.sequence_pointer, status);
      IF status.normal THEN
        RESET family_info.sequence_pointer;
        pfp$find_next_info_record (family_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          pfp$find_directory_array (p_info_record, p_family_directory, status);
          IF status.normal AND (p_family_directory <> NIL) THEN
            IF sort_users THEN
              PUSH p_sorted_directory: [1 .. UPPERBOUND (p_family_directory^)];
              pup$sort_directory (p_family_directory^, p_sorted_directory^);
            ELSE
              p_sorted_directory := p_family_directory;
            IFEND;
            FOR i := LOWERBOUND (p_sorted_directory^) TO UPPERBOUND (p_sorted_directory^) DO
              pup$check_if_family_in_range (p_sorted_directory^ [i].name, family_in_range);
              IF family_in_range THEN
                display_family (set_name, p_sorted_directory^ [i].name, sort_users, status);
              IFEND;
            FOREND;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (family_info, local_status);
    IFEND;
  PROCEND pup$display_set_request;

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

  PROCEDURE [XDCL] pup$include_all_files
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE include_all_files (
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 5, 13, 13, 37, 12, 195],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$status = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pup$verify_system_administrator (osc$null_name, puv$p_user_range_list, status);
    IF status.normal THEN
      clp$scan_command_line ('INCLUDE_USERS ALL', status);
      pup$write_os_status (status, status);
    IFEND;

    clp$scan_command_line (' INCLUDE_EXCLUDED_ITEMS ', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' INCLUDE_CYCLES ALL', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' EXCLUDE_HIGHEST_CYCLES 0', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' INCLUDE_EMPTY_CATALOGS FALSE', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' INCLUDE_LARGE_CYCLES 0', status);
    pup$write_os_status (status, status);

    clp$scan_command_line (' INCLUDE_VOLUME ALL', status);
    pup$write_os_status (status, status);

  PROCEND pup$include_all_files;
?? TITLE := '    [XDCL] pup$include_users_command ', EJECT ??

  PROCEDURE [XDCL] pup$include_users_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ pdt include_users_pdt(
{ users, user, u: list 1 .. puc$max_number_of_user_ranges range of file ..
{  OR key all = $required
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      include_users_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^include_users_pdt_names,
        ^include_users_pdt_params];

    VAR
      include_users_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
        clt$parameter_name_descriptor := [['USERS', 1], ['USER', 1], ['U', 1], ['STATUS', 2]];

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

{ USERS USER U }
      [[clc$required], 1, puc$max_number_of_user_ranges, 1, 1, clc$value_range_allowed,
        [^include_users_pdt_kv1, clc$file_value]],

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

    VAR
      include_users_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['ALL'];

?? POP ??

    VAR
      p_user_container: ^put$user_range_list_container,
      temp_p_user_range_list: ^put$user_range_list,
      temp_user_container: put$user_range_list_container,
      uncracked_parameter: ost$string;

    { The family_name parameter isn't used by pup$verify_family_administrator.
    {
    pup$verify_family_administrator ('INCLUDE_USERS', {family_name} osc$null_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_parameter_list (parameter_list, include_users_pdt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    pup$crack_user_range_list ('USERS', uncracked_parameter, temp_user_container, temp_p_user_range_list,
          status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF temp_p_user_range_list = NIL THEN
      puv$p_user_range_list := NIL;
    ELSE
      p_user_container := ^user_range_list_container;
      RESET p_user_container;
      NEXT puv$p_user_range_list: [1 .. UPPERBOUND (temp_p_user_range_list^)] IN p_user_container;
      puv$p_user_range_list^ := temp_p_user_range_list^;
    IFEND;
    pup$display_line (' INCLUDE USERS: ', status);
    pup$display_line (uncracked_parameter.value (1, uncracked_parameter.size), status);

  PROCEND pup$include_users_command;
?? TITLE := '    [XDCL] pup$sort_users_command ', EJECT ??

  PROCEDURE [XDCL] pup$sort_users_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE sort_users (
{   alphabetical_order, ao: boolean = true
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 5, 13, 13, 40, 56, 534],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['ALPHABETICAL_ORDER             ',clc$nominal_entry, 1],
    ['AO                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$alphabetical_order = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      local_sort_users: boolean;

    pup$verify_system_administrator ('SORT_USERS                     ', puv$p_user_range_list, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    puv$sort_users := pvt [p$alphabetical_order].value^.boolean_value.value;

  PROCEND pup$sort_users_command;
?? TITLE := '    display_family ', EJECT ??

  PROCEDURE display_family
    (    set_name: stt$set_name;
         family_name: pft$name;
         sort_users: boolean;
     VAR status: ost$status);

    VAR
      i: put$half_integer,
      local_status: ost$status,
      master_catalog_info: amt$segment_pointer,
      p_family_content: pft$p_info_record,
      p_master_catalog_directory: pft$p_directory_array,
      p_sorted_directory: pft$p_directory_array,
      user_in_range: boolean,
      user_path: array [1 .. 2] of pft$name;

    user_path [1] := family_name;
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, master_catalog_info, status);
    IF status.normal THEN
      RESET master_catalog_info.sequence_pointer;
      pfp$get_master_catalog_info (set_name, family_name, -$pft$catalog_info_selections [],
            master_catalog_info.sequence_pointer, status);
      IF status.normal THEN
        RESET master_catalog_info.sequence_pointer;
        pfp$find_next_info_record (master_catalog_info.sequence_pointer, p_family_content, status);
        IF status.normal THEN
          pfp$find_directory_array (p_family_content, p_master_catalog_directory, status);
          IF status.normal AND (p_master_catalog_directory <> NIL) THEN
            IF sort_users THEN
              PUSH p_sorted_directory: [1 .. UPPERBOUND (p_master_catalog_directory^)];
              pup$sort_directory (p_master_catalog_directory^, p_sorted_directory^);
            ELSE
              p_sorted_directory := p_master_catalog_directory;
            IFEND;
            FOR i := LOWERBOUND (p_sorted_directory^) TO UPPERBOUND (p_sorted_directory^) DO
              pup$check_if_user_in_range (family_name, p_sorted_directory^ [i].name, user_in_range);
              IF user_in_range THEN
                user_path [2] := p_sorted_directory^ [i].name;
                pup$write_path (user_path, status);
              IFEND;
            FOREND;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (master_catalog_info, local_status);
    IFEND;
  PROCEND display_family;

?? TITLE := '    display_user_range_list ', EJECT ??

  PROCEDURE display_user_range_list
    (VAR status: ost$status);

    VAR
      user_range_index: integer;

    IF puv$p_user_range_list = NIL THEN
      pup$display_line (' ALL USERS SELECTED', status);
    ELSE
      FOR user_range_index := 1 TO UPPERBOUND (puv$p_user_range_list^) DO
        pup$display_line (' range ', status);
        pup$display_line (' low user: ', status);
        pup$write_path (puv$p_user_range_list^ [user_range_index] [clc$low], status);
        pup$display_line (' high user:', status);
        pup$write_path (puv$p_user_range_list^ [user_range_index] [clc$high], status);
      FOREND;
    IFEND;
  PROCEND display_user_range_list;


MODEND pum$backup_set;
