From ec993d4753bbfddd8344c62be8cc161e9b414e6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Czerpak?= Date: Fri, 21 Apr 2023 11:45:59 +0200 Subject: [PATCH] 2023-04-21 11:45 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * include/harbour.hbx * src/harbour.def * src/rtl/vfile.c + added new PRG function: hb_vfIsLocal( ) --> It returns TRUE if is not redirected to any Harbour File IO driver but access local file system API. * contrib/xhb/traceprg.prg * merged with Victor's branch so now Harbour File IO API is used to access log file. * convert relative log file name to absolute file path name % write whole log entry in single IO operation. --- ChangeLog.txt | 15 ++++ contrib/xhb/traceprg.prg | 173 ++++++++++++++++++++++----------------- include/harbour.hbx | 1 + src/harbour.def | 1 + src/rtl/vfile.c | 5 ++ 5 files changed, 121 insertions(+), 74 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index 01d86e75ab..c85151075a 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -7,6 +7,21 @@ Entries may not always be in chronological/commit order. See license at the end of file. */ +2023-04-21 11:45 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * include/harbour.hbx + * src/harbour.def + * src/rtl/vfile.c + + added new PRG function: + hb_vfIsLocal( ) --> + It returns TRUE if is not redirected to any Harbour File IO + driver but access local file system API. + + * contrib/xhb/traceprg.prg + * merged with Victor's branch so now Harbour File IO API is used to + access log file. + * convert relative log file name to absolute file path name + % write whole log entry in single IO operation. + 2023-04-20 23:35 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * contrib/xhb/hbcompat.ch ! fixed translations of xHarbour operators inside brackets, diff --git a/contrib/xhb/traceprg.prg b/contrib/xhb/traceprg.prg index 021539f39d..99a4dd4e6e 100644 --- a/contrib/xhb/traceprg.prg +++ b/contrib/xhb/traceprg.prg @@ -51,32 +51,39 @@ STATIC s_lSET_TRACE := .T. STATIC s_cSET_TRACEFILE := "trace.log" +STATIC s_cSET_TRACEFILER := nil STATIC s_nSET_TRACESTACK := HB_SET_TRACESTACK_ALL FUNCTION xhb_SetTrace( xTrace ) LOCAL lTrace := s_lSET_TRACE - IF HB_ISLOGICAL( xTrace ) + DO CASE + CASE HB_ISLOGICAL( xTrace ) s_lSET_TRACE := xTrace - ELSEIF HB_ISSTRING( xTrace ) - IF Upper( xTrace ) == "ON" + CASE HB_ISSTRING( xTrace ) + SWITCH Upper( xTrace ) + CASE "ON" s_lSET_TRACE := .T. - ELSEIF Upper( xTrace ) == "OFF" + EXIT + CASE "OFF" s_lSET_TRACE := .F. - ENDIF - ENDIF + EXIT + ENDSWITCH + ENDCASE RETURN lTrace FUNCTION xhb_SetTraceFile( xFile, lAppend ) LOCAL cTraceFile := s_cSET_TRACEFILE + LOCAL hFile - IF HB_ISSTRING( xFile ) - s_cSET_TRACEFILE := xFile - IF ! HB_ISLOGICAL( lAppend ) .OR. ! lAppend - FClose( FCreate( s_cSET_TRACEFILE ) ) + IF HB_ISSTRING( xFile ) .AND. ! Empty( xFile ) + s_cSET_TRACEFILER := s_cSET_TRACEFILE := s_RealPath( xFile ) + IF ! hb_defaultValue( lAppend, .F. ) .AND. ; + ( hFile := hb_vfOpen( @s_cSET_TRACEFILER, FO_CREAT + FO_TRUNC + FO_WRITE ) ) != NIL + hb_vfClose( hFile ) ENDIF ENDIF @@ -86,88 +93,106 @@ FUNCTION xhb_SetTraceStack( xLevel ) LOCAL nTraceLevel := s_nSET_TRACESTACK - IF HB_ISSTRING( xLevel ) - IF Upper( xLevel ) == "NONE" + DO CASE + CASE HB_ISSTRING( xLevel ) + SWITCH xLevel + CASE "NONE" s_nSET_TRACESTACK := HB_SET_TRACESTACK_NONE - ELSEIF Upper( xLevel ) == "CURRENT" + EXIT + CASE "CURRENT" s_nSET_TRACESTACK := HB_SET_TRACESTACK_CURRENT - ELSEIF Upper( xLevel ) == "ALL" + EXIT + CASE "ALL" s_nSET_TRACESTACK := HB_SET_TRACESTACK_ALL - ENDIF - ELSEIF HB_ISNUMERIC( xLevel ) + EXIT + ENDSWITCH + CASE HB_ISNUMERIC( xLevel ) IF xLevel >= 0 s_nSET_TRACESTACK := xLevel ENDIF - ENDIF + ENDCASE RETURN nTraceLevel -// --------------------------------------------------------------// +/* --- */ FUNCTION TraceLog( ... ) // Using PRIVATE instead of LOCALs so TraceLog() is DIVERT friendly. - LOCAL cFile, FileHandle, nLevel, ProcName, xParam + LOCAL hFile, nLevel, ProcName, xParam, cData -#ifdef __XHARBOUR__ - IF ! Set( _SET_TRACE ) - RETURN .T. + IF s_lSET_TRACE + + cData := "" + + nLevel := s_nSET_TRACESTACK + + IF nLevel > 0 + cData += "[" + ProcFile( 1 ) + "->" + ProcName( 1 ) + "] (" + hb_ntos( ProcLine( 1 ) ) + ")" + ENDIF + + IF nLevel > 1 .AND. ! ProcName( 2 ) == "" + cData += " Called from:" + hb_eol() + nLevel := 1 + DO WHILE ! ( ProcName := ProcName( ++nLevel ) ) == "" + cData += Space( 30 ) + ProcFile( nLevel ) + "->" + ProcName + "(" + hb_ntos( ProcLine( nLevel ) ) + ")" + hb_eol() + ENDDO + ELSE + cData += hb_eol() + ENDIF + + FOR EACH xParam IN hb_AParams() + cData += "Type: " + ValType( xParam ) + " >>>" + hb_CStr( xParam ) + "<<<" + hb_eol() + NEXT + + cData += hb_eol() + + IF s_cSET_TRACEFILER == nil + s_cSET_TRACEFILER := s_cSET_TRACEFILE := s_RealPath( s_cSET_TRACEFILE ) + ENDIF + IF ( hFile := hb_vfOpen( @s_cSET_TRACEFILER, FO_CREAT + FO_WRITE ) ) != NIL + hb_vfSeek( hFile, 0, FS_END ) + hb_vfWrite( hFile, cData ) + hb_vfClose( hFile ) + ENDIF ENDIF - cFile := Set( _SET_TRACEFILE ) - nLevel := Set( _SET_TRACESTACK ) -#else - IF ! s_lSET_TRACE - RETURN .T. - ENDIF - - cFile := s_cSET_TRACEFILE - nLevel := s_nSET_TRACESTACK -#endif - - /* hb_FileExists() and FOpen()/FCreate() make different assumptions rgdg path, - so we have to make sure cFile contains path to avoid ambiguity */ - cFile := cWithPath( cFile ) - - IF hb_FileExists( cFile ) - FileHandle := FOpen( cFile, FO_WRITE ) - ELSE - FileHandle := FCreate( cFile ) - ENDIF - - FSeek( FileHandle, 0, FS_END ) - - IF nLevel > 0 - FWrite( FileHandle, "[" + ProcFile( 1 ) + "->" + ProcName( 1 ) + "] (" + hb_ntos( ProcLine( 1 ) ) + ")" ) - ENDIF - - IF nLevel > 1 .AND. ! ( ProcName( 2 ) == "" ) - FWrite( FileHandle, " Called from: " + hb_eol() ) - nLevel := 1 - DO WHILE ! ( ( ProcName := ProcName( ++nLevel ) ) == "" ) - FWrite( FileHandle, Space( 30 ) + ProcFile( nLevel ) + "->" + ProcName + "(" + hb_ntos( ProcLine( nLevel ) ) + ")" + hb_eol() ) - ENDDO - ELSE - FWrite( FileHandle, hb_eol() ) - ENDIF - - FOR EACH xParam IN hb_AParams() - FWrite( FileHandle, "Type: " + ValType( xParam ) + " >>>" + hb_CStr( xParam ) + "<<<" + hb_eol() ) - NEXT - - FWrite( FileHandle, hb_eol() ) - - FClose( FileHandle ) - RETURN .T. -// +STATIC FUNCTION s_RealPath( cFilename ) -/* Ensure cFilename contains path. If it doesn't, add current directory to the front of it */ -STATIC FUNCTION cWithPath( cFilename ) + LOCAL cPath, cName, cExt, cDrv, cDir, nStart - LOCAL cPath + IF hb_vfIsLocal( cFilename ) + hb_FNameSplit( cFilename, @cPath, @cName, @cExt, @cDrv ) + IF Empty( hb_osDriveSeparator() ) + cDrv := "" + ENDIF + nStart := iif( Empty( cDrv ), 1, 3 ) + IF ! SubStr( cPath, nStart, 1 ) $ hb_osPathDelimiters() + IF Empty( cDrv ) .OR. cDrv == DiskName() + cPath := hb_cwd() + SubStr( cPath, nStart ) + ELSE + #ifdef __PLATFORM__WINDOWS + /* WIN API used by Harbour binds current directory with + process not with drive letters, due to side effects in + current Harbour code for MS-Windows using CurDir( cDrv ) + changes current directory to root path [druzus] */ + cDir := "" + #else + IF ! Empty( cDir := CurDir( cDrv ) ) + cDir += hb_ps() + ENDIF + #endif + cPath := cDrv + hb_osDriveSeparator() + hb_ps() + cDir + ; + SubStr( cPath, nStart ) + ENDIF + cFilename := hb_FNameMerge( cPath, cName, cExt ) + ELSEIF Empty( cDrv ) .AND. ! Empty( cDrv := DiskName() ) .AND. ; + ! SubStr( cPath, 2, 1 ) $ hb_osPathDelimiters() + cPath := cDrv + hb_osDriveSeparator() + cPath + cFilename := hb_FNameMerge( cPath, cName, cExt ) + ENDIF + ENDIF - hb_FNameSplit( cFilename, @cPath ) - - RETURN iif( Empty( cPath ), "." + hb_ps(), "" ) + cFilename + RETURN cFilename diff --git a/include/harbour.hbx b/include/harbour.hbx index 4c4c8950e1..30deabc19d 100644 --- a/include/harbour.hbx +++ b/include/harbour.hbx @@ -957,6 +957,7 @@ DYNAMIC hb_vfErase DYNAMIC hb_vfExists DYNAMIC hb_vfFlush DYNAMIC hb_vfHandle +DYNAMIC hb_vfIsLocal DYNAMIC hb_vfLink DYNAMIC hb_vfLinkRead DYNAMIC hb_vfLinkSym diff --git a/src/harbour.def b/src/harbour.def index 61173bd06e..a6ba1cc345 100644 --- a/src/harbour.def +++ b/src/harbour.def @@ -1149,6 +1149,7 @@ HB_FUN_HB_VFERASE HB_FUN_HB_VFEXISTS HB_FUN_HB_VFFLUSH HB_FUN_HB_VFHANDLE +HB_FUN_HB_VFISLOCAL HB_FUN_HB_VFLINK HB_FUN_HB_VFLINKREAD HB_FUN_HB_VFLINKSYM diff --git a/src/rtl/vfile.c b/src/rtl/vfile.c index a6b699f1b4..a49c35d16c 100644 --- a/src/rtl/vfile.c +++ b/src/rtl/vfile.c @@ -129,6 +129,11 @@ static void hb_fileReturn( PHB_FILE pFile ) hb_ret(); } +/* hb_vfIsLocal( ) --> */ +HB_FUNC( HB_VFISLOCAL ) +{ + hb_retl( hb_fileIsLocalName( hb_parc( 1 ) ) ); +} /* hb_vfExists( , [ @ ] ) --> */ HB_FUNC( HB_VFEXISTS ) {