From 33193764bf478e52c3e6cada6aaee89bb0426d3f Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sat, 9 Oct 1999 10:07:23 +0000 Subject: [PATCH] 19991007-19:40 GMT+1 --- harbour/ChangeLog | 25 +- harbour/samples/Makefile | 12 + harbour/samples/guestbk/Makefile | 24 ++ .../bldguest.bat => guestbk/bld_b32.bat} | 3 + harbour/samples/guestbk/cgi.ch | 36 ++ .../samples/{hscript => guestbk}/guestbk.htm | 0 .../samples/{hscript => guestbk}/guestbk.ini | 0 .../samples/{hscript => guestbk}/guestbk.prg | 6 +- .../samples/{hscript => guestbk}/guestbk.txt | 0 harbour/samples/guestbk/inifiles.prg | 311 ++++++++++++++ harbour/samples/guestbk/testcgi.prg | 385 ++++++++++++++++++ harbour/samples/hscript/Makefile | 22 + harbour/samples/hscript/bld32exe.bat | 27 -- harbour/samples/hscript/bld_b32.bat | 8 + harbour/samples/hscript/dir.hs | 10 +- harbour/samples/hscript/hb32.bat | 10 - harbour/samples/hscript/hscript.prg | 118 +++--- harbour/samples/hscript/makehs.bat | 2 - harbour/samples/hscript/makehtm.bat | 13 +- harbour/samples/misc/Makefile | 47 +++ harbour/{tests => samples/misc}/guess.prg | 6 +- harbour/{tests => samples/misc}/mankala.prg | 6 +- harbour/tests/Makefile | 2 - harbour/tests/testcgi.prg | 20 +- 24 files changed, 964 insertions(+), 129 deletions(-) create mode 100644 harbour/samples/Makefile create mode 100644 harbour/samples/guestbk/Makefile rename harbour/samples/{hscript/bldguest.bat => guestbk/bld_b32.bat} (96%) create mode 100644 harbour/samples/guestbk/cgi.ch rename harbour/samples/{hscript => guestbk}/guestbk.htm (100%) rename harbour/samples/{hscript => guestbk}/guestbk.ini (100%) rename harbour/samples/{hscript => guestbk}/guestbk.prg (99%) rename harbour/samples/{hscript => guestbk}/guestbk.txt (100%) create mode 100644 harbour/samples/guestbk/inifiles.prg create mode 100644 harbour/samples/guestbk/testcgi.prg create mode 100644 harbour/samples/hscript/Makefile delete mode 100644 harbour/samples/hscript/bld32exe.bat create mode 100644 harbour/samples/hscript/bld_b32.bat delete mode 100644 harbour/samples/hscript/hb32.bat delete mode 100644 harbour/samples/hscript/makehs.bat create mode 100644 harbour/samples/misc/Makefile rename harbour/{tests => samples/misc}/guess.prg (98%) rename harbour/{tests => samples/misc}/mankala.prg (99%) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 2bdc8096c0..73fe506b7c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,27 @@ +19991007-19:40 GMT+1 Victor Szel + * tests/mankala.prg -> samples/misc/mankala.prg + tests/guess.prg -> samples/misc/guess.prg + tests/Makefile + * Sample type of tests moved to /samples directory + * samples/hscript/guest*.* -> samples/guestbk/*.* + * Separated hscript and guestbk. + * samples/hscript/*.bat + samples/guestbk/*.bat + + Borland build batch files updated, standardized. + ! Fixed some issues, hb_OSNewLine() usage added, some RTL function + names updated, minor fixes applied, now both works with the GNU make + system (tested with MINGW32) + + samples/Makefile + samples/guestbk/Makefile + samples/hscript/Makefile + samples/misc/Makefile + + GNU make files added for the samples. + They are currently not invoked by the mainstream make process, but + can be invoked manually. + * tests/testcgi.prg + % Got rid of s_cNewLine, so the HTML class no longer requires this + variable. + 19991008-20:00 CET Eddie Runia * include/extend.h uiPrevCls added to BASEARRAY @@ -52,7 +76,6 @@ * removed symbols.obj from compiler - I thought it needed it, but not so. * shortened filelist for Harbour.exe to $** ->>>>>>> 1.1163 19991007-17:00 GMT+2 Ryszard Glab *source/compiler/harbour.y diff --git a/harbour/samples/Makefile b/harbour/samples/Makefile new file mode 100644 index 0000000000..ff358c1a62 --- /dev/null +++ b/harbour/samples/Makefile @@ -0,0 +1,12 @@ +# +# $Id$ +# + +ROOT = ../ + +DIRS=\ + guestbk \ + hscript \ + misc \ + +include $(ROOT)config/dir.cf diff --git a/harbour/samples/guestbk/Makefile b/harbour/samples/guestbk/Makefile new file mode 100644 index 0000000000..dab036be6a --- /dev/null +++ b/harbour/samples/guestbk/Makefile @@ -0,0 +1,24 @@ +# +# $Id$ +# + +ROOT = ../../ + +PRG_SOURCES=\ + guestbk.prg \ + inifiles.prg \ + testcgi.prg \ + +PRG_MAIN=guestbk.prg + +LIBS=\ + runner \ + tools \ + debug \ + rdd \ + vm \ + rdd \ + rtl \ + pp \ + +include $(TOP)$(ROOT)config/bin.cf diff --git a/harbour/samples/hscript/bldguest.bat b/harbour/samples/guestbk/bld_b32.bat similarity index 96% rename from harbour/samples/hscript/bldguest.bat rename to harbour/samples/guestbk/bld_b32.bat index 21ca03c3e8..95bc04ec7c 100644 --- a/harbour/samples/hscript/bldguest.bat +++ b/harbour/samples/guestbk/bld_b32.bat @@ -1,4 +1,7 @@ @echo off +rem +rem $Id$ +rem ..\..\bin\harbour /n guestbk ..\..\bin\harbour /n ..\..\tests\inifiles diff --git a/harbour/samples/guestbk/cgi.ch b/harbour/samples/guestbk/cgi.ch new file mode 100644 index 0000000000..e1ef5bf542 --- /dev/null +++ b/harbour/samples/guestbk/cgi.ch @@ -0,0 +1,36 @@ +/* + * $Id$ + */ + +// 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 diff --git a/harbour/samples/hscript/guestbk.htm b/harbour/samples/guestbk/guestbk.htm similarity index 100% rename from harbour/samples/hscript/guestbk.htm rename to harbour/samples/guestbk/guestbk.htm diff --git a/harbour/samples/hscript/guestbk.ini b/harbour/samples/guestbk/guestbk.ini similarity index 100% rename from harbour/samples/hscript/guestbk.ini rename to harbour/samples/guestbk/guestbk.ini diff --git a/harbour/samples/hscript/guestbk.prg b/harbour/samples/guestbk/guestbk.prg similarity index 99% rename from harbour/samples/hscript/guestbk.prg rename to harbour/samples/guestbk/guestbk.prg index f0ae85a9d8..afdc7bf420 100644 --- a/harbour/samples/hscript/guestbk.prg +++ b/harbour/samples/guestbk/guestbk.prg @@ -1,6 +1,8 @@ /* * $Id$ - * + */ + +/* Harbour Project source code This file contains source for a script of a Guestbook @@ -32,7 +34,7 @@ */ -FUNCTION GuestMain() +FUNCTION Main() LOCAL oIni := TIniFile():New( "c:\inetpub\wwwroot\guestbk.ini" ) LOCAL oHTML := THTML():New() diff --git a/harbour/samples/hscript/guestbk.txt b/harbour/samples/guestbk/guestbk.txt similarity index 100% rename from harbour/samples/hscript/guestbk.txt rename to harbour/samples/guestbk/guestbk.txt diff --git a/harbour/samples/guestbk/inifiles.prg b/harbour/samples/guestbk/inifiles.prg new file mode 100644 index 0000000000..9501d1aad1 --- /dev/null +++ b/harbour/samples/guestbk/inifiles.prg @@ -0,0 +1,311 @@ +// +// $Id$ +// +#define CRLF (Chr(13) + Chr(10)) + +function TIniFile() + static oClass + + if oClass == nil + oClass := TClass():New( 'TINIFILE' ) // starts a new class definition + + oClass:AddData( 'FileName' ) // define this class objects datas + oClass:AddData( 'Contents' ) + + oClass:AddMethod( 'New', @New() ) // define this class objects methods + oClass:AddMethod( 'ReadString', @ReadString() ) + oClass:AddMethod( 'WriteString', @WriteString() ) + oClass:AddMethod( 'ReadNumber', @ReadNumber() ) + oClass:AddMethod( 'WriteNumber', @WriteNumber() ) + oClass:AddMethod( 'ReadDate', @ReadDate() ) + oClass:AddMethod( 'WriteDate', @WriteDate() ) + oClass:AddMethod( 'ReadBool', @ReadBool() ) + oClass:AddMethod( 'WriteBool', @WriteBool() ) + oClass:AddMethod( 'ReadSection', @ReadSection() ) + oClass:AddMethod( 'ReadSections', @ReadSections() ) + oClass:AddMethod( 'DeleteKey', @DeleteKey() ) + oClass:AddMethod( 'EraseSection', @EraseSection() ) + oClass:AddMethod( 'UpdateFile', @UpdateFile() ) + + oClass:Create() // builds this class + endif +return oClass:Instance() // builds an object of this class + +static function New(cFileName) + local Self := QSelf() + local Done, hFile, cFile, cLine, cIdent, nPos + local CurrArray + + if empty(cFileName) + // raise an error? + outerr('No filename passed to TIniFile():New()') + return nil + + else + ::FileName := cFilename + ::Contents := {} + CurrArray := ::Contents + + if File(cFileName) + hFile := fopen(cFilename, 0) + + else + hFile := fcreate(cFilename) + endif + + cLine := '' + Done := .f. + while !Done + cFile := space(256) + Done := (fread(hFile, @cFile, 256) <= 0) + + cFile := strtran(cFile, chr(10), '') // so we can just search for CHR(13) + + // prepend last read + cFile := cLine + cFile + while !empty(cFile) + if (nPos := at(chr(13), cFile)) > 0 + cLine := left(cFile, nPos - 1) + cFile := substr(cFile, nPos + 1) + + if !empty(cLine) + if Left(cLine, 1) == '[' // new section + if (nPos := At(']', cLine)) > 1 + cLine := substr(cLine, 2, nPos - 2); + + else + cLine := substr(cLine, 2) + endif + + AAdd(::Contents, { cLine, { /* this will be CurrArray */ } } ) + CurrArray := ::Contents[Len(::Contents)][2] + + elseif Left(cLine, 1) == ';' // preserve comments + AAdd( CurrArray, { NIL, cLine } ) + + else + if (nPos := At('=', cLine)) > 0 + cIdent := Left(cLine, nPos - 1) + cLine := SubStr(cLine, nPos + 1) + + AAdd( CurrArray, { cIdent, cLine } ) + + else + AAdd( CurrArray, { cLine, '' } ) + endif + endif + cLine := '' // to stop prepend later on + endif + + else + cLine := cFile + cFile := '' + endif + end + end + + fclose(hFile) + endif +return Self + +static function ReadString(cSection, cIdent, cDefault) + local Self := QSelf() + local cResult := cDefault + local i, j, cFind + + if Empty(cSection) + cFind := lower(cIdent) + j := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} ) + + if j > 0 + cResult := ::Contents[j][2] + endif + + else + cFind := lower(cSection) + i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} ) + + if i > 0 + cFind := lower(cIdent) + j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} ) + + if j > 0 + cResult := ::Contents[i][2][j][2] + endif + endif + endif +return cResult + +static procedure WriteString(cSection, cIdent, cString) + local Self := QSelf() + local i, j, cFind + + if Empty(cIdent) + outerr('Must specify an identifier') + + elseif Empty(cSection) + cFind := lower(cIdent) + j := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} ) + + if j > 0 + ::Contents[j][2] := cString + + else + AAdd(::Contents, nil) + AIns(::Contents, 1) + ::Contents[1] := {cIdent, cString} + endif + + else + cFind := lower(cSection) + if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'A'})) > 0 + cFind := lower(cIdent) + j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} ) + + if j > 0 + ::Contents[i][2][j][2] := cString + + else + AAdd( ::Contents[i][2], {cIdent, cString} ) + endif + + else + AAdd( ::Contents, {cSection, {{cIdent, cString}}} ) + endif + endif +return + +static function ReadNumber(cSection, cIdent, nDefault) + local Self := QSelf() +return Val( ::ReadString(cSection, cIdent, str(nDefault)) ) + +static procedure WriteNumber(cSection, cIdent, nNumber) + local Self := QSelf() + + ::WriteString( cSection, cIdent, alltrim(str(nNumber)) ) +return + +static function ReadDate(cSection, cIdent, dDefault) + local Self := QSelf() +return SToD( ::ReadString(cSection, cIdent, DToS(dDefault)) ) + +static procedure WriteDate(cSection, cIdent, dDate) + local Self := QSelf() + + ::WriteString( cSection, cIdent, DToS(dDate) ) +return + +static function ReadBool(cSection, cIdent, lDefault) + local Self := QSelf() + local cDefault := Iif( lDefault, '.t.', '.f.' ) + +return ::ReadString(cSection, cIdent, cDefault) == '.t.' + +static procedure WriteBool(cSection, cIdent, lBool) + local Self := QSelf() + + ::WriteString( cSection, cIdent, Iif(lBool, '.t.', '.f.') ) +return + +static procedure DeleteKey(cSection, cIdent) + local Self := QSelf() + local i, j + + cSection := lower(cSection) + i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cSection} ) + + if i > 0 + cIdent := lower(cIdent) + j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cIdent} ) + + ADel( ::Contents[i][2], j ) + ASize( ::Contents[i][2], Len(::Contents[i][2]) - 1 ) + endif +return + +static procedure EraseSection(cSection) + local Self := QSelf() + local i + + if Empty(cSection) + while (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. ValType(x[2]) == 'C'})) > 0 + ADel( ::Contents, i ) + ASize( ::Contents, len(::Contents) - 1 ) + end + + else + cSection := lower(cSection) + if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cSection .and. ValType(x[2]) == 'A'})) > 0 + ADel( ::Contents, i ) + ASize( ::Contents, Len(::Contents) - 1 ) + endif + endif +return + +static function ReadSection(cSection) + local Self := QSelf() + local i, j, aSection := {} + + if Empty(cSection) + for i := 1 to len(::Contents) + if valtype(::Contents[i][1]) == 'C' .and. valtype(::Contents[i][2]) == 'C' + aadd(aSection, ::Contents[i][1]) + endif + next + + else + cSection := lower(cSection) + if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0 + + for j := 1 to Len(::Contents[i][2]) + + if ::Contents[i][2][j][1] <> NIL + AAdd(aSection, ::Contents[i][2][j][1]) + endif + next + endif + endif +return aSection + +static function ReadSections() + local Self := QSelf() + local i, aSections := {} + + for i := 1 to Len(::Contents) + + if ValType(::Contents[i][2]) == 'A' + AAdd(aSections, ::Contents[i][1]) + endif + next +return aSections + +static procedure UpdateFile() + local Self := QSelf() + local i, j, hFile + + hFile := fcreate(::Filename) + + for i := 1 to Len(::Contents) + if ::Contents[i][1] == NIL + fwrite(hFile, ::Contents[i][2] + Chr(13) + Chr(10)) + + elseif ValType(::Contents[i][2]) == 'A' + fwrite(hFile, '[' + ::Contents[i][1] + ']' + Chr(13) + Chr(10)) + for j := 1 to Len(::Contents[i][2]) + + if ::Contents[i][2][j][1] == NIL + fwrite(hFile, ::Contents[i][2][j][2] + Chr(13) + Chr(10)) + + else + fwrite(hFile, ::Contents[i][2][j][1] + '=' + ::Contents[i][2][j][2] + Chr(13) + Chr(10)) + endif + next + fwrite(hFile, Chr(13) + Chr(10)) + + elseif ValType(::Contents[i][2]) == 'C' + fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + Chr(13) + Chr(10)) + + endif + next + fclose(hFile) +return diff --git a/harbour/samples/guestbk/testcgi.prg b/harbour/samples/guestbk/testcgi.prg new file mode 100644 index 0000000000..570bc063ab --- /dev/null +++ b/harbour/samples/guestbk/testcgi.prg @@ -0,0 +1,385 @@ +// +// $Id$ +// + +/* +* +* 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. +* 1999/06/02 Dynamic TAG matching routines (inspired on Delphi). +* First attempt to convert Delphi's ISAPI dll of WebSites' +* Function List +* (See http://www.flexsys-ci.com/harbour-project/functions.htm) +* 1999/06/11 List can be viewed online at +* http://www.flexsys-ci.com/cgi-bin/testcgi.exe +* 1999/07/29 Changed qOut() calls to OutStd() calls. +* +**/ + +#include "cgi.ch" +#include "harbour.ch" +#define IF_BUFFER 65535 + +FUNCTION ParseString( cString, cDelim, nRet ) + + LOCAL cBuf, aElem, nPosFim, nSize, i + + nSize := len( cString ) - len( StrTran( cString, cDelim, '' ) ) + 1 + aElem := array( nSize ) + + cBuf := cString + i := 1 + FOR i := 1 TO nSize + nPosFim := at( cDelim, cBuf ) + + IF nPosFim > 0 + aElem[i] := substr( cBuf, 1, nPosFim - 1 ) + ELSE + aElem[i] := cBuf + ENDIF + + cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) ) + + NEXT i + + RETURN( aElem[ nRet ] ) + +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:AddData( "cHTMLFile" ) + oClass:AddData( "aReplaceTags" ) + + oClass:AddMethod( "New", @New() ) // New Method + oClass:AddMethod( "SetTitle", @SetTitle() ) // Set Page Title + oClass:AddMethod( "AddHead", @AddHead() ) // Add

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( "SetHTMLFile",@SetHTMLFile() ) // Sets source HTML file + + oClass:AddMethod( "ProcessCGI", @ProcessCGI() ) + oClass:AddMethod( "GetCGIParam", @GetCGIParam() ) + oClass:AddMethod( "QueryFields", @QueryFields() ) + oClass:AddMethod( "AddReplaceTag", @AddReplaceTag() ) + + oClass:Create() + + ENDIF + + RETURN( oClass:Instance() ) + +STATIC FUNCTION New() + + LOCAL Self := QSelf() + + ::cTitle := "Untitled" + ::cBGColor := "#FFFFFF" + ::cLinkColor := "#0000FF" + ::cvLinkColor := "#FF0000" + ::cContent := "" + ::cBody := "" + ::aCGIContents := {} + ::aQueryFields := {} + ::aReplaceTags := {} + ::cHTMLFile := "" + + RETURN( Self ) + +STATIC FUNCTION SetTitle( cTitle ) + + LOCAL Self := QSelf() + + ::cTitle := cTitle + + RETURN( Self ) + +STATIC FUNCTION AddLink( cLinkTo, cLinkName ) + + LOCAL Self := QSelf() + + ::cBody := ::cBody + ; + "" + cLinkName + "" + + RETURN( Self ) + +STATIC FUNCTION AddHead( cDescr ) + + LOCAL Self := QSelf() + + // Why this doesn't work? + // ::cBody += ... + // ??? + + ::cBody := ::cBody + ; + "

