bvstone

Query To eRPG (QRY2ERPG) - A Blast From the Past

Posted:

Query To eRPG (QRY2ERPG) - A Blast From the Past

After seeing a few articles about IBM's Web Query for i it got me thinking to over 15 years ago when I thought I had stumbled on the end-all beat-all app for the IBM i (well, AS/400 at that time).  I remember my wife and I going out for supper (to Applebees.. yes, it's that clear in my mind still) and I explained it to her.  She looked at me and nodded, showing at least partial interest and maybe even a little understanding.  

I called it Query to eRPG (QRY2RPG).  What it did was allow you to take a query definition (created with Query/400), and then instantly turn that into an eRPG (CGI) program.  

What use was this?  Back then (and even still today) creating web applications with RPG still really hasn't caught on, even though I find it very useful and powerful.  Yes, I probably am a little biased, but during that time there really wasn't anything else.  Then things like Websphere, CGIDEV2, and even my own e-RPG SDK were released.

But back to this application known as QRY2ERPG.  I wanted to see if it still worked, even on my V7R3 machine.  So, I searched my archives for the last version, FTP'd the save file to my IBM i, restored the library and ran the QRY2ERPG command:

QRY2ERPG FROMQRY(MYLIB/ITEMPF) TOFILE(CGILIB/QRPGLESRC) TOMBR(Q_ITEMPF)          

