diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 25b1c2f121..bde343c3b7 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,22 @@ +2001-04-18 21:15 UTC-0400 David G. Holm + + * 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 * source/rdd/dbf1.c diff --git a/harbour/source/rtl/dbdelim.prg b/harbour/source/rtl/dbdelim.prg index ce893e51a1..1d2d525b64 100644 --- a/harbour/source/rtl/dbdelim.prg +++ b/harbour/source/rtl/dbdelim.prg @@ -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 +#include +#include /* $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( , , [], [], - * [], [], [], [], ) --> NIL + * __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. - * - * + * If set to .T., copies records to a delimited file. + * If set to .F., append records from a delimited 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. + * 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. + * 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$ - * __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 ) diff --git a/harbour/source/rtl/errorsys.prg b/harbour/source/rtl/errorsys.prg index 294ab0a985..13e3d9c6d0 100644 --- a/harbour/source/rtl/errorsys.prg +++ b/harbour/source/rtl/errorsys.prg @@ -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. diff --git a/harbour/source/rtl/langapi.c b/harbour/source/rtl/langapi.c index ced2e9547d..48703ef8e2 100644 --- a/harbour/source/rtl/langapi.c +++ b/harbour/source/rtl/langapi.c @@ -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 ) ) ); +} diff --git a/harbour/tests/Makefile b/harbour/tests/Makefile index 89be082e5b..9ec2aa29ff 100644 --- a/harbour/tests/Makefile +++ b/harbour/tests/Makefile @@ -61,6 +61,7 @@ PRG_SOURCES=\ dates3.prg \ db_brows.prg \ dbevalts.prg \ + delimtst.prg \ devtest.prg \ dirtest.prg \ disptest.prg \ diff --git a/harbour/tests/delimtst.prg b/harbour/tests/delimtst.prg new file mode 100644 index 0000000000..9c60ffae09 --- /dev/null +++ b/harbour/tests/delimtst.prg @@ -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 +*/ + +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 \ No newline at end of file