|
Hi Brigitta Yes that is what we basically want to do. When you say pass the procedure pointer could you expand your explication Thanks again Paul -----Message d'origine----- De : rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx] De la part de rpg400-l-request@xxxxxxxxxxxx Envoyé : mercredi 25 mai 2005 13:34 À : rpg400-l@xxxxxxxxxxxx Objet : RPG400-L Digest, Vol 4, Issue 568 Send RPG400-L mailing list submissions to rpg400-l@xxxxxxxxxxxx To subscribe or unsubscribe via the World Wide Web, visit http://lists.midrange.com/mailman/listinfo/rpg400-l or, via email, send a message with subject or body 'help' to rpg400-l-request@xxxxxxxxxxxx You can reach the person managing the list at rpg400-l-owner@xxxxxxxxxxxx When replying, please edit your Subject line so it is more specific than "Re: Contents of RPG400-L digest..." Today's Topics: 1. RE Variable Procedure Names (Hauser, Birgitta) 2. RE: Help improve performance of RPG program - Long Post (Wilt, Charles) ---------------------------------------------------------------------- message: 1 date: Wed, 25 May 2005 13:18:44 +0200 from: "Hauser, Birgitta" <Birgitta.Hauser@xxxxxxxxxxx> subject: RE Variable Procedure Names Hi Paul, >>The prototype would be the same in all cases but the idea was to retrieve the name of the procedure from a >>application parameter as we do with dynamically called programs. Does this mean, you want to pass the "procedure" name as parameter from an other program and execute this procedure? If so, you have can pass the procedure pointer as parameter. But somewhere (in the preceeding procedures) the procedure pointer must be hard coded. Example: 1. Prototypes *-----------------* D CvtDate PR 10A ExtProc(MyProcPtr) D ParmDate D const options(*NoPass) D MyProcPtr S * ProcPtr D CvtDateProcPtr PR 10A D ParmProcPtr * ProcPtr 2. Procedure ************************************************************ * Convert Date using Procedure Pointers as parameters ************************************************************ P CvtDateProcPtr B Export D CvtDateProcPtr PI 10A D ParmProc * ProcPtr D ParmDate D const options(*NoPass) *----------------------------------------------------------- /Free MyProcPtr = ParmProc; If %Parms >= 2; Return CvtDate(ParmDate); else; Return CvtDate(); EndIf; /End-Free P CvtDateProcPtr E 3. Call Procedure *-----------------* /Free Select; When Country = 'DE'; MyProcPtr = %PAddr('CVTDATEUR'); When Country = 'USA'; MyProcPtr = ConstProcUSA; When Country = 'JPN'; MyProcPtr = ConstProcJIS; EndSL; MyCharDate = CvtDateProcPtr(MyProcPtr: MyDate); Dsply MyCharDate; /End-Free Birgitta Mit freundlichen Gren i.A. Birgitta Hauser LUNZER + PARTNER GMBH Unternehmensberatung Carl-Zeiss-Strae 1 63755 Alzenau Tel: + 49 6023 951-255 Fax: + 49 6023 951-111 Internet. www.lp-gmbh.com www.rpg-schulung.de ------------------------------ message: 2 date: Wed, 25 May 2005 07:33:37 -0400 from: "Wilt, Charles" <CWilt@xxxxxxxxxxxx> subject: RE: Help improve performance of RPG program - Long Post Rich, I also recommend that you write directly to the IFS. In addition, you might want to consider replacing the native RPG I/O to InFile with embedded SQL. Just make sure you FETCH more than 1 row at a time. I'd recommend at fetching at least 100 rows if not more. Charles Wilt iSeries Systems Administrator / Developer Mitsubishi Electric Automotive America ph: 513-573-4343 fax: 513-398-1121 > -----Original Message----- > From: rpg400-l-bounces@xxxxxxxxxxxx > [mailto:rpg400-l-bounces@xxxxxxxxxxxx]On Behalf Of Rich Dotson > Sent: Tuesday, May 24, 2005 4:35 PM > To: rpg400-l@xxxxxxxxxxxx > Subject: Help improve performance of RPG program - Long Post > > > I have a program that we use to create export files that > are ftp*d to our > data warehouse application. The program works great > functionally but we > would like to improve the performance on files that have a > lot of fields > and a lot of records (500,000+). > > The program specs were: > > 1) Must be *generic* enough to process, without > modification, any file on > our iSeries. > > 2) First row of file must contain: > a) File Name > > b) Number of fields in file > > c) Number of Records in the file > > d) Last G/L posting date > > 3) Second row of the file must contain the field names > > 4) Subsequent rows will be the data > > > > A sample of the first three rows would look like: > > "XAT90090",5,1297,05/22/2005 > > "EFFDATE","APPLCD","ACCTNO","ACCTTYP","TRANAMT" > > 05/19/2005,20,1234567890,1,-190.78 > > 4) All dates must be in MM/DD/CCYY format. For this I > created a file > (XAP10005L1) that contains the fields that contain dates > and the format > that they are in: a) File Name b) Date Field Name c)Stored Date > Format (*LongJul, *MDY, *JUL, *YMD, etc..) When > processing a field I > check this file to see if it is a date field and reformat > it if it is. > > 5) Only the fields that the user selects should appear in > the export > file. The way I solved this issue is if the user does > not want all the > fields in the data file, I created another PF DDS > containing only the > desired fields. I pull the data from one file based on > the fields this > *template* file. > > I*ve borrowed a lot of code from this mail list and other > web sites and > pieced together the following program. > > Any suggestions on how it may be changed to improve the > performance would > be greatly appreciated. > > Thanks, Rich* > > > > H DftActGrp(*NO) BndDir('QC2LE':'OSBBNDDIR') > H OPTION(*NODEBUGIO: *NOSHOWCPY: *SRCSTMT) > * > *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* > ^1* Generic File to process desired data > FInFile IF F32766 Disk > ExtFile(InputFile) UsrOpn > F InFDS(FileInFDS) > ^1* Field Date Format File > FXAP10005L1IF E K Disk > ^1* FTP Output File > FFTPOutput O A F32766 Disk > ExtFile(OutputFile) UsrOpn > e* Prototype > D Entry PR ExtProc('XA90060') > D FileName 10A > D LibName 10A > D DDSName 10A > D DDSLib 10A > D Colum_Sep 1A > D Alpha_Sep 1A > D CBSName 10A > e* Prototype > D Entry PI > D FileName 10A > D LibName 10A > D DDSName 10A > D DDSLib 10A > D Colum_Sep 1A > D Alpha_Sep 1A > D CBSName 10A > ^1* Define the INTERNAL prototypes (Subroutines) used > in this program > D CloseSQLCursor PR > D DeclareCursor PR > D GetData PR > D GetFieldCount PR > D GetFieldDef PR > D IncludeInFile PR N > D inFieldName Like(FldName) CONST > D SetSQLOptions PR > D ValidSQLRecord PR N > D WriteHeaderRec PR > D WrtFieldNames PR > ^1* Define the EXTERNAL prototypes used in this program > /COPY *LIBL/QOSBCPYSRC,SC9000PR > /COPY *LIBL/QOSBCPYSRC,TA9000PR > /COPY *LIBL/QOSBCPYSRC,XA1001PR > /COPY *LIBL/QOSBCPYSRC,XA10006PR > e* Procedure to get extract a NUMBER from a STRING > D FmtNumber PR 50A Varying > D NbrValue 50A Varying CONST > D DecPos 3 0 CONST > e* Procedure to change the file date to 'MM/DD/CCYY' format > D FormatDate PR 10A Varying > D inFormat Like(XAPDateF) CONST > ^1* Input File Data Structure > DFileInFDS DS > D RecordCount 156 159B 0 > ^1* Data Structure to hold Date Fields > ^1* Work Fields > D CurrentUserId S 10A Inz(*User) > D DataPtr S * > D FieldCount S 9 0 > D FieldDSLen S 9 0 Inz(%Len(FieldDS)) > D FieldDSPtr S * Inz(*Null) > D FldIdxPtr S * > D FTPField S 32766A Inz Varying > D i S 9 0 Inz(0) > D InputFile S 21A Inz > D LastPostDate S 7P 0 Inz > D Offset S 9 0 Inz(0) > D OutputFile S 21A Inz('QTEMP/DB2EXPORT') > D SQLCommand S 256A Varying Inz > D AlphaFld S 256A Varying Inz > D NumberFld S 31 15 Inz > D File S Like(FileName) Inz > D Lib S Like(LibName) Inz > ^1* This DS will contain the data being read into the program > D DataRecord DS 32766 > ^1* This DS is used to contain the Field Information > for the record > D FieldDS DS Based(FldIdxPtr) > D FldNumber 10 0 > D FldName 10 > D TblName 10 > D Schema 10 > D FldType 10 > D FldLen 10I 0 > D FldDecPos 3 > D FldBytes 10I 0 > D FldOffset 10I 0 > D FldDateFmt Like(XAPDateF) > D FldExportFlg 1A > C > /Free > > > //^1*----------------------------------------------------------------- > //^1*aM A I N L I N E R O > U T I N > E > > > //^1*----------------------------------------------------------------- > //^1Get the Last Posting Date > LastPostDate = GetLastPostDte( > RtvBankDefault(CurrentUserId) ); > //^1Combine the Library and file to look like > 'LIBNAME/FILENAME' > LibName = toUpper(LibName); > FileName = toUpper(FileName); > InputFile = %Trim(LibName) + '/' + %Trim(FileName); > //^1Make sure the file names are in UPPER case > DDSName = toUpper(DDSName); > CBSName = toUpper(CBSName); > //^1Open the files to process > Open InFile; > Open FTPOutput; > //^1Count the # of fields in the file containing > the fields to > export > File = DDSName; > Lib = DDSLib; > GetFieldCount(); > //^1Write File Header Record > WriteHeaderRec(); > //^1Count the # of fields in the file containing the data to > process > File = FileName; > Lib = LibName; > GetFieldCount(); > //^1Retrieve Field Definitions > GetFieldDef(); > //^1Write a record containing the Field Names > WrtFieldNames(); > //^1Read the input file into the DS for processing > DoU %EOF(InFile); > Read InFile DataRecord; > If %EOF(InFile); > Leave; > EndIf; > //^1Strip out each field from the Data Structure > GetData(); > EndDo; > //^1Close the files > Close InFile; > Close FTPOutput; > *InLR = *On; > /End-Free > > ^1*----------------------------------------------------------------- > ^1*a O U T P U T S P E C S > > ^1*----------------------------------------------------------------- > OFTPOutput EADD WriteRec > O FTPField > > *===================================================================== > *aGetFieldDef: Get the definitions of the fields in this file > > *===================================================================== > P GetFieldDef B > /Free > //^1Alloc Storage to hold FieldDS for Each Column > in the Table > FieldDSPtr = %Alloc(FieldDSLen * FieldCount); > //^1Set the pointer to the first "Occurance" of FieldDS in > //^1 the allocated Storage > FldIdxPtr = FieldDSPtr; > //^1Clearing the Data structure will init the fields in the > FieldDS > //^1data structure and avoid data decimal errors > Clear FieldDS; > //^1Build a cursor containing the list of columns > (fields) in the > //^1file that is being exported. > DeclareCursor(); > //^1Read all the records from the SQL Cursor > //^1and place the data into FieldDS > DoW ValidSQLRecord(); > //^1Determine if this field is a date field > Chain (FileName : FldName) XAP10005L1; > If %Found( XAP10005L1 ); > FldDateFmt = XAPDateF; > EndIf; > //^1Determine the offset to the beginning of the field > FldOffset = Offset; > //^1Determine the field should be included in > the export file > //^1(All fields may not be exported to the Data > Warehouse) > FldExportFlg = 'Y'; > If Not IncludeInFile(FldName); > FldExportFlg = 'N'; > EndIf; > //^1If this is not the last column in the table, > calculate > //^1 the next offset and advance the pointer to the next > //^1 "occurrence" of FieldDs in the allocated storage. > If FldNumber <> FieldCount; > Offset = Offset + FldBytes; > FldIdxPtr = FieldDSPtr + (FieldDSLen * FldNumber); > Clear FieldDS; > EndIf; > EndDo; > CloseSQLCursor(); > /End-Free > P GetFieldDef E > > *===================================================================== > *aGetData: Get the data from the input record > > *===================================================================== > P GetData B > D AlphaFld S 256A Varying Inz > D DataType S 1A Inz > /Free > //^1Set the pointer to the Field Description Data Structure > FldIdxPtr = FieldDSPtr; > //^1Set the Data Pointer to the beginning of the > data record > DataPtr = %Addr(DataRecord); > //^1Clear the FTP Output field > Clear FTPField; > //^1Read each field and move it from the input > record to output > For i = 1 to FieldCount; > Select; > //^1Skip this field because it is not in the export file > When FldExportFlg = 'N'; > //^1This is a DATE field so reformat it to MM/DD/CCYY > When Not (FldDateFmt = *Blanks); > FTPField += FormatDate(FldDateFmt); > //^1This is a CHARACTER field move it to the > FTP output field > When FldType = 'CHAR'; > AlphaFld = %Trim(%SubSt(DataRecord : FldOffset+1 : > FldBytes)); > //^1If there is something in the alpha field > If %Len(%Trim(AlphaFld)) > 0; > //^1Remove any quotes (") or commas (,) > from the field > AlphaFld = %Trim(%XLate('"' : '''' : AlphaFld)); > FTPField += Alpha_Sep + AlphaFld + Alpha_Sep; > EndIf; > //^1Extract the ZONED or PACKED data from the > input buffer > When FldType = 'NUMERIC' or FldType = 'DECIMAL'; > If FldType = 'NUMERIC'; > DataType = 'S'; > Else; > DataType = 'P'; > EndIf; > AlphaFld = CvtNumFmt(%SubSt(DataRecord : > FldOffset+1 : > FldBytes) : > DataType : > %Uns(FldLen) : > %Uns(FldDecPos) : > 'S' ); > FTPField += FmtNumber(%SubSt(AlphaFld : > 1 : > FldLen) : > %Int(FldDecPos) ); > //^1Define other field types here > Other; > EndSL; > //^1If this is not the last field and the prior field was > //^1exported to the FTP file, add the Column Separator > If i < FieldCount and FldExportFlg = 'Y'; > FTPField += Colum_Sep; > EndIf; > //^1Position to the next Field Definition in the DS > FldIdxPtr += FieldDSLen; > EndFor; > //^1Write the FTP Record to the output file > Except WriteRec; > /End-Free > P GetData E > > *================================================================ > *aSetSQLOptions: Insure the SQL options are set correctly > > *================================================================ > P SetSQLOptions B > C/EXEC SQL > + Set Option > + Commit = *NONE, > + CloSqlCsr = *ENDMOD > C/END-EXEC > P SetSQLOptions E > > *===================================================================== > *aDeclareCursor: Declare the SQL cursor used to > retrieve field defs > > *===================================================================== > P DeclareCursor B > ^1* Build the list of columns in the Table > C/Exec SQL > + Declare FileLayout Cursor for > + SELECT ORDINAL_POSITION, > + Char(COLUMN_NAME,10), > + Char(TABLE_NAME,10), > + Char(TABLE_SCHEMA,10), > + Char(DATA_TYPE,10), > + LENGTH, > + Char(IfNull(Char(NUMERIC_SCALE),' '),3), > + STORAGE,0,' ',' ' > + FROM SYSCOLUMNS > + WHERE Table_Schema = :LibName > + AND Table_Name = :FileName > + ORDER BY ORDINAL_POSITION > C/End-Exec > ^1* Open the Cursor > C/Exec SQL > + Open FileLayout > C/End-Exec > P DeclareCursor E > > *================================================================ > *aValidSQLRecord: Fetch the next record from the SQL cursor > > *================================================================ > P ValidSQLRecord B Export > ^1* Procedure Interface > D ValidSQLRecord PI 1N > C/EXEC SQL > + Fetch from FileLayout into :FieldDS > C/END-Exec > C Return (%SubSt(SQLStt:1:2)='00' or > C %SubSt(SQLStt:1:2)='01') > P ValidSQLRecord E > > *================================================================ > *aCloseSQLCursor: Close the SQL Cursor > > *================================================================ > P CloseSQLCursor B > C/Exec SQL > + Close FileLayout > C/End-Exec > P CloseSQLCursor E > > *============================================================= > ========= > *aIncludeInFile: Check to see if the field should be > included in > export > > *============================================================= > ========= > P IncludeInFile B Export > ^1* Procedure Interface > D IncludeInFile PI 1N > D inFieldName Like(FldName) CONST > D f S 3P 0 Inz > C Clear f > C/EXEC SQL > + SELECT Count(*) INTO :f > + FROM SYSCOLUMNS > + WHERE Table_Schema = :DDSLib > + AND Table_Name = :DDSName > + AND COLUMN_NAME = :inFieldName > C/END-Exec > C Return (f > 0) > P IncludeInFile E > > *================================================================ > *aGetFieldCount: Get the # of fields in the file > being processed > > *================================================================ > P GetFieldCount B > C/Exec SQL > + SELECT Count(*) INTO :FieldCount > + FROM SYSCOLUMNS > + WHERE Table_Schema = :Lib > + and Table_Name = :File > C/End-Exec > P GetFieldCount E > > *===================================================================== > *aWriteHeaderRec: Write the FTP File Header Record > > *===================================================================== > P WriteHeaderRec B > /Free > FTPField = Alpha_Sep + %Trim(CBSName) + Alpha_Sep > + Colum_Sep + > %Trim(%EditC(FieldCount : '3')) > + Colum_Sep + > %Trim(%EditC(RecordCount : '3')) > + Colum_Sep + > %Char(%Date() - %Days(1) : *USA); > Except WriteRec; > /End-Free > P WriteHeaderRec E > > *===================================================================== > *aWrtFieldNames: Write the field names to the output record > > *===================================================================== > P WrtFieldNames B > /Free > //^1Set the first Field Description Data Structure > FldIdxPtr = FieldDSPtr; > //^1Clear the output field > Clear FTPField; > //^1Add each field name to the end of the output field > For i = 1 to FieldCount; > If FldExportFlg = 'Y'; > FTPField += Alpha_Sep + %Trim(FldName) + Alpha_Sep + > Colum_Sep; > EndIf; > //^1Position to the next Field Definition in the DS > FldIdxPtr += FieldDSLen; > EndFor; > //^1Remove the Column Separator from the end of the record > FTPField = %SubSt(FTPField : 1 : %Len(FTPField) - 1); > Except WriteRec; > /End-Free > P WrtFieldNames E > > *===================================================================== > *aFmtNumber: Format a Number that is in a string > > *===================================================================== > P FmtNumber B > e* Prototype > D FmtNumber PI 50A Varying > D inNbrValue 50A Varying CONST > D inDecPos 3 0 CONST > *^1Define Local Work Fields > D DecPos S Like(inDecPos) > D IntIsNegative S N Inz(*Off) > D NbrValue S Like(inNbrValue) Inz > D Number S 50A Varying Inz > D ValidChars C '1234567890- ' > D n S 31 15 Inz > D x S 5P 0 Inz > /FREE > NbrValue = inNbrValue; > DecPos = inDecPos; > //^1The negative sign is stored as an alpha character > IntIsNegative = %Check('0123456789':%TrimR(NbrValue)) > 0; > //^1Convert the negative character to its > corresponding numeric > value > NbrValue = %XLate('}JKLMNOPQR' : '0123456789' : NbrValue); > //^1The number has decimal positions > If DecPos > 0; > n = %Int(NbrValue); > For x = 1 to DecPos; > n /= 10; > EndFor; > Number = %SubSt(%Trim(%EditC(n : 'L')) : 1 : > (%CheckR(ValidChars : %Trim(%EditC(n : > 'L')))+DecPos)); > Else; > //^1The number does not have any decimal positions > Number = %Trim(%EditC(%Dec(NbrValue:31:0):'L')); > EndIf; > If IntIsNegative; > Number = '-' + %Trim(Number); > EndIf; > If %Len(Number) < 1; > Number += '0'; > EndIf; > Return Number; > /END-FREE > P FmtNumber E > > *===================================================================== > *aFormatDate: Format the date field into MM/DD/CCYY format > > *===================================================================== > P FormatDate B > e* Prototype > D FormatDate PI 10A Varying > D FromFormat Like(XAPDateF) CONST > *^1Define Local Work Fields > D NumericDate S 8S 0 Inz > /FREE > //^1Extract the Date from the input buffer > If FldType = 'NUMERIC'; > NumericDate = ZonedToInt(DataPtr+FldOffset:FldLen:0); > ElseIf FldType = 'DECIMAL'; > NumericDate = PackedToInt(DataPtr+FldOffset:FldLen:0); > EndIf; > //^1Convert the NumericDate to an alpha MM/DD/CCYY field > Monitor; > Select; > When NumericDate = *Zeros; > RETURN ''; > When FromFormat = '*MDY'; > RETURN %Char(%Date(NumericDate : *MDY):*USA); > When FromFormat = '*DMY'; > RETURN %Char(%Date(NumericDate : *DMY):*USA); > When FromFormat = '*YMD'; > RETURN %Char(%Date(NumericDate : *YMD):*USA); > When FromFormat = '*JUL'; > RETURN %Char(%Date(NumericDate : *JUL):*USA); > When FromFormat = '*LONGJUL'; > RETURN %Char(%Date(NumericDate : *LONGJUL):*USA); > When FromFormat = '*USA'; > RETURN %Char(%Date(NumericDate : *USA):*USA); > Other; > RETURN ''; > EndSL; > On-Error; > RETURN ''; > EndMon; > /END-FREE > P FormatDate E > > > ---------------------------------------------------------------------- > > Find just what you're after with the new, more precise MSN > Search - try it > now! > -- > This is the RPG programming on the AS400 / iSeries (RPG400-L) > mailing list > To post a message email: RPG400-L@xxxxxxxxxxxx > To subscribe, unsubscribe, or change list options, > visit: http://lists.midrange.com/mailman/listinfo/rpg400-l > or email: RPG400-L-request@xxxxxxxxxxxx > Before posting, please take a moment to review the archives > at http://archive.midrange.com/rpg400-l. > > ------------------------------
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
