Setting Switches in Micro Focus COBOL using C - cobol

I have C program that calls COBOL. I want to set the switches before the COBOL program is called. This is normally done using the COBSW environment variable.
When I set COBSW in the C program, it is as tho it is ignored.
When I set COBSW before the program is called, it is detected fine.
How can I get the COBSW set in C and have COBOL recognize it?
Here are somethings I tried:
I removed cobinit() and the program still runs. This indicates to me that the cobinit is somehow automatic when the C program starts and it will only pickup COBSW set in sh.
I added cobrescanenv() to the program.
Moved cobinit() before the cobputenv().
Here is the sh script that runs the test:
export C_INCLUDE_PATH=$COBDIR/include
PATH=$COBDIR/bin:$PATH
gcc -o callcobol.o -c -g -Wall -Wno-unused-variable -fPIC -Ibuild -Isrc callcobol.c
/opt/microfocus/VisualCOBOL/bin/cob -o callcobol -g callcobol.o -L/usr/local/lib -ldl -lrt -lpthread
cob -z cobsw.cbl -o TESTSW.so
unset COBSW
echo "Test ONE, COBSW not set:"
echo "We want the output to be:"
echo "SW0=ON sw1=ON sw2=ON sw3=ON sw4=ON sw5=ON sw6=OFF sw7=ON "
echo "Getting:"
./callcobol
# Output:
# value of COBSW is: +0+1+2+3+4+5-6+7
echo ""
echo ""
export COBSW=+1+2 # This should be ignore because we are setting COBSW in the c program.
echo "Test TWO, COBSW set to ${COBSW}, but should be overlaid by putenv() in C:"
echo "We want the output to be:"
echo "SW0=ON sw1=ON sw2=ON sw3=ON sw4=ON sw5=ON sw6=OFF sw7=ON "
echo "Getting:"
./callcobol
Here is callcobol.c:
#include <stdlib.h>
#include <stdio.h>
#include "cobcall.h"
#include "cobmain.h"
#include "cobenv.h"
PFR cobgetfuncaddr(int type, const cobchar_t *name);
int cobinit (void);
int main(int argc, char *argv[])
{
cobchar_t *prog = (cobchar_t *) "TESTSW";
//char *cobswval;
const char *cobswname = "COBSW";
cobputenv( (cobchar_t *) "COBSW=+0+1+2+3+4+5-6+7"); // out dummy computed SWITCH values for the program
//cobswval = getenv( cobswname);
//fprintf(stdout,"value of COBSW is: %s\n", cobswval);
cobinit(); /* Initialize COBOL environment */
cobrescanenv();
PFR cobprog;
if ((cobprog = cobgetfuncaddr(0, prog)) == NULL)
{
fprintf(stderr,"ERROR: could not find cobol module %s\n", (char *) prog);
}
else
{
/* Loaded */
(*cobprog)(); /* Call it! */
}
cobtidy(); /* Close down COBOL environment */
return(0); // return a return code of zero
}
Here is cobsw.cbl:
$SET CONFIRM
$SET IBMCOMP
$SET CHARSET"EBCDIC"
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTSW.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
SWITCH-0 IS SW0 ON IS SW_0_ON
SWITCH-1 IS SW1 ON IS SW_1_ON
UPSI-2 ON IS SW_2_ON
UPSI-3 ON IS SW_3_ON
UPSI-4 ON IS SW_4_ON
UPSI-5 ON IS SW_5_ON
UPSI-6 ON IS SW_6_ON
UPSI-7 ON IS SW_7_ON.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 rec-cnt pic 9(11) value zero.
01 sw-out.
02 filler pic x(4) value "SW0=".
02 SW0-status pic x(3).
02 filler pic x(5) value " sw1=".
02 SW1-status pic x(3).
02 filler pic x(5) value " sw2=".
02 SW2-status pic x(3).
02 filler pic x(5) value " sw3=".
02 SW3-status pic x(3).
02 filler pic x(5) value " sw4=".
02 SW4-status pic x(3).
02 filler pic x(5) value " sw5=".
02 SW5-status pic x(3).
02 filler pic x(5) value " sw6=".
02 SW6-status pic x(3).
02 filler pic x(5) value " sw7=".
02 SW7-status pic x(3).
01 acc-data pic x(80) value spaces.
LINKAGE SECTION.
PROCEDURE DIVISION.
MAIN-PARAGRAPH.
move "OFF" to SW0-status SW1-status SW2-status
SW3-status SW4-status SW5-status
SW6-status SW7-status.
IF SW_0_ON move "ON " to SW0-status.
IF SW_1_ON move "ON " to SW1-status.
IF SW_2_ON move "ON " to SW2-status.
IF SW_3_ON move "ON " to SW3-status.
IF SW_4_ON move "ON " to SW4-status.
IF SW_5_ON move "ON " to SW5-status.
IF SW_6_ON move "ON " to SW6-status.
IF SW_7_ON move "ON " to SW7-status.
display sw-out.
EXIT PROGRAM.
END PROGRAM TESTSW.
Here is the script output:
Test ONE, COBSW not set:
We want the output to be:
SW0=ON sw1=ON sw2=ON sw3=ON sw4=ON sw5=ON sw6=OFF sw7=ON
Getting:
SW0=OFF sw1=OFF sw2=OFF sw3=OFF sw4=OFF sw5=OFF sw6=OFF sw7=OFF
Test TWO, COBSW set to +1+2, but should be overlaid by putenv() in C:
We want the output to be:
SW0=ON sw1=ON sw2=ON sw3=ON sw4=ON sw5=ON sw6=OFF sw7=ON
Getting:
SW0=OFF sw1=ON sw2=ON sw3=OFF sw4=OFF sw5=OFF sw6=OFF sw7=OFF

