#include "hbclass.ch"
#include "fileio.ch"

CREATE CLASS TExportCSV

   DATA cSeparator INIT ";"
   DATA cDecimalSymbol INIT ","
   DATA cDateFormat INIT "DD/MM/YYYY"
   DATA cDateTimeFormat INIT "DD/MM/YYYY HH:MM:SS"
   DATA cTrueValue INIT "SI"
   DATA cFalseValue INIT "NO"
   DATA lUtf8Bom INIT .F.
   DATA lIncludeHeaders INIT .T.
   DATA lAlwaysQuote INIT .F.
   DATA lIncludeGroupHeaders INIT .F.
   DATA lIncludeGroupFooters INIT .F.
   DATA lIncludeTotals INIT .F.
   DATA lOverwrite INIT .F.
   DATA bProgressCallback INIT NIL
   DATA cLastError INIT ""
   DATA aAvisos INIT {}
   DATA aOutputFiles INIT {}
   DATA lCanceled INIT .F.
   DATA cCurrentInputEncoding INIT "WINDOWS-1252"

   METHOD New() CONSTRUCTOR
   METHOD Init()
   METHOD Create()
   METHOD End()
   METHOD SetProgressCallback( bCallback )
   METHOD GetTables( uIR )
   METHOD ExportTable( uIR, cTableId, cFileName )
   METHOD ExportAllTables( uIR, cDirectory, cBaseName )
   METHOD GetLastError() INLINE ::cLastError
   METHOD GetAvisos() INLINE ::aAvisos
   METHOD GetOutputFiles() INLINE ::aOutputFiles
   METHOD WasCanceled() INLINE ::lCanceled

   HIDDEN:
   METHOD FindTable( aTables, cTableId )
   METHOD WriteTable( hTable, cFileName, nTable, nTables )
   METHOD WriteRow( hFile, aValues )
   METHOD FormatValue( uValue )
   METHOD FormatDate( dValue )
   METHOD FormatDateTime( tValue )
   METHOD ApplyDateFormat( cDate, cTime, cFormat )
   METHOD EscapeField( cValue )
   METHOD ToUtf8( cValue )
   METHOD TableColumns( hTable )
   METHOD TableRows( hTable )
   METHOD SafeFileName( cValue )
   METHOD AvailableFileName( cFileName )
   METHOD NotifyProgress( nRecord, nRecords, nTable, nTables )
   METHOD HGet( hHash, cKey, uDefault )

ENDCLASS

METHOD New() CLASS TExportCSV
   ::Init()
RETURN Self

METHOD Init() CLASS TExportCSV
   ::cSeparator := ";"
   ::cDecimalSymbol := ","
   ::cDateFormat := "DD/MM/YYYY"
   ::cDateTimeFormat := "DD/MM/YYYY HH:MM:SS"
   ::cTrueValue := "SI"
   ::cFalseValue := "NO"
   ::lUtf8Bom := .F.
   ::lIncludeHeaders := .T.
   ::lAlwaysQuote := .F.
   ::lIncludeGroupHeaders := .F.
   ::lIncludeGroupFooters := .F.
   ::lIncludeTotals := .F.
   ::lOverwrite := .F.
   ::bProgressCallback := NIL
   ::cLastError := ""
   ::aAvisos := {}
   ::aOutputFiles := {}
   ::lCanceled := .F.
   ::cCurrentInputEncoding := "WINDOWS-1252"
RETURN Self

METHOD Create() CLASS TExportCSV
RETURN Self

METHOD End() CLASS TExportCSV
   ::bProgressCallback := NIL
   ::aAvisos := {}
   ::aOutputFiles := {}
RETURN NIL

METHOD SetProgressCallback( bCallback ) CLASS TExportCSV
   IF ValType( bCallback ) == "U" .OR. ValType( bCallback ) == "B"
      ::bProgressCallback := bCallback
   ENDIF
RETURN Self

