diff --git a/DDZUGFeRDService/App.config b/DDZUGFeRDService/App.config index a6041ca9..44d74781 100644 --- a/DDZUGFeRDService/App.config +++ b/DDZUGFeRDService/App.config @@ -14,7 +14,7 @@ DDZUGFeRDService - Digital Data ZUGFeRD Service + DD ZUGFeRD Service 172.24.12.41 @@ -28,6 +28,9 @@ dd + + 10 + \ No newline at end of file diff --git a/DDZUGFeRDService/My Project/Settings.Designer.vb b/DDZUGFeRDService/My Project/Settings.Designer.vb index fc8f79e7..37e6b49b 100644 --- a/DDZUGFeRDService/My Project/Settings.Designer.vb +++ b/DDZUGFeRDService/My Project/Settings.Designer.vb @@ -65,7 +65,7 @@ Namespace My _ + Global.System.Configuration.DefaultSettingValueAttribute("DD ZUGFeRD Service")> _ Public ReadOnly Property SERVICE_DISPLAY_NAME() As String Get Return CType(Me("SERVICE_DISPLAY_NAME"),String) @@ -107,6 +107,15 @@ Namespace My Return CType(Me("DB_PASSWORD"),String) End Get End Property + + _ + Public ReadOnly Property JOB_INTERVAL() As Integer + Get + Return CType(Me("JOB_INTERVAL"),Integer) + End Get + End Property End Class End Namespace diff --git a/DDZUGFeRDService/My Project/Settings.settings b/DDZUGFeRDService/My Project/Settings.settings index a6374583..f340b8c1 100644 --- a/DDZUGFeRDService/My Project/Settings.settings +++ b/DDZUGFeRDService/My Project/Settings.settings @@ -6,7 +6,7 @@ DDZUGFeRDService - Digital Data ZUGFeRD Service + DD ZUGFeRD Service 172.24.12.41 @@ -20,5 +20,8 @@ dd + + 10 + \ No newline at end of file diff --git a/DDZUGFeRDService/ThreadRunner.vb b/DDZUGFeRDService/ThreadRunner.vb index 06dcb1b1..bea354c9 100644 --- a/DDZUGFeRDService/ThreadRunner.vb +++ b/DDZUGFeRDService/ThreadRunner.vb @@ -22,7 +22,7 @@ Public Class ThreadRunner Private _zugferd As ZUGFeRDInterface Private _jobArguments As WorkerArgs - Private Const TIMER_INTERVAL_MS = 60_000 + Private Const TIMER_INTERVAL_MS = 10_000 Public Sub New(LogConfig As LogConfig, Firebird As Firebird) _logConfig = LogConfig @@ -35,23 +35,23 @@ Public Class ThreadRunner args = LoadPropertyMapFor(args, "DEFAULT") _jobArguments = args - _logger.Info("Checking SuccessDirectory {0}", args.SuccessDirectory) + _logger.Debug("Checking SuccessDirectory {0}", args.SuccessDirectory) If Not Directory.Exists(args.SuccessDirectory) Then _logger.Warn("SuccessDirectory {0} does not exist!", args.SuccessDirectory) 'Throw New DirectoryNotFoundException("SuccessDirectory: " & args.SuccessDirectory) End If - _logger.Info("Checking ErrorDirectory {0}", args.ErrorDirectory) + _logger.Debug("Checking ErrorDirectory {0}", args.ErrorDirectory) If Not Directory.Exists(args.ErrorDirectory) Then - 'Throw New DirectoryNotFoundException("ErrorDirectory: " & args.ErrorDirectory) _logger.Warn("ErrorDirectory {0} does not exist!", args.ErrorDirectory) + 'Throw New DirectoryNotFoundException("ErrorDirectory: " & args.ErrorDirectory) End If For Each oDirectory In args.WatchDirectories - _logger.Info("Checking WatchDirectory {0}", oDirectory) + _logger.Debug("Checking WatchDirectory {0}", oDirectory) If Not Directory.Exists(oDirectory) Then - 'Throw New DirectoryNotFoundException("WatchDirectory: " & oDirectory) _logger.Warn("WatchDirectory {0} does not exist!", oDirectory) + 'Throw New DirectoryNotFoundException("WatchDirectory: " & oDirectory) End If Next @@ -60,14 +60,13 @@ Public Class ThreadRunner .WorkerSupportsCancellation = True } - _workerTimer = New Timer With { - .Interval = TIMER_INTERVAL_MS - } + _workerTimer = New Timer() End Sub - Public Sub Start() + Public Sub Start(Interval As Integer) + _workerTimer.Interval = Interval * 1000 _workerTimer.Start() - _logger.Debug("ThreadRunner started.") + _logger.Debug("ThreadRunner started with {0}s Interval.", Interval) End Sub Public Sub [Stop]() @@ -92,12 +91,17 @@ Public Class ThreadRunner End Sub Private Sub DoWork(sender As Object, e As DoWorkEventArgs) Handles _workerThread.DoWork - Dim args As WorkerArgs = e.Argument + Try + Dim args As WorkerArgs = e.Argument - _logger.Debug("Background worker running..") + _logger.Debug("Background worker running..") - Dim job As New ImportZUGFeRDFiles(_logConfig, _firebird) - job.Start(args) + Dim job As New ImportZUGFeRDFiles(_logConfig, _firebird) + job.Start(args) + Catch ex As Exception + _logger.Warn("Background worker failed!") + _logger.Error(ex) + End Try End Sub Private Sub WorkCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles _workerThread.RunWorkerCompleted @@ -113,15 +117,12 @@ Public Class ThreadRunner Select Case oFolderType Case ZUGFERD_IN - _logger.Debug("Setting WatchDirectory: {0}", row.Item("FOLDER_PATH")) args.WatchDirectories.Add(row.Item("FOLDER_PATH")) Case ZUGFERD_SUCCESS - _logger.Debug("Setting SuccessDirectory: {0}", row.Item("FOLDER_PATH")) args.SuccessDirectory = row.Item("FOLDER_PATH") Case ZUGFERD_ERROR - _logger.Debug("Setting ErrorDirectory: {0}", row.Item("FOLDER_PATH")) args.ErrorDirectory = row.Item("FOLDER_PATH") End Select diff --git a/DDZUGFeRDService/ZUGFeRDService.vb b/DDZUGFeRDService/ZUGFeRDService.vb index b30b0486..c93dc77f 100644 --- a/DDZUGFeRDService/ZUGFeRDService.vb +++ b/DDZUGFeRDService/ZUGFeRDService.vb @@ -19,6 +19,7 @@ Public Class ZUGFeRDService Dim oDatabase As String = My.Settings.DB_DATABASE Dim oUser As String = My.Settings.DB_USER Dim oPassword As String = My.Settings.DB_PASSWORD + Dim oJobInterval As Integer = My.Settings.JOB_INTERVAL _logger.Debug("Datasource: {0}", oDataSource) _logger.Debug("Database: {0}", oDatabase) @@ -27,7 +28,7 @@ Public Class ZUGFeRDService Try _threadRunner = New ThreadRunner(_logConfig, _firebird) - _threadRunner.Start() + _threadRunner.Start(oJobInterval) Catch ex As Exception _logger.Error(ex) End Try diff --git a/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb b/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb index a677fa86..05e61741 100644 --- a/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb +++ b/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb @@ -47,6 +47,87 @@ Public Class ImportZUGFeRDFiles _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 @@ -69,49 +150,54 @@ Public Class ImportZUGFeRDFiles Dim oMoveDirectory As String = args.SuccessDirectory Dim oDocument As CrossIndustryDocumentType - Dim oValues As New Dictionary(Of String, String) 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 mapping In args.PropertyMap - Dim propertyValue As String = PropertyValues.GetPropValue(oDocument, mapping.Key) - Dim propertyDescripton As String = mapping.Value.Description + 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 - ' TODO: Check for missing values If String.IsNullOrEmpty(propertyValue) Then - _logger.Warn("Property {0} is empty or not found", propertyDescripton) + 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 - If String.IsNullOrEmpty(propertyValue) And mapping.Value.IsRequired Then - _logger.Error("Property {0} is empty but required!", propertyDescripton) - Throw New ApplicationException($"Property {propertyDescripton} is empty but required!") - End If - - Console.WriteLine("{0} => {1}", propertyDescripton, propertyValue) - oValues.Add(propertyDescripton, propertyValue) - - Dim oTableName = mapping.Value.TableName + Dim oTableName = Item.Value.TableName Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oGuid}', '{propertyDescripton}', '{propertyValue}')" - _logger.Info("Mapping Property {0} to value {1}. Will be inserted into table {2}", propertyDescripton, propertyValue, oTableName) + _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 - _logger.Error(ex, "File {0} was not processesd. Transaction rolled back.") + + 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 @@ -121,8 +207,4 @@ Public Class ImportZUGFeRDFiles _logger.Info("Finished processing directory {0}", oPath) Next End Sub - - - - End Class