ReportWriter (and Repository) explicitly support three file types: ASCII, DBL ISAM, and relative. They also support the user-defined file type, which enables you to provide your own support for any additional file types using I/O subroutines that you write yourself.
You can overload these I/O subroutines in ReportWriter. Whenever ReportWriter performs an I/O function where the file type is user-defined, it calls one of the four routines listed below. RPS_OPEN_METHOD opens a channel, RPS_CLOSE_METHOD closes a channel, RPS_READ_METHOD reads a record, and RPS_READS_METHOD reads a record sequentially.
The versions of these routines linked with your original ReportWriter distribution are “dummy” routines; they simply return. You can overload these routines with your own versions that provide support for file types not supported by ReportWriter or Repository.
RPS_OPEN_METHOD
subroutine RPS_OPEN_METHOD
a_channel ,n ;I/O channel returned (d3)
a_mode ,a ;I/O mode in which to open the channel
; (for example, U:I) (a3)
a_filename ,a ;Name of file to open (Not a file
; definition name.) (a64)
a_user_area ,a ;User–defined data area (a60)
a_record ,n ;Record number, if file is relative (d5)
a_error ,n ;Returned with an error code (d2)
RPS_CLOSE_METHOD
subroutine RPS_CLOSE_METHOD
a_channel ,n ;I/O channel (d3)
a_user_area ,a ;User–defined data area (a60)
a_record ,n ;Record number, if file is relative (d5)
a_error ,n ;Returned with an error code (d2)
RPS_READ_METHOD
subroutine RPS_READ_METHOD
a_channel ,d3 ;I/O channel to use (d3)
a_record ,a ;Record returned
a_key_val ,a ;Key value that identifies the record
a_key_ref ,n ;Explicit key of reference; if no keys defined
; for the structure, this value is -1 (d1)
a_user_area ,a ;User–defined data area (a60)
a_record ,n ;Record number, if file is relative (d5)
a_error ,n ;Returned with an error code (d2)
RPS_READS_METHOD
subroutine RPS_READS_METHOD
a_channel ,n ;I/O channel to use (d3)
a_record ,a ;Record returned
a_user_area ,a ;User–defined data area (a60)
a_record ,n ;Record number, if file is relative (d5)
a_error ,n ;Returned with an error code (d2)
Error codes to return from I/O subroutines
These are the valid error codes to return from the four I/O subroutines listed above:
DD_IO_ERROR ,-1 ;Operation error DD_IO_NORMAL ,0 ;Normal operation DD_IO_NOFIND ,1 ;"Record not found" error DD_IO_UNKNOWN ,2 ;Unknown error DD_IO_INVFIL ,3 ;Invalid file type DD_IO_EOF ,4 ;End of file DD_IO_CANCEL ,8 ;Interrupt signal entered
Sample user-defined file type I/O subroutines
This example illustrates the use of the user-defined file type for supporting an MCBA-like file structure. Also shown is the definition file this subroutine uses. The files containing these routines and their record definitions are included in your distribution.
;------------------------------------------------------------------
;
; Source: USRDCTIO.DEF
;
; Description: User-defined file type I/O control error
; codes and example user control area records
;
;-----------------------------------------------------------------
;
; Define error codes
;
.define DD_IO_ERROR , -1 ;Operation error
.define DD_IO_NORMAL , 0 ;Normal operation
.define DD_IO_NOFIND , 1 ;Record not found
.define DD_IO_UNKNOW , 2 ;Unknown error
.define DD_IO_INVFIL , 3 ;Invalid file type
.define DD_IO_EOF , 4 ;End of file
.define DD_IO_CANCEL , 8 ;Interrupt signal entered
; Example user file type definition area
record usr_type ;User area 1-15
usrtyp ,a15 ;User file type
usr_ftyp ,a1 @usrtyp+1 ;Specific file type
; Example user file structure for MCBA master type
record usr_mcba ;User area 16-41
idx_chn ,d2 ;Index file channel
keyref ,d1 ;Key reference used
orgcnt ,d5 ;Organized record count
reccnt ,d5 ;Record count
maxrec ,d5 ;Maximum record count
delcnt ,d3 ;Delete record count
recnum ,d5 ;Record number (pointer)
.ifndef SHOW_DEF_LIST
.START NOPAGE, LIST
.endc
;------------------------------------------------------------------
;
; Source: USRMCBA.DBL
;
; Description: Sample user-defined file type I/O access
; routines for an MCBA-like file
;
; Routines: RPS_OPEN_METHOD, RPS_READ_METHOD,
; RPS_READS_METHOD, RPS_CLOSE_METHOD
;
;------------------------------------------------------------------
subroutine rps_open_method
;
; Description: This is a sample user-defined file type open routine.
;
; Arguments:
;
a_chn ,n ;Returned open channel
a_mod ,a ;Returned file open mode
; in this example, not used
a_filnam ,a ;Open filename
a_userarea ,a ;Returned user control area
a_ddarea ,n ;Returned record number
a_sts ,n ;Returned status
; Special Notes:
; This example doesn't use "RPS_FILNAM_METHOD" to process the open
; filename. Instead, this routine processes the filename tag character
; to determine the necessary operation.
;
; User file types are specified at the end of the open filename.
;
; User file types supported:
; "@M" type file: MCBA-like standard master file with index (example
; file specification DAT:CUSMAS, IDX:CUSIDX@M)
;
; User data area structure:
;
; usrtyp ,a15 ;User file type
; idx_ch ,d2 ;Index file channel
; keyref ,d1 ;Key reference used
; orgcnt ,d5 ;Organized record count
; reccnt ,d5 ;Record count
; maxrec ,d5 ;Maximum record count
; delcnt ,d3 ;Delete record count
; recnum ,d5 ;Record number (pointer)
.define SHOW_DEF_LIST
.include "usrdctio.def"
record
len ,d2
mstlen ,d2
record rec_buf
buffer ,a200 ;Temporary buffer to read the MCBA
; control record
proc
clear usr_mcba
len = %trim(a_filnam) ;Get actual size of the filename
if (a_filnam(len-1:2).eq."@M") then
begin
a_mod = "i"
usrtyp = "@M" ;Load user type
len = len - 2
call mcba_master
xreturn ;We are done here!
end
else ;Invalid file type
begin
a_sts = DD_IO_INVFIL
xreturn
end
xreturn
mcba_master,
;
; Do MCBA master file type open
;
mstlen = %instr(1, a_filnam(1,len), ',') ;Find delimiter
if (.not.mstlen) ;Invalid file specification
begin ;Index file required for this type
a_sts = DD_IO_INVFIL
xreturn
end
;Open the index file and store channel
; in the user data area
xcall u_open(idx_chn, "i", a_filnam(mstlen+1,len),,, a_sts)
if (a_sts)
xreturn
len = mstlen - 1 ;Get the master filename length
xcall u_open(a_chn, a_mod, a_filnam(1,len),,, a_sts)
if (a_sts)
xreturn
;We don't care about actual record size
reads(a_chn, rec_buf) [eof=nofind, err=errexit]
reccnt = rec_buf(1,5) ;Record count
recnum = 2 ;And set next record to read
a_userarea(1,15) = usrtyp ;Save user file type
a_userarea(16,41) = usr_mcba ;Save control in user area
return
errexit,
a_sts = DD_IO_ERROR
return
nofind,
a_sts = DD_IO_NOFIND
return
end
subroutine rps_read_method
;
; Description: Sample user-defined file type random read routine.
;
; Arguments:
;
a_chn ,n ;File open channel
a_recbuf ,a ;Returned record buffer
a_keyval ,a ;Search key value
a_keyref ,n ;Search key reference ID
a_userarea ,a ;User control data area
a_ddarea ,n ;Returned record number
a_sts ,n ;Returned status
.include "usrdctio.def"
record
len ,d5
rtn ,d5
proc
usrtyp = a_userarea(1,15) ;Get user type
len = size(a_recbuf) ;Get size of record buffer
if (usrtyp.eq."@M") then ;Do random read on user case
begin
usr_mcba = a_userarea(16,41) ;Get local user area
xcall mcba_search(idx_chn, reccnt, a_keyval, a_keyref,
& recnum, a_sts)
if (a_sts)
goto nofind
get(a_chn, a_recbuf(1,len), recnum) [err=errexit, eof=nofind]
keyref = a_keyref ;Save for sequential read by key
a_userarea(16,41) = usr_mcba ;Save update
end
else ;DBL ISAM
goto errexit
xreturn
errexit,
a_sts = DD_IO_ERROR
xreturn
nofind,
a_sts = DD_IO_NOFIND
xreturn
end
subroutine rps_reads_method
;
; Description: Sample user-defined file type sequential read routine.
;
; Arguments:
;
a_chn ,n ;File open channel
a_recbuf ,a ;Returned record buffer
a_userarea ,a ;User control data area
a_ddarea ,n ;Returned record number
a_sts ,n ;Returned status
.include "usrdctio.def"
record
len ,d5
rtn ,d3
arecsiz ,a4
proc
usrtyp = a_userarea(1,15) ;Get the user type
len = %size(a_recbuf) ;Get size of record buffer
if (usrtyp.eq."@M") then ;Do sequential read on user case
begin
usr_mcba = a_userarea(16,41) ;Get local user area
xcall mcba_search(idx_chn, reccnt,, keyref, recnum, a_sts)
if (a_sts)
xreturn
get(a_chn,a_recbuf(1,len), recnum)
& [eof=nofind,key=nofind,err=errexit]
a_userarea(16,41) = usr_mcba ;Save update
end
else
goto errexit
xreturn
errexit,
a_sts = DD_IO_ERROR
xreturn
nofind,
a_sts = DD_IO_NOFIND
xreturn
end
subroutine rps_close_method
;
; Description: Sample user-defined file type close routine.
;
; Arguments:
;
a_chn ,n ;File open channel
a_userarea ,a ;User control data area
a_ddarea ,n ;Record number
a_sts ,n ;Returned status
.include "usrdctio.def"
proc
usrtyp = a_userarea(1,15)
xcall u_close(a_chn)
if (usrtyp.eq."@M")
begin
usr_mcba = a_userarea(16,41)
xcall u_close(idx_chn)
end
clear a_userarea
xreturn
end
subroutine mcba_search
;
; Description: Search MCBA master index and return record number
;
; Arguments:
;
a_chn ,n ;Index file open channel
a_reccnt ,n ;Organized record count
a_keyval ,a ;Index key value
a_keyref ,n ;Index key reference ID - 0 based
a_recnum ,n ;Returned record number
a_sts ,n ;Returned status
;
; Special Notes:
; This routine assumes the index file contains a single keyed index with
; a record pointer (number), and the index file is sorted by the index.
;
.include "usrdctio.def"
record idx_rec1 ;Sample index record structure
index_key ,a50 ; Index part
rec_num ,d5 ; Pointer part
,a1 ; Record Terminator
record idx_rec, X ;Sample index record structure
idxrec ,a55 ; Data only
record ;For binary search
first ,d5
last ,d5
saved ,d5
proc
; Do necessary search operation on the a_keyval and a_keyref
if (.not.%passed(a_keyval)) then ;Sequential read on keyref
call do_seq
else if (a_keyval.eq.' ') then ;Initial read on keyref
call do_seq
else
call do_random
a_recnum = rec_num + 1 ;Increment by one for control record
xreturn
do_seq,
do
reads(a_chn, idx_rec) [eof=nofind, err=errexit]
until (idx_rec.ne.']' .and. index_key.ne.' ')
return
do_random,
; Do sequential search or binary search
if (.not.%passed(a_reccnt)) then ;Sequential search
do forever
begin
reads(a_chn, idx_rec) [eof=nofind, err=errexit]
if (index_key.eq.a_keyval)
return
end
else ;Do binary search
begin
recnum = a_reccnt / 2 ;Initialize the indexes
first = 1
last = a_reccnt
do forever
begin
saved = recnum ;Save last middle index
get(a_chn, idx_rec1, recnum) [eof=nofind, err=errexit]
if (index_key.eq.a_keyval) then ;Found
return
else if (recnum.eq.first .or. recnum.eq.last) then ;Not found
goto nofind
else if (index_key.gt.a_keyval) then ;Try left half
begin
if ((last-recnum).eq.1) then ;No middle item set to first
decr recnum
else ;Set the next middle index
recnum = recnum - (last-recnum) / 2
last = saved
end
else ;Try right half
begin
if ((last-recnum).eq.1) then ;No middle item set to last
incr recnum
else ;Set the next middle index
recnum = recnum + (last-recnum) / 2
first = saved
end
end
end
return
nofind,
a_sts = DD_IO_NOFIND
xreturn
errexit,
a_sts = DD_IO_ERROR
xreturn
end