METHOD GetTables( uIR ) CLASS TExportCSV
   IF HB_ISOBJECT( uIR ) .AND. __objHasMsg( uIR, "GETDATATABLES" )
      RETURN uIR:GetDataTables()
   ENDIF
   IF HB_ISHASH( uIR )
      IF hb_HHasKey( uIR, "aDataTables" ) .AND. HB_ISARRAY( uIR[ "aDataTables" ] )
         RETURN uIR[ "aDataTables" ]
      ENDIF
      IF hb_HHasKey( uIR, "tablasDatos" ) .AND. HB_ISARRAY( uIR[ "tablasDatos" ] )
         RETURN uIR[ "tablasDatos" ]
      ENDIF
   ENDIF
RETURN {}

METHOD ExportTable( uIR, cTableId, cFileName ) CLASS TExportCSV
   LOCAL aTables := ::GetTables( uIR )
   LOCAL hTable := ::FindTable( aTables, cTableId )

   ::cLastError := ""
   ::aAvisos := {}
   ::aOutputFiles := {}
   ::lCanceled := .F.
   IF hTable == NIL
      ::cLastError := "No existe una tabla exportable con el identificador indicado."
      RETURN .F.
   ENDIF
   IF ! HB_ISSTRING( cFileName ) .OR. Empty( AllTrim( cFileName ) )
      ::cLastError := "No se ha indicado el archivo CSV."
      RETURN .F.
   ENDIF
   IF File( cFileName ) .AND. ! ::lOverwrite
      ::cLastError := "El archivo CSV ya existe y no se ha autorizado su sustitucion."
      RETURN .F.
   ENDIF
RETURN ::WriteTable( hTable, cFileName, 1, 1 )

METHOD ExportAllTables( uIR, cDirectory, cBaseName ) CLASS TExportCSV
   LOCAL aTables := ::GetTables( uIR )
   LOCAL hTable
   LOCAL cTableName
   LOCAL cFileName
   LOCAL nTable
   LOCAL nTables := Len( aTables )

   ::cLastError := ""
   ::aAvisos := {}
   ::aOutputFiles := {}
   ::lCanceled := .F.
   IF nTables == 0
      ::cLastError := "El informe no contiene tablas exportables."
      RETURN .F.
   ENDIF
   IF ! HB_ISSTRING( cDirectory ) .OR. Empty( AllTrim( cDirectory ) ) .OR. ! hb_DirExists( cDirectory )
      ::cLastError := "El directorio de destino no existe."
      RETURN .F.
   ENDIF
   cBaseName := ::SafeFileName( iif( Empty( AllTrim( cBaseName ) ), "informe", cBaseName ) )
   FOR nTable := 1 TO nTables
      hTable := aTables[ nTable ]
      cTableName := ::SafeFileName( ::HGet( hTable, "cName", ::HGet( hTable, "cId", "tabla" ) ) )
      cFileName := hb_DirSepAdd( cDirectory ) + cBaseName + "_" + cTableName + ".csv"
      IF File( cFileName ) .AND. ! ::lOverwrite
         cFileName := ::AvailableFileName( cFileName )
      ENDIF
      IF ! ::WriteTable( hTable, cFileName, nTable, nTables )
         RETURN .F.
      ENDIF
   NEXT
RETURN .T.

METHOD FindTable( aTables, cTableId ) CLASS TExportCSV
   LOCAL hTable
   IF ! HB_ISARRAY( aTables )
      RETURN NIL
   ENDIF
   IF Empty( AllTrim( iif( HB_ISSTRING( cTableId ), cTableId, "" ) ) ) .AND. Len( aTables ) == 1
      RETURN aTables[ 1 ]
   ENDIF
   FOR EACH hTable IN aTables
      IF HB_ISHASH( hTable ) .AND. ::HGet( hTable, "cId", "" ) == cTableId
         RETURN hTable
      ENDIF
   NEXT
RETURN NIL

