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

?? NEWTITLE := '   Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc puc$delete_all_files_message
*copyc pud$hierarchy_list
*copyc pue$error_condition_codes
*copyc amt$local_file_name
*copyc clt$parameter_list
*copyc clt$value
*copyc ost$name
*copyc ost$status
*copyc pft$cycle_count
*copyc pft$file_media_description
*copyc put$user_range_list
?? POP ??
*copyc amp$return
*copyc clp$evaluate_parameters
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc dmp$get_stored_fmd_header_info
*copyc dmp$get_stored_fmd_volume_list
*copyc jmp$system_job
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pfp$find_cycle_array_extended
*copyc pfp$find_cycle_directory
*copyc pfp$find_cycle_media
*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_set
*copyc pfp$get_item_info
*copyc pfp$get_master_catalog_info
*copyc pfp$get_multi_item_info
*copyc pfp$get_set_list
*copyc pfp$log_status
*copyc pfp$purge
*copyc pfp$purge_catalog
*copyc pfp$purge_master_catalog
*copyc pfp$utility_attach
*copyc pmp$get_job_mode
*copyc pmp$get_unique_name
*copyc pmp$get_user_identification
*copyc pup$all_volumes_included
*copyc pup$allow_job_termination
*copyc pup$build_catalog_header
*copyc pup$build_entry
*copyc pup$build_new_path
*copyc pup$check_cycle_inclusion
*copyc pup$check_if_family_in_range
*copyc pup$check_if_item_excluded
*copyc pup$check_if_size_included
*copyc pup$check_if_user_in_range
*copyc pup$check_if_volume_included
*copyc pup$crack_boolean
*copyc pup$crack_catalog
*copyc pup$crack_pf_file_reference
*copyc pup$display_blank_lines
*copyc pup$display_boolean
*copyc pup$display_excluded_item
*copyc pup$display_integer
*copyc pup$display_line
*copyc pup$get_cycle_array_version_2
*copyc pup$get_file_attributes
*copyc pup$get_file_password
*copyc pup$get_summary_status
*copyc pup$initialize_summary_status
*copyc pup$sort_cycle_array_version_2
*copyc pup$sort_directory
*copyc pup$verify_family_administrator
*copyc pup$verify_file_path
*copyc pup$verify_system_administrator
*copyc pup$write_cycle_display_header
*copyc pup$write_cycle_selector
*copyc pup$write_deleted_cycle
*copyc pup$write_excluded_cycle
*copyc pup$write_os_status
*copyc pup$write_path
*copyc pup$write_status_to_listing
*copyc rap$prompt_via_menu
*copyc puv$backup_information
*copyc puv$cycle_display_selections
*copyc puv$p_user_range_list
*copyc puv$sort_users
?? TITLE := '    Global Variables', EJECT ??

  VAR
    delete_catalogs: boolean := FALSE,
    delete_master_catalogs: boolean := FALSE;

  VAR
    exclude_highest_cycles: 0 .. pfc$maximum_cycle_number := 0;

  VAR
    total_bytes_deleted: integer := 0,
    number_of_cycles_deleted: integer := 0;


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

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