The COBOL runtime switches are read once from the environment variable COBSW or the command line during process initialization.
So unfortunately setting COBSW will not work because the runtime has already
read COBSW.
All is not lost because you can use the X"91" function 11 API from COBOL to set the switches.

Related

Getting SOC4 Abend in a cobol file program

I am writing COBOL pgm to sum 2 numbers, passing these 2 numbers from JCL in an input file and storing their sum in output file. But I am getting SOC4 (at MOVE). Below is my code. Please advise
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FILEIN ASSIGN TO INPFILE
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-ST1.
SELECT FILEOUT ASSIGN TO OUTFILE
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-ST2.
DATA DIVISION.
FILE SECTION.
FD FILEIN.
01 FIN-REC.
05 FIN-NUM1 PIC 9(2).
05 FILLER PIC X(1).
05 FIN-NUM2 PIC 9(2).
05 FILLER PIC X(75).
FD FILEOUT.
01 FOUT-TOT PIC 9(2).
01 FILLER PIC X(78).
WORKING-STORAGE SECTION.
01 WS-REC.
05 WS-NUM1 PIC 9(2).
05 WS-NUM2 PIC 9(2).
01 WS-ST1 PIC X(2) VALUE SPACES.
01 WS-ST2 PIC X(2) VALUE SPACES.
01 WS-EOF PIC X(1) VALUE SPACE.
01 WS-SUM PIC 9(2).
PROCEDURE DIVISION.
MAIN-PARA.
PERFORM 100-INITIAL-PARA THRU 100-EXIT.
PERFORM 200-PROCESS-PARA THRU 200-EXIT
UNTIL WS-EOF='Y'.
PERFORM 300-COMPUTE-PARA THRU 300-EXIT.
PERFORM 400-WRITE-PARA THRU 400-EXIT.
STOP RUN.
100-INITIAL-PARA.
MOVE 'N' TO WS-EOF
OPEN INPUT FILEIN
IF WS-ST1 NOT = '00'
DISPLAY 'ERROR IN 100-INITIAL-PARA'
DISPLAY 'INPUT FILE OPEN STATUS IS' WS-ST1
DISPLAY 'OUTPUT FILE OPEN STATUS IS' WS-ST2
END-IF.
100-EXIT.
EXIT.
200-PROCESS-PARA.
PERFORM UNTIL WS-EOF='Y'
READ FILEIN INTO WS-REC
AT END MOVE 'Y' TO WS-EOF
NOT AT END DISPLAY WS-REC
END-READ
END-PERFORM
CLOSE FILEIN.
200-EXIT.
EXIT.
300-COMPUTE-PARA.
COMPUTE WS-SUM= WS-NUM1 + WS-NUM2.
300-EXIT.
EXIT.
400-WRITE-PARA.
OPEN OUTPUT FILEOUT.
MOVE WS-SUM TO FOUT-TOT.
*> SOC4 abend in MOVE above
WRITE FOUT-TOT
END-WRITE.
CLOSE FILEOUT.
400-EXIT.
EXIT.
Below is the run JCL
//A102153J JOB MSGCLASS=S,MSGLEVEL=(1,1),NOTIFY=&SYSUID,REGION=0M
//STEP001 EXEC PGM=EXER4
//STEPLIB DD DISP=SHR,DSN=ADESH.LOADLIB
//INPFILE DD DSN=ADESH.EXER4.INFILE,DISP=SHR
//OUTFILE DD DSN=ADESH.EXER4.OUTFILE,UNIT=SYSDA,
// DISP=(NEW,CATLG,DELETE),SPACE=(CYL,(1,1),RLSE),
// DCB=(RECFM=FB,LRECL=80,BLKSIZE=0)
//SYSOUT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
Problem could be the output declaration:
FD FILEOUT.
01 FOUT-TOT PIC 9(2).
01 FILLER PIC X(78).
Replace with
FD FILEOUT.
01 out-record.
03 FOUT-TOT PIC 9(2).
03 FILLER PIC X(78).
Also update the write to
Write out-record.
Reason for the problem is the 2 01 levels --> VB which is different to the FB definition in the JCL which will cause the open to fail
There are a couple of logic errors in you program.
Firstly, in
100-INITIAL-PARA.
MOVE 'N' TO WS-EOF
OPEN INPUT FILEIN
IF WS-ST1 NOT = '00'
DISPLAY 'ERROR IN 100-INITIAL-PARA'
DISPLAY 'INPUT FILE OPEN STATUS IS' WS-ST1
DISPLAY 'OUTPUT FILE OPEN STATUS IS' WS-ST2
END-IF.
You open the input file, only, but check (well display) the status of the output file, which is yet to be opened.
Secondly, in the main paragraph
MAIN-PARA.
...
PERFORM 200-PROCESS-PARA THRU 200-EXIT
UNTIL WS-EOF='Y'.
you code a repetitive loop to end at end of input. And the called section
200-PROCESS-PARA.
PERFORM UNTIL WS-EOF='Y'
READ FILEIN INTO WS-REC
AT END MOVE 'Y' TO WS-EOF
NOT AT END DISPLAY WS-REC
END-READ
END-PERFORM
CLOSE FILEIN.
200-EXIT.
EXIT.
is again a repetitive loop to end at end of input file. There is one loop to many here.
Thirdly, in the section to write the output, you open the output file but are missing to check the status thereafter.
400-WRITE-PARA.
OPEN OUTPUT FILEOUT.
MOVE WS-SUM TO FOUT-TOT.
WRITE FOUT-TOT
END-WRITE.
CLOSE FILEOUT.
400-EXIT.
EXIT.
Lastly, the sum of two two digit numbers may well become a three digit number. You sum fields are declared as 2 digit field, however.

