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 = 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