>>SOURCE FORMAT IS FREE *> cobol-string-unstring.cob - split a comma-separated customer export with *> UNSTRING, check every field with COUNT IN, TALLYING IN, DELIMITER IN and *> ON OVERFLOW, then build a fixed-width label with STRING ... WITH POINTER *> Dialect: GnuCOBOL 3.x, free format *> Status : desk-checked against the GnuCOBOL 3.2 release source *> (libcob/strings.c, libcob/fileio.c) and the Programmer's Guide; *> NOT compiled (no cobc on the authoring machine) *> Input : datasets/cobol-string-unstring.csv, LINE SEQUENTIAL, one header *> line, then cust_id,last_name,first_name,city,tags with the tags *> separated by "|"; lines up to 120 bytes; no quoted fields *> Output : one line per input line on standard output, then totals *> Return : 0 if every data line was accepted, 4 if any was rejected, *> 12 if the file will not open, 16 if the header is wrong *> Build : cobc -x code/cobol-string-unstring.cob *> Run : ./cobol-string-unstring (from the site folder) IDENTIFICATION DIVISION. PROGRAM-ID. CSVSPLIT. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT Csv-File ASSIGN TO "datasets/cobol-string-unstring.csv" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Csv-Status. DATA DIVISION. FILE SECTION. FD Csv-File. 01 Csv-Line PIC X(120). WORKING-STORAGE SECTION. 01 WS-Csv-Status PIC XX. 88 Csv-Ok VALUE "00". 88 Csv-Eof VALUE "10". 01 WS-Header PIC X(40) VALUE "cust_id,last_name,first_name,city,tags". *> Where we are in the file, and how long the current line really is. *> A LINE SEQUENTIAL read pads the record area with spaces, so the length *> comes from counting the trailing spaces (see Find-Length). 01 WS-Line-No PIC 9(3) VALUE 0. 01 WS-Line-Ed PIC ZZ9. 01 WS-Line-Len PIC 9(3). 01 WS-Trail PIC 9(3). 01 WS-Reversed PIC X(120). 01 WS-Quotes PIC 9(3). *> The five receiving fields. Their sizes are the rules: a value longer *> than its field is an error, which only COUNT IN can reveal, because *> UNSTRING truncates silently, the way MOVE does. 01 WS-Cust. 05 Cust-Id PIC X(6). 05 Cust-Last PIC X(15). 05 Cust-First PIC X(12). 05 Cust-City PIC X(15). 05 Cust-Tags PIC X(40). 01 WS-Lengths. 05 Len-Id PIC 9(3). 05 Len-Last PIC 9(3). 05 Len-First PIC 9(3). 05 Len-City PIC 9(3). 05 Len-Tags PIC 9(3). 01 WS-Fields PIC 9(2). 01 WS-Tags-Delim PIC X. 01 WS-Line-Flags. 05 WS-Overflow-Flag PIC X. 88 Extra-Fields VALUE "Y". 88 Field-Count-Ok VALUE "N". 05 WS-Trailing-Flag PIC X. 88 Trailing-Comma VALUE "Y". 88 No-Trailing-Comma VALUE "N". 05 WS-Label-Flag PIC X. 88 Label-Cut VALUE "Y". 88 Label-Fits VALUE "N". *> Messages, built with STRING. STRING never clears its target, so every *> one of these is set to spaces before it is built. 01 WS-Reason PIC X(60). 01 WS-Num2 PIC 99. 01 WS-Digit PIC 9. *> The label: "Last, First (City)" in 32 characters. The pointer must be *> able to hold 33, one past the end, because that is where STRING leaves *> it when the target is exactly full or overflows. 01 WS-Label PIC X(32). 01 WS-Label-Ptr PIC 9(3). 01 WS-Ptr-Ed PIC Z9. 01 WS-Proper PIC X(30). 01 WS-Naive PIC X(30). *> The tags field holds a list of its own, separated by "|". One UNSTRING *> per tag, with a POINTER that remembers where the last one stopped. 01 WS-One-Tag PIC X(40). 01 WS-One-Len PIC 9(3). 01 WS-Tag-Ptr PIC 9(3). 01 WS-Tag-Count PIC 9. 01 WS-Empty-Tags PIC 9. 01 WS-Tag-List PIC X(40). 01 WS-List-Ptr PIC 9(3). 01 WS-Totals. 05 WS-Blank PIC 9(3) VALUE 0. 05 WS-Accepted PIC 9(3) VALUE 0. 05 WS-Rejected PIC 9(3) VALUE 0. 01 WS-Total-Ed PIC ZZ9. PROCEDURE DIVISION. Main-Line. OPEN INPUT Csv-File IF NOT Csv-Ok DISPLAY "CANNOT OPEN THE CSV FILE, STATUS " WS-Csv-Status MOVE 12 TO RETURN-CODE STOP RUN END-IF PERFORM UNTIL Csv-Eof READ Csv-File AT END CONTINUE NOT AT END ADD 1 TO WS-Line-No PERFORM Process-Line END-READ END-PERFORM CLOSE Csv-File PERFORM Show-Totals IF WS-Rejected > 0 MOVE 4 TO RETURN-CODE END-IF STOP RUN. Process-Line. MOVE WS-Line-No TO WS-Line-Ed IF WS-Line-No = 1 IF Csv-Line NOT = WS-Header DISPLAY "LINE 1 IS NOT THE EXPECTED HEADER; STOPPING" CLOSE Csv-File MOVE 16 TO RETURN-CODE STOP RUN END-IF DISPLAY "LINE 1 HEADER" ELSE PERFORM Find-Length IF WS-Line-Len = 0 ADD 1 TO WS-Blank DISPLAY "LINE " WS-Line-Ed " BLANK, SKIPPED" ELSE PERFORM Split-Line PERFORM Check-Fields IF WS-Reason = SPACES PERFORM Build-Label PERFORM Split-Tags PERFORM Show-Accepted ELSE ADD 1 TO WS-Rejected DISPLAY "LINE " WS-Line-Ed " REJECT " FUNCTION TRIM (WS-Reason TRAILING) END-IF END-IF END-IF. *> Reverse the line and count the spaces at its front: that is the number *> of padding spaces after the last real character. Find-Length. MOVE FUNCTION REVERSE (Csv-Line) TO WS-Reversed MOVE 0 TO WS-Trail INSPECT WS-Reversed TALLYING WS-Trail FOR LEADING SPACES COMPUTE WS-Line-Len = FUNCTION LENGTH (Csv-Line) - WS-Trail. *> One UNSTRING does the split. The source is reference-modified to the *> real length so the padding is not read as part of the last field. Split-Line. INITIALIZE WS-Cust WS-Lengths MOVE 0 TO WS-Fields MOVE SPACE TO WS-Tags-Delim SET Field-Count-Ok TO TRUE SET No-Trailing-Comma TO TRUE MOVE SPACES TO WS-Reason MOVE 0 TO WS-Quotes INSPECT Csv-Line (1:WS-Line-Len) TALLYING WS-Quotes FOR ALL QUOTE IF WS-Quotes > 0 EXIT PARAGRAPH END-IF UNSTRING Csv-Line (1:WS-Line-Len) DELIMITED BY "," INTO Cust-Id COUNT IN Len-Id Cust-Last COUNT IN Len-Last Cust-First COUNT IN Len-First Cust-City COUNT IN Len-City Cust-Tags DELIMITER IN WS-Tags-Delim COUNT IN Len-Tags TALLYING IN WS-Fields ON OVERFLOW SET Extra-Fields TO TRUE END-UNSTRING *> A comma as the very last character ends the scan: the pointer is past *> the end of the source, so the next receiving field is never touched and *> TALLYING does not count it. That field is empty, so count it here. IF Csv-Line (WS-Line-Len:1) = "," AND WS-Fields < 5 ADD 1 TO WS-Fields SET Trailing-Comma TO TRUE END-IF. Check-Fields. EVALUATE TRUE WHEN WS-Quotes > 0 MOVE "QUOTED FIELD; THIS PROGRAM DOES NOT PARSE QUOTES" TO WS-Reason WHEN Extra-Fields STRING "MORE THAN 5 FIELDS (THE TAGS FIELD ENDED AT '" WS-Tags-Delim "')" DELIMITED BY SIZE INTO WS-Reason END-STRING WHEN WS-Fields < 5 MOVE WS-Fields TO WS-Digit STRING "ONLY " WS-Digit " FIELDS, EXPECTED 5" DELIMITED BY SIZE INTO WS-Reason END-STRING WHEN Len-Id NOT = 6 OR Cust-Id IS NOT NUMERIC MOVE "CUSTOMER ID IS NOT SIX DIGITS" TO WS-Reason WHEN Len-Last = 0 MOVE "LAST NAME IS MISSING" TO WS-Reason WHEN Len-Last > 15 MOVE Len-Last TO WS-Num2 STRING "LAST NAME HAS " WS-Num2 " CHARACTERS, THE FIELD HOLDS 15" DELIMITED BY SIZE INTO WS-Reason END-STRING WHEN Len-First = 0 MOVE "FIRST NAME IS MISSING" TO WS-Reason WHEN Len-First > 12 MOVE Len-First TO WS-Num2 STRING "FIRST NAME HAS " WS-Num2 " CHARACTERS, THE FIELD HOLDS 12" DELIMITED BY SIZE INTO WS-Reason END-STRING WHEN Len-City = 0 MOVE "CITY IS MISSING" TO WS-Reason WHEN Len-City > 15 MOVE Len-City TO WS-Num2 STRING "CITY HAS " WS-Num2 " CHARACTERS, THE FIELD HOLDS 15" DELIMITED BY SIZE INTO WS-Reason END-STRING WHEN Len-Tags > 40 MOVE Len-Tags TO WS-Num2 STRING "TAGS HAVE " WS-Num2 " CHARACTERS, THE FIELD HOLDS 40" DELIMITED BY SIZE INTO WS-Reason END-STRING WHEN OTHER CONTINUE END-EVALUATE. *> Every count is at least 1 here, so each reference modification below *> has a legal length. The counted pieces keep "Van Dyke" whole; the naive *> version, DELIMITED BY SPACE, stops at the first space inside a name. Build-Label. MOVE SPACES TO WS-Label MOVE 1 TO WS-Label-Ptr SET Label-Fits TO TRUE STRING Cust-Last (1:Len-Last) DELIMITED BY SIZE ", " DELIMITED BY SIZE Cust-First (1:Len-First) DELIMITED BY SIZE " (" DELIMITED BY SIZE Cust-City (1:Len-City) DELIMITED BY SIZE ")" DELIMITED BY SIZE INTO WS-Label WITH POINTER WS-Label-Ptr ON OVERFLOW SET Label-Cut TO TRUE END-STRING MOVE SPACES TO WS-Proper WS-Naive STRING Cust-Last (1:Len-Last) DELIMITED BY SIZE ", " DELIMITED BY SIZE Cust-First (1:Len-First) DELIMITED BY SIZE INTO WS-Proper END-STRING STRING Cust-Last DELIMITED BY SPACE ", " DELIMITED BY SIZE Cust-First DELIMITED BY SPACE INTO WS-Naive END-STRING. *> Walk the tags with a POINTER. Each UNSTRING moves the pointer past the *> tag and its "|", so the loop ends when the pointer passes the end. Two *> "|" in a row give a tag with COUNT 0, which is skipped and counted. Split-Tags. MOVE 0 TO WS-Tag-Count WS-Empty-Tags MOVE SPACES TO WS-Tag-List MOVE 1 TO WS-List-Ptr IF Len-Tags > 0 MOVE 1 TO WS-Tag-Ptr PERFORM UNTIL WS-Tag-Ptr > Len-Tags MOVE SPACES TO WS-One-Tag MOVE 0 TO WS-One-Len UNSTRING Cust-Tags (1:Len-Tags) DELIMITED BY "|" INTO WS-One-Tag COUNT IN WS-One-Len WITH POINTER WS-Tag-Ptr END-UNSTRING IF WS-One-Len = 0 ADD 1 TO WS-Empty-Tags ELSE ADD 1 TO WS-Tag-Count STRING "[" WS-One-Tag (1:WS-One-Len) "]" DELIMITED BY SIZE INTO WS-Tag-List WITH POINTER WS-List-Ptr END-STRING END-IF END-PERFORM END-IF IF WS-Tag-Count = 0 MOVE "(none)" TO WS-Tag-List END-IF. Show-Accepted. ADD 1 TO WS-Accepted DISPLAY "LINE " WS-Line-Ed " OK " WS-Label " TAGS=" WS-Tag-Count " " FUNCTION TRIM (WS-Tag-List TRAILING) IF Label-Cut MOVE WS-Label-Ptr TO WS-Ptr-Ed DISPLAY " NOTE: LABEL CUT AT 32 CHARACTERS, POINTER = " WS-Ptr-Ed END-IF IF WS-Naive NOT = WS-Proper DISPLAY " NOTE: DELIMITED BY SPACE WOULD GIVE [" FUNCTION TRIM (WS-Naive TRAILING) "]" END-IF IF Trailing-Comma DISPLAY " NOTE: TRAILING COMMA, TAGS FIELD IS EMPTY" END-IF IF WS-Empty-Tags > 0 DISPLAY " NOTE: " WS-Empty-Tags " EMPTY TAG(S) SKIPPED" END-IF. Show-Totals. DISPLAY "----" MOVE WS-Line-No TO WS-Total-Ed DISPLAY "LINES READ " WS-Total-Ed MOVE WS-Accepted TO WS-Total-Ed DISPLAY "ACCEPTED " WS-Total-Ed MOVE WS-Rejected TO WS-Total-Ed DISPLAY "REJECTED " WS-Total-Ed MOVE WS-Blank TO WS-Total-Ed DISPLAY "BLANK " WS-Total-Ed.