Getting "mismatched input '>' expecting {<EOF>, IDENTIFICATION, REPLACE}" when trying to run COBOL code

COMPLETE NOOB here just trying to learn some COBOL. I'm following a YT video and the code I have written verbatim just won't run because of this error. Do I need to install another extension?
>>SOURCE FORMAT FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. coboltut.
AUTHOR. John Doe.
DATE-WRITTEN. November 24th 2021
ENVIRONMENT DIVISION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 UserName PIC X(30) VALUE "You".
01 Num1 PIC 9 VALUE ZEROS.
01 Num2 PIC 9 VALUE ZEROS.
01 Total PIC 99 VALUE 0.
01 SSNum.
02 SSArea PIC 999
03 SSGroup PIC 99
03 SSSerial PIC 9999
PROCEDURE DIVISION.
DISPLAY "WHAT IS YOUR NAME " WITH NO ADVANCING
ACCEPT UserName
DISPLAY "Hello " USERNAME
STOP RUN.
Try this:
$ cat coboltut.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. coboltut.
AUTHOR. John Doe.
DATE-WRITTEN. November 24th 2021
ENVIRONMENT DIVISION.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 UserName PIC X(30) VALUE "You".
01 Num1 PIC 9 VALUE ZEROS.
01 Num2 PIC 9 VALUE ZEROS.
01 Total PIC 99 VALUE ZEROS.
01 SSNum.
03 SSArea PIC 999.
03 SSGroup PIC 99.
03 SSSerial PIC 9999.
PROCEDURE DIVISION.
DISPLAY "WHAT IS YOUR NAME " WITH NO ADVANCING
ACCEPT UserName
DISPLAY "Hello " USERNAME
STOP RUN.
Execution:
$ cobc -F -x coboltut.cbl
$ ./coboltut
WHAT IS YOUR NAME Halley
Hello Halley

