From dabef65e184f709d1087d8f3d9cc31579a7019ca Mon Sep 17 00:00:00 2001 From: "David G. Holm" Date: Tue, 17 Apr 2001 21:13:58 +0000 Subject: [PATCH] 2001-04-17 17:15 UTC-0400 David G. Holm --- harbour/ChangeLog | 14 +++ harbour/doc/funclist.txt | 2 +- harbour/hb_slex.bc | 8 ++ harbour/hb_slex.vc | 1 + harbour/makefile.bc | 8 ++ harbour/makefile.vc | 1 + harbour/source/rtl/Makefile | 1 + harbour/source/rtl/dbdelim.prg | 219 +++++++++++++++++++++++++++++++++ harbour/source/rtl/dummy.prg | 2 +- 9 files changed, 254 insertions(+), 2 deletions(-) create mode 100644 harbour/source/rtl/dbdelim.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9aff2043cd..a4547302ad 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +2001-04-17 17:15 UTC-0400 David G. Holm + + * hb_slex.bc + * hb_slex.vc + * makefile.bc + * makefile.vc + * doc/funclist.txt + * source/rtl/Makefile + + source/rtl/dbdelim.prg + * source/rtl/dummy.prg + + Added __dbDelim() function for use by COPY TO DELIMITED. + FIELD, NEXT, FOR, and WHILE clauses are implemented, but I + don't know what the first and last two parameters are for. + 2001-04-17 21:30 CET Martin Vogel + contrib/libct/atnum.c + AFTERATNUM() function diff --git a/harbour/doc/funclist.txt b/harbour/doc/funclist.txt index 6e4ba35f9b..e8e69a81ce 100644 --- a/harbour/doc/funclist.txt +++ b/harbour/doc/funclist.txt @@ -287,7 +287,7 @@ __dbCopy ;S; __dbCopyStruct ;R; __dbCopyXStruct ;R; __dbCreate ;R; -__dbDelim ;N; +__dbDelim ;S; __dbJoin ;N; __dbList ;R; __dbLocate ;R; diff --git a/harbour/hb_slex.bc b/harbour/hb_slex.bc index aa7ad6a348..e79206b2c5 100644 --- a/harbour/hb_slex.bc +++ b/harbour/hb_slex.bc @@ -291,6 +291,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ $(OBJ_DIR)\dbedit.obj \ + $(OBJ_DIR)\dbdelim.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ @@ -1164,6 +1165,13 @@ $(OBJ_DIR)\dbedit.obj : $(OBJ_DIR)\dbedit.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\dbdelim.c : $(RTL_DIR)\dbdelim.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\dbdelim.obj : $(OBJ_DIR)\dbdelim.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/hb_slex.vc b/harbour/hb_slex.vc index e21ed9d293..44a80b6ac6 100644 --- a/harbour/hb_slex.vc +++ b/harbour/hb_slex.vc @@ -325,6 +325,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ $(OBJ_DIR)\dbedit.obj \ + $(OBJ_DIR)\dbedit.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ diff --git a/harbour/makefile.bc b/harbour/makefile.bc index 906b78eabb..e17bae6e30 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -291,6 +291,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ $(OBJ_DIR)\dbedit.obj \ + $(OBJ_DIR)\dbdelim.obj \ $(OBJ_DIR)\devoutp.obj \ $(OBJ_DIR)\dircmd.obj \ $(OBJ_DIR)\dummy.obj \ @@ -1161,6 +1162,13 @@ $(OBJ_DIR)\dbedit.obj : $(OBJ_DIR)\dbedit.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\dbdelim.c : $(RTL_DIR)\dbdelim.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\dbdelim.obj : $(OBJ_DIR)\dbdelim.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 e0ae873d51..a6fee89b5b 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -325,6 +325,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ $(OBJ_DIR)\dbedit.obj \ + $(OBJ_DIR)\dbdelim.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 0b9132b80a..9f61701585 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -118,6 +118,7 @@ PRG_SOURCES=\ browdb.prg \ browdbx.prg \ browse.prg \ + dbdelim.prg \ dbedit.prg \ devoutp.prg \ dircmd.prg \ diff --git a/harbour/source/rtl/dbdelim.prg b/harbour/source/rtl/dbdelim.prg new file mode 100644 index 0000000000..ce893e51a1 --- /dev/null +++ b/harbour/source/rtl/dbdelim.prg @@ -0,0 +1,219 @@ +/* + * Harbour Project source code: + * Copies the contents of a database to a delimited text file. + * + * 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 + +/* $DOC$ + * $FUNCNAME$ + * __dbDelim() + * $CATEGORY$ + * Conversion + * $ONELINER$ + * Copies the contents of a database to a delimited text file. + * $SYNTAX$ + * __dbDelim( , , [], [], + * [], [], [], [], ) --> NIL + * $ARGUMENTS$ + * + * The name of the text file to create. If a file + * extension is not specified, ".txt" is used by default. + * The character(s) to use as character field delimiters + * or "BLANK" (not case sensitive), which eliminates the character + * field delimiters and sets the field separator to a single space. + * A list of field names to limit the copy to. If not + * specified or if empty, then all fields are copied. + * A block expression containing a for expression to use to + * limit the records that will be copied, starting from the first + * record, unless a or argument is included. + * A block expression containing a while expression to use + * to limit the records that will be copied, starting from the current + * record. + * The number of consecutive records to copy, starting from + * the current record. + * + * + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * __dbDelim() copies the selected contents of a database table to + * a delimited text file. The default selection is all fields from + * all records. + * $EXAMPLES$ + * // Copy delinquent accounts into a delimited text file. + * + * USE ACCOUNTS NEW + * COPY TO overdue FOR !EMPTY( accounts->duedate ) ; + * .AND. DATE() - accounts->duedate > 30 + * $TESTS$ + * + * $STATUS$ + * I + * $COMPLIANCE$ + * __dbDelim() is intended to be fully compliant with CA-Clipper's + * function of the same name and is the underlying implementation + * of the COPY TO command. + * $PLATFORMS$ + * All + * $FILES$ + * + * $SEEALSO$ + * __dbSDF() + * $END$ + */ + +FUNCTION __dbDelim( lFlag1, cFile, cDelimArg, aFields, bFor, bWhile, nNext, arg8, lFlag2 ) +/// LOCAL cDateFormat := SET( _SET_DATEFORMAT, "YYYYMMDD" ) + LOCAL index, handle, lWriteSep := .F., cFileName := cFile + LOCAL cSeparator := ",", cDelimLeft := CHR( 34 ), cDelimRight := cDelimLeft + IF !EMPTY( cDelimArg ) + IF UPPER( cDelimArg ) == "BLANK" + cDelimLeft := cDelimRight := "" + cSeparator := " " + ELSE + cDelimLeft := LEFT( cDelimArg, 1 ) + IF LEN( cDelimArg ) > 1 + cDelimRight := SUBSTR( cDelimArg, 2, 1 ) + ELSE + cDelimRight := cDelimLeft + END IF + END IF + END IF + + 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 + handle := FCREATE( cFileName ) + IF handle == -1 + ELSE + IF EMPTY( bWhile ) .AND. EMPTY( nNext ) + // Start from the first record, unless a WHILE condition + // or a NEXT count is specified. + GO TOP + END IF + IF EMPTY( bFor ) + bFor := {||.T.} + END IF + IF EMPTY( bWhile ) + bWhile := {||!EOF()} + END IF + IF nNext == NIL + // If NEXT count not specified, indicate no next count. + // The EMPTY test can't be used here, because NEXT 0 + // is a valid scope that must not copy any records. + nNext := -1 + END IF + WHILE EVAL( bWhile ) .AND. ( nNext == -1 .OR. nNext > 0 ) + IF EVAL( bFor ) + IF EMPTY( aFields ) + FOR index := 1 TO FCOUNT() + IF lWriteSep + AppendSep( handle, cSeparator ) + END IF + lWriteSep := Export( handle, FIELDGET( index ), cDelimLeft, cDelimRight ) + NEXT index + ELSE + FOR index := 1 TO LEN( aFields ) + IF lWriteSep + AppendSep( handle, cSeparator ) + END IF + lWriteSep := Export( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ), cDelimLeft, cDelimRight ) + NEXT index + END IF + AppendEOL( handle ) + lWriteSep := .F. + IF nNext != -1 + nNext-- + END IF + END IF + SKIP + END WHILE + AppendEOF( handle ) + FCLOSE( handle ) + END IF +/// SET( _SET_DATEFORMAT, cDateFormat ) +RETURN NIL + +STATIC FUNCTION Export( handle, xField, cDelimLeft, cDelimRight ) + LOCAL cText := "", lWrite := .F. + DO CASE + CASE VALTYPE( xField ) == "C" + cText := cDelimLeft + TRIM( xField ) + cDelimRight + 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 := LTRIM( 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 ) + +STATIC FUNCTION AppendSep( handle, cSep ) +RETURN FWRITE( handle, cSep ) diff --git a/harbour/source/rtl/dummy.prg b/harbour/source/rtl/dummy.prg index e6c83e21b5..597d06d6c4 100644 --- a/harbour/source/rtl/dummy.prg +++ b/harbour/source/rtl/dummy.prg @@ -55,7 +55,7 @@ FUNCTION MPosToLC() ; RETURN 0 //FUNCTION __dbApp() ; RETURN NIL //FUNCTION __dbCopy() ; RETURN NIL -FUNCTION __dbDelim() ; RETURN NIL +//FUNCTION __dbDelim() ; RETURN NIL FUNCTION __dbJoin() ; RETURN NIL FUNCTION __dbSDF() ; RETURN NIL FUNCTION __dbTotal() ; RETURN NIL