From 278c09de8427b2c8599a28cbba1920fefc24deee Mon Sep 17 00:00:00 2001 From: "David G. Holm" Date: Thu, 19 Apr 2001 21:14:32 +0000 Subject: [PATCH] See ChangeLog entry 2001-04-19 17:10 UTC-0400 David G. Holm --- harbour/ChangeLog | 16 ++ harbour/doc/funclist.txt | 2 +- harbour/hb_slex.bc | 1 + harbour/hb_slex.vc | 3 +- harbour/makefile.bc | 8 + harbour/makefile.vc | 3 +- harbour/source/rtl/Makefile | 3 +- harbour/source/rtl/dbdelim.prg | 18 ++- harbour/source/rtl/dbsdf.prg | 260 +++++++++++++++++++++++++++++++++ harbour/tests/Makefile | 1 + harbour/tests/sdf_test.prg | 44 ++++++ 11 files changed, 348 insertions(+), 11 deletions(-) create mode 100644 harbour/source/rtl/dbsdf.prg create mode 100644 harbour/tests/sdf_test.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index aeb8756fc1..b7679dfe9f 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,19 @@ +2001-04-19 17:10 UTC-0400 David G. Holm + + * hb_slex.bc + * hb_slex.vc + * makefile.bc + * makefile.vc + * source/rtl/Makefile + * source/rtl/dbdelim.prg + + source/rtl/dbsdf.prg + * tests/Makefile + + tests/sdf_test.prg + + Added __dbSDF() with support for COPY TO SDF. + + Added dbdelim.obj to makefile.vc. + * Fixed CVS ID header in dbdelim.prg. + * Changed name of Export() function in dbdelim.prg to ExportVar() + 2001-04-19 15:07 GMT+2 Maurilio Longo * source/rtl/teditor.prg ! regression from previous fix diff --git a/harbour/doc/funclist.txt b/harbour/doc/funclist.txt index e8e69a81ce..5523ff9dc6 100644 --- a/harbour/doc/funclist.txt +++ b/harbour/doc/funclist.txt @@ -292,7 +292,7 @@ __dbJoin ;N; __dbList ;R; __dbLocate ;R; __dbPack ;R; -__dbSDF ;N; +__dbSDF ;S; __dbSort ;N; __dbTotal ;N; __dbUpdate ;R; diff --git a/harbour/hb_slex.bc b/harbour/hb_slex.bc index e79206b2c5..ab95ebc5d6 100644 --- a/harbour/hb_slex.bc +++ b/harbour/hb_slex.bc @@ -292,6 +292,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browse.obj \ $(OBJ_DIR)\dbedit.obj \ $(OBJ_DIR)\dbdelim.obj \ + $(OBJ_DIR)\dbsdf.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ diff --git a/harbour/hb_slex.vc b/harbour/hb_slex.vc index 44a80b6ac6..f4b333a89e 100644 --- a/harbour/hb_slex.vc +++ b/harbour/hb_slex.vc @@ -324,8 +324,9 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdb.obj \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ + $(OBJ_DIR)\dbdelim.obj \ $(OBJ_DIR)\dbedit.obj \ - $(OBJ_DIR)\dbedit.obj \ + $(OBJ_DIR)\dbsdf.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ diff --git a/harbour/makefile.bc b/harbour/makefile.bc index e17bae6e30..3c5128e57a 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -292,6 +292,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browse.obj \ $(OBJ_DIR)\dbedit.obj \ $(OBJ_DIR)\dbdelim.obj \ + $(OBJ_DIR)\dbsdf.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ @@ -1169,6 +1170,13 @@ $(OBJ_DIR)\dbdelim.obj : $(OBJ_DIR)\dbdelim.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\dbsdf.c : $(RTL_DIR)\dbsdf.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\dbsdf.obj : $(OBJ_DIR)\dbsdf.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\defpath.obj : $(RTL_DIR)\defpath.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/makefile.vc b/harbour/makefile.vc index a6fee89b5b..40f51aeddc 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -324,8 +324,9 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdb.obj \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ - $(OBJ_DIR)\dbedit.obj \ $(OBJ_DIR)\dbdelim.obj \ + $(OBJ_DIR)\dbedit.obj \ + $(OBJ_DIR)\dbsdf.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 9f61701585..edadb5ac01 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -118,8 +118,9 @@ PRG_SOURCES=\ browdb.prg \ browdbx.prg \ browse.prg \ - dbdelim.prg \ + dbdelim.prg \ dbedit.prg \ + dbsdf.prg \ devoutp.prg \ dircmd.prg \ dummy.prg \ diff --git a/harbour/source/rtl/dbdelim.prg b/harbour/source/rtl/dbdelim.prg index 1d2d525b64..c69b9cbc42 100644 --- a/harbour/source/rtl/dbdelim.prg +++ b/harbour/source/rtl/dbdelim.prg @@ -1,8 +1,11 @@ /* - * $ID:$ - * + * $Id$ + */ + +/* * Harbour Project source code: * Copies the contents of a database to a delimited text file. + * Appends the contents of a delimited text file to a database. * * Copyright 2001 David G. Holm * www - http://www.harbour-project.org @@ -90,11 +93,12 @@ * NIL * $DESCRIPTION$ * __dbDelim() copies all or selected contents of a database table - * to a delimited text file. + * to an SDF text file or appends all or selected contents of an SDF + * text file to a database table. * $EXAMPLES$ * // Copy delinquent accounts into a delimited text file. * USE ACCOUNTS NEW - * COPY TO overdue FOR !EMPTY( accounts->duedate ) ; + * COPY TO overdue DELIMITED FOR !EMPTY( accounts->duedate ) ; * .AND. DATE() - accounts->duedate > 30 * // Import new customer records. * USE CUSTOMER NEW @@ -204,7 +208,7 @@ FUNCTION __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRe IF lWriteSep AppendSep( handle, cSeparator ) END IF - lWriteSep := Export( handle, FIELDGET( index ), cDelim ) + lWriteSep := ExportVar( handle, FIELDGET( index ), cDelim ) NEXT index ELSE // Process the specified fields. @@ -212,7 +216,7 @@ FUNCTION __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRe IF lWriteSep AppendSep( handle, cSeparator ) END IF - lWriteSep := Export( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ), cDelim ) + lWriteSep := ExportVar( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ), cDelim ) NEXT index END IF // Set up for the start of the next record. @@ -252,7 +256,7 @@ FUNCTION __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRe END IF RETURN NIL -STATIC FUNCTION Export( handle, xField, cDelim ) +STATIC FUNCTION ExportVar( handle, xField, cDelim ) LOCAL cText := "", lWrite := .F. DO CASE CASE VALTYPE( xField ) == "C" diff --git a/harbour/source/rtl/dbsdf.prg b/harbour/source/rtl/dbsdf.prg new file mode 100644 index 0000000000..609a05daa1 --- /dev/null +++ b/harbour/source/rtl/dbsdf.prg @@ -0,0 +1,260 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Copies the contents of a database to an SDF text file. + * Appends the contents of an SDF text file to a database. + * + * Copyright 2001 David G. Holm + * 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. + * + */ + +#include +#include +#include + +/* $DOC$ + * $FUNCNAME$ + * __dbSDF() + * $CATEGORY$ + * Conversion + * $ONELINER$ + * Copies the contents of a database to an SDF text file or + * appends the contents of an SDF text file to a database. + * $SYNTAX$ + * __dbSDF( , , [], + * [], [], [], [], ) --> NIL + * $ARGUMENTS$ + * If set to .T., copies records to an SDF file. + * If set to .F., append records from an SDF file. + * The name of the text file to copy to or append from. + * If a file extension is not specified, ".txt" is used by default. + * An aray of field names to limit the processint to. If + * not specified, or if empty, then all fields are processed. + * An optional code block containing a FOR expression that + * will reduce the number of records to be processed. + * An optional code block containing a WHILE expression + * that will reduce the number of records to be processed. + * If present, but nRecord is not present, specifies to + * process this number of records, starting with the current record. + * A value of 0 means to process no records. + * If present, specifies the only record to process. A + * value of 0 means to process no records. Overrides nNext and lRest. + * If lExport is .T., then if set to .T. and there are no + * nRecord, nNext, or bWhile arguments, processes all records from + * current to last. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * __dbSDF() copies all or selected contents of a database table + * to an SDF text file or appends all or selected contents of an + * SDF text file to a database table. + * $EXAMPLES$ + * // Copy delinquent accounts into an SDF text file. + * USE ACCOUNTS NEW + * COPY TO overdue SDF FOR !EMPTY( accounts->duedate ) ; + * .AND. DATE() - accounts->duedate > 30 + * // Import new customer records. + * USE CUSTOMER NEW + * APPEND FROM customer SDF + * $TESTS$ + * + * $STATUS$ + * S + * $COMPLIANCE$ + * __dbSDF() is intended to be fully compliant with CA-Clipper's + * function of the same name and is the underlying implementation + * of the APPEND FROM SDF and COPY TO SDF commands. + * $PLATFORMS$ + * All + * $FILES$ + * + * $SEEALSO$ + * __dbDelim(), APPEND FROM, COPY TO + * $END$ + */ + +FUNCTION __dbSDF( lExport, cFile, aFields, bFor, bWhile, nNext, nRecord, lRest ) + LOCAL index, handle, cFileName := cFile, nStart, nCount, oErr + + // Process the file name argument. + index := RAT( ".", cFileName ) + IF index > 0 + // The file name might include a file extension. + IF RAT( "/", cFileName ) > index ; + .OR. RAT( "\", cFileName ) > index + // No, the file extension is in a directory name. + index := 0 + END IF + END IF + IF index <= 0 + // No file name extension, so provide the default. + cFileName += ".txt" + END IF + + // Determine where to start and how many records to process. + IF nRecord != NIL + // The RECORD clause has the highest priority. + nStart := nRecord + nCount := 1 + ELSEIF nNext != NIL + // The NEXT clause has the next highest priority. + nStart := -1 + nCount := nNext + ELSEIF bWhile != NIL .OR. lRest + // The WHILE and REST clauses have equal priority. + nStart := -1 + nCount := -1 + ELSE + // Followed by the FOR clause or the ALL clause. + nStart := 1 + nCount := -1 + END IF + IF EMPTY( bFor ) + // This simplifies the test that determines whether or not to + // use (i.e., import or export) any given processed record. + bFor := {||.T.} + END IF + + IF lExport + // COPY TO SDF + handle := FCREATE( cFileName ) + IF handle == -1 + oErr := ErrorNew() + oErr:severity := ES_ERROR + oErr:genCode := EG_CREATE + oErr:subSystem := "SDF" + oErr:subCode := 1002 + oErr:description := HB_LANGERRMSG( oErr:genCode ) + oErr:canRetry := .T. + oErr:canDefault := .T. + oErr:fileName := cFileName + oErr:osCode := FERROR() + Eval(ErrorBlock(), oErr) + ELSE + IF nStart > -1 + // Only reposition if a starting record was specified or implied. + GO (nStart) + END IF + IF EMPTY( bWhile ) + // This simplifies the looping logic. + bWhile := {||!BOF().AND.!EOF()} + END IF + // Process the records to copy SDF. + WHILE EVAL( bWhile ) .AND. ( nCount == -1 .OR. nCount > 0 ) + IF EVAL( bFor ) + IF EMPTY( aFields ) + // Process all fields. + FOR index := 1 TO FCOUNT() + ExportFixed( handle, FIELDGET( index ) ) + NEXT index + ELSE + // Process the specified fields. + FOR index := 1 TO LEN( aFields ) + ExportFixed( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ) ) + NEXT index + END IF + // Set up for the start of the next record. + AppendEOL( handle ) + END IF + IF nCount != -1 + nCount-- + END IF + SKIP + END WHILE + AppendEOF( handle ) + FCLOSE( handle ) + END IF + ELSE + // APPEND FROM SDF + handle := FOPEN( cFileName ) + IF handle == -1 + oErr := ErrorNew() + oErr:severity := ES_ERROR + oErr:genCode := EG_OPEN + oErr:subSystem := "SDF" + oErr:subCode := 1001 + oErr:description := HB_LANGERRMSG( oErr:genCode ) + oErr:canRetry := .T. + oErr:canDefault := .T. + oErr:fileName := cFileName + oErr:osCode := FERROR() + Eval(ErrorBlock(), oErr) + ELSE + IF EMPTY( bWhile ) + // This simplifies the looping logic. + bWhile := {||.T.} + END IF + FCLOSE( handle ) + END IF + END IF +RETURN NIL + +STATIC FUNCTION ExportFixed( handle, xField ) + LOCAL cText := "", lWrite := .F. + DO CASE + CASE VALTYPE( xField ) == "C" + cText := xField + lWrite := .T. + CASE VALTYPE( xField ) == "D" + cText := DTOS( xField ) + lWrite := .T. + CASE VALTYPE( xField ) == "L" + cText := IF( xField, "T", "F" ) + lWrite := .T. + CASE VALTYPE( xField ) == "N" + cText := STR( xField ) + lWrite := .T. + END CASE + FWRITE( handle, cText ) +RETURN lWrite + +STATIC FUNCTION AppendEOL( handle ) + STATIC cEOL := CHR( 13 ) + CHR( 10 ) +RETURN FWRITE( handle, cEOL ) + +STATIC FUNCTION AppendEOF( handle ) + STATIC cEOF := CHR( 26 ) +RETURN FWRITE( handle, cEOF ) diff --git a/harbour/tests/Makefile b/harbour/tests/Makefile index 9ec2aa29ff..e39bee070a 100644 --- a/harbour/tests/Makefile +++ b/harbour/tests/Makefile @@ -109,6 +109,7 @@ PRG_SOURCES=\ round.prg \ say.prg \ scroll.prg \ + sdf_test.prg \ seconds.prg \ setkeys.prg \ set_num.prg \ diff --git a/harbour/tests/sdf_test.prg b/harbour/tests/sdf_test.prg new file mode 100644 index 0000000000..a9069b5763 --- /dev/null +++ b/harbour/tests/sdf_test.prg @@ -0,0 +1,44 @@ +//NOTEST +// $Id$ +// + +// Test program for COPY TO SDF and APPEND FROM SDF +// Note: Only COPY TO SDF is fully implemented at this time... +/* Harbour Project source code + http://www.Harbour-Project.org/ + Donated to the public domain on 2001-04-18 by David G. Holm +*/ + +procedure main() + use test new + // Copy all records and fields. + copy to test1 SDF + + // Copy only address fields for records with salary over 50,000. + copy field first,last,street,city,state,zip to test2 SDF for _field->salary>50000 + + // Only copy record 3. + copy record 3 to test3 SDF + + // Copy records 4 through 7. + copy next 4 to test4 SDF + + // Copy the last 10 records. + go bottom + skip -9 + copy rest to test5 SDF + + // Copy the last 10 records again. + go bottom + skip -9 + copy to test6 SDF while !eof() + + // Copy only some of the last 10 records. + go bottom + skip -9 + copy rest to test7 SDF for _field->married + + // Try to append from a file that we know does not exist. + delete file test8.txt + append from test8 SDF +quit \ No newline at end of file