The following file is not ZUGFeRD-compliant: {oOriginalFilename}
" - If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then oEmailTo = String.Empty Else oEmailTo = oEmailAddress End If - If MissingProperties.Count > 0 Then - oBody &= $"{vbNewLine}{vbNewLine}" - oBody &= $"The following Properties were marked as Required but were not found:" - oBody &= $"{vbNewLine}{vbNewLine}" - - For Each prop In MissingProperties - oBody &= $"- {prop}" - Next - End If - _logger.Debug("Generated Email:") _logger.Debug("To: {0}", oEmailTo) _logger.Debug("Subject: {0}", oSubject) - _logger.Debug("Body {0}", oBody) + _logger.Debug("Body {0}", BodyText) Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE " oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO) VALUES " - oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{oBody}', '{oCreatedWho}')" + oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{BodyText}', '{oCreatedWho}')" _firebird.ExecuteNonQuery(oSQLInsert) @@ -128,83 +117,198 @@ Public Class ImportZUGFeRDFiles End Try End Sub + Private Function GetMessageIdFromFileName(Filename As String) As String + Dim oMatch = Regex.Match(Filename, "([\w\d]+)~.+", 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 oRegex = New Regex("([\w\d]+)_.+") + 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 args As WorkerArgs = Arguments _logger.Info("Starting Job {0}", Me.GetType.Name) + For Each oPath As String In args.WatchDirectories Dim oDirInfo As New DirectoryInfo(oPath) _logger.Info($"Start processing directory {oDirInfo.FullName}") If oDirInfo.Exists Then - Dim oFiles As List(Of FileInfo) = oDirInfo.GetFiles().ToList() + ' 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 _logger.Info("Found {0} files", oFileCount) - For Each oFile In oFiles - oCurrentFileCount += 1 - _logger.Info($"({oCurrentFileCount}/{oFileCount}) Start processing file {oFile.Name}") + ' 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 = args.SuccessDirectory - Dim oDocument As CrossIndustryDocumentType - Dim oGuid As String = Path.GetFileNameWithoutExtension(oFile.FullName) - Dim oConnection = _firebird.GetConnection() - Dim oTransaction = oConnection.BeginTransaction() + Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value + Dim oFileGroupId As String = oFileGroup.Key Dim oMissingProperties As New List(Of String) + _logger.Info("Start processing file group {0}", oFileGroupId) + Try - oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName) + For Each oFile In oFileGroupFiles + Dim oDocument As CrossIndustryDocumentType - For Each Item As KeyValuePair(Of String, XmlItemProperty) In args.PropertyMap - Dim propertyValue As String = PropertyValues.GetPropValue(oDocument, Item.Key) - Dim propertyDescripton As String = Item.Value.Description + ' Clear missing properties for the new file + oMissingProperties = New List(Of String) + oCurrentFileCount += 1 - If String.IsNullOrEmpty(propertyValue) Then - If Item.Value.IsRequired Then - _logger.Warn("Property {0} is empty but marked as required! Skipping.", propertyDescripton) - oMissingProperties.Add(propertyDescripton) - Continue For - Else - _logger.Debug("Property {0} is empty or not found. Skipping.", propertyDescripton) - Continue For - End If + _logger.Info($"({oCurrentFileCount}/{oFileCount}) Start processing file {oFile.Name}") + + Try + oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName) + Catch ex As Exception + _logger.Warn($"({oCurrentFileCount}/{oFileCount}) File is not a valid ZUGFeRD document! Skipping.") + Continue For + End Try + + ' Check if there are more than one ZUGFeRD files + If oZUGFeRDCount = 1 Then + Throw New TooMuchFerdsException() End If - Dim oTableName = Item.Value.TableName - Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oGuid}', '{propertyDescripton}', '{propertyValue}')" + ' Since extraction went well, increase the amount of ZUGFeRD files + oZUGFeRDCount += 1 - _logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2}", propertyDescripton, propertyValue, oTableName) + For Each Item As KeyValuePair(Of String, XmlItemProperty) In args.PropertyMap + Dim propertyValue As String = PropertyValues.GetPropValue(oDocument, Item.Key) + Dim propertyDescripton As String = Item.Value.Description - _firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction) + If String.IsNullOrEmpty(propertyValue) Then + If Item.Value.IsRequired Then + _logger.Warn("Property {0} is empty but marked as required! Skipping.", propertyDescripton) + oMissingProperties.Add(propertyDescripton) + Continue For + Else + _logger.Debug("Property {0} is empty or not found. Skipping.", propertyDescripton) + Continue For + End If + End If + + Dim oTableName = Item.Value.TableName + Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{propertyDescripton}', '{propertyValue}')" + + _logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2}", propertyDescripton, propertyValue, oTableName) + + _firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction) + Next + + If oMissingProperties.Count > 0 Then + Throw New MissingValueException(oFile) + End If Next - If oMissingProperties.Count > 0 Then - Throw New Exception($"Some properties were empty but marked as required required!") + ' Check if there are no ZUGFeRD files + If oZUGFeRDCount = 0 Then + Throw New NoFerdsException() End If + ' If no errors occurred, commit the transaction oTransaction.Commit() - Catch ex As Exception - _logger.Warn("File {0} was not processed. Transaction rolled back.", oFile.Name) + Catch ex As TooMuchFerdsException _logger.Error(ex) - oTransaction.Rollback() + oMoveDirectory = args.ErrorDirectory - AddToEmailQueue(oGuid, oFile.Name, oMissingProperties) + Dim oBody = "Your email contained more than one ZUGFeRD-Document.
" + AddToEmailQueue(oFileGroupId, oBody) + Catch ex As NoFerdsException + _logger.Error(ex) + + oMoveDirectory = args.ErrorDirectory + + Dim oBody = "Your email contained no ZUGFeRD-Documents.
" + AddToEmailQueue(oFileGroupId, oBody) + Catch ex As MissingValueException + _logger.Error(ex) + + oMoveDirectory = args.ErrorDirectory + + Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties) + AddToEmailQueue(oFileGroupId, oBody) Finally oConnection.Close() - _filesystem.MoveTo(oFile.FullName, oMoveDirectory) - _logger.Info("Finished processing file {0}", oFile.Name) - _logger.Info("File moved to {0}", oMoveDirectory) + + ' Move all files of the current group + For Each oFile In oFileGroupFiles + _filesystem.MoveTo(oFile.FullName, oMoveDirectory) + _logger.Info("({1}/{2}) Finished processing file {0}", oFile.Name, oCurrentFileCount, oFileCount) + _logger.Info($"({1}/{2}) File moved to {0}", oMoveDirectory) + Next + + _logger.Info("Finished processing file group {0}", oFileGroupId) End Try Next - Else - _logger.Debug("Directory {0} does not exist", oPath) End If - - _logger.Info("Finished processing directory {0}", oPath) Next End Sub + + + Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) + Dim oBody = $"The following file is not ZUGFeRD-compliant: {OriginalFilename}
" + + If MissingProperties.Count > 0 Then + oBody &= $"{vbNewLine}{vbNewLine}" + oBody &= $"The following Properties were marked as Required but were not found:" + oBody &= $"{vbNewLine}{vbNewLine}" + + For Each prop In MissingProperties + oBody &= $"- {prop}" + Next + End If + + Return oBody + End Function End Class diff --git a/Jobs/Exceptions.vb b/Jobs/Exceptions.vb new file mode 100644 index 00000000..d7b8cd5c --- /dev/null +++ b/Jobs/Exceptions.vb @@ -0,0 +1,31 @@ +Imports System.IO + +Public Class Exceptions + Public Class MissingValueException + Inherits ApplicationException + + Public ReadOnly File As FileInfo + + Public Sub New(File As FileInfo) + MyBase.New() + + Me.File = File + End Sub + End Class + + Public Class TooMuchFerdsException + Inherits ApplicationException + + Public Sub New() + MyBase.New() + End Sub + End Class + + Public Class NoFerdsException + Inherits ApplicationException + + Public Sub New() + MyBase.New() + End Sub + End Class +End Class diff --git a/Jobs/Jobs.vbproj b/Jobs/Jobs.vbproj index 3d058ff8..52d3116f 100644 --- a/Jobs/Jobs.vbproj +++ b/Jobs/Jobs.vbproj @@ -80,6 +80,7 @@