371 lines
17 KiB
VB.net
371 lines
17 KiB
VB.net
Imports System.Collections.Generic
|
|
Imports System.Data
|
|
Imports System.IO
|
|
Imports System.Linq
|
|
Imports System.Text.RegularExpressions
|
|
Imports DigitalData.Modules.Database
|
|
Imports DigitalData.Modules.Interfaces
|
|
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"
|
|
|
|
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 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)
|
|
|
|
Try
|
|
File.Move(oSource, oDestination)
|
|
oEmailData.Attachment = oDestination
|
|
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 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)
|
|
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 args As WorkerArgs = Arguments
|
|
|
|
_logger.Info("Starting Job {0}", [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
|
|
|
|
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 = 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
|
|
|
|
' Only pdf files are allowed from here on
|
|
If Not oFile.Name.EndsWith(".pdf") Then
|
|
_logger.Debug("Skipping non-pdf file {0}", oFile.Name)
|
|
Continue For
|
|
End If
|
|
|
|
_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)
|
|
|
|
' Insert into SQL Server
|
|
If args.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, commit the transaction
|
|
oTransaction.Commit()
|
|
Catch ex As TooMuchFerdsException
|
|
_logger.Error(ex)
|
|
|
|
oMoveDirectory = args.ErrorDirectory
|
|
|
|
Dim oBody = "<p>Your email contained more than one ZUGFeRD-Document.</p>"
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
|
|
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
|
Catch ex As NoFerdsException
|
|
_logger.Error(ex)
|
|
|
|
oMoveDirectory = args.ErrorDirectory
|
|
|
|
Dim oBody = "<p>Your email contained no ZUGFeRD-Documents.</p>"
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
|
|
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
|
Catch ex As MissingValueException
|
|
_logger.Error(ex)
|
|
|
|
oMoveDirectory = args.ErrorDirectory
|
|
|
|
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
|
|
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
|
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 = $"<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
|