Handle ZUGFeRD Files as filegroups

Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb

@@ -5,6 +5,9 @@ Imports DigitalData.Modules.Database
 Imports DigitalData.Modules.Interfaces
 Imports DigitalData.Modules.Logging
 Imports DigitalData.Modules.Filesystem
+Imports System.Text.RegularExpressions
+Imports DigitalData.Modules.Jobs.Exceptions
+Imports FirebirdSql.Data.FirebirdClient
 
 Public Class ImportZUGFeRDFiles
     Implements IJob
@@ -80,45 +83,31 @@ Public Class ImportZUGFeRDFiles
         End Try
     End Function
 
-    Private Sub AddToEmailQueue(FileGuid As String, OriginalFileName As String, MissingProperties As List(Of String))
+    Private Sub AddToEmailQueue(FileGuid As String, BodyText As String)
         Try
             Dim oJobId = RandomValue(1, 10000)
             Dim oReference = FileGuid
             Dim oEmailTo = ""
-            Dim oSubject = ""
-            Dim oBody = ""
+            Dim oSubject = "Your email was rejected"
             Dim oAccountId = 1
             Dim oCreatedWho = "ZUGFeRD Service"
             Dim oEmailAddress = GetEmailAddressForFileGUID(FileGuid)
             Dim oOriginalFilename = GetOriginalFileNameForFileGUID(FileGuid)
 
-            oSubject = "File not ZUGFeRD-Compliant!"
-            oBody = $"<p>The following file is not ZUGFeRD-compliant: {oOriginalFilename}</p>"
-
             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 = "<p>Your email contained more than one ZUGFeRD-Document.</p>"
+                        AddToEmailQueue(oFileGroupId, oBody)
+                    Catch ex As NoFerdsException
+                        _logger.Error(ex)
+
+                        oMoveDirectory = args.ErrorDirectory
+
+                        Dim oBody = "<p>Your email contained no ZUGFeRD-Documents.</p>"
+                        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 = $"<p>The following file is not ZUGFeRD-compliant: {OriginalFilename}</p>"
+
+        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

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

Jobs/Jobs.vbproj

@@ -80,6 +80,7 @@
   <ItemGroup>
     <Compile Include="EDMI\ZUGFeRD\ImportZUGFeRDFiles.vb" />
     <Compile Include="EDMI\ZUGFeRD\PropertyValues.vb" />
+    <Compile Include="Exceptions.vb" />
     <Compile Include="IJob.vb" />
     <Compile Include="My Project\AssemblyInfo.vb" />
   </ItemGroup>