From bc33eaaecdab145f957d65599603ce6579256c9c Mon Sep 17 00:00:00 2001 From: Jonathan Jenne Date: Thu, 19 Nov 2020 14:29:12 +0100 Subject: [PATCH] Jobs: Actually rollback firebird transaction, separately log outofmemory exception, make error directory the default to avoid sending rejected documents to success directory --- .../EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb | 211 +++--------------- 1 file changed, 34 insertions(+), 177 deletions(-) diff --git a/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb b/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb index 04e3b4dd..74bb152d 100644 --- a/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb +++ b/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb @@ -112,7 +112,7 @@ Public Class ImportZUGFeRDFiles Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String) Try 'PRCUST_ADD_HISTORY_STATE: @MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250) - Dim oSQL = $"EXEC PRCUST_ADD_HISTORY_STATE '{oMessageID}','{oTitle}','{oTitle1}','{oComment}'" + Dim oSQL = $"EXEC PRCUST_ADD_HISTORY_STATE '{oMessageID}','{oTitle}','{oTitle1}','{oComment.Replace("'", "''")}'" _mssql.ExecuteNonQuery(oSQL) Catch ex As Exception _logger.Error(ex) @@ -162,7 +162,7 @@ Public Class ImportZUGFeRDFiles ' Count the amount of ZUGFeRD files Dim oZUGFeRDCount As Integer = 0 ' Set the default Move Directory - Dim oMoveDirectory As String = oArgs.SuccessDirectory + Dim oMoveDirectory As String = oArgs.ErrorDirectory ' Flag to save if the whole process was a success. ' Will be set only at the end of the function if no error occurred. Dim oIsSuccess As Boolean = False @@ -229,7 +229,7 @@ Public Class ImportZUGFeRDFiles oMD5CheckSum = CreateMD5(oFile.FullName) If oMD5CheckSum <> String.Empty Then Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE GUID = (SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))" - Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction) + Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction, oTransaction) If Not IsNothing(oMD5DT) Then If oMD5DT.Rows.Count = 1 Then Dim oRejected As Boolean @@ -260,174 +260,7 @@ Public Class ImportZUGFeRDFiles ' Since extraction went well, increase the amount of ZUGFeRD files oZUGFeRDCount += 1 -#Region "Check Property Values" - ' --- BEGIN Check Property Values - - '' PropertyMap items with `IsGrouped = False` are handled normally - 'Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = oArgs.PropertyMap. - ' Where(Function(Item) Item.Value.IsGrouped = True). - ' ToDictionary(Function(Item) Item.Key, - ' Function(Item) Item.Value) - - '_logger.Debug("Found {0} default properties.", oDefaultProperties.Count) - - '' PropertyMap items with `IsGrouped = True` are grouped by group scope - 'Dim oGroupedProperties = oArgs.PropertyMap. - ' Where(Function(Item) Item.Value.IsGrouped = True). - ' ToLookup(Function(Item) Item.Value.GroupScope, ' Lookup key is group scope - ' Function(Item) Item) - - '_logger.Debug("Found {0} properties grouped in {1} group(s)", oArgs.PropertyMap.Count - oDefaultProperties.Count, oGroupedProperties.Count) - '' Iterate through groups to get group scope and group items - 'For Each oGroup In oGroupedProperties - ' Dim oGroupScope As String = oGroup.Key - ' Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object)) - ' Dim oRowCount = 0 - - ' _logger.Debug("Fetching Property values for group {0}.", oGroupScope) - - ' ' get properties as a nested object, see `oPropertyList` - ' For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup - ' Dim oPropertyValues As List(Of Object) - - ' Try - ' oPropertyValues = oPropertyExtractor.GetPropValue(oDocument, oProperty.Key) - ' Catch ex As Exception - ' _logger.Warn("Unknown error occurred while fetching property [{0}] in group [{1}]:", oProperty.Value.Description, oGroupScope) - ' _logger.Error(ex) - ' oPropertyValues = New List(Of Object) - ' End Try - - ' ' Flatten result value - ' oPropertyValues = oPropertyExtractor.GetFinalPropValue(oPropertyValues) - - ' ' Add to list - ' oPropertyList.Add(oProperty.Value, oPropertyValues) - - ' ' check the first batch of values to determine the row count - ' If oRowCount = 0 Then - ' oRowCount = oPropertyValues.Count - ' End If - ' Next - - ' ' Structure of oPropertyList - ' ' [ # Propertyname # Row 1 # Row 2 - ' ' PositionsMenge: [BilledQuantity1, BilledQuantity2, ...], - ' ' PositionsSteuersatz: [ApplicablePercent1, ApplicablePercent2, ...], - ' ' ... - ' ' ] - ' For oRowIndex = 0 To oRowCount - 1 - ' _logger.Debug("Processing row {0}", oRowIndex) - - ' For Each oColumn As KeyValuePair(Of XmlItemProperty, List(Of Object)) In oPropertyList - ' Dim oTableName As String = oColumn.Key.TableName - ' Dim oPropertyDescription As String = oColumn.Key.Description - ' Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1 - - ' ' Returns nothing if oColumn.Value contains an empty list - ' Dim oPropertyValue = oColumn.Value.ElementAtOrDefault(oRowIndex) - - ' _logger.Debug("Processing property {0}.", oPropertyDescription) - - ' If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then - ' If oColumn.Key.IsRequired Then - ' _logger.Warn("Property [{0}] is empty or not found but is required. Continuing with Empty String.", oPropertyDescription) - ' oMissingProperties.Add(oPropertyDescription) - ' Else - ' _logger.Debug("Property [{0}] is empty or not found. Continuing with Empty String.", oPropertyDescription) - ' End If - - ' oPropertyValue = String.Empty - ' End If - - ' _logger.Debug("Property {0} has value '{1}'", oPropertyDescription, oPropertyValue) - - ' Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oMessageId}', '{oPropertyDescription}', '{oPropertyValue}', {oRowCounter})" - ' _logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2} with RowCounter {3}", oPropertyDescription, oPropertyValue, oTableName, oRowCounter) - - ' ' Insert into SQL Server - ' If oArgs.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 - ' Next - - ' oGlobalGroupCounter += oRowCount - 'Next - - '' Iterate through default properties - 'For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties - ' Dim oPropertyValueList As List(Of Object) - ' Dim oPropertyDescription As String = Item.Value.Description - ' Dim oPropertyValue As Object = Nothing - - ' Try - ' oPropertyValueList = oPropertyExtractor.GetPropValue(oDocument, Item.Key) - ' Catch ex As Exception - ' _logger.Warn("Unknown error occurred while fetching property {0} in group {1}:", oPropertyDescription, Item.Value.GroupScope) - ' _logger.Error(ex) - ' oPropertyValueList = New List(Of Object) - ' End Try - - ' Try - ' If IsNothing(oPropertyValueList) Then - ' oPropertyValue = Nothing - ' ElseIf TypeOf oPropertyValueList Is List(Of Object) Then - ' Select Case oPropertyValueList.Count - ' Case 0 - ' oPropertyValue = Nothing - ' Case Else - ' Dim oList As List(Of Object) = DirectCast(oPropertyValueList, List(Of Object)) - ' oPropertyValue = oList.Item(0) - - ' ' This should hopefully show config errors - ' If TypeOf oPropertyValue Is List(Of Object) Then - ' _logger.Warn("Property with Description {0} may be configured incorrectly", oPropertyDescription) - ' oPropertyValue = Nothing - ' End If - ' End Select - ' End If - ' Catch ex As Exception - ' _logger.Warn("Unknown error occurred while processing property {0}:", oPropertyDescription) - ' _logger.Error(ex) - ' oPropertyValue = Nothing - ' End Try - - ' If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then - ' If Item.Value.IsRequired Then - ' _logger.Warn("Property {0} is empty but marked as required! Skipping.", oPropertyDescription) - ' oMissingProperties.Add(oPropertyDescription) - ' Continue For - ' Else - ' _logger.Debug("Property [{0}] is empty or not found. Skipping.", oPropertyDescription) - ' Continue For - ' End If - ' End If - - ' Dim oTableName = Item.Value.TableName - ' Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oMessageId}', '{oPropertyDescription}', '{oPropertyValue}')" - ' _logger.Debug("Mapping Property [{0}] to value [{1}] . Will be inserted into table {2}", oPropertyDescription, oPropertyValue, oTableName) - - ' ' Insert into SQL Server - ' If oArgs.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 - - '--- END Check Property Values -#End Region + ' Check the document against the configured property map and return: ' - a List of valid properties ' - a List of missing properties @@ -440,7 +273,7 @@ Public Class ImportZUGFeRDFiles Dim oStep As String Try oStep = "Firebird TBEDMI_ITEM_VALUE Delete messageID Items" - _firebird.ExecuteNonQueryWithConnection(oDelSQL, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction) + _firebird.ExecuteNonQueryWithConnection(oDelSQL, oConnection, Firebird.TransactionMode.WithTransaction) If oArgs.InsertIntoSQLServer = True Then oStep = "MSSQL TBEDMI_ITEM_VALUE Delete messageID Items" _mssql.ExecuteNonQuery(oDelSQL) @@ -495,10 +328,12 @@ Public Class ImportZUGFeRDFiles End If oIsSuccess = True + oMoveDirectory = oArgs.SuccessDirectory Catch ex As MD5HashException _logger.Error(ex) - oMoveDirectory = oArgs.ErrorDirectory + oTransaction.Rollback() + Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE GUID = '{HISTORY_ID}'" _firebird.ExecuteNonQuery(oSQL) @@ -506,40 +341,47 @@ Public Class ImportZUGFeRDFiles Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId) AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "") + Catch ex As InvalidFerdException _logger.Error(ex) + oTransaction.Rollback() - oMoveDirectory = oArgs.ErrorDirectory Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE GUID = '{HISTORY_ID}'" _firebird.ExecuteNonQuery(oSQL) + Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId) AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "") + Catch ex As TooMuchFerdsException _logger.Error(ex) + oTransaction.Rollback() - oMoveDirectory = oArgs.ErrorDirectory Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE GUID = '{HISTORY_ID}'" _firebird.ExecuteNonQuery(oSQL) + Dim oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId) AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "") + Catch ex As NoFerdsException _logger.Error(ex) + oTransaction.Rollback() - oMoveDirectory = oArgs.ErrorDirectory Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE GUID = '{HISTORY_ID}'" _firebird.ExecuteNonQuery(oSQL) + Dim oBody = EmailStrings.EMAIL_NO_FERDS Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId) AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "") + Catch ex As MissingValueException _logger.Error(ex) + oTransaction.Rollback() - oMoveDirectory = oArgs.ErrorDirectory Dim oMessage As String = "" For Each prop In oMissingProperties oMessage &= $"- {prop}" @@ -552,13 +394,28 @@ Public Class ImportZUGFeRDFiles _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId) AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage) + Catch ex As OutOfMemoryException + _logger.Warn("OutOfMemory Error occurred: {0}", ex.Message) + _logger.Error(ex) + oTransaction.Rollback() + + Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Out of memory' WHERE GUID = '{HISTORY_ID}'" + _firebird.ExecuteNonQuery(oSQL) + + AddRejectedState(oMessageId, "OutOfMemoryException", "", ex.Message) + Catch ex As Exception _logger.Warn("Unknown Error occurred: {0}", ex.Message) _logger.Error(ex) + oTransaction.Rollback() + Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'" _firebird.ExecuteNonQuery(oSQL) + oMoveDirectory = oArgs.ErrorDirectory + AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message) + Finally oConnection.Close()