AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ImportZUGFeRDFiles: Add Importing of grouped items

Browse Source
This commit is contained in:
Jonathan Jenne 2019-05-10 14:14:13 +02:00
parent ce21ae5dab
commit 15c33b843e
2 changed files with 81 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -255,20 +255,21 @@ Public Class ImportZUGFeRDFiles
_logger.Warn("File is not a valid ZUGFeRD document! Skipping.") _logger.Warn("File is not a valid ZUGFeRD document! Skipping.")
Continue For Continue For
End Try End Try
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 UPPER(MD5HASH) = UPPER('{oMD5CheckSum}')" Dim oCheckCommand = $"SELECT * 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)
If Not IsNothing(oMD5DT) Then If Not IsNothing(oMD5DT) Then
If oMD5DT.Rows.Count = 1 Then If oMD5DT.Rows.Count = 1 Then
'Hier muss noch gepüft werden ob die Rechnung schon mal abgelehnt wurde?! 'TODO: Hier muss noch gepüft werden ob die Rechnung schon mal abgelehnt wurde?!
Throw New MD5HashException() Throw New MD5HashException()
End If End If
Else Else
_logger.Info("Be careful: oExistsDT is nothing!") _logger.Warn("Be careful: oExistsDT is nothing!")
End If End If
Else Else
_logger.Info("Be careful: oMD5CheckSum is nothing!") _logger.Warn("Be careful: oMD5CheckSum is nothing!")
End If End If
' Check if there are more than one ZUGFeRD files ' Check if there are more than one ZUGFeRD files
@ -296,34 +297,81 @@ Public Class ImportZUGFeRDFiles
' Iterate through groups to get group scope and group items ' Iterate through groups to get group scope and group items
For Each oGroup In oGroupedProperties For Each oGroup In oGroupedProperties
Dim oGroupScope = oGroup.Key Dim oGroupScope = oGroup.Key
Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object))
Dim oRowCount = 0
' get properties as a nested object, see `oPropertyList`
For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup
' TODO: Fetching duplicate props works, Dim oPropertyValues As List(Of Object) = PropertyValues.GetPropValues(oDocument, oProperty.Key)
' now create the Pos Line array with all props of a line/group
Dim oPropertyValues As List(Of Object) = PropertyValues.GetPropValue(oDocument, oProperty.Key)
Console.Write("") 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
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 oPropertyValue = oColumn.Value.Item(oRowIndex)
Dim oRowCounter = oRowIndex + 1
If String.IsNullOrEmpty(oPropertyValue) Then
If oColumn.Key.IsRequired Then
_logger.Warn("Property {0} is empty or not found. Continuing with Empty String.", oPropertyDescription)
oMissingProperties.Add(oPropertyDescription)
Else
_logger.Warn("Property {0} is empty or not found. Continuing with Empty String.", oPropertyDescription)
End If
oPropertyDescription = String.Empty
End If
Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oFileGroupId}', '{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 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
Next Next
Next Next
' Iterate through default properties
For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties
Dim propertyValue As String = PropertyValues.GetPropValue(oDocument, Item.Key) Dim oPropertyValue As String = PropertyValues.GetPropValue(oDocument, Item.Key)
Dim propertyDescripton As String = Item.Value.Description Dim oPropertyDescription As String = Item.Value.Description
If String.IsNullOrEmpty(propertyValue) Then If String.IsNullOrEmpty(oPropertyValue) Then
If Item.Value.IsRequired Then If Item.Value.IsRequired Then
_logger.Warn("Property {0} is empty but marked as required! Skipping.", propertyDescripton) _logger.Warn("Property {0} is empty but marked as required! Skipping.", oPropertyDescription)
oMissingProperties.Add(propertyDescripton) oMissingProperties.Add(oPropertyDescription)
Continue For Continue For
Else Else
_logger.Debug("Property {0} is empty or not found. Skipping.", propertyDescripton) _logger.Debug("Property {0} is empty or not found. Skipping.", oPropertyDescription)
Continue For Continue For
End If End If
End If End If
Dim oTableName = Item.Value.TableName Dim oTableName = Item.Value.TableName
Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{propertyDescripton}', '{propertyValue}')" Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{oPropertyDescription}', '{oPropertyValue}')"
_logger.Debug("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}", oPropertyDescription, oPropertyValue, oTableName)
' Insert into SQL Server ' Insert into SQL Server
If args.InsertIntoSQLServer = True Then If args.InsertIntoSQLServer = True Then
@ -361,7 +409,7 @@ Public Class ImportZUGFeRDFiles
oMoveDirectory = args.ErrorDirectory oMoveDirectory = args.ErrorDirectory
Dim oBody = "<p>The invoice attached to Your email has already been worked in our system.</p>" Dim oBody = "<p>The invoice attached to your email has already been processed in our system.</p>"
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId) Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData) AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As TooMuchFerdsException Catch ex As TooMuchFerdsException
@ -417,7 +465,6 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Sub End Sub
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
Dim oBody = $"<p>The following file is not ZUGFeRD-compliant: {OriginalFilename}</p>" Dim oBody = $"<p>The following file is not ZUGFeRD-compliant: {OriginalFilename}</p>"

23
Jobs/EDMI/ZUGFeRD/PropertyValues.vb
View File

@ -7,10 +7,17 @@ Public Class PropertyValues
Private Shared _indexRegex As New Regex(_indexPattern) Private Shared _indexRegex As New Regex(_indexPattern)
Public Shared Function GetPropValues(Obj As Object, PropertyName As String) Public Shared Function GetPropValues(Obj As Object, PropertyName As String)
Dim oResult As Object = GetPropValue(Obj, PropertyName)
' Wrap the result of `GetPropValue` in a list if a single Value is returned
If TypeOf oResult Is List(Of Object) Then
Return oResult
Else
Return New List(Of Object) From {oResult}
End If
End Function End Function
Public Shared Function GetPropValue(Obj As Object, PropertyName As String, Optional ReturnWhenEmpty As Boolean = True) Public Shared Function GetPropValue(Obj As Object, PropertyName As String)
Dim oNameParts As String() = PropertyName.Split("."c) Dim oNameParts As String() = PropertyName.Split("."c)
If IsNothing(Obj) Then If IsNothing(Obj) Then
@ -49,14 +56,18 @@ Public Class PropertyValues
End If End If
If IsArray(Obj) And Not oHasIndex Then If IsArray(Obj) And Not oHasIndex Then
Dim oCurrentPart = oPart Dim oCurrentPart As String = oPart
Dim oPathFragment = PropertyName. Dim oSplitString As String() = New String() {"." & oCurrentPart & "."}
Split(New String() {"." & oCurrentPart & "."}, StringSplitOptions.None) Dim oPathFragments = PropertyName.Split(oSplitString, StringSplitOptions.None)
Dim oResults As New List(Of Object) Dim oResults As New List(Of Object)
' if path has no more subitems, return an empty list
If oPathFragments.Length = 1 Then
Return oResults
End If
For Each oArrayItem In Obj For Each oArrayItem In Obj
Dim oResult = GetPropValue(oArrayItem, oPathFragment(1), ReturnWhenEmpty:=False) Dim oResult = GetPropValue(oArrayItem, oPathFragments(1))
If Not IsNothing(oResult) Then If Not IsNothing(oResult) Then
oResults.Add(oResult) oResults.Add(oResult)