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

2012-09-11 22:04 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
+ 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
This commit is contained in:
Viktor Szakats
2012-09-11 20:15:27 +00:00
parent 2ae8ffd909
commit e1a3aaff59
6 changed files with 330 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
harbour/ChangeLog
View File

@@ -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)

50
harbour/contrib/hbformat/hbfmtcls.prg
View File

@@ -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. ;

112
harbour/doc/en/hbflock.txt Normal file
View File

@@ -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( <nHandle>, <nOffset>, <nBytes> [, <nType ] )
* --> <lSuccess>
* $ARGUMENTS$
* <nHandle> Dos file handle
* <nOffset> Offset of the first byte of the region to be locked.
* <nBytes> Number of bytes to be locked.
* <nType> The type (read or write) of lock requested.
* $RETURNS$
* <lSuccess> .T. if the lock was obtained, else .F.
* $DESCRIPTION$
* This function attempts to lock a region of the file whose file handle
* is <nHandle>. This is a low level file function. To lock Harbour
* data files use either the FLOCK() or RLOCK() function.
* The value of <nHandle> is obtained from either a call to the FOPEN()
* or the FCREATE() function.
* <nOffset> 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.)
* <nBytes> is the length of the region to be locked in bytes.
* <nType> is the type of lock requested. There are two types of locks:
* exclusive write locks ( <nType> = 0x0000 ) - the default, and shared
* read locks( <nType> = 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( <nHandle>, <nOffset>, <nBytes> ) --> <lSuccess>
* $ARGUMENTS$
* <nHandle> Dos file handle
* <nOffset> Offset of the first byte of the region to be locked.
* <nBytes> Number of bytes to be locked.
* $RETURNS$
* <lSuccess> .T. if the lock was removed, else .F.
* $DESCRIPTION$
* This function attempts to unlock a region of the file whose file
* handle is <nHandle>. This is a low level file function. To
* unlock Harbour data files use the DBUNLOCK() function.
* The value of <nHandle> is obtained from either a call to the FOPEN()
* or the FCREATE() function.
* <nOffset> 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.)
* <nBytes> 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$
*/

12
harbour/tests/db_brows.prg
View File

@@ -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"

30
harbour/tests/testcdx.prg
View File

@@ -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

137
harbour/tests/tflock.prg Normal file
View File

@@ -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