?? RIGHT := 110 ??
?? NEWTITLE := 'INSTALL_SOFTWARE UTILITY: EXECUTE_INSTALLER_PROCEDURE Subutility Interface.' ??
MODULE ram$execute_installer_procs_utl;

{ PURPOSE:
{   This module contains the EXECUTE_INSTALLER_PROCEDURE subutility of
{   INSTALL_SOFTWARE.  The procedures in this module create an environment
{   in order to execute installer procedures.  The utility will execute an
{   installer procedure when called during installation or can be used by a
{   developer to test an installer procedure.
{ DESIGN:
{   This module follows standard utility design with the exception that
{   command interface for the utility resides in the module
{   RAM$EXECUTE_INSTALLER_PROCS_CMD.
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$type_kind
*copyc clt$variable_name_reference
*copyc fst$number_of_path_elements
*copyc rae$install_software_cc
*copyc rat$installation_control_record
*copyc rat$installation_defaults
*copyc rat$processing_types
*copyc rat$subproduct_info_pointers
?? POP ??
*copyc clp$begin_utility
*copyc clp$create_procedure_variable
*copyc clp$create_environment_variable
*copyc clp$delete_variable
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$get_variable_value
*copyc clp$include_file
*copyc clp$include_line
*copyc clp$trimmed_string_size
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc rap$assemble_installation_path
*copyc rap$convert_path_to_str
*copyc rav$subproduct_type

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

  VAR
    rav$exeip_utility_name: [XDCL] clt$utility_name := 'EXECUTE_INSTALLER_PROCEDURE';

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] rap$execute_installer_procs_utl', EJECT ??

{ PURPOSE:
{   This procedure sets up the EXECUTE_INSTALLER_PROCEDURE utility
{   session.
{
{ DESIGN:
{   This follows standard utility design.  Enter the utility.  Then create
{   the SCL variables and types which are to be available during the utility
{   session.  (For a description of the variable and type creation process,
{   refer to procedure CREATE_SUBPRODUCT_INFO_VAR.  The scratch sequence
{   provided by the caller of this interface is used for creating the
{   variables.  If an installer procedure was passed in by the caller,
{   execute it using INCLUDE_LINE.  If none was given, perform an
{   INCLUDE_FILE.  This will allow execution of installer procedures in a
{   test mode.  At the completion of the INCLUDE_FILE or INCLUDE_COMMAND,
{   terminate the utility.
{ NOTES:
{   It is not necessary to clean up the VARs and TYPEs created on an error
{   or at the end of the utility will be cleaned up by SCL when the utility
{   terminates.

  PROCEDURE [XDCL] rap$execute_installer_procs_utl
    (    subp_processing_record: rat$subp_processing_record;
         subproduct_data_available: boolean;
     VAR installation_control_record: rat$installation_control_record;
     VAR status: ost$status);


{ table n=exeip_command_table t=command s=xdcl
{ command n=(install_file, insf) p=rap$install_file cm=procedure
{ command n=(update_library, updl) p=rap$update_library cm=procedure
{ command n=(rap$get_catalog_file_names) p=rap$get_catalog_file_names cm=procedure a=hidden
{ command n=(rap$get_file_ring_attributes) p=rap$get_file_ring_attributes cm=procedure a=hidden
{ command n=(rap$remove_elements_from_path) p=rap$remove_elements_from_path cm=procedure a=hidden
{ command n=(quit, qui) p=rap$quit_exeip cm=xref
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  exeip_command_table: [XDCL, READ] ^clt$command_table := ^exeip_command_table_entries,

  exeip_command_table_entries: [STATIC, READ] array [1 .. 9] of clt$command_table_entry := [
  {} ['INSF                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$proc_call, 'RAP$INSTALL_FILE'],
  {} ['INSTALL_FILE                   ', clc$nominal_entry, clc$normal_usage_entry, 1,
        clc$automatically_log, clc$proc_call, 'RAP$INSTALL_FILE'],
  {} ['QUI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$quit_exeip],
  {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 6,
        clc$automatically_log, clc$linked_call, ^rap$quit_exeip],
  {} ['RAP$GET_CATALOG_FILE_NAMES     ', clc$nominal_entry, clc$hidden_entry, 3, clc$automatically_log,
         clc$proc_call, 'RAP$GET_CATALOG_FILE_NAMES'],
  {} ['RAP$GET_FILE_RING_ATTRIBUTES   ', clc$nominal_entry, clc$hidden_entry, 4, clc$automatically_log,
         clc$proc_call, 'RAP$GET_FILE_RING_ATTRIBUTES'],
  {} ['RAP$REMOVE_ELEMENTS_FROM_PATH  ', clc$nominal_entry, clc$hidden_entry, 5, clc$automatically_log,
         clc$proc_call, 'RAP$REMOVE_ELEMENTS_FROM_PATH'],
  {} ['UPDATE_LIBRARY                 ', clc$nominal_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$proc_call, 'RAP$UPDATE_LIBRARY'],
  {} ['UPDL                           ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
        clc$automatically_log, clc$proc_call, 'RAP$UPDATE_LIBRARY']];

  PROCEDURE [XREF] rap$quit_exeip
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? POP ??


    CONST
      prompt_size = 5,
      prompt_value = 'EXEIP';

    VAR
      installer_procedure: rat$path,
      installer_pf_path_p: ^pft$path,
      linker_errors_found: ^clt$data_value,
      local_status: ost$status,
      scratch_sequence_p: ^SEQ ( * ),
      utility_attributes_p: ^clt$utility_attributes;


    status.normal := TRUE;

    PUSH utility_attributes_p: [1 .. 3];
    utility_attributes_p^ [1].key := clc$utility_command_search_mode;
    utility_attributes_p^ [1].command_search_mode := clc$global_command_search;
    utility_attributes_p^ [2].key := clc$utility_command_table;
    utility_attributes_p^ [2].command_table := exeip_command_table;
    utility_attributes_p^ [3].key := clc$utility_prompt;
    utility_attributes_p^ [3].prompt.size := prompt_size;
    utility_attributes_p^ [3].prompt.value := prompt_value;

    clp$begin_utility (rav$exeip_utility_name, utility_attributes_p^, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    scratch_sequence_p := installation_control_record.scratch_seq_p;
    RESET scratch_sequence_p;

  /main/
    BEGIN

      IF subproduct_data_available = TRUE THEN

        rap$assemble_installation_path (installation_control_record.processing_header_p^.
              installation_defaults.system_catalog, subp_processing_record.subproduct_info_pointers,
              rac$installer_procedure, installer_pf_path_p, installation_control_record.scratch_seq_p,
              status);

        IF NOT status.normal THEN
          RETURN;
        IFEND;

        rap$convert_path_to_str (installer_pf_path_p^, installer_procedure);

      IFEND;

      create_subproduct_info_var (subp_processing_record, subproduct_data_available,
            installer_procedure, installation_control_record. processing_seq_p, scratch_sequence_p,
            status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      create_installation_deflts_var (installation_control_record.processing_header_p^.installation_defaults,
            scratch_sequence_p, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      create_installation_envirn_var (installation_control_record.processing_header_p, scratch_sequence_p,
            status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF subproduct_data_available = TRUE THEN
        clp$include_line (installer_procedure.path (1, installer_procedure.size), TRUE,
              osc$null_name, status);
      ELSE
        clp$include_file (clc$current_command_input, prompt_value, rav$exeip_utility_name, status);
      IFEND;

      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF installer_procedure.path(1,installer_procedure.size) =
           ':$SYSTEM.$SYSTEM.SOFTWARE_MAINTENANCE.RAF$LIBRARY.INSTALL_NOSVE_MAINTENANCE' THEN
        clp$get_variable_value ('RAV$LINKER_ERRORS_FOUND', linker_errors_found, local_status);
        IF NOT local_status.normal THEN
          EXIT /main/;
        IFEND;

        IF linker_errors_found <> NIL THEN
          IF linker_errors_found^.boolean_value.value THEN
            osp$set_status_abnormal ('RA', rae$linker_errors_occurred, ' ', status);
          IFEND;
        IFEND;

{ If we get here, delete the variable and ignore the status.

        clp$delete_variable ('RAV$LINKER_ERRORS_FOUND', local_status);
      IFEND;

    END /main/;

    clp$end_utility (rav$exeip_utility_name, local_status);

    IF (status.normal) AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

  PROCEND rap$execute_installer_procs_utl;
?? OLDTITLE ??
?? NEWTITLE := 'create_subproduct_info_var', EJECT ??
{ PURPOSE:
{   This procedure creates the SCL variable and type which make the
{   attributes of the subproduct being installed available to the user.
{ DESIGN:
{   The process used to create the type declaration and var declaration
{   follows the guidelines the guidelines described in the SCL ERS.  Since
{   the variable created is a user defined type the process is somewhat more
{   complicated than if the variable were a standard NAME, or STRING type
{   variable.  The code is also complicated because the variables must be
{   initialized differently depending upon whether the utility was entered
{   from the command interface or from CYBIL during installation.  From the
{   command interface, there is no data available to initialize the variable
{   (except for the installation defaults variable).  From the CYBIL
{   interface, information about the current subproduct being installed is
{   passed into the utility.
{
{   The processed used to create each variable and type is as follows:
{
{   1.  Create the SCL type.  This type will be available to the user while
{       in the utility.  See procedure CREATE_SCL_TYPE for details about how the
{       type is created.
{
{   2.  In order to initialize the variable, a structure of type
{       clt$data_value must be created.  This structure is created in the
{       scratch sequence.  The number of fields in the variable determine how
{       big the structure will be.
{
{   3.  Initialize each field of the record.  If a value is available for a
{       field (was passed into the procedure), a value is assigned.  Otherwise
{       the field value is set to NIL.  Setting the field value to NIL causes
{       the field of the record to be DEFINED, but not INITIALIZED.  (DEFINED
{       and INITIALIZED are actual SCL terms in this case.  See the $FIELD
{       function.)
{
{       Although it would make this procedure shorter to initialize the fields
{       of the variable in a separate subroutine, the initialization was kept
{       here to keep the declaration of the record structure as close as
{       possible to the initialization of the fields.  This, it was thought,
{       would simplify maintenance.
{
{   4.  Create the SCL variable.  The variable will have scope XDCL so it
{       will be accessible to the user inside their installer procedure.
{       The type specification used to create the SCL type in step 1 is the
{       same one used to create the SCL variable.
{ NOTES:
{   If the subproduct_info_pointers.attributes_p is NIL, then it is assumed
{   that all the pointers for the subproduct are NIL.  This occurs when the
{   utility was invoked from the the command interface rather than the CYBIL
{   interface.

  PROCEDURE create_subproduct_info_var
    (    subp_processing_record: rat$subp_processing_record;
         subproduct_data_available: boolean;
         installer_procedure: rat$path;
         processing_seq_p: ^rat$processing_sequence;
     VAR scratch_sequence_p: ^SEQ ( * );
     VAR status: ost$status);

{ The value for the NUMBER_OF_RECORD_FIELDS constant and the actual number of
{ fields in the rav$subproduct_information record MUST match.

    CONST
      number_of_record_fields = 11;

{ TYPE
{   rav$subproduct_information: record
{     active_level_path:         file =$optional
{     actual_installation_path:  file =$optional
{     base_level_path:           file =$optional
{     correction_base_level:     name =$optional
{     correction_base_path:      file =$optional
{     defined_installation_path: file =$optional
{     installer_procedure:       file =$optional
{     internal_level:            name =$optional
{     level:                     name =$optional
{     subproduct_name:           name =$optional
{     subproduct_type:           name =$optional
{   recend
{ TYPEND

?? PUSH (LISTEXT := ON) ??

  VAR
    type_specification : [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      name: string (26),
      qualifier: clt$record_type_qualifier,
      field_spec_1: clt$field_specification,
      element_type_spec_1: record
        header: clt$type_specification_header,
      recend,
      field_spec_2: clt$field_specification,
      element_type_spec_2: record
        header: clt$type_specification_header,
      recend,
      field_spec_3: clt$field_specification,
      element_type_spec_3: record
        header: clt$type_specification_header,
      recend,
      field_spec_4: clt$field_specification,
      element_type_spec_4: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_5: clt$field_specification,
      element_type_spec_5: record
        header: clt$type_specification_header,
      recend,
      field_spec_6: clt$field_specification,
      element_type_spec_6: record
        header: clt$type_specification_header,
      recend,
      field_spec_7: clt$field_specification,
      element_type_spec_7: record
        header: clt$type_specification_header,
      recend,
      field_spec_8: clt$field_specification,
      element_type_spec_8: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_9: clt$field_specification,
      element_type_spec_9: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_10: clt$field_specification,
      element_type_spec_10: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_11: clt$field_specification,
      element_type_spec_11: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
    recend := [
      [1, 26, clc$record_type], 'RAV$SUBPRODUCT_INFORMATION', [11],
      ['ACTIVE_LEVEL_PATH              ', clc$optional_field, 3], [[1, 0, clc$file_type]],
      ['ACTUAL_INSTALLATION_PATH       ', clc$optional_field, 3], [[1, 0, clc$file_type]],
      ['BASE_LEVEL_PATH                ', clc$optional_field, 3], [[1, 0, clc$file_type]],
      ['CORRECTION_BASE_LEVEL          ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['CORRECTION_BASE_PATH           ', clc$optional_field, 3], [[1, 0, clc$file_type]],
      ['DEFINED_INSTALLATION_PATH      ', clc$optional_field, 3], [[1, 0, clc$file_type]],
      ['INSTALLER_PROCEDURE            ', clc$optional_field, 3], [[1, 0, clc$file_type]],
      ['INTERNAL_LEVEL                 ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['LEVEL                          ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['SUBPRODUCT_NAME                ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['SUBPRODUCT_TYPE                ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]]
      ];

?? POP ??

    VAR
      active_level_catalog_pf_path_p: ^pft$path,
      attributes_p: ^rat$subproduct_attributes,
      base_level_catalog_pf_path_p: ^pft$path,
      converted_path_p: ^rat$path,
      corr_base_catalog_pf_path_p: ^pft$path,
      initial_value_p: ^clt$data_value,
      installation_path_p: ^pft$path,
      installation_path_index: rat$path_container_length,
      path_element: fst$number_of_path_elements;

    status.normal := TRUE;
    IF subproduct_data_available THEN
      attributes_p := subp_processing_record.subproduct_info_pointers.attributes_p;
    IFEND;

    create_scl_type ('rat$subproduct_information', #SEQ (type_specification), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_memory_for_initial_value (number_of_record_fields, initial_value_p, scratch_sequence_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Initialize the fields of the record.

    initial_value_p^.kind := clc$record;

    initial_value_p^.field_values^ [1].name := 'ACTIVE_LEVEL_PATH';
    IF subproduct_data_available AND (subp_processing_record.active_level_catalog_rel_p <> NIL) THEN
      PUSH converted_path_p;
      active_level_catalog_pf_path_p :=  #PTR (subp_processing_record.active_level_catalog_rel_p,
            processing_seq_p^);
      rap$convert_path_to_str (active_level_catalog_pf_path_p^, converted_path_p^);
      initial_value_p^.field_values^ [1].value^.kind := clc$file;
      initial_value_p^.field_values^ [1].value^.file_value :=
           ^converted_path_p^.path (1, converted_path_p^.size);
    ELSE
      initial_value_p^.field_values^ [1].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [2].name := 'ACTUAL_INSTALLATION_PATH';
    IF subproduct_data_available THEN
      PUSH converted_path_p;
      rap$convert_path_to_str (subp_processing_record.installation_catalog_p^, converted_path_p^);
      initial_value_p^.field_values^ [2].value^.kind := clc$file;
      initial_value_p^.field_values^ [2].value^.file_value :=
           ^converted_path_p^.path (1, converted_path_p^.size);
    ELSE
      initial_value_p^.field_values^ [2].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [3].name := 'BASE_LEVEL_PATH';
    IF subproduct_data_available AND (subp_processing_record.base_level_catalog_rel_p <> NIL) THEN
      PUSH converted_path_p;
      base_level_catalog_pf_path_p :=  #PTR (subp_processing_record.base_level_catalog_rel_p,
            processing_seq_p^);
      rap$convert_path_to_str (base_level_catalog_pf_path_p^, converted_path_p^);
      initial_value_p^.field_values^ [3].value^.kind := clc$file;
      initial_value_p^.field_values^ [3].value^.file_value :=
           ^converted_path_p^.path (1, converted_path_p^.size);
    ELSE
      initial_value_p^.field_values^ [3].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [4].name := 'CORRECTION_BASE_LEVEL';
    IF (subproduct_data_available) AND (attributes_p^.correction_base_level <> osc$null_name) THEN
      initial_value_p^.field_values^ [4].value^.kind := clc$name;
      initial_value_p^.field_values^ [4].value^.name_value := attributes_p^.correction_base_level;
    ELSE
      initial_value_p^.field_values^ [4].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [5].name := 'CORRECTION_BASE_PATH';
    IF subproduct_data_available AND (subp_processing_record.correction_base_catalog_rel_p <> NIL) THEN
      PUSH converted_path_p;
      corr_base_catalog_pf_path_p :=  #PTR (subp_processing_record.correction_base_catalog_rel_p,
            processing_seq_p^);
      rap$convert_path_to_str (corr_base_catalog_pf_path_p^, converted_path_p^);
      initial_value_p^.field_values^ [5].value^.kind := clc$file;
      initial_value_p^.field_values^ [5].value^.file_value :=
           ^converted_path_p^.path (1, converted_path_p^.size);
    ELSE
      initial_value_p^.field_values^ [5].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [6].name := 'DEFINED_INSTALLATION_PATH';
    IF subproduct_data_available THEN
      installation_path_index := attributes_p^.installation_path.path_container_index;
      PUSH installation_path_p: [1 .. attributes_p^.installation_path.path_length];
      FOR path_element := 1 TO UPPERBOUND (installation_path_p^) DO
        installation_path_p^ [path_element] := subp_processing_record.subproduct_info_pointers.
              path_container_p^ [installation_path_index];
        installation_path_index := installation_path_index + 1;
      FOREND;
      PUSH converted_path_p;
      rap$convert_path_to_str (installation_path_p^, converted_path_p^);
      initial_value_p^.field_values^ [6].value^.kind := clc$file;
      initial_value_p^.field_values^ [6].value^.file_value :=
         ^converted_path_p^.path (1, converted_path_p^.size);
    ELSE
      initial_value_p^.field_values^ [6].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [7].name := 'INSTALLER_PROCEDURE';
    IF subproduct_data_available THEN
      initial_value_p^.field_values^ [7].value^.kind := clc$file;
      initial_value_p^.field_values^ [7].value^.file_value :=
         ^installer_procedure.path (1, installer_procedure.size);
    ELSE
      initial_value_p^.field_values^ [7].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [8].name := 'INTERNAL_LEVEL';
    IF (subproduct_data_available) AND (attributes_p^.internal_level <> osc$null_name) THEN
      initial_value_p^.field_values^ [8].value^.kind := clc$name;
      initial_value_p^.field_values^ [8].value^.name_value := attributes_p^.internal_level;
    ELSE
      initial_value_p^.field_values^ [8].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [9].name := 'LEVEL';
    IF subproduct_data_available THEN
      initial_value_p^.field_values^ [9].value^.kind := clc$name;
      initial_value_p^.field_values^ [9].value^.name_value := attributes_p^.level;
    ELSE
      initial_value_p^.field_values^ [9].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [10].name := 'SUBPRODUCT_NAME';
    IF subproduct_data_available THEN
      initial_value_p^.field_values^ [10].value^.kind := clc$name;
      initial_value_p^.field_values^ [10].value^.name_value := attributes_p^.name;
    ELSE
      initial_value_p^.field_values^ [10].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [11].name := 'SUBPRODUCT_TYPE';
    IF subproduct_data_available THEN
      initial_value_p^.field_values^ [11].value^.kind := clc$name;
      initial_value_p^.field_values^ [11].value^.name_value :=
            rav$subproduct_type [attributes_p^.subproduct_type];
    ELSE
      initial_value_p^.field_values^ [11].value := NIL;
    IFEND;

    clp$create_procedure_variable ('RAV$SUBPRODUCT_INFORMATION', clc$xdcl_scope, clc$read_write,
          clc$immediate_evaluation, #SEQ (type_specification), initial_value_p, status);

  PROCEND create_subproduct_info_var;

?? OLDTITLE ??
?? NEWTITLE := 'create_installation_deflts_var', EJECT ??

{ PURPOSE:
{   This procedure creates the SCL variable and type which make the current
{   INSTALL_SOFTWARE utility session installation defaults available to the
{   user.
{ DESIGN:
{   For a description of the SCL variable and type creation process, refer to the
{   documentation of procedure CREATE_SUBPRODUCT_INFO_VAR.
{ NOTES:
{   Unlike the other variables created, all the field values are always
{   available.

  PROCEDURE create_installation_deflts_var
    (    installation_defaults: rat$installation_defaults;
     VAR scratch_sequence_p: ^SEQ ( * );
     VAR status: ost$status);

{ The value for the NUMBER_OF_RECORD_FIELDS constant and the actual number of
{ fields in the rav$installation_defaults record MUST match.

    CONST
      number_of_record_fields = 6;

{ TYPE
{   rav$installation_defaults:  record
{     correction_bases      : file
{     ignore_storage_class  : boolean
{     installation_database : file
{     installation_logs     : file
{     relax_ring_settings   : boolean
{     system_catalog        : file = $optional
{   recend
{ TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
        name: string (25),
        qualifier: clt$record_type_qualifier,
        field_spec_1: clt$field_specification,
        element_type_spec_1: record
          header: clt$type_specification_header,
        recend,
        field_spec_2: clt$field_specification,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
        field_spec_3: clt$field_specification,
        element_type_spec_3: record
          header: clt$type_specification_header,
        recend,
        field_spec_4: clt$field_specification,
        element_type_spec_4: record
          header: clt$type_specification_header,
        recend,
        field_spec_5: clt$field_specification,
        element_type_spec_5: record
          header: clt$type_specification_header,
        recend,
        field_spec_6: clt$field_specification,
        element_type_spec_6: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, 25, clc$record_type], 'RAV$INSTALLATION_DEFAULTS', [6],
            ['CORRECTION_BASES               ', clc$required_field, 3], [[1, 0, clc$file_type]],
            ['IGNORE_STORAGE_CLASS           ', clc$required_field, 3], [[1, 0, clc$boolean_type]],
            ['INSTALLATION_DATABASE          ', clc$required_field, 3], [[1, 0, clc$file_type]],
            ['INSTALLATION_LOGS              ', clc$required_field, 3], [[1, 0, clc$file_type]],
            ['RELAX_RING_SETTINGS            ', clc$required_field, 3], [[1, 0, clc$boolean_type]],
            ['SYSTEM_CATALOG                 ', clc$optional_field, 3], [[1, 0, clc$file_type]]];

?? POP ??

    VAR
      initial_value_p: ^clt$data_value;

    status.normal := TRUE;

    create_scl_type ('rat$installation_defaults', #SEQ (type_specification), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_memory_for_initial_value (number_of_record_fields, initial_value_p, scratch_sequence_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   Initialize the fields of the record.

    initial_value_p^.kind := clc$record;

    initial_value_p^.field_values^ [1].name := 'CORRECTION_BASES';
    initial_value_p^.field_values^ [1].value^.kind := clc$file;
    initial_value_p^.field_values^ [1].value^.file_value := ^installation_defaults.correction_bases.
          path (1, installation_defaults.correction_bases.size);

    initial_value_p^.field_values^ [2].name := 'IGNORE_STORAGE_CLASS';
    initial_value_p^.field_values^ [2].value^.kind := clc$boolean;
    initial_value_p^.field_values^ [2].value^.boolean_value.value :=
          installation_defaults.ignore_storage_class;
    initial_value_p^.field_values^ [2].value^.boolean_value.kind := clc$yes_no_boolean;

    initial_value_p^.field_values^ [3].name := 'INSTALLATION_DATABASE';
    initial_value_p^.field_values^ [3].value^.kind := clc$file;
    initial_value_p^.field_values^ [3].value^.file_value :=
          ^installation_defaults.installation_database.path (1,
          installation_defaults.installation_database.size);

    initial_value_p^.field_values^ [4].name := 'INSTALLATION_LOGS';
    initial_value_p^.field_values^ [4].value^.kind := clc$file;
    initial_value_p^.field_values^ [4].value^.file_value := ^installation_defaults.installation_logs.
          path (1, installation_defaults.installation_logs.size);

    initial_value_p^.field_values^ [5].name := 'RELAX_RING_SETTINGS';
    initial_value_p^.field_values^ [5].value^.kind := clc$boolean;
    initial_value_p^.field_values^ [5].value^.boolean_value.value :=
          installation_defaults.relax_ring_settings;
    initial_value_p^.field_values^ [5].value^.boolean_value.kind := clc$yes_no_boolean;

    initial_value_p^.field_values^ [6].name := 'SYSTEM_CATALOG';
    IF installation_defaults.system_catalog.path <> osc$null_name THEN
      initial_value_p^.field_values^ [6].value^.kind := clc$file;
      initial_value_p^.field_values^ [6].value^.file_value := ^installation_defaults.system_catalog.
            path (1, installation_defaults.system_catalog.size);
    ELSE
      initial_value_p^.field_values^ [6].value := NIL;
    IFEND;

    clp$create_procedure_variable ('RAV$INSTALLATION_DEFAULTS', clc$xdcl_scope, clc$read_write,
          clc$immediate_evaluation, #SEQ (type_specification), initial_value_p, status);

  PROCEND create_installation_deflts_var;

?? OLDTITLE ??
?? NEWTITLE := 'create_installation_envirn_var', EJECT ??

{ PURPOSE:
{   This procedure creates the SCL variable and type which make the current
{   installation environment available to the user.  Installation environment
{   refers to the parameters assigned by the user for the installation currently
{   taking place.
{ DESIGN:
{   For a description of the SCL variable and type creation process, refer to the
{   documentation of procedure CREATE_SUBPRODUCT_INFO_VAR.
{ NOTES:
{   If the installation_identifier is null, then it is assumed that no other
{   installation environment information is available.  This occurs when the
{   utility was invoked from the the command interface rather than the CYBIL
{   interface.

  PROCEDURE create_installation_envirn_var
    (    processing_header_p: ^rat$processing_header;
     VAR scratch_sequence_p: ^SEQ ( * );
     VAR status: ost$status);

{ The value for the NUMBER_OF_RECORD_FIELDS constant and the actual number of
{ fields in the rav$installation_defaults record MUST match.

    CONST
      number_of_record_fields = 3;

{ TYPE
{   rav$installation_environment: record
{     installation_identifier:    name    =$optional
{     packing_list:               name    =$optional
{     save_previous_cycles:       boolean =$optional
{   recend
{ TYPEND

?? PUSH (LISTEXT := ON) ??

  VAR
    type_specification : [STATIC, READ, cls$declaration_section] record
      header: clt$type_specification_header,
      name: string (28),
      qualifier: clt$record_type_qualifier,
      field_spec_1: clt$field_specification,
      element_type_spec_1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_2: clt$field_specification,
      element_type_spec_2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      field_spec_3: clt$field_specification,
      element_type_spec_3: record
        header: clt$type_specification_header,
      recend,
    recend := [
      [1, 28, clc$record_type], 'RAV$INSTALLATION_ENVIRONMENT', [3],
      ['INSTALLATION_IDENTIFIER        ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['PACKING_LIST                   ', clc$optional_field, 5], [[1, 0, clc$name_type], [1,
  osc$max_name_size]],
      ['SAVE_PREVIOUS_CYCLES           ', clc$optional_field, 3], [[1, 0, clc$boolean_type]]
      ];

?? POP ??

    VAR
      initialize_fields: boolean,
      initial_value_p: ^clt$data_value;

    status.normal := TRUE;

    create_scl_type ('rat$installation_environment', #SEQ (type_specification), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_memory_for_initial_value (number_of_record_fields, initial_value_p, scratch_sequence_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Initialize the fields of the record.

    IF processing_header_p^.installation_identifier = osc$null_name THEN
      initialize_fields := FALSE;
    ELSE
      initialize_fields := TRUE;
    IFEND;

    initial_value_p^.kind := clc$record;

    initial_value_p^.field_values^ [1].name := 'INSTALLATION_IDENTIFIER';
    IF initialize_fields THEN
      initial_value_p^.field_values^ [1].value^.kind := clc$name;
      initial_value_p^.field_values^ [1].value^.name_value := processing_header_p^.installation_identifier;
    ELSE
      initial_value_p^.field_values^ [1].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [2].name := 'PACKING_LIST';
    IF initialize_fields THEN
      initial_value_p^.field_values^ [2].value^.kind := clc$name;
      initial_value_p^.field_values^ [2].value^.name_value := processing_header_p^.packing_list_name;
    ELSE
      initial_value_p^.field_values^ [2].value := NIL;
    IFEND;

    initial_value_p^.field_values^ [3].name := 'SAVE_PREVIOUS_CYCLES';
    IF initialize_fields THEN
      initial_value_p^.field_values^ [3].value^.kind := clc$boolean;
      initial_value_p^.field_values^ [3].value^.boolean_value.value :=
            NOT (rac$delete_previous_cycles_step IN processing_header_p^.step_set);
      initial_value_p^.field_values^ [3].value^.boolean_value.kind := clc$yes_no_boolean;
    ELSE
      initial_value_p^.field_values^ [3].value := NIL;
    IFEND;

    clp$create_procedure_variable ('RAV$INSTALLATION_ENVIRONMENT', clc$xdcl_scope, clc$read_write,
          clc$immediate_evaluation, #SEQ (type_specification), initial_value_p, status);

  PROCEND create_installation_envirn_var;
?? OLDTITLE ??
?? NEWTITLE := 'create_scl_type', EJECT ??
{ PURPOSE:
{   This procedure creates an SCL user defined type based up the type
{   specification supplied on the interface parameters.
{ DESIGN:
{   In order to create an SCL type, the SCL interface to create an
{   environment variable is used.  The parameters on the interface indicate
{   that you want to create a variable of type TYPE, ie.  a "type
{   specification type".  The structure for the type being created is
{   specified as the initial value for the variable.  The initial value is a
{   CLC$TYPE_SPECIFICATION (produced by GENPDT), rather than a typical
{   value, like CLC$RECORD, or CLC$NAME.
{
{   The standard method for creating an SCL user defined type would be to
{   use GENPDT with a type declaration as can be seen in this procedure.
{   (See the sample definition for a type named RAT$SUBPRODUCT_INFORMATION
{   below).  GENPDT will produce a CYBIL variable declaration named
{   TYPE_SPECIFICATION with all the fields initialized according to the PDT
{   supplied to it.  This is also the process used to give the type being
{   created an initial value.  A PDT was created and run through GENPDT.
{   Since GENPDT always produces a variable named TYPE_SPECIFICATION, the
{   type specification to create the type and the one to give the type
{   structure cannot both reside in the same routine.  So, this routine
{   CREATE_SCL_TYPE, was created to perform the type creation.
{
{   In the code, is an example type_specification as created by GENPDT which
{   has been commented out.  Below it, is a hard coded type specification
{   variable which is initialized appropriately for whatever parameters are
{   passed to this interface (CREATE_SCL_TYPE).
{ NOTES:

  PROCEDURE create_scl_type
    (    type_name: clt$variable_name_reference;
         type_specification: ^clt$type_specification;
     VAR status: ost$status);

{ This section of commented out code shows the required input to GENPDT
{ to declare a user defined type and the resulting GENPDT output.  Note
{ that this code is not actually used in this routine. It is shown to
{ to provide reference for the code which which does declare the type.
{
{ TYPE
{   rat$subproduct_information: type
{ TYPEND
{
{ VAR
{   type_specification : [STATIC, READ, cls$declaration_section] record
{     header: clt$type_specification_header,
{     name: string (26),
{   recend := [
{     [1, 26, clc$type_specification_type], 'RAT$SUBPRODUCT_INFORMATION'];

{ The variable TYPE_SPECIFICATION_INFO is a generic version of what
{ is created by GENPDT as shown above.

    VAR
      type_specification_info: record
        header: clt$type_specification_header,
        name: ost$name,
      recend,
      initial_value: clt$data_value;

    status.normal := TRUE;

{ This code initializes TYPE_SPECIFICATION_INFO based upon the parameters
{ to this routine.  The intent is to initialize the values the same way as
{ GENPDT does in the record initialization shown above.

    type_specification_info.header.version := 1; {clc$declaration_version}
    type_specification_info.header.name_size := clp$trimmed_string_size (type_name);
    type_specification_info.header.kind := clc$type_specification_type;
    type_specification_info.name := type_name;

    initial_value.kind := clc$type_specification;
    initial_value.type_specification_value := type_specification;

    clp$create_environment_variable (type_name, clc$utility_scope, clc$read_only,
          clc$immediate_evaluation, #SEQ (type_specification_info), ^initial_value, status);

  PROCEND create_scl_type;
?? OLDTITLE ??
?? NEWTITLE := 'get_memory_for_initial_value', EJECT ??

{ PURPOSE:
{   This interface creates a CLT$DATA_VALUE record structure in the sequence
{   provided in order to initialize a SCL record variable.
{ DESIGN:
{   RESET the scratch sequence provided.  NEXT in the fields which make up
{   an initial value for an SCL record variable.  (For a record value, there
{   are three parts:  1) the base clt$data_value type, 2) a pointer to an
{   array describing each field in the record, and 3) a pointer to a record
{   to contain the value of each field.
{ NOTES:
{

  PROCEDURE get_memory_for_initial_value
    (    field_count: integer;
     VAR initial_value_p: ^clt$data_value;
     VAR scratch_sequence_p: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      field_counter: integer;

    RESET scratch_sequence_p;

    NEXT initial_value_p IN scratch_sequence_p;
    IF initial_value_p = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_segment_eoi, 'EXECUTE_INSTALLER_PROCEDURE SEQUENCE',
            status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'initial variable values', status);
      RETURN;
    IFEND;

    NEXT initial_value_p^.field_values: [1 .. field_count] IN scratch_sequence_p;
    IF initial_value_p^.field_values = NIL THEN
      osp$set_status_abnormal ('RA', rae$accessed_beyond_segment_eoi, 'EXECUTE_INSTALLER_PROCEDURE SEQUENCE',
            status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'initial variable values', status);
      RETURN;
    IFEND;

    FOR field_counter := 1 TO field_count DO
      NEXT initial_value_p^.field_values^ [field_counter].value IN scratch_sequence_p;
      IF initial_value_p^.field_values^ [field_counter].value = NIL THEN
        osp$set_status_abnormal ('RA', rae$accessed_beyond_segment_eoi,
              'EXECUTE_INSTALLER_PROCEDURE SEQUENCE', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'initial variable values', status);
        RETURN;
      IFEND;
    FOREND;

  PROCEND get_memory_for_initial_value;

?? OLDTITLE ??

MODEND ram$execute_installer_procs_utl;

