?? RIGHT := 110 ??
?? NEWTITLE := 'rap$process_psrs_entered utility procedure.' ??
MODULE ram$process_psrs_entered;

{ PURPOSE:
{   This module contains the procedure that adds the PSRS to the
{   subproduct info sequence.
{
{ DESIGN:
{
{   The compiled module resides in RAF$LIBRARY.
{ NOTES:
{

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$data_value
*copyc ost$status
*copyc rae$package_software_cc
*copyc rat$correction_process_record
*copyc rat$subproduct_info_pointers
*copyc rat$subproduct_info_types
?? POP ??
*copyc amp$get_next
*copyc amp$rewind
*copyc clp$evaluate_token
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$generate_error_message
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc rap$sort_psrs

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

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

{ PURPOSE:
{   This procedure validates the input PSRs and adds them to the new
{   subproduct info sequence.
{
{ DESIGN:
{   Input validation:
{   1.  All duplicates from within the input PSR list are eliminated with
{       an informative message issued.
{   2.  If a previous correction exists, any of the input PSRs which
{       duplicate entries from the previous correction
{       are also eliminated with an informative message.
{   3.  PSR names are verified to be exactly 8 alpha_numeric characters
{       beginning with a letter.  If a syntax error is found,
{       an ERROR status will be returned and the entire input list will be rejected.
{
{   The new PSRs (minus all duplicates) are stored in the new subproduct info
{   sequence.
{
{   Validation is performed by first checking the current PSR with the list
{   of already validated input PSRs.  If it is not a duplicate, it is then
{   checked for duplication against the PSR list from a previous correction,
{   if it exists.  If it validates successfully, it is added to the end of
{   the validated PSR list.  The validated PSR list is maintained as an
{   adaptable array inside the new subproduct info sequence.
{
{ NOTES:
{   All PSR names are expected to begin with a letter.  The name may only have
{   letters and numerals.
{

  PROCEDURE [XDCL]  rap$process_psrs_entered
    (    psrs_answered: clt$data_value;
     VAR new_subproduct_info_pointers: rat$subproduct_info_pointers;
     VAR previous_correction_sif: rat$correction_process_sif_info;
     VAR status: ost$status);

    VAR
      path_container_p: ^rat$path_container,
      psrs_answered_p: ^rat$psrs_answered,
      previous_psrs_p: ^rat$psrs_answered;

    status.normal := TRUE;
    psrs_answered_p := NIL;

    IF previous_correction_sif.file_opened THEN
      previous_psrs_p := previous_correction_sif.subproduct_info_pointers.psrs_answered_p;
    ELSE
      previous_psrs_p := NIL;
    IFEND;

    IF psrs_answered.kind = clc$list THEN

      process_psrs_from_list (psrs_answered, previous_psrs_p, psrs_answered_p,
            new_subproduct_info_pointers.subproduct_info_seq_p, status);

    ELSEIF psrs_answered.kind = clc$file THEN

      process_psrs_from_file (psrs_answered.file_value, previous_psrs_p, psrs_answered_p,
            new_subproduct_info_pointers.subproduct_info_seq_p, status);

    IFEND;

    IF status.normal AND (psrs_answered_p <> NIL) THEN
      rap$sort_psrs (psrs_answered_p^);

      new_subproduct_info_pointers.psrs_answered_p := psrs_answered_p;

      new_subproduct_info_pointers.info_header_p^.psrs_answered_p :=
            #REL (psrs_answered_p, new_subproduct_info_pointers.subproduct_info_seq_p^);

    IFEND;

  PROCEND rap$process_psrs_entered;

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

{ PURPOSE:
{   This procedure adds a psr to the list of psrs.
{
{ DESIGN:
{   The PSR is added to the end of the array containing the
{   new psrs.  The array is located on the new subproduct
{   info sequence.
{
{ NOTES:
{
{

  PROCEDURE add_psr_to_list
    (    psr: rat$psr;
     VAR psrs_answered_p: ^rat$psrs_answered;
     VAR new_subproduct_info_seq_p: ^rat$subproduct_info_sequence);

    VAR
      psr_count: rat$psrs_answered_count;

    IF psrs_answered_p = NIL THEN
      NEXT psrs_answered_p: [1 .. 1] IN new_subproduct_info_seq_p;
      psrs_answered_p^ [1] := psr;
    ELSE
      psr_count := UPPERBOUND (psrs_answered_p^) + 1;
      RESET new_subproduct_info_seq_p TO psrs_answered_p;
      NEXT psrs_answered_p: [1 .. psr_count] IN new_subproduct_info_seq_p;
      psrs_answered_p^ [psr_count] := psr;
    IFEND;

  PROCEND add_psr_to_list;

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

{ PURPOSE:
{   This procedure process a list of psrs from a file.
{
{ DESIGN:
{   The file containing PSRs is opened and read a line at a
{   time.  The entry on each line is verified to be the length
{   of a PSR name.  The PSR name is sent to another procedure
{   to be validated, checked as a duplicate and eventually added
{   to the psrs answered list.
{
{ NOTES:
{
{

  PROCEDURE process_psrs_from_file
    (    psrs_file_p: ^fst$file_reference;
         previous_psrs_p: ^rat$psrs_answered;
     VAR psrs_answered_p: ^rat$psrs_answered;
     VAR new_subproduct_info_seq_p: ^rat$subproduct_info_sequence;
     VAR status: ost$status);

    VAR
      attachment_option: array [1 .. 2] of fst$attachment_option,
      file_position: amt$file_position,
      ignore_byte_address: amt$file_byte_address,
      local_status: ost$status,
      name_length: integer,
      psr: string (osc$max_string_size),
      psr_fid: amt$file_identifier,
      psr_file_opened: boolean,
      psr_name_length: string (osc$max_string_size),
      transfer_count: amt$transfer_count;

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

{ PURPOSE:
{   This procedure cleans up when an abort situation occurs
{   within the block structure.
{
{ DESIGN:
{   If an abort situation occurs, all open files are closed.
{
{ NOTES:
{
{

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      VAR
        ignore_status: ost$status;

      IF psr_file_opened THEN
        fsp$close_file (psr_fid, ignore_status);
        psr_file_opened := FALSE;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    osp$establish_block_exit_hndlr (^abort_handler);


  /main/
    BEGIN

      attachment_option [1].selector := fsc$access_and_share_modes;
      attachment_option [1].access_modes.selector := fsc$specific_access_modes;
      attachment_option [1].access_modes.value := $fst$file_access_options [fsc$read];
      attachment_option [1].share_modes.selector := fsc$determine_from_access_modes;
      attachment_option [2].selector := fsc$create_file;
      attachment_option [2].create_file := FALSE;

      psr_file_opened := TRUE;
      fsp$open_file (psrs_file_p^, amc$record, ^attachment_option, NIL, NIL, NIL, NIL, psr_fid, status);
      IF NOT status.normal THEN
        psr_file_opened := FALSE;
        EXIT /main/;
      IFEND;

      amp$get_next (psr_fid, ^psr, #SIZE (psr), transfer_count, ignore_byte_address, file_position, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      WHILE file_position <> amc$eoi DO

        IF (file_position = amc$eor) AND (transfer_count = rac$psr_name_length) THEN
          validate_psr_and_add_to_list (psr (1, rac$psr_name_length), previous_psrs_p, psrs_answered_p,
                new_subproduct_info_seq_p, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

          amp$get_next (psr_fid, ^psr, #SIZE (psr), transfer_count, ignore_byte_address, file_position,
                status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

        ELSE

          IF transfer_count <> rac$psr_name_length THEN
            STRINGREP (psr_name_length, name_length, rac$psr_name_length);
            osp$set_status_abnormal ('RA', rae$psr_format_error, psr_name_length (1, name_length), status);
            osp$append_status_parameter (osc$status_parameter_delimiter, psr (1, transfer_count), status);
          ELSE
            osp$set_status_abnormal ('RA', rae$unable_to_read_psr_line, '', status);
          IFEND;

          EXIT /main/;
        IFEND;

      WHILEND

    END /main/;

    IF psr_file_opened THEN
      fsp$close_file (psr_fid, local_status);
    IFEND;

    osp$disestablish_cond_handler;

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

  PROCEND process_psrs_from_file;

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

{ PURPOSE:
{   This procedure process a linked list of psrs from the input parameter
{   PSRS_ANSWERED.
{
{ DESIGN:
{   The procedure loops through the linked list passing each PSR name
{   to other procedures where it is validated, checked as a duplicate
{   and eventually added to the psrs answered list.
{
{ NOTES:
{
{

  PROCEDURE process_psrs_from_list
    (    psr_list: clt$data_value;
         previous_psrs_p: ^rat$psrs_answered;
     VAR psrs_answered_p: ^rat$psrs_answered;
     VAR new_subproduct_info_seq_p: ^rat$subproduct_info_sequence;
     VAR status: ost$status);

    VAR
      psrs: clt$data_value;

    status.normal := TRUE;
    psrs := psr_list;

  /loop/
    WHILE status.normal DO

      validate_psr_and_add_to_list (psrs.element_value^.name_value (1, rac$psr_name_length), previous_psrs_p,
            psrs_answered_p, new_subproduct_info_seq_p, status);

      IF psrs.link = NIL THEN
        EXIT /loop/;
      ELSE
        psrs := psrs.link^;
      IFEND;

    WHILEND /loop/;

  PROCEND process_psrs_from_list;

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

{ PURPOSE:
{   This function determines if the entered PSR is a duplicate
{   of a previously entered PSR.
{
{ DESIGN:
{   This procedure uses a sequential sort to compare the PSR
{   entered with a list of psrs.
{
{ NOTES:
{

  FUNCTION psr_duplicated
    (    psr: rat$psr,
         psrs_answered_p: ^rat$psrs_answered): boolean;

    VAR
      i: rat$psrs_answered_count,
      psr_found: boolean;


    psr_found := FALSE;

    IF psrs_answered_p <> NIL THEN

    /search_loop/
      FOR i := 1 TO UPPERBOUND (psrs_answered_p^) DO
        IF psr = psrs_answered_p^ [i] THEN
          psr_found := TRUE;
          EXIT /search_loop/;
        IFEND;
      FOREND /search_loop/;

    IFEND;

    psr_duplicated := psr_found;

  FUNCEND psr_duplicated;

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

{ PURPOSE:
{   This procedure validates a psr and adds it to the list of psrs answered.
{
{ DESIGN:
{   This procedure validates that a PSR:
{   1) Begins with a letter.
{   2) Has only letters and numerals.
{
{   Compares the PSR against the previous psr list and the new
{   list of psrs to see if it is a duplicate.
{
{   Adds the PSR to the list of new psrs.
{
{ NOTES:
{
{

  PROCEDURE validate_psr_and_add_to_list
    (    psr: rat$psr;
         previous_psrs_p: ^rat$psrs_answered;
     VAR psrs_answered_p: ^rat$psrs_answered;
     VAR new_subproduct_info_seq_p: ^rat$subproduct_info_sequence;
     VAR status: ost$status);

    VAR
      evaluation_options: clt$token_evaluation_options,
      i: 0 .. rac$psr_name_length,
      ignore_status: ost$status,
      index: clt$string_index,
      local_status: ost$status,
      name_length: integer,
      psr_name_length: string (osc$max_string_size),
      spaces_preceded_token: boolean,
      token: clt$lexical_token,
      upper_case_psr: rat$psr;

    status.normal := TRUE;
    evaluation_options := $clt$token_evaluation_options [clc$classify_name_token,
          clc$ignore_spaces_before_token];
    #TRANSLATE (osv$lower_to_upper, psr, upper_case_psr);
    index := 1;

    clp$evaluate_token (upper_case_psr, evaluation_options, index, spaces_preceded_token, token, status);
    IF NOT status.normal OR (token.kind <> clc$simple_name_token) THEN
      STRINGREP (psr_name_length, name_length, rac$psr_name_length);
      osp$set_status_abnormal ('RA', rae$psr_format_error, psr_name_length (1, name_length), status);
      osp$append_status_parameter (osc$status_parameter_delimiter, upper_case_psr, status);
      RETURN;
    IFEND;

    IF psr_duplicated (upper_case_psr, psrs_answered_p) THEN
      osp$set_status_abnormal ('RA', rae$psr_entered_twice, upper_case_psr, local_status);
      osp$generate_error_message (local_status, ignore_status);
    ELSEIF psr_duplicated (upper_case_psr, previous_psrs_p) THEN
      osp$set_status_abnormal ('RA', rae$duplicate_psr, upper_case_psr, local_status);
      osp$generate_error_message (local_status, ignore_status);
    ELSE
      add_psr_to_list (upper_case_psr, psrs_answered_p, new_subproduct_info_seq_p);
    IFEND;

  PROCEND validate_psr_and_add_to_list;

MODEND ram$process_psrs_entered;