I want to print triangle of " * " on middle of the screen using cobol?? how do i do it?

IDENTIFICATION DIVISION.
PROGRAM-ID. 11.
WORKING-STORAGE SECTION.
01 NUM1 PIC X(010) VALUE "*".
01 NUM2 PIC S9(001) VALUE +2 COMP.
PROCEDURE DIVISION.
PERFORM TRI 6 TIMES
STOP RUN.
TRI.
DISPLAY NUM1
ADD +2 TO NUM2
MOVE "*" TO NUM1(NUM2:6).
COBOL code to print triangle of asterisks in the middle of the screen is given below.
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO-WORLD.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-OUT PIC X(80) VALUE SPACES.
01 WS-N PIC 9(2) VALUE 0.
01 WS-CENTER PIC 9(2) VALUE 40.
PROCEDURE DIVISION.
PERFORM VARYING WS-N FROM 1 BY 2 UNTIL WS-N > 20
MOVE ALL '*' TO WS-OUT(WS-CENTER:WS-N)
COMPUTE WS-CENTER = WS-CENTER - 1
DISPLAY WS-OUT
END-PERFORM.
STOP RUN.
Output:
*
***
*****
*******
*********
***********
*************
***************
*****************
*******************
Run it here
Thanks to Rick Smith for the suggestions.

Is it possible to dynamically specify the file name at runtime in a COBOL program?

