******************************************************************** * Sample RPG Script - Process Survey Form * * Source: WWWSAMPLES/QRPGSRC (SRVYRPG) * Object: WWWCGI/SRVYRPG *PGM * * Program notes: * 1)2 server APIs are called: * WWWGETFV - Get the survey form variables * WWWWRITE - Return results to the browser * 2)The HTML data being returned to the browser is retrieved * from a message file. * 3)The form actually calls the CL program SURVEYRPG which calls * this program to perform the script processing. The CL program * is used to override the SURVEY database file to library * WWWSAMPLES. * 4)No error checking is being performed to enhance program * readability. * 5)Programmer writing this script hasn't programmed in RPG for * 6 years or so. * * Compile notes: * 1)Add libraries WWWSERVER and WWWSAMPLES to the library list. ******************************************************************** ******************************************************************** * * Survey sample database file (stored in library WWWSAMPLES) FSURVEY IF E DISK A F SURVEY KRENAMESRVYRCD * ******************************************************************** ******************************************************************** * * Array definitions E MSG 999 1 E BUF 999 1 * ******************************************************************** * * Constants used by the sample program I 'Content-ty- C CNTTYP I 'pe: text/h- I 'tml' I 'WWWMSGF - C WWMSGF I '*LIBL ' I X'0D250D25' C CRLF2 * * Binary fields used by the sample program IBINFLD DS I B 1 40VARLEN I B 5 80VALBP I B 9 120VALBA I B 13 160BYTIN I B 17 200BYTOUT I B 21 240Q1YES I B 25 280Q1NO I B 29 320Q2GIF I B 33 360Q2JPEG I B 37 400Q2DC I B 41 440MSGLEN I B 45 480MSGDLN I B 49 520I * *Structure used to track survey stats ISTATS DS I B 1 40NBR I B 5 80PQ1YES I B 9 120PQ1NO I B 13 160PQ1NA I B 17 200PQ2GIF I B 21 240PQ2JPG I B 25 280PQ2DC I B 29 320PQ2NA * *Structure used to receive errors IERR DS I B 1 40ERRBP I B 5 80ERRBA I 9 15 ERREID I 16 16 ERRRSV I 17 216 ERRDTA * *Structure used for QMHRTVM API call IRTVMDS DS I B 1 40QMHBR I B 5 80QMHBA I B 9 120QMHMBR I B 13 160QMHMBA I B 17 200QMHHBR I B 21 240QMHHBA I 251023 MSG * ******************************************************************** ******************************************************************** * * PLIST for WWWGETFV API C GETFV PLIST C PARM VAR 20 C PARM VARLEN C PARM VAL 50 C PARM VALBP C PARM VALBA * ******************************************************************** * * PLIST for WWWWRITE API C WWRITE PLIST C PARM BUF C PARM BYTIN C PARM BYTOUT * ******************************************************************** * * PLIST for QMHRTVM API C MHRTVM PLIST C PARM RTVMDS C PARM MSGLEN C PARM MSGFMT 8 C PARM MSGID 7 C PARM MSGF 20 C PARM MSGD 200 C PARM MSGDLN C PARM MSGREP 10 C PARM MSGCTL 10 C PARM ERR * ******************************************************************** ******************************************************************** * * MAIN * ******************************************************************** C EXSR SRTAB C EXSR SRGET C EXSR SRCOMP C EXSR SRSEND C SETON LR C RETRN ******************************************************************** ******************************************************************** * ******************************************************************** * Subroutine used to tabulate current survey answers C SRTAB BEGSR C CLEARBINFLD C Z-ADD0 NBR C *IN61 DOUEQ'1' C READ SURVEY 61 C N61 EXSR SRTAB2 C ENDDO C ENDSR * ******************************************************************** * Subroutine that updates survey results based on record read C SRTAB2 BEGSR * Increment number of respondents C ADD 1 NBR * * Increment question 1 answer appropriately C QUEST1 IFEQ 'Y' C ADD 1 Q1YES C ELSE C QUEST1 IFEQ 'N' C ADD 1 Q1NO C ENDIF C ENDIF * * Increment question 2 answer appropriately C QUEST2 IFEQ 'GIF ' C ADD 1 Q2GIF C ELSE C QUEST2 IFEQ 'JPEG ' C ADD 1 Q2JPEG C ELSE C QUEST2 IFEQ 'DONTCARE' C ADD 1 Q2DC C ENDIF C ENDIF C ENDIF C ENDSR * ******************************************************************** * Subroutine used to retrieve form variables and write to survey database C SRGET BEGSR * Retrieve form variable 1 named Quest1 C MOVEL'Quest1' VAR P C Z-ADD6 VARLEN C CLEARVAL C Z-ADD50 VALBP C CALL 'WWWGETFV'GETFV C MOVELVAL QUEST1 * * Retrieve form variable 2 named Quest2 C MOVEL'Quest2' VAR P C Z-ADD6 VARLEN C CLEARVAL C Z-ADD50 VALBP C CALL 'WWWGETFV'GETFV C MOVELVAL QUEST2 * * Tabulate new record and write record to the survey database C EXSR SRTAB2 C WRITESRVYRCD C ENDSR * ******************************************************************** * Subroutine used to compute survey percentages C SRCOMP BEGSR C Q1YES MULT 100 PQ1YES C DIV NBR PQ1YES C Q1NO MULT 100 PQ1NO C DIV NBR PQ1NO C NBR SUB Q1YES PQ1NA C SUB Q1NO PQ1NA C MULT 100 PQ1NA C DIV NBR PQ1NA C Q2GIF MULT 100 PQ2GIF C DIV NBR PQ2GIF C Q2JPEG MULT 100 PQ2JPG C DIV NBR PQ2JPG C Q2DC MULT 100 PQ2DC C DIV NBR PQ2DC C NBR SUB Q2GIF PQ2NA C SUB Q2JPEG PQ2NA C SUB Q2DC PQ2NA C MULT 100 PQ2NA C DIV NBR PQ2NA C ENDSR * ******************************************************************** * Subroutine used to return the survey results to the browser C SRSEND BEGSR * Send response header which sets the document content type C MOVEACNTTYP BUF,1 C Z-ADD23 BYTIN C CALL 'WWWWRITE'WWRITE * * End response header with CR,LF and add blank line (CR,LF) which * indicates the object body follows C MOVEACRLF2 BUF,1 C Z-ADD4 BYTIN C CALL 'WWWWRITE'WWRITE * * Call subroutine used to retrieve the document content and then return * the content to the browser C EXSR SRHTML C CALL 'WWWWRITE'WWRITE C ENDSR * ******************************************************************** * Subroutine used to retrieve the HTML document content from the * WWWMSGF message file. Message WWWFFFF contains in the second-level * message text the HTML data to return to the browser. C SRHTML BEGSR * * Initial QMHRTVM parameters C CLEARRTVMDS C Z-ADD1023 MSGLEN C MOVEL'RTVM0100'MSGFMT C MOVEL'WWWFFFF' MSGID C MOVELWWMSGF MSGF C MOVELSTATS MSGD C Z-ADD32 MSGDLN C MOVEL'*YES' MSGREP P C MOVEL'*NO' MSGCTL P C EXSR SRERR C CALL 'QMHRTVM' MHRTVM * * Copy second-level message data into write buffer C QMHMBR ADD 1 I C MOVEAMSG,I BUF,1 C Z-ADDQMHHBR BYTIN C ENDSR * ******************************************************************** * Subroutine used to initialize the error data structure C SRERR BEGSR C CLEARERR C Z-ADD216 ERRBP C ENDSR