*Process LIMITS( EXTNAME( 31 ) ) macro;
*Process LANGLVL( SAA2 ) MARGINS( 1, 100 ) ;
 myPkg: package exports(*);

 /********************************************************************/
 /*                                                                  */
 /*  NAME - gInfo.pli                                                */
 /*                                                                  */
 /*  DESCRIPTION                                                     */
 /*    Sample PL/I - CGI program.                                    */
 /*                                                                  */
 /*  DEPENDENCIES                                                    */
 /*    See readcgi.txt for details.                                  */
 /*                                                                  */
 /********************************************************************/
 /*                                                                  */
 /*    Licensed Materials - Property of IBM                          */
 /*    5639-A83, 5639-A24 (C) Copyright IBM Corp. 1992,2000.         */
 /*    All Rights Reserved.                                          */
 /*    US Government Users Restricted Rights-- Use, duplication or   */
 /*    disclosure restricted by GSA ADP Schedule Contract with       */
 /*    IBM Corp.                                                     */
 /*                                                                  */
 /*  DISCLAIMER OF WARRANTIES                                        */
 /*    The following enclosed code is sample code created by IBM   */
 /*    Corporation. This sample code is not part of any standard     */
 /*    IBM product and is provided to you solely for the purpose of  */
 /*    assisting you in the development of your applications.  The   */
 /*    code is provided "AS IS", without warranty of any kind.       */
 /*    IBM shall not be liable for any damages arising out of your   */
 /*    use of the sample code, even if IBM has been advised of the   */
 /*    possibility of such damages.                                  */
 /*                                                                  */
 /********************************************************************/

 /******************************************************************/
 /* Environment Variable                                           */
 /*   For running in WindosNT set to 'WIN'                         */
 /*   For running in MVS environment set to 'MVS'.                 */
 /******************************************************************/
  %Dcl RunsOn Char;
  %RunsOn = 'WIN';

 dcl stdout             file record output;

 dcl bytesRead          fixed bin(31);

 dcl contentIn          char(1024) var;
 dcl contentInB4        char(1024) var;
 dcl outrec             char(256) var;

 dcl rtnPtr             pointer;

 Dcl 1 wineDetail       based(rtnPtr),
       2 Vintner        char(25) var,
       2 vyear          char(4) var,
       2 appellat       char(15) var,
       2 pDate          char(8) var,
       2 mDate          char(8) var,
       2 numBttl        fixed bin(31),
       2 comments       char(200) var;