Is it possible to dynamically specify the file name at runtime in a COBOL program?
For example I would like to not have to define the name of a file I would like to open when I write the File-Control section, I would like to read the name of the file I want to open from a different file containing names and I would also like to define(FD) the file I want to open when I pass the name to File-COntrol.
The platform is Unix with Micro Focus Visual Cobol compiler.
I really love it when people ask for help posting a snippet of code that doesn't have a prayer of compiling.
IDENTIFICATION DIVISION.
PROGRAM-ID. STACK-OVERFLOW-1.
AUTHOR. Roland Hughes.
DATE-WRITTEN. TODAY.
DATE-COMPILED. TODAY.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OPTIONAL OUT_FILE
ASSIGN TO DISK
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS IN-STAT.
DATA DIVISION.
FILE SECTION.
FD OUT_FILE
IS GLOBAL
VALUE OF FILE-ID IS OUT_FILE_NAME
LABEL RECORDS ARE STANDARD.
01 DTL-LINE.
03 FIELDA PIC X(14).
03 FIELDB PIC X(10).
03 FIELDC PIC X(32).
03 FIELDD PIC X(03).
03 FIELDE PIC X(02).
WORKING-STORAGE SECTION.
01 STATUS-VARIABLES.
05 IN-STAT PIC X(2).
01 STUFF.
05 OUT_FILE_NAME PIC X(80).
PROCEDURE DIVISION.
MOVE "FILE1.DAT" to OUT_FILE_NAME.
OPEN OUTPUT OUT_FILE.
MOVE SPACES TO DTL-LINE.
MOVE 'HELLO!' TO FIELDA.
WRITE DTL-LINE.
CLOSE OUT_FILE
MOVE "FILE2.DAT" to OUT_FILE_NAME.
OPEN OUTPUT OUT_FILE.
MOVE SPACES TO DTL-LINE.
MOVE 'HI!' TO FIELDB.
WRITE DTL-LINE.
CLOSE OUT_FILE.
MOVE "FILE3.DAT" to OUT_FILE_NAME.
OPEN OUTPUT OUT_FILE.
MOVE SPACES TO DTL-LINE.
MOVE 'FRED' TO FIELDC.
WRITE DTL-LINE.
CLOSE OUT_FILE.
STOP RUN.
I tested this on KDE Neon with all of the latest updates installed. I installed the open-cobol package from the repositories.
cobc -x -free STACK-OVERFLOW-1.COB
./STACK-OVERFLOW-1
roland#roland-HP-EliteDesk-800-G2-SFF:~/COBOL$ ls *.DAT
FILE1.DAT FILE2.DAT FILE3.DAT
roland#roland-HP-EliteDesk-800-G2-SFF:~/COBOL$ cat *.DAT
HELLO! HI! FRED roland#roland-HP-EliteDesk-800-G2-SFF:~/COBOL$
A more complete example:
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN_FILE ASSIGN TO IN_FILE
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS FSTAT.
FILE SECTION.
FD IN_FILE
VALUE OF ID IS IN_FILE_NAME.
01 IN_POST.
03 FIELDA PIC X(14).
03 FIELDB PIC X(10).
03 FIELDC PIC X(32).
03 FIELDD PIC X(03).
03 FIELDE PIC X(02).
WORKING-STORAGE SECTION.
01 IN_FILE_NAME PIC X(22).
01 FSTAT PIC XX.
PROCEDURE DIVISION.
MOVE "FILE1.DAT" to IN_FILE_NAME
OPEN INPUT IN_FILE
CLOSE IN_FILE
MOVE "FILE2.DAT" to IN_FILE_NAME
OPEN INPUT IN_FILE
CLOSE IN_FILE
MOVE "FILE3.DAT" to IN_FILE_NAME
OPEN INPUT IN_FILE
CLOSE IN_FILE
STOP RUN.

Read and jump first line and anothers lines in file

