WIP: Comservice & Zugferd

This commit is contained in:
Jonathan Jenne
2019-03-14 17:00:25 +01:00
parent c0d37ef789
commit 62d04a8c21
5 changed files with 109 additions and 39 deletions

View File

@@ -1,4 +1,5 @@
Imports System.Collections.Generic
Imports System.Data
Imports System.IO
Imports System.Linq
Imports System.Text.RegularExpressions
@@ -14,6 +15,8 @@ Public Class ImportZUGFeRDFiles
Public Const ZUGFERD_IN = "ZUGFeRD in"
Public Const ZUGFERD_ERROR = "ZUGFeRD Error"
Public Const ZUGFERD_SUCCESS = "ZUGFeRD Success"
Public Const ZUGFERD_EML = "ZUGFeRD Eml"
Public Const ZUGFERD_REJECTED_EML = "ZUGFeRD Eml Rejected"
Private _logger As Logger
Private _logConfig As LogConfig
@@ -25,16 +28,26 @@ Public Class ImportZUGFeRDFiles
Public WatchDirectories As List(Of String)
Public SuccessDirectory As String
Public ErrorDirectory As String
Public OriginalEmailDirectory As String
Public RejectedEmailDirectory As String
Public PropertyMap As Dictionary(Of String, XmlItemProperty)
Public Sub New()
WatchDirectories = New List(Of String)
SuccessDirectory = Nothing
ErrorDirectory = Nothing
OriginalEmailDirectory = Nothing
RejectedEmailDirectory = Nothing
PropertyMap = New Dictionary(Of String, XmlItemProperty)
End Sub
End Class
Public Class EmailData
Public Attachment As String
Public Subject As String
Public From As String
End Class
Public Class XmlItemProperty
Public TableName As String
Public Description As String
@@ -54,36 +67,35 @@ Public Class ImportZUGFeRDFiles
Return oRandomValue
End Function
Private Function GetEmailAddressForMessageId(FileGuid As String) As String
Dim oSQL = $"SELECT EMAIL_FROM FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
Private Function GetEmailDataForMessageId(MessageId As String) As EmailData
Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT, EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Try
Dim emailAddress = _firebird.GetScalarValue(oSQL)
Dim oDatatable = _firebird.GetDatatable(oSQL)
Dim oRow As DataRow
_logger.Debug("Got Email Address for FileId {0}: {1}", FileGuid, emailAddress)
If oDatatable.Rows.Count = 0 Then
_logger.Warn("Got no results for MessageId {0}", MessageId)
Return Nothing
ElseIf oDatatable.Rows.Count > 1 Then
_logger.Warn("Got too many results for MessageId {0}. Using first row.", MessageId)
End If
Return emailAddress
_logger.Debug("Got Email Data for FileId {0}", MessageId)
oRow = oDatatable.Rows.Item(0)
Return New EmailData() With {
.From = oRow.Item("EMAIL_FROM"),
.Attachment = oRow.Item("EMAIL_ATTMT1"),
.Subject = oRow.Item("EMAIL_SUBJECT")
}
Catch ex As Exception
_logger.Warn("Could not fetch Email Address for FileId {0}", FileGuid)
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
Return Nothing
End Try
End Function
Private Function GetOriginalFileNameForMessageId(FileGuid As String) As String
Dim oSQL = $"SELECT EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
Try
Dim originalFilename = _firebird.GetScalarValue(oSQL)
_logger.Debug("Got Original Filename for FileId {0}: {1}", FileGuid, originalFilename)
Return originalFilename
Catch ex As Exception
_logger.Warn("Could not fetch Original Filename for FileId {0}", FileGuid)
Return Nothing
End Try
End Function
Private Function GetOriginalEmailPath(MessageId As String)
Dim oAttachmentDirectory = ""
Private Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
Dim oAttachmentDirectory = OriginalEmailDirectory
Dim oAttachmentFile = MessageId & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
@@ -94,7 +106,33 @@ Public Class ImportZUGFeRDFiles
End If
End Function
Private Sub AddToEmailQueue(MessageId As String, BodyText As String)
Private Function GetEmailPathWithSubjectAsName(RejectedEmailDirectory As String, UncleanedSubject As String) As String
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
Dim oAttachmentFile = oCleanSubject & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
Return oAttachmentPath
End Function
Private Function MoveAndRenameEmailToRejected(Args As WorkerArgs, MessageId As String) As EmailData
Dim oEmailData = GetEmailDataForMessageId(MessageId)
Dim oSource = GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId)
Dim oDestination = GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, oEmailData.Subject)
Try
File.Move(oSource, oDestination)
oEmailData.Attachment = oDestination
Catch ex As Exception
_logger.Warn("File {0} could not be moved! Original Filename will be used!", oSource)
_logger.Error(ex)
oEmailData.Attachment = oSource
End Try
Return oEmailData
End Function
Private Sub AddToEmailQueue(MessageId As String, BodyText As String, EmailData As EmailData)
Try
Dim oJobId = RandomValue(1, 10000)
Dim oReference = MessageId
@@ -102,10 +140,9 @@ Public Class ImportZUGFeRDFiles
Dim oSubject = "Your email was rejected"
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oAttachment = ""
Dim oEmailAddress = GetEmailAddressForMessageId(MessageId)
Dim oOriginalFilename = GetOriginalFileNameForMessageId(MessageId)
Dim oEmailAddress = EmailData.From
Dim oAttachment = EmailData.Attachment
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId)
@@ -114,8 +151,6 @@ Public Class ImportZUGFeRDFiles
oEmailTo = oEmailAddress
End If
oAttachment = GetOriginalEmailPath(MessageId)
_logger.Debug("Generated Email:")
_logger.Debug("To: {0}", oEmailTo)
_logger.Debug("Subject: {0}", oSubject)
@@ -294,21 +329,24 @@ Public Class ImportZUGFeRDFiles
oMoveDirectory = args.ErrorDirectory
Dim oBody = "<p>Your email contained more than one ZUGFeRD-Document.</p>"
AddToEmailQueue(oFileGroupId, oBody)
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As NoFerdsException
_logger.Error(ex)
oMoveDirectory = args.ErrorDirectory
Dim oBody = "<p>Your email contained no ZUGFeRD-Documents.</p>"
AddToEmailQueue(oFileGroupId, oBody)
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As MissingValueException
_logger.Error(ex)
oMoveDirectory = args.ErrorDirectory
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
AddToEmailQueue(oFileGroupId, oBody)
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Finally
oConnection.Close()