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

see changelog

Browse Source
This commit is contained in:
Eddie Runia
1999-06-01 08:54:16 +00:00
parent ca31045bcf
commit 94b8a2082c
4 changed files with 342 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
harbour/ChangeLog
View File

@@ -1,3 +1,9 @@
19990601-09:50 CET Eddie Runia
* include/cgi.ch, tests/working/testcgi.prg
CGI test program added
* tests/working/run_exp.h
GetEnv() added
19990531-23:05 CET Eddie Runia
* source/compiler/harbour.y
determination of symbol scope now correct.

32
harbour/include/cgi.ch Normal file
View File

@@ -0,0 +1,32 @@
// CGI.ch
//+
// Harbour project
//
//
// 99.05.31 initial posting.
//
//
//-
#define CGI_SERVER_SOFTWARE 01
#define CGI_SERVER_NAME 02
#define CGI_GATEWAY_INTERFACE 03
#define CGI_SERVER_PROTOCOL 04
#define CGI_SERVER_PORT 05
#define CGI_REQUEST_METHOD 06
#define CGI_HTTP_ACCEPT 07
#define CGI_HTTP_USER_AGENT 08
#define CGI_HTTP_REFERER 09
#define CGI_PATH_INFO 10
#define CGI_PATH_TRANSLATED 11
#define CGI_SCRIPT_NAME 12
#define CGI_QUERY_STRING 13
#define CGI_REMOTE_HOST 14
#define CGI_REMOTE_ADDR 15
#define CGI_REMOTE_USER 16
#define CGI_AUTH_TYPE 17
#define CGI_CONTENT_TYPE 18
#define CGI_CONTENT_LENGTH 19
#define CGI_ANNOTATION_SERVER 20

4
harbour/tests/working/run_exp.h
View File

