See ChangeLog entry 2001-04-19 17:10 UTC-0400 David G. Holm <dholm@jsd-llc.com>

2001-04-19 21:14:32 +00:00
parent 12f18e57ed
commit 278c09de84
11 changed files with 348 additions and 11 deletions
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -1,3 +1,19 @@
+2001-04-19 17:10 UTC-0400 David G. Holm <dholm@jsd-llc.com>
+
+  * 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 <maurilio.longo@libero.it>
   * source/rtl/teditor.prg
     ! regression from previous fix
--- 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;
--- 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 \
--- 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 \
--- 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) -+$@,,
--- 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 \
--- 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    \
--- 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 <dholm@jsd-llc.com>
 * 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"
--- a/harbour/source/rtl/dbsdf.prg
+++ 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 <dholm@jsd-llc.com>
+ * 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 <fileio.ch>
+#include <hbclass.ch>
+#include <error.ch>
+
+/*  $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( <lExport>, <xcFile>, [<aFields>],
+ *      [<bFor>], [<bWhile>], [<nNext>], [<nRecord>], <lRest>  ) --> NIL
+ *  $ARGUMENTS$
+ *      <lExport> If set to .T., copies records to an SDF file.
+ *      If set to .F., append records from an SDF file.
+ *      <xcFile> The name of the text file to copy to or append from.
+ *      If a file extension is not specified, ".txt" is used by default.
+ *      <aFields> An aray of field names to limit the processint to. If
+ *      not specified, or if empty, then all fields are processed.
+ *      <bFor> An optional code block containing a FOR expression that
+ *      will reduce the number of records to be processed.
+ *      <bWhile> An optional code block containing a WHILE expression
+ *      that will reduce the number of records to be processed.
+ *      <nNext> 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.
+ *      <nRecord> If present, specifies the only record to process. A
+ *      value of 0 means to process no records. Overrides nNext and lRest.
+ *      <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 )
--- 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 \
--- a/harbour/tests/sdf_test.prg
+++ 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 <dholm@jsd-llc.com>
+*/
+
+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