" + cDescr + "

" + + RETURN( NIL ) + +STATIC FUNCTION AddPara( cPara, cAlign ) + + LOCAL Self := QSelf() + + ::cBody := ::cBody + ; + "

" + hb_OSNewLine() + ; + cPara + hb_OSNewLine() + ; + "

" + + RETURN( Self ) + +STATIC FUNCTION Generate() + + LOCAL Self := QSelf() + LOCAL cFile, i, hFile, nPos, cRes := "" + LOCAL lFlag := .f. + + // Is this a meta file or hand generated script? + IF empty( ::cHTMLFile ) + ::cContent := ; + "" + hb_OSNewLine() + ; + "" + ::cTitle + "" + hb_OSNewLine() + ; + "" + + hb_OSNewLine() + ; + ::cBody + hb_OSNewLine() + ; + "" + ELSE + ::cContent := "" + + // Does cHTMLFile exists? + IF !File( ::cHTMLFile ) + ::cContent := "

Server Error

No such file: " + ; + ::cHTMLFile + ELSE + // Read from file + hFile := fOpen( ::cHTMLFile, 0 ) + cFile := space( IF_BUFFER ) + DO WHILE (nPos := fRead( hFile, @cFile, IF_BUFFER )) > 0 + + cFile := left( cFile, nPos ) + cRes += cFile + cFile := space( IF_BUFFER ) + + ENDDO + + fClose( hFile ) + + // Replace matched tags + i := 1 + ::cContent := cRes + /* TODO: Replace this DO WHILE with FOR..NEXT */ + DO WHILE i <= len( ::aReplaceTags ) + ::cContent := strtran( ::cContent, ; + "<#" + ::aReplaceTags[i, 1] + ">", ::aReplaceTags[i, 2] ) + i++ + ENDDO + + /* TODO: Clear remaining (not matched) tags */ + /* + cRes := "" + FOR i := 1 TO len( ::cContent ) + IF substr( ::cContent, i, 1 ) == "<" .AND. ; + substr( ::cContent, i + 1, 1 ) == "#" + lFlag := .t. + ELSEIF substr( ::cContent, i, 1 ) == ">" .AND. lFlag + lFlag := .f. + ELSEIF !lFlag + cRes += substr( ::cContent, i, 1 ) + ENDIF + NEXT i + + ::cContent := cRes + */ + + ENDIF + ENDIF + + RETURN( Self ) + +STATIC FUNCTION ShowResult() + + LOCAL Self := QSelf() + + OutStd( ; + "HTTP/1.0 200 OK" + hb_OSNewLine() + ; + "CONTENT-TYPE: TEXT/HTML" + hb_OSNewLine() + hb_OSNewLine() + ; + ::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 ) + +STATIC FUNCTION SetHTMLFile( cFile ) + + LOCAL Self := QSelf() + + ::cHTMLFile := cFile + + RETURN( Self ) + +STATIC FUNCTION AddReplaceTag( cTag, cReplaceText ) + + LOCAL Self := QSelf() + + aAdd( ::aReplaceTags, { cTag, cReplaceText } ) + + RETURN( Self ) diff --git a/harbour/samples/hscript/Makefile b/harbour/samples/hscript/Makefile new file mode 100644 index 0000000000..b8284caa9f --- /dev/null +++ b/harbour/samples/hscript/Makefile @@ -0,0 +1,22 @@ +# +# $Id$ +# + +ROOT = ../../ + +PRG_SOURCES=\ + hscript.prg \ + +PRG_MAIN=hscript.prg + +LIBS=\ + runner \ + tools \ + debug \ + rdd \ + vm \ + rdd \ + rtl \ + pp \ + +include $(TOP)$(ROOT)config/bin.cf diff --git a/harbour/samples/hscript/bld32exe.bat b/harbour/samples/hscript/bld32exe.bat deleted file mode 100644 index df4dcb49be..0000000000 --- a/harbour/samples/hscript/bld32exe.bat +++ /dev/null @@ -1,27 +0,0 @@ -@echo off - -IF A%1 == A GOTO :SINTAX -IF A%2 == A GOTO :NOOUTPUT - -echo -O2 -e%2.exe -I..\..\include ..\..\source\vm\hvm.c %1.c > b32.bc -echo ..\..\libs\b32\harbour.lib ..\..\libs\b32\terminal.lib >> b32.bc -echo ..\..\libs\b32\hbgt.lib >> b32.bc -bcc32 @b32.bc -del b32.bc -GOTO :END - -:NOOUTPUT -echo -O2 -e%1.exe -I..\..\include ..\..\source\vm\hvm.c %1.c > b32.bc -echo ..\..\libs\b32\harbour.lib ..\..\libs\b32\terminal.lib >> b32.bc -echo ..\..\libs\b32\hbgt.lib >> b32.bc -echo ..\runner.obj >> b32.bc -bcc32 @b32.bc -del b32.bc -GOTO :END - -:SINTAX -ECHO syntax: BuildExe Harbour_Output_Filename [Exe_Output_Filename] -ECHO Use Harbour_Output_Filename and Exe_Output_Filename without extensions -ECHO\ - -:END diff --git a/harbour/samples/hscript/bld_b32.bat b/harbour/samples/hscript/bld_b32.bat new file mode 100644 index 0000000000..944780cf4a --- /dev/null +++ b/harbour/samples/hscript/bld_b32.bat @@ -0,0 +1,8 @@ +@echo off +rem +rem $Id$ +rem + +..\..\bin\harbour hscript /n /i..\..\include +bcc32 -ehscript.exe -O2 -I..\..\include -L..\..\lib\b32 -v harbour.lib terminal.lib hbpp.lib hbgt.lib rdd.lib hscript.c +rem del hscript.c diff --git a/harbour/samples/hscript/dir.hs b/harbour/samples/hscript/dir.hs index 8237c8457d..89ed4adbcd 100644 --- a/harbour/samples/hscript/dir.hs +++ b/harbour/samples/hscript/dir.hs @@ -32,11 +32,11 @@ FUNCTION Main() FOR i := 1 TO len( aDir ) %> -<% OutStr( aDir[i,1] ) %> -<% OutStr( aDir[i,2] ) %> -<% OutStr( aDir[i,3] ) %> -<% OutStr( aDir[i,4] ) %> -<% OutStr( aDir[i,5] ) %> +<% OutStd( aDir[i,1] ) %> +<% OutStd( aDir[i,2] ) %> +<% OutStd( aDir[i,3] ) %> +<% OutStd( aDir[i,4] ) %> +<% OutStd( aDir[i,5] ) %> <% NEXT diff --git a/harbour/samples/hscript/hb32.bat b/harbour/samples/hscript/hb32.bat deleted file mode 100644 index ec1d5ea826..0000000000 --- a/harbour/samples/hscript/hb32.bat +++ /dev/null @@ -1,10 +0,0 @@ -@echo off - -REM From .PRG to .C = Harbour -..\..\bin\harbour %1.prg /n /i..\..\include -if errorlevel 1 goto end - -REM From .C to .EXE = BuildExe -call BLD32EXE %1 %2 - -:end diff --git a/harbour/samples/hscript/hscript.prg b/harbour/samples/hscript/hscript.prg index d0a52dee14..8e8f4de304 100644 --- a/harbour/samples/hscript/hscript.prg +++ b/harbour/samples/hscript/hscript.prg @@ -1,48 +1,50 @@ /* -* $Id$ -* -* HScript.PRG -* HarbourScript translation engine -* -* -* Copyright (C) 1999 Felipe Coury -* 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 of the License, or -* (at your option) any later version, with one exception: -* -* The exception is that if you link the Harbour Runtime Library (HRL) -* and/or the Harbour Virtual Machine (HVM) 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 HRL -* and/or HVM code into it. -* -* 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 program; if not, write to the Free Software -* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit -* their web site at http://www.gnu.org/). -* -* 1999/06/13 First implementation. -* 1999/06/24 Enhanced tag matching routines. -* 1999/07/26 Corrections to CGI output, qOut() -> OutStd(). -* -**/ + * $Id$ + */ -#include "CGI.ch" +/* + * HScript.PRG + * HarbourScript translation engine + * + * + * Copyright (C) 1999 Felipe Coury + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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 program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + * 1999/06/13 First implementation. + * 1999/06/24 Enhanced tag matching routines. + * 1999/07/26 Corrections to CGI output, qOut() -> OutStd(). + * + */ + +#include "hbextern.ch" +#include "cgi.ch" #define IF_BUFFER 65535 -#ifdef __HARBOUR__ -#define NewLine chr(10) -#else -#define NewLine chr(13) -#endif + +REQUEST DIRECTORY +REQUEST GETENV +REQUEST ASORT FUNCTION Main( cScript ) @@ -75,14 +77,14 @@ FUNCTION Main( cScript ) IF empty( cScriptName ) IF !empty( GetEnv( "SERVER_NAME" ) ) - OutStd( "content-type: text/html" + NewLine ) - OutStd( NewLine ) - OutStd( "