@@ -129,6 +129,7 @@ HARBOUR HB_FGOTO();
HARBOUR HB_FEOF();
HARBOUR HB_FREADLN();
HARBOUR HB_FSKIP();
HARBOUR GETENV();
/* Same story.
@@ -260,7 +261,8 @@ static SYMBOL symbols[] = {
{ "HB_FGOTO", FS_PUBLIC, HB_FGOTO , 0 },
{ "HB_FEOF", FS_PUBLIC, HB_FEOF , 0 },
{ "HB_FREADLN", FS_PUBLIC, HB_FREADLN , 0 },
{ "HB_FSKIP", FS_PUBLIC, HB_FSKIP , 0 }
{ "HB_FSKIP", FS_PUBLIC, HB_FSKIP , 0 },
{ "GETENV", FS_PUBLIC, GETENV , 0 }
};

301
harbour/tests/working/testcgi.prg Normal file
View File

@@ -0,0 +1,301 @@
/*
*
* TestCGI.PRG
* Harbour Test of a CGI/HTML-Generator class.
*
* 1999/05/30 First implementation.
*
* Tips: - Use ShowResults to make dynamic html (to test dynamic
* results, put the exe file on CGI-BIN dir or equivalent);
* - Use SaveToFile to make static html page
*
* 1999/05/31 Initial CGI functionality.
* 1999/06/01 Translated %nn to correct chars.
*
**/
#include "CGI.ch"
#define NewLine chr(10)+chr(13)
FUNCTION Main()
LOCAL oHTML := THTML():New()
LOCAL cName := ""
cName := oHTML:QueryFields( "NAME" )
oHTML:SetTitle( "Harbour CGI Scripting Demo" )
oHTML:AddHead( "Harbour CGI Scripting DEMO" )
oHTML:AddPara( "<UL>" + NewLine + ;
"<LI>Name: " + oHTML:QueryFields( "Name" ) + NewLine + ;
"<LI>Phone: " + oHTML:QueryFields( "Phone" ) + NewLine + ;
"<LI>Address: " + oHTML:QueryFields( "Address" ) + NewLine + ;
"</UL><P><HR><SMALL><CENTER>Copyright &copy 1999 by Harbour Project" + ;
"<BR>Generated at: " + dtoc( date() ) + " - " + time(), "LEFT" )
oHTML:Generate()
// Uncomment the following if you don't have a Web Server to test
// this sample
// oHTML:SaveToFile( "test.htm" )
// If the above is uncommented, you may comment this line:
oHTML:ShowResult()
RETURN( NIL )
FUNCTION Hex2Dec( cHex )
LOCAL aHex := { { "0", 00 }, ;
{ "1", 01 }, ;
{ "2", 02 }, ;
{ "3", 03 }, ;
{ "4", 04 }, ;
{ "5", 05 }, ;
{ "6", 06 }, ;
{ "7", 07 }, ;
{ "8", 08 }, ;
{ "9", 09 }, ;
{ "A", 10 }, ;
{ "B", 11 }, ;
{ "C", 12 }, ;
{ "D", 13 }, ;
{ "E", 14 }, ;
{ "F", 15 } }
LOCAL nRet
LOCAL nRes
nRet := ascan( aHex, { |x| upper( x[1] ) = upper( left( cHex, 1 ) ) } )
nRes := aHex[nRet, 2] * 16
nRet := ascan( aHex, { |x| upper( x[1] ) = upper( right( cHex, 1 ) ) } )
nRes += aHex[nRet, 2]
RETURN( nRes )
/*-------------------------------------------------------------------------*/
FUNCTION THTML
STATIC oClass
IF oClass == NIL
oClass = TClass():New( "THTML" )
oClass:AddData( "cTitle" ) // Page Title
oClass:AddData( "cBody" ) // HTML Body Handler
oClass:AddData( "cBGColor" ) // Background Color
oClass:AddData( "cLinkColor" ) // Link Color
oClass:AddData( "cvLinkColor" ) // Visited Link Color
oClass:AddData( "cContent" ) // Page Content Handler
oClass:AddData( "aCGIContents" )
oClass:AddData( "aQueryFields" )
oClass:AddMethod( "New", @New() ) // New Method
oClass:AddMethod( "SetTitle", @SetTitle() ) // Set Page Title
oClass:AddMethod( "AddHead", @AddHead() ) // Add <H1> Header
oClass:AddMethod( "AddLink", @AddLink() ) // Add Hyperlink
oClass:AddMethod( "AddPara", @AddPara() ) // Add Paragraph
oClass:AddMethod( "SaveToFile", @SaveToFile() ) // Saves Content to File
oClass:AddMethod( "ShowResult", @ShowResult() ) // Show Result - SEE Fcn
oClass:AddMethod( "Generate", @Generate() ) // Generate HTML
oClass:AddMethod( "ProcessCGI", @ProcessCGI() )
oClass:AddMethod( "GetCGIParam", @GetCGIParam() )
oClass:AddMethod( "QueryFields", @QueryFields() )
oClass:Create()
ENDIF
RETURN( oClass:Instance() )
STATIC FUNCTION New()
LOCAL Self := QSelf()
::cTitle := "Untitled"
::cBGColor := "#FFFFFF"
::cLinkColor := "#0000FF"
::cvLinkColor := "#FF0000"
::cContent := ""
::cBody := ""
::aCGIContents := {}
::aQueryFields := {}
RETURN( Self )
STATIC FUNCTION SetTitle( cTitle )
LOCAL Self := QSelf()
::cTitle := cTitle
RETURN( Self )
STATIC FUNCTION AddLink( cLinkTo, cLinkName )
LOCAL Self := QSelf()
::cBody := ::cBody + ;
"<A HREF='" + cLinkTo + "'>" + cLinkName + "</A>"
RETURN( Self )
STATIC FUNCTION AddHead( cDescr )
LOCAL Self := QSelf()
// Why this doesn't work?
// ::cBody += ...
// ???
::cBody := ::cBody + ;
"<H1>" + cDescr + "</H1>"
RETURN( NIL )
STATIC FUNCTION AddPara( cPara, cAlign )
LOCAL Self := QSelf()
::cBody := ::cBody + ;
"<P ALIGN='" + cAlign + "'>" + NewLine + ;
cPara + NewLine + ;
"</P>"
RETURN( Self )
STATIC FUNCTION Generate()
LOCAL Self := QSelf()
::cContent := ;
"<HTML><HEAD>" + NewLine + ;
"<TITLE>" + ::cTitle + "</TITLE>" + NewLine + ;
"<BODY link='" + ::cLinkColor + "' " + ;
"vlink='" + ::cvLinkColor + "'>" + + NewLine + ;
::cBody + NewLine + ;
"</BODY></HTML>"
RETURN( Self )
STATIC FUNCTION ShowResult()
LOCAL Self := QSelf()
qqOut( ;
"HTTP/1.0 200 OK" + NewLine + ;
"CONTENT-TYPE: TEXT/HTML" + NewLine + NewLine + ;
::cContent )
RETURN( Self )
STATIC FUNCTION SaveToFile( cFile )
LOCAL Self := QSelf()
LOCAL hFile := fCreate( cFile )
fWrite( hFile, ::cContent )
fClose( hFile )
RETURN( Self )
STATIC FUNCTION ProcessCGI()
LOCAL Self := QSelf()
LOCAL cQuery := ""
LOCAL cBuff := ""
LOCAL nBuff := 0
LOCAL i
IF empty( ::aCGIContents )
::aCGIContents := { ;
GetEnv( "SERVER_SOFTWARE" ), ;
GetEnv( "SERVER_NAME" ), ;
GetEnv( "GATEWAY_INTERFACE" ), ;
GetEnv( "SERVER_PROTOCOL" ), ;
GetEnv( "SERVER_PORT" ), ;
GetEnv( "REQUEST_METHOD" ), ;
GetEnv( "HTTP_ACCEPT" ), ;
GetEnv( "HTTP_USER_AGENT" ), ;
GetEnv( "HTTP_REFERER" ), ;
GetEnv( "PATH_INFO" ), ;
GetEnv( "PATH_TRANSLATED" ), ;
GetEnv( "SCRIPT_NAME" ), ;
GetEnv( "QUERY_STRING" ), ;
GetEnv( "REMOTE_HOST" ), ;
GetEnv( "REMOTE_ADDR" ), ;
GetEnv( "REMOTE_USER" ), ;
GetEnv( "AUTH_TYPE" ), ;
GetEnv( "CONTENT_TYPE" ), ;
GetEnv( "CONTENT_LENGTH" ), ;
GetEnv( "ANNOTATION_SERVER" ) ;
}
cQuery := ::GetCGIParam( CGI_QUERY_STRING )
IF !empty( cQuery )
::aQueryFields := {}
FOR i := 1 TO len( cQuery ) + 1
IF i > len( cQuery ) .OR. substr( cQuery, i, 1 ) == "&"
aadd( ::aQueryFields, ;
{ substr( cBuff, 1, at( "=", cBuff ) - 1 ), ;
strtran( substr( cBuff, at( "=", cBuff ) + 1, ;
len( cBuff ) - at( "=", cBuff ) + 1 ), "+", " " ) } )
cBuff := ""
ELSE
IF substr( cQuery, i, 1 ) = "%"
cBuff += chr( Hex2Dec( substr( cQuery, i + 1, 2 ) ) )
nBuff := 3
ENDIF
IF nBuff = 0
cBuff += substr( cQuery, i, 1 )
ELSE
nBuff--
ENDIF
ENDIF
NEXT
ENDIF
ENDIF
RETURN( Self )
STATIC FUNCTION GetCGIParam( nParam )
LOCAL Self := QSelf()
::ProcessCGI()
IF nParam > 20 .OR. nParam < 1
outerr( "Invalid CGI parameter" )
RETURN( NIL )
ENDIF
RETURN( ::aCGIContents[nParam] )
STATIC FUNCTION QueryFields( cQueryName )
LOCAL Self := QSelf()
LOCAL cRet := ""
LOCAL nRet
::ProcessCGI()
nRet := aScan( ::aQueryFields, ;
{ |x| upper( x[1] ) = upper( cQueryName ) } )
IF nRet > 0
cRet := ::aQueryFields[nRet, 2]
ENDIF
RETURN( cRet )