fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2009-06-15 18:47 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* utils/hbmk2/hbmk2.prg
    - Deleted hb_DirBase() DJGPP hack after Przemek's fix.
    - Deleted gcc compiler command line hack after Przemek's fix.

  * contrib/hbxbp/xbp.ch
    + Added extra protection for Windows-only debug line.

  * contrib/hbxbp/apig.ch
    * Minor in comment.

  * contrib/rddado/adordd.prg
    * Minor formatting.
    * Changed it to use non-legacy OLE interface.
      PLEASE REVIEW & TEST.

  * contrib/hbwin/legacy.prg
    + Added support for TOleAuto():cClassName var.
    + Added RTE generation in case the OLE object cannot be created.
      PLEASE REVIEW & TEST.

  + contrib/rddado/tests/test.mdb
    + Added. It's generated by access2.prg to avoid any problems.

  * contrib/rddado/tests/access1.prg
    * Minor formatting.
    ; TOFIX: Does't work:
      ---
      Error BASE/3012  Argument error: OPEN
      Called from WIN_OLEAUTO:OPEN(0)
      Called from ADO_OPEN(0)
      Called from DBUSEAREA(0)
      Called from MAIN(11)
      ---

  - examples/uhttpd
  + examples/httpsrv
  - examples/httpsrv/uhttpd.ini
  + examples/httpsrv/httpsrv.ini
  - examples/httpsrv/uhttpdgd.hbp
  + examples/httpsrv/httpsrvg.hbp
  - examples/httpsrv/uhttpdc.c
  + examples/httpsrv/httpsrvc.c
  - examples/httpsrv/uhttpd.prg
  + examples/httpsrv/httpsrv.prg
  * examples/httpsrv/cookie.prg
  * examples/httpsrv/cgifunc.prg
  * examples/httpsrv/session.prg
  * examples/httpsrv/readme.txt
    * Renamed uhttpd to httpsrv.
      NOTE: If there are better names proposed I can rename 
            it to anything else. Mindaugas's new uhttpd will 
            be name uhttpd2 to avoid any ambiguity.
This commit is contained in:
Viktor Szakats
2009-06-15 18:02:57 +00:00
parent 69941dbb06
commit 91bd1aee41
35 changed files with 245 additions and 154 deletions
Download Patch File Download Diff File Expand all files Collapse all files

116
harbour/examples/httpsrv/modules/cookie.prg Normal file
View File

@@ -0,0 +1,116 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* uHTTPD cookie example
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#include "hbclass.ch"
MEMVAR _REQUEST
#xcommand TEXT INTO <v> => #pragma __cstream|<v>+=%s
//#pragma escapedstrings = on
FUNCTION HRBMAIN()
LOCAL cHtml := ""
LOCAL cCookie := uhttpd_GetField( "mycookie" )
LOCAL cAction := uhttpd_GetField( "action" )
LOCAL oCookie
//hb_ToOutDebug( "cCookie = %s, cAction = %s\n\r", hb_ValToExp( cCookie ), cAction )
DEFAULT cCookie TO ""
DEFAULT cAction TO ""
// Sample page embedded
TEXT INTO cHtml
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Harbour uHTTPD Server cookie example</title>
<link rel="shortcut icon" href="favicon.ico" type="image/x-icon" />
</head>
<body>
<h1>Simple uHTTPD server cookie example</h1>
<br />
<br />
<form name=test action="/cgi-bin/cookie.hrb" method="post">
Type something: <input type="text" name="mycookie" value="<%COOKIE_VALUE%>">
<input type="submit">
<input type="hidden" name="action" value="gotoinfo">
</form>
Pressing button you will redirect to /info page. Look at COOKIE values.
<br>You will see a "mycookie" variable name.
<br>
<br>Return to <a href="/">Main Page</a>
</body>
</html>
ENDTEXT
IF Empty( cAction )
// Set a simple cookie
oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
// cleaning previous cookie
oCookie:DeleteCookie( "mycookie" )
cHtml := StrTran( cHtml, "<%COOKIE_VALUE%>", cCookie )
ELSEIF cAction == "gotoinfo"
// Set a simple cookie
oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
oCookie:SetCookie( "mycookie", cCookie )
uhttpd_SetHeader( "Location", "/info" )
//uhttpd_Write( "cookie set <a href='/info'>Go to info page</a>" )
RETURN NIL
ENDIF
RETURN cHtml

144
harbour/examples/httpsrv/modules/info.prg Normal file
View File

