?? RIGHT := 110 ??
*copyc osd$default_pragmats
MODULE ram$correct_source_library;
?? PUSH (LISTEXT := ON) ??
*copyc rac$status_id
*copyc rae$error_messages
*copyc rat$deck_index
*copyc rat$write_scl_commands
*copyc rat$source_lib_correction_hdr
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$return
*copyc clp$get_path_description
*copyc clp$scan_command_line
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$set_status_abnormal
*copyc pfp$permit
*copyc pfp$delete_permit
*copyc pmp$get_unique_name
*copyc pmp$get_user_identification
?? POP ??

*copyc rah$correct_source_library

  PROCEDURE [XDCL] rap$correct_source_library (base_file: clt$file;
        target_file: clt$file;
        p_correction: ^SEQ ( * );
    VAR status: ost$status);

    VAR
      application_info: pft$application_info,
      attribute: array [1 .. 1] of fst$file_cycle_attribute,
      ba: amt$file_byte_address,
      base_container: clt$path_container,
      base_file_ref: clt$file_reference,
      base_path: ^pft$path,
      command: ^array [1 .. * ] of rat$write_scl_commands,
      command_fid: amt$file_identifier,
      command_file: ost$name,
      correction: ^SEQ ( * ),
      correction_header: ^rat$source_lib_correction_hdr,
      cycle_sel: clt$cycle_selector,
      delete_decks: ^array [1 .. * ] of ost$name,
      group: pft$group,
      i: rat$deck_index,
      identification: ost$user_identification,
      ignore_status: ost$status,
      insert_decks: ^array [1 .. * ] of ost$name,
      j: rat$deck_index,
      number_of_commands: rat$deck_index,
      open_p: clt$open_position,
      permit_selections: pft$permit_selections,
      permit_status: ost$status,
      replace: amt$segment_pointer,
      replacement: ^SEQ ( * ),
      repl_fid: amt$file_identifier,
      repl_sl: ost$name,
      share_requirements: pft$share_requirements,
      size: integer,
      sl_replacement: ^SEQ ( * ),
      target_container: clt$path_container,
      target_file_ref: clt$file_reference,
      target_path: ^pft$path,
      text: string (osc$max_string_size),
      write_attachment: array [1 .. 2] of fst$attachment_option;

    correction := p_correction;

    pmp$get_unique_name (command_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    write_attachment [1].selector := fsc$access_and_share_modes;
    write_attachment [1].access_modes.selector := fsc$specific_access_modes;
    write_attachment [1].access_modes.value := $fst$file_access_options [fsc$read, fsc$shorten, fsc$append,
          fsc$modify];
    write_attachment [1].share_modes.selector := fsc$determine_from_access_modes;
    write_attachment [2].selector := fsc$create_file;
    write_attachment [2].create_file := TRUE;

    fsp$open_file (command_file, amc$record, ^write_attachment, NIL, NIL, NIL, NIL, command_fid,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_path_description (base_file, base_file_ref, base_container, base_path, cycle_sel, open_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_path_description (target_file, target_file_ref, target_container, target_path, cycle_sel, open_p,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    NEXT correction_header IN correction;
    IF correction_header = NIL THEN
      osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'CORRECTION FILE', status);
      RETURN;
    IFEND;
    number_of_commands := correction_header^.decks_to_delete + correction_header^.decks_to_insert + 7;
    PUSH command: [1 .. number_of_commands];
    STRINGREP (command^ [1].command, command^ [1].size, ' scu');
    STRINGREP (command^ [2].command, command^ [2].size, ' use_library b=', base_file_ref.path_name (1,
          base_file_ref.path_name_size), ' r=', target_file_ref.path_name (1, target_file_ref.
          path_name_size));
    j := 3;
    IF correction_header^.decks_to_delete > 0 THEN
      NEXT delete_decks: [1 .. correction_header^.decks_to_delete] IN correction;
      IF delete_decks = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'CORRECTION FILE', status);
        RETURN;
      IFEND;
      FOR i := 1 TO correction_header^.decks_to_delete DO
        STRINGREP (command^ [j].command, command^ [j].size, '   delete_deck ', delete_decks^ [i]);
        j := j + 1;
      FOREND;
    IFEND;

    IF correction_header^.decks_to_insert > 0 THEN
      NEXT insert_decks: [1 .. correction_header^.decks_to_insert] IN correction;
      IF insert_decks = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'CORRECTION FILE', status);
        RETURN;
      IFEND;
      FOR i := 1 TO correction_header^.decks_to_insert DO
        STRINGREP (command^ [j].command, command^ [j].size, '   create_deck d=', insert_decks^ [i],
          ' m=dummmy');
        j := j + 1;
      FOREND;
    IFEND;

    IF correction_header^.size_of_replacement > 0 THEN
      NEXT replacement: [[REP correction_header^.size_of_replacement OF cell]] IN correction;
      IF replacement = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, 'CORRECTION FILE', status);
        RETURN;
      IFEND;

      pmp$get_unique_name (repl_sl, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      attribute [1].selector := fsc$file_contents_and_processor;
      attribute [1].file_contents := fsc$legible_library;
      attribute [1].file_processor := fsc$scu;

      fsp$open_file (repl_sl, amc$segment, ^write_attachment, ^attribute, NIL, NIL, NIL, repl_fid,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      amp$get_segment_pointer (repl_fid, amc$sequence_pointer, replace, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      NEXT sl_replacement: [[REP correction_header^.size_of_replacement OF cell]] IN replace.sequence_pointer;
      IF sl_replacement = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, repl_sl, status);
        RETURN;
      IFEND;

      sl_replacement^ := replacement^;

      fsp$close_file (repl_fid, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      STRINGREP (command^ [j].command, command^ [j].size, '   replace_libraries ', repl_sl);
      j := j + 1;
    IFEND;
    STRINGREP (command^ [j].command, command^ [j].size, ' quit yes');


    number_of_commands := j;
    FOR i := 1 TO number_of_commands DO
      amp$put_next (command_fid, ^command^ [i].command, command^ [i].size, ba, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

    fsp$close_file (command_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


{    In order to successfully run SCU a permit must be built giving the user all authority }
{  on access mode and an application information value of 'I4'.                            }
{    The permit is deleted as soon as possible.  The source library used is from the       }
{  installation catalog and so the assumption that a permit does'nt already exist can      }
{  be made. }


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

    group.group_type := pfc$user;
    group.user_description.family := identification.family;
    group.user_description.user := identification.user;

    application_info := 'I4';
    permit_selections := $pft$permit_selections [pfc$read, pfc$shorten, pfc$append, pfc$modify, pfc$execute,
          pfc$cycle, pfc$control];
    share_requirements := $pft$share_requirements [];

    pfp$permit (base_path^, group, permit_selections, share_requirements, application_info, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    STRINGREP (text, size, ' include_file f=', command_file);
    clp$scan_command_line (text (1, size), status);
    pfp$delete_permit (base_path^, group, permit_status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF NOT permit_status.normal THEN
      status := permit_status;
      RETURN;
    IFEND;

    amp$return (command_file, ignore_status);
    amp$return (repl_sl, ignore_status);

  PROCEND rap$correct_source_library;
MODEND ram$correct_source_library;
