AppStd/Monorepo
8
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Jobs: Actually rollback firebird transaction, separately log outofmemory exception, make error directory the default to avoid sending rejected documents to success directory

Browse Source
This commit is contained in:
Jonathan Jenne 2020-11-19 14:29:12 +01:00
parent fc4cead01f
commit bc33eaaecd
1 changed files with 33 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

209
Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -112,7 +112,7 @@ Public Class ImportZUGFeRDFiles
Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String) Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String)
Try Try
'PRCUST_ADD_HISTORY_STATE: @MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250) '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) _mssql.ExecuteNonQuery(oSQL)
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
@ -162,7 +162,7 @@ Public Class ImportZUGFeRDFiles
' Count the amount of ZUGFeRD files ' Count the amount of ZUGFeRD files
Dim oZUGFeRDCount As Integer = 0 Dim oZUGFeRDCount As Integer = 0
' Set the default Move Directory ' 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. ' Flag to save if the whole process was a success.
' Will be set only at the end of the function if no error occurred. ' Will be set only at the end of the function if no error occurred.
Dim oIsSuccess As Boolean = False Dim oIsSuccess As Boolean = False
@ -229,7 +229,7 @@ Public Class ImportZUGFeRDFiles
oMD5CheckSum = CreateMD5(oFile.FullName) oMD5CheckSum = CreateMD5(oFile.FullName)
If oMD5CheckSum <> String.Empty Then 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 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 Not IsNothing(oMD5DT) Then
If oMD5DT.Rows.Count = 1 Then If oMD5DT.Rows.Count = 1 Then
Dim oRejected As Boolean Dim oRejected As Boolean
@ -260,174 +260,7 @@ Public Class ImportZUGFeRDFiles
' Since extraction went well, increase the amount of ZUGFeRD files ' Since extraction went well, increase the amount of ZUGFeRD files
oZUGFeRDCount += 1 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: ' Check the document against the configured property map and return:
' - a List of valid properties ' - a List of valid properties
' - a List of missing properties ' - a List of missing properties
@ -440,7 +273,7 @@ Public Class ImportZUGFeRDFiles
Dim oStep As String Dim oStep As String
Try Try
oStep = "Firebird TBEDMI_ITEM_VALUE Delete messageID Items" 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 If oArgs.InsertIntoSQLServer = True Then
oStep = "MSSQL TBEDMI_ITEM_VALUE Delete messageID Items" oStep = "MSSQL TBEDMI_ITEM_VALUE Delete messageID Items"
_mssql.ExecuteNonQuery(oDelSQL) _mssql.ExecuteNonQuery(oDelSQL)
@ -495,10 +328,12 @@ Public Class ImportZUGFeRDFiles
End If End If
oIsSuccess = True oIsSuccess = True
oMoveDirectory = oArgs.SuccessDirectory
Catch ex As MD5HashException Catch ex As MD5HashException
_logger.Error(ex) _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}'" Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL) _firebird.ExecuteNonQuery(oSQL)
@ -506,40 +341,47 @@ Public Class ImportZUGFeRDFiles
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId)
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "") AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "")
Catch ex As InvalidFerdException Catch ex As InvalidFerdException
_logger.Error(ex) _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}'" Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL) _firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId)
AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "") AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "")
Catch ex As TooMuchFerdsException Catch ex As TooMuchFerdsException
_logger.Error(ex) _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}'" Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL) _firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS Dim oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId)
AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "") AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "")
Catch ex As NoFerdsException Catch ex As NoFerdsException
_logger.Error(ex) _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}'" Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL) _firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_NO_FERDS Dim oBody = EmailStrings.EMAIL_NO_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId)
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "") AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "")
Catch ex As MissingValueException Catch ex As MissingValueException
_logger.Error(ex) _logger.Error(ex)
oTransaction.Rollback()
oMoveDirectory = oArgs.ErrorDirectory
Dim oMessage As String = "" Dim oMessage As String = ""
For Each prop In oMissingProperties For Each prop In oMissingProperties
oMessage &= $"- {prop}" oMessage &= $"- {prop}"
@ -552,13 +394,28 @@ Public Class ImportZUGFeRDFiles
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId)
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage) 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 Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message) _logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex) _logger.Error(ex)
oTransaction.Rollback()
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'" Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL) _firebird.ExecuteNonQuery(oSQL)
oMoveDirectory = oArgs.ErrorDirectory oMoveDirectory = oArgs.ErrorDirectory
AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message) AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message)
Finally Finally
oConnection.Close() oConnection.Close()