Preprocessing with gixsql adds uncompilable gnucobol code - preprocessor

I recently started using gixsql for a project I am working on.
https://github.com/mridoni/gix/blob/main/doc/gixsql.md
I followed the examples in the readme, but when compiling with GnuCobol the sample TEST001.cbsql is not working:
TEST001.cbsql: in paragraph 'GIXSQL-CI-P-TEST001-EMPTBL':
TEST001.cbsql:394: error: syntax error, unexpected Identifier
TEST001.cbsql: in paragraph '100-EXIT':
TEST001.cbsql:383: error: 'GIX-SKIP-CRSR-INIT' is not defined
If I remove this generated code then the program compiles, although it removes an important section from the program and does not work properly. Just wondering what I might be doing wrong? I am following the example using GnuCobol to compile the preprocessed cobol to connect to a PostGres database.
cobc -x TEST001.cbsql -L /opt/gixsql/lib -lgixsql
Here is the generated section that is causing the compile issue:
GIXSQL*
GIXSQL* ESQL CURSOR DECLARATIONS (START)
GIXSQL GO TO GIX-SKIP-CRSR-INIT.
GIXSQL GIXSQL-CI-P-TEST001-EMPTBL.
GIXSQL CALL STATIC "GIXSQLCursorDeclare" USING
GIXSQL BY REFERENCE SQLCA
GIXSQL BY REFERENCE x"00"
GIXSQL BY VALUE 0
GIXSQL BY REFERENCE "TEST001_EMPTBL" & x"00"
GIXSQL BY VALUE 0
GIXSQL BY REFERENCE SQ0001
GIXSQL BY VALUE 0
GIXSQL END-CALL
GIXSQL GIX-SKIP-CRSR-INIT.
GIXSQL*
GIXSQL* ESQL CURSOR DECLARATIONS (END)
Original cbl file is from the gixsql examples
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST001.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AT.
OBJECT-COMPUTER. IBM-AT.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
EXEC SQL
INCLUDE EMPREC
END-EXEC.
01 DBNAME PIC X(64).
01 DBAUTH PIC X(64).
01 T1 PIC 9(3) VALUE 0.
01 DISP-RATE PIC 9(15).
01 DISP-COM PIC 9(3).
01 DISP-CODE PIC 9(8).
01 FAKE-CHAR PIC X.
01 ANSS PIC X.
01 COM-NULL-IND PIC S9(4) COMP.
01 VARC PIC X(20).
01 VARD PIC X(20).
EXEC SQL
INCLUDE SQLCA
END-EXEC.
* declare cursor for select
EXEC SQL
DECLARE EMPTBL CURSOR FOR
SELECT
ENO,
LNAME,
FNAME,
STREET,
CITY,
ST,
ZIP,
DEPT,
PAYRATE,
COM,
MISCDATA
FROM EMPTABLE
ORDER BY LNAME
END-EXEC
PROCEDURE DIVISION.
000-CONNECT.
DISPLAY "DBNAME" UPON ENVIRONMENT-NAME.
ACCEPT DBNAME FROM ENVIRONMENT-VALUE.
DISPLAY "DBAUTH" UPON ENVIRONMENT-NAME.
ACCEPT DBAUTH FROM ENVIRONMENT-VALUE.
* DISPLAY '***************************************'.
* DISPLAY " DB : " DBNAME.
* DISPLAY " USER: " DBAUTH.
* DISPLAY '***************************************'.
EXEC SQL
CONNECT TO :DBNAME USER :DBAUTH
END-EXEC.
IF SQLCODE <> 0 THEN
DISPLAY 'SQLCODE. ' SQLCODE
DISPLAY 'SQLERRM. ' SQLERRM
GO TO 100-EXIT
END-IF.
100-MAIN.
EXEC SQL
START TRANSACTION
END-EXEC.
* open cursor
EXEC SQL
OPEN EMPTBL
END-EXEC
MOVE SQLCODE TO DISP-CODE
DISPLAY 'open ' DISP-CODE.
DISPLAY 'open ' SQLERRM.
* fetch a data item
EXEC SQL
FETCH EMPTBL INTO
:ENO,:LNAME,:FNAME,:STREET,:CITY,
:ST,:ZIP,:DEPT,:PAYRATE,
:COM,:MISCDATA
END-EXEC.
100-test.
MOVE SQLCODE TO DISP-CODE
DISPLAY 'fetch ' DISP-CODE
* loop until no more data
PERFORM UNTIL SQLCODE < 0 OR SQLCODE = 100
* display the record
MOVE PAYRATE TO DISP-RATE
MOVE COM TO DISP-COM
DISPLAY 'employee #: [' ENO ']'
DISPLAY 'last name : [' LNAME ']'
DISPLAY 'first name: [' FNAME ']'
DISPLAY 'street : [' STREET ']'
DISPLAY 'city : [' CITY ']'
DISPLAY 'state : [' ST ']'
DISPLAY 'zip code : [' ZIP ']'
DISPLAY 'department: [' DEPT ']'
DISPLAY 'payrate : [' PAYRATE ']'
DISPLAY 'commission: [' COM ']'
DISPLAY 'misc : [' MISCDATA-TEXT ']'
DISPLAY 'misc (len): [' MISCDATA-LEN ']'
IF COM-NULL-IND < 0
DISPLAY 'commission is null'
ELSE
DISPLAY 'commission ' DISP-COM
END-IF
* DISPLAY 'Do you want to see the next record? (y/n)'
* ACCEPT ANSS
* IF ANSS = 'Y' OR 'y'
EXEC SQL
FETCH EMPTBL INTO
:ENO,:LNAME,:FNAME,:STREET,:CITY,
:ST,:ZIP,:DEPT,:PAYRATE,
:COM,:MISCDATA
END-EXEC
* ELSE
* GO TO CLOSE-LOOP
* END-IF
MOVE SQLCODE TO DISP-CODE
DISPLAY 'fetch ' DISP-CODE
DISPLAY 'fetch ' SQLCODE
END-PERFORM
DISPLAY 'All records in this table have been selected'.
CLOSE-LOOP.
* close the cursor
EXEC SQL
CLOSE EMPTBL
END-EXEC.
100-EXIT.
STOP RUN.

