>>SOURCE FORMAT IS FREE *> cobol-inspect.cob - clean a fixed-width order *> export in place with INSPECT REPLACING and INSPECT CONVERTING: zero-fill *> a right-justified quantity, normalise date separators, build an *> upper-case match key, lower-case only the domain of an e-mail address, *> mask the address for printing, neutralise "|" in a free-text note and *> upper-case a voucher code between square brackets *> Dialect: GnuCOBOL 3.x, free format *> Status : desk-checked against the GnuCOBOL 3.2 release source *> (libcob/strings.c, cobc/parser.y, cobc/typeck.c) and the *> Programmer's Guide; compiled and run with GnuCOBOL 3.2 on *> 2026-10-29 *> Input : datasets/cobol-inspect-replacing-converting.dat, LINE *> SEQUENTIAL, 100 bytes per record (code/...converting.cpy) *> Output : two to four lines per cleaned record and one per rejected *> record on standard output, then totals *> Return : 0 if every record was cleaned, 4 if any was rejected, *> 12 if the file will not open or a read fails *> Build : cobc -x -I code code/cobol-inspect.cob *> Run : ./cobol-inspect (from the site folder) IDENTIFICATION DIVISION. PROGRAM-ID. ORDER-CLEAN. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT Order-File ASSIGN TO "datasets/cobol-inspect-replacing-converting.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Order-Status. DATA DIVISION. FILE SECTION. FD Order-File. COPY "cobol-inspect-replacing-converting.cpy". WORKING-STORAGE SECTION. 01 WS-Order-Status PIC XX. 88 Order-Ok VALUE "00". 88 Order-Eof VALUE "10". *> The alphabet in both cases, written once and used in both directions. *> The same character must not appear twice in a "from" string (IBM). 01 WS-Lower PIC X(26) VALUE "abcdefghijklmnopqrstuvwxyz". 01 WS-Upper PIC X(26) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". *> The match key: lower case to upper case, and four punctuation marks *> to spaces. Both strings are 30 characters; the last four characters *> of WS-Key-To are spaces, written out so the sizes visibly agree. 01 WS-Key-From PIC X(30) VALUE "abcdefghijklmnopqrstuvwxyz'.-,". 01 WS-Key-To PIC X(30) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ ". 01 WS-Key PIC X(20). 01 WS-Mask PIC X(36). 01 WS-Ats PIC 9(3). 01 WS-Bars PIC 9(3). 01 WS-Bars-Ed PIC Z9. 01 WS-Reason PIC X(32). 01 WS-Bad PIC X(36). 01 WS-Bad-Len PIC 9(3). 01 WS-Rec-Ed PIC ZZ9. 01 WS-Counts. 05 WS-Read PIC 9(3) VALUE 0. 05 WS-Clean PIC 9(3) VALUE 0. 05 WS-Rejected PIC 9(3) VALUE 0. 01 WS-Count-Ed PIC ZZ9. PROCEDURE DIVISION. Main. OPEN INPUT Order-File IF NOT Order-Ok DISPLAY "CANNOT OPEN THE ORDER FILE, STATUS " WS-Order-Status MOVE 12 TO RETURN-CODE STOP RUN END-IF PERFORM Read-Order PERFORM UNTIL Order-Eof ADD 1 TO WS-Read PERFORM Clean-Order PERFORM Read-Order END-PERFORM CLOSE Order-File PERFORM Show-Totals IF WS-Rejected > 0 MOVE 4 TO RETURN-CODE ELSE MOVE 0 TO RETURN-CODE END-IF STOP RUN. Read-Order. READ Order-File AT END CONTINUE END-READ IF NOT Order-Ok AND NOT Order-Eof DISPLAY "READ FAILED, STATUS " WS-Order-Status MOVE 12 TO RETURN-CODE STOP RUN END-IF. *> Each step either cleans its field in place or sets WS-Reason; the *> first step that fails stops the record. Clean-Order. MOVE SPACES TO WS-Reason PERFORM Clean-Qty IF WS-Reason = SPACES PERFORM Clean-Date END-IF IF WS-Reason = SPACES PERFORM Clean-Email END-IF IF WS-Reason = SPACES PERFORM Clean-Note PERFORM Build-Key PERFORM Show-Clean ADD 1 TO WS-Clean ELSE PERFORM Show-Reject ADD 1 TO WS-Rejected END-IF. *> A right-justified quantity: " 12" becomes "0012". LEADING stops at *> the first character that is not a space, so "15 " is left alone and *> fails the NUMERIC test. A blank field is caught first, because *> LEADING SPACES BY ZEROS would turn it into "0000", a valid number. Clean-Qty. MOVE Ord-Qty TO WS-Bad MOVE 4 TO WS-Bad-Len IF Ord-Qty = SPACES MOVE "QUANTITY IS BLANK" TO WS-Reason ELSE INSPECT Ord-Qty REPLACING LEADING SPACES BY ZEROS IF Ord-Qty IS NOT NUMERIC MOVE Ord-Qty TO WS-Bad MOVE "QUANTITY IS NOT A NUMBER" TO WS-Reason END-IF END-IF. *> Slashes and dots become hyphens, one character for one character. *> CONVERTING cannot move characters, so a day-first date stays day-first *> and fails the shape test. Clean-Date. INSPECT Ord-Date CONVERTING "/." TO "--" IF Ord-Date (1:4) IS NOT NUMERIC OR Ord-Date (5:1) NOT = "-" OR Ord-Date (6:2) IS NOT NUMERIC OR Ord-Date (8:1) NOT = "-" OR Ord-Date (9:2) IS NOT NUMERIC MOVE Ord-Date TO WS-Bad MOVE 10 TO WS-Bad-Len MOVE "DATE IS NOT YYYY-MM-DD" TO WS-Reason END-IF. *> The domain of an address is not case sensitive and the local part may *> be (RFC 5321), so only the characters after the @ are lower-cased. *> The @ is counted first: with no @, AFTER INITIAL "@" would convert *> nothing and say nothing. Clean-Email. MOVE Ord-Email TO WS-Bad MOVE 0 TO WS-Bad-Len INSPECT Ord-Email TALLYING WS-Bad-Len FOR CHARACTERS BEFORE INITIAL SPACE IF WS-Bad-Len = 0 MOVE 1 TO WS-Bad-Len END-IF MOVE 0 TO WS-Ats INSPECT Ord-Email TALLYING WS-Ats FOR ALL "@" EVALUATE TRUE WHEN WS-Ats = 0 MOVE "E-MAIL HAS NO @" TO WS-Reason WHEN WS-Ats > 1 MOVE "E-MAIL HAS MORE THAN ONE @" TO WS-Reason WHEN Ord-Email (1:1) = "@" MOVE "E-MAIL HAS NOTHING BEFORE THE @" TO WS-Reason WHEN OTHER INSPECT Ord-Email CONVERTING WS-Upper TO WS-Lower AFTER INITIAL "@" MOVE Ord-Email TO WS-Mask INSPECT WS-Mask (2:) REPLACING CHARACTERS BY "*" BEFORE INITIAL "@" END-EVALUATE. *> The report separates fields with "|", so a bar typed into the note *> must not survive. TALLYING and REPLACING in one statement count the *> bars in the note as it was read, then replace them. A voucher code *> between square brackets is upper-cased, and nothing else in the note. Clean-Note. MOVE 0 TO WS-Bars INSPECT Ord-Note TALLYING WS-Bars FOR ALL "|" REPLACING ALL "|" BY "/" INSPECT Ord-Note CONVERTING WS-Lower TO WS-Upper AFTER INITIAL "[" BEFORE INITIAL "]". *> A key for matching names typed in different ways: one CONVERTING *> upper-cases the letters and turns ' . - and , into spaces. INSPECT *> never changes a field's length, so the spaces stay where they are. Build-Key. MOVE Ord-Name TO WS-Key INSPECT WS-Key CONVERTING WS-Key-From TO WS-Key-To. Show-Clean. MOVE WS-Read TO WS-Rec-Ed DISPLAY "REC " WS-Rec-Ed " " Ord-Id " OK " WS-Key " " Ord-Date " QTY " Ord-Qty DISPLAY " EMAIL " FUNCTION TRIM (Ord-Email TRAILING) DISPLAY " MASKED " FUNCTION TRIM (WS-Mask TRAILING) IF Ord-Note NOT = SPACES IF WS-Bars > 0 MOVE WS-Bars TO WS-Bars-Ed DISPLAY " NOTE " FUNCTION TRIM (Ord-Note TRAILING) " (BARS REPLACED:" WS-Bars-Ed ")" ELSE DISPLAY " NOTE " FUNCTION TRIM (Ord-Note TRAILING) END-IF END-IF. Show-Reject. MOVE WS-Read TO WS-Rec-Ed DISPLAY "REC " WS-Rec-Ed " " Ord-Id " REJECT " FUNCTION TRIM (WS-Reason TRAILING) " [" WS-Bad (1:WS-Bad-Len) "]". Show-Totals. DISPLAY "----" MOVE WS-Read TO WS-Count-Ed DISPLAY "RECORDS READ " WS-Count-Ed MOVE WS-Clean TO WS-Count-Ed DISPLAY "CLEANED " WS-Count-Ed MOVE WS-Rejected TO WS-Count-Ed DISPLAY "REJECTED " WS-Count-Ed.