******************************************************************** * Sample ILE RPG Script - Process Survey Form * * Source: WWWSAMPLES/QRPGLESRC (SRVYRPGLE) * Object: WWWCGI/SRVYRPGLE *PGM * * Program notes: * 1)2 server APIs are called: * WwwGetFormVar (WWWGETFV) - Get the survey form variables * WwwWrite (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 SURVEYRPGI 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. * 2)Use the following options on the CRTBNDRPG command: * DFTACTGRP(*NO) * BNDDIR(*LIBL/BNDDIR) ******************************************************************** ******************************************************************** * * Survey sample database file (stored in library WWWSAMPLES) FSURVEY IF A E DISK RENAME(SURVEY:SRVYRCD) * ******************************************************************** ******************************************************************** * * Include server constants; DWWWAPI is shipped in source file QRPGLESRC * in library WWWSERVER D/COPY DWWWAPI * ******************************************************************** * * Constants used by the sample program DCONTTYPE C CONST('Content-type: text/html') DWWWMSGF C CONST('WWWMSGF *LIBL ') DQMHRTVM C 'QMHRTVM' * * Binary fields used by the sample program DVARLEN S 9B 0 INZ DVALBP S 9B 0 INZ DVALBA S 9B 0 INZ DBYTIN S 9B 0 INZ DBYTOUT S 9B 0 INZ DQ1YES S 9B 0 INZ DQ1NO S 9B 0 INZ DQ2GIF S 9B 0 INZ DQ2JPEG S 9B 0 INZ DQ2DC S 9B 0 INZ DMSGLEN S 9B 0 INZ DMSGDLEN S 9B 0 INZ DI S 9B 0 INZ * *Structure used to track survey stats DSTATS DS D NBR 1 4B 0 D PQ1YES 5 8B 0 D PQ1NO 9 12B 0 D PQ1NA 13 16B 0 D PQ2GIF 17 20B 0 D PQ2JPEG 21 24B 0 D PQ2DC 25 28B 0 D PQ2NA 29 32B 0 * *Structure used to receive errors DERR DS D ERRBP 1 4B 0 D ERRBA 5 8B 0 D ERREID 9 15 D ERRRSV 16 16 D ERRDTA 17 216 * *Structure used for QMHRTVM API call DQMHRTVMDS DS D QMHBR 1 4B 0 D QMHBA 5 8B 0 D QMHMSGBR 9 12B 0 D QMHMSGBA 13 16B 0 D QMHHLPBR 17 20B 0 D QMHHLPBA 21 24B 0 D MSGDTA 25 1024 DIM(1000) * ******************************************************************** ******************************************************************** * * PLIST for WwwGetFormVar 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 999 C PARM BYTIN C PARM BYTOUT * ******************************************************************** * * PLIST for QMHRTVM API C MHRTVM PLIST C PARM QMHRTVMDS C PARM MSGLEN C PARM MSGFMT 8 C PARM MSGID 7 C PARM MSGF 20 C PARM MSGD 200 C PARM MSGDLEN 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 RETURN ******************************************************************** ******************************************************************** * ******************************************************************** * Subroutine used to tabulate current survey answers C SRTAB BEGSR C Z-ADD 0 NBR C *IN61 DOUEQ '1' C READ SURVEY 61 C N61 EXSR SRTABINC C ENDDO C ENDSR * ******************************************************************** * Subroutine that updates survey results based on record read C SRTABINC 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(P) 'Quest1' VAR C Z-ADD 6 VARLEN C CLEAR VAL C Z-ADD 50 VALBP C CALLB(D) WWWGETFV GETFV C MOVEL VAL QUEST1 * * Retrieve form variable 2 named Quest2 C MOVEL(P) 'Quest2' VAR C Z-ADD 6 VARLEN C CLEAR VAL C Z-ADD 50 VALBP C CALLB(D) WWWGETFV GETFV C MOVEL VAL QUEST2 * * Tabulate new record and write record to the survey database C EXSR SRTABINC C WRITE SRVYRCD C ENDSR * ******************************************************************** * Subroutine used to compute survey percentages C SRCOMP BEGSR C EVAL PQ1YES=(Q1YES*100)/NBR C EVAL PQ1NO=(Q1NO*100)/NBR C EVAL PQ1NA=((NBR-Q1YES-Q1NO)*100)/NBR C EVAL PQ2GIF=(Q2GIF*100)/NBR C EVAL PQ2JPEG=(Q2JPEG*100)/NBR C EVAL PQ2DC=(Q2DC*100)/NBR C EVAL PQ2NA=((NBR-Q2GIF-Q2JPEG-Q2DC)*100)/NBR 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 MOVEL CONTTYPE BUF C Z-ADD 23 BYTIN C CALLB(D) WWWWRITE WWRITE * * End response header with CR,LF and add blank line (CR,LF) which * indicates the object body follows C MOVEL X'0D250D25' BUF C Z-ADD 4 BYTIN C CALLB(D) WWWWRITE WWRITE * * Call subroutine used to retrieve the document content and then return * the content to the browser C EXSR SRHTML C CALLB(D) 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 CLEAR QMHRTVMDS C Z-ADD 1024 MSGLEN C MOVEL 'RTVM0100' MSGFMT C MOVEL 'WWWFFFF' MSGID C MOVEL WWWMSGF MSGF C MOVEL STATS MSGD C Z-ADD 32 MSGDLEN C MOVEL(P) '*YES' MSGREP C MOVEL(P) '*NO' MSGCTL C EXSR SRERR C CALL QMHRTVM MHRTVM * * Copy second-level message data into write buffer C EVAL I=QMHMSGBR+1 C MOVEA MSGDTA(I) BUF C Z-ADD QMHHLPBR BYTIN C ENDSR * ******************************************************************** * Subroutine used to initialize the error data structure C SRERR BEGSR C CLEAR ERR C Z-ADD 216 ERRBP C ENDSR