Imports System.Collections.Generic Imports System.IO Imports System.Linq Imports DigitalData.Modules.Database Imports DigitalData.Modules.Interfaces Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Filesystem 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, OriginalFileName As String, MissingProperties As List(Of String)) Try Dim oJobId = RandomValue(1, 10000) Dim oReference = FileGuid Dim oEmailTo = "" Dim oSubject = "" Dim oBody = "" Dim oAccountId = 1 Dim oCreatedWho = "ZUGFeRD Service" Dim oEmailAddress = GetEmailAddressForFileGUID(FileGuid) Dim oOriginalFilename = GetOriginalFileNameForFileGUID(FileGuid) oSubject = "File not ZUGFeRD-Compliant!" oBody = $"
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) 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}')" _firebird.ExecuteNonQuery(oSQLInsert) _logger.Info("Email Queue updated for MessageId {0}.", FileGuid, oEmailTo) Catch ex As Exception _logger.Error(ex) End Try End Sub 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() 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}") 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 oMissingProperties As New List(Of String) Try oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName) 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 ('{oGuid}', '{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 Exception($"Some properties were empty but marked as required required!") End If oTransaction.Commit() Catch ex As Exception _logger.Warn("File {0} was not processed. Transaction rolled back.", oFile.Name) _logger.Error(ex) oTransaction.Rollback() oMoveDirectory = args.ErrorDirectory AddToEmailQueue(oGuid, oFile.Name, oMissingProperties) Finally oConnection.Close() _filesystem.MoveTo(oFile.FullName, oMoveDirectory) _logger.Info("Finished processing file {0}", oFile.Name) _logger.Info("File moved to {0}", oMoveDirectory) End Try Next Else _logger.Debug("Directory {0} does not exist", oPath) End If _logger.Info("Finished processing directory {0}", oPath) Next End Sub End Class