?? RIGHT := 110 ??
?? NEWTITLE := 'DEFINE_SUBPRODUCT Subutility: Module RAM$DEFINE_PERMIT.' ??
MODULE ram$define_permit;

{ PURPOSE:
{   This module sets the permit field for an element or all elements in the
{   element list.
{
{ DESIGN:
{   The element list is searched for the correct file or catalog.  Then
{   the permit 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
*copyc rat$validation_selections
?? POP ??
*copyc clp$convert_file_ref_to_string
*copyc clp$get_fs_path_elements
*copyc clp$get_set_count
*copyc clp$get_value
*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 rap$locate_element
*copyc rap$get_file_path_and_ref
*copyc rav$subproduct_info_pointers
*copyc rav$pacs_catalog_p
*copyc rav$pacs_catalog_ref_p
*copyc rav$defs_scratch_segment
*copy rav$permit_names

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

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

{ PURPOSE:
{   This procedure sets each or all of the permit fields in the element_list.
{
{ DESIGN:
{   The permit, share_mode and application information are determined
{   from the input parameters on DEFINE_CATALOG_PERMIT or DEFINE_FILE_PERMIT.
{   If only one file or catalog is being updated, validate that it is
{   an element of the current subproduct.  Then locate the element in the
{   element list and update the permit field.
{   If all files are selected, update the permit for all elements in the
{   element list.
{   If INSTALLATION_PATH_CATALOG is selected, validate the existence of
{   the installation path and update the value of the permit.
{
{ NOTES:
{
{

  PROCEDURE [XDCL] rap$define_permit
    (    element_type: string ( * <= osc$max_string_size);
     VAR status: ost$status);

    VAR
      ai_specified: boolean,
      application_info: pft$application_info,
      attributes_p: ^rat$subproduct_attributes,
      element_p: ^rat$element,
      element_found: boolean,
      ignore_permit: pft$permit_selections,
      ignore_share: pft$share_requirements,
      path_index: 0 .. fsc$max_path_size,
      path_p: ^pft$path,
      path_ref_p: ^fst$file_reference,
      permit: pft$permit_selections,
      share_specified: boolean,
      share: pft$share_requirements,
      subproduct_info_seq_p: ^rat$subproduct_info_sequence,
      value: clt$value;


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

    process_access_or_share ('ACCESS_MODE', select_permit, ignore_share, permit, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    IF share_specified THEN
      process_access_or_share ('SHARE_MODE', select_share, share, ignore_permit, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      share := $pft$share_requirements [];
    IFEND;

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

    IF ai_specified THEN
      clp$get_value ('APPLICATION_INFORMATION', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      application_info := value.str.value (1, value.str.size);
    ELSE {application information not specified}
      application_info := '';
    IFEND;

    clp$get_value (element_type, 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 (element_type, rav$defs_scratch_segment.sequence_p, path_p, path_ref_p,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF rav$pacs_catalog_ref_p^ = path_ref_p^ THEN

        attributes_p^.catalog_permit.defined := TRUE;
        attributes_p^.catalog_permit.permit_selections := permit;
        attributes_p^.catalog_permit.share_requirements := share;
        attributes_p^.catalog_permit.application_info := application_info;

      ELSE

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

        IF (#SIZE (rav$pacs_catalog_ref_p^) > #SIZE (path_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$catalog) AND (element_type <> 'CATALOG')) THEN
          osp$set_status_abnormal ('RA', rae$expecting_file, '', status);
          osp$append_status_file (osc$status_parameter_delimiter, path_ref_p^, status);
          RETURN;
        IFEND;

        IF ((element_p^.element_type = rac$file) AND (element_type <> 'FILE')) THEN
          osp$set_status_abnormal ('RA', rae$expecting_catalog, '', status);
          osp$append_status_file (osc$status_parameter_delimiter, path_ref_p^, status);
          RETURN;
        IFEND;

        element_p^.permit.defined := TRUE;
        element_p^.permit.permit_selections := permit;
        element_p^.permit.share_requirements := share;
        element_p^.permit.application_info := application_info;

      IFEND;

    ELSEIF value.name.value = 'ALL' THEN

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

      add_file_permit (permit, share, application_info, attributes_p^.first_level_element_count, element_p,
            subproduct_info_seq_p);

    ELSEIF value.name.value = 'INSTALLATION_PATH_CATALOG' THEN

      attributes_p^.catalog_permit.defined := TRUE;
      attributes_p^.catalog_permit.permit_selections := permit;
      attributes_p^.catalog_permit.share_requirements := share;
      attributes_p^.catalog_permit.application_info := application_info;

    IFEND;

  PROCEND rap$define_permit;

?? TITLE := 'add_file_permit', EJECT ??

{ PURPOSE:
{   This procedure sets the permit on an element or all elements
{   in the element list.
{
{ DESIGN:
{   This procedure is given an element pointer and the number of next level 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 and lower level subcatalogs
{   will be updated.
{
{ NOTES:
{
{

  PROCEDURE add_file_permit
    (    permit: pft$permit_selections;
         share: pft$share_requirements;
         application_info: pft$application_info;
         element_count: rat$element_count;
         element_p: ^rat$element;
     VAR subproduct_info_seq_p: ^rat$subproduct_info_sequence);


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


    current_element_p := element_p;

    FOR i := 1 TO element_count DO
      IF current_element_p^.element_type = rac$file THEN
        current_element_p^.permit.defined := TRUE;
        current_element_p^.permit.permit_selections := permit;
        current_element_p^.permit.share_requirements := share;
        current_element_p^.permit.application_info := application_info;
      ELSEIF (current_element_p^.element_type = rac$catalog) AND (current_element_p^.element_count <> 0) THEN
        next_element_count := current_element_p^.element_count;
        first_element_down_p := #PTR (current_element_p^.first_element_down_p, subproduct_info_seq_p^);
        add_file_permit (permit, share, application_info, next_element_count, first_element_down_p,
              subproduct_info_seq_p);
      IFEND;

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

  PROCEND add_file_permit;

?? TITLE := 'process_access_or_share', EJECT ??

{ PURPOSE:
{   This procedure sets the correct values for the access_mode and  share_mode
{   given the input parameters.
{
{ DESIGN:
{   This procedure translates the value of ALL or WRITE into
{   the correct set of access modes.
{
{ NOTES:
{
{

  PROCEDURE process_access_or_share
    (    param_name: string ( * );
         selection_kind: (select_share, select_permit);
     VAR share_requirements: pft$share_requirements;
     VAR permit_selections: pft$permit_selections;
     VAR status: ost$status);

    VAR
      i: 1 .. clc$max_value_sets,
      j: pft$permit_options,
      permit_option: pft$permit_selections,
      share_option: pft$share_requirements,
      value_set_count: 0 .. clc$max_value_sets,
      value: clt$value;


    permit_selections := $pft$permit_selections [];
    share_requirements := $pft$share_requirements [];

    clp$get_set_count (param_name, value_set_count, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

      IF value.name.value = 'ALL' THEN
        IF (value_set_count <> 1) AND (selection_kind <> select_permit) THEN
          osp$set_status_abnormal ('CL', cle$all_must_be_used_alone, param_name, status);
          RETURN;
        IFEND;

        IF selection_kind = select_permit THEN
          permit_option := -$pft$permit_selections [pfc$control, pfc$cycle];
        ELSEIF selection_kind = select_share THEN
          share_option := -$pft$share_requirements [];
        IFEND;

      ELSEIF value.name.value = 'NONE' THEN
        IF value_set_count <> 1 THEN
          osp$set_status_abnormal ('CL', cle$none_must_be_used_alone, param_name, status);
        IFEND;
        RETURN;

      ELSEIF value.name.value = 'WRITE' THEN
        IF selection_kind = select_permit THEN
          permit_option := $pft$permit_selections [pfc$append, pfc$modify, pfc$shorten];
        ELSEIF selection_kind = select_share THEN
          share_option := $pft$share_requirements [pfc$append, pfc$modify, pfc$shorten];
        IFEND;

      ELSE

      /initialize_value/
        FOR j := LOWERBOUND (rav$permit_names) TO UPPERBOUND (rav$permit_names) DO

          IF rav$permit_names [j] = value.name.value THEN

            IF selection_kind = select_permit THEN
              permit_option := $pft$permit_selections [j];
            ELSEIF selection_kind = select_share THEN
              share_option := $pft$share_requirements [j];
            IFEND;

          IFEND;

        FOREND /initialize_value/;

      IFEND;

      IF selection_kind = select_permit THEN
        IF permit_option <= permit_selections THEN
          osp$set_status_abnormal ('CL', cle$redundancy_in_selections, param_name, status);
          RETURN;
        IFEND;
        permit_selections := permit_selections + permit_option;

      ELSEIF selection_kind = select_share THEN

        IF share_option <= share_requirements THEN
          osp$set_status_abnormal ('CL', cle$redundancy_in_selections, param_name, status);
          RETURN;
        IFEND;
        share_requirements := share_requirements + share_option;

      IFEND;

    FOREND;

  PROCEND process_access_or_share;

MODEND ram$define_permit;
