Cobol - COBOL is dynamic (depends)

Author

COBOL is dynamic (depends)

Frank Swarbrick

2006-10-30, 6:55 pm

Years ago for a project I had to deal with some messages that were something
like the following:

Field 1 - 4 alphanumeric characters
Field 2 - 2 numeric characters
Field 3 - either 16, or 33 or 49 characters in length, where if the first
character is a 'U' the length is 33, if the first character is a 'T' the
length is 49, otherwise the length is 16
Field 4 - 4 numeric characters
Field 5 - zero to 49 characters with the length being specified by field 4.
Field 6 - 1 character end of message delimiter ('!')

I ended up with a solution that, while it didn't make me happy, works and
isn't *too* complicated and ugly.

I saw this code again yesterday and thought that I should be able to make it
simpler, more flexible, and easier to understand.
So here's an example of how I would do it today.

PROGRAM-ID. DEPENDS.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 DATA-IN PIC X(80).
77 LEN-1 PIC S9(3) COMP-3.
77 LEN-2 PIC S9(3) COMP-3.
01 VC.
05 A PIC X(4).
05 B PIC X(2).
05 C.
10 PIC X OCCURS 0 TO 49
DEPENDING ON LEN-1.
05 D PIC 9(4).
05 E.
10 PIC X OCCURS 0 TO 49
DEPENDING ON LEN-2.
05 F PIC X.

PROCEDURE DIVISION.
PERFORM GET-VC
PERFORM UNTIL DATA-IN = LOW-VALUES
PERFORM PROCESS-VC
PERFORM GET-VC
END-PERFORM
GOBACK.

GET-VC.
MOVE LOW-VALUES TO DATA-IN
ACCEPT DATA-IN

Oliver Wong

2006-10-30, 9:55 pm

"Frank Swarbrick" <Frank.Swarbrick@efirstbank.com> wrote in message
news:4qc64qFmdaonU1@individual.net...
> Years ago for a project I had to deal with some messages that were
> something
> like the following:
>
> Field 1 - 4 alphanumeric characters
> Field 2 - 2 numeric characters
> Field 3 - either 16, or 33 or 49 characters in length, where if the first
> character is a 'U' the length is 33, if the first character is a 'T' the
> length is 49, otherwise the length is 16
> Field 4 - 4 numeric characters
> Field 5 - zero to 49 characters with the length being specified by field
> 4.
> Field 6 - 1 character end of message delimiter ('!')
>
[...]
>
> To be honest, I have no idea how I'd do this in, say, C or Java, but I
> can't
> imagine it would be any simpler.

It's not too bad, but it's not quite as nice a COBOL, since you need to
explicitly keep track of the length of C and E, rather than letting the
compiler do it for you. This Java program produces the same output, but it
hardcodes the input to the examples you provided, because input from the
console is actually somewhat of a pain to do in Java.

