These are the assorted source files for the Open Access for RPG example published in the November 2010 issue of the iSeries EXTRA newsletter. You can see an example of the output clicking here . It is not particularly pretty but that is just a function of the HTML template. I hope to add some "prettier" examples in the future.
If you don't feel like doing a copy/paste job on the code below you can get a zip file of all the sources involved here.
|
|
The "User" Program
This uses the OAR Handler program shown below. Note that the only difference in the code from the original print file program is the use of the HANDLER keyword on the file's F-spec.
The HTML template used by the handler is shown here.
The definitions for the files used can be found here.
FXProducts IF E K DISK
FXCategors IF E K DISK Prefix('XC')
FProdRptF O E PRINTER OFLIND(*IN99)
F Handler( 'WEBPRINTER' )
D WriteTotals Pr
D totalSell s 11p 2
D totalDisc s 11p 2
D currentCategory...
D s Like(CatCode)
D descr s 30a
D endOfPage c 99
/Free
Write Heading;
// Read product file to prime Do loop and set last category
Read XProducts;
currentCategory = catCode;
// Continue reading until EOF
Dow Not %EOF(XProducts);
If catCode <> currentCategory;
WriteTotals();
currentCategory = catCode;
EndIf;
// Print details
If *In(endOfPage);
Write Heading;
*In(endOfPage) = *Off;
EndIf;
// Increment category totals
totalSell += (sellPrice * qtyOnHand);
totalDisc += (discPrice * qtyOnHand);
descr = shortDesc;
Write Detail;
// Read next record and return to top of loop
Read XProducts;
EndDo;
// Output final set of totals
WriteTotals();
*inLR = *on;
/End-Free
P WriteTotals B
D PI
/Free
Chain currentCategory XCategors;
If Not %Found(XCategors);
XCcatName = '*** Missing ***';
EndIf;
Write CatTotals;
// Reset totals
totalSell = 0;
totalDisc = 0;
Return;
/End-Free
P WriteTotals E
The Handler Program
All of the real work takes place in this handler. In this example it was compiled as a PGM object.
H DftActGrp(*No) Option(*SrcStmt) BndDir('CGIDEV2/CGIDEV2')
// Standard IBM supplied Open Access definitions
/copy qrnopenacc
// CGIDEV2 Prototypes
/copy cgidev2/qrpglesrc,prototypeb
// QUSEC error structure definition
/copy cgidev2/qrpglesrc,usec
// On V7 and later systems this PR can be removed and so can those for
// local subprocedures openFile(), writeFile() and closeFile().
D WebPrinter pr ExtPgm('WEBPRINTER')
D info likeds(QrnOpenAccess_T)
// Definitions for local subprocedures
D openFile pr
D writeFile pr
D closeFile pr
D WebPrinter pi
D info likeds(QrnOpenAccess_T)
// Field Names/Values structures
D nvInput ds likeds(QrnNamesValues_T)
D based(pNvInput)
/free
If info.rpgOperation = QrnOperation_WRITE;
// Set up access to Name/Value information
pNvInput = info.namesValues;
// Write error is unlikely but signal it if it occurs
writeFile();
elseIf info.rpgOperation = QrnOperation_OPEN;
// Specify that we want to use Name/Value intformation
info.useNamesValues = *On;
openFile();
elseIf info.rpgOperation = QrnOperation_CLOSE;
closeFile();
else;
// Any other operation is unsupported so notify RPG
info.rpgStatus = 1299; // general error status
endif;
Return;
/end-free
P openFile b
D openFile pi
D skeletonName s 256a Varying Inz('/Partner400/')
/free
// Build HTML template name using File name then retrieve template
skeletonName += ( %TrimR(info.externalFile.name)
+ '_Template.html' );
GetHTMLIFS( skeletonName: '');
UpdHTMLVar( 'Date': %Char(%Date()): '0');
/end-free
P openFile e
P closeFile b
D closeFile pi
/free
WrtSection( 'Footer' );
// Activate the following line to allow you to test the program on systems where you
// cannot set up or modify the web server. It lets you output the HTML to a stream file
// so you can then simply copy the file to your PC and launch it directly in the browser.
// WrtHTMLToStmf( '/Partner400/Test.html': 819 );
// Comment out the following line if activating the WrtHTMLToStmf line above
WrtSection( '*Fini' );
return;
/end-free
P closeFile e
P writeFile b
D pi
D value s 32470a Based(pvalue)
D i s 5i 0
/free
// Process all fields in record
For i = 1 to nvInput.num;
pvalue = nvInput.field(i).value; // set up to access data
UpdHTMLVar( nvInput.field(i).externalName:
%subst( value: 1: nvInput.field(i).valueLenBytes ));
EndFor;
// Now write out current record format
WrtSection( info.recordName );
Return;
/end-free
P writeFile e
HTML Template
Note that the template in this case is named PRODRPTF_Template.html' - i.e. the name of the original printer file suffixed by '_Template.html'. Note also that the Section names correspond with the record format names in the printer file.
<!-- Heading -->
CONTENT-TYPE: TEXT/HTML
<HTML>
<BODY>
<CENTER>
<h3>Products By Category As At /%Date%/ - Value of Current Inventory</h3>
</CENTER>
<CENTER>
<table width=800 border=1 cellspacing=1 cellpadding=1>
<tr>
<th width=75>Category Code</th>
<th width=75>Product Code</th>
<th width=300>Description</th>
<th width=100>Selling Price</th>
<th width=100>Discount Price</th>
<th width=100>Quantity on Hand</th>
</tr>
<!-- Detail -->
<tr>
<td width=75 height=39 align="center">/%CatCode%/</td>
<td width=75 align="center">/%ProdCode%/</td>
<td width=300 align="left">/%Descr%/</td>
<td width=100 align="right">/%SellPrice%/</td>
<td width=100 align="right">/%DiscPrice%/</td>
<td width=100 align="right">/%QtyOnHand%/</td>
</tr>
<!-- CatTotals -->
<tr>
<td colspan=2 height=39>Values for category:</td>
<td width=300 align="left">/%XCCatName%/</td>
<td width=100 align="right">/%TotalSell%/</td>
<td width=100 align="right">/%TotalDisc%/</td>
<td width=100> </td>
</tr>
<!-- Footer -->
</table>
</CENTER>
</BODY>
</HTML>
DDS For Files Used
These are the DDS sources for the Printer and Physical files used in the "User" program above. I have not included the /COPY members as they are supplied by CGIDEV2 or by IBM.
Printer File PRODRPTF
A REF(PARTNER400/XPRODUCTS)
A R HEADING
A SKIPB(1)
A 1'Products By Category As At'
A 28DATE(*JOB *YY)
A EDTCDE(Y)
A 39'- Value of Current Inventory'
A SPACEA(1)
A 1' Category Product Description -
A Selling -
A Discount Quantity'
A SPACEA(1)
A 1' Code Code -
A Price -
A Price on Hand'
A SPACEA(2)
A R DETAIL SPACEA(1)
A CATCODE R 3
A PRODCODE R 10
A DESCR 30 21
A SELLPRICE R 57EDTCDE(K)
A DISCPRICE R 72EDTCDE(K)
A QTYONHAND R 86EDTCDE(K)
A R CATTOTALS SPACEB(1)
A SPACEA(1)
A 1'Values for category: '
A XCCATNAME 30A 22
A TOTALSELL 11 2 52EDTCDE(K)
A TOTALDISC 11 2 67EDTCDE(K)
A
Physical File XPRODUCTS
A R PRODUCTREC
A PRODCODE 5A
A SHORTDESC 40A VARLEN(40)
A FULLDESC 200A VARLEN(100)
A CATCODE 2A
A QTYONHAND 5P 0
A SELLPRICE 7P 2
A DISCPRICE 7P 2
A K CATCODE
A K PRODCODE
Physical File XCATEGORS
A R CATEGORREC
A CATCODE 2A
A CATNAME 30A
A K CATCODE
Want more information?
Got a question or comment about the site?
Please feel free to Contact Us at any time.}