ZUGFeRD: Send original message as attachment in error case

This commit is contained in:
Jonathan Jenne 2019-03-13 16:14:39 +01:00
parent e4ba39f19c
commit 76ff4a5daa
2 changed files with 31 additions and 11 deletions

View File

@ -1,11 +1,11 @@
Imports System.Collections.Generic Imports System.Collections.Generic
Imports System.IO Imports System.IO
Imports System.Linq Imports System.Linq
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Database Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Logging
Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Jobs.Exceptions Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging
Imports FirebirdSql.Data.FirebirdClient Imports FirebirdSql.Data.FirebirdClient
Public Class ImportZUGFeRDFiles Public Class ImportZUGFeRDFiles
@ -54,7 +54,7 @@ Public Class ImportZUGFeRDFiles
Return oRandomValue Return oRandomValue
End Function End Function
Private Function GetEmailAddressForFileGUID(FileGuid As String) As String Private Function GetEmailAddressForMessageId(FileGuid As String) As String
Dim oSQL = $"SELECT EMAIL_FROM FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'" Dim oSQL = $"SELECT EMAIL_FROM FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
Try Try
Dim emailAddress = _firebird.GetScalarValue(oSQL) Dim emailAddress = _firebird.GetScalarValue(oSQL)
@ -68,7 +68,7 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Function End Function
Private Function GetOriginalFileNameForFileGUID(FileGuid As String) As String Private Function GetOriginalFileNameForMessageId(FileGuid As String) As String
Dim oSQL = $"SELECT EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'" Dim oSQL = $"SELECT EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
Try Try
Dim originalFilename = _firebird.GetScalarValue(oSQL) Dim originalFilename = _firebird.GetScalarValue(oSQL)
@ -82,35 +82,52 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Function End Function
Private Sub AddToEmailQueue(FileGuid As String, BodyText As String) Private Function GetOriginalEmailPath(MessageId As String)
Dim oAttachmentDirectory = ""
Dim oAttachmentFile = MessageId & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
If File.Exists(oAttachmentPath) Then
Return oAttachmentPath
Else
Return String.Empty
End If
End Function
Private Sub AddToEmailQueue(MessageId As String, BodyText As String)
Try Try
Dim oJobId = RandomValue(1, 10000) Dim oJobId = RandomValue(1, 10000)
Dim oReference = FileGuid Dim oReference = MessageId
Dim oEmailTo = "" Dim oEmailTo = ""
Dim oSubject = "Your email was rejected" Dim oSubject = "Your email was rejected"
Dim oAccountId = 1 Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service" Dim oCreatedWho = "ZUGFeRD Service"
Dim oEmailAddress = GetEmailAddressForFileGUID(FileGuid) Dim oAttachment = ""
Dim oOriginalFilename = GetOriginalFileNameForFileGUID(FileGuid)
Dim oEmailAddress = GetEmailAddressForMessageId(MessageId)
Dim oOriginalFilename = GetOriginalFileNameForMessageId(MessageId)
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId)
oEmailTo = String.Empty oEmailTo = String.Empty
Else Else
oEmailTo = oEmailAddress oEmailTo = oEmailAddress
End If End If
oAttachment = GetOriginalEmailPath(MessageId)
_logger.Debug("Generated Email:") _logger.Debug("Generated Email:")
_logger.Debug("To: {0}", oEmailTo) _logger.Debug("To: {0}", oEmailTo)
_logger.Debug("Subject: {0}", oSubject) _logger.Debug("Subject: {0}", oSubject)
_logger.Debug("Body {0}", BodyText) _logger.Debug("Body {0}", BodyText)
Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE " Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE "
oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO) VALUES " oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES "
oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{BodyText}', '{oCreatedWho}')" oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{BodyText}', '{oCreatedWho}', '{oAttachment}')"
_firebird.ExecuteNonQuery(oSQLInsert) _firebird.ExecuteNonQuery(oSQLInsert)
_logger.Debug("Email Queue updated for MessageId {0}.", FileGuid, oEmailTo) _logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo)
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
End Try End Try

View File

@ -60,6 +60,9 @@ Public Class ZUGFeRDInterface
oProcessOutput = oProcess.StandardOutput.ReadToEnd() oProcessOutput = oProcess.StandardOutput.ReadToEnd()
oProcessError = oProcess.StandardError.ReadToEnd() oProcessError = oProcess.StandardError.ReadToEnd()
oProcess.WaitForExit() oProcess.WaitForExit()
_logger.Debug("Process Output:")
_logger.Debug(oProcessOutput)
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
Throw ex Throw ex