Jobs: Actually rollback firebird transaction, separately log outofmemory exception, make error directory the default to avoid sending rejected documents to success directory
This commit is contained in:
Jonathan Jenne
parent
fc4cead01f
commit
bc33eaaecd
@ -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()
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user