Supporting user‑defined file types

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 = %len(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 = %len(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)  ;Not found
            goto nofind
          else if (index_key.gt.a_keyval)   ;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