?? RIGHT := 110 ??
?? NEWTITLE := 'INSTALL_SOFTWARE Utility: RAP$RECORD_DISK_PATH Interface.' ??
MODULE ram$record_disk_path;

{ PURPOSE:
{   This module contains the interface and procedures that records the path
{   to the disk order file in the packing list.
{
{ DESIGN:
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rae$install_software_cc
*copyc rac$control_job_identifier
*copyc rac$packing_list_level
*copyc rac$pacs_processor_version
*copyc fst$path
*copyc rat$installation_control_record
*copyc rat$packing_list_sequence
*copyc rat$sequence_descriptor_types
?? POP ??
*copyc amp$get_segment_pointer
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_file
*copyc osp$append_status_parameter
*copyc osp$establish_block_exit_hndlr
*copyc osp$disestablish_cond_handler
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc rav$installation_defaults

?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

?? TITLE := '[XDCL] rap$record_disk_path', EJECT ??

{ PURPOSE:
{   This interface records the path to the disk order file in the packing
{   list.
{
{ DESIGN:
{
{ NOTES:
{   This interface was designed for a specific purpose (modifying a packing
{   list for a disk order).  Because of this fact it was deemed uneccessary
{   to report the passing in of a tape order packing list.  This condition
{   is tested for however.
{

  PROCEDURE [XDCL] rap$record_disk_path
    (    disk_path: fst$file_reference;
         packing_list: fst$file_reference;
     VAR status: ost$status);


    VAR
      attachment_options: array [1 .. 4] of fst$attachment_option,
      file_opened: boolean,
      local_status: ost$status,
      packing_list_fid: amt$file_identifier,
      packing_list_header_p: ^rat$packing_list_header;


?? NEWTITLE := 'abort_handler', EJECT ??

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs within the
{   block structure.
{
{ DESIGN:
{   The function of this condition handler is to close the packing list
{   file when an abort condition arises.
{
{ NOTES:
{

    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;

      fsp$close_file (packing_list_fid, ignore_status);

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    osp$establish_block_exit_hndlr (^abort_handler);

  /main/
    BEGIN

      attachment_options [1].selector := fsc$access_and_share_modes;
      attachment_options [1].access_modes.selector := fsc$specific_access_modes;
      attachment_options [1].access_modes.value := $fst$file_access_options [fsc$read, fsc$modify];
      attachment_options [1].share_modes.selector := fsc$specific_share_modes;
      attachment_options [1].share_modes.value := $fst$file_access_options [];
      attachment_options [2].selector := fsc$open_share_modes;
      attachment_options [2].open_share_modes := $fst$file_access_options [];
      attachment_options [3].selector := fsc$create_file;
      attachment_options [3].create_file := FALSE;
      attachment_options [4].selector := fsc$wait_for_attachment;
      attachment_options [4].wait_for_attachment.wait := osc$wait;
      attachment_options [4].wait_for_attachment.wait_time := fsc$longest_wait_time;

      file_opened := TRUE;
      fsp$open_file (packing_list, amc$segment, ^attachment_options, NIL, NIL, NIL, NIL, packing_list_fid,
            status);
      IF NOT status.normal THEN
        file_opened := FALSE;
        EXIT /main/;
      IFEND;

      establish_packing_list_pointers (packing_list_fid, packing_list, packing_list_header_p, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF packing_list_header_p^.order_medium = rac$disk THEN

        packing_list_header_p^.disk_path := disk_path;

      IFEND;

    END /main/;

    IF file_opened THEN
      fsp$close_file (packing_list_fid, local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND rap$record_disk_path;

?? TITLE := 'establish_packing_list_pointers', EJECT ??

{ PURPOSE:
{   This procedure establishes the pointers to the major data structures
{   in the packing list.
{
{ DESIGN:
{
{   Validation errors are returned in the status variable.
{
{ NOTES:
{   Commonality between this procedure and establish_packing_list_pointers
{   in ram$access_packing_list should be analyzed and the two written as
{   one.
{

  PROCEDURE establish_packing_list_pointers
    (    packing_list_fid: amt$file_identifier;
         packing_list: fst$file_reference;
     VAR packing_list_header_p {output} : ^rat$packing_list_header;
     VAR status: ost$status);


    VAR
      ignore_status: ost$status,
      local_status: ost$status,
      segment_pointer: amt$segment_pointer,
      sequence_descriptor_p: ^rat$sequence_descriptor;


    status.normal := TRUE;

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

    RESET segment_pointer.sequence_pointer;
    NEXT sequence_descriptor_p IN segment_pointer.sequence_pointer;
    IF sequence_descriptor_p = NIL THEN
      set_status_abnormal (rae$unexpected_eof_packing_list, packing_list, status);
      RETURN;
    IFEND;

    IF sequence_descriptor_p^.sequence_type <> rac$packing_list_sequence THEN
      set_status_abnormal (rae$invalid_packing_list, packing_list, status);
      RETURN;
    IFEND;

    IF sequence_descriptor_p^.sequence_level <> rac$packing_list_level THEN
      osp$set_status_abnormal ('RA', rae$incompatible_sequence_level, 'PACKING LIST', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, sequence_descriptor_p^.sequence_level,
            status);
      RETURN;
    IFEND;

    IF sequence_descriptor_p^.processor_version <> rac$pacs_processor_version THEN
      osp$set_status_abnormal ('RA', rae$different_processor_version, 'PACKING LIST', local_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], local_status, ignore_status);
    IFEND;

    NEXT packing_list_header_p IN segment_pointer.sequence_pointer;
    IF packing_list_header_p = NIL THEN
      set_status_abnormal (rae$unexpected_eof_packing_list, packing_list, status);
      RETURN;
    IFEND;

  PROCEND establish_packing_list_pointers;

?? TITLE := 'set_status_abnormal', EJECT ??

{ PURPOSE:
{   This procedure sets the status to the defined condition.  The
{   conditions allowed have common parameter values.  The set status is
{   returned in the status parameter.
{
{ DESIGN:
{   Conditions allowed are:  RAE$UNEXPECTED_EOF_PACKING_LIST and
{   RAE$INVALID_PACKING_LIST.
{
{ NOTES:
{

  PROCEDURE set_status_abnormal
    (    condition_code: ost$status_condition_code;
         packing_list: fst$file_reference;
     VAR status: ost$status);


    VAR
      installation_database: rat$path,
      packing_list_name: ost$name,
      packing_list_name_length: integer;


    status.normal := TRUE;

    installation_database := rav$installation_defaults.installation_database;

    packing_list_name_length := #SIZE (packing_list) - installation_database.size - 1;
    packing_list_name := packing_list (installation_database.size + 1, packing_list_name_length);

    osp$set_status_abnormal ('RA', condition_code, packing_list_name (1, packing_list_name_length), status);
    osp$append_status_file (osc$status_parameter_delimiter, installation_database.
          path (1, installation_database.size), status);

  PROCEND set_status_abnormal;
MODEND ram$record_disk_path;
