Re: COBOL Books - DON'T bother to buy
- From: "James J. Gavan" <jgavandeletethis@xxxxxxx>
- Date: Fri, 25 Nov 2005 02:57:19 GMT
Richard wrote:
afterall, what is the point of overly complicating a simple program and increasing the line count by 50% just to write it in OO Cobol?
There is a point to OO, but many Cobol programs - especially batch sequential processing programs - would not realise it.
One could write a 'class' using a called Cobol subprogram. You would CALL using some parameters one being a function code: 'O' for Open, 'X' for Close, 'R' to Read, etc. The subprogram would maintain data in Working-Storage.
<snip>......
Well you covered that very well by your illustrations - but as back up, take a look :-
*>-----------------FileIsam.cbl-----------------------------------
Class-id. IsamFile
inherits from FileErrors.Class-control. IsamFile is class "fileisam"
FileErrors is class "filerror"
.*> Note : All lines marked +++ MUST HAVE the same value as *> the variable MaxRecordSize. This class CANNOT be used with *> an existing file which has been created (OPENed) with an *> original fixed length record, say, in a typically Procedural *> program
*> The program is written to N/E V 3.1 syntax, CLASS-CONTROL and *> OBJECT-STORAGE SECTION. If you have N/E V 4.0 onwards, *> take advantage of the COBOL 2002 syntax *> and change :
*> (1) REPOSITORY instead of CLASS-CONTROL. *> (2) WORKING-STORAGE SECTION instead of OBJECT-STORAGE SECTION
*>---------------------------------------------------------- *>FACTORY. *>--------------------------------------------------------------- *>End FACTORY. *>------------------------------------------------------------ OBJECT. *>------------------------------------------------------------ FILE-CONTROL.
Select Data-File
assign Data-filename
organization indexed
access dynamic
record key Data-PrimeKey
file status ws-FileStatus.*>---------------------------------------------------------------
*> Note that the file structure assumes you can hold a Primekey *> in the first 20 characters of the record. Your actual Key may *> only be, say 5 characters. So the 'calling' class intializes *> the field and puts in the fewer characters as necessasry. *> Are you concerned about wasted space in records ? You can *> always add the M/F data compression Directives.
*> Although your actual input records can be FIXED LENGTH or *> VARIABLE LENGTH, (see Flag setting in method "setFileInfo", *> they are still accessible using the lines below :- *> *> record varying from 20 to 1500 characters *> depending on ws-RecordSize. *> *> The 'minmimum' of 20, must allow for the PrimeKey size *> *> Of course, subject to your needs the PrimeKey field and the *> Maximum record size can be increased/decreased - but any *> revised sizes apply to any file created and used with this *> class
FILE SECTION.
FD Data-File
record varying from 20 to 1500 characters *> +++
depending on ws-RecordSize.
01 Data-record.
05 Data-PrimeKey pic x(20). *> PPPP
05 Data-info pic x(1480). *> +++*>--------------------------------------------------------------- OBJECT-STORAGE SECTION. copy "\copylib\LinkErr.cpy" replacing ==(tag)== by ==ws==. 01 charx pic x. 01 Data-filename pic x(100). 01 Instance-MaxRecordSize pic 9(04). 78 MaxRecordSize value 1500. 01 ws-RecordSize pic 9(04) value 1. 01 OpenFlag pic 9(01) value 0. 88 FileClosed value 0. 88 FileOpened value 1.
*> This is signalling to this particular Instance generated by *> invoking "new", that this file is either 'Fixed' or *> 'Variable' Length records. See Method "setFileInfo" which *> sets this flag.
01 RecordLength-Flag pic 9(01) value 0. 88 FixedLengthRecords value 0. 88 VariableLengthRecords value 1.
*>-------------------------------------------------------------- Method-id. "closeFile". *>--------------------------------------------------------------
*> Checking for FileOpened ensures you don't get a file-status *> error when attempting to close the file twice
Linkage section. copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division returning lnk-SqlResult.
set ResultOK to true
if FileOpened
close Data-file if ws-fileStatus = "00"
set FileClosed to true else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-if
End-ifEnd Method "closeFile".
*>--------------------------------------------------------------
Method-id. "DeleteRecord".
*>--------------------------------------------------------------
Local-storage section.
01 ls-Values.
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==05 ls==.
05 ls-record.
10 occurs 1 to MaxRecordSize
depending on ws-RecordSize pic x.Linkage section. 01 lnk-Key pic x(20). *> PPPPP copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division using lnk-Key
returning lnk-SqlResult. initialize lnk-SqlResult
invoke self "readRecord"
using lnk-Key returning ls-values if ResultOK of ls-values
Delete Data-File record
invalid key
set RecNotFound of lnk-SqlResult to true
End-Deleteelse EXIT METHOD End-if
if ws-fileStatus = "00" or "23"
continue else set FileError of lnk-SqlResult to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "DeleteRecord". *>-------------------------------------------------------------- Method-id. "openInputFile". *>-------------------------------------------------------------- Linkage section. copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division returning lnk-SqlResult.
set ResultOK to true open input Data-file
if ws-fileStatus = "00"
set FileOpened to true else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "openInputFile". *>-------------------------------------------------------------- Method-id. "openIOfile". *>-------------------------------------------------------------- Linkage section. copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division returning lnk-SqlResult.
set ResultOK to true open I-O Data-file
if ws-fileStatus = "00"
set FileOpened to true else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "openIOfile". *>-------------------------------------------------------------- Method-id. "openOutputFile". *>-------------------------------------------------------------- Linkage section. copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division returning lnk-SqlResult.
set ResultOK to true open output Data-file
if ws-fileStatus = "00"
set FileOpened to true else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-if
End Method "openOutputFile".
*>--------------------------------------------------------------
Method-id. "readNext".
*>--------------------------------------------------------------
Linkage section.
01 lnk-ReturnValues.
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==05 lnk==.
05 lnk-RecordSize pic 9(04).
05 lnk-record.
10 occurs 1 to MaxRecordSize
depending on lnk-RecordSize pic x.Procedure Division returning lnk-ReturnValues.
initialize lnk-ReturnValues
Read Data-File next record
At End
Set fileFinis to True
Not at End
move ws-RecordSize to lnk-RecordSize
Move Data-record (1:ws-RecordSize)
to lnk-record (1:ws-RecordSize)
End-Read if ws-fileStatus = "00" or "10" *> EOF
continue else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "readNext".
*>--------------------------------------------------------------
Method-id. "readRecord".
*>--------------------------------------------------------------
Linkage section.
01 lnk-PrimeKey pic x(20). *> PPPP
01 lnk-ReturnValues.
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==05 lnk==.
05 lnk-RecordSize pic 9(04).
05 lnk-record.
10 occurs 1 to MaxRecordSize
depending on lnk-RecordSize pic x.Procedure Division using lnk-PrimeKey
returning lnk-ReturnValues. initialize lnk-ReturnValues
move lnk-PrimeKey to Data-PrimeKey
Read Data-File
key is Data-PrimeKey
invalid key
set RecNotFound to true
not invalid key
move ws-RecordSize to lnk-RecordSize
move Data-record(1:ws-RecordSize)
to lnk-record (1:ws-RecordSize)
End-Read if ws-fileStatus = "00" or "23"
continue else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "readRecord".
*>--------------------------------------------------------------
Method-id. "rewriteRecord".
*>--------------------------------------------------------------
Linkage section.
01 lnk-record.
10 occurs 1 to MaxRecordSize
depending on lnk-RecordSize pic x.
01 lnk-RecordSize pic 9(04).
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.Procedure Division using lnk-record, lnk-RecordSize,
returning lnk-SqlResult.set ResultOK to true
Evaluate true
when FixedLengthRecords
if lnk-RecordSize = Instance-MaxRecordSize
continue else move "RL" to ws-fileStatus
*> Dummy file-status to generate errorMessage
set FileError to true
invoke super "showFileError" using ws-ErrorParams
EXIT METHOD
End-ifwhen other
if (lnk-RecordSize is > zeroes) AND
(lnk-RecordSize is not > Instance-MaxRecordSize)
continue else move "RL" to ws-fileStatus
*> Dummy file-status to generate errorMessage
set FileError to true
invoke super "showFileError" using ws-ErrorParams
EXIT METHOD
End-ifEnd-Evaluate
REWRITE Data-Record *> R-E-W-R-I-T-E from lnk-record (1:lnk-RecordSize)
if ws-fileStatus <> "00"
set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "rewriteRecord". *>--------------------------------------------------------------- Method-id. "setFileInfo". *>--------------------------------------------------------------- Linkage section. 01 lnk-Filename pic x(100). 01 lnk-Parent object reference. 01 lnk-recordSize pic 9(04). 01 lnk-LengthType pic 9.
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division using lnk-filename
lnk-Parent
lnk-RecordSize
lnk-LengthType
returning lnk-SqlResult. set ResultOK to true
initialize ws-ErrorParams
move lnk-filename to Data-filename
ws-filename
set ws-Parent to lnk-Parent
move lnk-recordSize to ws-RecordSize
Instance-MaxRecordSize if ws-RecordSize > MaxRecordSize
move "RS" to ws-fileStatus
*> Dummy file-status to generate errorMessage
set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-if*> It is assumed the File in this Instance will be for *> Fixed ( = 0 ) unless you pass a value of '1' for Variable *> Length records
if lnk-LengthType = 1
set VariableLengthRecords to true
End-ifEnd Method "setFileInfo". *>--------------------------------------------------------------- Method-id. "startPrimeKey". *>--------------------------------------------------------------- Linkage section. 01 lnk-Key pic x(20). *> PPPP copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
Procedure Division using lnk-Key returning lnk-SqlResult.
set ResultOK to true move lnk-Key to Data-PrimeKey
Start Data-File key is > Data-PrimeKey
invalid key set FileFinis to true
not invalid key continue
End-start if ws-fileStatus = "00" or "10"
continue else set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "startPrimeKey".
*>---------------------------------------------------------------
*>Method-id. "StartPrimeKey".
*>---------------------------------------------------------------
*> Although for my own use I have found the above syntax adequate,
*> you may want to use one of the other comparison methods.
*> You could use a copyfile in your calling program to send,
*> in addition to the key field, Level 88s :-
*>
*> 01 Start-Flag pic 9.
*> 88 EqualTo value 1.
*> 88 GreaterThan value 2.
*> 88 NotLessThan value 3.
*> 88 GreaterOrEqualTo value 4.
*> 88 LessThan value 5.
*> 88 NotGreaterThan value 6.
*> 88 LessThanOrEqual value 7.
*> 88 NotLewssThanOrEqual value 8.
*> 88 ValidComparison value 1 thru 8.
*>
*>--------------------------------------------------------------
*>Linkage section.
*>01 lnk-Key pic x(20). *> PPPP
*>01 lnk-StartFlag pic 9.
*>copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.
*>
*>Procedure Division using lnk-Key, lnk-StartFlag
*> returning lnk-SqlResult.
*>
*> if not ValidComparison
*> set an error ...... - build a new method into your
*> file-status checker for file-status = "VC"
*>
*> set ResultOK to true
*> move lnk-Key to Data-PrimeKey
*>
*> Evaluate true
*>
*> when EqualTo
*> Start Data-File key is Equal to Data-PrimeKey
*> invalid key set FileFinis to true
*> End-start
*>
*> when GreaterThan
*> Start Data-File key Greater Than Data-PrimeKey
*> invalid key set FileFinis to true
*> End-start
*>
*> when etc.........
*>
*> End-Evaluate
*>
*> if ws-fileStatus = "00" or "10"
*> continue
*>
*> else set FileError to true
*> invoke super "showFileError" using ws-ErrorParams
*> End-if
*>
*>
*>*>End Method "StartPrimeKey".
*>*>---------------------------------------------------------------
Method-id. "writeRecord".
*>--------------------------------------------------------------
Linkage section.
01 lnk-record.
10 occurs 1 to MaxRecordSize
depending on lnk-RecordSize pic x.
01 lnk-RecordSize pic 9(04).
copy "\copylib\sqlResult.cpy" replacing ==(tag)== by ==01 lnk==.Procedure Division using lnk-record, lnk-RecordSize,
returning lnk-SqlResult.set ResultOK to true
Evaluate true
when FixedLengthRecords
if lnk-RecordSize = Instance-MaxRecordSize
continue else move "RL" to ws-fileStatus
*> Dummy file-status to generate errorMessage
set FileError to true
invoke super "showFileError" using ws-ErrorParams
EXIT METHOD
End-ifwhen other
if (lnk-RecordSize is > zeroes) AND
(lnk-RecordSize is not > Instance-MaxRecordSize)
continue else move "RL" to ws-fileStatus
*> Dummy file-status to generate errorMessage
set FileError to true
invoke super "showFileError" using ws-ErrorParams
EXIT METHOD
End-ifEnd-Evaluate
WRITE Data-Record *> W-R-I-T-E from lnk-record (1:lnk-RecordSize)
if ws-fileStatus <> "00"
set FileError to true
invoke super "showFileError" using ws-ErrorParams
End-ifEnd Method "writeRecord". *>--------------------------------------------------------------
End OBJECT. End CLASS IsamFile.
*>---------------------------------------------------------------
Above - Acknowledgtements (1) Will Price, (but not covered in his books), (2) Bill Klein for suggesting varying from 'a' to 'b' depending upon 'c', (3) Donald who twigged the fixed keys idea and (4) Pete who took a crack at it for me - but I came to the conclusion that Donald's was a more simplistic approach.
Subject to fitting the PrimeKey size, which you could alter, then you can apply this to 1, 10 or 10,000 ISAM Files. Don't like the restrictions, would rather have a class which is dedicated to each of your separate files - FILE-CONTROL and FILE-SECTION are adapted to a particular file. In the FILE-SECTION you would include a copyfile for your specific record formats - that copyfile also appears in any program which invokes the class. Lots more to it than that, but above gives you an idea - WHICH WORKS ! Meanwhile yours truly has moved on to SQL......., but for a quick test like my checking out data for a Treeview, do use the old file classes.
The reference to inherits from FileErrors - OO purists would say, "Dear or deary me, how can a file class possibly inherit from a set of errors. Tut, tut". So I'm a heretic and have broken the basic rules - but nice neat way to get at FileErrors - parallel course with classes for SQL Tables. FileErrors contains messages for all the Standard file-status codes plus the ancillary list from M/F covering the second character where file-status gives you '9X'. FileErrors of course invokes Messagebox to display the error.
Jimmy .
- Follow-Ups:
- Re: COBOL Books - DON'T bother to buy
- From: Richard
- Re: COBOL Books - DON'T bother to buy
- References:
- COBOL Books - DON'T bother to buy
- From: James J. Gavan
- Re: COBOL Books - DON'T bother to buy
- From: Alistair
- Re: COBOL Books - DON'T bother to buy
- From: Richard
- COBOL Books - DON'T bother to buy
- Prev by Date: Re: Next generation COBOL?
- Next by Date: Re: Cobol books & experiences
- Previous by thread: Re: COBOL Books - DON'T bother to buy
- Next by thread: Re: COBOL Books - DON'T bother to buy
- Index(es):