How I can read a .dat file with struct like that: ( A = ALPHANUMERIC && N = NUMERIC )
0AAAAAAAANNNN (233 BLANK SPACES ) 999999 ( SEQUENTIAL NUMBER ONE BY ONE )
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
1NNNNNNNNNNNNAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
2AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (194 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
9 (245 BLANK SPACES) 999999 (SEQUENTIAL NUMBER ONE BY ONE)
So, I know, how I can make a program to read this in C/C++ or in C#, but, I try to make in Cobol, just for study....
But, I don't know what the command I need to use to open the file with this style ( I just know the:
ORGANIZATION IS LINE SEQUENTIAL.
I think, exist a another command to open with custon instructions... i don't know...
So, btw, how I can open the file and read the informations ??
( i just need to read the line 1 on time, and, I need to read the line 2 and 3 always paried ... 4 and 5 && 6 and 7 && 8 and 9 ... )
and, I whant to show that information with DISPLAY ( just for study )
Thanks :)
Something like this below your FD:
01 INPUT-RECORD.
05 IR-RECORD-TYPE PIC X.
88 INPUT-RECORD-IS-HEADER VALUE '0'.
88 INPUT-RECORD-IS-DATA1 VALUE '1'.
88 INPUT-RECORD-IS-DATA2 VALUE '2'.
88 INPUT-RECORD-IS-TRAILER VALUE '9'.
05 FILLER PIC X(whatever).
You may need a "trailing" byte for a record-delimiter, I don't know, and you'll have to sort out the lengths, as they seem to vary.
These in Working-Storage:
01 INPUT-RECORD-HEADER.
05 IRH-RECORD-TYPE PIC X.
05 IRH-ITEM1 PIC X(8).
05 IRH-ITEM2 PIC 9(4).
05 FILLER PIC X(233).
05 IRH-SEQUENCE PIC X(6)
01 INPUT-RECORD-DATA1.
05 IRD1-RECORD-TYPE PIC X.
05 IRD1-ITEM1 PIC 9(14).
05 IRD1-ITEM1 PIC X(19).
05 FILLER PIC X(194).
05 IRD1-SEQUENCE PIC X(6)
01 INPUT-RECORD-DATA2.
05 IRD2-RECORD-TYPE PIC X.
05 IRD2-ITEM1 PIC X(33).
05 FILLER PIC X(194).
05 IRD2-SEQUENCE PIC X(6)
01 INPUT-RECORD-TRAILER.
05 IRT-RECORD-TYPE PIC X.
05 FILLER PIC X(245).
05 IRT-SEQUENCE PIC X(6).
You have to read each record, one at a time. Identify it. Put it in the correct W-S definition. When you read a "2" you can process the "1" you have stored along with the "2".
My datanames aren't very good, as I don't know what your data is. Also I have not "formatted" the definitions, which will make them more readable when you do it.
For OpenCOBOL, here is a sample standard in/standard out filter program:
>>SOURCE FORMAT IS FIXED
*> ***************************************************************
*><* ===========
*><* filter
*><* ===========
*><* :Author: Brian Tiffin
*><* :Date: 20090207
*><* :Purpose: Standard IO filters
*><* :Tectonics: cobc -x filter.cob
*> ***************************************************************
identification division.
program-id. filter.
environment division.
configuration section.
input-output section.
file-control.
select standard-input assign to keyboard.
select standard-output assign to display.
data division.
file section.
fd standard-input.
01 stdin-record pic x(32768).
fd standard-output.
01 stdout-record pic x(32768).
working-storage section.
01 file-status pic x value space.
88 end-of-file value high-value
when set to false is low-value.
*> ***************************************************************
procedure division.
main section.
00-main.
perform 01-open
perform 01-read
perform
until end-of-file
perform 01-transform
perform 01-write
perform 01-read
end-perform
.
00-leave.
perform 01-close
.
goback.
*> end main
support section.
01-open.
open input standard-input
open output standard-output
.
01-read.
read standard-input
at end set end-of-file to true
end-read
.
*> All changes here
01-transform.
move stdin-record to stdout-record
.
*>
01-write.
write stdout-record end-write
.
01-close.
close standard-input
close standard-output
.
end program filter.
*><*
*><* Last Update: dd-Mmm-yyyy
and here is a demonstration of using LINAGE that just happens to read in a text file.
*****************************************************************
* Example of LINAGE File Descriptor
* Author: Brian Tiffin
* Date: 10-July-2008
* Tectonics: $ cocb -x linage-demo.cob
* $ ./linage-demo <filename ["linage-demo.cob"]>
* $ cat -n mini-report
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. linage-demo.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
select optional data-file assign to file-name
organization is line sequential
file status is data-file-status.
select mini-report assign to "mini-report".
DATA DIVISION.
FILE SECTION.
FD data-file.
01 data-record.
88 endofdata value high-values.
02 data-line pic x(80).
FD mini-report
linage is 16 lines
with footing at 15
lines at top 2
lines at bottom 2.
01 report-line pic x(80).
WORKING-STORAGE SECTION.
01 command-arguments pic x(1024).
01 file-name pic x(160).
01 data-file-status pic 99.
01 lc pic 99.
01 report-line-blank.
02 filler pic x(18) value all "*".
02 filler pic x(05) value spaces.
02 filler pic x(34)
VALUE "THIS PAGE INTENTIONALLY LEFT BLANK".
02 filler pic x(05) value spaces.
02 filler pic x(18) value all "*".
01 report-line-data.
02 body-tag pic 9(6).
02 line-3 pic x(74).
01 report-line-header.
02 filler pic x(6) VALUE "PAGE: ".
02 page-no pic 9999.
02 filler pic x(24).
02 filler pic x(5) VALUE " LC: ".
02 header-tag pic 9(6).
02 filler pic x(23).
02 filler pic x(6) VALUE "DATE: ".
02 page-date pic x(6).
01 page-count pic 9999.
PROCEDURE DIVISION.
accept command-arguments from command-line end-accept.
string
command-arguments delimited by space
into file-name
end-string.
if file-name equal spaces
move "linage-demo.cob" to file-name
end-if.
open input data-file.
read data-file
at end
display
"File: " function trim(file-name) " open error"
end-display
go to early-exit
end-read.
open output mini-report.
write report-line
from report-line-blank
end-write.
move 1 to page-count.
accept page-date from date end-accept.
move page-count to page-no.
write report-line
from report-line-header
after advancing page
end-write.
perform readwrite-loop until endofdata.
display
"Normal termination, file name: "
function trim(file-name)
" ending status: "
data-file-status
end-display.
close mini-report.
* Goto considered harmful? Bah! :)
early-exit.
close data-file.
exit program.
stop run.
****************************************************************
readwrite-loop.
move data-record to report-line-data
move linage-counter to body-tag
write report-line from report-line-data
end-of-page
add 1 to page-count end-add
move page-count to page-no
move linage-counter to header-tag
write report-line from report-line-header
after advancing page
end-write
end-write
read data-file
at end set endofdata to true
end-read
.
*****************************************************************
* Commentary
* LINAGE is set at a 20 line logical page
* 16 body lines
* 2 top lines
* A footer line at 15 (inside the body count)
* 2 bottom lines
* Build with:
* $ cobc -x -Wall -Wtruncate linage-demo.cob
* Evaluate with:
* $ ./linage-demo
* This will read in linage-demo.cob and produce mini-report
* $ cat -n mini-report
*****************************************************************
END PROGRAM linage-demo.
With those samples, along with Gilbert's answer, you should have enough to tackle your problem, with the caveat that these examples are shy on proper error handling, so be careful is this is homework or a paid assignment. For an example of standard input/output or by filename depending on command line arguments (or lack thereof), see the ocdoc.cob program in the OpenCOBOL FAQ.
Offtopic: Output of an ocdoc pass over ocdoc.cob itself can be seen at http://opencobol.add1tocobol.com/ocdoc.html (Why mention it? The COBOL lexicon highlighter for Pygments has just been accepted into main. Any Pygments pulled after version 1.6 will allow for COBOL (context free) lexical highlighting.)
You write an ordinary Cobol program that reads a file.
The first byte (character) of the record is either 0, 1, 2, or 9.
Define a Working-Storage area (01 level) for each of the 4 record types. Then, after you read the record, you move it from the input area to the appropriate Working-Storage area for the record.
Then you process the record how you wish from one of the 4 Working-Storage areas.

Resources