     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( '<b>ERROR</b> - 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 = '<string>'
                        + %char(YEAR)
                        + '</string>'
                        ;
                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 = '<number>'
                        + %char(VALUE)
                        + '</number>'
                        ;
                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.....<p>' +
               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
