diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 406c627a67..7e83c6a232 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,40 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-07-25 15:24 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/contrib/xhb/Makefile + * harbour/contrib/xhb/common.mak + + harbour/contrib/xhb/dirrec.prg + + added DirectoryRecurse() function. It's not exactly xHarbour + compatible as I wanted at the beginning. But when I begin + to carefully check what xHarbour exactly does then I dropped + the strict compatibility due to problems with xHarbour + implementation which have to be fixed. I left this note in the + dirrec.prg header: + This implementation uses different rules then xHarbour one. + It does not change current drive or current directory so + unlike the xHarbour version it's MT safe. + It also returns relative paths which are more similar to + DIRECTORY() function results so they can be easy used + directly in other code, f.e. to create archive without + absolute paths. Please note that user can easy convert + relative paths to absolte ones by simple adding curdir() + and/or cPath parameter passed to DirectoryRecurse() but + reverted conversion may not be possible in some cases. + The 3-rd xHarbour parameter is ignored because + harbour uses platform native rules to check filename mask + respecting SET FILECASE and SET DIRCASE settings. + xHarbour does not add "D" to attribute list used for directory + tree scanning so user always have to add it manually and later + it ignores it so it's not possible to extract file list with + directories entries. In Harbour it's fixed. + + * harbour/source/rtl/philes.c + + added hb_osFileMask() + + * harbour/source/rtl/direct.c + % minor optimization + 2008-07-25 11:27 UTC+0200 Viktor Szakats (harbour.01 syenar hu) * contrib/hbziparch/hbziparc.c ! Fixed bug reported by Juan Galvez. @@ -139,7 +173,7 @@ * contrib/hbclipsm/common.mak * contrib/hbclipsm/Makefile - contrib/hbclipsm/dbf.c - ! Removed duplicate implementation of DBF() from hbclipsm.lib + ! Removed duplicate implementation of DBF() from hbclipsm.lib ; TOFIX: I'm getting these new warnings under BCC55: diff --git a/harbour/contrib/xhb/Makefile b/harbour/contrib/xhb/Makefile index 163f3978ee..daa7a05507 100644 --- a/harbour/contrib/xhb/Makefile +++ b/harbour/contrib/xhb/Makefile @@ -27,6 +27,7 @@ PRG_SOURCES=\ hblog.prg \ hblognet.prg \ cstruct.prg \ + dirrec.prg \ xhbcomp.prg \ PRG_HEADERS=\ diff --git a/harbour/contrib/xhb/common.mak b/harbour/contrib/xhb/common.mak index 32b705aea9..102be30582 100644 --- a/harbour/contrib/xhb/common.mak +++ b/harbour/contrib/xhb/common.mak @@ -32,6 +32,7 @@ LIB_OBJS = \ $(OBJ_DIR)hblog$(OBJEXT) \ $(OBJ_DIR)hblognet$(OBJEXT) \ $(OBJ_DIR)cstruct$(OBJEXT) \ + $(OBJ_DIR)dirrec$(OBJEXT) \ $(OBJ_DIR)xhbcomp$(OBJEXT) \ all: \ diff --git a/harbour/contrib/xhb/dirrec.prg b/harbour/contrib/xhb/dirrec.prg new file mode 100644 index 0000000000..5d96fa22b6 --- /dev/null +++ b/harbour/contrib/xhb/dirrec.prg @@ -0,0 +1,112 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * xHarbour compatible function DirectoryRecurse() + * + * Copyright 2008 Przemyslaw Czerpak + * 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, or (at your option) + * any later version. + * + * 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 software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +/* This implementation uses different rules then xHarbour one. + * It does not change current drive or current directory so + * unlike the xHarbour version it's MT safe. + * It also returns relative paths which are more similar to + * DIRECTORY() function results so they can be easy used + * directly in other code, f.e. to create archive without + * absolute paths. Please note that user can easy convert + * relative paths to absolte ones by simple adding curdir() + * and/or cPath parameter passed to DirectoryRecurse() but + * reverted conversion may not be possible in some cases. + * The 3-rd xHarbour parameter is ignored because + * harbour uses platform native rules to check filename mask + * respecting SET FILECASE and SET DIRCASE settings. + * xHarbour does not add "D" to attribute list used for directory + * tree scanning so user always have to add it manually and later + * it ignores it so it's not possible to extract file list with + * directories entries. In Harbour it's fixed. + * [druzus] + */ + +FUNCTION DirectoryRecurse( cPath, cAttr ) + + LOCAL aResult := {}, aDir, aFile, cExt, cMask, cPathSep + + IF Empty( cPath ) + cPath := "" + cMask := hb_osFileMask() + ELSE + hb_FNameSplit( cPath, @cPath, @cMask, @cExt ) + cMask += cExt + IF cMask == "" + cMask := hb_osFileMask() + ENDIF + ENDIF + + IF ! ValType( cAttr ) $ "CM" + cAttr := "" + ENDIF + + cPathSep := hb_osPathSeparator() + /* xHarbour does not add "D" to attribute list */ + aDir := Directory( cPath + cMask, cAttr + "D" ) + + FOR EACH aFile IN aDir + IF "D" $ aFile[ 5 ] + /* xHarbour does not respect "D" in attribute list */ + IF "D" $ cAttr + AAdd( aResult, aFile ) + ENDIF + IF !( aFile[ 1 ] == "." .OR. aFile[ 1 ] == ".." ) + AEval( DirectoryRecurse( cPath + aFile[ 1 ] + cPathSep + cMask, cAttr ), ; + { |x| x[ 1 ] := aFile[ 1 ] + cPathSep + x[ 1 ], ; + AAdd( aResult, x ) } ) + ENDIF + ELSE + AAdd( aResult, aFile ) + ENDIF + NEXT + + RETURN aResult diff --git a/harbour/source/rtl/direct.c b/harbour/source/rtl/direct.c index bb66c6d353..6cb8b8a969 100644 --- a/harbour/source/rtl/direct.c +++ b/harbour/source/rtl/direct.c @@ -196,7 +196,7 @@ HB_FUNC( DIRECTORY ) hb_arraySetC ( pSubarray, F_ATTR, hb_fsAttrDecode( ffind->attr, buffer ) ); /* Don't exit when array limit is reached */ - hb_arrayAdd( pDir, pSubarray ); + hb_arrayAddForward( pDir, pSubarray ); } while( hb_fsFindNext( ffind ) ); diff --git a/harbour/source/rtl/philes.c b/harbour/source/rtl/philes.c index 545599c9bd..a129dea8b5 100644 --- a/harbour/source/rtl/philes.c +++ b/harbour/source/rtl/philes.c @@ -321,3 +321,8 @@ HB_FUNC( HB_OSDRIVESEPARATOR ) hb_retc( NULL ); #endif } + +HB_FUNC( HB_OSFILEMASK ) +{ + hb_retc( OS_FILE_MASK ); +}