METHOD WriteTable( hTable, cFileName, nTable, nTables ) CLASS TExportCSV
   LOCAL hFile := -1
   LOCAL aColumns := ::TableColumns( hTable )
   LOCAL aRows := ::TableRows( hTable )
   LOCAL aHeaders
   LOCAL aValues
   LOCAL hColumn
   LOCAL aRow
   LOCAL nRecord
   LOCAL nRecords := Len( aRows )
   LOCAL lOk := .T.

   ::cCurrentInputEncoding := Upper( AllTrim( ::HGet( hTable, "cEncoding", "WINDOWS-1252" ) ) )
   IF ::lIncludeGroupHeaders .OR. ::lIncludeGroupFooters .OR. ::lIncludeTotals
      AAdd( ::aAvisos, "Las cabeceras y pies de grupo y los totales no se incluyen porque el IR no dispone todavia de una estructura semantica fiable para ellos." )
   ENDIF

   IF Len( aColumns ) == 0
      ::cLastError := "La tabla no contiene columnas exportables."
      RETURN .F.
   ENDIF
   hFile := FCreate( cFileName, FC_NORMAL )
   IF hFile < 0
      ::cLastError := "No se ha podido crear el archivo CSV: " + cFileName
      RETURN .F.
   ENDIF
   IF ::lUtf8Bom
      lOk := FWrite( hFile, Chr( 239 ) + Chr( 187 ) + Chr( 191 ) ) == 3
   ENDIF
   IF lOk .AND. ::lIncludeHeaders
      aHeaders := Array( Len( aColumns ) )
      FOR EACH hColumn IN aColumns
         aHeaders[ hColumn:__enumIndex() ] := ::HGet( hColumn, "cTitle", ::HGet( hColumn, "cField", "" ) )
      NEXT
      lOk := ::WriteRow( hFile, aHeaders )
   ENDIF
   FOR nRecord := 1 TO nRecords
      IF ! lOk
         EXIT
      ENDIF
      aRow := aRows[ nRecord ]
      aValues := Array( Len( aColumns ) )
      FOR EACH hColumn IN aColumns
         aValues[ hColumn:__enumIndex() ] := iif( HB_ISARRAY( aRow ) .AND. Len( aRow ) >= hColumn:__enumIndex(), aRow[ hColumn:__enumIndex() ], NIL )
      NEXT
      lOk := ::WriteRow( hFile, aValues )
      IF lOk .AND. ! ::NotifyProgress( nRecord, nRecords, nTable, nTables )
         ::lCanceled := .T.
         lOk := .F.
         ::cLastError := "Exportacion CSV cancelada."
      ENDIF
   NEXT
   FClose( hFile )
   IF ! lOk
      IF File( cFileName )
         FErase( cFileName )
      ENDIF
      IF Empty( ::cLastError )
         ::cLastError := "Error al escribir el archivo CSV."
      ENDIF
      RETURN .F.
   ENDIF
   AAdd( ::aOutputFiles, cFileName )
RETURN .T.

METHOD WriteRow( hFile, aValues ) CLASS TExportCSV
   LOCAL cLine := ""
   LOCAL uValue
   FOR EACH uValue IN aValues
      IF uValue:__enumIndex() > 1
         cLine += ::cSeparator
      ENDIF
      cLine += ::EscapeField( ::FormatValue( uValue ) )
   NEXT
   cLine := ::ToUtf8( cLine ) + Chr( 13 ) + Chr( 10 )
RETURN FWrite( hFile, cLine ) == Len( cLine )

METHOD FormatValue( uValue ) CLASS TExportCSV
   LOCAL cType := ValType( uValue )
   DO CASE
   CASE cType == "U"; RETURN ""
   CASE cType == "C"; RETURN uValue
   CASE cType == "N"; RETURN StrTran( hb_NToS( uValue ), ".", ::cDecimalSymbol )
   CASE cType == "D"; RETURN ::FormatDate( uValue )
   CASE cType == "T"; RETURN ::FormatDateTime( uValue )
   CASE cType == "L"; RETURN iif( uValue, ::cTrueValue, ::cFalseValue )
   ENDCASE
