Imports System.Collections.Generic Imports System.IO Imports System.Linq Imports DigitalData.Modules.Database Imports DigitalData.Modules.Interfaces Imports DigitalData.Modules.Logging Imports System.Text.RegularExpressions Imports DigitalData.Modules.Jobs.Exceptions 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" Private _logger As Logger Private _logConfig As LogConfig Private _zugferd As ZUGFeRDInterface Private _firebird As Firebird Private _filesystem As Filesystem.File Public Class WorkerArgs Public WatchDirectories As List(Of String) Public SuccessDirectory As String Public ErrorDirectory As String Public PropertyMap As Dictionary(Of String, XmlItemProperty) Public Sub New() WatchDirectories = New List(Of String) SuccessDirectory = Nothing ErrorDirectory = Nothing PropertyMap = New Dictionary(Of String, XmlItemProperty) End Sub End Class Public Class XmlItemProperty Public TableName As String Public Description As String Public IsRequired As Boolean End Class Public Sub New(LogConfig As LogConfig, Firebird As Firebird) _logConfig = LogConfig _logger = LogConfig.GetLogger() _firebird = Firebird _filesystem = New Filesystem.File(_logConfig) _zugferd = New ZUGFeRDInterface(_logConfig) 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 GetEmailAddressForFileGUID(FileGuid As String) As String Dim oSQL = $"SELECT EMAIL_FROM FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'" Try Dim emailAddress = _firebird.GetScalarValue(oSQL) _logger.Debug("Got Email Address for FileId {0}: {1}", FileGuid, emailAddress) Return emailAddress Catch ex As Exception _logger.Warn("Could not fetch Email Address for FileId {0}", FileGuid) Return Nothing End Try End Function Private Function GetOriginalFileNameForFileGUID(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 Sub AddToEmailQueue(FileGuid As String, BodyText As String) Try Dim oJobId = RandomValue(1, 10000) Dim oReference = FileGuid Dim oEmailTo = "" Dim oSubject = "Your email was rejected" Dim oAccountId = 1 Dim oCreatedWho = "ZUGFeRD Service" Dim oEmailAddress = GetEmailAddressForFileGUID(FileGuid) Dim oOriginalFilename = GetOriginalFileNameForFileGUID(FileGuid) If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then 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 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}', '{BodyText}', '{oCreatedWho}')" _firebird.ExecuteNonQuery(oSQLInsert) _logger.Debug("Email Queue updated for MessageId {0}.", FileGuid, oEmailTo) Catch ex As Exception _logger.Error(ex) 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) Try 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 ' 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) ' 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 oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value Dim oFileGroupId As String = oFileGroup.Key Dim oMissingProperties As New List(Of String) _logger.NewBlock($"Message Id {oFileGroupId}") _logger.Info("Start processing file group {0}", oFileGroupId) Try For Each oFile In oFileGroupFiles Dim oDocument As CrossIndustryDocumentType ' Clear missing properties for the new file oMissingProperties = New List(Of String) oCurrentFileCount += 1 _logger.Info("Start processing file {0}", oFile.Name) Try oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName) Catch ex As Exception _logger.Warn("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 ' Since extraction went well, increase the amount of ZUGFeRD files oZUGFeRDCount += 1 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 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 ' 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 TooMuchFerdsException _logger.Error(ex) oMoveDirectory = args.ErrorDirectory 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() ' Move all files of the current group For Each oFile In oFileGroupFiles _filesystem.MoveTo(oFile.FullName, oMoveDirectory) _logger.Info("Finished processing file {0}", oFile.Name) _logger.Info("File moved to {0}", oMoveDirectory) Next _logger.Info("Finished processing file group {0}", oFileGroupId) _logger.EndBlock() 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 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