This commit is contained in:
Jonathan Jenne 2018-12-18 17:32:51 +01:00
parent d33624c66c
commit 56fcedc309
6 changed files with 143 additions and 44 deletions

View File

@ -14,7 +14,7 @@
<value>DDZUGFeRDService</value>
</setting>
<setting name="SERVICE_DISPLAY_NAME" serializeAs="String">
<value>Digital Data ZUGFeRD Service</value>
<value>DD ZUGFeRD Service</value>
</setting>
<setting name="DB_DATASOURCE" serializeAs="String">
<value>172.24.12.41</value>
@ -28,6 +28,9 @@
<setting name="DB_PASSWORD" serializeAs="String">
<value>dd</value>
</setting>
<setting name="JOB_INTERVAL" serializeAs="String">
<value>10</value>
</setting>
</DDZUGFeRDService.My.MySettings>
</applicationSettings>
</configuration>

View File

@ -65,7 +65,7 @@ Namespace My
<Global.System.Configuration.ApplicationScopedSettingAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Configuration.DefaultSettingValueAttribute("Digital Data ZUGFeRD Service")> _
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
<Global.System.Configuration.ApplicationScopedSettingAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Configuration.DefaultSettingValueAttribute("10")> _
Public ReadOnly Property JOB_INTERVAL() As Integer
Get
Return CType(Me("JOB_INTERVAL"),Integer)
End Get
End Property
End Class
End Namespace

View File

@ -6,7 +6,7 @@
<Value Profile="(Default)">DDZUGFeRDService</Value>
</Setting>
<Setting Name="SERVICE_DISPLAY_NAME" Type="System.String" Scope="Application">
<Value Profile="(Default)">Digital Data ZUGFeRD Service</Value>
<Value Profile="(Default)">DD ZUGFeRD Service</Value>
</Setting>
<Setting Name="DB_DATASOURCE" Type="System.String" Scope="Application">
<Value Profile="(Default)">172.24.12.41</Value>
@ -20,5 +20,8 @@
<Setting Name="DB_PASSWORD" Type="System.String" Scope="Application">
<Value Profile="(Default)">dd</Value>
</Setting>
<Setting Name="JOB_INTERVAL" Type="System.Int32" Scope="Application">
<Value Profile="(Default)">10</Value>
</Setting>
</Settings>
</SettingsFile>

View File

@ -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

View File

@ -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

View File

@ -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 = $"<p>The following file is not ZUGFeRD-compliant: {oOriginalFilename}</p>"
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