?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := ' NOS/VE Backup/Restore Utilities:  common_modules ', EJECT ??
MODULE pum$common_modules;
{
{  This module contains procedures of common interest to both backup and restore
{  processing.
{
?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc pus$literals
*copyc clt$parameter_list
*copyc clt$value
*copyc osd$integer_limits
*copyc pud$hierarchy_list
*copyc pfe$error_condition_codes
*copyc pfe$internal_error_conditions
*copyc pue$error_condition_codes
*copyc amt$local_file_name
*copyc clt$file
*copyc ost$name
*copyc ost$status
*copyc pft$p_path
*copyc put$file_identifier
*copyc put$selected_object
*copyc put$user_range_list
*copyc stt$set_name
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc avp$family_administrator
*copyc avp$system_administrator
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$append_status_file
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pfp$convert_pf_path_to_fs_path
*copyc pfp$find_cycle_array
*copyc pfp$find_cycle_array_version_2
*copyc pfp$find_cycle_entry_version_2
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_file_description
*copyc pfp$find_next_info_record
*copyc pfp$get_family_set
*copyc pfp$get_item_info
*copyc pfp$get_master_catalog_info
*copyc pmp$get_compact_date_time
*copyc pmp$get_user_identification
?? TITLE := '    Global Variables', EJECT ??

  VAR
    no_file_info_selections: [pus$literals, READ] pft$file_info_selections := $pft$file_info_selections [],
    no_catalog_info_selections: [pus$literals, READ] pft$catalog_info_selections :=
      $pft$catalog_info_selections [];

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

  PROCEDURE [XDCL] pup$build_catalog_header
   (    set_name: stt$set_name;
        p_path: ^pft$path;
    VAR catalog_header: put$catalog_header);

{  PURPOSE:
{    This procedure builds a pf utility catalog header.
{    - set_name
{    - p_path  This specifies the pf_path (starting with family) of the
{      backup item.  This should be specifies to NIL if there is no path.

    catalog_header.set_name := set_name;
    IF p_path = NIL THEN
      catalog_header.logical_path_length := 0;
    ELSE
      catalog_header.logical_path_length := UPPERBOUND (p_path^);
      catalog_header.path := p_path^;
    IFEND;
  PROCEND pup$build_catalog_header;

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

  PROCEDURE [XDCL] pup$build_entry (pf_name: pft$name;
        cycle_selector: pft$cycle_selector;
        entry_type: put$entry_type;
    VAR pf_utility_entry: put$entry);

{  PURPOSE:
{    This procedure builds a pf utility entry.
{    - pf_name parameter specifies the name of the entry that is being
{    backed up. (eg. For a backup_catalog this is the catalog_name)
{    - cycle_selector
{      This is only used for entry_type = puc$valid_cycle_entry
{    - entry_type
{      This specifies the type of the item that is being backed up.
{      Choices are:
{        puc$valid_set_entry
{        puc$valid_family_entry
{        puc$valid_catalog_entry
{        puc$valid_pf_entry
{        puc$valid_cycle_entry
    pf_utility_entry.entry_type := entry_type;
    CASE entry_type OF
    = puc$valid_cycle_entry =
      pf_utility_entry.pf_selector.pfn := pf_name;
      pf_utility_entry.pf_selector.cycle_selector := cycle_selector;
    = puc$valid_pf_entry =
      pf_utility_entry.pfn := pf_name;
    = puc$valid_catalog_entry =
      pf_utility_entry.catalog_name := pf_name;
    = puc$valid_family_entry =
      pf_utility_entry.family_name := pf_name;
    = puc$valid_set_entry =
      pf_utility_entry.set_name := pf_name;
    ELSE
    CASEND;
  PROCEND pup$build_entry;

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

  PROCEDURE [XDCL] pup$build_hierarchy_list (pf_utility_entry: put$entry;
        catalog_header: put$catalog_header;
    VAR hierarchy_list: put$hierarchy_list;
    VAR status: ost$status);

{
{  PURPOSE:
{    This builds a pf utility hierarchy list by combining an entry, and
{    catalog header.

    status.normal := TRUE;
    hierarchy_list.pf_entry := pf_utility_entry;
    hierarchy_list.catalog_header := catalog_header;
    pmp$get_compact_date_time (hierarchy_list.date_time, status);
  PROCEND pup$build_hierarchy_list;

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

  PROCEDURE [XDCL] pup$build_new_catalog_header (pfu_entry: put$entry;
        pf_utility_catalog_header: put$catalog_header;
    VAR pf_util_new_catalog_header: put$catalog_header);

{
{  PURPOSE:
{    This builds a new pf utility catalog header.
{    The new catalog header must have a logical length one greater than the
{    old catalog header.  The name for the new path is taken from the
{    pf entry input.


    VAR
      i: put$half_integer,
      new_name: pft$name;

    pf_util_new_catalog_header.set_name := pf_utility_catalog_header.set_name;
    pf_util_new_catalog_header.logical_path_length := pf_utility_catalog_header.logical_path_length + 1;
    IF pf_utility_catalog_header.logical_path_length > 0 THEN
      FOR i := LOWERBOUND (pf_utility_catalog_header.path) TO UPPERBOUND (pf_utility_catalog_header.path) DO
        pf_util_new_catalog_header.path [i] := pf_utility_catalog_header.path [i];
      FOREND;
    IFEND;
    CASE pfu_entry.entry_type OF
    = puc$valid_family_entry =
      new_name := pfu_entry.family_name;
    = puc$valid_catalog_entry =
      new_name := pfu_entry.catalog_name;
    = puc$valid_pf_entry =
      new_name := pfu_entry.pfn;
    = puc$valid_cycle_entry =
      new_name := pfu_entry.pfn;
    ELSE
    CASEND;
    pf_util_new_catalog_header.path [pf_util_new_catalog_header.logical_path_length] := new_name;
  PROCEND pup$build_new_catalog_header;

?? TITLE := '    [XDCL] pup$build_new_online_cat_head ', EJECT ??
*copyc puh$build_new_online_cat_head

  PROCEDURE [XDCL] pup$build_new_online_cat_head (catalog_header: put$catalog_header;
        new_catalog_header: put$catalog_header;
        found_catalog_header: put$catalog_header;
    VAR new_online_catalog_header: put$catalog_header);

    VAR
      i: integer,
      new_online_index: integer;

    new_online_index := 0;
    new_online_catalog_header.set_name := found_catalog_header.set_name;
    FOR i := 1 TO new_catalog_header.logical_path_length DO
      new_online_index := new_online_index + 1;
      new_online_catalog_header.path [new_online_index] := new_catalog_header.path [i];
    FOREND;

    FOR i := (catalog_header.logical_path_length + 1) TO found_catalog_header.logical_path_length DO
      new_online_index := new_online_index + 1;
      new_online_catalog_header.path [new_online_index] := found_catalog_header.path [i];
    FOREND;
    new_online_catalog_header.logical_path_length := new_online_index;
  PROCEND pup$build_new_online_cat_head;

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

  PROCEDURE [XDCL] pup$build_new_path (path: pft$path;
        new_name: pft$name;
    VAR new_path: pft$path);

{  PURPOSE:
{    This routine takes an old path and appends a new name onto it.
{    The new_path is assumed to be one at least one larger than the old path.


    VAR
      index: integer;

    FOR index := LOWERBOUND (path) TO UPPERBOUND (path) DO
      new_path [index] := path [index];
    FOREND;
    new_path [(UPPERBOUND (path) + 1)] := new_name;
  PROCEND pup$build_new_path;

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

  PROCEDURE pup$compare_catalog_header (cat_header_a: put$catalog_header;
        cat_header_b: put$catalog_header;
    VAR a_equals_b: boolean;
    VAR a_above_b: boolean);

{  PURPOSE:
{    The purpose of this procedure is to compare catalog headers to determine
{    if they are equal, or if cat_header_a is above cat_header_b in the
{    PF catalog tree.

    {Do not check set names, just use family names
    IF (cat_header_a.logical_path_length > 0) AND (cat_header_b.logical_path_length > 0) THEN
      pup$compare_paths (cat_header_a.path, cat_header_b.path, a_equals_b, a_above_b);
    ELSE
      { at least one of the catalog headers has a path length of zero.
      a_equals_b := cat_header_a.logical_path_length = cat_header_b.logical_path_length;
      a_above_b := cat_header_b.logical_path_length > cat_header_a.logical_path_length;
    IFEND;
  PROCEND pup$compare_catalog_header;

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

  PROCEDURE [XDCL] pup$compare_cycle_selectors (cycle_selector_a: pft$cycle_selector;
        cycle_selector_b: pft$cycle_selector;
    VAR a_equals_b: boolean);

    a_equals_b := cycle_selector_a.cycle_option = cycle_selector_b.cycle_option;
    IF a_equals_b AND (cycle_selector_a.cycle_option = pfc$specific_cycle) THEN
      a_equals_b := cycle_selector_a.cycle_number = cycle_selector_b.cycle_number;
    IFEND;
  PROCEND pup$compare_cycle_selectors;



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

  PROCEDURE [XDCL] pup$compare_dates (date_time_a: ost$date_time;
        date_time_b: ost$date_time;
    VAR a_later_than_b: boolean);

{  This procedure compares date_time_a and date_time_b to determine
{  If date_time_a is later chronilogically than date_time_b.
{---------- I I M  E-------------> a_later_than_b
{   date_a        date_b         FALSE
{   date_b     date_a            TRUE
{        date_b = date_a         FALSE

    IF date_time_a.year > date_time_b.year THEN
      a_later_than_b := TRUE;
    ELSEIF date_time_a.year < date_time_b.year THEN
      a_later_than_b := FALSE
    ELSE
      IF date_time_a.month > date_time_b.month THEN
        a_later_than_b := TRUE;
      ELSEIF date_time_a.month < date_time_b.month THEN
        a_later_than_b := FALSE
      ELSE
        IF date_time_a.day > date_time_b.day THEN
          a_later_than_b := TRUE;
        ELSEIF date_time_a.day < date_time_b.day THEN
          a_later_than_b := FALSE
        ELSE
          IF date_time_a.hour > date_time_b.hour THEN
            a_later_than_b := TRUE;
          ELSEIF date_time_a.hour < date_time_b.hour THEN
            a_later_than_b := FALSE
          ELSE
            IF date_time_a.minute > date_time_b.minute THEN
              a_later_than_b := TRUE;
            ELSEIF date_time_a.minute < date_time_b.minute THEN
              a_later_than_b := FALSE
            ELSE
              IF date_time_a.second > date_time_b.second THEN
                a_later_than_b := TRUE;
              ELSEIF date_time_a.second < date_time_b.second THEN
                a_later_than_b := FALSE
              ELSE
                IF date_time_a.millisecond > date_time_b.millisecond THEN
                  a_later_than_b := TRUE;
                ELSE
                  a_later_than_b := FALSE
                IFEND;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$compare_dates;

?? TITLE := '    [XDCL] pup$compare_item_descriptor ', EJECT ??
*copyc puh$compare_item_descriptor
{truth chart for comparison
{===========================
{
{    CATALOG HEADERS                                              RESULTS
{a_above_b   a_equals_b     a_b_entry_equal         a_equals_b       a_above_b
{______________________________________________________________________________
{
{f              t                t                      t               f
{
{
{                                f                      f       (a.entry_type = file)
{                                                                   and
{                                                               (b_entry_type = cycle
{                                                                         AND
{                                                               a_entry.pfn =
{                                                               b_entry.pf_selector.pfn
{
{
{_________________________________________________________________________________
{
{
{t              f               t                      f        a_entry_type = catalog
{                                                               family or set
{
{
{f              f               t                      f        f
{
{
{
{t              f               f                      f        a_entry_type = catalog
{                                                               family or set
{
{
{f              f               f                      f        f
{
{=============================================================================
?? EJECT ??
  PROCEDURE [XDCL] pup$compare_item_descriptor (put_entry_a: put$entry;
        cat_header_a: put$catalog_header;
        put_entry_b: put$entry;
        cat_header_b: put$catalog_header;
    VAR a_equals_b: boolean;
    VAR a_above_b: boolean);

    VAR
      a_b_entry_equal: boolean,
      a_cat_head_above_b: boolean,
      a_cat_head_equal_b: boolean;

    pup$compare_catalog_header (cat_header_a, cat_header_b, a_cat_head_equal_b, a_cat_head_above_b);
    compare_entries (put_entry_a, put_entry_b, a_b_entry_equal);
    a_equals_b := a_cat_head_equal_b AND a_b_entry_equal;
    IF a_cat_head_equal_b THEN
      a_above_b := (NOT a_b_entry_equal) AND (((put_entry_a.entry_type = puc$valid_pf_entry) AND (put_entry_b.
            entry_type = puc$valid_cycle_entry)) AND (put_entry_a.pfn = put_entry_b.pf_selector.pfn));
    ELSE
      a_above_b := a_cat_head_above_b AND ((put_entry_a.entry_type = puc$valid_set_entry) OR (put_entry_a.
            entry_type = puc$valid_family_entry) OR (put_entry_a.entry_type = puc$valid_catalog_entry));
    IFEND;
  PROCEND pup$compare_item_descriptor;

?? TITLE := '    [XDCL] pup$compare_paths ', EJECT ??
*copyc puh$compare_paths

  PROCEDURE [XDCL] pup$compare_paths (path_a: pft$path;
        path_b: pft$path;
    VAR a_equals_b: boolean;
    VAR a_above_b: boolean);


    VAR
      a_equals_start_of_b: boolean,
      i: integer,
      length_path_a: integer,
      length_path_b: integer;

    length_path_a := UPPERBOUND (path_a);
    length_path_b := UPPERBOUND (path_b);

    IF length_path_a > length_path_b THEN
      a_above_b := FALSE;
      a_equals_b := FALSE;
    ELSE
      a_equals_start_of_b := TRUE;
      {This compares the a path with the first part of the b path.

    /search_for_unequal/
      FOR i := 1 TO length_path_a DO
        IF path_a [i] <> path_b [i] THEN
          a_equals_start_of_b := FALSE;
          EXIT /search_for_unequal/;
        IFEND;
      FOREND /search_for_unequal/;

{determine if a equals b}
      a_equals_b := (length_path_a = length_path_b) AND a_equals_start_of_b;
      a_above_b := a_equals_start_of_b AND (length_path_a < length_path_b);
    IFEND;
  PROCEND pup$compare_paths;

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

  PROCEDURE [XDCL] pup$convert_cycle_path_to_strng (path: pft$path;
        cycle_number: fst$cycle_number;
    VAR path_name: ost$string);

{   This procedure converts a path to a string.  The string is a path
{ name suitable for printing and follows the standard form, i.e. it begins
{ with :family_name, contains no blanks, and separates each name with a
{ period.

    VAR
      cycle_string: string (20),
      cycle_string_length: integer,
      found: boolean,
      last_name_index: integer,
      last_name_length: 0 .. osc$max_name_size + 1,
      name_length: 1 .. osc$max_name_size + 1,
      path_index: integer,
      path_name_length: integer,
      space_character: [pus$literals, READ] packed array [0 .. 255] of boolean := [REP 32 of FALSE, TRUE, REP
        223 of FALSE];

    STRINGREP (cycle_string, cycle_string_length, cycle_number);
    cycle_string (1) := '.';
    path_name.value (1) := ':';
    path_name_length := 1;

    last_name_index := UPPERBOUND (path);
    #scan (space_character, path [last_name_index], last_name_length, found);
    last_name_length := last_name_length - 1;

    FOR path_index := 1 TO last_name_index - 1 DO
      IF (path [path_index] = osc$null_name) OR (path [path_index] = '') THEN
        path_name.value (path_name_length + 1, 2) := '?.';
        path_name_length := path_name_length + 2;
      ELSE
        #scan (space_character, path [path_index], name_length, found);
        name_length := name_length - 1;
        IF path_name_length + name_length + (2 * ((last_name_index - 1) - path_index)) + last_name_length >
              osc$max_string_size THEN
          {
          { The path name would be too long, so a '?' is substituted for this
          { name in the path.
          {
          path_name.value (path_name_length + 1, 2) := '?.';
          path_name_length := path_name_length + 2;
        ELSE
          STRINGREP (path_name.value, path_name_length, path_name.value (1, path_name_length), path
                [path_index] (1, name_length), '.');
        IFEND;
      IFEND;
    FOREND;

    STRINGREP (path_name.value, path_name_length, path_name.value (1, path_name_length), path
          [last_name_index] (1, last_name_length), cycle_string (1, cycle_string_length));
    path_name.size := path_name_length;
  PROCEND pup$convert_cycle_path_to_strng;

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

  PROCEDURE [XDCL] pup$convert_path_to_string (path: pft$path;
    VAR path_name: ost$string);

{   This procedure converts a path to a string.  The string is a path
{ name suitable for printing and follows the standard form, i.e. it begins
{ with :family_name, contains no blanks, and separates each name with a
{ period.

    VAR
      found: boolean,
      last_name_index: integer,
      last_name_length: 0 .. osc$max_name_size + 1,
      name_length: 1 .. osc$max_name_size + 1,
      path_index: integer,
      path_name_length: integer,
      space_character: [pus$literals, READ] packed array [0 .. 255] of boolean := [REP 32 of FALSE, TRUE, REP
        223 of FALSE];

    path_name.value (1) := ':';
    path_name_length := 1;

    last_name_index := UPPERBOUND (path);
    #scan (space_character, path [last_name_index], last_name_length, found);
    last_name_length := last_name_length - 1;

    FOR path_index := 1 TO last_name_index - 1 DO
      IF (path [path_index] = osc$null_name) OR (path [path_index] = '') THEN
        path_name.value (path_name_length + 1, 2) := '?.';
        path_name_length := path_name_length + 2;
      ELSE
        #scan (space_character, path [path_index], name_length, found);
        name_length := name_length - 1;
        IF path_name_length + name_length + (2 * ((last_name_index - 1) - path_index)) + last_name_length >
              osc$max_string_size THEN
          {
          { The path name would be too long, so a '?' is substituted for this
          { name in the path.
          {
          path_name.value (path_name_length + 1, 2) := '?.';
          path_name_length := path_name_length + 2;
        ELSE
          STRINGREP (path_name.value, path_name_length, path_name.value (1, path_name_length), path
                [path_index] (1, name_length), '.');
        IFEND;
      IFEND;
    FOREND;

    STRINGREP (path_name.value, path_name_length, path_name.value (1, path_name_length), path
          [last_name_index] (1, last_name_length));
    path_name.size := path_name_length;
  PROCEND pup$convert_path_to_string;

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

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

      set_exists := TRUE;
      status.normal := TRUE;

  PROCEND pup$determine_if_set_exists;

?? TITLE := '    [XDCL] pup$find_cycle_entry ', EJECT ??
*copyc puh$find_cycle_entry

  PROCEDURE [XDCL] pup$find_cycle_entry
   (    path: pft$path;
        cycle_selector: pft$cycle_selector;
    VAR cycle_entry: pft$cycle_array_entry_version_2;
    VAR status: ost$status);

    VAR
      cycle_index: pft$array_index,
      group: pft$group,
      local_status: ost$status,
      p_cycle_array: ^pft$cycle_array_version_2,
      p_item_record: pft$p_info_record,
      segment_pointer: amt$segment_pointer;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment_pointer, status);
    IF status.normal THEN
      group.group_type := pfc$public;
      pfp$get_item_info (path, group, $pft$catalog_info_selections [],
            $pft$file_info_selections [pfc$file_directory, pfc$file_cycles_version_2],
            segment_pointer.sequence_pointer, status);
      IF status.normal THEN
        pup$get_cycle_array_version_2 (segment_pointer.sequence_pointer, p_cycle_array, p_item_record,
              status);
        IF status.normal THEN
          pfp$find_cycle_entry_version_2 (p_cycle_array, cycle_selector, cycle_index, status);
          IF status.normal THEN
            cycle_entry := p_cycle_array^ [cycle_index];
          ELSEIF status.condition = pfe$unknown_cycle THEN
            pup$set_unknown_cycle_status (path [UPPERBOUND (path)], cycle_selector, status);
          IFEND;
        IFEND;
        mmp$delete_scratch_segment (segment_pointer, local_status);
      IFEND;
    IFEND;
  PROCEND pup$find_cycle_entry;

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

  PROCEDURE [XDCL] pup$find_cycle_info_record
   (    p_cycle_array_extended_record: pft$p_info_record;
        p_cycle_directory_array: pft$p_cycle_directory_array;
        cycle_number: fst$cycle_number;
        p_path: pft$p_path;
    VAR p_cycle_info_record: pft$p_info_record;
    VAR status: ost$status);

    VAR
      fs_path: fst$path,
      fs_path_size: fst$path_size,
      i: ost$positive_integers;

    FOR i := 1 TO UPPERBOUND (p_cycle_directory_array^) DO
      IF p_cycle_directory_array^ [i].cycle_number = cycle_number THEN
        pfp$find_direct_info_record (^p_cycle_array_extended_record^.body,
              p_cycle_directory_array^ [i].info_offset, p_cycle_info_record, status);
        RETURN;
      IFEND;
    FOREND;
    pfp$convert_pf_path_to_fs_path (p_path^, fs_path, fs_path_size);
    osp$set_status_abnormal (puc$pf_utility_id, pue$no_cycle_direct_array_entry, '', status);
    osp$append_status_parameter (osc$status_parameter_delimiter, fs_path (1, fs_path_size), status);
    osp$append_status_integer (osc$status_parameter_delimiter, cycle_number, 10, FALSE, status);
  PROCEND pup$find_cycle_info_record;

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

  PROCEDURE [XDCL] pup$get_cycle_array (
    VAR sequence_pointer: ^SEQ ( * );
    VAR p_cycle_array: pft$p_cycle_array;
    VAR p_item_record: pft$p_info_record;
    VAR status: ost$status);

{
{  PURPOSE:
{    This procedure attempts to find the cycle array for a file.
{    A sequence must be supplied, in which the cycle array will be stored.

    VAR
      p_body: pft$p_info,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record;

    p_cycle_array := NIL;
    RESET sequence_pointer;
    pfp$find_next_info_record (sequence_pointer, p_info_record, status);
    IF status.normal THEN
      pfp$find_directory_array (p_info_record, p_directory_array, status);
      IF status.normal AND (p_directory_array <> NIL) THEN
        p_body := ^p_info_record^.body;
        pfp$find_direct_info_record (p_body, p_directory_array^ [LOWERBOUND (p_directory_array^)].
              info_offset, p_item_record, status);
        IF status.normal THEN
          pfp$find_cycle_array (p_item_record, p_cycle_array, status);
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$get_cycle_array;

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

  PROCEDURE [XDCL] pup$get_cycle_array_version_2 (
    VAR sequence_pointer: ^SEQ ( * );
    VAR p_cycle_array_version_2: ^pft$cycle_array_version_2;
    VAR p_item_record: pft$p_info_record;
    VAR status: ost$status);

{
{  PURPOSE:
{    This procedure attempts to find the cycle array for a file.
{    A sequence must be supplied, in which the cycle array will be stored.


    VAR
      p_body: pft$p_info,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record;

    p_cycle_array_version_2 := NIL;
    RESET sequence_pointer;
    pfp$find_next_info_record (sequence_pointer, p_info_record, status);
    IF status.normal THEN
      pfp$find_directory_array (p_info_record, p_directory_array, status);
      IF status.normal AND (p_directory_array <> NIL) THEN
        p_body := ^p_info_record^.body;
        pfp$find_direct_info_record (p_body, p_directory_array^ [LOWERBOUND (p_directory_array^)].
              info_offset, p_item_record, status);
        IF status.normal THEN
          pfp$find_cycle_array_version_2 (p_item_record, p_cycle_array_version_2, status);
        IFEND;
      IFEND;
    IFEND;
  PROCEND pup$get_cycle_array_version_2;

?? TITLE := '    [XDCL] pup$get_file_password ', EJECT ??
*copyc puh$get_file_password

  PROCEDURE [XDCL] pup$get_file_password (file_path: pft$path;
    VAR password: pft$password);


    VAR
      file_info: pft$file_info_selections,
      file_item_info: amt$segment_pointer,
      group: pft$group,
      p_body: pft$p_info,
      p_directory_array: pft$p_directory_array,
      p_file_description: pft$p_file_description,
      p_info_record: pft$p_info_record,
      p_item_record: pft$p_info_record,
      status: ost$status;

    password := osc$null_name;
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, file_item_info, status);
    IF status.normal THEN
      group.group_type := pfc$public;
      file_info := $pft$file_info_selections [pfc$file_directory, pfc$file_description];
      pfp$get_item_info (file_path, group, no_catalog_info_selections, file_info, file_item_info.
            sequence_pointer, status);
      IF status.normal THEN
        RESET file_item_info.sequence_pointer;
        pfp$find_next_info_record (file_item_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          p_body := ^p_info_record^.body;
          pfp$find_directory_array (p_info_record, p_directory_array, status);
          IF status.normal AND (p_directory_array <> NIL) THEN
            pfp$find_direct_info_record (p_body, p_directory_array^ [LOWERBOUND (p_directory_array^)].
                  info_offset, p_item_record, status);
            IF status.normal THEN
              pfp$find_file_description (p_item_record, p_file_description, status);
              IF status.normal THEN
                password := p_file_description^.password;
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (file_item_info, status);
    IFEND;
  PROCEND pup$get_file_password;

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

  PROCEDURE [XDCL] pup$set_abnormal_entry_status (entry: put$entry;
        condition: ost$status_condition;
    VAR status: ost$status);

{  The template is assumed to have 3 spaces for parameters


    CASE entry.entry_type OF
    = puc$valid_set_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'set ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, entry.set_name, status);
    = puc$valid_family_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'family ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, entry.family_name, status);
    = puc$valid_catalog_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'catalog ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, entry.catalog_name, status);
    = puc$valid_pf_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'permanent file ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, entry.pfn, status);
    = puc$valid_cycle_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'permanent file cycle ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, entry.pf_selector.pfn, status);
      osp$append_status_integer (osc$status_parameter_delimiter, entry.pf_selector.cycle_selector.
            cycle_number, 10, FALSE, status);
    ELSE
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'INVALID ENTRY ', status);
    CASEND;
  PROCEND pup$set_abnormal_entry_status;

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

  PROCEDURE [XDCL] pup$set_object_abnormal
    (   p_object: ^put$selected_object;
        condition: ost$status_condition;
    VAR status: ost$status);

  VAR
    fs_path_size: fst$path_size,
    os_string: ost$string,
    p_fs_path: ^fst$path;

{  The template is assumed to have 2 spaces for parameters


    CASE p_object^.entry.entry_type OF
    = puc$valid_set_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'Set ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_object^.entry.set_name, status);
    = puc$valid_family_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'Family ', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_object^.entry.family_name, status);
    = puc$valid_catalog_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'Catalog ', status);
      PUSH p_fs_path;
      pfp$convert_pf_path_to_fs_path(p_object^.p_catalog_header^.path, p_fs_path^, fs_path_size);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_fs_path^(1, fs_path_size), status);
    = puc$valid_pf_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'Permanent file ', status);
      PUSH p_fs_path;
      pfp$convert_pf_path_to_fs_path(p_object^.p_catalog_header^.path, p_fs_path^, fs_path_size);
      osp$append_status_parameter (osc$status_parameter_delimiter, p_fs_path^(1, fs_path_size), status);
    = puc$valid_cycle_entry =
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'Permanent file cycle ', status);
      IF p_object^.entry.pf_selector.cycle_selector.cycle_option = pfc$specific_cycle THEN
        pup$convert_cycle_path_to_strng (p_object^.p_catalog_header^.path,
              p_object^.entry.pf_selector.cycle_selector.cycle_number, os_string);
        osp$append_status_parameter (osc$status_parameter_delimiter, os_string.value(1, os_string.size),
              status);
      ELSE
        PUSH p_fs_path;
        pfp$convert_pf_path_to_fs_path (p_object^.p_catalog_header^.path, p_fs_path^, fs_path_size);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_fs_path^ (1, fs_path_size), status);
      IFEND;
    ELSE
      osp$set_status_abnormal (puc$pf_utility_id, condition, 'INVALID ENTRY ', status);
    CASEND;
  PROCEND pup$set_object_abnormal;

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

  PROCEDURE [XDCL] pup$set_unknown_cycle_status (file_name: pft$name;
        cycle_selector: pft$cycle_selector;
    VAR status: ost$status);
    osp$set_status_abnormal (puc$pf_utility_id, pfe$unknown_cycle, file_name, status);
    CASE cycle_selector.cycle_option OF
    = pfc$lowest_cycle =
      osp$append_status_parameter (osc$status_parameter_delimiter, '$LOW', status);
    = pfc$highest_cycle =
      osp$append_status_parameter (osc$status_parameter_delimiter, '$HIGH', status);
    = pfc$specific_cycle =
      osp$append_status_integer (osc$status_parameter_delimiter, cycle_selector.cycle_number, 10, FALSE,
            status);
    CASEND;
  PROCEND pup$set_unknown_cycle_status;

?? TITLE := '    [XDCL, #GATE] pup$sort_cycle_array ', EJECT ??

  PROCEDURE [XDCL, #GATE] pup$sort_cycle_array (VAR sorted_cycle_array: pft$cycle_array);


    PROCEDURE quicksort (lower: integer;
          upper: integer);

      VAR
        i: integer,
        j: integer,
        x: pft$cycle_array_entry,
        w: pft$cycle_array_entry;

      i := lower;
      j := upper;

      x := sorted_cycle_array [(lower + upper) DIV 2];
      REPEAT
        WHILE sorted_cycle_array [i].cycle_number < x.cycle_number DO
          i := i + 1;
        WHILEND;
        WHILE x.cycle_number < sorted_cycle_array [j].cycle_number DO
          j := j - 1;
        WHILEND;
        IF i <= j THEN
          w := sorted_cycle_array [i];
          sorted_cycle_array [i] := sorted_cycle_array [j];
          sorted_cycle_array [j] := w;
          i := i + 1;
          j := j - 1;
        IFEND;
      UNTIL i > j;
      IF lower < j THEN
        quicksort (lower, j);
      IFEND;
      IF i < upper THEN
        quicksort (i, upper);
      IFEND;
    PROCEND quicksort;

    quicksort (1, UPPERBOUND (sorted_cycle_array));
  PROCEND pup$sort_cycle_array;

?? TITLE := '    [XDCL, #GATE] pup$sort_cycle_array_version_2 ', EJECT ??

  PROCEDURE [XDCL, #GATE] pup$sort_cycle_array_version_2 (VAR sorted_cycle_array: pft$cycle_array_version_2);


    PROCEDURE quicksort (lower: integer;
          upper: integer);

      VAR
        i: integer,
        j: integer,
        x: pft$cycle_array_entry_version_2,
        w: pft$cycle_array_entry_version_2;

      i := lower;
      j := upper;

      x := sorted_cycle_array [(lower + upper) DIV 2];
      REPEAT
        WHILE sorted_cycle_array [i].cycle_number < x.cycle_number DO
          i := i + 1;
        WHILEND;
        WHILE x.cycle_number < sorted_cycle_array [j].cycle_number DO
          j := j - 1;
        WHILEND;
        IF i <= j THEN
          w := sorted_cycle_array [i];
          sorted_cycle_array [i] := sorted_cycle_array [j];
          sorted_cycle_array [j] := w;
          i := i + 1;
          j := j - 1;
        IFEND;
      UNTIL i > j;
      IF lower < j THEN
        quicksort (lower, j);
      IFEND;
      IF i < upper THEN
        quicksort (i, upper);
      IFEND;
    PROCEND quicksort;

    quicksort (1, UPPERBOUND (sorted_cycle_array));
  PROCEND pup$sort_cycle_array_version_2;

?? TITLE := '    [XDCL, #GATE] pup$sort_directory ', EJECT ??

  PROCEDURE [XDCL, #GATE] pup$sort_directory (unsorted_directory: pft$directory_array;
    VAR sorted_directory: pft$directory_array);


    PROCEDURE quicksort (lower: integer;
          upper: integer);

      VAR
        i: integer,
        j: integer,
        x: pft$directory_array_entry,
        w: pft$directory_array_entry;

      i := lower;
      j := upper;

      x := sorted_directory [(lower + upper) DIV 2];
      REPEAT
        WHILE sorted_directory [i].name < x.name DO
          i := i + 1;
        WHILEND;
        WHILE x.name < sorted_directory [j].name DO
          j := j - 1;
        WHILEND;
        IF i <= j THEN
          w := sorted_directory [i];
          sorted_directory [i] := sorted_directory [j];
          sorted_directory [j] := w;
          i := i + 1;
          j := j - 1;
        IFEND;
      UNTIL i > j;
      IF lower < j THEN
        quicksort (lower, j);
      IFEND;
      IF i < upper THEN
        quicksort (i, upper);
      IFEND;
    PROCEND quicksort;

    sorted_directory := unsorted_directory;
    quicksort (1, UPPERBOUND (sorted_directory));
  PROCEND pup$sort_directory;

?? TITLE := '    [XDCL] pup$validate_n_n_minus_1 ', EJECT ??
*copyc puh$validate_n_n_minus_1

  PROCEDURE [XDCL] pup$validate_n_n_minus_1 (path: pft$path;
        n_type: put$entry_type;
        cycle_selector: pft$cycle_selector;
    VAR status: ost$status);

    VAR
      cycle_entry: pft$cycle_array_entry_version_2,
      i: integer,
      p_n_minus_1_path: ^pft$path;

    status.normal := TRUE;
    { Verify N minus 1 exists online
    CASE n_type OF
    = puc$valid_family_entry =

    = puc$valid_catalog_entry, puc$valid_pf_entry =
      PUSH p_n_minus_1_path: [1 .. (UPPERBOUND (path) - 1)];
      FOR i := 1 TO UPPERBOUND (p_n_minus_1_path^) DO
        p_n_minus_1_path^ [i] := path [i];
      FOREND;
      pup$verify_catalog_path (p_n_minus_1_path^, status);

    = puc$valid_cycle_entry =
      pup$verify_file_path (path, status);
      IF NOT status.normal AND (status.condition = pfe$unknown_permanent_file) THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$restore_cycle_requires_file, '', status);
      IFEND;
    ELSE
    CASEND;

    { Verify N does not exist
    IF status.normal THEN
      CASE n_type OF
      = puc$valid_family_entry, puc$valid_catalog_entry =
        pup$verify_catalog_path (path, status);
        IF status.normal THEN
          osp$set_status_abnormal (puc$pf_utility_id, pue$new_catalog_already_exists, path [UPPERBOUND
                (path)], status);
        ELSEIF (status.condition = pfe$unknown_last_subcatalog) OR (status.condition =
              pfe$unknown_nth_subcatalog) THEN
          status.normal := TRUE;
        ELSEIF (status.condition = pfe$unknown_family) AND (UPPERBOUND(path) = pfc$family_name_index) THEN
          status.normal := TRUE;
        ELSEIF (status.condition = pfe$unknown_master_catalog) AND (UPPERBOUND(path) =
              pfc$master_catalog_name_index) THEN
          status.normal := TRUE;
        IFEND;

      = puc$valid_pf_entry =
        pup$verify_file_path (path, status);
        IF status.normal THEN
          osp$set_status_abnormal (puc$pf_utility_id, pue$new_file_already_exists, path [UPPERBOUND (path)],
                status);
        ELSEIF status.condition = pfe$unknown_permanent_file THEN
          status.normal := TRUE;
        IFEND;

      = puc$valid_cycle_entry =
        IF cycle_selector.cycle_option = pfc$specific_cycle THEN
          { $high, $low are OK
          pup$find_cycle_entry (path, cycle_selector, cycle_entry, status);
          IF status.normal THEN
            osp$set_status_abnormal (puc$pf_utility_id, pue$new_cycle_already_exists, path [UPPERBOUND
                  (path)], status);
            osp$append_status_integer (osc$status_parameter_delimiter, cycle_selector.cycle_number, 10, FALSE,
                  status);
          ELSEIF status.condition = pfe$unknown_cycle THEN
            status.normal := TRUE;
          IFEND;
        IFEND;
      ELSE
      CASEND;
    IFEND;

  PROCEND pup$validate_n_n_minus_1;

?? TITLE := '    [XDCL] pup$verify_catalog_path ', EJECT ??
*copyc puh$verify_catalog_path

  PROCEDURE [XDCL] pup$verify_catalog_path (catalog_path: pft$path;
    VAR status: ost$status);

    VAR
      catalog_info: pft$catalog_info_selections,
      file_info: pft$file_info_selections,
      group: pft$group,
      local_status: ost$status,
      segment: amt$segment_pointer,
      set_name: stt$set_name;


    pfp$get_family_set (catalog_path [pfc$family_name_index], set_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment, status);
    IF status.normal THEN
      catalog_info := $pft$catalog_info_selections [pfc$catalog_directory, pfc$catalog_description];
      IF UPPERBOUND(catalog_path) = pfc$family_name_index THEN
        pfp$get_master_catalog_info (set_name, catalog_path[pfc$family_name_index], catalog_info,
             segment.sequence_pointer, status);
      ELSE
        group.group_type := pfc$public;
        file_info := $pft$file_info_selections [];
        pfp$get_item_info (catalog_path, group, catalog_info, file_info, segment.sequence_pointer, status);
      IFEND;
      mmp$delete_scratch_segment (segment, local_status);
    IFEND;
  PROCEND pup$verify_catalog_path;

?? TITLE := '    [XDCL] pup$verify_file_path ', EJECT ??
*copyc puh$verify_file_path

  PROCEDURE [XDCL] pup$verify_file_path (file_path: pft$path;
    VAR status: ost$status);

    VAR
      catalog_info: pft$catalog_info_selections,
      file_info: pft$file_info_selections,
      group: pft$group,
      local_status: ost$status,
      segment: amt$segment_pointer;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment, status);
    IF status.normal THEN
      group.group_type := pfc$public;
      catalog_info := $pft$catalog_info_selections [];
      file_info := $pft$file_info_selections [pfc$file_description];
      pfp$get_item_info (file_path, group, catalog_info, file_info, segment.sequence_pointer, status);
      mmp$delete_scratch_segment (segment, local_status);
    IFEND;
  PROCEND pup$verify_file_path;


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

  PROCEDURE [XDCL] pup$verify_family_administrator (request_name: string (* <= osc$max_name_size);
        family_name: pft$name;
    VAR status: ost$status);

    status.normal := TRUE;

    IF (NOT avp$family_administrator ()) AND (NOT avp$system_administrator ()) THEN
      osp$set_status_abnormal (puc$pf_utility_id, pue$not_system_administrator, request_name, status);
    IFEND;

  PROCEND pup$verify_family_administrator;
?? TITLE := '    [XDCL] pup$verify_system_administrator ', EJECT ??

  PROCEDURE [XDCL] pup$verify_system_administrator (request_name: string (* <= osc$max_name_size);
        p_included_users: ^put$user_range_list;
    VAR status: ost$status);

    VAR
      low_or_high: clt$low_or_high,
      non_administrated_user_included: boolean,
      range: 1 .. puc$max_number_of_user_ranges,
      user_identification: ost$user_identification;

    status.normal := TRUE;

    pmp$get_user_identification (user_identification, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT avp$system_administrator () THEN
      IF NOT avp$family_administrator () THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$not_system_administrator, request_name, status);
        RETURN;
      ELSE
        IF p_included_users = NIL THEN
          { All users are included
          non_administrated_user_included := TRUE;
        ELSE
          non_administrated_user_included := FALSE;

        /check_included_ranges/
          FOR range := 1 TO UPPERBOUND (p_included_users^) DO
            FOR low_or_high := clc$low TO clc$high DO
              IF user_identification.family <> p_included_users^ [range] [low_or_high] [pfc$family_name_index]
                    THEN
                non_administrated_user_included := TRUE;
                EXIT /check_included_ranges/;
              IFEND;
            FOREND;
          FOREND /check_included_ranges/;
        IFEND;
        IF non_administrated_user_included THEN
          osp$set_status_abnormal (puc$pf_utility_id, pue$unowned_users_included, request_name, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND pup$verify_system_administrator;

?? TITLE := '    bubble_sort_directory ', EJECT ??

  PROCEDURE bubble_sort_directory (unsorted_directory: pft$directory_array;
    VAR sorted_directory: pft$directory_array);

    { bubble sort

    VAR
      i: integer,
      local_entry: pft$directory_array_entry,
      exchange_done: boolean,
      number_of_times_repeated: integer;

    sorted_directory := unsorted_directory;
    number_of_times_repeated := 0;
    REPEAT
      exchange_done := FALSE;
      FOR i := 1 TO (UPPERBOUND (sorted_directory) - (number_of_times_repeated + 1)) DO
        IF sorted_directory [i].name > sorted_directory [i + 1].name THEN
          local_entry := sorted_directory [i];
          sorted_directory [i] := sorted_directory [i + 1];
          sorted_directory [i + 1] := local_entry;
          exchange_done := TRUE;
        IFEND;
      FOREND;
      number_of_times_repeated := number_of_times_repeated + 1;
    UNTIL NOT exchange_done;
  PROCEND bubble_sort_directory;

?? TITLE := '    compare_entries ', EJECT ??

  PROCEDURE compare_entries (put_entry_a: put$entry;
        put_entry_b: put$entry;
    VAR a_equals_b: boolean);

{   This compares two pf entries to determine if they are equal.

    a_equals_b := FALSE;
    IF put_entry_a.entry_type = put_entry_b.entry_type THEN
      CASE put_entry_a.entry_type OF
      = puc$valid_set_entry =
        a_equals_b := put_entry_a.set_name = put_entry_b.set_name;
      = puc$valid_family_entry =
        a_equals_b := put_entry_a.family_name = put_entry_b.family_name;
      = puc$valid_catalog_entry =
        a_equals_b := put_entry_a.catalog_name = put_entry_b.catalog_name;
      = puc$valid_pf_entry =
        a_equals_b := put_entry_a.pfn = put_entry_b.pfn;
      = puc$valid_cycle_entry =
        pup$compare_cycle_selectors (put_entry_a.pf_selector.cycle_selector, put_entry_b.pf_selector.
              cycle_selector, a_equals_b);
        a_equals_b := a_equals_b AND (put_entry_a.pf_selector.pfn = put_entry_b.pf_selector.pfn);
      ELSE
        a_equals_b := TRUE;
      CASEND;
    IFEND;
  PROCEND compare_entries;
MODEND pum$common_modules;