<code>
public class Depends {
private final String data;
private final int CLength, ELength;

public Depends(String input) {
this.data = input;
switch (data.charAt(6)) {
case 'U':
CLength = 33;
break;
case 'T':
CLength = 49;
break;
default:
CLength = 16;
break;
}
ELength = Integer.valueOf(data.substring(6 + CLength, 6 + CLength + 4));
}

public String getA() {
return data.substring(0, 4);
}

public String getB() {
return data.substring(4, 6);
}

public String getC() {
return data.substring(6, 6 + CLength);
}

public String getD() {
return data.substring(6 + CLength, 6 + CLength + 4);
}

public String getE() {
return data.substring(6 + CLength + 4, 6 + CLength + 4 + ELength);
}

public String getF() {
assert 6 + CLength + 4 + ELength + 1== data.length();
return data.substring(data.length() - 1);
}

public String toString() {
return "**********" + getC().charAt(0) + "\n" +
data + "\n" +
getA() + "\n" +
getB() + "\n" +
getC() + "\n" +
getD() + "\n" +
getE() + "\n" +
getF() + "\n";
}

public static void main(String[] args) {
System.out.println(new
Depends(" ABCD990123456789ABCDEF004912345678901234
56789012345678901234567890123456789!").toString());
System.out.println(new
Depends(" ABCD99U0123456789ABCDEFFEDCBA98765432100
033123456789012345678901234567890123!").toString());
System.out.println(new
Depends(" ABCD99T0123456789ABCDEFFEDCBA9876543210F
FFFFFFFFFFFFFFF00161234567890123456!").toString());
}
}
</code>

- Oliver

William M. Klein

2006-10-30, 9:55 pm

In "standard" COBOL (since '74) it is illegal (non-conforming) to have:
- nested Occurs Depending ON (ODO)
- any data following an ODO (at the same level)
- an ODO under an OCCURS clause

IBM has had an extension for "complex" ODO's" for time immemorial (well VS COBOL
II, R1.0 didn't have them, but by R1.1, they were back).

Most of the PC (workstation) compilers have support for this as an extension for
"IBM compatibility". HOWEVER, what it actually does may vary. In fact, Micro
Focus has a directive "ODOSLIDE" just to determine run-time behavior for such
non-Standard records.

I know that Frank works on VSE, but for some of the (often unexpected) effects
of using this construct, one should read

"Effects of change in ODO object value"

at

http://publibz.boulder.ibm.com/cgi-...1/APPENDIX1.2.2

****

Having said all of this, if one IS working on an IBM mainframe (or with
"compatible" workstation compilers), this may well be the most "elegant"
solution.

--
Bill Klein
wmklein <at> ix.netcom.com
"Frank Swarbrick" <Frank.Swarbrick@efirstbank.com> wrote in message
news:4qc64qFmdaonU1@individual.net...
> Years ago for a project I had to deal with some messages that were something
> like the following:
>
> Field 1 - 4 alphanumeric characters
> Field 2 - 2 numeric characters
> Field 3 - either 16, or 33 or 49 characters in length, where if the first
> character is a 'U' the length is 33, if the first character is a 'T' the
> length is 49, otherwise the length is 16
> Field 4 - 4 numeric characters
> Field 5 - zero to 49 characters with the length being specified by field 4.
> Field 6 - 1 character end of message delimiter ('!')
>
> I ended up with a solution that, while it didn't make me happy, works and
> isn't *too* complicated and ugly.
>
> I saw this code again yesterday and thought that I should be able to make it
> simpler, more flexible, and easier to understand.
> So here's an example of how I would do it today.
>
> PROGRAM-ID. DEPENDS.
> DATA DIVISION.
> WORKING-STORAGE SECTION.
> 77 DATA-IN PIC X(80).
> 77 LEN-1 PIC S9(3) COMP-3.
> 77 LEN-2 PIC S9(3) COMP-3.
> 01 VC.
> 05 A PIC X(4).
> 05 B PIC X(2).
> 05 C.
> 10 PIC X OCCURS 0 TO 49
> DEPENDING ON LEN-1.
> 05 D PIC 9(4).
> 05 E.
> 10 PIC X OCCURS 0 TO 49
> DEPENDING ON LEN-2.
> 05 F PIC X.
>
> PROCEDURE DIVISION.
> PERFORM GET-VC
> PERFORM UNTIL DATA-IN = LOW-VALUES
> PERFORM PROCESS-VC
> PERFORM GET-VC
> END-PERFORM
> GOBACK.
>
> GET-VC.
> MOVE LOW-VALUES TO DATA-IN
> ACCEPT DATA-IN
> .
>
> PROCESS-VC.
> MOVE 49 TO LEN-1
> MOVE 49 TO LEN-2
> MOVE DATA-IN TO VC
> DISPLAY '**********' C(1:1)
> EVALUATE C(1:1)
> WHEN 'T'
> MOVE 49 TO LEN-1
> WHEN 'U'
> MOVE 33 TO LEN-1
> WHEN OTHER
> MOVE 16 TO LEN-1
> END-EVALUATE
> MOVE D TO LEN-2
> DISPLAY A B C D E F
> DISPLAY A
> DISPLAY B
> DISPLAY C
> DISPLAY D
> DISPLAY E
> DISPLAY F
> .
>
> END PROGRAM DEPENDS.
>
> Here's three examples. (Word wrap will probably cause havoc, but hopefully
> it will be understandable.)
>
> Input:
> ABCD990123456789ABCDEF004912345678901234
56789012345678901234567890123456789!
>
>
> Output:
> **********0
> ABCD990123456789ABCDEF004912345678901234
56789012345678901234567890123456789!
>
> ABCD
> 99
> 0123456789ABCDEF
> 0049
> 1234567890123456789012345678901234567890
123456789
> !
>
> Input:
> ABCD99U0123456789ABCDEFFEDCBA98765432100
033123456789012345678901234567890123
> !
>
> Output:
> **********U
> ABCD99U0123456789ABCDEFFEDCBA98765432100
033123456789012345678901234567890123
> !
> ABCD
> 99
> U0123456789ABCDEFFEDCBA9876543210
> 0033
> 123456789012345678901234567890123
> !
>
> Input:
> ABCD99T0123456789ABCDEFFEDCBA9876543210F
FFFFFFFFFFFFFFF00161234567890123456!
>
>
> Output:
> **********T
> ABCD99T0123456789ABCDEFFEDCBA9876543210F
FFFFFFFFFFFFFFF00161234567890123456!
>
> ABCD
> 99
> T0123456789ABCDEFFEDCBA9876543210FFFFFFF
FFFFFFFFF
> 0016
> 1234567890123456
> !
>
> I've got to say that I think it's a pretty elegant solution. Maybe is
> absolutely obvious to everyone else, but hey I got there eventually! :-)
>
> (Note to Roger While: OpenCobol does not like this program. I may take a
> look at it someday. Or not. Probably fairly complicated to implement...)
>
> To be honest, I have no idea how I'd do this in, say, C or Java, but I can't
> imagine it would be any simpler.
>
> Frank
>
>
>
> ---
> Frank Swarbrick
> Senior Developer/Analyst - Mainframe Applications
> FirstBank Data Corporation - Lakewood, CO USA

HeyBub

2006-10-30, 9:55 pm

Frank Swarbrick wrote:
> Years ago for a project I had to deal with some messages that were
> something like the following:
>
> Field 1 - 4 alphanumeric characters
> Field 2 - 2 numeric characters
> Field 3 - either 16, or 33 or 49 characters in length, where if the
> first character is a 'U' the length is 33, if the first character is
> a 'T' the length is 49, otherwise the length is 16
> Field 4 - 4 numeric characters
> Field 5 - zero to 49 characters with the length being specified by
> field 4. Field 6 - 1 character end of message delimiter ('!')
>
> I ended up with a solution that, while it didn't make me happy, works
> and isn't *too* complicated and ugly.
>
> I saw this code again yesterday and thought that I should be able to
> make it simpler, more flexible, and easier to understand.

Your solution is simple, compact, and easy to understand.

You're lucky to have a compiler that permits field names after an ODO. For
those of us with conforming compilers, your solution can't be used. If faced
with the same problem, I'd have to march an index down the input record
moving individual bytes to their prescribed destinations.

Frank Swarbrick

2006-10-30, 9:55 pm

Ah! I was wondering if it perhaps was not "standard" COBOL. Just forgot to
mention it. But even though it isn't, perhaps it should be? Seems pretty
useful. I'm sure there are dangers in that you could code it incorrectly
and get some fairly bizarre results, but isn't that always the case? :-)

Frank

In "standard" COBOL (since '74) it is illegal (non-conforming) to have:
- nested Occurs Depending ON (ODO)
- any data following an ODO (at the same level)
- an ODO under an OCCURS clause

IBM has had an extension for "complex" ODO's" for time immemorial (well VS
COBOL
II, R1.0 didn't have them, but by R1.1, they were back).

Most of the PC (workstation) compilers have support for this as an extension
for
"IBM compatibility". HOWEVER, what it actually does may vary. In fact,
Micro
Focus has a directive "ODOSLIDE" just to determine run-time behavior for
such
non-Standard records.

I know that Frank works on VSE, but for some of the (often unexpected)
effects
of using this construct, one should read

"Effects of change in ODO object value"

at

http://publibz.boulder.ibm.com/cgi-...y3pg31/APPENDIX
1.2.2

****

Having said all of this, if one IS working on an IBM mainframe (or with
"compatible" workstation compilers), this may well be the most "elegant"
solution.

--
Bill Klein
wmklein <at> ix.netcom.com
"Frank Swarbrick" <Frank.Swarbrick@efirstbank.com> wrote in message
news:4qc64qFmdaonU1@individual.net...[color=darkred]
> Years ago for a project I had to deal with some messages that were
something
> like the following:
>
> Field 1 - 4 alphanumeric characters
> Field 2 - 2 numeric characters
> Field 3 - either 16, or 33 or 49 characters in length, where if the first
> character is a 'U' the length is 33, if the first character is a 'T' the
> length is 49, otherwise the length is 16
> Field 4 - 4 numeric characters
> Field 5 - zero to 49 characters with the length being specified by field
4.
> Field 6 - 1 character end of message delimiter ('!')
>
> I ended up with a solution that, while it didn't make me happy, works and
> isn't *too* complicated and ugly.
>
> I saw this code again yesterday and thought that I should be able to make
it
> simpler, more flexible, and easier to understand.
> So here's an example of how I would do it today.
>
> PROGRAM-ID. DEPENDS.
> DATA DIVISION.
> WORKING-STORAGE SECTION.
> 77 DATA-IN PIC X(80).
> 77 LEN-1 PIC S9(3) COMP-3.
> 77 LEN-2 PIC S9(3) COMP-3.
> 01 VC.
> 05 A PIC X(4).
> 05 B PIC X(2).
> 05 C.
> 10 PIC X OCCURS 0 TO 49
> DEPENDING ON LEN-1.
> 05 D PIC 9(4).
> 05 E.
> 10 PIC X OCCURS 0 TO 49
> DEPENDING ON LEN-2.
> 05 F PIC X.
>
> PROCEDURE DIVISION.
> PERFORM GET-VC
> PERFORM UNTIL DATA-IN = LOW-VALUES
> PERFORM PROCESS-VC
> PERFORM GET-VC
> END-PERFORM
> GOBACK.
>
> GET-VC.
> MOVE LOW-VALUES TO DATA-IN
> ACCEPT DATA-IN
> .
>
> PROCESS-VC.
> MOVE 49 TO LEN-1
> MOVE 49 TO LEN-2
> MOVE DATA-IN TO VC
> DISPLAY '**********' C(1:1)
> EVALUATE C(1:1)
> WHEN 'T'
> MOVE 49 TO LEN-1
> WHEN 'U'
> MOVE 33 TO LEN-1
> WHEN OTHER
> MOVE 16 TO LEN-1
> END-EVALUATE
> MOVE D TO LEN-2
> DISPLAY A B C D E F
> DISPLAY A
> DISPLAY B
> DISPLAY C
> DISPLAY D
> DISPLAY E
> DISPLAY F
> .
>
> END PROGRAM DEPENDS.
>
> Here's three examples. (Word wrap will probably cause havoc, but
hopefully
> it will be understandable.)
>
> Input:
>
ABCD990123456789ABCDEF004912345678901234
56789012345678901234567890123456789!

>
>
> Output:
> **********0
>
ABCD990123456789ABCDEF004912345678901234
56789012345678901234567890123456789!

>
> ABCD
> 99
> 0123456789ABCDEF
> 0049
> 1234567890123456789012345678901234567890
123456789
> !
>
> Input:
>
ABCD99U0123456789ABCDEFFEDCBA98765432100
033123456789012345678901234567890123

> !
>
> Output:
> **********U
>
ABCD99U0123456789ABCDEFFEDCBA98765432100
033123456789012345678901234567890123

> !
> ABCD
> 99
> U0123456789ABCDEFFEDCBA9876543210
> 0033
> 123456789012345678901234567890123
> !
>
> Input:
>
ABCD99T0123456789ABCDEFFEDCBA9876543210F
FFFFFFFFFFFFFFF00161234567890123456!

>
>
> Output:
> **********T
>
ABCD99T0123456789ABCDEFFEDCBA9876543210F
FFFFFFFFFFFFFFF00161234567890123456!

>
> ABCD
> 99
> T0123456789ABCDEFFEDCBA9876543210FFFFFFF
FFFFFFFFF
> 0016
> 1234567890123456
> !
>
> I've got to say that I think it's a pretty elegant solution. Maybe is
> absolutely obvious to everyone else, but hey I got there eventually! :-)
>
> (Note to Roger While: OpenCobol does not like this program. I may take a
> look at it someday. Or not. Probably fairly complicated to
implement...)
>
> To be honest, I have no idea how I'd do this in, say, C or Java, but I
can't
> imagine it would be any simpler.
>
> Frank
>
>
>
> ---
> Frank Swarbrick
> Senior Developer/Analyst - Mainframe Applications
> FirstBank Data Corporation - Lakewood, CO USA

Richard

2006-10-30, 9:55 pm

HeyBub wrote:

> Your solution is simple, compact, and easy to understand.
>
> You're lucky to have a compiler that permits field names after an ODO. For
> those of us with conforming compilers, your solution can't be used. If faced
> with the same problem, I'd have to march an index down the input record
> moving individual bytes to their prescribed destinations.

Or use reference notation, perhaps table driven:

01 Tspec PIC X(36) VALUE
"001004005002007049056004060049109001".
01 Uspec PIC X(36) VALUE
"001004005002007033040004044033077001".
etc
01 FieldSpec.
03 AStart PIC 999.
03 ALen PIC 999.
03 BStart PIC 999.
03 BLen PIC 999.
etc

MOVE TSpec TO FieldSpec
EVALUATE Data-In(CStart:1)
WHEN "U"
MOVE Uspec TO FieldSpec
WHEN OTHER
etc

MOVE Data-In(AStart:ALen) TO A
MOVE Data-In(BStart:BLen) TO B
etc

Karl Kiesel

2006-10-30, 9:55 pm

"Frank Swarbrick" <Frank.Swarbrick@efirstbank.com> schrieb im Newsbeitrag
news:4qctegFmeh26U1@individual.net...
> Ah! I was wondering if it perhaps was not "standard" COBOL. Just forgot
> to
> mention it. But even though it isn't, perhaps it should be? Seems pretty
> useful. I'm sure there are dangers in that you could code it incorrectly
> and get some fairly bizarre results, but isn't that always the case? :-)
>
> Frank
Frank,
a standard2002 soulution similar to Yours is possible, using BASED items and
pointers; something like:

WORKING-STORAGE SECTION.
77 LEN-1 PIC S9(3) PACKED-DECIMAL.
01 WRK-PTR USAGE POINTER.
01 DATA-IN.
05 A PIC X(4).
05 B PIC X(2).
05 C-LG-IND PIC X.
05 REST PIC X(102).
LINKAGE SECTION.
01 C BASED.
05 PIC X OCCURS 0 TO 49
DEPENDING ON LEN-1.
01 D-E BASED.
05 D PIC 9(4).
05 E.
10 PIC X OCCURS 0 TO 49
DEPENDING ON D.
01 F BASED.
05 PIC X.
PROCEDURE DIVISION.

*> removed length computations from PROCESS-VC
*> extended/modified GET-VC
*> other unchanged snipped here

GET-VC.
MOVE LOW-VALUES TO DATA-IN
ACCEPT DATA-IN
IF DATA-IN NOT = LOW-VALUES
EVALUATE C-LG-IND
WHEN 'T'
MOVE 49 TO LEN-1
WHEN 'U'
MOVE 33 TO LEN-1
WHEN OTHER
MOVE 16 TO LEN-1
END-EVALUATE
*> make parts C, D-E, F addressable within area DATA-IN
SET WRK-PTR TO ADDRESS OF C-LG-IND
SET ADDRESS OF C TO WRK-PTR
SET WRK-PTR UP BY LEN-1
SET ADDRESS OF D-E TO WRK-PTR
SET WRK-PTR UP BY FUNCTION BYTE-LENGTH(D-E)
SET ADDRESS OF F TO WRK-PTR
END-IF.

This has a shortcoming compared to the original solution: data A ...F can
not be accessed as a group like VC in the original solution

Karl Kiesel
Fujitsu Siemens Computers, München

Frank Swarbrick

2006-10-30, 9:55 pm

Richard<riplin@Azonic.co.nz> 10/26/06 5:32 PM >>>
>
>HeyBub wrote:
>
For[color=darkred]
faced[color=darkred]
>
>Or use reference notation, perhaps table driven:
>
> 01 Tspec PIC X(36) VALUE
>"001004005002007049056004060049109001".
> 01 Uspec PIC X(36) VALUE
>"001004005002007033040004044033077001".
> etc
> 01 FieldSpec.
> 03 AStart PIC 999.
> 03 ALen PIC 999.
> 03 BStart PIC 999.
> 03 BLen PIC 999.
> etc
>
> MOVE TSpec TO FieldSpec
> EVALUATE Data-In(CStart:1)
> WHEN "U"
> MOVE Uspec TO FieldSpec
> WHEN OTHER
> etc
>
> MOVE Data-In(AStart:ALen) TO A
> MOVE Data-In(BStart:BLen) TO B
> etc

I think you'll have to admit that you can't just glance at that and see what
it is actually doing, while my original example is probably readible even by
a non-programmer.

What I like about my original example is that it does what computers are
made to do; the hard stuff. It leaves the programmer to do his job rather
that trying to figure out how to get the computer to do the computer's job.

Frank

---
Frank Swarbrick
Senior Developer/Analyst - Mainframe Applications
FirstBank Data Corporation - Lakewood, CO USA

HeyBub

2006-10-30, 9:55 pm

Frank Swarbrick wrote:
> Richard<riplin@Azonic.co.nz> 10/26/06 5:32 PM >>>
>
> I think you'll have to admit that you can't just glance at that and
> see what it is actually doing, while my original example is probably
> readible even by a non-programmer.
>
> What I like about my original example is that it does what computers
> are made to do; the hard stuff. It leaves the programmer to do his
> job rather that trying to figure out how to get the computer to do
> the computer's job.
>
> Frank
>

As I said originally, your solution is, indeed, elegant. For those without
your compiler's abilities, we are constrained to less forthright solutions,
such as the one Richard demonstrated.

I, personally, would attack the problem thusly:

....
READ Input-File
CALL 'DECOMPOSE' USING Input-File Restultant-Fields
....

Then nobody would know how convoluted the code might be.

Richard

2006-10-30, 9:55 pm

Frank Swarbrick wrote:

> I think you'll have to admit that you can't just glance at that and see what
> it is actually doing, while my original example is probably readible even by
> a non-programmer.

What one can understand at a glance depends entirely on what one is
used to.

I do a _lot_ of table driven code, often by tables in configuration
files. So, yes, I can glance at table driven code and see what it is
actually doing. In fact if I was doing this for a serious project I
would probably have the field offsets and lengths in a configuration
file along with the specifiers about which set of offsets to use and
then the code could deal with other variations.

Richard

2006-10-30, 9:55 pm

Sponsored Links