With our Enterprise COBOL compiler I would expect a message along the lines of "A PERIOD WAS REQUIRED" - before starting a new section you have to end the previous sentence with a period ..
So try adding a period before GIX-SKIP-CRSR-INIT.:
GIXSQL GIXSQL-CI-P-TEST001-EMPTBL.
GIXSQL CALL STATIC "GIXSQLCursorDeclare" USING
GIXSQL BY REFERENCE SQLCA
GIXSQL BY REFERENCE x"00"
GIXSQL BY VALUE 0
GIXSQL BY REFERENCE "TEST001_EMPTBL" & x"00"
GIXSQL BY VALUE 0
GIXSQL BY REFERENCE SQ0001
GIXSQL BY VALUE 0
GIXSQL END-CALL
.
GIXSQL GIX-SKIP-CRSR-INIT.
But don't ask me why it isn't generated by your tool...

Related

invalid level number 'EXEC' error in OpenCOBOL

this is my code Here :
******************************************************************
* Open Cobol ESQL (Ocesql) Sample Program
*
* FETCHTBL --- demonstrates CONNECT, SELECT COUNT(*),
* DECLARE cursor, FETCH cursor, COMMIT,
* ROLLBACK, DISCONNECT
*
* Copyright 2013 Tokyo System House Co., Ltd.
******************************************************************
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. FETCHTBL.
******************************************************************
DATA DIVISION.
******************************************************************
WORKING-STORAGE SECTION.
01 D-EMP-REC.
05 D-EMP-NO PIC 9(04).
05 FILLER PIC X.
05 D-EMP-NAME PIC X(20).
05 FILLER PIC X.
05 D-EMP-SALARY PIC --,--9.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
01 DBNAME PIC X(30) VALUE SPACE.
01 USERNAME PIC X(30) VALUE SPACE.
01 PASSWD PIC X(10) VALUE SPACE.
01 EMP-REC-VARS.
05 EMP-NO PIC S9(04).
05 EMP-NAME PIC X(20) .
05 EMP-SALARY PIC S9(04).
01 EMP-CNT PIC 9(04).
EXEC SQL END DECLARE SECTION END-EXEC.
EXEC SQL INCLUDE SQLCA END-EXEC.
******************************************************************
PROCEDURE DIVISION.
******************************************************************
MAIN-RTN.
DISPLAY "*** FETCHTBL STARTED ***".
* WHENEVER IS NOT YET SUPPORTED :(
* EXEC SQL WHENEVER SQLERROR PERFORM ERROR-RTN END-EXEC.
* CONNECT
MOVE "testdb" TO DBNAME.
MOVE "postgres" TO USERNAME.
MOVE SPACE TO PASSWD.
EXEC SQL
CONNECT :USERNAME IDENTIFIED BY :PASSWD USING :DBNAME
END-EXEC.
IF SQLCODE NOT = ZERO PERFORM ERROR-RTN STOP RUN.
* SELECT COUNT(*) INTO HOST-VARIABLE
EXEC SQL
SELECT COUNT(*) INTO :EMP-CNT FROM EMP
END-EXEC.
DISPLAY "TOTAL RECORD: " EMP-CNT.
* DECLARE CURSOR
EXEC SQL
DECLARE C1 CURSOR FOR
SELECT EMP_NO, EMP_NAME, EMP_SALARY
FROM EMP
ORDER BY EMP_NO
END-EXEC.
EXEC SQL
OPEN C1
END-EXEC.
* FETCH
DISPLAY "---- -------------------- ------".
DISPLAY "NO NAME SALARY".
DISPLAY "---- -------------------- ------".
EXEC SQL
FETCH C1 INTO :EMP-NO, :EMP-NAME, :EMP-SALARY
END-EXEC.
PERFORM UNTIL SQLCODE NOT = ZERO
MOVE EMP-NO TO D-EMP-NO
MOVE EMP-NAME TO D-EMP-NAME
MOVE EMP-SALARY TO D-EMP-SALARY
DISPLAY D-EMP-REC
EXEC SQL
FETCH C1 INTO :EMP-NO, :EMP-NAME, :EMP-SALARY
END-EXEC
END-PERFORM.
* CLOSE CURSOR
EXEC SQL
CLOSE C1
END-EXEC.
* COMMIT
EXEC SQL
COMMIT WORK
END-EXEC.
* DISCONNECT
EXEC SQL
DISCONNECT ALL
END-EXEC.
* END
DISPLAY "*** FETCHTBL FINISHED ***".
STOP RUN.
******************************************************************
ERROR-RTN.
******************************************************************
DISPLAY "*** SQL ERROR ***".
DISPLAY "SQLCODE: " SQLCODE " " NO ADVANCING.
EVALUATE SQLCODE
WHEN +10
DISPLAY "Record not found"
WHEN -01
DISPLAY "Connection falied"
WHEN -20
DISPLAY "Internal error"
WHEN -30
DISPLAY "PostgreSQL error"
DISPLAY "ERRCODE: " SQLSTATE
DISPLAY SQLERRMC
*> TO RESTART TRANSACTION, DO ROLLBACK.
EXEC SQL
ROLLBACK
END-EXEC
WHEN OTHER
DISPLAY "Undefined error"
DISPLAY "ERRCODE: " SQLSTATE
DISPLAY SQLERRMC
END-EVALUATE.
******************************************************************
This is not "pure COBOL", but COBOL with embedded SQL, which in most cases needs a precompiler.
As-is there is a word EXEC where in COBOL a level-number would be expected, therefore the message from your compiler is correct.
In order to compile this source with your COBOL compiler, use an EXEC SQL precompiler to convert the SQL statements into COBOL for you first, most likely the one that the sample program references: ocesql - Open-COBOL-ESQL (PostgreSQL only).
As an alterative you can also use other preparsers (likely with some adjustments, especially for the CONNECT); here's an incomplete list:
esqlOC - ESQL for GnuCOBOL/OpenCobol (also works with other compilers, uses ODBC under the hood)
Gix ESQL, a recent addition, currently only as part of the Gix-IDE (GnuCOBOL only, currently uses a general ODBC or direct binding to PostgreSQL or MySql)
... and some proprietary variants (only to access their products)
Oracle Pro*COBOL
IBM DB2 precompiler
...

Does add only work for fields in WORKING-STORAGE SECTION.?

It seems a program like this does not work.
PROGRAM-ID. Test.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CountFile ASSIGN TO "count.dat"
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD CountFile.
01 CountDetails.
02 FCountA PIC 99 VALUE 0.
02 FCountB PIC 99 VALUE 0.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
Begin.
OPEN OUTPUT CountFile
ADD 1 TO FCountA
ADD 1 TO FCountB
WRITE CountDetails
CLOSE CountFile
STOP RUN.
This writes 9999 to the count.dat file. ADD works for fields in the WORKING-STORAGE SECTION but not in the FILE SECTION.
Is that true ?
Q: Is that true?
A: No, it isn't.
ADD works for any numeric field, no matter where it is stored.
Note that data in FILE SECTION is only guaranteed to be available at all after a successful OPEN (as you've mentioned GnuCOBOL: this one always provides the storage). It does not have any guaranteed value, so you likely want to INITIALIZE the data.
Sample COBOL sample that shows both and can be adjusted and executed:
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO-WORLD.
ENVIRONMENT DIVISION.
input-output section.
file-control.
select test-file
assign to 'test-file'
organization is line sequential.
data division.
file section.
fd test-file.
01 num-var pic 9 value 0.
working-storage section.
01 num2-var pic 9 value 0.
PROCEDURE DIVISION.
ADD 1 TO num-var num2-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
INITIALIZE num-var num2-var
ADD 1 TO num-var num2-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
ADD num2-var to num-var
ADD num2-var to num-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
ADD num-var to num-var
DISPLAY 'Hello, num ' num2-var ' and file ' num-var.
STOP RUN.
Beware: it is fixed-form reference-format, not necessarily portable, the missing OPEN can mean it aborts - and it isn't any reasonable good style - but demonstrate the issue.

Cobol, Code 65 File Locked

I am trying to access the same file to do two certain tasks. The first task is to update, add, and delete records. Access has to be random. The second task is to display all records on console. Access has to be sequential. I receive code 65 File locked from COBOL because the program is trying to access the same file twice the same time. Is there any way to fix this error? Or is there an different way to do this? Or do I have to write a separate program to display the record on console? I am stuck!
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-5\SALES.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY M-SALESPERSON-NUM.
SELECT MAST2-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-5\SALES.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS SEQUENTIAL
RECORD KEY M2-SALESPERSON-NUM.
DATA DIVISION.
FILE SECTION.
FD MAST-FILE
LABEL RECORDS ARE STANDARD.
01 MAST-RECORD.
05 M-SALESPERSON-NUM PIC XXX.
05 M-CUSTOMER-NAME PIC X(15).
05 M-TOTAL-SALES PIC 9(5)V99.
05 M-COST-OF-SALES PIC 9(4)V99.
FD MAST2-FILE
LABEL RECORDS ARE STANDARD.
01 MAST2-RECORD.
05 M2-SALESPERSON-NUM PIC X(3).
05 M2-SALESPERSON-NAME PIC X(15).
05 M2-TOTAL-SALES PIC 9(5)V99.
05 M2-COST-OF-SALES PIC 9(4)V99.
WORKING-STORAGE SECTION.
01 SALES-DATA.
05 SALESPERSON-NUM PIC X(3).
05 SALESPERSON-NAME PIC X(15).
05 TOTAL-SALES PIC 9(5)V99.
05 COST-OF-SALES PIC 9(4)V99.
01 OUTPUT-RECORD.
05 PIC X(1) VALUE SPACES.
05 O-SALESPERSON-NUM PIC X(3).
05 PIC X(3) VALUE SPACES.
05 O-SALESPERSON-NAME PIC X(3).
05 PIC X(3) VALUE SPACES.
05 O-TOTAL-SALES PIC 9(5)V99.
05 PIC X(3) VALUE SPACES.
05 O-COST-OF-SALES PIC 9(4)V99.
01 PROGRAM-DATA-ITEMS.
05 I-SALESPERSON-NUM PIC XXX.
05 WAIT-OK PIC X.
05 CHOICE PIC 9 VALUE 0.
05 READ-OK PIC X.
05 REWRITE-OK PIC X.
05 DELETE-OK PIC X.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN I-O MAST-FILE
OPEN INPUT MAST2-FILE
PERFORM 20-PROCESS-LOOP
CLOSE MAST-FILE
MAST2-FILE
STOP RUN.
20-PROCESS-LOOP.
PERFORM UNTIL CHOICE = 5
PERFORM 30-DISPLAY-MENU
EVALUATE CHOICE
WHEN 1
PERFORM 40-UPD-SALES
WHEN 2
PERFORM 90-ADD-SALES
WHEN 3
PERFORM 110-DELETE-SALES
WHEN 4
PERFORM 120-DISPLAY-SALES
END-EVALUATE
END-PERFORM.
30-DISPLAY-MENU.
DISPLAY 'SALES MAINTENANCE SYSTEM'
DISPLAY ' '
DISPLAY ' SELECT ONE:'
DISPLAY ' '
DISPLAY ' 1. UPDATE SALES RECORD'
DISPLAY ' 2. ADD SALES RECORD'
DISPLAY ' 3. DELETE SALES RECORD'
DISPLAY ' 4. DISPLAY SALES RECORD'
DISPLAY ' 5. QUIT'
DISPLAY ' '
DISPLAY 'ENTER CHOICE (1 - 5): ' WITH NO ADVANCING
ACCEPT CHOICE
PERFORM UNTIL CHOICE >= 1 AND <= 5
DISPLAY ' '
DISPLAY 'ERROR: ENTER CHOICE (1 - 5): ' WITH NO ADVANCING
ACCEPT CHOICE
END-PERFORM.
40-UPD-SALES.
DISPLAY 'UPDATE SALES: ENTER SALESPERSON NUMBER: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NUM
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
PERFORM 50-READ-RECORD
IF READ-OK = 'N'
DISPLAY 'RECORD DOES NOT EXIST - PRESS ENTER'
ACCEPT WAIT-OK
ELSE
DISPLAY SALES-DATA
PERFORM 100-INPUT-NEW-RECORD
PERFORM 60-REWRITE-RECORD
END-IF.
50-READ-RECORD.
MOVE 'Y' TO READ-OK
READ MAST-FILE INTO SALES-DATA
INVALID KEY
MOVE 'N' TO READ-OK
END-READ.
60-REWRITE-RECORD.
REWRITE MAST-RECORD FROM SALES-DATA
INVALID KEY
DISPLAY 'REWRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-REWRITE.
70-WRITE-RECORD.
MOVE 'Y' TO REWRITE-OK
WRITE MAST-RECORD FROM SALES-DATA
INVALID KEY
MOVE 'N' TO REWRITE-OK
END-WRITE
IF REWRITE-OK = 'N'
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF.
80-DELETE-RECORD.
MOVE 'Y' TO DELETE-OK
DELETE MAST-FILE
INVALID KEY
MOVE 'N' TO DELETE-OK
END-DELETE
IF REWRITE-OK = 'N'
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF.
90-ADD-SALES.
DISPLAY 'ADD SALES RECORD: ENTER SALESPERSON NUMBER: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NUM
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
PERFORM 50-READ-RECORD
IF READ-OK = 'Y'
DISPLAY 'RECORD ALREADY EXISTS - PRESS ENTER'
ACCEPT WAIT-OK
ELSE
PERFORM 100-INPUT-NEW-RECORD
PERFORM 70-WRITE-RECORD
IF REWRITE-OK = 'Y'
DISPLAY 'RECORD ' SALESPERSON-NUM ' ADDED TO FILE'
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF
END-IF.
100-INPUT-NEW-RECORD.
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
DISPLAY ' ENTER SALESPERSON NAME: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NAME
DISPLAY ' ENTER TOTAL SALES: ' WITH NO ADVANCING
ACCEPT TOTAL-SALES
DISPLAY ' ENTER COST OF SALES: ' WITH NO ADVANCING
ACCEPT COST-OF-SALES.
110-DELETE-SALES.
DISPLAY 'DELETE SALES RECORD: ENTER SALESPERSON NUMBER: ' WITH NO ADVANCING
ACCEPT SALESPERSON-NUM
MOVE SALESPERSON-NUM TO M-SALESPERSON-NUM
PERFORM 50-READ-RECORD
IF READ-OK = 'N'
DISPLAY 'RECORD DOES NOT EXIST - PRESS ENTER'
ACCEPT WAIT-OK
ELSE
PERFORM 80-DELETE-RECORD
IF DELETE-OK = 'Y'
DISPLAY 'RECORD DELETED - PRESS ENTER'
ACCEPT WAIT-OK
END-IF
END-IF.
120-DISPLAY-SALES.
MOVE SALESPERSON-NUM TO M2-SALESPERSON-NUM
MOVE SALESPERSON-NAME TO M2-SALESPERSON-NAME
MOVE TOTAL-SALES TO M2-TOTAL-SALES
MOVE COST-OF-SALES TO M2-COST-OF-SALES
READ MAST2-FILE
AT END MOVE HIGH-VALUES TO M2-SALESPERSON-NUM
END-READ
PERFORM UNTIL M2-SALESPERSON-NUM = HIGH-VALUES
MOVE M2-SALESPERSON-NUM TO O-SALESPERSON-NUM
MOVE M2-SALESPERSON-NAME TO O-SALESPERSON-NAME
MOVE M2-TOTAL-SALES TO O-TOTAL-SALES
MOVE M2-COST-OF-SALES TO O-COST-OF-SALES
DISPLAY OUTPUT-RECORD
READ MAST2-FILE
AT END MOVE HIGH-VALUES TO M2-SALESPERSON-NUM
END-READ
END-PERFORM.
end program Program1.
When you open a file I-O, that means you open it for Input and Output. Get rid of your second file.
To position your file for displaying the data, you can READ with a KEY and then READ ... NEXT ..., or you can use START ... and then READ ... NEXT.
Always use the FILE STATUS in the ASSIGN. Then use the file-status field you tell COBOL to put the file status in to, to check the previous IO. Use it for end-of-file (value of "10"). Use 88s. You don't then need the INVALID KEY and AT END and all the END- statements associated with IO can go, because you then don't have a built-in condition with the IO. Which will simplify things.
Your structure is very good for a beginner. Refreshing to see no PERFORM ... THRU ....
I'd suggest you try the effect of a single full-stop/period in column 12 on a line of its own. You'll then be able to move the last line of code from a paragraph without having to think about the full-stop/period attached to it (because it isn't attached to it).
Use more PERFORMs. OPEN and CLOSE are not vital to the logic of the program. Hide them away in paragraphs, do the FILE STATUS checking on them. Same with the READ/WRITE/DELETE and any other IO statements you end up with. Hide them in well-named procedures which you PERFORM.
Consider the size (number of lines) of some of your IFs. Put the code in a well-named procedure, and the code can be "read" at a high level by a human, with the detail only being looked at if needed.
Do not, do not, do not, mess around with two files. Do not, do not, do not OPEN the same file twice (I've written a few COBOL programs in my time, and I've never, ever, considered that a reasonable way to achieve anything, let alone the simple task you have).
You may want to consider DYNAMIC instead of RANDOM (this is what it is for). You use RANDOM if you are only doing random access. You actually want to do sequential access as well (look for references to skip-sequential access for further discussion).
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-5\SALES.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOMREWRITE-OK = 'N'
RECORD KEY M-SALESPERSON-NUM
FILE STATUS IS W-MAST-FILE-STATUS.
...
01 W-MAST-FILE-STATUS PIC XX.
88 W-MAST-FILE-LAST-IO-OK VALUE "00".
88 W-MAST-FILE-EOF VALUE "10".
88 W-MAST-FILE-REC-NOT-FOUND VALUE "23".
88 W-MAST-FILE-OR-OR-NOT-FOUND VALUE "00" "23".
...
50-READ-RECORD.
MOVE 'Y' TO READ-OK
READ MAST-FILE INTO SALES-DATA
INVALID KEY
MOVE 'N' TO READ-OK
END-READ.
Becomes:
50-READ-RECORD.
READ MAST-FILE KEY key-name INTO SALES-DATA
IF NOT ( W-MAST-FILE-OR-OR-NOT-FOUND )
some code to deal with the pickle, which is nothing to do with
business-logic, so hide it away
END-IF
.
80-DELETE-RECORD.
MOVE 'Y' TO DELETE-OK
DELETE MAST-FILE
INVALID KEY
MOVE 'N' TO DELETE-OK
END-DELETE
IF REWRITE-OK = 'N'
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF.
Becomes:
80-DELETE-RECORD.
DELETE MAST-FILE
IF NOT W-MAST-FILE-LAST-IO-OK
DISPLAY 'WRITE ERROR: SALESPERSON NUMBER ' SALESPERSON-NUM
DISPLAY 'PRESS ENTER TO CONTINUE'
ACCEPT WAIT-OK
END-IF
.
Each IO paragraph becomes self-contained, self-verifying, and the FILE STATUS field naturally bears only good conditions when you are in your business logic. The "can't happen" (but will, one day) you deal with in these paragraphs.
You code elsewhere simplifies. Your number of "flags" is reduced (the value of the FILE STATUS field replaces the need for the flags) your IOs have no conditional part, so don't need the END- scope delimiter.
A tip about numbering paragraphs. Don't do it until you have tested sufficiently that you are happy with the structure of the logic. Once you are happy with that, rearrange the paragraphs so that the paragraph is always physically after the PERFORM of it. Then put the numbers on. The physical layout of your code then represents the structure of your program logic.
If you number first, you'll end up with the situation you have - you have numbers, but they infer nothing. It is much more tedious to "renumber" paragraphs than it is to add paragraph numbers where there were none (use the power of the editor/utilities available to you to do this numbering).

Extract records by first letter of name

I am trying to make the program below to pull out records that have customer names beginning with letter the "M" and write the records to a temporary file. The program runs but it won't write records to the output file. I debugged the code, and it seems like the code line "WRITE MAST2-RECORD" never runs. It skips this line of code.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAST-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-1\OVERDUE.IND.TXT'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS M-ACCT-NUM.
SELECT MAST2-FILE ASSIGN TO 'G:\CPSC315-COBOL\COBOLAssignments\P15-1\OVERDUE2.IND.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD MAST-FILE
LABEL RECORDS ARE STANDARD.
01 MAST-RECORD.
05 M-ACCT-NUM PIC X(4).
05 M-CUSTOMER-NAME PIC X(15).
05 M-DAYS-OVERDUE PIC 99.
05 M-BALANCE-DUE PIC 999V99.
FD MAST2-FILE
LABEL RECORDS ARE STANDARD.
01 MAST2-RECORD PIC X(50).
WORKING-STORAGE SECTION.
01 COUNTER PIC 9.
01 PROGRAM-DATA-ITEMS.
05 WRITE-OK PIC X VALUE 'Y'.
PROCEDURE DIVISION.
10-MAINLINE.
OPEN OUTPUT MAST-FILE
OUTPUT MAST2-FILE
PERFORM 20-LOAD-MAST-FILE
CLOSE MAST-FILE
MAST2-FILE
STOP RUN.
20-LOAD-MAST-FILE.
PERFORM 30-INPUT-INDEX
PERFORM UNTIL M-ACCT-NUM = 0 OR WRITE-OK = 'N'
PERFORM 40-WRITE-FILE
PERFORM 50-FIND-CUSTOMER-START-WITH-M
PERFORM 30-INPUT-INDEX
END-PERFORM.
30-INPUT-INDEX.
DISPLAY 'ENTER ACCOUNT NUMBER (0 TO QUIT): ' WITH NO ADVANCING
ACCEPT M-ACCT-NUM.
40-WRITE-FILE.
DISPLAY ' ENTER CUSTOMER NAME: ' WITH NO ADVANCING
ACCEPT M-CUSTOMER-NAME
DISPLAY ' ENTER DAYS OVERDUE: ' WITH NO ADVANCING
ACCEPT M-DAYS-OVERDUE
DISPLAY ' ENTER BALANCE DUE: ' WITH NO ADVANCING
ACCEPT M-BALANCE-DUE
WRITE MAST-RECORD
INVALID KEY
MOVE 'N' TO WRITE-OK
DISPLAY 'ERROR ' MAST-RECORD
END-WRITE.
50-FIND-CUSTOMER-START-WITH-M.
MOVE 0 TO COUNTER
INSPECT MAST-RECORD TALLYING COUNTER FOR ALL ' M '
IF COUNTER > 0
WRITE MAST2-RECORD
END-IF.
end program Program1.
You are looking for blank-M-blank, across the entire record.
What you say you want to do is fine customer-names which begin with M.
05 M-CUSTOMER-NAME.
10 M-CUSTOMER-NAME-FIST-CHARACTER PIC X.
88 M-CUSTOMER-NAME-START-M VALUE "M".
If you use that definition in place of what you have, and use the 88 in the test for your write, you should get what you want.
Eg replace:
50-FIND-CUSTOMER-START-WITH-M.
MOVE 0 TO COUNTER
INSPECT MAST-RECORD TALLYING COUNTER FOR ALL ' M '
IF COUNTER > 0
WRITE MAST2-RECORD
END-IF.
By:
50-FIND-CUSTOMER-START-WITH-M.
IF M-CUSTOMER-NAME-START-M
WRITE MAST2-RECORD
END-IF
.
Simpler, easier to understand, so easier to maintain.
You should consider the possible "validity" of your names. In a good system, there will be no leading blanks. In a poor system there may be.
To deal with that, test the first byte of the customer-name for being space as well, if so, test the customer-name for entirely space. If not entirely space, loop until you find the first non-blank. Test that first non-blank for M. So in this case you have two tests.
You can assess the quality of your data separately by copying and cutting-down this program and reporting/outputting where the first byte of the customer-name is blank.
Once you know that, you go to the analyst (tutor) and ask if you need to deal with possible leading blanks. If you don't, keep the test for blank in your actual program, and crash in that case :-)

Standard way to remove spaces from input in cobol?

I'm just learning COBOL; I'm writing a program that simply echos back user input. I have defined a variable as:
User-Input PIC X(30).
Later when I ACCEPT User-Input, then DISPLAY User-Input " plus some extra text", it has a bunch of spaces to fill the 30 characters. Is there a standard way (like Ruby's str.strip!) to remove the extra spaces?
One would hope for a more elegant way of simply trimming text strings
but this is pretty much the standard solution... The trimming part
is done in the SHOW-TEXT paragraph.
*************************************
* TRIM A STRING... THE HARD WAY...
*************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTX.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 USER-INPUT PIC X(30).
01 I PIC S9(4) BINARY.
PROCEDURE DIVISION.
MOVE SPACES TO USER-INPUT
PERFORM SHOW-TEXT
MOVE ' A B C' TO USER-INPUT
PERFORM SHOW-TEXT
MOVE 'USE ALL 30 CHARACTERS -------X' TO USER-INPUT
PERFORM SHOW-TEXT
GOBACK
.
SHOW-TEXT.
PERFORM VARYING I FROM LENGTH OF USER-INPUT BY -1
UNTIL I LESS THAN 1 OR USER-INPUT(I:1) NOT = ' '
END-PERFORM
IF I > ZERO
DISPLAY USER-INPUT(1:I) '# OTHER STUFF'
ELSE
DISPLAY '# OTHER STUFF'
END-IF
.
Produces the following output:
# OTHER STUFF
A B C# OTHER STUFF
USE ALL 30 CHARACTERS -------X# OTHER STUFF
Note that the PERFORM VARYING statement relies on the left to
right evaluation of the UNTIL clause to avoid out-of-bounds
subscripting on USER-INPUT in the case where it contains only
blank spaces.
Use OpenCOBOL 1.1 or greater.
Identification division.
Program-id. 'trimtest'.
*> Compile:
*> cobc -x -free -ffunctions-all TrimTest.cbl
*>
Data division.
Working-Storage Section.
1 myBigStr Pic X(32768) Value Spaces.
Procedure Division.
Display "Enter Something? " With no advancing.
Accept myBigStr.
Display "[" Trim(myBigStr) "]".
Goback.
The trim function also has the options; Leading or Trailing.
cobc -h formore info.
Here's a solution if you work on OpenVMS:
01 WS-STRING-LENGTH PIC S9(04) COMP.
CALL "STR$TRIM" USING BY DESCRIPTOR user_output,
user_input,
BY REFERENCE WS-STRING-LENGTH.
a more general solution:
01 length pic 99.
perform varying length from 1 by 1
until length > 30 or user-input[length] = space
end-perform.
if length > 30
display user-input 'plus some extra text'
else
display user-input[1:length] 'plus some extra text'
end-if.
untested, I don't have a compiler at hand at the moment
There are three ways you can do this.
Use the COBOL functions to determine the string's "length". This is a mix of a couple functions. This is my preferred method, but requires declaring extra variables.
Write your own function to get the "length".
Use knowledge of a "terminating" string. You have to know what key characters indicates an end-of-string, like three spaces or a low-value character.
This example code demonstrates all three.
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTPROG.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ONE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 ONE-A-TLY PIC 9(02) VALUE ZERO.
01 ONE-A-LEN PIC 9(02) VALUE ZERO.
01 ONE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 ONE-B-TLY PIC 9(02) VALUE ZERO.
01 ONE-B-LEN PIC 9(02) VALUE ZERO.
01 TWO-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 TWO-A-LEN PIC 9(02) VALUE ZERO.
01 TWO-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 TWO-B-LEN PIC 9(02) VALUE ZERO.
01 THREE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 THREE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 THREE-C PIC X(80) VALUE SPACES.
PROCEDURE DIVISION.
DISPLAY ' -- METHOD ONE -- '
INSPECT FUNCTION REVERSE(ONE-A)
TALLYING ONE-A-TLY FOR LEADING SPACES.
SUBTRACT ONE-A-TLY FROM LENGTH OF ONE-A GIVING ONE-A-LEN.
INSPECT FUNCTION REVERSE(ONE-B)
TALLYING ONE-B-TLY FOR LEADING SPACES.
SUBTRACT ONE-B-TLY FROM LENGTH OF ONE-A GIVING ONE-B-LEN.
DISPLAY ONE-A(1:ONE-A-LEN)
' ' ONE-B(1:ONE-B-LEN)
'.'.
DISPLAY ' -- METHOD TWO -- '
PERFORM VARYING TWO-A-LEN FROM LENGTH OF TWO-A BY -1
UNTIL TWO-A-LEN < 1 OR TWO-A(TWO-A-LEN:1) > SPACE
END-PERFORM.
PERFORM VARYING TWO-B-LEN FROM LENGTH OF TWO-B BY -1
UNTIL TWO-B-LEN < 1 OR TWO-B(TWO-B-LEN:1) > SPACE
END-PERFORM.
DISPLAY TWO-A(1:TWO-A-LEN)
' ' TWO-B(1:TWO-B-LEN)
'.'.
DISPLAY ' -- METHOD THREE, NAIVE -- '
* DELIMITING BY JUST ANY SPACES ISN'T GOOD ENOUGH.
STRING THREE-A DELIMITED BY SPACES
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY SPACES
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
DISPLAY ' -- METHOD THREE, OK -- '
STRING THREE-A DELIMITED BY ' '
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY ' '
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
EXIT-PROG.
STOP RUN.
and the output looks like this:
-- METHOD ONE --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD TWO --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD THREE, NAIVE --
RALPH LIKES.
-- METHOD THREE, OK --
RALPH WIGGAM LIKES LEARNDING.

Resources