#!/bin/sh
#
# Create the source files containing the individual programs 
# and test data file
#
cat >ParseKWsets.cpy <<!EOF!
      ******************************************************************
      * Author: Jay Moseley
      * Date: May 25, 2016
      * Purpose: Fields returned from ParseKWsets
      ******************************************************************
       01  PARSED-KEYWORD              PIC X(25).
       01  PARSED-INDEX                PIC S9(4) COMP.
       01  PARSED-VALUE                PIC X(60).
      ************************************************ end of copybook *
!EOF!
cat >parseKWsets.cbl <<!EOF!
      ******************************************************************
      * Author: Jay Moseley
      * Date: May 25, 2016
      * Purpose: Parse a passed field into a Keyword segment and
      *          a value segment based upon the position of a
      *          separating colon character ':'. If no colon character
      *          RETURN-CODE is set to +8. After successfull parsing,
      *          if the Keyword segment contains a left parenthesis
      *          character '(' followed by a right parenthesis charac-
      *          ter ')', the Keyword segment is additional parsed
      *          to place the numeric value contained between the
      *          parentheses into an index value field.
      *       September 20, 2019 - addition of copybook for fields
      *                            returned to caller and determine
      *                            length of passed in field at
      *                            execution time.
      * Tectonics: cobc -m parseKWsets.cbl
      ******************************************************************
       IDENTIFICATION DIVISION.

       PROGRAM-ID. parseKWsets.
       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

       DATA DIVISION.

       FILE SECTION.

       WORKING-STORAGE SECTION.

       LOCAL-STORAGE SECTION.

       *> Length of the field passed from caller:
       01  INPUT-FIELD-SIZE            PIC 9(6) COMP-5.

       *> Copy of input field in local storage:
       01  INPUT-FIELD-LOCAL           PIC X(32768).

       01  KOUNT                       PIC S9(4) COMP.
       01  KW-LEN                      PIC S9(4) COMP.
       01  KV-START                    PIC S9(4) COMP.
       01  IX-START                    PIC S9(4) COMP.
       01  IX-VALUE                    PIC X(5).

       LINKAGE SECTION.

       01  PASSED-FIELD                PIC X ANY LENGTH.

       COPY 'ParseKWsets.cpy'.

       PROCEDURE DIVISION USING PASSED-FIELD,
                                PARSED-KEYWORD,
                                PARSED-INDEX,
                                PARSED-VALUE.

      ******************************************************************
      * Retrieve length of passed field.
      ******************************************************************
           CALL 'C\$PARAMSIZE' USING 1
              GIVING INPUT-FIELD-SIZE
           END-CALL.

           MOVE PASSED-FIELD (1:INPUT-FIELD-SIZE) TO INPUT-FIELD-LOCAL.

           INSPECT INPUT-FIELD-LOCAL
             TALLYING KW-LEN FOR CHARACTERS 
                      BEFORE INITIAL ':'.
           INSPECT INPUT-FIELD-LOCAL
             TALLYING KOUNT FOR ALL ':'.

           IF KOUNT = 0
             MOVE +8 TO RETURN-CODE
             GOBACK.
      * - - - - - - - - - - - - - - - - - - - - - - PROGRAM EXIT POINT

           COMPUTE KV-START = KW-LEN + 2.
           MOVE TRIM(INPUT-FIELD-LOCAL (KV-START:)) TO PARSED-VALUE.
           MOVE INPUT-FIELD-LOCAL (1:KW-LEN) TO PARSED-KEYWORD.
           MOVE +0 TO PARSED-INDEX.
           MOVE +0 TO KOUNT, KW-LEN.
           INSPECT PARSED-KEYWORD
             TALLYING KOUNT FOR ALL '(' CHARACTERS.
           INSPECT PARSED-KEYWORD
             TALLYING KW-LEN FOR CHARACTERS
                      BEFORE INITIAL '('.

           IF KOUNT > 0
             ADD +2 TO KW-LEN GIVING IX-START
             MOVE SPACES TO IX-VALUE
             UNSTRING PARSED-KEYWORD
               DELIMITED BY ')'
               INTO IX-VALUE 
               WITH POINTER IX-START
             END-UNSTRING
             MOVE NUMVAL(IX-VALUE) TO PARSED-INDEX
             ADD +1 TO KW-LEN GIVING IX-START
             MOVE SPACES TO PARSED-KEYWORD(IX-START:)
           END-IF. 

           MOVE +0 TO RETURN-CODE.
           GOBACK.
      * - - - - - - - - - - - - - - - - - - - - - - PROGRAM EXIT POINT

       END PROGRAM parseKWsets.

