Would like to ask how to remove specific values in different lengths out of a string.
I have this:
'{4:72:SELLS¬#:73:ABC¬#:PPF:TESTPPF¬#:74:BLA¬#:PPF:ABC¬#:74:BLA¬#-}'
( want to remove all ¬#:PPF: Tags with its content. In my example this should be removed:
¬#:PPF:TESTPPF
¬#:PPF:ABC )
And would like to have this:
'{4:72:SELLS¬#:73:ABC¬#:74:BLA¬#:74:BLA¬#-}'
I have this code:
01 TINP.
05 TINPFIELD PIC X(2000) VALUE
'{4:72:SELLS¬#:73:ABC¬#:PPF:TESTPPF¬#:74:BLA¬#:PPF:TESTPPF¬#:74:BLA¬#-}'.
01 WA-OUTPUT PIC X(2000) value spaces.
01 WA-TEMP PIC X(2500).
01 WP-MSG PIC 9(8) BINARY value zero.
01 WN-ROWCNT PIC S9(8) BINARY.
01 WN-ROWCNT2 PIC S9(8) BINARY.
01 WP-BEG PIC 9(8) BINARY.
01 WP-END PIC 9(8) BINARY.
01 WN-OUT-LEN PIC 9(8) BINARY value zero.
0000-TESTPROCESSING SECTION.
display TINPFIELD.
INSPECT TINPFIELD
TALLYING WN-Rowcnt FOR ALL "¬#".
MOVE 1 TO WP-MSG
PERFORM UNTIL WN-ROWCNT2 >= WN-ROWCNT
MOVE WP-MSG TO WP-BEG
display 'WP-BEG' WP-BEG
UNSTRING TINPFIELD
DELIMITED BY "¬#"
INTO WA-TEMP
POINTER WP-MSG
END-UNSTRING
MOVE WP-MSG TO WP-END
display 'WP-END' WP-END
if WA-OUTPUT = space
subtract 1 from wp-end
STRING TINPFIELD(WP-BEG:WP-END)
delimited by SIZE
INTO WA-OUTPUT
END-STRING
move wp-end to WN-OUT-LEN
else
STRING WA-OUTPUT(1:WN-OUT-LEN)
delimited by SIZE
TINPFIELD(WP-BEG:WP-END)
delimited by SIZE
'¬#'
delimited by SIZE
INTO WA-OUTPUT
END-STRING
end-if
move WP-END TO WN-OUT-LEN
display 'WN-OUT-LEN' WN-OUT-LEN
ADD 1 TO WN-ROWCNT2
END-Perform
.
EXIT.
//edit: The Input data is always the same. In the output (after my code runs) I have sometimes a "Tag" twice, sometimes only once and so on. Its not consistent at all. I suppose this is a code issue on my side.
The code was changed to reflect a change in the question.
This code splits the input into delimited segments copying each segment directly to the output using reference modification. If there is no text to be removed (no delimiter) it will copy all the input directly to the output.
There are performance implications with this method. Specifically, the move of each segment will cause space-filling in the output. The larger the number of segments the worse the performance.
I changed WA-OUTPUT to X(2000), since the output can never be larger than the input.
01 TINP.
05 TINPFIELD PIC X(2000) VALUE
'{4:72:SELLS¬#:73:ABC¬#:PPF:TESTPPF¬#:74:BLA' &
'¬#:PPF:TESTPPF¬#:74:BLA¬#-}'.
01 WA-OUTPUT PIC X(2000) value spaces.
01 segment-length binary pic 9(4).
01 additional-characters binary pic 9(4).
01 input-pointer binary pic 9(4).
01 output-pointer binary pic 9(4).
01 input-length binary pic 9(4).
01 output-length binary pic 9(4).
procedure division.
begin.
move 1 to input-pointer output-pointer
input-length output-length
inspect TINPFIELD tallying
input-length for characters before "}".
display input-length
display TINPFIELD
perform until input-pointer > function length(TINPFIELD)
unstring TINPFIELD delimited "¬#:PPF:"
into WA-OUTPUT (output-pointer:)
count in segment-length
with pointer input-pointer
add segment-length to output-pointer
if input-pointer <= function length(TINPFIELD)
move 0 to additional-characters
inspect TINPFIELD (input-pointer:) tallying
additional-characters for characters before "¬"
add additional-characters to input-pointer
end-if
end-perform
inspect WA-OUTPUT tallying
output-length for characters before "}".
display wa-output
display output-length
goback
.
Output:
0070
{4:72:SELLS¬#:73:ABC¬#:PPF:TESTPPF¬#:74:BLA¬#:PPF:TESTPPF¬#:74:BLA¬#-}
{4:72:SELLS¬#:73:ABC¬#:74:BLA¬#:74:BLA¬#-}
0042
This is a modification of the above that, while slightly more complicated, eliminates the performance penalty for space-filling when there is a larger number of segments. It is unusual because, while it uses the UNSTRING statement, it does not actually "unstring" anything.
01 TINP.
05 TINPFIELD PIC X(2000) VALUE
'{4:72:SELLS¬#:73:ABC¬#:PPF:TESTPPF¬#:74:BLA' &
'¬#:PPF:TESTPPF¬#:74:BLA¬#-}'.
01 WA-OUTPUT PIC X(2000) value spaces.
01 segment-length binary pic 9(4).
01 segment-holder pic x.
01 additional-characters binary pic 9(4).
01 input-pointer binary pic 9(4).
01 backup-pointer binary pic 9(4).
01 output-pointer binary pic 9(4).
01 input-length binary pic 9(4).
01 output-length binary pic 9(4).
procedure division.
begin.
move 1 to input-pointer output-pointer
input-length output-length
inspect TINPFIELD tallying
input-length for characters before "}".
display input-length
display TINPFIELD
perform until input-pointer > function length(TINPFIELD)
move input-pointer to backup-pointer
unstring TINPFIELD delimited "¬#:PPF:"
into segment-holder
count in segment-length
with pointer input-pointer
move TINPFIELD (backup-pointer:segment-length)
to WA-OUTPUT (output-pointer:segment-length)
add segment-length to output-pointer
if input-pointer <= function length(TINPFIELD)
move 0 to additional-characters
inspect TINPFIELD (input-pointer:) tallying
additional-characters for characters before "¬"
add additional-characters to input-pointer
end-if
end-perform
if output-pointer < function length (WA-OUTPUT)
move space to WA-OUTPUT (output-pointer:)
inspect WA-OUTPUT tallying
output-length for characters before "}".
display wa-output
display output-length
goback
.
The output is the same.
Related
I have a very simple COBOL code here that has a given input data and output data. The problem is that, it shows an error on line 60 which is the MOVE STUD-AGE TO AGE-OUT. and everytime I run OpenCOBOLIDE, I always get and error which is:
libcob: test.cob: 60: 'STUD-AGE' not numeric: ' '
WARNING - Implicit CLOSE of STUDENT-OUT ('C:\STUD-OUT.DAT')
WARNING - Implicit CLOSE of STUDENT-IN ('C:\STUD-IN.DAT')
And I don't know exactly what's wrong with it. Here is supposedly the input file I created:
----5---10---15---20---25---30---35---40--
00-123345 ALISON MARTIN WOLF 1912056
00-789012 KEN DENNIOS ROME 1914156
00-345678 JACK ADRIAN TOCKSIN 1622234
00-901234 EJHAYZ ALONEY 2045645
00-567890 CHARLES JOHN GUINNIVER 1813243
00-123457 JEAN MICHAEL YARTER 2034253
Here's the code to it:
IDENTIFICATION DIVISION.
PROGRAM-ID. SAMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STUDENT-IN ASSIGN TO "C:\STUD-IN.DAT".
SELECT STUDENT-OUT ASSIGN TO "C:\STUD-OUT.DAT".
DATA DIVISION.
FILE SECTION.
FD STUDENT-IN.
01 STUD-REC.
02 STUD-NO PIC X(10).
02 STUD-NAME PIC X(25).
02 STUD-AGE PIC 99.
02 STUD-ALLOWANCE PIC 999V99.
FD STUDENT-OUT.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 HDG-1.
02 FILLER PIC X(20) VALUE SPACES.
02 FILLER PIC X(22) VALUE "WILLOW PARK UNIVERSITY".
02 FILLER PIC X(14) VALUE " OF MADAGASCAR".
01 HDG-2.
02 FILLER PIC X(9) VALUE SPACES.
02 FILLER PIC X(14) VALUE "STUDENT NUMBER".
02 FILLER PIC X(8) VALUE SPACES.
02 FILLER PIC X(12) VALUE "STUDENT NAME".
02 FILLER PIC X(15) VALUE SPACES.
02 FILLER PIC X(3) VALUE "AGE".
02 FILLER PIC X(8) VALUE SPACES.
02 FILLER PIC X(9) VALUE "ALLOWANCE".
01 PRINT-LINE.
02 FILLER PIC X(9) VALUE SPACES.
02 SNO-OUT PIC X(10).
02 FILLER PIC X(12) VALUE SPACES.
02 SNAME-OUT PIC X(25).
02 FILLER PIC X(2) VALUE SPACE.
02 AGE-OUT PIC Z9.
02 FILLER PIC X(9) VALUE SPACES.
02 ALL-OUT PIC ZZZ.99.
01 E-O-F PIC XXX VALUE "NO".
PROCEDURE DIVISION.
OPEN INPUT STUDENT-IN
OUTPUT STUDENT-OUT.
WRITE PRINT-REC FROM HDG-1 BEFORE 1 LINE.
WRITE PRINT-REC FROM HDG-2 AFTER 2 LINES.
MOVE SPACES TO PRINT-REC.
WRITE PRINT-REC AFTER 1 LINE.
PERFORM READ-RTN UNTIL E-O-F = "YES".
PERFORM CLOSE-RTN.
READ-RTN.
READ STUDENT-IN AT END MOVE "YES" TO E-O-F.
MOVE STUD-NO TO SNO-OUT.
MOVE STUD-NAME TO SNAME-OUT.
MOVE STUD-AGE TO AGE-OUT.
MOVE STUD-ALLOWANCE TO ALL-OUT.
WRITE PRINT-REC FROM PRINT-LINE AFTER 1 LINE.
CLOSE-RTN.
CLOSE STUDENT-IN, STUDENT-OUT.
STOP RUN.
What I want to achieve is just to output the file correctly but the error only inputs the HDG-1 and then the rest blank.
To answer your question: COBOL accept numeric data however you define it.
So for "text data" (as long as it isn't UTF-16 or another multibyte encoded file) PIC 99 (which says "two digits in the default USAGE DISPLAY - so one byte per digit) is perfectly fine.
As with every other language: "never trust input data" is something I can recommend. For example: someone could run this program with a file that was saved with an UTF-8 encoded character in the name and then it "looks" right but the code has an unexpected shift in its data. For COBOL things like FUNCTION TEST-NUMVAL(inp) [ignores spaces and allows decimal-point] or IS NUMERIC (strict class test) can be useful.
Using data-check you could for example also skip empty lines or leading/trailing extra data (temporary rulers, headline, summary, ...).
For the actual problem:
It looks like you feed the program with a "common" text file, but you actually did not specify this so your COBOL implementation uses the default SEQUENTIAL. Because of the missing check of the input data you did not spot this directly.
To align expectations and code:
SELECT STUDENT-IN ASSIGN TO "C:\STUD-IN.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT STUDENT-OUT ASSIGN TO "C:\STUD-OUT.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
I have program that creates a CSV document. One field from a database table, Z-ZYSR-MONTAN(IZYSR), has the format NOT NULL NUMBER(11,2).
My code is :
05 H-ZYSR-MONTAN PIC S9(11)V9(2) COMP-3.
* Taux horaire formation
05 W-Z18 PIC -(12),99.
05 FILLER PIC X(001) VALUE ';'.
ALIM-WZ18 SECTION.
MOVE Z-ZYSR-NOMBRE TO IZYSR.
MOVE ZERO TO H-ZYSR-MONTAN.
IF Z-ZYSR-NOMBRE > ZERO
PERFORM VARYING IZYSR FROM Z-ZYSR-NOMBRE BY -1 UNTIL
IZYSR = ZERO
IF Z-ZYSR-CODRUB(IZYSR) = 'THF'
MOVE Z-ZYSR-MONTAN(IZYSR) TO
H-ZYSR-MONTAN
MOVE ZERO TO IZYSR
END-IF
END-PERFORM
IF H-ZYSR-MONTAN < 0
MOVE 0 TO W-Z18
END-IF
IF H-ZYSR-MONTAN >= 0
MOVE H-ZYSR-MONTAN TO W-Z18
END-IF
END-IF.
Results:
2223,55
-10,98
-1,08
82,61
But the problem I have in my CSV document is that there are spaces before the number. As may be seen in the picture in this forum :
https://www.developpez.net/forums/d1940330/autres-langages/autres-langages/cobol/numerique-condense-cobol/#post10895608
So my question how can I obtain the correct results without spaces before the number?
You could try to make a loop (PERFORM UNTIL), for every character, and if it is SPACE, then change it by 0.
You can use the TRIM() function to remove white space if you're using GnuCOBOL(OpenCOBOL) on Linux.
WORKING-STORAGE SECTION.
01.
05 H-ZYSR-MONTAN PIC S9(11)V9(2) COMP-3.
05 W-Z18 PIC -(12).99.
05 H-Z18-C REDEFINES W-Z18 PIC X(15).
05 H-ZYSR-DISPLAY PIC X(15).
PROCEDURE DIVISION.
0000-MAIN.
MOVE 1234.56 TO H-ZYSR-MONTAN.
move H-ZYSR-MONTAN to W-Z18.
MOVE FUNCTION TRIM(H-Z18-C) TO H-ZYSR-DISPLAY.
DISPLAY H-ZYSR-DISPLAY.
STOP RUN.
I did have to change the , to . to match my locale so remember to change it back.
And if you don't have access to that function there is a simple work around.
WORKING-STORAGE SECTION.
01.
05 H-ZYSR-MONTAN PIC S9(11)V9(2) COMP-3.
05 W-Z18 PIC -(12).99.
05 VAR-Z18 PIC X(15).
05 ws-counter pic 9(3) COMP-3 value 0.
01 VARIABLES.
05 VAR1 PIC X(10).
05 VAR2 PIC X(10).
05 VAR3 PIC X(10).
05 VAR4 PIC X(10).
05 VAR5 PIC X(10).
05 VAR6 PIC X(10).
05 VAR7 PIC X(10).
05 VAR8 PIC X(10).
01 WS-DELIMITED-TEXT PIC X(200).
PROCEDURE DIVISION.
0000-MAIN.
INITIALIZE VARIABLES
MOVE 'CEX18' TO VAR6
MOVE -1234.56 TO H-ZYSR-MONTAN
MOVE H-ZYSR-MONTAN TO W-Z18
INSPECT W-Z18 TALLYING WS-COUNTER FOR LEADING SPACES
IF WS-COUNTER > 0
COMPUTE WS-COUNTER = WS-COUNTER + 1
MOVE W-Z18(ws-counter:) TO VAR-Z18
ELSE
MOVE W-Z18 TO VAR-Z18
END-IF
String VAR1 delimited by SPACE
";" delimited by size
VAR2 delimited by SPACE
";" delimited by size
VAR3 delimited by SPACE
";" delimited by size
VAR4 delimited by SPACE
";" delimited by size
VAR5 delimited by SPACE
";" delimited by size
VAR6 delimited by SPACE
";" delimited by size
VAR-Z18 delimited by SPACE
";" delimited by size
VAR7 delimited by SPACE
";" delimited by size
VAR8 delimited by SPACE
";" delimited by size
into WS-DELIMITED-TEXT
DISPLAY WS-DELIMITED-TEXT.
GOBACK.
Using STRING to assemble the final text field was already suggested by the other forum I only include it here to round out the example.
Based on our conversation and other information, I changed the code a little bit. I removed all references to CSV, since that seems to occur outside the COBOL program. I replaced the STRING statement. The data-name for the group containing W-Z18 and the ; was not given in other references, so here I named it, W-Z18-FIELD. I placed the result in W-Z18-TEXT.
environment division.
configuration section.
special-names.
decimal-point is comma.
data division.
working-storage section.
1 w-z18-text pic x(16) value space.
1 w-z18-pointer comp pic 9(4) value 1.
1 w-z18-field.
* Taux horaire formation
3 w-z18 pic -(12),99.
3 pic x value ";".
1 leading-spaces comp pic 9(4) value 0.
1 move-length comp pic 9(4) value 0.
procedure division.
begin.
move -10,98 to w-z18
move 0 to leading-spaces
inspect w-z18 tallying
leading-spaces for leading space
compute move-length =
function length (w-z18 (leading-spaces + 1:))
move space to w-z18-text
move 1 to w-z18-pointer
move w-z18 (leading-spaces + 1:)
to w-z18-text (w-z18-pointer:move-length)
compute w-z18-pointer = w-z18-pointer + move-length
move ";" to w-z18-text (w-z18-pointer:1)
add 1 to w-z18-pointer
display quote w-z18-field quote
display quote w-z18-text quote
stop run
.
Result: (the quotes were added to show the change)
" -10,98;" - what it looked like before, w-z18-field
"-10,98; " - with the changes, w-z18-text
This only moves the spaces from before the number to after the semi-colon. Whether this will be enough depends on whether the next program removes trailing spaces.
I have a field containing article-numbers (PIC X(25)).
Example article number: 12345-6789.
The problem is the "-", I need to delete the "-" and put together the 5 and 6, result example: 123456789
Using Micro Focus Net Express 5.1 running on a UNIX server. The position of the dash is not fixed.
Take this code for a spin.
Update: Good catch, Bill. I just wanted to give options, depending what the needs and demands truly were.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
* ClassIncludeList and ClassExcludeList can now be referenced much like NUMERIC
CLASS ClassIncludeList IS '0123456789'
CLASS ClassExcludeList IS '-'
.
WORKING-STORAGE SECTION.
01 InputStringText PIC X(1000).
01 InputStringLength PIC 9(04) COMP.
01 OutputStringText PIC X(1000).
01 OutputStringLength PIC 9(04) COMP.
01 ByteSubscript PIC 9(04) COMP.
PROCEDURE DIVISION.
MOVE article-numbers TO InputStringText.
MOVE FUNCTION LENGTH(article-numbers) TO InputStringLength.
PERFORM IncludeCharacters.
* Use OutputStringText(OutputStringLength)
PERFORM ExcludeCharacters.
* Use OutputStringText(OutputStringLength)
IncludeCharacters.
MOVE SPACES TO OutputStringText
MOVE ZERO TO OutputStringLength
PERFORM
VARYING ByteSubscript FROM 1 BY 1
UNTIL ByteSubscript > InputStringLength
IF (InputStringText(ByteSubscript:1) IS ClassIncludeList)
ADD 1 TO OutputStringLength
MOVE InputStringText(ByteSubscript:1)
TO OutputStringText(OutputStringLength:1)
END-IF
END-PERFORM
.
ExcludeCharacters.
MOVE SPACES TO OutputStringText
MOVE ZERO TO OutputStringLength
PERFORM
VARYING ByteSubscript FROM 1 BY 1
UNTIL ByteSubscript > InputStringLength
IF (InputStringText(ByteSubscript:1) IS ClassExcludeList)
CONTINUE
ELSE
ADD 1 TO OutputStringLength
MOVE InputStringText(ByteSubscript:1)
TO OutputStringText(OutputStringLength:1)
END-IF
END-PERFORM
.
There's always UNSTRING and STRING if your Cobol supports them, and if there is a limit to how many 'parts' there are going to be in the text.
01 ARTICLE-NUMBER PIC X(25).
01 PARTS.
05 PART1 PIC X(25).
05 PART2 PIC X(25).
05 PART3 PIC X(25).
05 PART4 PIC X(25).
01 RESULT PIC X(25).
........
INITIALIZE PARTS, RESULT.
UNSTRING ARTICLE-NUMBER
DELIMITED BY '-'
INTO PART1, PART2, PART3, PART4
ON OVERFLOW
DISPLAY "Too many parts!!!"
END-UNSTRING.
STRING PART1, PART2, PART3, PART4
DELIMITED BY SPACE INTO RESULT.
Hope this helps.
The following should work on any modern COBOL:
01 INPUT-STRING PIC X(25).
01 OUTPUT-STRING PIC X(25).
01 IX PIC S9(8) COMP SYNC.
01 OX PIC S9(8) COMP SYNC.
...
MOVE +1 TO OX.
MOVE ALL ' ' TO OUTPUT-STRING.
PERFORM VARYING IX FROM 1 BY 1
UNTIL IX > 25
IF NOT INPUT-STRING(IX:1) = '-'
THEN
MOVE INPUT-STRING(IX:1) TO OUTPUT-STRING(OX:1)
ADD +1 TO OX
END-IF
END-PERFORM.
I'm new to the site as well as COBOL. I am trying to write a program that reads in an 80 byte file, and finds a certain string and grabs another string that is positioned right after that. The only issue I'm having with this is that the starting position of the string is not always in the same byte throughout the file. For example, the string I am trying to find below is the LENGTH(#####) string that appears twice throughout the file:
LENGTH(14909135) FILEID(DD:EDIREC) MSGDATE(130723) MSGDATELONG(20130723)
MSGTIME(091053) MSGSEQO(001390) MSGNAME(00008557) MSGSEQNO(00001)
SESSIONKEY(XXXXXXXX) DELIMITED(E) SYSNAME(XXXXX-XX) SYSLEVEL(XXXX) TIMEZONE(L)
DATATYPE(E) EDITYPE(XXX) SENDERFILE(#####) RECFM(????) RECLEN(#) RECDLM(E)
UNIQUEID(XXXXXXXX) SYSTYPE(##) SYSVER(#);
RECEIVED ACCOUNT(XXXX) USERID(XXXXXXXX) CLASS(#E2) CHARGE(3) LENGTH(14911043)
FILEID(DD:EDIREC) MSGDATE(130723) MSGDATELONG(20130723) MSGTIME(093045)
MSGSEQO(001392) MSGSEQNO(00000) SESSIONKEY(XXXXXXXX) DELIMITED(C)
SYSNAME(XXXXX-XX) SYSLEVEL(XXXX) TIMEZONE(L) DATATYPE(E) EDITYPE(UNFORMATTED)
SENDERFILE(XXXXXXXXXXXXX) RECFM(????) RECLEN(0) RECDLM(C) UNIQUEID(XXXXXXXX)
SYSTYPE(24) SYSVER(5);
Notice the two LENGTH(#####) strings. The below code manages to count the amount of times the length string appears as well as grab the final length string count (what I really want, the numbers within the length string), but only when they are in these two positions:
WORKING-STORAGE SECTION.
01 WS-INPUT-RECORD PIC X(80).
01 WS-STRINGS.
05 LENGTH-STRING PIC X(7) VALUE 'LENGTH('.
01 WS-COUNTERS.
05 WS-MSG-COUNT PIC 9(11).
01 WS-CHAR-TOTALS.
05 CHAR-TOTAL PIC 9(11) VALUE ZEROS.
05 TMP-TOTAL PIC X(11) VALUE ZEROS.
......
PROCEDURE DIVISION.
2200-GET-MSG-TOTAL.
INSPECT WS-INPUT-RECORD
TALLYING WS-MSG-COUNT FOR ALL LENGTH-STRING.
2300-CHAR-TOTAL.
IF WS-INPUT-RECORD(1:7) = LENGTH-STRING
MOVE WS-INPUT-RECORD(8:9) TO TMP-TOTAL
UNSTRING TMP-TOTAL DELIMITED BY ')'
INTO CHAR-TOTAL
END-IF
IF WS-INPUT-RECORD(61:7) = LENGTH-STRING
MOVE WS-INPUT-RECORD(68:9) TO TMP-TOTAL
UNSTRING TMP-TOTAL DELIMITED BY ')'
INTO CHAR-TOTAL
END-IF
The code works great for the two positions shown in the example input above. But it won't work if LENGTH(####) ends up in any other byte position. Other than coding 80 IF statements to check for every byte in the file for the string, is there an easier way to go about getting those values inside of the length parens? I've checked a lot of other posts and I've thought about using pointers or tables but I can't quite seem to figure it out.
Use INSPECT to establish that LENGTH( is on the current record.
Only if present, do the following:
UNSTRING using LENGTH( as a delimiter with two receiving fields.
UNSTRING second receiving field delimited by ) leaving you with the number.
For example:
01 delimiting-field PIC X(7) VALUE "LENGTH(".
01 desitnation-field-1 PIC X.
01 destination-field-2 PIC X(18) JUST RIGHT.
UNSTRING source-field DELIMITED BY delimiting-field INTO desitnation-field-1
destination-field-2
Abandon destination-field-1. Use destination-field-2 for input to the second UNSTRING.
Use meaningful names, rather than those I have shown to illuminate the example.
So,
01 WS-INPUT-RECORD PIC X(80).
01 NUMBER-OF-LENGTHS BINARY PIC 9(4).
01 DELIMITER-COUNT BINARY PIC 9(4).
88 NO-DELIMITERS VALUE ZERO.
88 ONE-DELIMITER VALUE 1.
01 LENGTH-OPEN-PAREN PIC X(7)
VALUE "LENGTH(".
01 DATA-TO-IGNORE PIC X.
01 DATA-WITH-LENGTH-VALUE PIC X(80).
01 CLOSING-PAREN PIC X VALUE ")".
01 VALUE-OF-LENGTH-AN PIC X(18) JUST RIGHT.
THE-STUFF.
SET NO-DELIMITERS TO TRUE
INSPECT WS-INPUT-RECORD TALLYING DELIMITER-COUNT
FOR ALL LENGTH-OPEN-PAREN
EVALUATE TRUE
WHEN NO-DELIMITERS
CONTINUE
WHEN ONE-DELIMITER
PERFORM GET-THE-DATA
WHEN OTHER
PERFORM OH-DEAR-MORE-THAN-ONE
END-EVALUATE
.
GET-THE-DATA.
UNSTRING WS-INPUT-RECORD DELIMITED BY
LENGTH-OPEN-PAREN
INTO DATA-TO-IGNORE
DATA-WITH-LENGTH-VALUE
UNSTRING DATA-WITH-LENGTH-VALUE
DELIMITED BY CLOSING-PAREN
INTO VALUE-OF-LENGTH-AN
DISPLAY "THIS IS WHAT WE FOUND"
DISPLAY ">"
VALUE-OF-LENGTH-AN
"<"
.
OH-DEAR-MORE-THAN-ONE.
DISPLAY "THE FOLLOWING LINE HAS MORE THAN ONE LENGTH("
DISPLAY ">"
WS-INPUT-RECORD
"<"
.
The technique with the INSPECT to see if the "string" is present can be applied to the other solution accepted so that only if the line contains the value desired is it "searched".
You can use a "perform varying" loop to look at each block of the string within each line, where each block is a string the length of the string you are looking for. Here is an example that works in OpenCobol:
IDENTIFICATION DIVISION.
PROGRAM-ID. FIND-STRING.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE ASSIGN TO 'SAMPLE-LEN.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 END-OF-FILE-SWITCH PIC XXX VALUE 'NO '.
88 END-OF-FILE VALUE 'YES'.
01 STRING-MARKER PIC X(7) VALUE 'LENGTH('.
01 STRING-MARKER-LENGTH PIC 99 VALUE 7.
01 STRING-SOUGHT PIC X(11).
01 STRING-INDEX PIC 99.
01 RECORD-LENGTH PIC 99 VALUE 80.
PROCEDURE DIVISION.
MAIN.
OPEN INPUT IN-FILE
PERFORM UNTIL END-OF-FILE
READ IN-FILE
AT END
SET END-OF-FILE TO TRUE
NOT AT END
PERFORM FIND-STRING
END-READ
END-PERFORM
CLOSE IN-FILE
STOP RUN
.
FIND-STRING.
PERFORM VARYING STRING-INDEX FROM 1 BY 1
UNTIL STRING-INDEX > (RECORD-LENGTH
- STRING-MARKER-LENGTH)
IF IN-RECORD(STRING-INDEX:STRING-MARKER-LENGTH) =
STRING-MARKER
UNSTRING IN-RECORD(STRING-INDEX
+ STRING-MARKER-LENGTH : 10)
DELIMITED BY ')' INTO STRING-SOUGHT
END-UNSTRING
DISPLAY STRING-SOUGHT END-DISPLAY
END-IF
END-PERFORM
.
Based on Bill Woodger's comments, here is a better solution. Thank's Bill, for teaching me not to slouch :) I still like looping through each record as a way to catch multiple matches on one line, so I kept that part.
IDENTIFICATION DIVISION.
PROGRAM-ID. FIND-STRING-2.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE ASSIGN TO 'SAMPLE-LEN.TXT'
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS IN-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 IN-FILE-STATUS PIC XX.
01 END-OF-FILE-SWITCH PIC XXX VALUE 'NO '.
88 END-OF-FILE VALUE 'YES'.
01 STRING-MARKER-LEFT PIC X(7) VALUE 'LENGTH('.
01 STRING-MARKER-RIGHT PIC X VALUE ')'.
01 STRING-MARKER-LENGTH PIC 99 USAGE BINARY.
01 STRING-INDEX PIC 99 USAGE BINARY.
01 START-INDEX PIC 99 USAGE BINARY.
01 END-INDEX PIC 99 USAGE BINARY.
01 RECORD-LENGTH PIC 99 USAGE BINARY.
01 SEARCH-LENGTH PIC 99 USAGE BINARY.
01 IS-END-FOUND PIC XXX VALUE 'NO '.
88 END-FOUND VALUE 'YES'.
88 END-NOT-FOUND VALUE 'NO '.
PROCEDURE DIVISION.
MAIN.
OPEN INPUT IN-FILE
IF IN-FILE-STATUS NOT = '00'
DISPLAY 'FILE READ ERROR ' IN-FILE-STATUS
END-DISPLAY
PERFORM EXIT-PROGRAM
END-IF
PERFORM INITIALIZE-LENGTHS
PERFORM UNTIL END-OF-FILE
READ IN-FILE
AT END
SET END-OF-FILE TO TRUE
NOT AT END
PERFORM FIND-STRING
END-READ
END-PERFORM
PERFORM EXIT-PROGRAM
.
INITIALIZE-LENGTHS.
MOVE FUNCTION LENGTH(IN-RECORD) TO RECORD-LENGTH
COMPUTE STRING-MARKER-LENGTH = FUNCTION LENGTH(
STRING-MARKER-LEFT)
END-COMPUTE
COMPUTE SEARCH-LENGTH = RECORD-LENGTH - STRING-MARKER-LENGTH
END-COMPUTE
.
FIND-STRING.
PERFORM VARYING STRING-INDEX FROM 1 BY 1
UNTIL STRING-INDEX > SEARCH-LENGTH
IF IN-RECORD(STRING-INDEX:STRING-MARKER-LENGTH) =
STRING-MARKER-LEFT
COMPUTE START-INDEX = STRING-INDEX
+ STRING-MARKER-LENGTH
END-COMPUTE
SET END-NOT-FOUND TO TRUE
PERFORM VARYING END-INDEX FROM START-INDEX BY 1
UNTIL END-INDEX > RECORD-LENGTH OR END-FOUND
IF IN-RECORD(END-INDEX:
FUNCTION LENGTH(STRING-MARKER-RIGHT)) =
STRING-MARKER-RIGHT
SET END-FOUND TO TRUE
END-IF
END-PERFORM
COMPUTE END-INDEX = END-INDEX - START-INDEX - 1
END-COMPUTE
DISPLAY IN-RECORD(START-INDEX:END-INDEX)
END-DISPLAY
END-IF
END-PERFORM
.
EXIT-PROGRAM.
CLOSE IN-FILE
STOP RUN
.
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.