RETURN hb_ValToExp( uValue )

METHOD FormatDate( dValue ) CLASS TExportCSV
RETURN ::ApplyDateFormat( DToS( dValue ), "", ::cDateFormat )

METHOD FormatDateTime( tValue ) CLASS TExportCSV
   LOCAL cValue := hb_TToC( tValue, "YYYYMMDD", "HHMMSS" )
   LOCAL nSpace := At( " ", cValue )
RETURN ::ApplyDateFormat( Left( cValue, nSpace - 1 ), SubStr( cValue, nSpace + 1 ), ::cDateTimeFormat )

METHOD ApplyDateFormat( cDate, cTime, cFormat ) CLASS TExportCSV
   LOCAL cDatePattern := cFormat
   LOCAL cTimePattern := ""
   LOCAL cResult
   LOCAL nSpace := At( " ", cFormat )
   LOCAL cYear := iif( Len( cDate ) >= 8, Left( cDate, 4 ), "" )
   LOCAL cMonth := iif( Len( cDate ) >= 8, SubStr( cDate, 5, 2 ), "" )
   LOCAL cDay := iif( Len( cDate ) >= 8, SubStr( cDate, 7, 2 ), "" )
   LOCAL cHour := iif( Len( cTime ) >= 6, Left( cTime, 2 ), "00" )
   LOCAL cMinute := iif( Len( cTime ) >= 6, SubStr( cTime, 3, 2 ), "00" )
   LOCAL cSecond := iif( Len( cTime ) >= 6, SubStr( cTime, 5, 2 ), "00" )
   IF nSpace > 0
      cDatePattern := Left( cFormat, nSpace - 1 )
      cTimePattern := SubStr( cFormat, nSpace + 1 )
   ENDIF
   cDatePattern := StrTran( cDatePattern, "YYYY", cYear )
   cDatePattern := StrTran( cDatePattern, "DD", cDay )
   cDatePattern := StrTran( cDatePattern, "MM", cMonth )
   IF Empty( cTimePattern )
      RETURN cDatePattern
   ENDIF
   cTimePattern := StrTran( cTimePattern, "HH", cHour )
   cTimePattern := StrTran( cTimePattern, "MM", cMinute )
   cTimePattern := StrTran( cTimePattern, "mm", cMinute )
   cTimePattern := StrTran( cTimePattern, "SS", cSecond )
   cResult := cDatePattern + " " + cTimePattern
RETURN cResult

METHOD EscapeField( cValue ) CLASS TExportCSV
   LOCAL lQuote := ::lAlwaysQuote .OR. ::cSeparator $ cValue .OR. Chr( 34 ) $ cValue .OR. Chr( 13 ) $ cValue .OR. Chr( 10 ) $ cValue
   IF Len( cValue ) > 0 .AND. ( Left( cValue, 1 ) $ " " + Chr( 9 ) .OR. Right( cValue, 1 ) $ " " + Chr( 9 ) )
      lQuote := .T.
   ENDIF
   IF lQuote
      RETURN Chr( 34 ) + StrTran( cValue, Chr( 34 ), Chr( 34 ) + Chr( 34 ) ) + Chr( 34 )
   ENDIF
RETURN cValue

METHOD ToUtf8( cValue ) CLASS TExportCSV
   IF ::cCurrentInputEncoding == "UTF-8" .OR. ::cCurrentInputEncoding == "UTF8"
      RETURN cValue
   ENDIF
RETURN hb_StrToUTF8( cValue, "ESWIN" )

METHOD TableColumns( hTable ) CLASS TExportCSV
RETURN iif( HB_ISHASH( hTable ) .AND. HB_ISARRAY( ::HGet( hTable, "aColumns", NIL ) ), hTable[ "aColumns" ], {} )