!EOF!
# ------------------------------------------------------------------
cat >testParse.cbl <<!EOF!
      ******************************************************************
      * Author: Jay Moseley
      * Date: May 23, 2016
      * Purpose: Test/verify parseKWsets operation.
      * Tectonics: cobc -x testParse.cbl
      ******************************************************************
       IDENTIFICATION DIVISION.

       PROGRAM-ID. testParse.
       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT INPUT-FILE
               ORGANIZATION IS LINE SEQUENTIAL
               ASSIGN TO 'testParse.inp'.

       DATA DIVISION.

       FILE SECTION.

       FD  INPUT-FILE
           DATA RECORD IS INPUT-RECORD.
       01  INPUT-RECORD                  PIC X(125).

       WORKING-STORAGE SECTION.

       01  WORK-FIELDS.
           02  END-INPUT-FILE-SWITCH   PIC X VALUE 'N'.
               88  END-OF-FILE               VALUE 'Y'.
               88  NOT-END-OF-FILE           VALUE 'N'.

           02  SEPARATOR               PIC X(70) VALUE ALL '-'.

           02  INPUT-RECORD-COUNT      PIC 9(2) VALUE 0.

       COPY 'ParseKWsets.cpy'.

       PROCEDURE DIVISION.

       MAIN-PROCEDURE SECTION.

       PROCESS-INPUT-FILE.

           SET NOT-END-OF-FILE TO TRUE.

           OPEN INPUT INPUT-FILE.

           PERFORM UNTIL END-OF-FILE
             READ INPUT-FILE
               AT END
                 SET END-OF-FILE TO TRUE
               NOT AT END
                 ADD 1 TO INPUT-RECORD-COUNT
                 DISPLAY 'Input Record #' INPUT-RECORD-COUNT
                         ' ->' INPUT-RECORD
                 CALL 'parseKWsets' USING INPUT-RECORD,
                                          PARSED-KEYWORD,
                                          PARSED-INDEX,
                                          PARSED-VALUE
                 END-CALL
                 IF RETURN-CODE = +0
                   DISPLAY 'Keyword..' PARSED-KEYWORD
                   DISPLAY 'Index....' PARSED-INDEX
                   DISPLAY 'Value....' PARSED-VALUE
                   DISPLAY SEPARATOR
                 ELSE
                   DISPLAY 'RETURN-CODE=' RETURN-CODE
                   DISPLAY SEPARATOR
                 END-IF
             END-READ
           END-PERFORM.

           CLOSE INPUT-FILE.

           STOP RUN.
      * - - - - - - - - - - - - - - - - - - - - - - PROGRAM EXIT POINT

       END PROGRAM testParse.

!EOF!
# ------------------------------------------------------------------
cat >testParse.inp <<!EOF!
Title: 1001 Questions Answered About Trees
SubTitle: 
Author(1): Platt, Rutherford
Publisher: Dodd, Mead & Company
Year.Published: 1959
Title: Adult Art Psychotherapy
SubTitle: Issues and Applications
Author(1): Landgarten, Helen B.
Author(2): Lubbers, Darcy
Publisher: Brunner/Mazel
Title: Art Therapy, Race and Culture
SubTitle: 
Author(1): Campbell, Jean
Author(2): Liebmann, Marian
Author(3): Brooks, Frederica
Author(4): Jones, Jenny
Author(5): Ward, Cathy
Publisher: Jessica Kingsley
Year.Published: 1999
ISBN: 185302578X
Accession Year: 2015
Next Accession Number: 0000
Next Title RRN: +00002293
Print Requests Pending: 0000
Really Big Index(1024): Value is 32
This will be reported as an error
Course Name: INTERIOR DESIGN: COLOR AND LIGHT
Course Name: HISTORY OF ARCHITECTURE AND INTERIOR DESIGN
!EOF!
# ------------------------------------------------------------------
#
# Compile the programs
#
cobc -m parseKWsets.cbl
cobc -xj testParse.cbl
#
exit 0