fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2001-04-18 21:15 UTC-0400 David G. Holm <dholm@jsd-llc.com>

Browse Source
This commit is contained in:
David G. Holm
2001-04-19 01:13:25 +00:00
parent 625722055e
commit b2f78f76f8
6 changed files with 229 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -1,3 +1,22 @@
2001-04-18 21:15 UTC-0400 David G. Holm <dholm@jsd-llc.com>
* source/rtl/dbdelim.prg
* Completed the code needed for COPY TO DELIMITED
* source/rtl/errorsys.prg
+ Temporarily added a QOUT() ahead of displaying the error
message in DEFERROR(), because unless the screen has been
scrolled while the program was running, the DOS prompt will
overwrite the first line of the error trace after quitting.
* source/rtl/langapi.c
+ Added Harbour methods to get language specific error messages
and language specific general messages.
* tests/Makefile
+ tests/delimtst.prg
+ New module to test COPY TO DELIMITED and APPEND FROM DELIMITED.
2001-04-18 17:40 UTC-0400 David G. Holm <dholm@jsd-llc.com>
* source/rdd/dbf1.c

240
harbour/source/rtl/dbdelim.prg
View File

@@ -1,4 +1,6 @@
/*
* $ID:$
*
* Harbour Project source code:
* Copies the contents of a database to a delimited text file.
*
@@ -47,6 +49,8 @@
*/
#include <fileio.ch>
#include <hbclass.ch>
#include <error.ch>
/* $DOC$
* $FUNCNAME$
@@ -54,76 +58,79 @@
* $CATEGORY$
* Conversion
* $ONELINER$
* Copies the contents of a database to a delimited text file.
* Copies the contents of a database to a delimited text file or
* appends the contents of a delimited text file to a database.
* $SYNTAX$
* __dbDelim( <lFlag1>, <xcFile>, [<xcDelim>], [<aFields>],
* [<bFor>], [<bWhile>], [<nNext>], [<?>], <lFlag2> ) --> NIL
* __dbDelim( <lExport>, <xcFile>, [<xcDelim>], [<aFields>],
* [<bFor>], [<bWhile>], [<nNext>], [<nRecord>], <lRest> ) --> NIL
* $ARGUMENTS$
* <lFlag1>
* <xcFile> The name of the text file to create. If a file
* extension is not specified, ".txt" is used by default.
* <xcDelim> 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.
* <aFields> A list of field names to limit the copy to. If not
* specified or if empty, then all fields are copied.
* <bFor> A block expression containing a for expression to use to
* limit the records that will be copied, starting from the first
* record, unless a <bWhile> or <nNext> argument is included.
* <bWhile> A block expression containing a while expression to use
* to limit the records that will be copied, starting from the current
* record.
* <nNext> The number of consecutive records to copy, starting from
* the current record.
* <?>
* <lFlag2>
* <lExport> If set to .T., copies records to a delimited file.
* If set to .F., append records from a delimited 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.
* <xcDelim> Either the character to use as the character field
* delimiter (only the first character is used). or "BLANK" (not case
* sensitive), which eliminates the character field delimiters and
* sets the field separator to a single space instead of a comma.
* <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$
* __dbDelim() copies the selected contents of a database table to
* a delimited text file. The default selection is all fields from
* all records.
* __dbDelim() copies all or selected contents of a database table
* to a delimited text file.
* $EXAMPLES$
* // Copy delinquent accounts into a delimited text file.
*
* USE ACCOUNTS NEW
* COPY TO overdue FOR !EMPTY( accounts->duedate ) ;
* .AND. DATE() - accounts->duedate > 30
* // Import new customer records.
* USE CUSTOMER NEW
* APPEND FROM customer DELIMITED
* $TESTS$
*
* $STATUS$
* I
* S
* $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.
* of the APPEND FROM DELIMITED and COPY TO DELIMITED commands.
* $PLATFORMS$
* All
* $FILES$
*
* $SEEALSO$
* __dbSDF()
* __dbSDF(), APPEND FROM, COPY TO
* $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
FUNCTION __dbDelim( lExport, cFile, cDelimArg, aFields, bFor, bWhile, nNext, nRecord, lRest )
LOCAL index, handle, lWriteSep, cFileName := cFile, nStart, nCount, oErr
LOCAL cSeparator := ",", cDelim := CHR( 34 )
// Process the delimiter argument.
IF !EMPTY( cDelimArg )
IF UPPER( cDelimArg ) == "BLANK"
cDelimLeft := cDelimRight := ""
cDelim := ""
cSeparator := " "
ELSE
cDelimLeft := LEFT( cDelimArg, 1 )
IF LEN( cDelimArg ) > 1
cDelimRight := SUBSTR( cDelimArg, 2, 1 )
ELSE
cDelimRight := cDelimLeft
END IF
cDelim := LEFT( cDelimArg, 1 )
END IF
END IF
// Process the file name argument.
index := RAT( ".", cFileName )
IF index > 0
// The file name might include a file extension.
@@ -137,62 +144,119 @@ FUNCTION __dbDelim( lFlag1, cFile, cDelimArg, aFields, bFor, bWhile, nNext, arg8
// No file name extension, so provide the default.
cFileName += ".txt"
END IF
handle := FCREATE( cFileName )
IF handle == -1
// 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
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 )
// 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 DELIMITED
handle := FCREATE( cFileName )
IF handle == -1
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_CREATE
oErr:subSystem := "DELIM"
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
// Set up for the start of the first record.
lWriteSep := .F.
// Process the records to copy delimited.
WHILE EVAL( bWhile ) .AND. ( nCount == -1 .OR. nCount > 0 )
IF EVAL( bFor )
IF EMPTY( aFields )
// Process all fields.
FOR index := 1 TO FCOUNT()
IF lWriteSep
AppendSep( handle, cSeparator )
END IF
lWriteSep := Export( handle, FIELDGET( index ), cDelim )
NEXT index
ELSE
// Process the specified fields.
FOR index := 1 TO LEN( aFields )
IF lWriteSep
AppendSep( handle, cSeparator )
END IF
lWriteSep := Export( handle, FIELDGET( FIELDPOS( aFields[ index ] ) ), cDelim )
NEXT index
END IF
// Set up for the start of the next record.
AppendEOL( handle )
lWriteSep := .F.
END IF
IF nCount != -1
nCount--
END IF
SKIP
END WHILE
AppendEOF( handle )
FCLOSE( handle )
END IF
ELSE
// APPEND FROM DELIMITED
handle := FOPEN( cFileName )
IF handle == -1
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_OPEN
oErr:subSystem := "DELIM"
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
/// SET( _SET_DATEFORMAT, cDateFormat )
RETURN NIL
STATIC FUNCTION Export( handle, xField, cDelimLeft, cDelimRight )
STATIC FUNCTION Export( handle, xField, cDelim )
LOCAL cText := "", lWrite := .F.
DO CASE
CASE VALTYPE( xField ) == "C"
cText := cDelimLeft + TRIM( xField ) + cDelimRight
cText := cDelim + TRIM( xField ) + cDelim
lWrite := .T.
CASE VALTYPE( xField ) == "D"
cText := DTOS( xField )

5
harbour/source/rtl/errorsys.prg
View File

@@ -138,6 +138,7 @@ STATIC FUNCTION DefError( oError )
cMessage += " " + cDOSError
ENDIF
QOut() /// dgh - Temporary to keep DOS prompt from overwriting message.
QOut( cMessage )
n := 2
@@ -145,7 +146,9 @@ STATIC FUNCTION DefError( oError )
QOut("Called from " + ProcName( n ) + ;
"(" + AllTrim( Str( ProcLine( n++ ) ) ) + ")")
ENDDO
/// For some strange reason, the DOS prompt gets written on the first line
/// *of* the message instead of on the first line *after* the message after
/// the program quits, unless the screen has scrolled. - dgh
QUIT
RETURN .F.

9
harbour/source/rtl/langapi.c
View File

@@ -210,3 +210,12 @@ HB_FUNC( HB_LANGNAME )
hb_xfree( pszName );
}
HB_FUNC( HB_LANGERRMSG )
{
hb_retc( hb_langDGetErrorDesc( hb_parnl( 1 ) ) );
}
HB_FUNC( HB_LANGMESSAGE )
{
hb_retc( hb_langDGetItem( hb_parnl( 1 ) ) );
}

1
harbour/tests/Makefile
View File

@@ -61,6 +61,7 @@ PRG_SOURCES=\
dates3.prg \
db_brows.prg \
dbevalts.prg \
delimtst.prg \
devtest.prg \
dirtest.prg \
disptest.prg \

44
harbour/tests/delimtst.prg Normal file
View File

@@ -0,0 +1,44 @@
//NOTEST
// $Id$
//
// Test program for COPY TO DELIMITED and APPEND FROM DELIMITED
// Note: Only COPY TO DELIMITED 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 delimited
// Copy only address fields for records with salary over 50,000.
copy field first,last,street,city,state,zip to test2 delimited for _field->salary>50000
// Only copy record 3.
copy record 3 to test3 delimited
// Copy records 4 through 7.
copy next 4 to test4 delimited
// Copy the last 10 records.
go bottom
skip -9
copy rest to test5 delimited
// Copy the last 10 records again.
go bottom
skip -9
copy to test6 delimited while !eof()
// Copy only some of the last 10 records.
go bottom
skip -9
copy rest to test7 delimited for _field->married
// Try to append from a file that we know does not exist.
delete file test8.txt
append from test8 delimited
quit