gInfo: proc() options(main);

 /* Prototypes */
 dcl gDetail  entry (pointer byvalue)
              returns( pointer byvalue )
              options( fetchable byvalue linkage(system) );

 dcl gTag     entry ( pointer, pointer, pointer )
              options( fetchable byvalue linkage(system) );

 dcl parseIt  entry ( pointer, pointer )
              options( fetchable byvalue linkage(system) );

 dcl sysin              file input;

 dcl area(0:1)          char(32) var init('Sonoma','Napa');
 dcl currWine           char(64) var;
 dcl firstName          char(32) var init('mysterious person');
 dcl fromWhere          char(32) var init('the beyond');
 dcl GatewayInterface   char(40) var;
 dcl method             char(20) var;
 dcl myComments         char(200) var;
 dcl price(0:1)         char(32) var init('Cheap','Expensive');
 dcl rtnBuf             char(1022) var;
 dcl STDOUTFNAME        char(*) value('STDOUT:');
 dcl STDOUTTITLE        char(*) value( '/' || STDOUTFNAME ||
      ',lrecl(256),append(n),type(crlf),share(none)' );
 dcl SvrProtocol        char(40) var;
 dcl sysinTitle         char(62) var;
 dcl tagName            char(32) var ;
 dcl tagValue           char(64) var based(tagPtr);

 dcl cLen               fixed bin(31);
 dcl I                  fixed bin(31);

 dcl myPtr              pointer init(null());
 dcl tagValuePtr        pointer;
 dcl rbPtr              pointer;
 dcl tagPtr             pointer;


 /* begin processing */
 rtnBuf = '';
 bytesRead = 0;
 contentIn = '';
 contentInB4 = '';

 /***************************************/
 /* On unit to handle non-numeric data. */
 /***************************************/
   on conversion
     begin;
       outrec = sourceline() ||'  '||procname() ||'<br>';
       call w_html ( outrec , stdout );
       goto recover;
     end;

 /* determine if GET or POST */
 method = getenv('REQUEST_METHOD');

 /* get the input */
 if method = 'GET'
   then
     do;
       rtnBuf = getenv('QUERY_STRING');
     end;
   else
     do;
       cLen = getenv('CONTENT_LENGTH');
       sysinTitle = '/STDIN:,LRECL(' || trim(edit(cLen,'999999'))
                    || '),TYPE(U)';
       open file(sysin) title(sysinTitle)  record;
       bytesRead = fileread( sysin, addrdata(rtnBuf), cLen );
       outlen    = cLen;
       close file( sysin );
     end;


 /* open stdout and write out CGI header */
 open file ( stdout ) title( STDOUTTITLE );

 outrec = "Content-type: text/html";
 call w_html ( outrec , stdout );
 outrec = '';
 call w_html ( outrec , stdout );

 /* Load the Value pairs into a linked-list from the input string */
 contentIn = substr(rtnBuf,1,bytesRead);
 contentInB4 = contentIn;
 rbPtr = addrdata(contentIn);
 call parseIt( rbPtr, addr(myPtr) );

 /* get info for the new web page */

 /* get the firstName value */
 tagname = 'fname';
 call gTag( myPtr, addr(tagName), addr(tagValuePtr) );
 tagPtr = addrdata(tagValuePtr) ;
 if TagValue ^=''
   then
     firstName = trim(TagValue);

 /* get the fromwhere value */
 tagname = 'wherefrom';
 call gTag( myPtr, addr(tagName), addr(tagValuePtr) );
 tagPtr = addrdata(tagValuePtr) ;
 if TagValue ^=''
   then
     fromWhere = trim(TagValue);

 /* get the winery name */
 tagname = 'Data';
 call gTag( myPtr, addr(tagName), addr(tagValuePtr) );
 tagPtr = addrdata(tagValuePtr) ;
 currWine = TagValue;
 tagPtr = addr(currWine);

 /* get the details of the selected wine */
 fetch gDetail title('GDETAIL');
 rtnPtr = gDetail( tagPtr );

 /* begin writing out the html for the new web page */
 outrec   ='<HTML><HEAD><TITLE>PL/I CGI Wine Inventory Control</TITLE>';

 /* write out calls to JavaScript function call to close debug window */
 outrec ||= '</HEAD><BODY onunload="closeDbg()"';

 %if RunsOn = 'MVS'        /* If execution environment is MVS        */
   %then
      %do;
 outrec ||=' BACKGROUND="';
 outrec ||='http://stplex4b.stl.ibm.com:3091/PUB-BALKBJ/grapesbw.gif"><CENTER>';
     %end;
   %else                   /* If exe environment is Windows          */
      %do;
 outrec ||= ' BACKGROUND="/images/grapesbw.gif">';
      %end;

 outrec ||='<center><H2>PL/I - CGI Wine Inventory Sample</H2></center>';
 call w_html ( outrec , stdout );

 /* start the table to hold the values */
 outrec   ='<TABLE WIDTH="100%" align="center" bORDER="0">';
 outrec ||='<TR><TD WIDTH="60%" align="center">';
 outrec ||='<P>Here is the information on the wine you selected.<br>';
 outrec ||='Please be sure to order <b>soon</b> while quantites last!';
 call w_html ( outrec , stdout );
 outrec   ='<P><TD WIDTH="40%" align="center">';

 %if RunsOn = 'MVS'        /* If execution environment is MVS        */
   %then
      %do;
 outrec ||='<img src="http://stplex4b.stl.ibm.com:3091/PUB-BALKBJ/images/buy-now.gif" border=0';
     %end;
   %else                   /* If exe environment is Windows          */
      %do;
 outrec ||='<img src="/images/buy-now.gif" border=0';
      %end;

 outrec ||='<img src="/images/buy-now.gif" border=0';
 outrec ||='alt="Order Now!"></TABLE>';
 call w_html ( outrec , stdout );

 outrec   ='<TABLE WIDTH="100%" BORDER="0"><TR>';
 outrec ||='<TD WIDTH="10%" >&nbsp;<TD WIDTH="80%" >';
 outrec ||='<TABLE Border width=100% center>';
 call w_html ( outrec , stdout );

 outrec   ='<TR><TD ALIGN="LEFT"><B>Vintner</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||rtnPtr->wineDetail.vintner ||'</TD></TR>';
 call w_html ( outrec , stdout );
 outrec   ='<TR><TD ALIGN="LEFT"><B>Vintage Year</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||rtnPtr->wineDetail.vyear   ||'</TD></TR>';
 call w_html ( outrec , stdout );
 outrec   ='<TR><TD ALIGN="LEFT"><B>Appelation</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||rtnPtr->wineDetail.appellat||'</TD></TR>';
 call w_html ( outrec , stdout );
 outrec   ='<TR><TD ALIGN="LEFT"><B>Release Date</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||rtnPtr->wineDetail.pDate   ||'</TD></TR>';
 call w_html ( outrec , stdout );
 outrec   ='<TR><TD ALIGN="LEFT"><B>Mature Date</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||rtnPtr->wineDetail.mDate   ||'</TD></TR>';
 call w_html ( outrec , stdout );
 outrec   ='<TR><TD ALIGN="LEFT"><B>Bottles on Hand</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||rtnPtr->wineDetail.numbttl ||'</TD></TR>';
 call w_html ( outrec , stdout );

 myComments = translate(substr(rtnPtr->wineDetail.comments,1),' ','?');
 outrec   ='<TR><TD ALIGN="LEFT"><B>Wine Comments</B></TD>';
 outrec ||='<TD ALIGN="LEFT">'||trim(myComments)           ||'</TD></TR>';
 call w_html ( outrec , stdout );

 outrec   ='</TABLE>';
 call w_html ( outrec , stdout );

 firstName = translate(firstName,' ','+');
 fromWhere = translate(fromWhere,' ','+');
 outrec   ='<P>By the way <b>'||trim(firstName)||'</b>, thanks for contacting ';
 outrec ||='us all the way from <b>'||trim(fromwhere)||'</b>!  Don''t be a stranger...';
 call w_html ( outrec , stdout );

 outrec   ='<TD WIDTH="10%" >&nbsp;</TABLE>';
 call w_html ( outrec , stdout );

 /* write out the debug checkbox */
 outrec   = '<TABLE WIDTH="100%" BORDER="1"><TR><FORM ';
 outrec ||=
 '<TD><INPUT TYPE="BUTTON" VALUE="Show Debug Info" NAME="debug" onClick="doDebug()">';
 outrec ||= '</TD></TR></TABLE>';
 call w_html ( outrec, stdout );


 /* Get the type of server from the env var */
 GatewayInterface = trim(getenv('GATEWAY_INTERFACE'));
 SvrProtocol = trim(getenv('SERVER_PROTOCOL'));

 outrec   ='<TABLE WIDTH="100%" BORDER="1">';
 outrec ||='<TR><TD WIDTH="40%" align="center" >';
 outrec ||='<FONT FACE="Ariel" Size="3">';
 outrec ||='This Web Page Powered by <B>';
 call w_html ( outrec , stdout );
 outrec   ='<A HREF="http://www.software.ibm.com/ad/pli" TARGET="BLANK">PL/I </A></B>';
 outrec ||='<BR>Using <B>' || trim(GatewayInterface) ||'</B> and <B>';
 outrec ||= trim(SvrProtocol) ||'</B></FONT>';
 call w_html ( outrec , stdout );
 outrec ='<TD WIDTH="20%" align="center" >';

 %if RunsOn = 'MVS'        /* If execution environment is MVS        */
   %then
      %do;
 outrec ||='<img src="http://stplex4b.stl.ibm.com:3091/PUB-BALKBJ/vapli390.jpg"';
     %end;
   %else                   /* If exe environment is Windows          */
      %do;
 outrec ||='<img src="/images/vapli390.jpg"';
      %end;

 outrec ||='width=120 height=100 border=0 ';
 outrec ||='alt="VisualAge PL/I for OS/390!">';
 outrec ||='<TD WIDTH="40%" align="center" >';
 outrec ||='<FONT FACE="Ariel" Size="3">';
 call w_html ( outrec , stdout );
 outrec   ='Let us know how you<A HREF="mailto:balk@us.ibm.com?subject=Ain''t this neat?">';
 outrec ||=' feel.</A><BR><BR>';

 %if RunsOn = 'MVS'        /* If execution environment is MVS        */
   %then
      %do;
 outrec ||='View the <A HREF="http://stplex4b.stl.ibm.com:3091/PUB-BALKBJ/gInfo.txt"';
     %end;
   %else                   /* If exe environment is Windows          */
      %do;
 outrec ||='View the <A HREF="http://localhost/gInfo.txt"';
      %end;

 outrec ||='TARGET="BLANK">PL/I Source.</A></FONT></TABLE>';
 call w_html ( outrec , stdout );

 /* add JavaScript to display debug window */
 call addDebug;

 recover:

 outrec   ='</BODY></HTML>';
 call w_html ( outrec , stdout );

 close file ( stdout );

 end gInfo;


 /*******************************************************************/
 /* addDebug                                                        */
 /*******************************************************************/

 addDebug: proc( ) options( nodescriptor );


 /* write out the javascript function */
 outrec    = '<SCRIPT LANGUAGE="JavaScript">';
 call w_html ( outrec, stdout );
 outrec    = '<!-- hide it from other browsers ';
 call w_html ( outrec, stdout );
 outrec    = 'var myw = null;';
 call w_html ( outrec, stdout );
 outrec   = '  function doDebug() {';
 call w_html ( outrec, stdout );
 outrec   =
 '  myw = window.open("","windowName","height=250,width=600,screenX=200,screenY=400");';
 call w_html ( outrec, stdout );
 outrec   =
 '  myw.document.writeln("<TITLE>Debug Variables from gInfo.pli: </TITLE>");';
 call w_html ( outrec, stdout );

 outrec   = 'myw.document.writeln("<B>bytesRead = </B>' || bytesRead ||'<br>");';
 call w_html ( outrec, stdout );

 outrec   = '  myw.document.writeln("<B>contentIn before parseIt transforms characters = </B><BR>'||
             contentinB4||'<BR>");';
 call w_html ( outrec, stdout );

 outrec   =
 'myw.document.writeln("<B>Values after being processed by parseIt:</B><br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.vintner  = </B>' || rtnPtr->wineDetail.vintner ||'<br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.vyear    = </B>' || rtnPtr->wineDetail.vyear   ||'<br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.appellat = </B>' || rtnPtr->wineDetail.appellat ||'<br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.pDate    = </B>' || rtnPtr->wineDetail.pDate   ||'<br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.mDate    = </B>' || rtnPtr->wineDetail.mDate   ||'<br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.numbttl  = </B>' || rtnPtr->wineDetail.numbttl ||'<br>");';
 call w_html ( outrec, stdout );
 outrec   =
 'myw.document.writeln("<B>wineDetail.comments = </B>' || rtnPtr->wineDetail.comments||'<br>");';
 call w_html ( outrec, stdout );

 outrec   = '  myw.document.close();';
 call w_html ( outrec, stdout );
 outrec   = '  }';
 call w_html ( outrec, stdout );
 outrec   = '  function closeDbg() {';
 call w_html ( outrec, stdout );
 /* outrec   ='  myw.window.close();';*/
 outrec   ='  if (( myw == null) || (myw.closed)) {';
 call w_html ( outrec, stdout );
 outrec   ='       return;';
 call w_html ( outrec, stdout );
 outrec   ='     } else {';
 call w_html ( outrec, stdout );
 outrec   ='       myw.window.close();';
 call w_html ( outrec, stdout );
 outrec   ='     }';
 call w_html ( outrec, stdout );
 outrec   = '  }';
 call w_html ( outrec, stdout );
 outrec    = '// unhide it -->';
 call w_html ( outrec, stdout );
 outrec    = '</SCRIPT>';
 call w_html ( outrec, stdout );


 return;

 end addDebug;

 /*******************************************************************/
 /* w_html                                                          */
 /*******************************************************************/

 w_html: proc( outstr, outfile )
         options( nodescriptor );

   dcl outfile          file;
   dcl outstr           char(*) var nonasgn;

   write file( outfile ) from ( outstr );

   return;

 end w_html;


 end myPkg;