@@ -0,0 +1,144 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* uHTTPD info page
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/*
Show internal variables.
Call it with: /info
*/
#include "common.ch"
#include "hbclass.ch"
MEMVAR _SERVER, _REQUEST, _GET, _POST, _COOKIE, _SESSION, _HTTP_REQUEST, _HTTP_RESPONSE
FUNCTION HRBMAIN()
LOCAL cHtml
cHtml := ShowServerInfo()
RETURN cHtml
STATIC FUNCTION ShowServerInfo()
LOCAL cHtml := ""
//LOCAL oCookie
cHtml += "<BIG>Server Info</BIG>"
//cHtml += "<br><br>If it is first time you see this page reload it to see cookies<br><br>"
cHtml += '<br><br>Return to <a href="/">Main Page</a><br><br>'
cHtml += DisplayVars( _Server , "SERVER Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _HTTP_REQUEST , "HTTP Request Headers" )
cHtml += "<br>"
cHtml += DisplayVars( _HTTP_RESPONSE, "HTTP Response Headers" )
cHtml += "<br>"
cHtml += DisplayVars( _Get , "GET Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _Post , "POST Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _Cookie , "COOKIE Vars" )
cHtml += "<br>"
//cHtml += DisplayVars( _Files , "FILE Vars" )
//cHtml += "<br>"
cHtml += DisplayVars( _Request , "REQUEST Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _Session , "SESSION Vars" )
cHtml += "<br>"
// Set a simple cookie
//oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
//oCookie:SetCookie( "samplecookie", "test" )
//oCookie:SetCookie( "samplecookie2", "test2" )
_SESSION[ "Session_Var1" ] := "Test1"
_SESSION[ "Session_Var2" ] := "Test2"
RETURN cHtml
STATIC FUNCTION DisplayVars( hHash, cTitle )
LOCAL cHtml := ""
cHtml += "<table width='90%' align='center' border='1'>"
cHtml += "<th colspan=2>" + hb_cStr( cTitle ) + "</th>"
cHtml += "<tr>"
cHtml += "<th width='20%'>KEY</th>"
cHtml += "<th width='80%'>VALUE</th>"
cHtml += "</tr>"
cHtml += DisplayHash( hHash )
cHtml += "</table>"
RETURN cHtml
STATIC FUNCTION DisplayHash( hHash )
LOCAL cHtml := ""
LOCAL cKey, cSubKey, xValue
FOR EACH cKey IN hHash:Keys
cHtml += "<tr>"
IF HB_ISHASH( hHash[ cKey ] )
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>-------</td>"
FOR EACH cSubKey IN hHash[ cKey ]:Keys
xValue := hHash[ cKey ][ cSubKey ]
cHtml += "<tr>"
cHtml += "<td>" + hb_cStr( cSubKey ) + "</td>"
cHtml += "<td>" + IIF( Empty( xValue ), "<i>no value</i>", hb_cStr( xValue ) ) + "</td>"
cHtml += "</tr>"
NEXT
ELSE
xValue := hHash[ cKey ]
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>" + IIF( Empty( xValue ), "<i>no value</i>", hb_cStr( xValue ) ) + "</td>"
ENDIF
cHtml += "</tr>"
NEXT
RETURN cHtml

225
harbour/examples/httpsrv/modules/showcounter.prg Normal file
View File

@@ -0,0 +1,225 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* simple image counter
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#if defined( GD_SUPPORT )
MEMVAR _SERVER // defined in uHTTPD
MEMVAR _REQUEST // defined in uHTTPD
#include "common.ch"
//#include "xhb.ch"
#include "gd.ch"
#ifdef __PLATFORM__UNIX
#define IMAGES_IN "../../hbgd/tests/digits/"
#define IMAGES_OUT ( _SERVER[ "DOCUMENT_ROOT" ] + "/counter/" )
#else
#define IMAGES_IN "..\..\hbgd\tests\digits\"
#define IMAGES_OUT ( _SERVER[ "DOCUMENT_ROOT" ] + "\counter\" )
#endif
#define DISPLAY_NUM 10
FUNCTION HRBMAIN()
LOCAL cHtml
//LOCAL cBaseImage
IF HB_HHasKey( _REQUEST, "w" )
cHtml := CreateCounter( AllTrim( Str( Val( _REQUEST[ "w" ] ) ) ) )
//hb_ToOutDebug( hb_sprintf( "CreateCounter = %s", cHtml ) )
IF !Empty( cHtml )
uhttpd_SetHeader( "Content-Type", "image/gif" )
uhttpd_SetHeader( "Pragma", "no-cache" )
uhttpd_SetHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" )
uhttpd_Write( cHtml )
ELSE
uhttpd_SetHeader( "Content-Type", "text/html" )
uhttpd_Write( "<h1>Error: No image created</h1>" )
ENDIF
ELSE
uhttpd_SetHeader( "Content-Type", "text/html" )
uhttpd_Write( "<h1>Error: no parameters passed</h1>" )
ENDIF
RETURN TRUE
STATIC FUNCTION CreateCounter( cValue, cBaseImage )
LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp
//LOCAL black, white, blue, red, green, cyan, gray
//LOCAL white
LOCAL aNumberImages := {}
LOCAL n, nValue
//LOCAL cFile
// A value if not passed
DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM )
DEFAULT cBaseImage TO "57chevy.gif"
IF !File( IMAGES_IN + cBaseImage )
//hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
//THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
RETURN NIL
ENDIF
nValue := Val( cValue )
// Fix num lenght
IF nValue > 10^DISPLAY_NUM
nValue := 10^DISPLAY_NUM
ENDIF
cValue := StrZero( nValue, DISPLAY_NUM )
//? "Value = ", cValue
// To set fonts run this command:
// for windows: SET GDFONTPATH=c:\windows\fonts
// per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType
// SET GDFONTPATH=c:\windows\fonts
//IF GetEnv( "GDFONTPATH" ) == ""
// ? "Please set GDFONTPATH"
// ? "On Windows: SET GDFONTPATH=c:\windows\fonts"
// ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType"
// ?
//ENDIF
// Check output directory
/*
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
*/
/* Load a digits image in memory from file */
oIDigits := GDImage():LoadFromGif( IMAGES_IN + cBaseImage )
/* Get single number images */
// Get dimensions
nWidth := oIDigits:Width()
nHeight := oIDigits:Height()
// Check base digits image
DO CASE
CASE nWidth % 10 == 0 // 0..9 digits
nDigits := 10
CASE nWidth % 11 == 0 // 0..9 :
nDigits := 11
CASE nWidth % 13 == 0 // 0..9 : am pm
nDigits := 13
OTHERWISE
uhttpd_Write( "Error on digits image" )
ENDCASE
nNumWidth := nWidth / nDigits
//? "nNumWidth, nWidth, nHeight, nDigits = ", nNumWidth, nWidth, nHeight, nDigits
/* extracts single digits */
FOR n := 1 TO nDigits
oTemp := oIDigits:Copy( (n - 1) * nNumWidth, 0, nNumWidth, nHeight )
//oTemp:SaveGif( IMAGES_OUT + StrZero( n-1, 2 ) + ".gif" )
// Here I have to clone the image, otherwise on var destruction I loose
// the image in memory
aAdd( aNumberImages, oTemp:Clone() )
NEXT
/* Create counter image in memory */
oI := GDImage():New( nNumWidth * DISPLAY_NUM, nHeight ) // the counter
//? "Image dimensions: ", oI:Width(), oI:Height()
/* Allocate background */
//white := oI:SetColor( 255, 255, 255 )
/* Allocate drawing color */
//black := oI:SetColor( 0, 0, 0 )
//blue := oI:SetColor( 0, 0, 255 )
//red := oI:SetColor( 255, 0, 0 )
//green := oI:SetColor( 0, 255, 0 )
//cyan := oI:SetColor( 0, 255, 255 )
/* Draw rectangle */
//oI:Rectangle( 0, 0, 200, 30, , blue )
/* Draw Digits */
FOR n := 1 TO Len( cValue )
// Retrieve the number from array in memory
oTemp := aNumberImages[ Val( SubStr( cValue, n, 1 ) ) + 1 ]:Clone()
// Save it to show the number for a position
//oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" )
// Set the digit as tile that I have to use to fill position in counter
oI:SetTile( oTemp )
// Fill the position with the image digit
oI:Rectangle( (n - 1) * nNumWidth, 0, (n - 1) * nNumWidth + nNumWidth, nHeight, TRUE, gdTiled )
NEXT
/* Write Final Counter Image */
//cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif"
//oI:SaveGif( IMAGES_OUT + cFile )
/* Destroy images in memory */
// Class does it automatically
//?
//? "Look at " + IMAGES_OUT + " folder for output images"
//?
//RETURN cFile
RETURN oI:ToStringGif()
#endif

404
harbour/examples/httpsrv/modules/tableservletdb.prg Normal file
View File

@@ -0,0 +1,404 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* xml table servlet
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#include "hbclass.ch"
#define CRLF ( chr(13)+chr(10) )
#ifdef __PLATFORM__WINDOWS
#define TABLE_NAME_PATH "..\..\..\..\tests\test.dbf"
#else
#define TABLE_NAME_PATH "../../../../tests/test.dbf"
#endif
#define SIMULATE_SLOW_REPLY
MEMVAR _REQUEST // defined in uHTTPD
FUNCTION HRBMAIN()
LOCAL cXml, cPage, cCount, nCount
LOCAL oTM
LOCAL hGets
hGets := _REQUEST
DEFAULT hGets TO hb_Hash()
IF HB_HHasKey( hGets, "page" )
cPage := hGets[ "page" ]
oTM := TableManager():New()
IF ( oTM:Open() )
oTM:Read()
cXml := oTM:getXmlData( Val( cPage ) )
oTM:Close()
ENDIF
ELSEIF HB_HHasKey( hGets, "count" )
cCount := hGets[ "count" ]
IF cCount == "true"
oTM := TableManager():New()
IF ( oTM:Open() )
nCount := oTM:getLastRec()
cXml := oTM:getXmlCount( nCount )
oTM:Close()
ENDIF
ENDIF
ENDIF
IF !Empty( cXml )
uhttpd_SetHeader( "Content-Type", "text/xml" )
// cache control
uhttpd_SetHeader( "Cache-Control", "no-cache, must-revalidate" )
uhttpd_SetHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" )
uhttpd_Write( cXml )
ELSE
uhttpd_SetHeader("Content-Type", "text/xml")
uhttpd_Write( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
uhttpd_Write( '<pages><page>No Data</page></pages>' )
ENDIF
RETURN TRUE // I Handle HTML Output
/*
TableManager
*/
CLASS TableManager
CLASSVAR ROWS_PER_PAGE INIT 23
VAR aData INIT {}
VAR cTable INIT TABLE_NAME_PATH
VAR lOpened INIT FALSE
METHOD New()
METHOD Open()
METHOD Close() INLINE IIF( ::lOpened, ( table->( dbCloseArea() ), ::lOpened := FALSE ), )
METHOD Read()
METHOD getLastRec() INLINE table->( LastRec() )
METHOD getXmlData()
METHOD getXmlCount()
METHOD xmlEncode( input )
ENDCLASS
METHOD New() CLASS TableManager
RETURN Self
METHOD Open() CLASS TableManager
LOCAL cDBF := ::cTable
IF !::lOpened
CLOSE ALL
USE ( cDBF ) ALIAS table SHARED NEW
//hb_ToOutDebug( "cDBF = %s, Used() = %s\n", cDBF, Used() )
::lOpened := USED()
ENDIF
RETURN ::lOpened
METHOD Read() CLASS TableManager
LOCAL hMap, lOk := FALSE
#ifdef SIMULATE_SLOW_REPLY
// force slow connection to simulate long reply
HB_IDLESLEEP(0.5)
#endif
IF ::lOpened
table->( dbGoTop() )
//n := 0
DO WHILE table->( !Eof() ) //.AND. ++n < 50
hMap := hb_Hash()
hMap[ "recno" ] := StrZero( table->( RecNo() ), 4 )
hMap[ "name" ] := RTrim( table->first ) + " " + RTrim( table->last )
hMap[ "address" ] := RTrim( table->street )
hMap[ "city" ] := RTrim( table->city )
hMap[ "state" ] := table->state
hMap[ "zip" ] := table->zip
aAdd( ::aData, hMap )
table->( dbSkip() )
ENDDO
lOk := TRUE
ENDIF
RETURN lOK
/**
* Builds a <code>String</code> of XML representing the aData for the
* request table.
*
* For simplicity, we are using a hard-coded data set. In a production
* system, you may wish to use DAOs to query a database for specific table
* data. This may require additional parameters (e.g., the name of the
* table, which could be used to look up instructions on retrieving the
* necessary data).
*
* The returned XML will be formatted as follows:
* &lt;table&gt;<br />
* &lt;header&gt;<br />
* &lt;cell key="address"&gt;Address&lt;/cell&gt;<br />
* &lt;/header&gt;<br />
* &lt;row&gt;<br />
* &lt;cell key="name"&gt;Hank&lt;/cell&gt;<br />
* &lt;cell key="address"&gt;1B Something Street&lt;/cell&gt;<br />
* &lt;cell key="city"&gt;Marietta&lt;/cell&gt;<br />
* &lt;cell key="state"&gt;GA&lt;/cell&gt;<br />
* &lt;cell key="zip"&gt;30339&lt;/cell&gt;<br />
* &lt;/row&gt;<br />
* ...<br />
* &lt;/table&gt;
*
* @param page
* the page number to retrieve data for
* @return a <code>String</code> of XML representing data for the
* requested table
* @throws IllegalArgumentException
*/
METHOD getXmlData( page ) CLASS TableManager
LOCAL startIndex, stopIndex
LOCAL xml, i, map, key, cString
/*
* For simplicity, we are creating XML as a String. In a production
* system, you should create an XML document (org.w3c.dom.Document) to
* ensure compliance with the DOM Level 2 Core Specification.
*/
// Calculate the start and end indexes of the table data.
startIndex := (page - 1) * ::ROWS_PER_PAGE
stopIndex := startIndex + ::ROWS_PER_PAGE
stopIndex := Min( Len( ::aData ), stopIndex )
// Check the validity of the page index.
IF ( startIndex < 0 .OR. startIndex >= stopIndex )
//throw new IllegalArgumentException("Page index is out of bounds.");
ENDIF
xml := BasicXML():New()
xml:append( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
// Add the opening <table> tag
xml:append( "<table>" )
// Add nodes describing the table columns
xml:append( "<header>" )
xml:append( '<cell key="recno">RecNo</cell>')
xml:append( '<cell key="name">Name</cell>')
xml:append( '<cell key="address">Address</cell>' )
xml:append( '<cell key="city">City</cell>' )
xml:append( '<cell key="state">State</cell>' )
xml:append( '<cell key="zip">Zip</cell>' )
xml:append( "</header>" )
// Add nodes for each row.
FOR i := startIndex + 1 TO stopIndex
map := ::aData[ i ]
// Add the opening <row> tag
xml:append( "<row>" )
// For each entry in the HashMap, add a node
// e.g., <address>123 four street</address>
FOR EACH key IN map:Keys
cString := '<cell key="' + key + '">'
cString += ::xmlEncode( hb_cStr( map[ key ] ) )
cString += "</cell>"
xml:append( cString )
NEXT
// Add the closing </row> tag
xml:append( "</row>" )
NEXT
// Add the closing </table> tag
xml:append( "</table>" )
RETURN xml:toString()
METHOD getXmlCount( nCount ) CLASS TableManager
LOCAL xml, n
LOCAL nPages := nCount / ::ROWS_PER_PAGE
IF Int( nPages ) < nPages
nPages++
ENDIF
xml := BasicXML():New()
xml:append( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
xml:append( "<pages>" )
FOR n := 1 TO nPages
xml:append( "<page>" + LTrim( Str( n ) ) + "</page>" )
NEXT
xml:append( "</pages>" )
RETURN xml:toString()
/**
* Replaces characters commonly used in XML with symbolic representations
* such that they are interpretted correctly by XML parsers.
*
* @param input
* the string to encode.
* @return the encoded version of the specified string
*/
METHOD xmlEncode( input ) CLASS TableManager
LOCAL out, i, c
IF input == NIL
RETURN input
ENDIF
// Go through the input string and replace the following
// characters:
// & &amp;
// ' &apos;
// " &quot;
// < &lt;
// > &gt;
// [any non-ascii character] &#[character code];
out := ""
FOR i := 1 TO Len( input )
c := SubStr( input, i, 1 )
switch ( c )
case '&'
out += "&amp;"
exit
case "'"
out += "&apos;"
exit
case '"'
out += "&quot;"
exit
case '<'
out += "&lt;"
exit
case '>'
out += "&gt;"
exit
//case ' '
// out += "&nbsp;"
// exit
case Chr( 9 ) //E'\t'
case Chr( 13 ) //E'\r'
case Chr( 10 ) //E'\n'
out += c
exit
OTHERWISE
// All non-ascii
if ( Asc( c ) <= 0x1F .OR. Asc( c ) >= 0x80 )
out += "&#x" + hb_NumToHex( Asc( c ) ) + ";"
else
out += c
endif
exit
end
NEXT
RETURN out
CLASS BasicXML
VAR aData INIT {}
METHOD New() CONSTRUCTOR
METHOD Append( cString ) INLINE aAdd( ::aData, cString )
METHOD ToString()
ENDCLASS
METHOD New() CLASS BasicXML
RETURN Self
METHOD ToString() CLASS BasicXML
LOCAL s := ""
aEval( ::aData, {|c| s += c + IIF( Right( c, 1 ) == ">", CRLF, "" ) } )
RETURN s

69
harbour/examples/httpsrv/modules/testajax.prg Normal file
View File

@@ -0,0 +1,69 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* simple ajax responder
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
MEMVAR _REQUEST
FUNCTION HRBMAIN()
LOCAL cW
LOCAL cHtml := ""
IF HB_HHasKey( _REQUEST, "w" )
IF !Empty( cW := _REQUEST[ "w" ] )
cHtml += "This is a reply from testajax : " + cW
ENDIF
ENDIF
RETURN cHtml