?? RIGHT := 110 ??
?? NEWTITLE := 'DEFINE_SUBPRODUCT Subutility: DEFINE_STORAGE_CLASS subcommand.' ??
MODULE ram$define_storage_class;

{ PURPOSE:
{   This module defines each or all of the storage_class fields in the element_list.
{
{ DESIGN:
{   The element list is searched for the correct file using locate_element.  Then
{   the correction_format field is updated.  If ALL elements are selected,
{   all files in the element list are updated.
{   The compiled module resides in RAF$LIBRARY.
{
{ NOTES:
{

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

?? PUSH (LISTEXT := ON) ??
*copyc cld$path_description
*copyc fst$file_reference
*copyc ost$status
*copyc rae$package_software_cc
*copyc rat$subproduct_info_p
*copyc rat$subproduct_info_types
?? POP ??
*copyc clp$scan_parameter_list
*copyc clp$get_value
*copyc osp$append_status_file
*copyc osp$set_status_abnormal
*copyc rap$get_file_path_and_ref
*copyc rap$locate_element
*copyc rav$subproduct_info_pointers
*copyc rav$pacs_catalog_p
*copyc rav$pacs_catalog_ref_p
*copyc rav$defs_scratch_segment

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

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

{ PURPOSE:
{   This command interface sets the storage_class field for a
{   file or all files in the current subproduct.
{
{ DESIGN:
{   The file is validated as part of the current subproduct.
{   The file is located in the element_list and its storage class
{   is updated.  If ALL elements are selected, all files in the
{   element list are updated.
{
{ NOTES:
{
{

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

{  pdt defsc_pdt (
{    file, files, f    : file or key all = all
{    storage_class, sc : key service_critical_product, product, user_permanen..
{ t_files = $required
{    status            : var of status = $optional
{    )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    defsc_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
  ^defsc_pdt_names, ^defsc_pdt_params];

  VAR
    defsc_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6]
  of clt$parameter_name_descriptor := [['FILE', 1], ['FILES', 1], ['F', 1], [
  'STORAGE_CLASS', 2], ['SC', 2], ['STATUS', 3]];

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

{ FILE FILES F }
    [[clc$optional_with_default, ^defsc_pdt_dv1], 1, 1, 1, 1,
  clc$value_range_not_allowed, [^defsc_pdt_kv1, clc$file_value]],

{ STORAGE_CLASS SC }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^defsc_pdt_kv2,
  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
    defsc_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1
  ] of ost$name := ['ALL'];

  VAR
    defsc_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3
  ] of ost$name := ['SERVICE_CRITICAL_PRODUCT','PRODUCT','USER_PERMANENT_FILES'
  ];

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

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      attributes_p: ^rat$subproduct_attributes,
      element_found: boolean,
      element_p: ^rat$element,
      path_index: integer,
      path_p: ^pft$path,
      path_ref_p: ^fst$file_reference,
      storage_class: rmt$mass_storage_class,
      subproduct_info_seq_p: ^rat$subproduct_info_sequence,
      value: clt$value;

    status.normal := TRUE;
    attributes_p := rav$subproduct_info_pointers.attributes_p;
    element_p := rav$subproduct_info_pointers.element_list_p;
    subproduct_info_seq_p := rav$subproduct_info_pointers.subproduct_info_seq_p;

    IF attributes_p^.first_level_element_count = 0 THEN
      osp$set_status_abnormal ('RA', rae$error_pacs_catalog_empty, '', status);
      RETURN;
    IFEND;

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

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

    IF value.name.value (1, value.name.size) = 'PRODUCT' THEN
      storage_class := rmc$msc_product_files;
    ELSEIF value.name.value (1, value.name.size) = 'USER_PERMANENT_FILES' THEN
      storage_class := rmc$msc_user_permanent_files;
    ELSE {service critical product}
      storage_class := rmc$msc_system_permanent_files;
    IFEND;

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

    IF value.kind = clc$file_value THEN

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

      rap$get_file_path_and_ref ('FILE', rav$defs_scratch_segment.sequence_p, path_p, path_ref_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF (#SIZE (path_ref_p^) < #SIZE (rav$pacs_catalog_ref_p^)) OR
            (rav$pacs_catalog_ref_p^ <> path_ref_p^ (1, #SIZE (rav$pacs_catalog_ref_p^))) THEN
        osp$set_status_abnormal ('RA', rae$not_in_pacs_catalog, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, path_ref_p^, status);
        RETURN;
      IFEND;

      path_index := UPPERBOUND (rav$pacs_catalog_p^) + 1;

      rap$locate_element (path_p, path_index, subproduct_info_seq_p, element_p, element_found);

      IF NOT element_found THEN
        osp$set_status_abnormal ('RA', rae$not_in_pacs_catalog, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, path_ref_p^, status);
        RETURN;
      IFEND;

      IF element_p^.element_type = rac$file THEN
        add_storage_class (storage_class, 1, element_p, attributes_p, subproduct_info_seq_p);
      ELSE
        osp$set_status_abnormal ('RA', rae$expecting_file, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, path_ref_p^, status);
        RETURN;
      IFEND;

    ELSE {ALL}

      add_storage_class (storage_class, attributes_p^.first_level_element_count, element_p,
            attributes_p, subproduct_info_seq_p);
    IFEND;

  PROCEND rap$define_storage_class;

?? TITLE := 'add_storage_class', EJECT ??

{ PURPOSE:
{   This procedure sets the storage_class field for a file
{   or all files in the element_list.
{
{ DESIGN:
{   This procedure is given an element pointer and the number of elements in that
{   element.  If the element is of type FILE, then only that one element will be updated.
{   If the element is of type CATALOG, all files in the catalog will be updated as well
{   as all files in all of the subcatalogs.
{
{ NOTES:
{

  PROCEDURE add_storage_class
    (    storage_class: rmt$mass_storage_class;
         element_count: rat$element_count;
     VAR element_p: {input/output} ^rat$element;
     VAR attributes_p: {input/output} ^rat$subproduct_attributes;
     VAR subproduct_info_seq_p: {input/output} ^rat$subproduct_info_sequence);


    VAR
      i: rat$path_container_index,
      next_element_count: rat$element_count,
      first_element_down_p: ^rat$element;


    FOR i := 1 TO element_count DO

      IF element_p^.element_type = rac$file THEN

        IF element_p^.storage_class <> storage_class THEN

          IF storage_class = rmc$msc_product_files THEN
            attributes_p^.product_file_size := attributes_p^.product_file_size + element_p^.size;
            IF (attributes_p^.service_critical_file_size - element_p^.size) > 0 THEN
              attributes_p^.service_critical_file_size := attributes_p^.service_critical_file_size -
                    element_p^.size;
            ELSE
              attributes_p^.service_critical_file_size := 0;
            IFEND;
            IF (attributes_p^.user_permanent_file_size - element_p^.size) > 0 THEN
              attributes_p^.user_permanent_file_size := attributes_p^.user_permanent_file_size -
                    element_p^.size;
            ELSE
              attributes_p^.user_permanent_file_size := 0;
            IFEND;
          ELSEIF storage_class = rmc$msc_user_permanent_files THEN
            attributes_p^.user_permanent_file_size := attributes_p^.user_permanent_file_size +
                  element_p^.size;
            IF (attributes_p^.service_critical_file_size - element_p^.size) > 0 THEN
              attributes_p^.service_critical_file_size := attributes_p^.service_critical_file_size -
                    element_p^.size;
            ELSE
              attributes_p^.service_critical_file_size := 0;
            IFEND;
            IF (attributes_p^.product_file_size - element_p^.size) > 0 THEN
              attributes_p^.product_file_size := attributes_p^.product_file_size - element_p^.size;
            ELSE
              attributes_p^.product_file_size := 0;
            IFEND;
          ELSE
            IF (attributes_p^.product_file_size - element_p^.size) > 0 THEN
              attributes_p^.product_file_size := attributes_p^.product_file_size - element_p^.size;
            ELSE
              attributes_p^.product_file_size := 0;
            IFEND;
            IF (attributes_p^.user_permanent_file_size - element_p^.size) > 0 THEN
              attributes_p^.user_permanent_file_size := attributes_p^.user_permanent_file_size -
                    element_p^.size;
            ELSE
              attributes_p^.user_permanent_file_size := 0;
            IFEND;
            attributes_p^.service_critical_file_size := attributes_p^.service_critical_file_size +
                  element_p^.size;
          IFEND;

        IFEND;

        element_p^.storage_class := storage_class;

      ELSEIF (element_p^.element_type = rac$catalog) AND (element_p^.element_count <> 0) THEN
        next_element_count := element_p^.element_count;
        first_element_down_p := #PTR (element_p^.first_element_down_p, subproduct_info_seq_p^);
        add_storage_class (storage_class, next_element_count, first_element_down_p, attributes_p,
              subproduct_info_seq_p);
      IFEND;

      IF i < element_count THEN
        element_p := #PTR (element_p^.next_element_across_p, subproduct_info_seq_p^);
      IFEND;
    FOREND;

  PROCEND add_storage_class;

MODEND ram$define_storage_class;
