?? RIGHT := 110 ??
?? NEWTITLE := 'DEFINE_SUBPRODUCT Subutility: DEFINE_SUBPRODUCT_ATTRIBUTES Subcommand.' ??
MODULE ram$define_subproduct_attrib;

{ PURPOSE:
{   This module contains the procedures that define and validate the
{   subproduct attributes.
{
{ DESIGN:
{   The procedures in this module process the parameters on DEFINE_SUBPRODUCT_ATTRIBUTES
{   to create a completed subproduct_attriubtes record.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc rac$subproduct_info_level
*copyc rae$package_software_cc
*copyc rat$sequence_descriptor_types
*copyc rat$subproduct_info_types
?? POP ??
*copyc clp$convert_file_ref_to_string
*copyc clp$convert_string_to_integer
*copyc clp$get_fs_path_elements
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$include_command
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc clp$trimmed_string_size
*copyc fsp$convert_fs_structure_to_pf
*copyc osp$append_status_file
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc osp$generate_error_message
*copyc pmp$get_unique_name
*copyc rap$get_file_path_and_ref
*copyc rav$subproduct_info_pointers
*copyc rav$pacs_catalog_p
*copyc rav$defs_scratch_segment
*copyc rav$installation_path_option
*copyc rav$installation_scheme

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

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

{ PURPOSE:
{   This procedure updates the values in the subproduct attributes record.
{
{ DESIGN:
{   The subproduct attributes record is initialize then each of the parameters
{   is processed.
{
{ NOTES:
{
{

  PROCEDURE [XDCL] rap$define_subproduct_attrib
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{ pdt defsa_pdt (
{   description, d                       : string 1..50 = $required
{   installation_scheme, is              : key cycle_based, catalog_based, version_based = $required
{   level, l                             : name = $required
{   licensed_product, lp                 : name = $required
{   subproduct_installation_path, sip    : file = $required
{   additional_products, ..
{   additional_product, ap               : list 1..5 of name or key none = none
{   auto_install, ai                     : boolean = true
{   correction_base_level, cbl           : name = $optional
{   date_level, dl                       : string 7 = $date(ordinal)
{   development_group, dg                : string 1..31 = $optional
{   hidden, h                            : boolean = false
{   installation_path_option, ipo        : key definable_master_catalog, definable_family_name, ..
{                                              definable_user_name, not_definable = not_definable
{   installer_procedure, ip              : file or key none = none
{   primary_subproduct, ps               : boolean = false
{   product_dependencies, ..
{   product_dependency, pd               : list 1..5 of name or key none = none
{   stamp_files, sf                      : boolean = false
{   internal_level                       : name = $optional
{   subproduct_priority                  : key installation_tools, high, low, medium = low
{   status                               : var of status = $optional
{   )

?? PUSH (LISTEXT := ON) ??

  VAR
    defsa_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^defsa_pdt_names, ^defsa_pdt_params
  ];

  VAR
    defsa_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 37] of
  clt$parameter_name_descriptor := [['DESCRIPTION', 1], ['D', 1], ['INSTALLATION_SCHEME', 2], ['IS', 2], [
  'LEVEL', 3], ['L', 3], ['LICENSED_PRODUCT', 4], ['LP', 4], ['SUBPRODUCT_INSTALLATION_PATH', 5], ['SIP', 5],
  ['ADDITIONAL_PRODUCTS', 6], ['ADDITIONAL_PRODUCT', 6], ['AP', 6], ['AUTO_INSTALL', 7], ['AI', 7], [
  'CORRECTION_BASE_LEVEL', 8], ['CBL', 8], ['DATE_LEVEL', 9], ['DL', 9], ['DEVELOPMENT_GROUP', 10], ['DG', 10]
  , ['HIDDEN', 11], ['H', 11], ['INSTALLATION_PATH_OPTION', 12], ['IPO', 12], ['INSTALLER_PROCEDURE', 13], [
  'IP', 13], ['PRIMARY_SUBPRODUCT', 14], ['PS', 14], ['PRODUCT_DEPENDENCIES', 15], ['PRODUCT_DEPENDENCY', 15]
  , ['PD', 15], ['STAMP_FILES', 16], ['SF', 16], ['INTERNAL_LEVEL', 17], ['SUBPRODUCT_PRIORITY', 18], [
  'STATUS', 19]];

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

{ DESCRIPTION D }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 1, 50]],

{ INSTALLATION_SCHEME IS }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^defsa_pdt_kv2, clc$keyword_value]],

{ LEVEL L }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ LICENSED_PRODUCT LP }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ SUBPRODUCT_INSTALLATION_PATH SIP }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ ADDITIONAL_PRODUCTS ADDITIONAL_PRODUCT AP }
    [[clc$optional_with_default, ^defsa_pdt_dv6], 1, 5, 1, 1, clc$value_range_not_allowed, [^defsa_pdt_kv6,
  clc$name_value, 1, osc$max_name_size]],

{ AUTO_INSTALL AI }
    [[clc$optional_with_default, ^defsa_pdt_dv7], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ CORRECTION_BASE_LEVEL CBL }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ DATE_LEVEL DL }
    [[clc$optional_with_default, ^defsa_pdt_dv9], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$string_value, 7, 7]],

{ DEVELOPMENT_GROUP DG }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$string_value, 1, 31]],

{ HIDDEN H }
    [[clc$optional_with_default, ^defsa_pdt_dv11], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ INSTALLATION_PATH_OPTION IPO }
    [[clc$optional_with_default, ^defsa_pdt_dv12], 1, 1, 1, 1, clc$value_range_not_allowed, [^defsa_pdt_kv12,
  clc$keyword_value]],

{ INSTALLER_PROCEDURE IP }
    [[clc$optional_with_default, ^defsa_pdt_dv13], 1, 1, 1, 1, clc$value_range_not_allowed, [^defsa_pdt_kv13,
  clc$file_value]],

{ PRIMARY_SUBPRODUCT PS }
    [[clc$optional_with_default, ^defsa_pdt_dv14], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ PRODUCT_DEPENDENCIES PRODUCT_DEPENDENCY PD }
    [[clc$optional_with_default, ^defsa_pdt_dv15], 1, 5, 1, 1, clc$value_range_not_allowed, [^defsa_pdt_kv15,
  clc$name_value, 1, osc$max_name_size]],

{ STAMP_FILES SF }
    [[clc$optional_with_default, ^defsa_pdt_dv16], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$boolean_value]],

{ INTERNAL_LEVEL }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ SUBPRODUCT_PRIORITY }
    [[clc$optional_with_default, ^defsa_pdt_dv18], 1, 1, 1, 1, clc$value_range_not_allowed, [^defsa_pdt_kv18,
  clc$keyword_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
    defsa_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of ost$name := ['CYCLE_BASED',
  'CATALOG_BASED','VERSION_BASED'];

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

  VAR
    defsa_pdt_kv12: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := [
  'DEFINABLE_MASTER_CATALOG','DEFINABLE_FAMILY_NAME','DEFINABLE_USER_NAME','NOT_DEFINABLE'];

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

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

  VAR
    defsa_pdt_kv18: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := [
  'INSTALLATION_TOOLS','HIGH','LOW','MEDIUM'];

  VAR
    defsa_pdt_dv6: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'none';

  VAR
    defsa_pdt_dv7: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

  VAR
    defsa_pdt_dv9: [STATIC, READ, cls$pdt_names_and_defaults] string (14) := '$date(ordinal)';

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

  VAR
    defsa_pdt_dv12: [STATIC, READ, cls$pdt_names_and_defaults] string (13) := 'not_definable';

  VAR
    defsa_pdt_dv13: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'none';

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

  VAR
    defsa_pdt_dv15: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'none';

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

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

?? POP ??

    status.normal := TRUE;

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

    IF (rav$subproduct_info_pointers.psrs_answered_p <> NIL) AND
      (rav$subproduct_info_pointers.path_container_p <> NIL) THEN
      osp$set_status_abnormal ('RA', rae$defsa_command_not_allowed, '', status);
      RETURN;
    IFEND;

    clear_subproduct_attributes (rav$subproduct_info_pointers);

    process_attributes (rav$subproduct_info_pointers, status);
    IF NOT status.normal THEN
      clear_subproduct_attributes (rav$subproduct_info_pointers);
      RETURN;
    IFEND;

  PROCEND rap$define_subproduct_attrib;

?? TITLE := 'clear_subproduct_attributes', EJECT ??

{ PURPOSE:
{   This procedure initializes the subproduct attributes.
{
{ DESIGN:
{   Each of the attributes is set to a null or default value.
{
{ NOTES:
{
{
  PROCEDURE clear_subproduct_attributes
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: 0 .. rac$max_additional_products;


    attributes_p := subproduct_info_pointers.attributes_p;

    FOR i := 1 TO rac$max_additional_products DO
      attributes_p^.additional_products [i] := '';
    FOREND;

    FOR i := 1 TO rac$max_additional_products DO
      attributes_p^.dependencies [i] := '';
    FOREND;

    attributes_p^.auto_install := FALSE;
    attributes_p^.correction_base_level := '';
    attributes_p^.date_level := '';
    attributes_p^.description := '';
    attributes_p^.development_group := '';
    attributes_p^.files_stamped := FALSE;
    attributes_p^.hidden := FALSE;
    attributes_p^.internal_level := '';
    attributes_p^.level := '';
    attributes_p^.licensed_product := '';
    attributes_p^.installation_path_option := rac$not_definable;
    attributes_p^.installation_scheme := rac$cycle_based;
    attributes_p^.primary := FALSE;
    attributes_p^.correction_base_sif_identifier := '';
    attributes_p^.sif_identifier := '';
    attributes_p^.subproduct_priority := rac$low;

  PROCEND clear_subproduct_attributes;

?? TITLE := 'process_additional_products', EJECT ??

{ PURPOSE:
{   This procedure puts the names of the additional products
{   into the attributes.additional_products array.
{
{ DESIGN:
{   The number of additional products is determined and these names are
{   put into the additional_products field of the subproduct attributes record.
{
{ NOTES:
{
{

  PROCEDURE process_additional_products
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: 0 .. clc$max_value_sets,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

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

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

      IF value.name.value <> 'NONE' THEN
        attributes_p^.additional_products [i] := value.name.value;
      ELSEIF i > 1 THEN
        osp$set_status_abnormal ('RA', rae$invalid_product_name, 'NONE', status);
        RETURN;
      IFEND;
    FOREND;

    sort_additional_products (attributes_p^.additional_products);

  PROCEND process_additional_products;

?? TITLE := 'process_attributes', EJECT ??

{ PURPOSE:
{   Each of the subproduct attributes is entered in the
{   attributes record.
{
{ DESIGN:
{   The attributes are processed in the same order as they are listed in the
{   attributes record.  Most of the fields are order independent, but
{   INSTALLATION_PATH_OPTION must be processed before INSTALLATION_PATH must be
{   processed before INSTALLER_PROCEDURE and LICENSED_PRODUCT must be
{   processed before PRIMARY_SUBPRODUCT.
{ NOTES:
{
{

  PROCEDURE process_attributes
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);

    VAR
      attributes_p: ^rat$subproduct_attributes,
      installation_path_option: ost$name,
      development_group_specified: boolean,
      sif_identifier: ost$name,
      test_integer: integer,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

    clp$get_value ('LEVEL', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    attributes_p^.level := value.name.value;

    process_date_level (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_internal_level (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_subproduct_priority (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_correction_base_level (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('DESCRIPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    attributes_p^.description := value.str.value (1, value.str.size);

    clp$get_value ('LICENSED_PRODUCT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    attributes_p^.licensed_product := value.name.value;

    process_additional_products (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_primary_subproduct( subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_product_dependencies (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('HIDDEN', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    attributes_p^.hidden := value.bool.value;

    clp$get_value ('AUTO_INSTALL', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    attributes_p^.auto_install := value.bool.value;

    process_installation_scheme (subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_installation_path_opt (subproduct_info_pointers, installation_path_option, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_installation_path (installation_path_option, subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    process_installer_procedure (rav$pacs_catalog_p^, subproduct_info_pointers, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$test_parameter ('DEVELOPMENT_GROUP', development_group_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF development_group_specified THEN
      clp$get_value ('DEVELOPMENT_GROUP', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      #TRANSLATE (osv$lower_to_upper, value.str.value, attributes_p^.development_group);
    IFEND;

    pmp$get_unique_name (sif_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    attributes_p^.sif_identifier := sif_identifier;

  PROCEND process_attributes;

?? TITLE := 'process_correction_base_level', EJECT ??

{ PURPOSE:
{   This procedure sets the correction_base_level for subproduct attributes.
{
{ DESIGN:
{   Since this is an optional parameter, the procedure first determines if
{   the parameter has been specified.  If specified the correction_base_level is
{   set.  The correction_base_level must be specified if the subproduct_type
{   is rac$correction.  An error message occurs if the subproduct_type is
{   rac$correction and the correction_base_level is NOT set.
{
{ NOTES:
{
{

  PROCEDURE process_correction_base_level
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      parameter_specified: boolean,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

    clp$test_parameter ('CORRECTION_BASE_LEVEL', parameter_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter_specified THEN

      clp$get_value ('CORRECTION_BASE_LEVEL', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      attributes_p^.correction_base_level := value.name.value;

    ELSEIF attributes_p^.subproduct_type = rac$correction THEN

      osp$set_status_abnormal ('RA', rae$param_required_for_corr, 'CORRECTION_BASE_LEVEL', status);
      RETURN;

    IFEND;

  PROCEND process_correction_base_level;

?? TITLE := 'process_date_level', EJECT ??

{ PURPOSE:
{   This procedure process the date_level entered.
{
{ DESIGN:
{   The first four characters of the string must be and integer greater than
{   minimun year.  The last three digits of the string must be an integer
{   between 1 and the number of days in a year.
{
{ NOTES:
{
{

  PROCEDURE process_date_level
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR

      attributes_p: ^rat$subproduct_attributes,
      days_in_year: [STATIC] integer := 366,
      year: [STATIC] integer := 1988,
      test_integer: clt$integer,
      value: clt$value;

    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

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

    clp$convert_string_to_integer (value.str.value (1, 4), test_integer, status);
    IF (NOT status.normal) OR (test_integer.value < year) THEN
      osp$set_status_abnormal ('RA', rae$invalid_date_level, value.str.value, status);
      RETURN;
    IFEND;

    clp$convert_string_to_integer (value.str.value (5, 3), test_integer, status);
    IF (NOT status.normal) OR (1 > test_integer.value) OR (test_integer.value > days_in_year) THEN
      osp$set_status_abnormal ('RA', rae$invalid_date_level, value.str.value, status);
      RETURN;
    IFEND;

    attributes_p^.date_level := value.str.value;

  PROCEND process_date_level;

?? TITLE := 'process_installation_path', EJECT ??

{ PURPOSE:
{   This procedure sets:
{        the installation_path.path_container_index to the next available path container.
{        the installation_path.path_length to the file length of the element.
{        For example, $SYSTEM.A.B.DDD.E has a length of 5.
{        the info_header_p.path_container_length to total length of all containers used.
{        the path_container_p^s are filled with the names of the installation path.  In the example above
{        path_container_p^ [i] = $SYSTEM
{        path_container_p^ [i + 1] = A
{        path_container_p^ [i + 2] = B
{        path_container_p^ [i + 3] = DDD
{        path_container_p^ [i + 4] = E
{
{ DESIGN:
{   The INSTALLATION_PATH cannot be $LOCAL.
{   The INSTALLATION_PATH can only have $UNDEFINED in the first or second containers.
{   The path_option attribute is validated against the first two path containers.
{   If the INSTALLATION_PATH contains a path_container_index greater than 0, it
{   has been previously defined.  If the new path is the same length as the old path,
{   the new path can use the old path's containers.
{
{   Else set the path_container_index to the next available index number.
{   The info_header_p^.path_container_index contains the value of the last used path container.
{   Set the value of the path_length to the uppervalue of the array that contains the path.
{   See example above to understand how the length of a path is determined.
{   The info_header.path_container_length is updated to point to the last used path container.
{   If the path container has not been created, it is created with a size large enough to hold this path.
{   Else the path_containers size is set to the size indicated in info_header.path_container_length.
{   Then the path_containers are filled with the path.
{
{ NOTES:
{
{

  PROCEDURE process_installation_path
    (    installation_path_option: ost$name;
     VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: rat$path_container_index,
      ignore_status: ost$status,
      index: rat$path_container_index,
      info_header_p: ^rat$subproduct_info_header,
      installation_path_p: ^pft$path,
      installation_path_ref_p: ^fst$file_reference,
      length: integer,
      local_status: ost$status,
      master_catalog: string (osc$max_name_size * 2 + 2),
      path_container_p: ^rat$path_container,
      path_option: rat$installation_path_option,
      subproduct_info_seq_p: ^rat$subproduct_info_sequence,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;
    info_header_p := subproduct_info_pointers.info_header_p;
    subproduct_info_seq_p := subproduct_info_pointers.subproduct_info_seq_p;
    path_container_p := subproduct_info_pointers.path_container_p;

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

    RESET rav$defs_scratch_segment.sequence_p TO rav$defs_scratch_segment.reset_p;

    rap$get_file_path_and_ref ('SUBPRODUCT_INSTALLATION_PATH', rav$defs_scratch_segment.sequence_p,
          installation_path_p, installation_path_ref_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF installation_path_p^ [1] = '$LOCAL' THEN
      osp$set_status_abnormal ('RA', rae$cannot_use_local_catalog, 'INSTALLATION_PATH', status);
      RETURN;
    IFEND;

    FOR i := 3 TO UPPERBOUND (installation_path_p^) DO
      IF installation_path_p^ [i] = '$UNDEFINED' THEN
        osp$set_status_abnormal ('RA', rae$invalid_installation_path, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, installation_path_ref_p^, status);
        RETURN;
      IFEND;
    FOREND;

    path_option := attributes_p^.installation_path_option;
    IF ((installation_path_p^ [1] = '$UNDEFINED') AND ((path_option = rac$definable_user_name) OR
          (path_option = rac$not_definable))) OR ((installation_path_p^ [2] = '$UNDEFINED') AND
          ((path_option = rac$definable_family_name) OR (path_option = rac$not_definable))) THEN
      osp$set_status_abnormal ('RA', rae$invalid_inst_path_with_opt, installation_path_option, status);
      osp$append_status_file (osc$status_parameter_delimiter, installation_path_ref_p^, status);
      RETURN;
    IFEND;

    IF (installation_path_p^ [1] <> '$SYSTEM') AND (installation_path_p^ [1] <> '$UNDEFINED') AND
          (installation_path_p^ [2] <> '$SYSTEM') AND (installation_path_p^ [2] <> '$UNDEFINED') THEN
      STRINGREP (master_catalog, length, ':', installation_path_p^
            [1] (1, clp$trimmed_string_size (installation_path_p^ [1])), '.', installation_path_p^ [2]
            (1, clp$trimmed_string_size (installation_path_p^ [2])));
      osp$set_status_abnormal ('RA', rae$non_standard_master_catalog, master_catalog (1, length),
            local_status);
      osp$generate_error_message (local_status, ignore_status);
    IFEND;

    IF (attributes_p^.installation_path.path_container_index <> 0) AND
          (attributes_p^.installation_path.path_length = UPPERBOUND (installation_path_p^)) THEN
      index := attributes_p^.installation_path.path_container_index;
      FOR i := LOWERBOUND (installation_path_p^) TO UPPERBOUND (installation_path_p^) DO
        path_container_p^ [index] := installation_path_p^ [i];
        index := index + 1;
      FOREND;
    ELSE
      attributes_p^.installation_path.path_container_index := info_header_p^.path_container_length + 1;
      attributes_p^.installation_path.path_length := UPPERBOUND (installation_path_p^);
      info_header_p^.path_container_length := info_header_p^.path_container_length +
            attributes_p^.installation_path.path_length;

      IF path_container_p = NIL THEN
        NEXT path_container_p: [1 .. info_header_p^.path_container_length] IN subproduct_info_seq_p;
        path_container_p^ := installation_path_p^;
      ELSE
        RESET subproduct_info_seq_p TO path_container_p;
        NEXT path_container_p: [1 .. info_header_p^.path_container_length] IN subproduct_info_seq_p;

        index := attributes_p^.installation_path.path_container_index;
        FOR i := LOWERBOUND (installation_path_p^) TO UPPERBOUND (installation_path_p^) DO
          path_container_p^ [index] := installation_path_p^ [i];
          index := index + 1;
        FOREND;
      IFEND;

      subproduct_info_pointers.info_header_p^.path_container_p := #REL (path_container_p,
            subproduct_info_seq_p^);
      subproduct_info_pointers.subproduct_info_seq_p := subproduct_info_seq_p;
      subproduct_info_pointers.path_container_p := path_container_p;
    IFEND;

  PROCEND process_installation_path;

?? TITLE := 'process_installation_path_opt', EJECT ??

{ PURPOSE:
{   This procedure updates the value of the installation_path_option in
{   the subproduct_attributes record.
{
{ DESIGN:
{   The value entered is translated to a constant and the constant value
{   is entered in the attributes.installation_path_option field.
{
{ NOTES:
{
{

  PROCEDURE process_installation_path_opt
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR installation_path_option: ost$name;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: rat$installation_path_option,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

    clp$get_value ('INSTALLATION_PATH_OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    installation_path_option := value.name.value;

  /initialize_value/
    FOR i := LOWERBOUND (rav$installation_path_option) TO UPPERBOUND (rav$installation_path_option) DO
      IF rav$installation_path_option [i] = value.name.value (1, value.name.size) THEN
        attributes_p^.installation_path_option := i;
        EXIT /initialize_value/;
      IFEND;
    FOREND /initialize_value/;

  PROCEND process_installation_path_opt;

?? TITLE := 'process_installer_procedure', EJECT ??

{ PURPOSE:
{   This procedure sets:
{        the installler_procedure.path_container_index to the next available path container.
{        the installler_procedure.path_length to the file length of the element.
{        For example, $SYSTEM.A.B.DDD.E, has a length of 5.
{        the info_header_p.path_container_length to total length of all containers used.
{        the path_container_p^s are filled with the names of the installation path.  In the example above
{        path_container_p^ [i] = $SYSTEM
{        path_container_p^ [i + 1] = A
{        path_container_p^ [i + 2] = B
{        path_container_p^ [i + 3] = DDD
{        path_container_p^ [i + 4] = E
{
{ DESIGN:
{   If the INSTALLER_PROCEDURE is part of the PACS catalog, it is validated as
{   an existing file containing a procedure.
{   If the INSTALLER_PROCEDURE is not part of the PACS catalog, a warning
{   message is displayed.
{   If the INSTALLER_PROCEDURE already contains a path_container_index, validate that the
{   new path is of the same length as the old path.  If they are the same length, put the new path in the
{   same containers that the old path used.
{
{   Else set the path_container_index to the next available index number.
{   The info_header_p^.path_container_index contains the value of the last used path container.
{   Set the value of the path_length to the uppervalue of the array that contains the path.
{   See example above to understand how the length of a path is determined.
{   The info_header.path_container_length is updated to point to the last used path container.
{   If the path container has not been created, it is created with a size large enough to hold this path.
{   Else the path_containers size is set to the size indicated in info_header.path_container_length.
{   Then the path_containers are filled with the path.
{
{
{ NOTES:
{
{

  PROCEDURE process_installer_procedure
    (    pacs_catalog: pft$path;
     VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      command_line: string (fsc$max_path_size + osc$max_name_size),
      i: rat$path_container_index,
      ignore_status: ost$status,
      index: rat$path_container_index,
      info_header_p: ^rat$subproduct_info_header,
      installer_procedure_p: ^pft$path,
      installer_procedure_ref_p: ^fst$file_reference,
      inst_proc_in_pacs_catalog: boolean,
      length: integer,
      local_status: ost$status,
      message_status: ost$status,
      path_length: integer,
      path_container_p: ^rat$path_container,
      subproduct_info_seq_p: ^rat$subproduct_info_sequence,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;
    info_header_p := subproduct_info_pointers.info_header_p;
    inst_proc_in_pacs_catalog := TRUE;
    subproduct_info_seq_p := subproduct_info_pointers.subproduct_info_seq_p;
    path_container_p := subproduct_info_pointers.path_container_p;

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

    IF value.kind = clc$name_value THEN { key none }

      attributes_p^.installer_procedure.path_container_index := 0;
      attributes_p^.installer_procedure.path_length := 0;

    ELSE { value.kind = clc$file_value }

      RESET rav$defs_scratch_segment.sequence_p TO rav$defs_scratch_segment.reset_p;

      rap$get_file_path_and_ref ('INSTALLER_PROCEDURE', rav$defs_scratch_segment.sequence_p,
            installer_procedure_p, installer_procedure_ref_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      /check_path/ FOR i := 1 TO UPPERBOUND (pacs_catalog) DO
        IF installer_procedure_p^ [i] <> pacs_catalog [i] THEN
          osp$set_status_abnormal ('RA', rae$inst_proc_not_in_pacs_cat, '', message_status);
          osp$append_status_file (osc$status_parameter_delimiter, installer_procedure_ref_p^, message_status);
          osp$generate_error_message (message_status, ignore_status);
          inst_proc_in_pacs_catalog := FALSE;
          EXIT /check_path/;
        IFEND;
      FOREND /check_path/;

      IF inst_proc_in_pacs_catalog THEN

        STRINGREP (command_line, length, 'display_command_information o=$null c=',
              installer_procedure_ref_p^);
        clp$include_command (command_line (1, length), FALSE, local_status);
        IF NOT local_status.normal THEN
          osp$set_status_abnormal ('RA', rae$invalid_installer_proc, '', status);
          osp$append_status_file (osc$status_parameter_delimiter, installer_procedure_ref_p^, status);
          RETURN;
        IFEND;

      IFEND;

      path_length := UPPERBOUND (installer_procedure_p^);

      IF (attributes_p^.installer_procedure.path_container_index <> 0) AND
            (attributes_p^.installer_procedure.path_length = path_length) THEN

        index := attributes_p^.installer_procedure.path_container_index;
        FOR i := 1 TO UPPERBOUND (installer_procedure_p^) DO
          path_container_p^ [index] := installer_procedure_p^ [i];
          index := index + 1;
        FOREND;

      ELSE
        attributes_p^.installer_procedure.path_container_index := info_header_p^.path_container_length + 1;
        attributes_p^.installer_procedure.path_length := path_length;
        info_header_p^.path_container_length := info_header_p^.path_container_length + path_length;

        IF path_container_p = NIL THEN
          NEXT path_container_p: [1 .. info_header_p^.path_container_length] IN subproduct_info_seq_p;
        ELSE
          RESET subproduct_info_seq_p TO path_container_p;
          NEXT path_container_p: [1 .. info_header_p^.path_container_length] IN subproduct_info_seq_p;
        IFEND;

        index := attributes_p^.installer_procedure.path_container_index;
        FOR i := 1 TO UPPERBOUND (installer_procedure_p^) DO
          path_container_p^ [index] := installer_procedure_p^ [i];
          index := index + 1;
        FOREND;

        subproduct_info_pointers.info_header_p^.path_container_p := #REL (path_container_p,
              subproduct_info_seq_p^);
        subproduct_info_pointers.subproduct_info_seq_p := subproduct_info_seq_p;
        subproduct_info_pointers.path_container_p := path_container_p;
      IFEND;
    IFEND;

  PROCEND process_installer_procedure;

?? TITLE := 'process_installation_scheme', EJECT ??

{ PURPOSE:
{   This procedure updates the value of the installation_scheme in
{   the subproduct_attributes record.
{
{ DESIGN:
{   Validate if the subproduct is a correction, that the installation scheme
{   is cycle_based.  Define subproduct can't create version based corrections.
{   The value entered is translated to a constant and the constant value
{   is entered in the attributes.installation_scheme field.
{
{ NOTES:
{
{

  PROCEDURE process_installation_scheme
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: rat$installation_scheme,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

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

  /initialize_value/
    FOR i := LOWERBOUND (rav$installation_scheme) TO UPPERBOUND (rav$installation_scheme) DO
      IF rav$installation_scheme [i] = value.name.value (1, value.name.size) THEN
        attributes_p^.installation_scheme := i;
        EXIT /initialize_value/;
      IFEND;
    FOREND /initialize_value/;

  IF (attributes_p^.installation_scheme = rac$version_based) AND
     (attributes_p^.subproduct_type = rac$correction) THEN
    osp$set_status_abnormal('RA', rae$corr_must_be_cycle_based, '', status);
    RETURN;
  IFEND;

  PROCEND process_installation_scheme;

?? TITLE := 'process_internal_level', EJECT ??

{ PURPOSE:
{   This procedure updates the value of the internal_level in
{   the subproduct_attributes record.
{
{ DESIGN:
{   If this optional value is specified, the attributes.internal_level
{   field is set to its value.
{
{ NOTES:
{
{

  PROCEDURE process_internal_level
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      parameter_specified: boolean,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

    clp$test_parameter ('INTERNAL_LEVEL', parameter_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter_specified THEN
      clp$get_value ('INTERNAL_LEVEL', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      attributes_p^.internal_level := value.name.value;
    IFEND;

  PROCEND process_internal_level;

?? TITLE := 'process_primary_subproduct', EJECT ??

{ PURPOSE:
{   This procedure validates the primary_subproduct parameter against
{   the subproduct name and licensed product name and if valid, updates
{   the subproduct attributues.
{
{ DESIGN:
{   If the licensed product name matches the subproduct name, then this
{   must also be the primary subproduct.  This restriction is made because
{   of how INSTALL_SOFTWARE processes subproducts/licensed products when
{   their names are equal.  This restriction will reduce the chance that
{   when subproduct name and licensed product name are equal, that the
{   licensed product contains more than one subproduct.
{
{   If the licensed product name and subproduct name do not match,
{   there are no restrictions on the primary subproduct parameter.
{ NOTES:
{
{

  PROCEDURE process_primary_subproduct
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

    clp$get_value ('PRIMARY_SUBPRODUCT', 1, 1, clc$low, value, status);

    IF (attributes_p^.name = attributes_p^.licensed_product) THEN
      IF value.bool.value THEN
        attributes_p^.primary := value.bool.value;
      ELSE
        osp$set_status_abnormal ('RA', rae$must_be_primary_subproduct, '', status);
        RETURN;
      IFEND;
    ELSE
      attributes_p^.primary := value.bool.value;
    IFEND;
  PROCEND process_primary_subproduct;


?? TITLE := 'process_product_dependencies', EJECT ??

{ PURPOSE:
{   This procedure puts the names of the product dependencies
{   into the attributes.dependencies array.
{
{ DESIGN:
{   The number of product dependencies is determined and these names are
{   put into the dependencies field of the subproduct attributes record.
{
{ NOTES:
{
{

  PROCEDURE process_product_dependencies
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      i: 0 .. clc$max_value_sets,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

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

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

      IF value.name.value <> 'NONE' THEN
        attributes_p^.dependencies [i] := value.name.value;
      ELSEIF i > 1 THEN
        osp$set_status_abnormal ('RA', rae$invalid_product_name, 'NONE', status);
        RETURN;
      IFEND;
    FOREND;

    sort_dependencies (attributes_p^.dependencies);

  PROCEND process_product_dependencies;

?? TITLE := 'process_subproduct_priority', EJECT ??

{ PURPOSE:
{   This procedure updates the value of the subproduct_priority in
{   the subproduct_attributes record.
{
{ DESIGN:
{   If this optional value is specified, the attributes.subproduct_priority
{   field is set to its value.
{
{ NOTES:
{
{

  PROCEDURE process_subproduct_priority
    (VAR subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR status: ost$status);


    VAR
      attributes_p: ^rat$subproduct_attributes,
      parameter_specified: boolean,
      subproduct_priority: ost$name,
      value: clt$value;


    status.normal := TRUE;
    attributes_p := subproduct_info_pointers.attributes_p;

    clp$test_parameter ('SUBPRODUCT_PRIORITY', parameter_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter_specified THEN
      clp$get_value ('SUBPRODUCT_PRIORITY', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      #TRANSLATE (osv$lower_to_upper, value.name.value, subproduct_priority);

      IF subproduct_priority = 'LOW' THEN
        attributes_p^.subproduct_priority := rac$low;

      ELSEIF subproduct_priority = 'MEDIUM' THEN
        attributes_p^.subproduct_priority := rac$medium;

      ELSEIF subproduct_priority = 'HIGH' THEN
        attributes_p^.subproduct_priority := rac$high;

      ELSEIF subproduct_priority = 'INSTALLATION_TOOLS' THEN
        attributes_p^.subproduct_priority := rac$installation_tools;
      IFEND;

    IFEND;

  PROCEND process_subproduct_priority;

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

{ PURPOSE:
{   This procedure sorts the array of additional products.
{
{ DESIGN:
{   This procedure uses a shell sort.
{
{ NOTES:
{

  PROCEDURE sort_additional_products
    (VAR additional_products: rat$additional_products);

    VAR
      current: integer,
      gap: integer,
      start: integer,
      swap: ost$name;


    gap := UPPERBOUND (additional_products);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := LOWERBOUND (additional_products) TO UPPERBOUND (additional_products) - gap DO
        current := start;
        WHILE (current > 0) AND (additional_products [current] > additional_products [current + gap])
              AND (additional_products [current] <> '') AND (additional_products [current + gap] <> '') DO

          swap := additional_products [current];
          additional_products [current] := additional_products [current + gap];
          additional_products [current + gap] := swap;
          current := current - gap;

        WHILEND;
      FOREND;
    WHILEND;

  PROCEND sort_additional_products;

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

{ PURPOSE:
{   This procedure sorts the array of dependencies.
{
{ DESIGN:
{   This procedure uses a shell sort.
{
{ NOTES:
{

  PROCEDURE sort_dependencies
    (VAR dependencies: rat$subproduct_dependencies);

    VAR
      current: integer,
      gap: integer,
      start: integer,
      swap: ost$name;


    gap := UPPERBOUND (dependencies);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := LOWERBOUND (dependencies) TO UPPERBOUND (dependencies) - gap DO
        current := start;
        WHILE (current > 0) AND (dependencies [current] > dependencies [current + gap])
              AND (dependencies [current] <> '') AND (dependencies [current + gap] <> '') DO

          swap := dependencies [current];
          dependencies [current] := dependencies [current + gap];
          dependencies [current + gap] := swap;
          current := current - gap;

        WHILEND;
      FOREND;
    WHILEND;

  PROCEND sort_dependencies;

MODEND ram$define_subproduct_attrib;

