WIP: cleanup, work on doc result form
This commit is contained in:
Jonathan Jenne
5
Modules.Jobs/EDMI/ZUGFeRD/EmailData.vb
Normal file
5
Modules.Jobs/EDMI/ZUGFeRD/EmailData.vb
Normal file
@@ -0,0 +1,5 @@
|
||||
Public Class EmailData
|
||||
Public Attachment As String
|
||||
Public Subject As String
|
||||
Public From As String
|
||||
End Class
|
||||
664
Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
Normal file
664
Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
Normal file
@@ -0,0 +1,664 @@
|
||||
Imports System.Collections.Generic
|
||||
Imports System.Data
|
||||
Imports System.IO
|
||||
Imports System.Linq
|
||||
Imports System.Reflection
|
||||
Imports System.Security.Cryptography
|
||||
Imports System.Text.RegularExpressions
|
||||
Imports System.Xml
|
||||
Imports DigitalData.Modules.Filesystem
|
||||
Imports DigitalData.Modules.Database
|
||||
Imports DigitalData.Modules.Interfaces
|
||||
Imports DigitalData.Modules.Interfaces.Exceptions
|
||||
Imports DigitalData.Modules.Jobs.Exceptions
|
||||
Imports DigitalData.Modules.Logging
|
||||
Imports FirebirdSql.Data.FirebirdClient
|
||||
|
||||
Public Class ImportZUGFeRDFiles
|
||||
Implements IJob
|
||||
|
||||
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"
|
||||
Public Const ZUGFERD_ATTACHMENTS = "ZUGFeRD Attachments"
|
||||
Public HISTORY_ID As Integer
|
||||
|
||||
Private _logger As Logger
|
||||
Private _logConfig As LogConfig
|
||||
Private _zugferd As ZUGFeRDInterface
|
||||
Private _firebird As Firebird
|
||||
Private _filesystem As Filesystem.File
|
||||
Private _mssql As MSSQLServer
|
||||
|
||||
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
|
||||
_logConfig = LogConfig
|
||||
_logger = LogConfig.GetLogger()
|
||||
_firebird = Firebird
|
||||
_filesystem = New Filesystem.File(_logConfig)
|
||||
_zugferd = New ZUGFeRDInterface(_logConfig)
|
||||
_mssql = MSSQL
|
||||
End Sub
|
||||
|
||||
Private Function RandomValue(lowerBound As Integer, upperBound As Integer) As Integer
|
||||
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
|
||||
Return oRandomValue
|
||||
End Function
|
||||
|
||||
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 oDatatable = _firebird.GetDatatable(oSQL)
|
||||
Dim oRow As DataRow
|
||||
|
||||
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
|
||||
|
||||
_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 Data for FileId {0}", MessageId)
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
|
||||
Dim oAttachmentDirectory = OriginalEmailDirectory
|
||||
Dim oAttachmentFile = MessageId & ".eml"
|
||||
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
|
||||
|
||||
If IO.File.Exists(oAttachmentPath) Then
|
||||
Return oAttachmentPath
|
||||
Else
|
||||
Return String.Empty
|
||||
End If
|
||||
End Function
|
||||
|
||||
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)
|
||||
Dim oFinalFileName = _filesystem.GetVersionedFilename(oDestination)
|
||||
|
||||
Try
|
||||
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
|
||||
IO.File.Move(oSource, oFinalFileName)
|
||||
oEmailData.Attachment = oFinalFileName
|
||||
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
|
||||
Dim oEmailTo = ""
|
||||
Dim oSubject = "Your email was rejected"
|
||||
Dim oAccountId = 1
|
||||
Dim oCreatedWho = "ZUGFeRD Service"
|
||||
|
||||
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)
|
||||
oEmailTo = String.Empty
|
||||
Else
|
||||
oEmailTo = oEmailAddress
|
||||
End If
|
||||
|
||||
_logger.Debug("Generated Email:")
|
||||
_logger.Debug("To: {0}", oEmailTo)
|
||||
_logger.Debug("Subject: {0}", oSubject)
|
||||
_logger.Debug("Body {0}", BodyText)
|
||||
Dim osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE1 = '{oReference} and EMAIL_TO = ''{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
|
||||
|
||||
Dim oDTResult As DataTable = _firebird.GetDatatable(osql)
|
||||
If oDTResult.Rows.Count = 0 Then
|
||||
Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE "
|
||||
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}', '{oAttachment}')"
|
||||
_firebird.ExecuteNonQuery(oSQLInsert)
|
||||
_logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo)
|
||||
Else
|
||||
_logger.Debug("Email has already been sent!!")
|
||||
End If
|
||||
Catch ex As Exception
|
||||
_logger.Error(ex)
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Function GetMessageIdFromFileName(Filename As String) As String
|
||||
' Regex to find MessageId
|
||||
' See also: https://stackoverflow.com/questions/3968500/regex-to-validate-a-message-id-as-per-rfc2822
|
||||
Dim oRegex = "(((([a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*)|(""(([\x01-\x08\x0B\x0C\x0E-\x1F\x7F]|[\x21\x23-\x5B\x5D-\x7E])|(\\[\x01-\x09\x0B\x0C\x0E-\x7F]))*""))@(([a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*)|(\[(([\x01-\x08\x0B\x0C\x0E-\x1F\x7F]|[\x21-\x5A\x5E-\x7E])|(\\[\x01-\x09\x0B\x0C\x0E-\x7F]))*\]))))~.+"
|
||||
Dim oMatch = Regex.Match(Filename, oRegex, RegexOptions.IgnoreCase)
|
||||
|
||||
If oMatch.Success Then
|
||||
Dim oMessageId = oMatch.Groups(1).Value
|
||||
Return oMessageId
|
||||
Else
|
||||
Return Nothing
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function GroupFiles(Files As List(Of FileInfo)) As Dictionary(Of String, List(Of FileInfo))
|
||||
Dim oGrouped As New Dictionary(Of String, List(Of FileInfo))
|
||||
|
||||
If Files.Count = 0 Then
|
||||
Return oGrouped
|
||||
End If
|
||||
|
||||
For Each oFile In Files
|
||||
Dim oMessageId = GetMessageIdFromFileName(oFile.Name)
|
||||
|
||||
If oMessageId Is Nothing Then
|
||||
_logger.Warn("File {0} did not have the required filename-format!", oMessageId)
|
||||
Continue For
|
||||
End If
|
||||
|
||||
If oGrouped.ContainsKey(oMessageId) Then
|
||||
oGrouped.Item(oMessageId).Add(oFile)
|
||||
Else
|
||||
oGrouped.Add(oMessageId, New List(Of FileInfo) From {oFile})
|
||||
End If
|
||||
Next
|
||||
|
||||
Return oGrouped
|
||||
End Function
|
||||
|
||||
|
||||
Public Sub Start(Arguments As Object) Implements IJob.Start
|
||||
Dim oArgs As WorkerArgs = Arguments
|
||||
Dim oPropertyExtractor = New PropertyValues(_logConfig)
|
||||
|
||||
_logger.Info("Starting Job {0}", [GetType].Name)
|
||||
|
||||
Try
|
||||
For Each oPath As String In oArgs.WatchDirectories
|
||||
Dim oDirInfo As New DirectoryInfo(oPath)
|
||||
|
||||
_logger.Info($"Start processing directory {oDirInfo.FullName}")
|
||||
|
||||
If oDirInfo.Exists Then
|
||||
' Filter out *.lock files
|
||||
Dim oFiles As List(Of FileInfo) = oDirInfo.
|
||||
GetFiles().
|
||||
Where(Function(f) Not f.Name.EndsWith(".lock")).
|
||||
ToList()
|
||||
Dim oFileCount = oFiles.Count
|
||||
Dim oCurrentFileCount = 0
|
||||
|
||||
If oFileCount = 0 Then
|
||||
_logger.Info("No files to process.")
|
||||
Continue For
|
||||
Else
|
||||
_logger.Info("Found {0} files", oFileCount)
|
||||
End If
|
||||
|
||||
' Group files by messageId
|
||||
Dim oGrouped As Dictionary(Of String, List(Of FileInfo)) = GroupFiles(oFiles)
|
||||
|
||||
_logger.Info("Found {0} file groups", oGrouped.Count)
|
||||
|
||||
' Process each file group together
|
||||
For Each oFileGroup In oGrouped
|
||||
' Start a new transaction for each file group.
|
||||
' This way we can rollback database changes for the whole filegroup in case something goes wrong.
|
||||
Dim oConnection As FbConnection = _firebird.GetConnection()
|
||||
Dim oTransaction As FbTransaction = oConnection.BeginTransaction()
|
||||
' Count the amount of ZUGFeRD files
|
||||
Dim oZUGFeRDCount As Integer = 0
|
||||
' Set the default Move Directory
|
||||
Dim oMoveDirectory As String = oArgs.SuccessDirectory
|
||||
' Create file lists
|
||||
Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value
|
||||
Dim oFileAttachmentFiles As New List(Of FileInfo)
|
||||
|
||||
Dim oFileGroupId As String = oFileGroup.Key
|
||||
Dim oMissingProperties As New List(Of String)
|
||||
Dim oMD5CheckSum As String = String.Empty
|
||||
|
||||
_logger.NewBlock($"Message Id {oFileGroupId}")
|
||||
_logger.Info("Start processing file group {0}", oFileGroupId)
|
||||
|
||||
Try
|
||||
For Each oFile In oFileGroupFiles
|
||||
Dim oDocument As CrossIndustryDocumentType
|
||||
' Start a global group counter for each file
|
||||
Dim oGlobalGroupCounter = 0
|
||||
' Clear missing properties for the new file
|
||||
oMissingProperties = New List(Of String)
|
||||
oCurrentFileCount += 1
|
||||
|
||||
' Only pdf files are allowed from here on
|
||||
If Not oFile.Name.EndsWith(".pdf") Then
|
||||
_logger.Debug("Skipping non-pdf file {0}", oFile.Name)
|
||||
oFileAttachmentFiles.Add(oFile)
|
||||
Continue For
|
||||
End If
|
||||
|
||||
_logger.Info("Start processing file {0}", oFile.Name)
|
||||
|
||||
Try
|
||||
oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName)
|
||||
Catch ex As ZUGFeRDExecption
|
||||
Select Case ex.ErrorType
|
||||
Case ZUGFeRDInterface.ErrorType.NoZugferd
|
||||
_logger.Warn("File is not a valid ZUGFeRD document! Skipping.")
|
||||
oFileAttachmentFiles.Add(oFile)
|
||||
Continue For
|
||||
|
||||
Case ZUGFeRDInterface.ErrorType.NoValidZugferd
|
||||
_logger.Warn("File is an Incorrectly formatted ZUGFeRD document!")
|
||||
Throw New InvalidFerdException()
|
||||
|
||||
Case Else
|
||||
_logger.Warn("Unexpected Error occurred while extracting ZUGFeRD Information from file {0}", oFile.FullName)
|
||||
Throw ex
|
||||
End Select
|
||||
|
||||
|
||||
End Try
|
||||
|
||||
oMD5CheckSum = CreateMD5(oFile.FullName)
|
||||
If oMD5CheckSum <> String.Empty Then
|
||||
Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE GUID = (SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
|
||||
Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction)
|
||||
If Not IsNothing(oMD5DT) Then
|
||||
If oMD5DT.Rows.Count = 1 Then
|
||||
Dim oRejected As Boolean
|
||||
Try
|
||||
oRejected = CBool(oMD5DT.Rows(0).Item("REJECTED"))
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Error while converting REJECTED: " & ex.Message)
|
||||
oRejected = False
|
||||
End Try
|
||||
If oRejected = False Then
|
||||
HISTORY_ID = oMD5DT.Rows(0).Item("GUID")
|
||||
Throw New MD5HashException()
|
||||
Else
|
||||
_logger.Info("ZuGFeRDFile already has been worked, but formerly obviously was rejected!")
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
_logger.Warn("Be careful: oExistsDT is nothing!")
|
||||
End If
|
||||
Else
|
||||
_logger.Warn("Be careful: oMD5CheckSum is nothing!")
|
||||
End If
|
||||
|
||||
' Check if there are more than one ZUGFeRD files
|
||||
If oZUGFeRDCount = 1 Then
|
||||
Throw New TooMuchFerdsException()
|
||||
End If
|
||||
|
||||
' Since extraction went well, increase the amount of ZUGFeRD files
|
||||
oZUGFeRDCount += 1
|
||||
|
||||
' PropertyMap items with `IsGrouped = False` are handled normally
|
||||
Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = oArgs.PropertyMap.
|
||||
Where(Function(Item As KeyValuePair(Of String, XmlItemProperty))
|
||||
Return Item.Value.IsGrouped = False
|
||||
End Function).
|
||||
ToDictionary(Function(Item) Item.Key,
|
||||
Function(Item) Item.Value)
|
||||
|
||||
_logger.Debug("Found {0} default properties.", oDefaultProperties.Count)
|
||||
|
||||
' PropertyMap items with `IsGrouped = True` are grouped by group scope
|
||||
Dim oGroupedProperties = oArgs.PropertyMap.
|
||||
Where(Function(Item) Item.Value.IsGrouped = True).
|
||||
ToLookup(Function(Item) Item.Value.GroupScope, ' Lookup key is group scope
|
||||
Function(Item) Item)
|
||||
|
||||
_logger.Debug("Found {0} properties grouped in {1} group(s)", oArgs.PropertyMap.Count - oDefaultProperties.Count, oGroupedProperties.Count)
|
||||
' Iterate through groups to get group scope and group items
|
||||
For Each oGroup In oGroupedProperties
|
||||
Dim oGroupScope As String = oGroup.Key
|
||||
Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object))
|
||||
Dim oRowCount = 0
|
||||
|
||||
_logger.Debug("Fetching Property values for group {0}.", oGroupScope)
|
||||
|
||||
' get properties as a nested object, see `oPropertyList`
|
||||
For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup
|
||||
Dim oPropertyValues As List(Of Object)
|
||||
|
||||
Try
|
||||
oPropertyValues = oPropertyExtractor.GetPropValue(oDocument, oProperty.Key)
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Unknown error occurred while fetching property [{0}] in group [{1}]:", oProperty.Value.Description, oGroupScope)
|
||||
_logger.Error(ex)
|
||||
oPropertyValues = New List(Of Object)
|
||||
End Try
|
||||
|
||||
' Flatten result value
|
||||
oPropertyValues = oPropertyExtractor.GetFinalPropValue(oPropertyValues)
|
||||
|
||||
' Add to list
|
||||
oPropertyList.Add(oProperty.Value, oPropertyValues)
|
||||
|
||||
' check the first batch of values to determine the row count
|
||||
If oRowCount = 0 Then
|
||||
oRowCount = oPropertyValues.Count
|
||||
End If
|
||||
Next
|
||||
|
||||
' Structure of oPropertyList
|
||||
' [ # Propertyname # Row 1 # Row 2
|
||||
' PositionsMenge: [BilledQuantity1, BilledQuantity2, ...],
|
||||
' PositionsSteuersatz: [ApplicablePercent1, ApplicablePercent2, ...],
|
||||
' ...
|
||||
' ]
|
||||
For oRowIndex = 0 To oRowCount - 1
|
||||
_logger.Debug("Processing row {0}", oRowIndex)
|
||||
|
||||
For Each oColumn As KeyValuePair(Of XmlItemProperty, List(Of Object)) In oPropertyList
|
||||
Dim oTableName As String = oColumn.Key.TableName
|
||||
Dim oPropertyDescription As String = oColumn.Key.Description
|
||||
Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1
|
||||
|
||||
' Returns nothing if oColumn.Value contains an empty list
|
||||
Dim oPropertyValue = oColumn.Value.ElementAtOrDefault(oRowIndex)
|
||||
|
||||
_logger.Debug("Processing property {0}.", oPropertyDescription)
|
||||
|
||||
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
|
||||
If oColumn.Key.IsRequired Then
|
||||
_logger.Warn("Property [{0}] is empty or not found but is required. Continuing with Empty String.", oPropertyDescription)
|
||||
oMissingProperties.Add(oPropertyDescription)
|
||||
Else
|
||||
_logger.Debug("Property [{0}] is empty or not found. Continuing with Empty String.", oPropertyDescription)
|
||||
End If
|
||||
|
||||
oPropertyValue = String.Empty
|
||||
End If
|
||||
|
||||
_logger.Debug("Property {0} has value '{1}'", oPropertyDescription, oPropertyValue)
|
||||
|
||||
Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oFileGroupId}', '{oPropertyDescription}', '{oPropertyValue}', {oRowCounter})"
|
||||
_logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2} with RowCounter {3}", oPropertyDescription, oPropertyValue, oTableName, oRowCounter)
|
||||
|
||||
' Insert into SQL Server
|
||||
If oArgs.InsertIntoSQLServer = True Then
|
||||
Dim oResult = _mssql.NewExecutenonQuery(oCommand)
|
||||
If oResult = False Then
|
||||
_logger.Warn("SQL Command was not successful. Check the log.")
|
||||
End If
|
||||
End If
|
||||
|
||||
' Insert into Firebird
|
||||
_firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
|
||||
Next
|
||||
Next
|
||||
|
||||
oGlobalGroupCounter += oRowCount
|
||||
Next
|
||||
|
||||
' Iterate through default properties
|
||||
For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties
|
||||
Dim oPropertyValueList As List(Of Object)
|
||||
Dim oPropertyDescription As String = Item.Value.Description
|
||||
Dim oPropertyValue As Object = Nothing
|
||||
|
||||
Try
|
||||
oPropertyValueList = oPropertyExtractor.GetPropValue(oDocument, Item.Key)
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Unknown error occurred while fetching property {0} in group {1}:", oPropertyDescription, Item.Value.GroupScope)
|
||||
_logger.Error(ex)
|
||||
oPropertyValueList = New List(Of Object)
|
||||
End Try
|
||||
|
||||
Try
|
||||
If IsNothing(oPropertyValueList) Then
|
||||
oPropertyValue = Nothing
|
||||
ElseIf TypeOf oPropertyValueList Is List(Of Object) Then
|
||||
Select Case oPropertyValueList.Count
|
||||
Case 0
|
||||
oPropertyValue = Nothing
|
||||
Case Else
|
||||
Dim oList As List(Of Object) = DirectCast(oPropertyValueList, List(Of Object))
|
||||
oPropertyValue = oList.Item(0)
|
||||
|
||||
' This should hopefully show config errors
|
||||
If TypeOf oPropertyValue Is List(Of Object) Then
|
||||
_logger.Warn("Property with Description {0} may be configured incorrectly", oPropertyDescription)
|
||||
oPropertyValue = Nothing
|
||||
End If
|
||||
End Select
|
||||
End If
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Unknown error occurred while processing property {0}:", oPropertyDescription)
|
||||
_logger.Error(ex)
|
||||
oPropertyValue = Nothing
|
||||
End Try
|
||||
|
||||
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
|
||||
If Item.Value.IsRequired Then
|
||||
_logger.Warn("Property {0} is empty but marked as required! Skipping.", oPropertyDescription)
|
||||
oMissingProperties.Add(oPropertyDescription)
|
||||
Continue For
|
||||
Else
|
||||
_logger.Debug("Property [{0}] is empty or not found. Skipping.", oPropertyDescription)
|
||||
Continue For
|
||||
End If
|
||||
End If
|
||||
|
||||
Dim oTableName = Item.Value.TableName
|
||||
Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{oPropertyDescription}', '{oPropertyValue}')"
|
||||
_logger.Debug("Mapping Property [{0}] to value [{1}] . Will be inserted into table {2}", oPropertyDescription, oPropertyValue, oTableName)
|
||||
|
||||
' Insert into SQL Server
|
||||
If oArgs.InsertIntoSQLServer = True Then
|
||||
Dim oResult = _mssql.NewExecutenonQuery(oCommand)
|
||||
If oResult = False Then
|
||||
_logger.Warn("SQL Command was not successful. Check the log.")
|
||||
End If
|
||||
End If
|
||||
|
||||
' Insert into Firebird
|
||||
_firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
|
||||
Next
|
||||
|
||||
If oMissingProperties.Count > 0 Then
|
||||
Throw New MissingValueException(oFile)
|
||||
End If
|
||||
Next
|
||||
|
||||
'Check if there are no ZUGFeRD files
|
||||
If oZUGFeRDCount = 0 Then
|
||||
Throw New NoFerdsException()
|
||||
End If
|
||||
|
||||
'If no errors occurred...
|
||||
'Log the History
|
||||
If oMD5CheckSum <> String.Empty Then
|
||||
Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oFileGroupId}', '{oMD5CheckSum}')"
|
||||
_firebird.ExecuteNonQueryWithConnection(oInsertCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
|
||||
'commit the transaction
|
||||
oTransaction.Commit()
|
||||
Try
|
||||
Dim oSQL = $"SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE MESSAGE_ID = '{oFileGroupId}'"
|
||||
HISTORY_ID = _firebird.GetScalarValue(oSQL)
|
||||
Catch ex As Exception
|
||||
HISTORY_ID = 0
|
||||
End Try
|
||||
End If
|
||||
|
||||
Catch ex As MD5HashException
|
||||
_logger.Error(ex)
|
||||
oMoveDirectory = oArgs.ErrorDirectory
|
||||
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE GUID = '{HISTORY_ID}'"
|
||||
_firebird.ExecuteNonQuery(oSQL)
|
||||
|
||||
Dim oBody = "<p>The invoice attached to your email has already been processed in our system.</p>"
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
|
||||
Catch ex As InvalidFerdException
|
||||
_logger.Error(ex)
|
||||
|
||||
oMoveDirectory = oArgs.ErrorDirectory
|
||||
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE GUID = '{HISTORY_ID}'"
|
||||
_firebird.ExecuteNonQuery(oSQL)
|
||||
Dim oBody = """
|
||||
<p>Ihre email einthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.</p>
|
||||
<p>Mögliche Gründe für ein inkorrektes Format:<ul>
|
||||
<li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
|
||||
</ul></p>
|
||||
"""
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Catch ex As TooMuchFerdsException
|
||||
_logger.Error(ex)
|
||||
|
||||
oMoveDirectory = oArgs.ErrorDirectory
|
||||
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE GUID = '{HISTORY_ID}'"
|
||||
_firebird.ExecuteNonQuery(oSQL)
|
||||
Dim oBody = "<p>Ihre email enthielt mehr als ein ZUGFeRD-Dokument.</p>"
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Catch ex As NoFerdsException
|
||||
_logger.Error(ex)
|
||||
|
||||
oMoveDirectory = oArgs.ErrorDirectory
|
||||
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE GUID = '{HISTORY_ID}'"
|
||||
_firebird.ExecuteNonQuery(oSQL)
|
||||
Dim oBody = "<p>Your email contained no ZUGFeRD-Documents.</p>"
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Catch ex As MissingValueException
|
||||
_logger.Error(ex)
|
||||
|
||||
oMoveDirectory = oArgs.ErrorDirectory
|
||||
Dim oMessage As String = ""
|
||||
For Each prop In oMissingProperties
|
||||
oMessage &= $"- {prop}"
|
||||
Next
|
||||
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Missing Required Properties: {oMessage}' WHERE GUID = '{HISTORY_ID}'"
|
||||
_firebird.ExecuteNonQuery(oSQL)
|
||||
|
||||
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
|
||||
_logger.Error(ex)
|
||||
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'"
|
||||
_firebird.ExecuteNonQuery(oSQL)
|
||||
|
||||
oMoveDirectory = oArgs.ErrorDirectory
|
||||
Finally
|
||||
oConnection.Close()
|
||||
|
||||
' Move all files of the current group
|
||||
Try
|
||||
MoveFiles(oArgs, oFileGroupFiles, oFileAttachmentFiles, oMoveDirectory)
|
||||
_logger.Info("Finished processing file group {0}", oFileGroupId)
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Could not move files!")
|
||||
_logger.Error(ex)
|
||||
Throw ex
|
||||
Finally
|
||||
_logger.EndBlock()
|
||||
End Try
|
||||
End Try
|
||||
Next
|
||||
End If
|
||||
Next
|
||||
|
||||
_logger.Info("Finishing Job {0}", Me.GetType.Name)
|
||||
Catch ex As Exception
|
||||
_logger.Error(ex)
|
||||
_logger.Info("Job Failed! See error log for details")
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Sub MoveFiles(Args As WorkerArgs, Files As List(Of FileInfo), AttachmentFiles As List(Of FileInfo), MoveDirectory As String)
|
||||
For Each oFile In Files
|
||||
Try
|
||||
Dim oFinalMoveDirectory As String = MoveDirectory
|
||||
|
||||
If AttachmentFiles.Contains(oFile) Then
|
||||
oFinalMoveDirectory = Path.Combine(MoveDirectory, Args.AttachmentsSubDirectory)
|
||||
|
||||
If Not Directory.Exists(oFinalMoveDirectory) Then
|
||||
Directory.CreateDirectory(oFinalMoveDirectory)
|
||||
End If
|
||||
End If
|
||||
|
||||
Dim oFileName = _filesystem.GetVersionedFilename(Path.Combine(oFinalMoveDirectory, oFile.Name))
|
||||
|
||||
_filesystem.MoveTo(oFile.FullName, oFileName, oFinalMoveDirectory)
|
||||
|
||||
_logger.Info("Finished processing file {0}", oFile.Name)
|
||||
_logger.Info("File moved to {0}", oFileName)
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Could not move file {0}", oFile.FullName)
|
||||
_logger.Error(ex)
|
||||
End Try
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
|
||||
Dim oBody = $"<p>Die angehängte Datei entspricht nicht dem WISAG ZUGFeRD-Format: {OriginalFilename}</p>"
|
||||
|
||||
If MissingProperties.Count > 0 Then
|
||||
oBody &= $"{vbNewLine}{vbNewLine}"
|
||||
oBody &= $"Die folgenden Eigenschaften wurden als ERFORDERLICH eingestuft, wurden aber nicht gefunden:"
|
||||
oBody &= $"{vbNewLine}{vbNewLine}"
|
||||
|
||||
For Each prop In MissingProperties
|
||||
oBody &= $"- {prop}"
|
||||
Next
|
||||
End If
|
||||
|
||||
Return oBody
|
||||
End Function
|
||||
Private Function CreateMD5(ByVal Filename As String) As String
|
||||
Try
|
||||
Dim oMD5 As New MD5CryptoServiceProvider
|
||||
Dim oHash As Byte()
|
||||
Dim oHashString As String
|
||||
Dim oResult As String = ""
|
||||
|
||||
Using oFileStream As New FileStream(Filename, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
|
||||
oHash = oMD5.ComputeHash(oFileStream)
|
||||
oHashString = BitConverter.ToString(oHash)
|
||||
End Using
|
||||
|
||||
oResult = oHashString.Replace("-", "")
|
||||
Return oResult
|
||||
Catch ex As Exception
|
||||
_logger.Error(ex)
|
||||
Return ""
|
||||
End Try
|
||||
End Function
|
||||
End Class
|
||||
138
Modules.Jobs/EDMI/ZUGFeRD/PropertyValues.vb
Normal file
138
Modules.Jobs/EDMI/ZUGFeRD/PropertyValues.vb
Normal file
@@ -0,0 +1,138 @@
|
||||
Imports System.Collections.Generic
|
||||
Imports System.Linq
|
||||
Imports System.Reflection
|
||||
Imports System.Text.RegularExpressions
|
||||
Imports DigitalData.Modules.Logging
|
||||
|
||||
Public Class PropertyValues
|
||||
Private _indexPattern = "\((\d+)\)"
|
||||
Private _indexRegex As New Regex(_indexPattern)
|
||||
Private _Logger As Logger
|
||||
|
||||
Public Sub New(LogConfig As LogConfig)
|
||||
_Logger = LogConfig.GetLogger()
|
||||
End Sub
|
||||
|
||||
Public Function GetPropValue(Obj As Object, PropertyName As String) As List(Of Object)
|
||||
Dim oNameParts As String() = PropertyName.Split("."c)
|
||||
|
||||
If IsNothing(Obj) Then
|
||||
_Logger.Debug("`Obj` is Nothing. Exiting.")
|
||||
Return New List(Of Object)
|
||||
End If
|
||||
|
||||
|
||||
If oNameParts.Length = 1 Then
|
||||
Dim oPropInfo As PropertyInfo = Obj.GetType().GetProperty(PropertyName)
|
||||
|
||||
If IsNothing(oPropInfo) Then
|
||||
_Logger.Debug("Property {0} does not exist.", PropertyName)
|
||||
Return New List(Of Object)
|
||||
Else
|
||||
Dim oPropValue = oPropInfo.GetValue(Obj, Nothing)
|
||||
Return New List(Of Object) From {oPropValue}
|
||||
End If
|
||||
End If
|
||||
|
||||
For Each oPart As String In oNameParts
|
||||
Dim oType As Type = Obj.GetType()
|
||||
Dim oPartName = oPart
|
||||
Dim oIndex As Integer = Nothing
|
||||
Dim oHasIndex As Boolean = HasIndex(oPartName)
|
||||
|
||||
If oHasIndex Then
|
||||
oPartName = StripIndex(oPart)
|
||||
oIndex = GetIndex(oPart)
|
||||
End If
|
||||
|
||||
Dim oInfo As PropertyInfo = oType.GetProperty(oPartName)
|
||||
|
||||
If IsNothing(oInfo) OrElse IsNothing(oInfo.GetValue(Obj, Nothing)) Then
|
||||
_Logger.Debug("Property {0} does not exist.", oPartName)
|
||||
Return New List(Of Object)
|
||||
End If
|
||||
|
||||
Obj = oInfo.GetValue(Obj, Nothing)
|
||||
|
||||
If oHasIndex Then
|
||||
Obj = Obj(0)
|
||||
End If
|
||||
|
||||
If IsArray(Obj) And Not oHasIndex Then
|
||||
Dim oCurrentPart As String = oPart
|
||||
Dim oSplitString As String() = New String() {oCurrentPart & "."}
|
||||
Dim oPathFragments = PropertyName.Split(oSplitString, StringSplitOptions.None)
|
||||
Dim oResults As New List(Of Object)
|
||||
|
||||
' if path has no more subitems, return an empty list
|
||||
If oPathFragments.Length = 1 Then
|
||||
Return oResults
|
||||
End If
|
||||
|
||||
For Each oArrayItem In Obj
|
||||
Dim oResult As List(Of Object) = GetPropValue(oArrayItem, oPathFragments(1))
|
||||
|
||||
If Not IsNothing(oResult) Then
|
||||
oResults.Add(oResult)
|
||||
End If
|
||||
Next
|
||||
|
||||
Return oResults
|
||||
End If
|
||||
Next
|
||||
|
||||
Return New List(Of Object) From {Obj}
|
||||
End Function
|
||||
|
||||
Public Function GetFinalPropValue(List As List(Of Object)) As List(Of Object)
|
||||
Dim oResult As New List(Of Object)
|
||||
|
||||
For Each Item In List
|
||||
Dim oItemValue = DoGetFinalPropValue(Item)
|
||||
|
||||
If Not IsNothing(oItemValue) Then
|
||||
oResult.Add(oItemValue)
|
||||
End If
|
||||
Next
|
||||
|
||||
Return oResult
|
||||
End Function
|
||||
|
||||
Private Function DoGetFinalPropValue(Value As Object) As String
|
||||
If TypeOf Value Is List(Of Object) Then
|
||||
Dim oList = DirectCast(Value, List(Of Object))
|
||||
Dim oCount = oList.Count
|
||||
|
||||
Select Case oCount
|
||||
Case 0
|
||||
Return Nothing
|
||||
Case Else
|
||||
Return DoGetFinalPropValue(oList.First())
|
||||
End Select
|
||||
|
||||
Return DoGetFinalPropValue(Value)
|
||||
Else
|
||||
Return Value.ToString
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function GetIndex(Prop As String) As Integer
|
||||
If Regex.IsMatch(Prop, _indexPattern) Then
|
||||
Dim oMatch = _indexRegex.Match(Prop)
|
||||
Dim oGroup = oMatch.Groups.Item(1)
|
||||
Dim oValue = oGroup.Value
|
||||
|
||||
Return Integer.Parse(oValue)
|
||||
End If
|
||||
|
||||
Return Nothing
|
||||
End Function
|
||||
|
||||
Private Function StripIndex(Prop As String) As String
|
||||
Return Regex.Replace(Prop, _indexPattern, "")
|
||||
End Function
|
||||
|
||||
Private Function HasIndex(Prop As String) As Boolean
|
||||
Return Regex.IsMatch(Prop, _indexPattern)
|
||||
End Function
|
||||
End Class
|
||||
23
Modules.Jobs/EDMI/ZUGFeRD/WorkerArgs.vb
Normal file
23
Modules.Jobs/EDMI/ZUGFeRD/WorkerArgs.vb
Normal file
@@ -0,0 +1,23 @@
|
||||
Imports System.Collections.Generic
|
||||
|
||||
Public Class WorkerArgs
|
||||
Public WatchDirectories As List(Of String)
|
||||
Public SuccessDirectory As String
|
||||
Public ErrorDirectory As String
|
||||
Public OriginalEmailDirectory As String
|
||||
Public RejectedEmailDirectory As String
|
||||
Public AttachmentsSubDirectory As String
|
||||
Public PropertyMap As Dictionary(Of String, XmlItemProperty)
|
||||
Public InsertIntoSQLServer As Boolean
|
||||
|
||||
Public Sub New()
|
||||
WatchDirectories = New List(Of String)
|
||||
SuccessDirectory = Nothing
|
||||
ErrorDirectory = Nothing
|
||||
OriginalEmailDirectory = Nothing
|
||||
RejectedEmailDirectory = Nothing
|
||||
AttachmentsSubDirectory = Nothing
|
||||
PropertyMap = New Dictionary(Of String, XmlItemProperty)
|
||||
InsertIntoSQLServer = False
|
||||
End Sub
|
||||
End Class
|
||||
7
Modules.Jobs/EDMI/ZUGFeRD/XmlItemProperty.vb
Normal file
7
Modules.Jobs/EDMI/ZUGFeRD/XmlItemProperty.vb
Normal file
@@ -0,0 +1,7 @@
|
||||
Public Class XmlItemProperty
|
||||
Public TableName As String
|
||||
Public Description As String
|
||||
Public IsRequired As Boolean
|
||||
Public IsGrouped As Boolean
|
||||
Public GroupScope As String
|
||||
End Class
|
||||
Reference in New Issue
Block a user