H CopyRight('www.agnethe.dk (c) - 2008')
H DatEdit(*YMD.)
H Option( *SrcStmt: *NoDebugIO)
H DECEDIT(*JOBRUN)
H BndDir('QC2LE')
/If Defined(*Crtbndrpg)
H BndDir( '*LIBL/CGIBNDDIR' )
H DftActGrp(*NO)
/Endif
//*=============================================================
//*
//* ‚MC PRESS ONLINE
//*
//* Function :‚Let's bake pies and donuts - Create some XML data
//*
//* ------------------------------------------------------------
//* Created:
//* Programmer:‚Jan Jorgensen
//* Date . . :‚2008-12-20
//*
//* How to compile:
//*
//* step 1
//* CRTRPGMOD MODULE(yourlib/FORM015X01) SRCFILE(yourlib/QRPGSRC)
//* SRCMBR(FORM015X01) DBGVIEW(*SOURCE) REPLACE(*YES)
//*
//* step 2
//* CRTPGM PGM(yourlib/FORM015X01) MODULE(FORM015X01)
//* BNDSRVPGM(QHTTPSVR/QZHBCGI)
//*
//*=============================================================
* Graph data
FFORM015DTAIF E K DISK
//==============================================================
//‚ DECLARE WORK FIELDS, ARRAYS AND MORE
//==============================================================
// Contants
D HTTPHeader c Const('Content-type: text/html')
D NewLine c Const(X'15')
D IFSfile c '1.xml'
D IFSpath c '/web/mcpressonline/pies_and_donuts/'
D pCounter s 2s 0
D parm s 50a dim( 10 )
D q c ''''
D s1 c 'Kim Gordon'
D s2 c 'Steve Shelley'
D sName s 50a
D link s 1000a
D dsarrNames ds Inz
D arrNames 30 dim(100)
D dsarrValues ds Inz
D arrValues 60 dim(100)
D varCount 5i 0 inz(0)
D FormName s 30 DIM(3) PERRCD(1)
D CTDATA
D NbrNam s 5i 0 inz( %elem( FormName ))
D wrkFormName s like( FormName )
D SndHTMLmsg s n
D i s 5i 0 Inz( *Zeros )
D j s 5i 0 Inz( *Zeros )
D Rslt s 5i 0 Inz( *Zeros )
D Lng s 5i 0 Inz( *Zeros )
D WrkLine s 2000a varying
D WrkTarg s 2000a varying
D p0 s 300a
D p1 s 300a
D p2 s 300a
D inputvalue s 300a
D pSalesMan s like( SALESMAN )
D pGtype s 20a
D LF C x'25'
D file s *
D space s 501A
D line s 500A varying
D p_data s *
D fd S 10I 0
D wrdata S 24A
D rddata S 48A
D flags S 10U 0
D mode S 10U 0
D Msg S 50A
D Len S 10I 0
D data s 50A
D wait s 1A
//----------------------------------------------------------------
// Prototypes
//----------------------------------------------------------------
// IFS prototypes - Made by Scott Klement (http://www.scottklement.com)
/copy qrpgsrc,bufio_h
// MakeHTML function
D MakeHTML pr
D StringIn 2000 value
// Replace function
D ReplaceIt pr 2000a
D Target 2000 const
D Source 2000 value
D StartPos 5i 0 const
D Length 5i 0 const
// Parse
D CGIparse pr ExtPgm('CGIPARSEZ')
D pArrNames like( arrNames )
D pArrValues like( arrValues )
D pVarCount like( varCount )
//---------------------------------------------------------------
// Declare key list(s) (KLIST)
//---------------------------------------------------------------
D kFORM015DTA ds LikeRec( RDATA : *Key )
//==============================================================
//‚Main Loop
//==============================================================
/free
//---------------------------------------------------------------
// Tell browser HTML is coming
//---------------------------------------------------------------
// Content-Type
MakeHTML( HTTPHeader + NewLine + NewLine );
//---------------------------------------------------------------
// Init program...
//---------------------------------------------------------------
// Set Error checker
SndHTMLmsg = *OFF;
//---------------------------------------------------------------
// Read standard input
//---------------------------------------------------------------
ExSr subrFORMparse;
//---------------------------------------------------------------
// Move HTML values to internal fields
//---------------------------------------------------------------
ExSr subrParseFields;
//---------------------------------------------------------------
// Save Detail data
//---------------------------------------------------------------
ExSr subrSaveDetailData;
//---------------------------------------------------------------
// Display form
//---------------------------------------------------------------
ExSr subrCreateHTMLreply;
//---------------------------------------------------------------
// Stop Program
//---------------------------------------------------------------
ExSr StopPgm;
//---------------------------------------------------------------
// Parse HTML form
//---------------------------------------------------------------
BegSr subrFORMparse;
CallP(e) CGIparse( dsarrNames
: dsarrValues
: varCount
)
;
EndSr;
//---------------------------------------------------------------
// Parse fields to the correct internal RPG fields
//---------------------------------------------------------------
BegSr subrParseFields;
// Search fields
For i = 1 BY 1 TO NbrNam;
// No more fields
If FormName(i) = '*none';
Leave;
EndIf;
wrkFormName = FormName(i);
j = 1;
// Find the fields to parse to
j = %lookup( wrkFormName: arrNames : 1 );
If j>0;
*in30 = *on;
Else;
*in30 = *off;
Endif;
If *in30;
Select;
// Sales man
When wrkFormName = FormName(1);
Monitor;
pSalesMan = %dec(arrValues(j):2:0);
On-Error;
pSalesMan = 1;
EndMon;
// Graph type
When wrkFormName = FormName(2);
pGtype = arrValues(j);
EndSl;
EndIf;
EndFor;
EndSr;
//================================================================
// Save Detail data
//================================================================
BegSr subrSaveDetailData;
EndSr;
//================================================================
// Create HTML reply
//================================================================
BegSr subrCreateHTMLreply;
file = fopen( IFSpath + '/' + IFSfile : 'r');
// IFS file not found
if (file = *NULL);
MakeHTML( 'ERROR - Skeleton file not found : '
+ IFSpath
+ '/'
+ IFSfile
+ NewLine
);
ExSr StopPgm;
endif;
dou 1 = 2;
// Read data
p_data = fgets( %addr(space): %size(space): file );
// End of file
if ( p_data = *NULL ) ;
leave ;
endif ;
// Move data read into an internal field
line = %str(p_data);
// Remove linebreak if any
If (%subst(line:%len(line):1) = LF);
%len(line) = %len(line) - 1;
Endif;
If line > *BLANKS;
WrkLine = line;
//---------------------------------------------------------------
// Salesman name (Junk but ok for the test)
//---------------------------------------------------------------
Rslt = %scan('%%salesman_name%%' : WrkLine: 1 );
If Rslt > *Zeros;
Lng = %size( '%%salesman_name%%' );
If ( pSalesMan = 01 );
WrkTarg = s1;
ElseIf ( pSalesMan = 02 );
WrkTarg = s2;
Else;
WrkTarg = '** Unknown salesman **';
EndIf;
Wrkline = ReplaceIt( WrkTarg:WrkLine:Rslt:Lng);
MakeHTML( %trim(WrkLine) + NewLine );
Iter;
EndIf;
//---------------------------------------------------------------
// Graph type
//---------------------------------------------------------------
Rslt = %scan('%%gtype%%' : WrkLine: 1 );
If Rslt > *Zeros;
Lng = %size( '%%gtype%%' );
WrkTarg = %trim( pGtype );
Wrkline = ReplaceIt( WrkTarg:WrkLine:Rslt:Lng);
MakeHTML( %trim(WrkLine) + NewLine );
Iter;
EndIf;
//---------------------------------------------------------------
// Write detail data to browser
//---------------------------------------------------------------
Rslt = %scan('%%year_data%%' : WrkLine: 1 );
If Rslt > *Zeros;
Lng = %size( '%%year_data%%' );
// Read detail data and write it to the browser
SetLL *START FORM015DTA;
Dou 1 = 2;
Read RDATA;
If %eof( FORM015DTA );
Leave;
EndIf;
If ( SALESMAN <> pSalesMan );
Iter;
EndIf;
WrkLine = ''
+ %char(YEAR)
+ ''
;
MakeHTML( %trim(WrkLine) + NewLine );
EndDo;
Iter;
EndIf;
//---------------------------------------------------------------
// Write detail data to browser
//---------------------------------------------------------------
Rslt = %scan('%%value_data%%' : WrkLine: 1 );
If Rslt > *Zeros;
Lng = %size( '%%value_data%%' );
// Read detail data and write it to the browser
SetLL *START FORM015DTA;
Dou 1 = 2;
Read RDATA;
If %eof( FORM015DTA );
Leave;
EndIf;
If ( SALESMAN <> pSalesMan );
Iter;
EndIf;
WrkLine = ''
+ %char(VALUE)
+ ''
;
MakeHTML( %trim(WrkLine) + NewLine );
EndDo;
Iter;
EndIf;
//---------------------------------------------------------------
// Write HTML to browser
//---------------------------------------------------------------
MakeHTML( %trim(WrkLine) + NewLine );
EndIf;
EndDo;
//-------------------------------------------------------------
// Close IFS file
//-------------------------------------------------------------
fclose(file);
EndSr;
//---------------------------------------------------------------
// Stop Program
//---------------------------------------------------------------
BegSr StopPgm;
// Create HTML Message
If SndHTMLmsg = *On;
MakeHTML( 'Program stopped.....' +
NewLine );
EndIf;
*inLR = *ON;
Return;
EndSr;
//---------------------------------------------------------------
// Global error catcher
//---------------------------------------------------------------
BegSr *PSSR;
EndSr;
/end-free
//================================================================
// Function MakeHTML - Write string to StdOut
//================================================================
P MakeHTML b
D MakeHTML pi
D StringIn 2000 value
D Work s like(StringIn)
D StdOutLen s 9B 0
//----------------------------------------------------------------
// General API error routine
//----------------------------------------------------------------
DQUSEC DS
D qusbprv 1 4B 0 Inz( 16 ) Qus EC
D qusbavl 5 8B 0 Bytes Provided
D qusei 9 15 Bytes Available
D quserved 16 16 Exception Id
//----------------------------------------------------------------
// Calculate length of StdOut string
//----------------------------------------------------------------
/free
Work = %trim(StringIn);
Work = %trim(Work);
StdOutLen = %CheckR(' ':Work);
/end-free
//----------------------------------------------------------------
// Call QtmhWrStout API to write response HTML to StdOut
//----------------------------------------------------------------
C CallB(e) 'QtmhWrStout'
C Parm Work
C Parm StdOutLen
C Parm QUSEC
P MakeHTML e
//================================================================
// Function ReplaceIt - Replace something in a string
//================================================================
P ReplaceIt b export
D ReplaceIt pi 2000a
D Target 2000a const
D Source 2000a value
D StartPos 5i 0 const
D Length 5i 0 const
/free
Source = %replace( %trim(Target) :
Source :
StartPos :
Length );
Return Source;
/end-free
P ReplaceIt e
**CTDATA FormName
FORM_salesman 01
FORM_gtype 02