This is a more sophisticated Open Access handler program than the one included in the earlier example that allows a CSV file to be read using a conventional READ op-code with no need to use IFS APIs or to use utilities to copy the data from the CSV form to a temporary database file. The major addition in this version is the ability to use column headings in the CSV file to supply the column names. In addition the sequence of the data in the CSV does not have to match that in the physical file.
The article that explains the whole proces can be found here
Here you can find the source files for the CSV data file (IFSDATA1) that is used in the example. The main source file for the handler (IFSINPHND2), and the test program from the article (IFSINPTST2). The /Copy file used to define the IFS control (IFS_CPY2) parameter is shown here
DDS for CSV "File" IFSDATA1's layout
A R IFSDATAR1
A ZONED5_0 5S 0
A ZONED5_2 5S 2
A PACKED7_2 7P 2
A CHAR80 80A
A DATEUSA L DATFMT(*USA)
Copy File IFS_CPY2's content
// COPY file defining the additional HANDLER parameter used to allow
// the RPG program to pass the IFS path to the handler
// Also contains constants used in the I/O routines
/if defined(IFS_CPY2_COPIED)
/eof
/endif
/define IFS_CPY2_COPIED
D ifs_hdlr_info_t...
D ds qualified template
D fieldDelim 1a
D stringDelim 1a
D headerRow n
D failOnError n
D path 5000a varying
D comma c ','
D doubleQuote c '"'
Handler Program IFSINPHND2
// This handler takes as input a delimited file and parses out the
// individual fields which it then returns to RPG
//
// This version provides the following options:
//
// 1: The ability to specify that the input file contains a header row
// containing the field names names in the file.
// - If a field requested by the RPG program has no match then it is set
// to its default value.
// - If the header row is omitted then the fields are assumed to be
// in the same sequence in both files and no errors are genrated.
//
// 2: The ability to determine if errors should simply be reported (default)
// or cause the read operation to fail. Errors in this context include
// fields that are included in the delimited file but not requested by RPG.
//
// 3: Ability to specify the field delimiter character (defaults to comma)
// and the character string delimiter (defaults to double-quote)
//
// Future extensions and limitations:
//
// Currently assumes dates in the delimited file to be in *MDY format.
// Could add the ability to specify the format.
// Currently limited to 256 field in the record, 1024 characters maximum
// in each of those fields.
// If field names exceed 10 characters the program only uses the first 10.
//
// Credits:
// The handler uses Scott Klement's CSVR4 Service Program to
// perform the parsing of the IFS input records. As part of the process,
// Scott's code strips any quotes from around character strings.
H DftActGrp(*No) Option(*NoDebugIO: *SrcStmt) BndDir('CSV')
// Standard IBM supplied Open Access definitions
/copy OASAMPSRC,qrnopenacc
// Definition of additional handler parameter and constants
/copy OASAMPSRC,ifs_cpy2
// RPG Status code values
/copy OASAMPSRC,monstatcds
// Protos for the CSVR4 Service Program procedures
/copy OASAMPSRC,CSV_H
// On V7 and later systems most PRs can be removed
D IFSINPHND2 Pr ExtPgm('IFSINPHND2')
D info likeds(QrnOpenAccess_T)
// Definition for local subprocedure
D readFile Pr
D handle like(fileHandle) value
D LoadHeaderRow Pr
D handle Like(fileHandle) value
D IFSINPHND2 PI
D info likeds(QrnOpenAccess_T)
// Error status (i.e. RPG error status)
D errStatus s Like(info.rpgStatus)
// Field Names/Values structures
D namesValues ds likeds(QrnNamesValues_T)
D based(pnamesValues)
// Structure to map the "additional information" parameter passed
// by the RPG program. It contains processing options plus the IFS file name.
// Its pointer is contained within the userArea field in the info struct
D ifs_info ds likeds(ifs_hdlr_info_t)
D based(pIfs_info)
// Used by the IFS routines to determine which IFS file is to be used
// and the column names etc. that map to the CSV fields.
// Maps to storage dynamically allocated when opening the file.
// Pointer is stored in the stateInfo field in the info structure
(1) D stateInfo ds based(pstateInfo)
(2) D fileHandle *
// Count of number of active entries in entries array
// Storage for field names and their sequence in the delimited file
(3) D fieldCount 5u 0
(4) D entries Dim(256) Ascend
D name 10a Varying Overlay(entries)
D sequence 5u 0 Overlay(entries: *Next)
// Data from each field in the delimited file is stored here and
// indexed from the fields DS array above
D fieldContent s 1024a Varying Dim(256)
/free
// Use the pointers in the info area to set up access to the
// the state info i.e. field names and IFS handle. (stateInfo)
// and the IFS file information (userArea)
pstateInfo = info.stateInfo;
pIfs_info = info.userArea;
If info.rpgOperation = QrnOperation_READ;
// Set up access to Name/Value information and read file
pnamesValues = info.namesValues;
readFile(fileHandle);
elseIf info.rpgOperation = QrnOperation_OPEN;
// Specify that we want to use Name/Value information
info.useNamesValues = *On;
// Allocate the storage for the file handle and store the pointer
// in the info area. That way RPG can associate the pointer with
// the specific file and give it back to us on each operation.
pstateInfo = %Alloc(%Size(stateInfo));
info.stateInfo = pstateInfo;
// Ensure that file handle is zero before attempting open()
clear fileHandle;
// Set CSV delimiter values to defaults if not supplied
If ifs_info.fieldDelim = *Blank;
ifs_info.fieldDelim = comma;
EndIf;
If ifs_info.stringDelim = *Blank;
ifs_info.stringDelim = doubleQuote;
EndIf;
// Good to go so we can now open the file. We use all four
// parmaeters since we have set our own defaults
fileHandle = CSV_open(ifs_info.path :
ifs_info.stringDelim :
*Omit :
ifs_info.fieldDelim );
if fileHandle = *Null;
info.rpgStatus = errImpOpenClose; // Open failed
else;
If ifs_info.headerRow; // process header row if supplied
LoadHeaderRow(fileHandle);
EndIf;
EndIf;
elseif info.rpgOperation = QrnOperation_CLOSE;
csv_close(fileHandle);
// free the state information and null out the info pointer
dealloc(n) pstateInfo;
info.stateInfo = *null;
else;
// Any other operation is unsupported so notify RPG
info.rpgStatus = 1299; // general error status
endif;
Return;
/end-free
P LoadHeaderRow b
D pi
D handle Like(fileHandle) value
D fieldNumber s 5u 0
/free
// Load the first record - returns true if record found
If (CSV_loadrec (handle));
fieldNumber = 1;
// Now process field names header record storing field names and position
(A) DoW CSV_getfld(handle:
name(fieldNumber):
%size(name));
(B) sequence(fieldNumber) = fieldNumber;
fieldNumber += 1;
// Make sure that we don't have too many fields and error if we do
(C) If fieldNumber > %Elem(name);
dsply ('Too many fields - current limit is '
+ %Char(%Elem(name)));
info.rpgStatus = errImpOpenClose; // Open failed
Return;
EndIf;
EndDo;
// Store number of actual field headers found
(D) fieldCount = fieldNumber - 1;
// All field headers loaded - sort the header entries into sequence
(E) SortA %SubArr(name: 1: fieldCount);
Else; // No header row found - issue message and fail open.
dsply ('File is empty - no header row found');
info.rpgStatus = errImpOpenClose; // Open failed
EndIf;
/End-Free
P LoadHeaderRow e
// Subprocedure ReadFile()
// Reads record from CSV file and sets up the field values in
// the RPG name/value area
P readFile b
D pi
D handle Like(fileHandle) value
D fieldLen s 10u 0
D i s 5u 0
D csvEOF s n
D fieldNumber s 5u 0
D value s 32470a Based(pvalue)
D tempCharDate s 10a
/free
// Read the next record - set EOF and exit when all read
If Not (CSV_loadrec (handle));
info.eof = *On; // Set eof flag - no more records to process
Return;
EndIf;
info.eof = *Off; // Clear eof flag
// Load the next record into the data storage table
fieldNumber = 1;
// Get the data for all fields from the CSV
(F) DoW CSV_getfld(handle:
fieldContent(fieldNumber):
%size(fieldContent));
fieldNumber += 1;
EndDo;
// Process all of the requested input fields
For i = 1 to namesValues.num;
// Set up pointer to field buffer area
pvalue = namesValues.field(i).value;
If ifs_Info.headerRow; // If file had a header row look up the field name
(G) fieldNumber = %Lookup(namesValues.field(i).externalName :
name :
1 :
fieldCount);
// If no header then just process fields in sequence by setting up the
// field number and data sequence to match
(H) Else;
fieldNumber = i;
sequence(i) = i;
EndIf;
If fieldNumber > 0;
// If we have field data determine the length to use and load
// the data into the buffer.
If %Len(fieldContent(sequence(fieldNumber)))
> namesValues.field(i).valueMaxLenBytes;
namesValues.field(i).valueLenBytes
= namesValues.field(i).valueMaxLenBytes;
Else;
namesValues.field(i).valueLenBytes
= %Len(fieldContent(sequence(fieldNumber)));
EndIf;
// Validate and Convert format of date field if required
If namesValues.field(i).dataType = QrnDatatype_Date;
namesValues.field(i).valueLenBytes = 10; // *USA date is 10 long
// Date ops don't always like varying fields
tempCharDate = fieldContent(sequence(fieldNumber));
Test(DE) *MDY tempCharDate;
If Not %Error; // Date is good so convert it and place in buffer
%Subst(value: 1: namesValues.field(i).valueLenBytes)
= %Char(%Date(tempCharDate: *MDY) : *USA);
Else; // Date is in error - report and then either use today's date
// or tell RPG to terminate the program
dsply ('Invalid *MDY date "' + tempCharDate + '" in field '
+ namesValues.field(i).externalName);
If ifs_Info.failOnError;
info.rpgStatus = errInvalDate; // report invalid date to RPG
Else; // Otherwise set the date to the default
%Subst(value: 1: namesValues.field(i).valueLenBytes)
= %Char(%Date() : *USA);
EndIf;
Return; // Done with date processing
EndIf;
// Non-date fields
Else;
%Subst(value: 1: namesValues.field(i).valueLenBytes)
= fieldContent(sequence(fieldNumber));
EndIf;
(I) Else;
namesValues.field(i).valueLenBytes = 0;
dsply ('No value found for field '
+ namesValues.field(i).externalName);
(J) If ifs_Info.failOnError;
info.rpgStatus = errInpMisMatch; // report error to RPG
Return; // return to allow RPG to handle error
Else;
(K) namesValues.field(i).valueLenBytes = 0;
EndIf;
EndIf;
// Make sure that numeric fields are not returned to RPG as zero length
If ((namesValues.field(i).valueLenBytes = 0) And (
(namesValues.field(i).dataType = QrnDatatype_Decimal)
Or (namesValues.field(i).dataType = QrnDatatype_Integer)
Or (namesValues.field(i).dataType = QrnDatatype_Unsigned)
Or (namesValues.field(i).dataType = QrnDatatype_Float)));
// Numeric field with no data - Set value to zero and length to 1
%Subst(value: 1: 1) = *Zero;
namesValues.field(i).valueLenBytes = 1;
EndIf;
EndFor;
Return;
/end-free
P readFile e
Program IFSINPTST2 - Test Program from the Extra Article.
H dftactgrp(*no) option(*NoDebugIO : *SrcStmt)
FIFSDATA1 IF E Disk Handler('IFSINPHND2' : ifs_info)
F UsrOpn
FQSYSPRT O F 132 PRINTER
// Copy in definition of the additional IFS data (path)
/copy OASAMPSRC,ifs_cpy2
// Define IFS file name etc. based on the template
D ifs_info ds likeds(ifs_hdlr_info_t) Inz
/free
// Set up IFS path name and parms then open file
ifs_info.path = '/Partner400/IFS_INP2.csv';
ifs_info.headerRow = *On; // File contains a header row
// This is also where you would set the field and string delimiters if
// you wanted values other than the defaults. e.g.
// ifs_info.failOnError = *On; <=== Fail on errors
// ifs_info.fieldDelim = '|'; <==== Use the pipe character as field delim
// ifs_info.stringDelim = ''''; <== Use single quote as string delimiter
Open IFSDATA1;
Read IFSDATA1;
DoW not %eof(IFSDATA1);
Except showData;
Read IFSDATA1;
EndDo;
*inlr = *On;
/End-Free
OQSYSPRT E ShowData 1
O zoned5_0 10
O zoned5_2 20
O packed7_2 30
O dateUSA 45
O char80 132
Want more
information?
Got a question or comment about the site?
Please feel free to Contact
Us at any time.}