From e1a3aaff59fb48c7320a4925318cd3f1533b331c Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Tue, 11 Sep 2012 20:15:27 +0000 Subject: [PATCH] 2012-09-11 22:04 UTC+0200 Viktor Szakats (harbour syenar.net) + doc/en/hbflock.txt + tests/tflock.prg + Documentation and test code for Harbour file locking functions Contributed by Doug. * tests/tflock.prg * Code fixed to build in -w3 mode and simplified. * contrib/hbformat/hbfmtcls.prg ! Fixed to indent OTHERWISE statement properly ! Fixed to not pad '++', '--' and '->' operators ! Fixed not uppercasing FOR/NEXT keywords ! Fixed not recognizing 'CREATE CLASS' as class declaration statement ! Fixed to not indent '//' comments ! Fixed to not add space between characters of codeblock operator '{|' ; Patches by Maurizio la Cecilia. * contrib/hbformat/hbfmtcls.prg % minor rework to not avoid using '=' (SET EXACT dependent) operator and OTHERWISE/ELSE to be handled with adding exception cases. Maurizio, please verify me. * tests/db_brows.prg * tests/testcdx.prg * modified after testing new hbformat with them --- harbour/ChangeLog | 37 ++++++- harbour/contrib/hbformat/hbfmtcls.prg | 50 +++++----- harbour/doc/en/hbflock.txt | 112 +++++++++++++++++++++ harbour/tests/db_brows.prg | 12 +-- harbour/tests/testcdx.prg | 30 +++--- harbour/tests/tflock.prg | 137 ++++++++++++++++++++++++++ 6 files changed, 330 insertions(+), 48 deletions(-) create mode 100644 harbour/doc/en/hbflock.txt create mode 100644 harbour/tests/tflock.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 75f83f6463..786f4d72a4 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,33 @@ The license applies to all entries newer than 2009-04-28. */ +2012-09-11 22:04 UTC+0200 Viktor Szakats (harbour syenar.net) + + doc/en/hbflock.txt + + tests/tflock.prg + + Documentation and test code for Harbour file locking functions + Contributed by Doug. + + * tests/tflock.prg + * Code fixed to build in -w3 mode and simplified. + + * contrib/hbformat/hbfmtcls.prg + ! Fixed to indent OTHERWISE statement properly + ! Fixed to not pad '++', '--' and '->' operators + ! Fixed not uppercasing FOR/NEXT keywords + ! Fixed not recognizing 'CREATE CLASS' as class declaration statement + ! Fixed to not indent '//' comments + ! Fixed to not add space between characters of codeblock operator '{|' + ; Patches by Maurizio la Cecilia. + + * contrib/hbformat/hbfmtcls.prg + % minor rework to not avoid using '=' (SET EXACT dependent) + operator and OTHERWISE/ELSE to be handled with adding + exception cases. Maurizio, please verify me. + + * tests/db_brows.prg + * tests/testcdx.prg + * modified after testing new hbformat with them + 2012-09-11 21:22 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * harbour/utils/hbmk2/hbmk2.prg * harbour/config/win/bcc.mk @@ -43,12 +70,12 @@ 2012-09-09 15:30 UTC-0800 Pritpal Bedi (bedipritpal@hotmail.com) + contrib/hbqt/tests/qtwvg.hbp + contrib/hbqt/tests/qtwvg.prg - + Added: demonstration code to exploit the power of Qt with existing - GTWVT/GTWVG based applications. This demo opens a HbQt dialog + + Added: demonstration code to exploit the power of Qt with existing + GTWVT/GTWVG based applications. This demo opens a HbQt dialog from where n number of GTWVG dialogs can be opened. This protocol - requires that your applications are MT based, at least for the - main application window to appear. Examine the code and adopt it - to your own advantage. This protocol opens up a vast horizon + requires that your applications are MT based, at least for the + main application window to appear. Examine the code and adopt it + to your own advantage. This protocol opens up a vast horizon for our console applications, believe me. 2012-09-09 18:50 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) diff --git a/harbour/contrib/hbformat/hbfmtcls.prg b/harbour/contrib/hbformat/hbfmtcls.prg index 75df741935..2e43f860a9 100644 --- a/harbour/contrib/hbformat/hbfmtcls.prg +++ b/harbour/contrib/hbformat/hbfmtcls.prg @@ -108,13 +108,13 @@ CREATE CLASS HBFORMATCODE VAR cCommands INIT "," VAR cClauses INIT "," VAR cFunctions INIT "," - VAR aContr INIT { { "if" , "" , "elseif" , "endif" },; - { "do" , "while" , "" , "enddo" },; - { "while" , "" , "" , "enddo" },; - { "for" , "" , "" , "next" },; - { "do" , "case" , "case" , "endcase" },; - { "begin" , "sequence", "recover", "end" },; - { "switch", "" , "case" , "endswitch" } } + VAR aContr INIT { { "if" , "" , "|else|elseif|" , "endif" },; + { "do" , "while" , "" , "enddo" },; + { "while" , "" , "" , "enddo" },; + { "for" , "" , "" , "next" },; + { "do" , "case" , "|case|otherwise|", "endcase" },; + { "begin" , "sequence", "|recover|" , "end" },; + { "switch", "" , "|case|otherwise|", "endswitch" } } VAR bCallback @@ -161,8 +161,8 @@ METHOD New( aParams, cIniName ) CLASS HBFORMATCODE ::cCommands += "IF,ELSEIF,ELSE,ENDIF,END,DO,WHILE,ENDDO,WITH,CASE,OTHERWISE,ENDCASE,BEGIN," +; "FUNCTION,PROCEDURE,RETURN,CLASS,ENDCLASS,METHOD,DATA,LOCAL,PRIVATE,PUBLIC,STATIC,FIELD,MEMVAR,PARAMETERS,DECLARE," +; "ACCEPT,APPEND,AVERAGE,CLEAR,CLOSE,COMMIT,CONTINUE,COPY,COUNT,CREATE,DEFAULT," +; - "DELETE,DISPLAY,EJECT,ERASE,EXIT,GO,GOTO,INDEX,INPUT,JOIN,KEYBOARD,LABEL,LIST,LOCATE," +; - "LOOP,MENU,PACK,PRINT,QUIT,READ,RECALL,REINDEX,RELEASE,RENAME,REQUEST,REPLACE,RESTORE," +; + "DELETE,DISPLAY,EJECT,ERASE,EXIT,FOR,GO,GOTO,INDEX,INPUT,JOIN,KEYBOARD,LABEL,LIST,LOCATE," +; + "LOOP,MENU,NEXT,PACK,PRINT,QUIT,READ,RECALL,REINDEX,RELEASE,RENAME,REQUEST,REPLACE,RESTORE," +; "RUN,SAVE,SEEK,SELECT,SET,SKIP,SORT,STORE,SUM,TEXT,TOTAL,UNLOCK,USE,WAIT,ZAP," IF Right( ::cClauses, 1 ) != "," @@ -316,10 +316,11 @@ METHOD Reformat( aFile ) CLASS HBFORMATCODE ( LEFTEQUAL( "function", cToken2 ) .OR. LEFTEQUAL( "procedure", cToken2 ) ) ) .OR. ; LEFTEQUAL( "function", cToken1 ) .OR. LEFTEQUAL( "procedure", cToken1 ) ; .OR. ( "method" == cToken1 .AND. ! lClass ) .OR. ; - ( "class" == cToken1 .AND. ! lClass ) ) + ( "class" == cToken1 .AND. ! lClass ) .OR. ; + ( "create" == cToken1 .AND. "class" == cToken2 .AND. ! lClass ) ) IF nDeep == 0 nState := RF_STATE_FUNC - IF "class" == cToken1 + IF "class" == cToken1 .or. ( "create" == cToken1 .AND. "class" == cToken2 ) lClass := .T. ENDIF ELSE @@ -355,7 +356,7 @@ METHOD Reformat( aFile ) CLASS HBFORMATCODE AAdd( aDeep, NIL ) ENDIF aDeep[ nDeep ] := nContrState - ELSEIF Len( cToken1 ) < 4 .OR. ( nContrState := Ascan( ::aContr, {| a | a[ 3 ] = cToken1 } ) ) == 0 + ELSEIF Len( cToken1 ) < 4 .OR. ( nContrState := Ascan( ::aContr, {| a | "|" + cToken1 + "|" $ a[ 3 ] } ) ) == 0 IF ( nPos := Ascan( ::aContr, {| a | a[ 4 ] == cToken1 } ) ) > 0 .OR. ; cToken1 == "end" IF nPos != 0 .AND. nDeep > 0 .AND. aDeep[ nDeep ] != nPos @@ -389,6 +390,9 @@ METHOD Reformat( aFile ) CLASS HBFORMATCODE IF Left( cLine, 1 ) == "#" .AND. ! ::lIndDrt nIndent := 0 ENDIF + IF Left( cLine, 2 ) == "//" .AND. nDeep == 0 + nIndent := 0 + ENDIF cLineAll := Space( nIndent ) + ::FormatLine( cLine ) IF i > 1 .AND. ( ( nState == RF_STATE_RET .AND. ::nLineRet > 0 ) .OR. ; @@ -548,7 +552,7 @@ METHOD FormatLine( cLine, lContinued ) CLASS HBFORMATCODE ENDIF ENDIF IF ::lSpaces .AND. aBrackets[ iif( c == "(", 1, 2 ) ] <= ::nBr4Brac .AND. ; - i < nLen .AND. !( SubStr( cLine, i + 1, 1 ) $ " )}" ) + i < nLen .AND. !( SubStr( cLine, i + 1, 1 ) $ iif( c == "(", " )", " |} " ) ) nA := i ENDIF nState := FL_STATE_ANY @@ -605,15 +609,17 @@ METHOD FormatLine( cLine, lContinued ) CLASS HBFORMATCODE IF lFirst .AND. nState != FL_STATE_STRING lFirst := .F. ENDIF - IF nA != 0 .AND. ::lSpaces .AND. nA < nLen .AND. SubStr( cLine, nA + 1, 1 ) != " " - cLine := Left( cLine, nA ) + " " + SubStr( cLine, nA + 1 ) - nLen++ - i++ - ENDIF - IF nB != 0 .AND. ::lSpaces .AND. nB > 1 .AND. SubStr( cLine, nB - 1, 1 ) != " " - cLine := Left( cLine, nB - 1 ) + " " + SubStr( cLine, nB ) - nLen++ - i++ + IF !( "|" + SubStr( cLine, nB, 2 ) + "|" $ "|--|++|->|" ) + IF nA != 0 .AND. ::lSpaces .AND. nA < nLen .AND. SubStr( cLine, nA + 1, 1 ) != " " + cLine := Left( cLine, nA ) + " " + SubStr( cLine, nA + 1 ) + nLen++ + i++ + ENDIF + IF nB != 0 .AND. ::lSpaces .AND. nB > 1 .AND. SubStr( cLine, nB - 1, 1 ) != " " + cLine := Left( cLine, nB - 1 ) + " " + SubStr( cLine, nB ) + nLen++ + i++ + ENDIF ENDIF nA := nB := 0 ELSEIF ( nState == FL_STATE_QUOTED .AND. c == cSymb ) .OR. ; diff --git a/harbour/doc/en/hbflock.txt b/harbour/doc/en/hbflock.txt new file mode 100644 index 0000000000..904cecded1 --- /dev/null +++ b/harbour/doc/en/hbflock.txt @@ -0,0 +1,112 @@ +/* + * $Id$ + */ + +/* $DOC$ + * $TEMPLATE$ + * Function + * $NAME$ + * HB_FLOCK() + * $CATEGORY$ + * API + * $SUBCATEGORY$ + * FileSys + * $ONELINER$ + * Locks part or all of any file + * $SYNTAX$ + * HB_FLOCK( , , [, + * $ARGUMENTS$ + * Dos file handle + + * Offset of the first byte of the region to be locked. + + * Number of bytes to be locked. + + * The type (read or write) of lock requested. + * $RETURNS$ + * .T. if the lock was obtained, else .F. + * $DESCRIPTION$ + * This function attempts to lock a region of the file whose file handle + * is . This is a low level file function. To lock Harbour + * data files use either the FLOCK() or RLOCK() function. + + * The value of is obtained from either a call to the FOPEN() + * or the FCREATE() function. + + * is the offset (from the beginning of the file) to the first + * byte of the region to be locked. (Offsets from the current position + * and end of file are not currently supported.) + + * is the length of the region to be locked in bytes. + + * is the type of lock requested. There are two types of locks: + * exclusive write locks ( = 0x0000 ) - the default, and shared + * read locks( = 0x0100 ). Additionally you can specify a + * blocking version of this function (that is it won't return until + * either an error has occurred or the lock has been obtained) by + * adding Ox0200 to the above values. + * $EXAMPLES$ + * refer to tfl.prg + * $STATUS$ + * R + * $COMPLIANCE$ + * H + * $PLATFORMS$ + * All(64K) + * $FILES$ + * Library is rtl + * $SEEALSO$ + * HB_FUNLOCK(),FOPEN(),FCREATE(),FERROR(),FCLOSE() + * $END$ + */ + +/* $DOC$ + * $TEMPLATE$ + * Function + * $NAME$ + * HB_FUNLOCK() + * $CATEGORY$ + * API + * $SUBCATEGORY$ + * FileSys + * $ONELINER$ + * Unlocks part or all of any file + * $SYNTAX$ + * HB_FUNLOCK( , , ) --> + + * $ARGUMENTS$ + * Dos file handle + + * Offset of the first byte of the region to be locked. + + * Number of bytes to be locked. + * $RETURNS$ + * .T. if the lock was removed, else .F. + * $DESCRIPTION$ + * This function attempts to unlock a region of the file whose file + * handle is . This is a low level file function. To + * unlock Harbour data files use the DBUNLOCK() function. + + * The value of is obtained from either a call to the FOPEN() + * or the FCREATE() function. + + * is the offset (from the beginning of the file) to the first + * byte of the region to be unlocked. (Offsets from the current position + * and end of file are not currently supported.) + + * is the length of the region to be unlocked in bytes. + * $EXAMPLES$ + * refer to tfl.prg + * $STATUS$ + * R + * $COMPLIANCE$ + * H + * $PLATFORMS$ + * All(64K) + * $FILES$ + * Library is rtl + * $SEEALSO$ + * HB_FLOCK(),FOPEN(),FCREATE(),FERROR(),FCLOSE() + * $END$ + */ diff --git a/harbour/tests/db_brows.prg b/harbour/tests/db_brows.prg index f11a2dd404..7518341b7d 100644 --- a/harbour/tests/db_brows.prg +++ b/harbour/tests/db_brows.prg @@ -208,7 +208,7 @@ FUNCTION DBFLIST( mslist, x1, y1, x2, y2, title, maskey ) ENDIF LI_COLPOS := 1 LI_NLEFT := LI_FREEZE + 1 - // DO MSFNEXT WITH mslist,LI_NLEFT +// DO MSFNEXT WITH mslist,LI_NLEFT LI_LEFTVISIBLE := LI_NLEFT STORE .T. TO rez LI_NCOLUMNS := FLDCOUNT( mslist, LI_X1 + 2, LI_X2 - 2, LI_NLEFT ) @@ -483,7 +483,7 @@ FUNCTION DBFLIST( mslist, x1, y1, x2, y2, title, maskey ) ELSEIF predit > 1 predit := 1 ENDIF - OTHERWISE + OTHERWISE IF maskey != Nil IF AScan( maskey, xkey ) != 0 rez := .F. @@ -722,7 +722,7 @@ FUNCTION FLDSTR( mslist, numf ) ENDIF ENDIF ENDIF - // fldtype := FIELDTYPE( numf ) +// fldtype := FIELDTYPE( numf ) fldtype := LI_MSTYP[ numf ] DO CASE CASE fldtype == "C" @@ -782,8 +782,8 @@ FUNCTION InitList LI_BSKIP := {| a, x | HB_SYMBOL_UNUSED( a ), dbSkip( x ) } LI_BGTOP := {|| dbGoTop() } LI_BGBOT := {|| dbGoBottom() } - LI_BEOF := {|| Eof() } - LI_BBOF := {|| Bof() } + LI_BEOF := {|| EOF() } + LI_BBOF := {|| BOF() } LI_B1 := {| a | HB_SYMBOL_UNUSED( a ), DevPos( LI_Y2, LI_X1 + 2 ), DevOut( Str( RecNo(), 6 ) + "/" + Str( LI_KOLZ, 6 ) ) } LI_FREEZE := 0 LI_RCOU := {|| RecCount() } @@ -807,7 +807,7 @@ FUNCTION InitList FUNCTION Defpict( mslist, i, maxlen ) - // LOCAL spict, fldd, fldtype := FIELDTYPE( i ), fldlen := FIELDSIZE( i ) +// LOCAL spict, fldd, fldtype := FIELDTYPE( i ), fldlen := FIELDSIZE( i ) LOCAL spict, fldd, fldtype := LI_MSTYP[ i ], fldlen := LI_MSLEN[ i ] DO CASE CASE fldtype == "C" diff --git a/harbour/tests/testcdx.prg b/harbour/tests/testcdx.prg index 9c27333b9c..bc7566738d 100644 --- a/harbour/tests/testcdx.prg +++ b/harbour/tests/testcdx.prg @@ -4,7 +4,7 @@ PROCEDURE Main() - LOCAL aStruct := {; + LOCAL aStruct := { ; { "CHARACTER", "C", 25, 0 }, ; { "NUMERIC", "N", 8, 0 }, ; { "DOUBLE", "N", 8, 2 }, ; @@ -17,20 +17,20 @@ PROCEDURE Main() dbCreate( "testcdx", aStruct, "DBFCDX", .T. , "TESTCDX" ) ? "RddName:", rddName() - // ? "Press any key to continue..." - // InKey( 0 ) +// ? "Press any key to continue..." +// InKey( 0 ) Select( "TESTDBF" ) SET FILTER TO TESTDBF->SALARY > 140000 TESTDBF->( dbGoTop() ) - // WHILE !TESTDBF->( Eof() ) - // TESTCDX->( dbAppend() ) - // TESTCDX->CHARACTER := TESTDBF->FIRST - // TESTCDX->NUMERIC := TESTDBF->SALARY - // TESTCDX->MEMO := TESTDBF->FIRST + Chr( 13 ) + Chr( 10 ) + ; - // TESTDBF->LAST + Chr( 13 ) + Chr( 10 ) + ; - // TESTDBF->STREET - // TESTDBF->( dbSkip() ) - // ENDDO +// WHILE !TESTDBF->( Eof() ) +// TESTCDX->( dbAppend() ) +// TESTCDX->CHARACTER := TESTDBF->FIRST +// TESTCDX->NUMERIC := TESTDBF->SALARY +// TESTCDX->MEMO := TESTDBF->FIRST + Chr( 13 ) + Chr( 10 ) + ; +// TESTDBF->LAST + Chr( 13 ) + Chr( 10 ) + ; +// TESTDBF->STREET +// TESTDBF->( dbSkip() ) +// ENDDO ? TESTCDX->( RecCount() ) TESTCDX->( dbGoTop() ) @@ -39,13 +39,13 @@ PROCEDURE Main() ? TESTCDX->( RecNo() ), TESTCDX->NUMERIC ? TESTCDX->MEMO TESTCDX->( dbSkip() ) - // ? "Press any key to continue..." - // InKey( 0 ) +// ? "Press any key to continue..." +// InKey( 0 ) ENDDO FErase( "testcdx.cdx" ) - SELECT( "TESTCDX" ) + Select( "TESTCDX" ) ordCreate( "testcdx", "Character", "CHARACTER", FIELD->CHARACTER, .F. ) RETURN diff --git a/harbour/tests/tflock.prg b/harbour/tests/tflock.prg new file mode 100644 index 0000000000..d0aa9cdf97 --- /dev/null +++ b/harbour/tests/tflock.prg @@ -0,0 +1,137 @@ +/* + * $Id$ + */ + +/* test file locking */ + +#include "fileio.ch" +#include "inkey.ch" + +#define READ_ACCESS 0 +#define WRITE_ACCESS 1 +#define READ_WRITE_ACCESS 2 + +#define FLX_EXCLUSIVE 0x0000 /* Exclusive lock */ +#define FLX_SHARED 0x0100 /* Shared lock */ +#define FLX_NO_WAIT 0x0000 /* Immediate return */ +#define FLX_WAIT 0x0200 /* Wait for lock until success */ + +#define hb_keyCode( x ) Asc( x ) + +STATIC s_lLocked +STATIC s_lExclusive +STATIC s_lBlocking + +PROCEDURE Main() + + LOCAL hLockFile + LOCAL lSuccess + LOCAL nExclusivity + LOCAL nBlocking + LOCAL nKeyHit + LOCAL nLockType + + QOut( "Opening lock file" ) + IF ( hLockFile := FOpen( "emphasis.6lo", READ_WRITE_ACCESS ) ) == F_ERROR + QOut( "ERROR: Cannot open Lock File" ) + RETURN + ENDIF + QOut( "Lock file opened - handle is", hb_ntos( hLockFile ) ) + QOut() + s_lLocked := .F. + s_lExclusive := .T. + s_lBlocking := .F. + nExclusivity := FLX_EXCLUSIVE + nBlocking := FLX_NO_WAIT + ShowStatus() + QOut( "[+] to get a lock, [-] to release it, [Esc] to exit, [E] for exclusive, [S] for shared, [B] for blocking, [N] for non-blocking" ) + DO WHILE .T. + nKeyHit := Inkey( 0 ) + SWITCH nKeyHit + CASE hb_keyCode( "+" ) + IF s_lLocked + QOut( "Already locked" ) + ELSE + nLockType := nExclusivity + nBlocking + QOut( "Requesting Lock" ) + lSuccess := hb_FLock( hLockFile, 0, 1, nLockType ) + IF lSuccess + QOut( "Lock has been obtained" ) + s_lLocked := .T. + ELSE + QOut( "Lock Request Failed - Error Code:", FError() ) + ENDIF + ENDIF + EXIT + CASE hb_keyCode( "-" ) + IF ! s_lLocked + QOut( "Lock not currently held" ) + ELSE + lSuccess := hb_FUnlock( hLockFile, 0, 1 ) + IF lSuccess + QOut( "Lock has been released" ) + s_lLocked := .F. + ELSE + QOut( "Unlock Request Failed - Error Code:", FError() ) + ENDIF + ENDIF + EXIT + CASE hb_keyCode( "E" ) + CASE hb_keyCode( "e" ) + IF s_lLocked + QOut( "Release Lock before changing lock type" ) + ELSE + s_lExclusive := .T. + nExclusivity := FLX_EXCLUSIVE + ShowStatus() + ENDIF + EXIT + CASE hb_keyCode( "S" ) + CASE hb_keyCode( "s" ) + IF s_lLocked + QOut( "Release Lock before changing lock type" ) + ELSE + s_lExclusive := .F. + nExclusivity := FLX_SHARED + ShowStatus() + ENDIF + EXIT + CASE hb_keyCode( "B" ) + CASE hb_keyCode( "b" ) + IF s_lLocked + QOut( "Release Lock before changing function mode" ) + ELSE + s_lBlocking := .T. + nExclusivity := FLX_WAIT + ShowStatus() + ENDIF + EXIT + CASE hb_keyCode( "N" ) + CASE hb_keyCode( "n" ) + IF s_lLocked + QOut( "Release Lock before changing function mode" ) + ELSE + s_lBlocking := .F. + nExclusivity := FLX_NO_WAIT + ShowStatus() + ENDIF + EXIT + CASE K_ESC + QOut() + FClose( hLockFile ) + QOut( "Exiting" ) + RETURN + OTHERWISE + QOut( "Key not supported", nKeyHit ) + ENDSWITCH + ENDDO + + RETURN + +PROCEDURE ShowStatus() + + QOut( "Lock: " + iif( s_lLocked, "Held", "Released" ) +; + " Type: " + iif( s_lExclusive, "Exclusive", "Shared" ) +; + " Request is: " + iif( s_lBlocking, "Blocking", "Non-Blocking" ) ) + + RETURN