METHOD TableRows( hTable ) CLASS TExportCSV
RETURN iif( HB_ISHASH( hTable ) .AND. HB_ISARRAY( ::HGet( hTable, "aRows", NIL ) ), hTable[ "aRows" ], {} )

METHOD SafeFileName( cValue ) CLASS TExportCSV
   LOCAL cResult := AllTrim( iif( HB_ISSTRING( cValue ), cValue, "" ) )
   LOCAL cChar
   LOCAL nIndex
   FOR EACH cChar IN { "<", ">", ":", Chr( 34 ), "/", "\", "|", "?", "*" }
      cResult := StrTran( cResult, cChar, "_" )
   NEXT
   FOR nIndex := 1 TO 31
      cResult := StrTran( cResult, Chr( nIndex ), "_" )
   NEXT
   DO WHILE "  " $ cResult
      cResult := StrTran( cResult, "  ", " " )
   ENDDO
   cResult := StrTran( cResult, " ", "_" )
RETURN iif( Empty( cResult ), "tabla", cResult )

METHOD AvailableFileName( cFileName ) CLASS TExportCSV
   LOCAL cDirectory := hb_FNameDir( cFileName )
   LOCAL cBase := hb_FNameName( cFileName )
   LOCAL cExtension := hb_FNameExt( cFileName )
   LOCAL cCandidate := cFileName
   LOCAL nSuffix := 2
   DO WHILE File( cCandidate )
      cCandidate := cDirectory + cBase + "_" + LTrim( Str( nSuffix ) ) + cExtension
      nSuffix++
   ENDDO
RETURN cCandidate

METHOD NotifyProgress( nRecord, nRecords, nTable, nTables ) CLASS TExportCSV
   LOCAL uContinue
   IF ValType( ::bProgressCallback ) != "B"
      RETURN .T.
   ENDIF
   uContinue := Eval( ::bProgressCallback, nRecord, nRecords, nTable, nTables )
RETURN !( ValType( uContinue ) == "L" .AND. ! uContinue )

METHOD HGet( hHash, cKey, uDefault ) CLASS TExportCSV
   IF HB_ISHASH( hHash ) .AND. hb_HHasKey( hHash, cKey )
      RETURN hHash[ cKey ]
   ENDIF
RETURN uDefault

FUNCTION LLDominusExportCSV( uIR, cArchivo, cTableId, cSeparator, cDecimalSymbol, cDateFormat, lIncludeHeaders, lUtf8Bom )
   LOCAL oCSV := TExportCSV():New():Create()
   LOCAL lOk
   cTableId := iif( cTableId == NIL, "", cTableId )
   cSeparator := iif( cSeparator == NIL, ";", cSeparator )
   cDecimalSymbol := iif( cDecimalSymbol == NIL, ",", cDecimalSymbol )
   cDateFormat := iif( cDateFormat == NIL, "DD/MM/YYYY", cDateFormat )
   lIncludeHeaders := iif( lIncludeHeaders == NIL, .T., lIncludeHeaders )
   lUtf8Bom := iif( lUtf8Bom == NIL, .F., lUtf8Bom )
   oCSV:cSeparator := cSeparator
   oCSV:cDecimalSymbol := cDecimalSymbol
   oCSV:cDateFormat := cDateFormat
   oCSV:lIncludeHeaders := lIncludeHeaders
   oCSV:lUtf8Bom := lUtf8Bom
   lOk := oCSV:ExportTable( uIR, cTableId, cArchivo )
   oCSV:End()
   oCSV := NIL
RETURN lOk

FUNCTION LLDominusExportAllTablesCSV( uIR, cDirectorio, cNombreBase )
   LOCAL oCSV := TExportCSV():New():Create()
   LOCAL lOk
   cNombreBase := iif( cNombreBase == NIL, "informe", cNombreBase )
   lOk := oCSV:ExportAllTables( uIR, cDirectorio, cNombreBase )
   oCSV:End()
   oCSV := NIL
RETURN lOk