{  PROCEDURE (osm$delaf) delete_all_files (
{    delete_confirmation, dc: boolean = $optional
{    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,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [92, 5, 1, 13, 8, 48, 90],
    clc$command, 3, 2, 0, 0, 0, 0, 2, 'OSM$DELAF'], [
    ['DC                             ',clc$abbreviation_entry, 1],
    ['DELETE_CONFIRMATION            ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, 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_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$boolean_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      cset: stt$number_of_sets,
      ignore_status: ost$status,
      job_mode: jmt$job_mode,
      local_status: ost$status,
      menu_selections_p: ^array [*] of ost$name,
      number_of_sets: stt$number_of_sets,
      selection_chosen: ost$name,
      set_list: ^stt$set_list;

    pup$verify_system_administrator ('DELETE_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;

    pmp$get_job_mode (job_mode, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (pvt [p$delete_confirmation].specified AND
          pvt [p$delete_confirmation].value^.boolean_value.value AND
          (jmp$system_job() OR (job_mode <> jmc$batch))) OR
          (NOT pvt [p$delete_confirmation].specified AND
          (jmp$system_job() OR (job_mode <> jmc$batch))) THEN

{ Display a menu to the operator to confirm the deletion of all files.

      PUSH menu_selections_p: [1..2];
      menu_selections_p^ [1] := 'CONTINUE_REQUEST';
      menu_selections_p^ [2] := 'TERMINATE_REQUEST';
      rap$prompt_via_menu ({ menu_module } puc$delete_all_files_message, menu_selections_p^,
            { menu_parameters } NIL, { prompting_option } $rat$prompting_options[],
            selection_chosen, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF selection_chosen = 'TERMINATE_REQUEST' THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$delaf_command_terminated, ' ', status);
        RETURN;
      IFEND;
    IFEND;
    pup$display_line (' DELETE_ALL_FILES ', status);
    pup$initialize_summary_status;
    total_bytes_deleted := 0;
    number_of_cycles_deleted := 0;
    pup$write_cycle_display_header (status);
    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$delete_set_contents (set_list^ [cset], delete_catalogs, status);
    FOREND;
    display_deletion_totals;
    pup$get_summary_status (status);

{ Return an informative message in the job and system logs to report the execution of a
{ DELETE_ALL_FILES subcommand of BACKUP_PERMANENT_FILES.

    osp$set_status_abnormal (puc$pf_utility_id, pue$delete_all_files_completed, ' ', local_status);
    pfp$log_status ($pmt$ascii_logset [pmc$system_log, pmc$job_log], local_status);
  PROCEND pup$delete_all_files_cm;
?? TITLE := '    pup$delete_catalog_contents ', EJECT ??

  PROCEDURE pup$delete_catalog_contents
    (    path: pft$path;
         delete_catalogs: boolean;
     VAR status: ost$status);

    VAR
      dummy_cycle_selector: pft$cycle_selector,
      entry: put$entry,
      group: pft$group,
      index: integer,
      item_excluded: boolean,
      local_status: ost$status,
      p_catalog_header: ^put$catalog_header,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      p_new_path: ^pft$path,
      password: pft$password,
      segment_pointer: amt$segment_pointer,
      set_name: stt$set_name;


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

    pup$write_path (path, status);
    IF status.normal THEN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, segment_pointer, status);
      IF status.normal THEN
        group.group_type := pfc$public;
        pfp$get_multi_item_info (path, group, $pft$catalog_info_selections
              [pfc$catalog_directory, pfc$catalog_description], $pft$file_info_selections
              [pfc$file_directory, pfc$file_description], segment_pointer.sequence_pointer, status);
        IF status.normal THEN
          RESET segment_pointer.sequence_pointer;
          pfp$find_next_info_record (segment_pointer.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
              PUSH p_catalog_header: [1 .. UPPERBOUND (path) + 1];
              PUSH p_new_path: [1 .. (UPPERBOUND (path) + 1)];
              FOR index := LOWERBOUND (p_directory_array^) TO UPPERBOUND (p_directory_array^) DO
                CASE p_directory_array^ [index].name_type OF
                = pfc$file_name =
                  pup$allow_job_termination;
                  pup$build_new_path (path, p_directory_array^ [index].name, p_new_path^);
                  pup$build_catalog_header (set_name, p_new_path, p_catalog_header^);
                  pup$build_entry (p_directory_array^ [index].name, dummy_cycle_selector, puc$valid_pf_entry,
                        entry);
                  pup$check_if_item_excluded (entry, p_catalog_header^, item_excluded);
                  IF item_excluded THEN
                    pup$display_excluded_item (entry, p_catalog_header^, status);
                  ELSE
                    pup$get_file_password (p_new_path^, password);
                    pup$delete_file_contents (p_new_path^, password, status);
                    pup$write_os_status (status, local_status);
                    status.normal := TRUE;
                  IFEND;
                ELSE
                CASEND;
              FOREND;

              FOR index := LOWERBOUND (p_directory_array^) TO UPPERBOUND (p_directory_array^) DO
                CASE p_directory_array^ [index].name_type OF
                = pfc$catalog_name =
                  pup$allow_job_termination;
                  pup$build_new_path (path, p_directory_array^ [index].name, p_new_path^);
                  pup$build_catalog_header (set_name, p_new_path, p_catalog_header^);
                  pup$build_entry (p_directory_array^ [index].name, dummy_cycle_selector,
                        puc$valid_catalog_entry, entry);
                  pup$check_if_item_excluded (entry, p_catalog_header^, item_excluded);
                  IF item_excluded THEN
                    pup$display_excluded_item (entry, p_catalog_header^, status);
                  ELSE
                    pup$delete_catalog_contents (p_new_path^, delete_catalogs, status);
                    pup$write_os_status (status, local_status);
                    status.normal := TRUE;
                  IFEND;
                ELSE
                CASEND;
              FOREND;
            IFEND;
          IFEND;
        IFEND;
        mmp$delete_scratch_segment (segment_pointer, local_status);
      IFEND;
      IF status.normal THEN
        IF UPPERBOUND (path) > pfc$master_catalog_name_index THEN
          IF delete_catalogs THEN
            pfp$purge_catalog (path, status);
            IF status.normal THEN
              pup$display_line ('-- catalog DELETED ', status);
            IFEND;
          ELSE
            pup$display_line (' --catalog NOT deleted', local_status);
          IFEND;
        ELSE
          IF delete_master_catalogs THEN
            pfp$purge_master_catalog (set_name, path [pfc$family_name_index],
                  path [pfc$master_catalog_name_index], status);
            IF status.normal THEN
              pup$display_line (' -- MASTER CATALOG DELETED', status);
            ELSE
              pup$write_os_status (status, status);
            IFEND;
          ELSE
            pup$display_line (' -- MASTER CATALOG NOT DELETED', status);
          IFEND;
        IFEND;
      IFEND;
    IFEND;
    pup$write_os_status (status, local_status);
  PROCEND pup$delete_catalog_contents;
?? TITLE := '    [XDCL] pup$delete_catalog_contents_cm ', EJECT ??

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

{ pdt del_catalog_contents_pdt (
{ catalog,c:file=$required
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      del_catalog_contents_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^del_catalog_contents_pdt_names, ^del_catalog_contents_pdt_params];

    VAR
      del_catalog_contents_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['CATALOG', 1], ['C', 1], ['STATUS', 2]];

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

{ CATALOG C }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, 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]]];

?? POP ??

    VAR
      local_status: ost$status,
      path_container: clt$path_container,
      p_path: ^pft$path,
      set_name: stt$set_name;

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

    pup$crack_catalog ('CATALOG', path_container, p_path, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF UPPERBOUND (p_path^) = pfc$family_name_index THEN
      pup$verify_family_administrator ('DELETE_CATALOG_CONTENTS', p_path^ [pfc$family_name_index], status);
      IF NOT status.normal THEN
        osp$append_status_parameter (osc$status_parameter_delimiter, ' to delete a family', status);
      IFEND;
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    pup$display_line (' DELETE_CATALOG_CONTENTS', status);
    pup$write_path (p_path^, status);
    pup$write_cycle_display_header (status);
    pup$initialize_summary_status;
    total_bytes_deleted := 0;
    number_of_cycles_deleted := 0;
    IF UPPERBOUND (p_path^) = pfc$family_name_index THEN
      delete_family_contents (set_name, p_path^ [pfc$family_name_index], delete_catalogs, status);
    ELSE
      pup$delete_catalog_contents (p_path^, delete_catalogs, status);
    IFEND;
    display_deletion_totals;
    pup$get_summary_status (status);
  PROCEND pup$delete_catalog_contents_cm;


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

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

    VAR
      local_status: ost$status,
      p_path: ^pft$path,
      password: pft$password,
      path_container: clt$path_container;


    crack_delete_file (parameter_list, path_container, p_path, password, status);
    IF status.normal THEN
      pup$verify_file_path (p_path^, status);
      IF status.normal THEN
        pup$display_line (' DELETE_FILE_CONTENTS', status);
        pup$write_path (p_path^, status);
        pup$write_cycle_display_header (status);
        pup$initialize_summary_status;
        total_bytes_deleted := 0;
        number_of_cycles_deleted := 0;
        pup$delete_file_contents (p_path^, password, status);
        display_deletion_totals;
        pup$get_summary_status (status);
        pup$write_os_status (status, local_status);
      IFEND;
    IFEND;
  PROCEND pup$delete_file_command;

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

  PROCEDURE pup$delete_file_contents
    (    path: pft$path;
         password: pft$password;
     VAR status: ost$status);

    VAR
      action_descriptor: put$action_descriptor,
      any_cycle_deleted: boolean,
      cycle_included: boolean,
      cycle_selector: pft$cycle_selector,
      data_resides_offline: boolean,
      entry: put$entry,
      file_id: amt$file_identifier,
      fmd_header: pft$fmd_header,
      gfn: ost$binary_unique_name,
      group: pft$group,
      index: pft$cycle_count,
      length: amt$file_length,
      local_status: ost$status,
      output_line: string (78),
      p_catalog_header: ^put$catalog_header,
      p_cycle_array: ^pft$cycle_array_version_2,
      p_cycle_array_extended_record: pft$p_info_record,
      p_cycle_directory_array: pft$p_cycle_directory_array,
      p_cycle_info_record: pft$p_info_record,
      p_cycle_media_description: pft$p_file_media_description,
      p_info_record: pft$p_info_record,
      p_volume_list: ^pft$volume_list,
      set_name: stt$set_name,
      sequence_pointer: amt$segment_pointer;

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

    output_line := '';
    output_line (5, * ) := path [UPPERBOUND (path)];
    pup$display_line (output_line, local_status);
    PUSH p_catalog_header: [1 .. UPPERBOUND (path)];
    pup$build_catalog_header (set_name, ^path, p_catalog_header^);
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, sequence_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /delete_file_contents/
    BEGIN
      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,
            pfc$cycle_media_descriptor], sequence_pointer.sequence_pointer, status);
      IF NOT status.normal THEN
        EXIT /delete_file_contents/;
      IFEND;
      pup$get_cycle_array_version_2 (sequence_pointer.sequence_pointer, p_cycle_array, p_info_record, status);
      IF (NOT status.normal) OR (p_cycle_array = NIL) THEN
        EXIT /delete_file_contents/;
      IFEND;

      any_cycle_deleted := FALSE;
      pfp$find_cycle_array_extended (p_info_record, p_cycle_array_extended_record, status);
      IF NOT status.normal THEN
        EXIT /delete_file_contents/;
      IFEND;

      pfp$find_cycle_directory (p_cycle_array_extended_record, p_cycle_directory_array, status);
      IF NOT status.normal THEN
        EXIT /delete_file_contents/;
      IFEND;

      IF pup$excluded_highest_cycles () > 0 THEN
        pup$sort_cycle_array_version_2 (p_cycle_array^);
      IFEND;

    /delete_all_cycles/
      FOR index := LOWERBOUND (p_cycle_array^) TO (UPPERBOUND (p_cycle_array^)) DO
        cycle_selector.cycle_option := pfc$specific_cycle;
        cycle_selector.cycle_number := p_cycle_array^ [index].cycle_number;
        pup$build_entry (path [UPPERBOUND (path)], cycle_selector, puc$valid_cycle_entry, entry);
        pup$check_cycle_inclusion (p_catalog_header^, entry, p_cycle_array^, index, cycle_included,
              action_descriptor);
        IF cycle_included THEN
          {
          { This code takes advantage of the fact that the cycle array and the
          { cycle directory array contain the same cycle numbers in the same order.
          {
          pfp$find_direct_info_record (^p_cycle_array_extended_record^.body,
                p_cycle_directory_array^ [index].info_offset, p_cycle_info_record, status);
          IF NOT status.normal THEN
            EXIT /delete_file_contents/;
          IFEND;

          pfp$find_cycle_media (p_cycle_info_record, p_cycle_media_description, status);
          IF status.normal THEN
            {
            { Get the volume list from the fmd if needed.
            { Determine if the cycle is excluded from this backup by a previous
            { INCLUDE_VOLUMES command.
            {
            IF (p_cycle_array^ [index].device_class = rmc$mass_storage_device) AND
                  ((puc$cdo_recorded_vsn IN puv$cycle_display_selections) OR
                  (NOT pup$all_volumes_included ())) THEN
              dmp$get_stored_fmd_header_info (^p_cycle_media_description^.file_media_descriptor, fmd_header,
                    status);
              IF NOT status.normal THEN
                EXIT /delete_file_contents/;
              IFEND;

              PUSH p_volume_list: [1 .. fmd_header.number_of_subfiles];
              dmp$get_stored_fmd_volume_list (^p_cycle_media_description^.file_media_descriptor,
                    p_volume_list, status);
              IF NOT status.normal THEN
                EXIT /delete_file_contents/;
              IFEND;

              pup$check_if_volume_included (p_volume_list, cycle_included);
              IF NOT cycle_included THEN
                action_descriptor := 'EXCLUDE VOLUME';
              IFEND;
            IFEND;
          ELSE { pfp$find_cycle_media failed.
            IF status.condition = pfe$unknown_cycle_media THEN
              cycle_included := TRUE;
              status.normal := TRUE;
              p_volume_list := NIL;
            ELSE
              EXIT /delete_file_contents/;
            IFEND;
          IFEND;

          IF cycle_included THEN
            check_attached_file_attributes (path, cycle_selector, password, p_cycle_array^[index], gfn,
                  length, cycle_included, data_resides_offline, action_descriptor, status);
            IF status.normal AND cycle_included AND data_resides_offline THEN
              length := puc$released_cycle_size;
              PUSH p_volume_list: [1 .. 1];
              p_volume_list^ [1] := puc$nonexistent_recorded_vsn;

{ Call pup$check_if_volume_included to see if the user has issued the include_volume command
{ within this BACPF session.

              pup$check_if_volume_included (p_volume_list, cycle_included);
              IF NOT cycle_included THEN
                action_descriptor := 'EXCLUDE VOLUME';
              IFEND;
            IFEND;
          IFEND;

          IF status.normal THEN
            IF cycle_included THEN
              pfp$purge (path, cycle_selector, password, status);
              IF NOT status.normal THEN
                EXIT /delete_all_cycles/;
              IFEND;
              any_cycle_deleted := TRUE;
              IF length <> puc$released_cycle_size THEN
                total_bytes_deleted := total_bytes_deleted + length;
              IFEND;
              number_of_cycles_deleted := number_of_cycles_deleted + 1;
              pup$write_deleted_cycle (entry, p_cycle_array^ [index], length, gfn, p_volume_list,
                     p_cycle_array_extended_record, p_cycle_directory_array, status);
            ELSE
              pup$write_excluded_cycle (entry, p_cycle_array^ [index], length, gfn, p_volume_list,
                    p_cycle_array_extended_record, p_cycle_directory_array,
                    action_descriptor, status);
            IFEND;
          ELSE
            pup$write_status_to_listing (entry, status, local_status);
          IFEND;
        ELSE
          pup$write_excluded_cycle (entry, p_cycle_array^ [index], puc$unknown_cycle_size,
                puv$unknown_global_file_name, {recorded vsn} NIL, p_cycle_array_extended_record,
                p_cycle_directory_array, action_descriptor, status);
        IFEND;
      FOREND /delete_all_cycles/;
    END /delete_file_contents/;

    mmp$delete_scratch_segment (sequence_pointer, local_status);

    IF NOT any_cycle_deleted THEN
      pup$display_line ('       No cycles deleted', local_status);
    IFEND;
  PROCEND pup$delete_file_contents;

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

  PROCEDURE pup$delete_set_contents
    (    set_name: stt$set_name;
         delete_catalogs: boolean;
     VAR status: ost$status);

    VAR
      dummy_cycle_selector: pft$cycle_selector,
      family_entry: put$entry,
      family_excluded: boolean,
      family_in_range: boolean,
      family_info: amt$segment_pointer,
      family_path: array [1 .. 1] of pft$name,
      i: put$half_integer,
      local_status: ost$status,
      p_family_catalog_header: ^put$catalog_header,
      p_family_directory: pft$p_directory_array,
      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_name, $pft$catalog_info_selections
            [pfc$catalog_directory, pfc$catalog_description], 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
            PUSH p_family_catalog_header: [1 .. 1];
            FOR i := LOWERBOUND (p_family_directory^) TO UPPERBOUND (p_family_directory^) DO
              pup$check_if_family_in_range (p_family_directory^ [i].name, family_in_range);
              IF family_in_range THEN
                family_path [pfc$family_name_index] := p_family_directory^ [i].name;
                pup$build_entry (p_family_directory^ [i].name, dummy_cycle_selector, puc$valid_family_entry,
                      family_entry);
                pup$build_catalog_header (set_name, ^family_path, p_family_catalog_header^);
                pup$check_if_item_excluded (family_entry, p_family_catalog_header^, family_excluded);
                IF family_excluded THEN
                  pup$display_excluded_item (family_entry, p_family_catalog_header^, status);
                ELSE
                  delete_family_contents (set_name, p_family_directory^ [i].name, delete_catalogs, status);
                IFEND;
              IFEND;
            FOREND;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (family_info, local_status);
    IFEND;
  PROCEND pup$delete_set_contents;
?? TITLE := '    [XDCL] pup$display_delete_empty_cat_cm ', EJECT ??

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

{ pdt display_delec_pdt (status)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_delec_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^display_delec_pdt_names, ^display_delec_pdt_params];

    VAR
      display_delec_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
            clt$parameter_name_descriptor := [['STATUS', 1]];

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

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

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

    pup$display_boolean (' INCLUDE_EMPTY_CATALOGS = ', delete_catalogs, status);
    pup$display_boolean (' INCLUDE_MASTER_CATALOGS = ', delete_master_catalogs, status);
  PROCEND pup$display_delete_empty_cat_cm;
?? TITLE := '    [XDCL] pup$display_exc_highest_cycles ', EJECT ??

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

{ pdt display_exchc_pdt (status)

?? PUSH (LISTEXT := ON) ??

    VAR
      display_exchc_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^display_exchc_pdt_names, ^display_exchc_pdt_params];

    VAR
      display_exchc_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
            clt$parameter_name_descriptor := [['STATUS', 1]];

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

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

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

    IF exclude_highest_cycles = 0 THEN
      pup$display_line (' NO HIGH CYCLES EXCLUDED', status);
    ELSE
      pup$display_integer (' EXCLUDE HIGHEST CYCLES: ', exclude_highest_cycles, status);
    IFEND;
  PROCEND pup$display_exc_highest_cycles;
?? TITLE := '    [XDCL] pup$exclude_highest_cycles_cm ', EJECT ??

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


{   PDT exc_highest_cycles_pdt (
{    number_of_cycles, noc: integer 0 .. pfc$maximum_cycle_number or key all = 3
{    status)

?? PUSH (LISTEXT := ON) ??

    VAR
      exc_highest_cycles_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^exc_highest_cycles_pdt_names, ^exc_highest_cycles_pdt_params];

    VAR
      exc_highest_cycles_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['NUMBER_OF_CYCLES', 1], ['NOC', 1], ['STATUS', 2]];

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

{ NUMBER_OF_CYCLES NOC }
      [[clc$optional_with_default, ^exc_highest_cycles_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^exc_highest_cycles_pdt_kv1, clc$integer_value, 0, pfc$maximum_cycle_number]],

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

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

    VAR
      exc_highest_cycles_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '3';

?? POP ??

    VAR
      value: clt$value;

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

    clp$get_value ('NUMBER_OF_CYCLES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$integer_value THEN
    exclude_highest_cycles := value.int.value;
    ELSE {ALL
    exclude_highest_cycles := pfc$maximum_cycle_number;
    IFEND;
    pup$display_integer (' EXCLUDING HIGHEST CYCLES: ', exclude_highest_cycles, status);
  PROCEND pup$exclude_highest_cycles_cm;

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

  FUNCTION [XDCL] pup$excluded_highest_cycles: 0 .. pfc$maximum_cycle_number;

    pup$excluded_highest_cycles := exclude_highest_cycles;
  FUNCEND pup$excluded_highest_cycles;

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

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

{ PDT include_empty_cat_pdt (
{  delete_catalogs, delete_catalog, dc: boolean = true
{  status)

?? PUSH (LISTEXT := ON) ??

    VAR
      include_empty_cat_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^include_empty_cat_pdt_names, ^include_empty_cat_pdt_params];

    VAR
      include_empty_cat_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
            clt$parameter_name_descriptor := [['DELETE_CATALOGS', 1], ['DELETE_CATALOG', 1], ['DC', 1],
            ['STATUS', 2]];

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

{ DELETE_CATALOGS DELETE_CATALOG DC }
      [[clc$optional_with_default, ^include_empty_cat_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_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_empty_cat_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

?? POP ??

    VAR
      local_delete_catalogs: boolean;

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

    pup$crack_boolean ('DELETE_CATALOGS', local_delete_catalogs, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    delete_catalogs := local_delete_catalogs;
    pup$display_boolean (' INCLUDE_EMPTY_CATALOGS ', delete_catalogs, status);
  PROCEND pup$include_empty_catalog_cm;

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

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


{  PDT include_master_cat_pdt (
{   delete_master_catalogs, delete_master_catalog, dmc: boolean = true
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      include_master_cat_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^include_master_cat_pdt_names, ^include_master_cat_pdt_params];

    VAR
      include_master_cat_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
            clt$parameter_name_descriptor := [['DELETE_MASTER_CATALOGS', 1], ['DELETE_MASTER_CATALOG', 1],
            ['DMC', 1], ['STATUS', 2]];

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

{ DELETE_MASTER_CATALOGS DELETE_MASTER_CATALOG DMC }
      [[clc$optional_with_default, ^include_master_cat_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_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_master_cat_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

?? POP ??

    VAR
      local_delete_catalogs: boolean,
      user_name: ost$user_identification;

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

    pup$verify_family_administrator ('INCLUDE_MASTER_CATALOGS ', user_name.family, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    pup$crack_boolean ('DELETE_MASTER_CATALOGS', local_delete_catalogs, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    delete_master_catalogs := local_delete_catalogs;
    pup$display_boolean (' INCLUDE_MASTER_CATALOGS ', delete_master_catalogs, status);
  PROCEND pup$include_master_catalog_cmd;

?? TITLE := '    check_attached_file_attributes ', EJECT ??

  PROCEDURE check_attached_file_attributes
    (    path: pft$path;
         cycle_selector: pft$cycle_selector;
         password: pft$password;
         cycle_array_entry: pft$cycle_array_entry_version_2;
     VAR gfn: ost$binary_unique_name;
     VAR length: amt$file_length;
     VAR cycle_included: boolean;
     VAR data_resides_offline: boolean;
     VAR action_descriptor: put$action_descriptor;
     VAR status: ost$status);

    VAR
      cycle_damage_symptoms: fst$cycle_damage_symptoms,
      cycle_number: fst$cycle_number,
      lfn: amt$local_file_name,
      local_status: ost$status,
      log_base_recovery_enabled: boolean;

    data_resides_offline := FALSE;
    pmp$get_unique_name (lfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF puv$backup_information.media <> rmc$null_device THEN
      pfp$utility_attach (lfn, path, cycle_selector, password, $pft$usage_selections [pfc$read],
            $pft$share_selections [pfc$read, pfc$execute], pfc$no_wait,
            $fst$cycle_damage_symptoms [fsc$respf_modification_mismatch, fsc$parent_catalog_restored],
            cycle_damage_symptoms, cycle_number, status);
    ELSE
      pfp$utility_attach (lfn, path, cycle_selector, password, $pft$usage_selections [],
            - $pft$share_selections [], pfc$no_wait, $fst$cycle_damage_symptoms
            [fsc$respf_modification_mismatch, fsc$parent_catalog_restored], cycle_damage_symptoms,
            cycle_number, status);
    IFEND;
    IF NOT status.normal THEN
      IF status.condition = pfe$cycle_data_resides_offline THEN
        status.normal := TRUE;
        data_resides_offline := TRUE;
        length := cycle_array_entry.eoi;
        gfn := cycle_array_entry.original_unique_name;
        pup$check_if_size_included (length, cycle_included);
      ELSEIF (status.condition = pfe$undefined_data) OR
            (status.condition = pfe$volume_unavailable) OR
            (status.condition = pfe$cycles_media_missing) OR
            (status.condition = pfe$parent_catalog_restored) OR
            (status.condition = pfe$media_image_inconsistent) OR
            (status.condition = pfe$respf_modification_mismatch) OR
            (status.condition = pfe$volume_not_online) THEN
        status.normal := TRUE;
        length := cycle_array_entry.eoi;
        gfn := cycle_array_entry.original_unique_name;
        pup$check_if_size_included (length, cycle_included);
      IFEND;
      RETURN;
    IFEND;

    pup$get_file_attributes (lfn, cycle_array_entry, length, gfn, status);
    IF status.normal THEN
      pup$check_if_size_included (length, cycle_included);
      IF NOT cycle_included THEN
        action_descriptor := 'EXCLUDE SIZE';
      IFEND;
      amp$return (lfn, status);
    ELSE
      amp$return (lfn, local_status);
    IFEND;
  PROCEND check_attached_file_attributes;
?? TITLE := '    crack_delete_file ', EJECT ??

  PROCEDURE crack_delete_file
    (    parameter_list: clt$parameter_list;
     VAR path_container: clt$path_container;
     VAR p_path: ^pft$path;
     VAR password: pft$password;
     VAR status: ost$status);


{   PROCEDURE (osm$bacpf_delfc) delete_file_contents, delete_file_content, delfc (
{     file, f: file = $required
{     password, pw: (SECURE) any of
{         key
{           none
{         keyend
{         name
{       anyend = none
{     status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 2, 28, 16, 30, 32, 773],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'OSM$BACPF_DELFC'], [
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['PASSWORD                       ',clc$nominal_entry, 2],
    ['PW                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, 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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 3
    [5, 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$file_type]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'none'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$file = 1,
      p$password = 2,
      p$status = 3;

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

    VAR
      cycle_selector_specified: boolean,
      cycle_selector: pft$cycle_selector;


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

    pup$crack_pf_file_reference (pvt [p$file].value^.file_value^, -$put$cycle_reference_selections [],
          'FILE', path_container, p_path, cycle_selector_specified, cycle_selector, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pvt [p$password].value^.kind = clc$name THEN
      password := pvt [p$password].value^.name_value;
    ELSE {keyword = NONE}
      password := osc$null_name;
    IFEND;
  PROCEND crack_delete_file;

?? TITLE := '    delete_family_contents ', EJECT ??

  PROCEDURE delete_family_contents
    (    set_name: stt$set_name;
         family_name: pft$name;
         delete_catalogs: boolean;
     VAR status: ost$status);

    VAR
      dummy_cycle_selector: pft$cycle_selector,
      entry: put$entry,
      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_user_catalog_header: ^put$catalog_header,
      user_excluded: boolean,
      user_in_range: boolean,
      user_path: array [1 .. 2] of pft$name;

    user_path [pfc$family_name_index] := 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
            [pfc$catalog_directory, pfc$catalog_description], 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 puv$sort_users THEN
              pup$sort_directory (p_master_catalog_directory^, p_master_catalog_directory^);
            IFEND;
            PUSH p_user_catalog_header: [1 .. 2];
            FOR i := LOWERBOUND (p_master_catalog_directory^) TO UPPERBOUND (p_master_catalog_directory^) DO
              pup$check_if_user_in_range (family_name, p_master_catalog_directory^ [i].name, user_in_range);
              IF user_in_range THEN
                user_path [pfc$master_catalog_name_index] := p_master_catalog_directory^ [i].name;
                pup$build_entry (user_path [pfc$master_catalog_name_index], dummy_cycle_selector,
                      puc$valid_catalog_entry, entry);
                pup$build_catalog_header (set_name, ^user_path, p_user_catalog_header^);
                pup$check_if_item_excluded (entry, p_user_catalog_header^, user_excluded);
                IF user_excluded THEN
                  pup$display_excluded_item (entry, p_user_catalog_header^, status);
                ELSE
                  pup$delete_catalog_contents (user_path, delete_catalogs, status);
                IFEND;
              IFEND;
            FOREND;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (master_catalog_info, local_status);
    IFEND;
  PROCEND delete_family_contents;


?? TITLE := '    display_deletion_totals ', EJECT ??

  PROCEDURE display_deletion_totals;

    VAR
      local_status: ost$status;

    pup$display_blank_lines (3, local_status);
    pup$display_line (' DELETE SUMMARY: ', local_status);
    pup$display_integer ('   NUMBER OF CYCLES DELETED: ', number_of_cycles_deleted, local_status);
    number_of_cycles_deleted := 0;
    pup$display_integer ('   TOTAL CYCLE DATA DELETED: ', total_bytes_deleted, local_status);
    total_bytes_deleted := 0;
  PROCEND display_deletion_totals;
MODEND pum$delete_all;