When this was done (and it did complete successfully the first time!) I looked and saw that sure enough, a program object named Q_ITEMPF was placed in CGILIB.  But no source... then I remembered, without a license key it wouldn't save the source.  So, I applied a key, ran the command again, and my source was there!  How's this for a flashback:

      ****************************************************************
      * To Compile:                                                  *
      *                                                              *
      * 1. CRTSQLRPGI OBJ(lib/pgm) SRCFILE(lib/file) +               *
      *     OBJTYPE(*MODULE) TGTRLS(V3R7M0)                          *
      * 2. CRTPGM PGM(cgilib/pgm) MODULE(lib/pgm) +                  *
      *     BNDSRVPGM(QHTTPSVR/QZHBCGI) TGTRLS(V3R7M0)               *
      *                                                              *
      * Module and program must be created with a minimum target     *
      *  release of V3R7M0.                                          *
      *                                                              *
      * Program must be bound with service program QZHBCGI in        *
      *  library QHTTPSVR or your CGI library where a copy of this   *
      *  service program resides.                                    *
      *                                                              *
      * At least *USE authority must be granted to User ID           *
      *  QTMHHTP1 (or the user profile specified on the USER         *
      *  directive of your HTTP Configuration) in order to function. *
      *                                                              *
      * Your HTTP configuration must be set up to allow execution    *
      *  of CGI programs using the EXEC directive.  This directive   *
      *  must specify *.PGM for the extention or you will have to    *
      *  modify the $Footer subrouting to include .PGM to the end    *
      *  of the program name in the hyperlink.                       *
      * EXEC /cgi-bin/* /QSYS.LIB/AS400CGI.LIB/*.PGM                 *
      *                                                              *
      * For more information on e-RPG programming, see the book:     *
      *  "e-RPG: Building Web Applications with RPG" by Bradley      *
      *  V. Stone.  This book is available from Midrange Computing   *
      *  at:                                                         *
      *  http://www.midrangecomputing.com                            *
      *                                                              *
      * Source Created by Query to e-RPG (QRY2ERPG) from BVS/Tools   *
      * https://www.bvstools.com                                      *
      *                                                              *
      ****************************************************************
      ****************************************************************
     D                SDS
     D  W$PGM                  1     10
      *
     D INFDS           DS
     D  F$RRN                397    400B 0
      *
     D WPError         DS
     D  EBytesP                1      4B 0 INZ(40)
     D  EBytesA                5      8B 0
     D  EMsgID                 9     15
     D  EReserverd            16     16
     D  EData                 17     56
      *
      * This is header information that is written to the HTML file first.  The
      * date is used so that caching does not take place and the data is always
      * refreshed.  You will need at least the HTTPHeader and two new line
      * characters.
      *
     D HTTPHeader      C                   CONST('Content-type: text/html')
     D Pragma          C                   CONST('Pragma: no-cache')
     D Expires1        C                   CONST('Expires: Tuesday, October ')
     D Expires2        C                   CONST('26, 1999 10:10:10 GMT')
     D NewLine         C                   CONST(X'15')
      *
     D ITEMPFDS      E DS                  EXTNAME(ITEMPF) PREFIX(T01)
      *
     D CmdStr          S             64
     D ParseFmt        S              8    INZ('CGII0200')
     D TgtBuf          S           1024
     D TgtBufLen       S              9B 0 INZ(%size(TgtBuf))
     D RespLen         S              9B 0
      *
     D WrtDta          S           1024
     D WrtDtaLen       S              9B 0
      *
     D LastRRN         S              9  0
     D LastRRNx        S              9
     D Count           S              4  0
     D i               S              4  0
      ****************************************************************
     C                   EXSR      $Header
     C                   EXSR      $Main
     C                   EXSR      $Footer
      *
     C                   eval      *INLR = *On
      ****************************************************************
      * Write Header data to Browser
      ****************************************************************
     C     $Header       BEGSR
      *
     C                   eval      WrtDta = '<html><head>' +
     C                             '<title>' +
     C                             '</title>' +
     C                             '</head><body>' +
     C                             NewLine
     C                   EXSR      $WrStout
      *
      * This portion writes a stylesheet to format the data in a table.  Character
      *  data is left justified in table cells and numeric data is right justified
      *  in table cells.  For more infomation on stylesheets go to:
      *  http://www.htmlhelp.com/reference/css/
      *  or
      *  http://msdn.microsoft.com/workshop/author/css/css.asp
      *
     C                   eval      WrtDta = '<style type="text/css">' +
     C                                      NewLine +
     C                                      'td.char {font-size: 8pt;' +
     C                                      NewLine +
     C                                      'font-family: ' +
     C                                      '"geneva","arial","verdana";' +
     C                                      'font-weight: normal;' +
     C                                      'text-align: left}' +
     C                                      'td.num {font-size: 8pt;' +
     C                                      NewLine +
     C                                      'font-family: ' +
     C                                      '"geneva","arial","verdana";' +
     C                                      'font-weight: normal;' +
     C                                      'text-align: right}' +
     C                                      NewLine +
     C                                      '</style>' +
     C                                      NewLine
     C                   EXSR      $WrStout
      *
     C                   ENDSR
      ****************************************************************
      * Write Main Data to Browser
      ****************************************************************
     C     $Main         BEGSR
      *
     C                   eval      WrtDta = '<table ' +
     C                             'border="1" ' +
     C                             'cellspacing="0" ' +
     C                             'cellpadding="3" ' +
     C                             '>' + NewLine
     C                   EXSR      $WrStout
      *
     C                   eval      WrtDta = '<tr>' +
     C                             '<td class="char">' +
     C                             'ITITEM' +
     C                             '</td>' +
     C                             '<td class="char">' +
     C                             'ITIDESC' +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             'ITPRICE' +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             'ITQTY' +
     C                             '</td>' +
     C                             '</tr>' +
     C                             Newline
     C                   EXSR      $WrStout
      *
     C/EXEC SQL
     C+ DECLARE C1 DYNAMIC SCROLL CURSOR FOR
     C+ SELECT
     C+ T01.ITITEM,
     C+ T01.ITIDESC,
     C+ T01.ITPRICE,
     C+ T01.ITQTY
     C+  FROM
     C+ MYLIB/ITEMPF T01
     C/END-EXEC
      *
     C/EXEC SQL
     C+ OPEN C1
     C/END-EXEC
      *
     C                   eval      Count = 0
      *
     C                   if        (LastRRN <= 0)
     C                   eval      LastRRN = 1
     C                   endif
      *
     C/EXEC SQL
     C+ FETCH RELATIVE :LastRRN FROM C1 INTO
     C+ :T01ITITEM,
     C+ :T01ITIDESC,
     C+ :T01ITPRICE,
     C+ :T01ITQTY
     C/END-EXEC
      *
     C                   dow       (SQLCOD = 0) and (Count < 30)
     C                   eval      WrtDta = '<tr>' +
     C                             '<td class="char">' +
     C                             %trim(T01ITITEM) +
     C                             '</td>' +
     C                             '<td class="char">' +
     C                             %trim(T01ITIDESC) +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             %trim(%editc(T01ITPRICE:'L')) +
     C                             '</td>' +
     C                             '<td class="num">' +
     C                             %trim(%editc(T01ITQTY:'L')) +
     C                             '</td>' +
     C                             '</tr>' +
     C                             Newline
     C                   EXSR      $WrStout
     C                   eval      Count = (Count + 1)
     C                   eval      LastRRN = (LastRRN + 1)
      *
     C/EXEC SQL
     C+ FETCH C1 INTO
     C+ :T01ITITEM,
     C+ :T01ITIDESC,
     C+ :T01ITPRICE,
     C+ :T01ITQTY
     C/END-EXEC
      *
     C                   enddo
      *
     C                   eval      WrtDta = '</table>' + NewLine
     C                   EXSR      $WrStout
      *
     C                   ENDSR
      ****************************************************************
      * Write Footer Data to Browser
      ****************************************************************
     C     $Footer       BEGSR
      *
     C                   if        (SQLCOD <> 0)
     C                   eval      WrtDta = '<i><b>End of Listing</b></i>'
     C                   else
     C                   MOVE      LastRRN       LastRRNx
     C                   eval      WrtDta = '<a href="' +
     C                             %trim(W$PGM) +
     C                             '?LastRRN=' +
     C                             %trim(LastRRNx) +
     C                             '">Next Page</a>'
     C                   endif
      *
     C                   EXSR      $WrStout
      *
     C                   eval      WrtDta = '</body></html>' +
     C                             NewLine
     C                   EXSR      $WrStout
      *
     C                   ENDSR
      ****************************************************************
      * Call the Write Standard Output API
      ****************************************************************
     C     $WrStout      BEGSR
      *
     C                   eval      WrtDtaLen = %len(%trim(WrtDta))
      *
     C                   CALLB     'QtmhWrStout'
     C                   PARM                    WrtDta
     C                   PARM                    WrtDtaLen
     C                   PARM                    WPError
      *
     C                   ENDSR
      ****************************************************************
      * Call the CGI Parse API
      ****************************************************************
     C     $CGIParse     BEGSR
      *
     C                   CALLB     'QzhbCgiParse'
     C                   PARM                    CmdStr
     C                   PARM      'CGII0200'    ParseFmt
     C                   PARM                    TgtBuf
     C                   PARM                    TgtBufLen
     C                   PARM                    RespLen
     C                   PARM                    WPError
      *
     C                   ENDSR
      ****************************************************************
      * Initialization Subroutine
      ****************************************************************
     C     *INZSR        BEGSR
      *
      * Do Not remove this portion of code.  CGI programs are required to
      *  write header records followed by two new line characters in order
      *  to function properly.  You may remove the Pragma, Expires1 and
      *  Expires2, but then your browser must handle caching.
      *
     C                   eval      WrtDta = %trim(HTTPHeader) +
     C                                      NewLine + Pragma +
     C                                      NewLine + Expires1 +
     C                                      NewLine + Expires2 +
     C                                      NewLine + NewLine
     C                   EXSR      $WrStout
      *
      * Retrieve Query String Environment Variables.
      *
     C                   eval      CmdStr = '-value LastRRN' + X'00'
     C                   EXSR      $CGIParse
      *
      * If the Response Length is zero, then no Query String Environment Variables
      *  existed.  Set the value of LastRRNx to blank.
      *
     C                   if        (RespLen > 0)
     C     X'25'         SCAN      TgtBuf:1      i                        99
     C                   eval      LastRRNx = %trim(%subst(TgtBuf:1:i-1))
     C                   else
     C                   eval      LastRRNx = ' '
     C                   endif
      *
     C                   MOVE      LastRRNx      LastRRN
      *
     C                   ENDSR

When I went to run the program, I noticed that no data was showing up.  The job log quickly showed that my web program didn't have authority to the MYLIB library where the data was stored.  Once granted, I was presented with the following:

https://www.bvstools.com/cgi-bin/q_itempf (which doesn't seem to be working right now... bummer)

A simple but effective eRPG application with built in pagination as well!  The only issue was that the 2nd time I ran it, it also didn't work.  A quick look showed me that there was no close to the SQL cursor.  So, I added that, and it worked great again.

The theory behind this tool was rather simple... retrieve the query definition (which is sql) and wrap an RPG program around it.  Users back then were free to create queries they needed, and Query/400 was the tool to use.  This was before SQL become popular in the midrange world as well.  So, thinking back, I can see why I thought this was going to be quite the utility!  Anyone could easily create eRPG programs in just seconds.

I don't recall why I ended up taking it off my site.  Probably because back then it was a little too early to be forcing web applications on people.   

I haven't yet tried it on any "complex" query definitions yet, but seeing as how this still worked almost 20 years later on V3Rx and now on V7R3, I was pretty impressed and just wanted to share this since I got a good chuckle and a big smile out of something that old...  sort of like when my 64 VW Beetle fires right up the first time.


Last edited 07/17/2018 at 10:07:52




Reply




© Copyright 1983-2024 BVSTools
GreenBoard(v3) Powered by the eRPG SDK, MAILTOOL Plus!, GreenTools for Google Apps, jQuery, jQuery UI, BlockUI, TinyMCE and running on the IBM i (AKA AS/400, iSeries, System i).