Join Network
Categories
RPG Open--Bob Cozzi's New Open-Source Library v1.0
Article ID: 58593
Posted November 5th, 2009
A few weeks ago I mentioned that I was going to create an open-source add-on library for RPG IV. This "library" is nothing more than a service program filled with subprocedures. The "filled" part is coming, but for now I've installed a few subprocedures to get us started. RPG Open is completely free and includes the source code and a build routine (CL program) to recompile it on your system.
RPG Open v1.0
Included in this release of RPG Open is only a few subprocedures. This was done to get the package out there now, so I've included subprocedures that perform simple, everyday tasks; tasks that most RPG IV Programmers need in most programs they work with.
- Joblog - Write to the joblog
- iComp - Compare and ignore upper/lower case
- ConCat - Concatenate multiple strings
JOBLOB--Write to the Joblog
You've already seen this subprocedure if you're an RPG Coder reader or own RPG xTools (now RPGLIB) or attended my sessions at RPG World. JOBLOG simply writes an impromptu message to the joblog and lets you insert substitution values. Those substitution values must be character (not numeric, so use %CHAR if necessary) and you can specify up to 8 values--although since you have the code, adding a few more if necessary should be easy enough. Here's the code:
H NOMAIN OPTION(*NODEBUGIO:*SRCSTMT)
H Copyright('RPG OPEN - (c) 2009 Robert Cozzi, Jr. All rights reserved.')
/IF NOT DEFINED(*V6R1M0)
H BNDDIR('QC2LE')
/ENDIF
/INCLUDE RPGOPEN/QCPYSRC,joblog
P Joblog B EXPORT
******************************************************
** Write a text message with optional substitution
** values to the joblog.
** e.g., joblog('Customer %s not found.':%char(custno))
******************************************************
D Joblog PI
D pMsg * value OPTIONS(*STRING)
D pS1 * value OPTIONS(*STRING : *NOPASS)
D pS2 * value OPTIONS(*STRING : *NOPASS)
D pS3 * value OPTIONS(*STRING : *NOPASS)
D pS4 * value OPTIONS(*STRING : *NOPASS)
D pS5 * value OPTIONS(*STRING : *NOPASS)
D pS6 * value OPTIONS(*STRING : *NOPASS)
D pS7 * value OPTIONS(*STRING : *NOPASS)
D pS8 * value OPTIONS(*STRING : *NOPASS)
/free
Qp0zLprintf(pMsg:pS1:pS2:pS3:pS4:pS5:pS6:pS7:ps8);
Qp0zLprintf(X'25');
return;
/end-free
P Joblog E
To use this, include the JOBLOG source member (just like I did in the source above) and then specify the BNDDIR('RPGOPEN/RPGOPEN') binding directory in your Header specification. Then simply call it whenever you want to write out to the joblog. For example:
H BNDDIR('RPGOPEN/RPGOPEN')
/INCLUDE RPGOPEN/QCPYSRC,joblog
/free
if (arrayIndex <= 0);
joblog('Array index %s not valid.':%char(arrayIndex));
endif;
/end-free
Note the use of the %s in the text string. This indicates where the substitution value will be inserted. Each %s corresponds to a subsequent value. For example, if you had 3 values you wanted to insert into the string, your joblog() subprocedure call might look like this:
H BNDDIR('RPGOPEN/RPGOPEN')
/INCLUDE RPGOPEN/QCPYSRC,joblog
/free
chain (custNo) custmast;
if %found();
joblog('Customer %s is based in %s Phone: %s':%char(custno):cmstate:%editW(phone:'0( )& - '));
endif;
/end-free
iComp--Compare and Ignore Upper/Lower Case
I featured this subprocedure in a recent RPG Coder newsletter so I won't go over it again here, except to highlight the basics.
The iComp subprocedure compares two character strings and ignores the upper/lower case differences between them, returning *ON (true) if the string match, or *OFF (false) if the strings don't. Here's how you'd use it:
H BNDDIR('RPGOPEN/RPGOPEN')
/INCLUDE RPGOPEN/QCPYSRC,icomp
/INCLUDE RPGOPEN/QCPYSRC,joblog
/free
chain (custNo) custmast;
if %found();
if iComp(company:'ibm');
joblog('Company %s matches "ibm"':company);
endif;
endif;
/end-free
ConCat - Concatenate Multiple Strings
This is the only new subprocedure to our RPG Coder audience; CONCAT is a package of 3 different subprocedures:
- TCAT - Concatenate and trim interleaving blanks
- BCAT - Concatenate and insert a single interleaving blank
- SCAT - Concatenate and insert a user-specified interleaving character
H BNDDIR('RPGOPEN/RPGOPEN')
/INCLUDE RPGOPEN/QCPYSRC,concat
/free
len = Bcat(name : first : middle : last);
len = Tcat(name : first : middle : last);
len = Scat(acct : '-' : prefix : region : %char(checkDigit));
/end-free
The first two subprocedures, BCAT and TCAT, work the same way: Specify the target variable in the first parameter, then specify the values you want to concatenate together; up to 8 are supported. The first parameter is updated with the concatenated values. And there is a difference between this TCAT function and the standard RPG plus sign (+) concatenate--TCAT removes blanks then concatenates, without requiring a %TRIMR wrapper.
The target variable (parameter 1) MUST BE A VARYING field. That is, the VARYING keyword must be specific for the target variable--fixed length fields are not permitted; although there's nothing to stop you from changing the code if you prefer fixed-length.
The third subprocedure SCAT is the underlying support for the other two; SCAT lets you specify the value you want to insert between the concatenated values. I used a dash in the example above, but any character--including nothing (i.e., TCAT)--may be specified.
The source code for CONCAT follows:
H NOMAIN
H OPTION(*NODEBUGIO:*SRCSTMT)
H Copyright('RPG OPEN - (c) 2009 Robert Cozzi, Jr. All rights reserved.')
/IF NOT DEFINED(*V6R1M0)
H BNDDIR('QC2LE')
/ENDIF
/include rpgOpen/qcpysrc,concat
D CEEGSI PR extproc('CEEGSI') OPDESC
D nParmNum 10I 0 Const
D nParmDataType 10I 0
D nParmCurLen 10I 0
D nParmMaxLen 10I 0
D szParmError 12A OPTIONS(*OMIT)
D TRIMPARM PR 10I 0
D target 1024A VARYING
D nMaxLen 10I 0 Const
D sv 1024A Const VARYING
P SCAT B EXPORT
D SCAT PI 10I 0 OPDESC
D rtnVar 1024A Varying Options(*VARSIZE)
D symbol 256A Const Varying
D p1 256A Const Varying OPTIONS(*NOPASS)
D p2 256A Const Varying OPTIONS(*NOPASS)
D p3 256A Const Varying OPTIONS(*NOPASS)
D p4 256A Const Varying OPTIONS(*NOPASS)
D p5 256A Const Varying OPTIONS(*NOPASS)
D p6 256A Const Varying OPTIONS(*NOPASS)
D p7 256A Const Varying OPTIONS(*NOPASS)
D p8 256A Const Varying OPTIONS(*NOPASS)
D nLen S 10I 0
D maxRtnLen S 10I 0
D dataType S 10I 0
D curLen S 10I 0
D maxLen S 10I 0
/free
ceegsi(1 : dataType : curlen : maxLen: *OMIT);
if (%parms() >= 3);
%len(rtnVar) = 0;
nLen = trimParm(rtnVar:maxLen:p1);
endif;
if (%parms() >= 4);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p2);
endif;
if (%parms() >= 5);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p3);
endif;
if (%parms() >= 6);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p4);
endif;
if (%parms() >= 7);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p5);
endif;
if (%parms() >= 8);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p6);
endif;
if (%parms() >= 9);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p7);
endif;
if (%parms() >= 10);
if (%len(symbol) > 0);
rtnVar += symbol;
endif;
nLen = trimParm(rtnVar:maxLen:p8);
endif;
return %Len(rtnVar);
/end-free
P SCAT E
P TCAT B EXPORT
D TCAT PI 10I 0 OPDESC
D rtnVar 1024A Varying Options(*VARSIZE)
D p1 256A Const Varying OPTIONS(*NOPASS)
D p2 256A Const Varying OPTIONS(*NOPASS)
D p3 256A Const Varying OPTIONS(*NOPASS)
D p4 256A Const Varying OPTIONS(*NOPASS)
D p5 256A Const Varying OPTIONS(*NOPASS)
D p6 256A Const Varying OPTIONS(*NOPASS)
D p7 256A Const Varying OPTIONS(*NOPASS)
D p8 256A Const Varying OPTIONS(*NOPASS)
// Empty SYMBOL for TCAT function
D symbol S 10A Varying Inz
D nLen S 10I 0
D dataType S 10I 0
D curLen S 10I 0
D maxLen S 10I 0
/free
ceegsi(1 : dataType : curlen : maxLen: *OMIT);
if (%parms() >= 9);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5:p6:p7:p8);
elseif (%parms() = 8);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5:p6:p7);
elseif (%parms() = 7);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5:p6);
elseif (%parms() = 6);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5);
elseif (%parms() = 5);
return sCat(rtnVar : symbol : p1:p2:p3:p4);
elseif (%parms() = 4);
return sCat(rtnVar : symbol : p1:p2:p3);
elseif (%parms() = 3);
return sCat(rtnVar : symbol : p1:p2);
elseif (%parms() = 2);
return sCat(rtnVar : symbol : p1);
endif;
return 0;
/end-free
P TCAT E
P BCAT B EXPORT
D BCAT PI 10I 0 OPDESC
D rtnVar 1024A Varying Options(*VARSIZE)
D p1 256A Const Varying OPTIONS(*NOPASS)
D p2 256A Const Varying OPTIONS(*NOPASS)
D p3 256A Const Varying OPTIONS(*NOPASS)
D p4 256A Const Varying OPTIONS(*NOPASS)
D p5 256A Const Varying OPTIONS(*NOPASS)
D p6 256A Const Varying OPTIONS(*NOPASS)
D p7 256A Const Varying OPTIONS(*NOPASS)
D p8 256A Const Varying OPTIONS(*NOPASS)
// Separator SYMBOL is one blank for BCAT function.
D symbol S 1A Varying Inz(' ')
D nLen S 10I 0
D maxRtnLen S 10I 0
D dataType S 10I 0
D curLen S 10I 0
D maxLen S 10I 0
/free
ceegsi(1 : dataType : curlen : maxLen: *OMIT);
if (%parms() = 9);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5:p6:p7:p8);
elseif (%parms() = 8);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5:p6:p7);
elseif (%parms() = 7);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5:p6);
elseif (%parms() = 6);
return sCat(rtnVar : symbol : p1:p2:p3:p4:p5);
elseif (%parms() = 5);
return sCat(rtnVar : symbol : p1:p2:p3:p4);
elseif (%parms() = 4);
return sCat(rtnVar : symbol : p1:p2:p3);
elseif (%parms() = 3);
return sCat(rtnVar : symbol : p1:p2);
elseif (%parms() = 2);
return sCat(rtnVar : symbol : p1);
endif;
return 0;
/end-free
P BCAT E
P TrimParm B
D TrimParm PI 10I 0
D target 1024A VARYING
D nMaxLen 10I 0 Const
D sv 1024A Const VARYING
/free
if (%len(sv) = 1 and sv = ' ' or %len(sv) = 0); // Just a blank?
if (%len(target) + %len(sv) <= nMaxLen);
target += sv;
endif;
else;
if (%len(target) + %len(sv) <= nMaxLen);
target += %trim(sv);
endif;
endif;
return %len(target);
/end-free
P TrimParm E
RPG Open is Open
The RPG Open service program is free and includes source, if that means it's "open-source," then so be it. It is currently only available in source code format in the downloads area of RPGWorld.com but will soon be up on www.RPGOpen.com and have its documentation posted online as well.
To compile RPGOpen, call the CRTOPEN CL program after compiling the source member as *MODULE objects. Do this with the CRTRPGMOD command in WDSc/RDi or option 15 in PDM.
This is just the beginning. I've got at least a dozen more subprocedures working in other areas of my RPG lab, and once I move them over to RPG Open and re-test, I'll make them available as well.
New features in RPG Open will be announced on my weekly video show, iWeekly (Friday's at Noon eastern at www.RPGWorld.com/iweeky) along with any other news or updates. Let me know what you think.
Follow Bob Cozzi on Twitter at: Twitter.com/bobcozzi
Follow RPG World on Twitter: Twitter.com/rpgworld
iWeekly, Bob's weekly hour-long video show is aired live every Friday at Noon eastern on RPG World. iWeekly is where you'll learn things you didn't know, and some things you probably don't want to know.
Bob Cozzi is the author of Subprocedures and Service Programs. A 3-disc training series available on DVD that gives RPG IV programmers an easy way to learn RPG IV Subprocedures and Service Programs. It is available now atwww.RPGWorld.com/DVD. Bob's website www.RPGWorld.com is also the place to download the source code featured in RPG Coder and his Tuesday Tips video podcast along with additional examples he's created over the decades. Join Bob Cozzi & Friends in 2010 for "RPG World" The RPG Developers Conference, and Bob's weekly video podcast iWeekly is where you'll learn about everything from RPG IV to SQL, XML, PHP and even a few things you didn't want to know.
Bookmark/Search this post with:
- Login to post comments
- Printer-friendly version
Posted on November 11th, 2009 BobCozzi says:
- Login to post comments
- I've updated the existing
I've updated the existing RPG OPEN codebase so that any V5R3 or later features are wrapped in conditional compiler directives. This means that if, for example, you are not on V5R3 or V6R1 the conditional compiler directives will allow the source to be compiled anyway.
-Bob Cozzi
www.RPGWorld.com
www.RPGOpen.Com
Posted on November 6th, 2009 BobCozzi says:
- Login to post comments
- permalink
Normally I try to stay at least n-3 releases safe in my code, and where I am not, I use the IF DEFINED(*VxRyMx) directives (See the BNDDIR('QC2LE') statement.)
But if you're not on v5.3 or later by now, then you can't expect us to point out that "this code works only on v5.3 or later" do you? What's the cutoff?
I know it would be polite to do this, and *TRIM certainly "feels new" to me, (and I'm on v6.1) but all the way back to unsupported releases of the OS? Sorry, but if you're staying back that many releases for what ever reason...
If I use short-form math such as X += 1 should I point out that it requires v4.2 or later?
If I use QUALIFIED Data Structures, should I point out that it requires v5.1 or later?
The rule of thumb is n-2 (used to be n-1) for the OS, so that means anything at v5.3 or earlier is considered standardized; no disclaimer required.
-Bob Cozzi
www.RPGWorld.com
Posted on November 5th, 2009 r.d.davis@world... says:
- Login to post comments
- permalink
If I am reading the compIler error messages correctly, the icomp module requires V5R3 because of the options(*STRING:*TRIM) statement..
Please, all software authors who publish, tell us the what level of os/400 is REQUIRED.