Server Error

" + NewLine ) - OutStd( "Must specify scriptname using hscript.exe?script=" + NewLine ) - OutStd( "" + NewLine ) + OutStd( "content-type: text/html" + hb_OSNewLine() ) + OutStd( hb_OSNewLine() ) + OutStd( "

Server Error

" + hb_OSNewLine() ) + OutStd( "Must specify scriptname using hscript.exe?script=" + hb_OSNewLine() ) + OutStd( "" + hb_OSNewLine() ) ELSE - OutStd( "Please give .hs name" + NewLine ) + OutStd( "Please give .hs name" + hb_OSNewLine() ) ENDIF @@ -92,9 +94,9 @@ FUNCTION Main( cScript ) // Script not found IF !file( cScriptName ) IF !empty( GetEnv( "SERVER_NAME" ) ) - OutStd( "CONTENT-TYPE: text/html" + NewLine ) + OutStd( "CONTENT-TYPE: text/html" + hb_OSNewLine() ) ENDIF - OutStd( "

Server Error

Script not found: " + cScriptName + NewLine ) + OutStd( "

Server Error

Script not found: " + cScriptName + hb_OSNewLine() ) EXIT ENDIF @@ -122,7 +124,7 @@ FUNCTION Main( cScript ) // Abre script IF i > 1 //cTrans += " ; " - cTrans += NewLine + cTrans += hb_OSNewLine() ENDIF IF i + 1 < nLen cTrans += "OutStd( '" @@ -142,7 +144,7 @@ FUNCTION Main( cScript ) lOpen := .f. IF i < nLen // cTrans += " ; " - cTrans += NewLine + cTrans += hb_OSNewLine() ENDIF ENDIF @@ -174,13 +176,13 @@ FUNCTION Main( cScript ) fClose( hFile ) // Creates the temporary HRB, erases the PRG - __Run( cHarbourDir + "harbour.exe " + cFile + " /q /n /gHRB /o" + ; - left( cHarbourDir, len( cHarbourDir ) - 1 ) ) + __Run( cHarbourDir + "harbour.exe " + cFile + " /q /n /gh /o" + ; + left( cHarbourDir, len( cHarbourDir ) - 1 ) + "\" ) fErase( cFile ) // Runs using Tugboat - cFile := strtran( upper( cFile ), ".PRG", ".HRB" ) - HB_Run( cFile ) + cFile := strtran( upper( cFile ), ".PRG", ".hrb" ) + __hrbRun( cFile ) // Erases the HRB file fErase( cFile ) @@ -203,14 +205,14 @@ FUNCTION ParseString( cString, cDelim, nRet ) FOR i := 1 TO nSize nPosFim := at( cDelim, cBuf ) - IF nPosFim > 0 + IF nPosFim > 0 aElem[i] := substr( cBuf, 1, nPosFim - 1 ) ELSE aElem[i] := cBuf ENDIF cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) ) - + NEXT i RETURN( aElem[ nRet ] ) diff --git a/harbour/samples/hscript/makehs.bat b/harbour/samples/hscript/makehs.bat deleted file mode 100644 index eaf43e6a7b..0000000000 --- a/harbour/samples/hscript/makehs.bat +++ /dev/null @@ -1,2 +0,0 @@ -@echo off -call hb32 hscript \ No newline at end of file diff --git a/harbour/samples/hscript/makehtm.bat b/harbour/samples/hscript/makehtm.bat index f0f37e41b0..90f422de30 100644 --- a/harbour/samples/hscript/makehtm.bat +++ b/harbour/samples/hscript/makehtm.bat @@ -1,12 +1,17 @@ @echo off +rem +rem $Id$ +rem + IF NOT EXIST hscript.exe GOTO :missing :start -SET HARBOUR_DIR=\HARBOUR\BIN\ +SET HARBOURDIR=.\ -hscript hello.hs >hello.htm -hscript multiply.hs >multiply.htm -hscript dir.hs >dir.htm +hscript hello.hs > hello.htm +hscript multiply.hs > multiply.htm +hscript dir.hs > dir.htm +hscript ugly.hs > ugly.htm cls echo Ready to go! diff --git a/harbour/samples/misc/Makefile b/harbour/samples/misc/Makefile new file mode 100644 index 0000000000..e5056456d1 --- /dev/null +++ b/harbour/samples/misc/Makefile @@ -0,0 +1,47 @@ +# +# $Id$ +# + +ROOT = ../../ + +LIBS=\ + tools \ + debug \ + rtl \ + rdd \ + vm \ + rdd \ + rtl \ + pp \ + runner \ + +ifeq ($(PM),) + PM := $(pm) +endif +ifeq ($(PM),) # PM not defined = build all files +PRG_SOURCES=\ + guess.prg \ + mankala.prg \ + +PRG_HEADERS=\ + +C_SOURCES=\ + +C_HEADERS=\ + +include $(TOP)$(ROOT)config/test.cf + +else #PM defined = build specified file + +ifneq ($(findstring .prg,$(PM)),) + PRG_MAIN := $(PM) +else + ifneq ($(findstring .PRG,$(PM)),) + PRG_MAIN := $(PM) + else + PRG_MAIN := $(PM).prg + endif +endif +include $(TOP)$(ROOT)config/bin.cf + +endif diff --git a/harbour/tests/guess.prg b/harbour/samples/misc/guess.prg similarity index 98% rename from harbour/tests/guess.prg rename to harbour/samples/misc/guess.prg index 9c342b05fc..61a551e93c 100644 --- a/harbour/tests/guess.prg +++ b/harbour/samples/misc/guess.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // // Guess a number diff --git a/harbour/tests/mankala.prg b/harbour/samples/misc/mankala.prg similarity index 99% rename from harbour/tests/mankala.prg rename to harbour/samples/misc/mankala.prg index d1f8876b3d..d0731d32b3 100644 --- a/harbour/tests/mankala.prg +++ b/harbour/samples/misc/mankala.prg @@ -1,6 +1,6 @@ -// -// $Id$ -// +/* + * $Id$ + */ // // Mankala. The first Harbour board game. diff --git a/harbour/tests/Makefile b/harbour/tests/Makefile index e062f7ff8f..060a383cfd 100644 --- a/harbour/tests/Makefile +++ b/harbour/tests/Makefile @@ -71,7 +71,6 @@ PRG_SOURCES=\ fornext2.prg \ fortest.prg \ funcarr.prg \ - guess.prg \ hardcr.prg \ hello.prg \ ifelse.prg \ @@ -87,7 +86,6 @@ PRG_SOURCES=\ longdev.prg \ longstr.prg \ longstr2.prg \ - mankala.prg \ mathtest.prg \ memfile.prg \ memvar.prg \ diff --git a/harbour/tests/testcgi.prg b/harbour/tests/testcgi.prg index 5bb9e41bc0..d8da566c74 100644 --- a/harbour/tests/testcgi.prg +++ b/harbour/tests/testcgi.prg @@ -28,15 +28,11 @@ #include "cgi.ch" #define IF_BUFFER 65535 -STATIC s_cNewLine - FUNCTION Main() LOCAL oHTML := THTML():New() LOCAL hFile, nPos, cString, cBuf, i, cTable, cLine - s_cNewLine := HB_OSNewLine() - oHTML:SetHTMLFile( "function.cfm" ) hFile := fOpen( "list.txt", 0 ) @@ -246,8 +242,8 @@ STATIC FUNCTION AddPara( cPara, cAlign ) LOCAL Self := QSelf() ::cBody := ::cBody + ; - "

" + s_cNewLine + ; - cPara + s_cNewLine + ; + "

" + HB_OSNewLine() + ; + cPara + HB_OSNewLine() + ; "

" RETURN( Self ) @@ -261,11 +257,11 @@ STATIC FUNCTION Generate() // Is this a meta file or hand generated script? IF empty( ::cHTMLFile ) ::cContent := ; - "" + s_cNewLine + ; - "" + ::cTitle + "" + s_cNewLine + ; + "" + HB_OSNewLine() + ; + "" + ::cTitle + "" + HB_OSNewLine() + ; "" + + s_cNewLine + ; - ::cBody + s_cNewLine + ; + "vlink='" + ::cvLinkColor + "'>" + + HB_OSNewLine() + ; + ::cBody + HB_OSNewLine() + ; "" ELSE ::cContent := "" @@ -325,8 +321,8 @@ STATIC FUNCTION ShowResult() LOCAL Self := QSelf() OutStd( ; - "HTTP/1.0 200 OK" + s_cNewLine + ; - "CONTENT-TYPE: TEXT/HTML" + s_cNewLine + s_cNewLine + ; + "HTTP/1.0 200 OK" + HB_OSNewLine() + ; + "CONTENT-TYPE: TEXT/HTML" + HB_OSNewLine() + HB_OSNewLine() + ; ::cContent ) RETURN( Self )