?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := 'DETACH_LOCAL_FILES ' ??
MODULE clm$detach_local_files;
{   PURPOSE: This module contains the procedure for detaching local files.
*copyc cle$ecc_file_reference
*copyc clt$parameter_list
*copyc ost$status
*copyc pmt$condition
*copyc rae$upgrade_errors

*copyc amp$return
*copyc clp$get_list_of_$local_files
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc clp$get_set_count
*copyc jmp$system_job
*copyc mmp$create_segment
*copyc mmp$delete_segment
*copyc osp$append_status_parameter
*copyc osp$establish_block_exit_hndlr
*copyc osp$disestablish_cond_handler
*copyc osp$set_status_abnormal
*copyc pfp$find_directory_array
*copyc pfp$find_direct_info_record
*copyc pfp$find_next_info_record
*copyc rmp$get_device_class


  CONST
    max_element_in_parameter = 256,
    max_standard_file = 3;

  TYPE

    device_class_set = set of rmt$device_class;


  PROCEDURE [XDCL, #GATE] clp$detach_local_files
    (    parameter_list: clt$parameter_list;

     VAR status: ost$status);

{ PDT detach_local_files_pdt(
{    device_class, dc : list of key magnetic_tape, mt, ...
{                                   mass_storage, ms, ...
{                                   terminal, t, null, n, ...
{                                   all, a = all
{     exclude_unique_files, euf : boolean = false
{     exclude_files, exclude_file, ef : list of name
{     status)



    VAR
      detach_local_files_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^detach_local_files_pdt_names, ^detach_local_files_pdt_params];

    VAR
      detach_local_files_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
            clt$parameter_name_descriptor := [['DEVICE_CLASS', 1], ['DC', 1],
            ['EXCLUDE_UNIQUE_FILES', 2], ['EUF', 2], ['EXCLUDE_FILES', 3], ['EF', 3],
            ['STATUS', 4]];

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

{ DEVICE_CLASS DC}
      [[clc$optional_with_default, ^detach_local_files_pdt_dv1], 1, clc$max_value_sets, 1, 1,
            clc$value_range_not_allowed, [^detach_local_files_pdt_kv1, clc$keyword_value]],


{ EXCLUDE_UNIQUE_FILES EUF}
      [[clc$optional_with_default, ^detach_local_files_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

{EXCLUDE_FILES EF}

      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$name_value, 1, osc$max_name_size]],

{STATUS }

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

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


    VAR
      detach_local_files_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'FALSE';

    VAR
      detach_local_files_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 10] of
            ost$name := ['MAGNETIC_TAPE', 'MT', 'MASS_STORAGE', 'MS', 'TERMINAL', 'T', 'NULL', 'N', 'ALL',
            'A'];



    VAR
      info: pft$p_info,
      info_record: pft$p_info_record,
      directory: pft$p_directory_array,
      ignore_status: ost$status,
      local_status: ost$status,
      info_segment_pointer: mmt$segment_pointer,
      info_segment_open: boolean,
      exclude_files_count: 0 .. max_element_in_parameter,
      exclude_files_list_ptr: ^array [1 .. * ] of ost$name,
      local_file: ost$name,
      j: 1 .. max_standard_file,
      index: 1 .. max_element_in_parameter,
      ef_index: 1 .. max_element_in_parameter,
      specified_device_class: device_class_set,
      returned_device_class: rmt$device_class,
      device_assigned: boolean,
      euf_value: clt$value,
      f: 1 .. max_element_in_parameter,
      i: 1 .. max_element_in_parameter,
      ef_value: clt$value,
      parm_count: 0 .. clc$max_value_sets,
      value: clt$value,
      p_count: 0 .. clc$max_value_sets,
      standard_file: [STATIC, READ] array [1 .. max_standard_file] of ost$name :=
            ['COMMAND                        ', 'INPUT                          ',
            'OUTPUT                         '];

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF info_segment_open THEN
        mmp$delete_segment (info_segment_pointer, 1, ignore_status);
        info_segment_open := FALSE;
      IFEND;

    PROCEND abort_handler;



    status.normal := TRUE;
    info_segment_open := FALSE;
    osp$establish_block_exit_hndlr (^abort_handler);
    exclude_files_count := 0;
    specified_device_class := $device_class_set [];
    clp$scan_parameter_list (parameter_list, detach_local_files_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF jmp$system_job () THEN
      osp$set_status_abnormal ('CL', rae$illegal_command_call, 'DETACH_LOCAL_FILES', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'from the operator console', status);
      RETURN;
    IFEND;

    clp$get_set_count ('DEVICE_CLASS', parm_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    FOR i := 1 TO parm_count DO
      clp$get_value ('DEVICE_CLASS', i, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (value.name.value (1)) = 'A' THEN
        IF parm_count <> 1 THEN
          osp$set_status_abnormal ('CL', cle$all_must_be_used_alone, 'DEVICE_CLASS', status);
          RETURN;
        ELSE
          specified_device_class := -$device_class_set [];
        IFEND;
      ELSEIF ((value.name.value (1, 3) = 'MAG') OR (value.name.value (1, 2) = 'MT')) THEN
        specified_device_class := specified_device_class + $device_class_set [rmc$magnetic_tape_device];
      ELSEIF ((value.name.value (1, 3) = 'MAS') OR (value.name.value (1, 2) = 'MS')) THEN
        specified_device_class := specified_device_class + $device_class_set [rmc$mass_storage_device];
      ELSEIF value.name.value (1) = 'T' THEN
        specified_device_class := specified_device_class + $device_class_set [rmc$terminal_device];
      ELSEIF value.name.value (1) = 'N' THEN
        specified_device_class := specified_device_class + $device_class_set [rmc$null_device];
      IFEND;
    FOREND;



    clp$get_value ('EXCLUDE_UNIQUE_FILES', 1, 1, clc$low, euf_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('EXCLUDE_FILES', p_count, status);
    IF p_count > 0 THEN
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      PUSH exclude_files_list_ptr: [1 .. p_count];
      exclude_files_count := p_count;
      FOR f := 1 TO p_count DO
        clp$get_value ('EXCLUDE_FILES', f, 1, clc$low, ef_value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        exclude_files_list_ptr^ [f] := ef_value.name.value (1, 31);
      FOREND;
    IFEND;




  /main/
    BEGIN
      mmp$create_segment (NIL, mmc$sequence_pointer, 1, info_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      info_segment_open := TRUE;
      info := info_segment_pointer.seq_pointer;
      RESET info;


      clp$get_list_of_$local_files (info, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      RESET info;
      pfp$find_next_info_record (info, info_record, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      pfp$find_directory_array (info_record, directory, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      FOR index := LOWERBOUND (directory^) TO UPPERBOUND (directory^) DO
        IF directory^ [index].name_type = pfc$file_name THEN
          local_file := directory^ [index].name;
          rmp$get_device_class (local_file, device_assigned, returned_device_class, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

        /return_file/
          BEGIN

            FOR j := LOWERBOUND (standard_file) TO UPPERBOUND (standard_file) DO
              IF local_file = standard_file [j] THEN
                EXIT /return_file/;
              IFEND;
            FOREND;
            IF (local_file (3, 2) = 'F$') AND (returned_device_class <> rmc$magnetic_tape_device) THEN
                EXIT /return_file/;
            IFEND;
            IF (local_file (1) = '$') AND (returned_device_class <> rmc$magnetic_tape_device) THEN
              IF (local_file (11) = 'S') AND (local_file (16) = 'D') AND
                    (local_file (25) = 'T') THEN
                IF euf_value.bool.value THEN
                  EXIT /return_file/;
                IFEND;
              ELSE
                EXIT /return_file/;
              IFEND;
            IFEND;
            IF exclude_files_count <> 0 THEN
              FOR ef_index := LOWERBOUND (exclude_files_list_ptr^) TO UPPERBOUND (exclude_files_list_ptr^) DO
                IF local_file = exclude_files_list_ptr^ [ef_index] THEN
                  EXIT /return_file/;
                IFEND;
              FOREND;
            IFEND;
            IF (returned_device_class IN specified_device_class) THEN
              amp$return (local_file, ignore_status);
              EXIT /return_file/;
            IFEND;

          END /return_file/;
        IFEND;
      FOREND;
    END /main/;
    IF info_segment_open THEN
      mmp$delete_segment (info_segment_pointer, 1, local_status);
      info_segment_open := FALSE;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;
  PROCEND clp$detach_local_files;

MODEND clm$detach_local_files;
