mirror of
https://github.com/KeymonSoft/jRDC-MultiDB-Hikari.git
synced 2026-04-17 21:06:23 +00:00
347 lines
13 KiB
QBasic
347 lines
13 KiB
QBasic
B4J=true
|
|
Group=Default Group
|
|
ModulesStructureVersion=1
|
|
Type=Class
|
|
Version=6.01
|
|
@EndOfDesignText@
|
|
'Class module
|
|
'Author: Oliver Ackermann
|
|
'Created on: 2018/05/07
|
|
'Based on: https://github.com/AnywhereSoftware/B4J_Server/blob/master/src/anywheresoftware/b4j/object/ConnectionPool.java
|
|
'Resources:
|
|
' https://github.com/brettwooldridge/HikariCP
|
|
' addDataSourceProperty - individual driver property
|
|
' setDataSourceProperties - Java Property values
|
|
|
|
Sub Class_Globals
|
|
Private poolJO As JavaObject
|
|
Private poolProperties As Map
|
|
Private PoolSizeConfig As Int
|
|
Private MinIdleConfig As Int
|
|
Private MaxLifeConfig As Long
|
|
Private ConnTimeoutConfig As Long
|
|
Private LeakDetectionThresholdConfig As Long
|
|
Private KeepAliveTimeConfig As Long
|
|
End Sub
|
|
|
|
Public Sub Initialize
|
|
Dim properties As Map
|
|
properties.Initialize
|
|
'
|
|
'Frequently used
|
|
properties.Put("autocommit", "boolean")
|
|
properties.Put("connectiontimeout", "int")
|
|
properties.Put("idletimeout", "int")
|
|
properties.Put("maxlifetime", "int")
|
|
properties.Put("connectiontestquery", "string")
|
|
properties.Put("minimumidle", "int")
|
|
properties.Put("maximumpoolsize", "int")
|
|
properties.Put("poolname", "string")
|
|
properties.Put("keepalivetime", "int")
|
|
|
|
'Infrequently used
|
|
properties.Put("initializationfailtimeout", "int")
|
|
properties.Put("isolateinternalqueries", "boolean")
|
|
properties.Put("allowpoolsuspension", "boolean")
|
|
properties.Put("readonly", "boolean")
|
|
properties.Put("registermbeans", "boolean")
|
|
properties.Put("connectioninitsql", "string")
|
|
properties.Put("validationtimeout", "int")
|
|
properties.Put("leakdetectionthreshold", "int")
|
|
|
|
poolProperties = properties
|
|
End Sub
|
|
|
|
'Creates the pool.
|
|
' driverClass - The JDBC driver class.
|
|
' jdbcUrl - JDBC connection url.
|
|
' aUser / aPassword - Connection credentials.
|
|
Public Sub CreatePool(driverClass As String, jdbcUrl As String, aUser As String, aPassword As String)
|
|
CreatePool2(driverClass, jdbcUrl, aUser, aPassword, 0)
|
|
End Sub
|
|
|
|
'Creates the pool.
|
|
' driverClass - The JDBC driver class.
|
|
' jdbcUrl - JDBC connection url.
|
|
' aUser / aPassword - Connection credentials.
|
|
' poolSize - Maximum size of connection pool. Pool's default used when < 1.
|
|
Public Sub CreatePool2(driverClass As String, jdbcUrl As String, aUser As String, aPassword As String, poolSize As Int)
|
|
Dim jo As JavaObject
|
|
poolJO = jo.InitializeNewInstance("com.zaxxer.hikari.HikariDataSource", Null)
|
|
poolJO.RunMethod("setDriverClassName",Array As Object(driverClass))
|
|
poolJO.RunMethod("setJdbcUrl", Array As Object(jdbcUrl))
|
|
poolJO.RunMethod("setUsername", Array As Object(aUser))
|
|
poolJO.RunMethod("setPassword", Array As Object(aPassword))
|
|
If poolSize > 0 Then poolJO.RunMethod("setMaximumPoolSize", Array As Object(poolSize))
|
|
|
|
End Sub
|
|
|
|
Public Sub CreatePool3(options As Map)
|
|
CreatePool2(options.Get("driver"), options.Get("url"), options.Get("user"), options.Get("password"), options.Get("poolsize"))
|
|
End Sub
|
|
|
|
'https://github.com/openbouquet/HikariCP/blob/master/src/main/java/com/zaxxer/hikari/HikariConfig.java
|
|
'HikariConfig can use Properties object. But this must be done before creating the pool. The pool than is created using
|
|
'that HikariConfig object.
|
|
Public Sub SetProperties(properties As Map)
|
|
|
|
' Valores óptimos por defecto para HikariCP (en milisegundos)
|
|
Private const DEFAULT_MAX_LIFE As Long = 1750000
|
|
Private const DEFAULT_CONN_TIMEOUT As Long = 30000
|
|
Private const DEFAULT_LEAK_THR As Long = 35000
|
|
Private const DEFAULT_REG_MBEANS As Boolean = True
|
|
Private const DEFAULT_MIN_IDLE As Int = 10
|
|
Private const DEFAULT_MAX_SIZE As Int = 10
|
|
Private const DEFAULT_KEEP_ALIVE_TIME As Long = 300000
|
|
|
|
Dim rawValue As String
|
|
Dim processedKeys As List
|
|
processedKeys.Initialize
|
|
|
|
Dim maxSize As Int ' Variable temporal para el tamaño máximo calculado
|
|
|
|
' --- INICIO: Procesamiento de Propiedades Críticas ---
|
|
|
|
' 1. MaxLifetime (Long) - Clave: maxlifetime
|
|
Dim maxLife As Long
|
|
If properties.ContainsKey("maxlifetime") Then
|
|
rawValue = properties.Get("maxlifetime").As(String).Trim
|
|
maxLife = rawValue
|
|
poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife))
|
|
Log($"Ponemos (LONG, Config): MaxLifetime, ${maxLife}"$)
|
|
Else
|
|
maxLife = DEFAULT_MAX_LIFE
|
|
poolJO.RunMethod("setMaxLifetime", Array As Object(maxLife))
|
|
Log($"Ponemos (LONG, Default): MaxLifetime, ${DEFAULT_MAX_LIFE}"$)
|
|
End If
|
|
processedKeys.Add("maxlifetime")
|
|
MaxLifeConfig = maxLife ' <-- ALMACENAMIENTO CRÍTICO
|
|
|
|
' 2. ConnectionTimeout (Long) - Clave: connectiontimeout
|
|
Dim connTimeout As Long
|
|
If properties.ContainsKey("connectiontimeout") Then
|
|
rawValue = properties.Get("connectiontimeout").As(String).Trim
|
|
connTimeout = rawValue
|
|
poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout))
|
|
Log($"Ponemos (LONG, Config): ConnectionTimeout, ${connTimeout}"$)
|
|
Else
|
|
connTimeout = DEFAULT_CONN_TIMEOUT
|
|
poolJO.RunMethod("setConnectionTimeout", Array As Object(connTimeout))
|
|
Log($"Ponemos (LONG, Default): ConnectionTimeout, ${DEFAULT_CONN_TIMEOUT}"$)
|
|
End If
|
|
processedKeys.Add("connectiontimeout")
|
|
ConnTimeoutConfig = connTimeout ' <-- ALMACENAMIENTO CRÍTICO
|
|
|
|
' 3. LeakDetectionThreshold (Long) - Clave: leakdetectionthreshold
|
|
Dim leakThr As Long
|
|
If properties.ContainsKey("leakdetectionthreshold") Then
|
|
rawValue = properties.Get("leakdetectionthreshold").As(String).Trim
|
|
leakThr = rawValue
|
|
poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr))
|
|
Log($"Ponemos (LONG, Config): LeakDetectionThreshold, ${leakThr}"$)
|
|
Else
|
|
leakThr = DEFAULT_LEAK_THR
|
|
poolJO.RunMethod("setLeakDetectionThreshold", Array As Object(leakThr))
|
|
Log($"Ponemos (LONG, Default): LeakDetectionThreshold, ${DEFAULT_LEAK_THR}"$)
|
|
End If
|
|
processedKeys.Add("leakdetectionthreshold")
|
|
LeakDetectionThresholdConfig = leakThr ' <-- ALMACENAMIENTO CRÍTICO
|
|
|
|
|
|
' ********** LÓGICA DE FIXED POOL: MaximumPoolSize primero **********
|
|
|
|
' 4. MaximumPoolSize (Int) - Clave: maximumpoolsize
|
|
If properties.ContainsKey("maximumpoolsize") Then
|
|
rawValue = properties.Get("maximumpoolsize").As(String).Trim
|
|
maxSize = rawValue.As(Int)
|
|
poolJO.RunMethod("setMaximumPoolSize", Array As Object(maxSize))
|
|
Log($"Ponemos (INT, Config): MaximumPoolSize, ${maxSize}"$)
|
|
Else
|
|
maxSize = DEFAULT_MAX_SIZE
|
|
poolJO.RunMethod("setMaximumPoolSize", Array As Object(DEFAULT_MAX_SIZE))
|
|
Log($"Ponemos (INT, Default): MaximumPoolSize, ${DEFAULT_MAX_SIZE}"$)
|
|
End If
|
|
processedKeys.Add("maximumpoolsize")
|
|
PoolSizeConfig = maxSize ' <-- ALMACENAMIENTO CRÍTICO
|
|
|
|
' 5. MinimumIdle (Int) - Clave: minimumidle
|
|
Dim minIdleFinal As Int
|
|
If properties.ContainsKey("minimumidle") Then
|
|
rawValue = properties.Get("minimumidle").As(String).Trim
|
|
minIdleFinal = rawValue.As(Int)
|
|
poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal))
|
|
Log($"Ponemos (INT, Config): MinimumIdle, ${minIdleFinal}"$)
|
|
Else
|
|
' APLICAMOS EL FIXED POOL AXIOM: MinimumIdle = MaximumPoolSize (maxSize)
|
|
minIdleFinal = maxSize
|
|
poolJO.RunMethod("setMinimumIdle", Array As Object(minIdleFinal))
|
|
Log($"Ponemos (INT, Fixed Default): MinimumIdle, ${minIdleFinal} (Igual a MaximumPoolSize)"$)
|
|
End If
|
|
processedKeys.Add("minimumidle")
|
|
MinIdleConfig = minIdleFinal ' <-- ALMACENAMIENTO CRÍTICO
|
|
|
|
' ********** FIN DE LA LÓGICA DE FIXED POOL **********
|
|
|
|
' 6. RegisterMbeans (Boolean) - Clave: registermbeans
|
|
If properties.ContainsKey("registermbeans") Then
|
|
Dim regMbeans As Boolean = properties.Get("registermbeans")
|
|
poolJO.RunMethod("setRegisterMbeans", Array As Object(regMbeans))
|
|
Log($"Ponemos (BOOL, Config): RegisterMbeans, ${regMbeans}"$)
|
|
Else
|
|
poolJO.RunMethod("setRegisterMbeans", Array As Object(DEFAULT_REG_MBEANS))
|
|
Log($"Ponemos (BOOL, Default): RegisterMbeans, ${DEFAULT_REG_MBEANS}"$)
|
|
End If
|
|
processedKeys.Add("registermbeans")
|
|
|
|
' 7. KeepaliveTime (Long) - Clave: keepalivetime
|
|
Dim keepAlive As Long
|
|
If properties.ContainsKey("keepalivetime") Then
|
|
rawValue = properties.Get("keepalivetime").As(String).Trim
|
|
keepAlive = rawValue
|
|
' El valor mínimo aceptado es 30,000 ms [4].
|
|
If keepAlive < 30000 Then keepAlive = 30000
|
|
|
|
poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive))
|
|
Log($"Ponemos (LONG, Config): KeepaliveTime, ${keepAlive}"$)
|
|
Else
|
|
keepAlive = DEFAULT_KEEP_ALIVE_TIME
|
|
poolJO.RunMethod("setKeepaliveTime", Array As Object(keepAlive))
|
|
Log($"Ponemos (LONG, Default): KeepaliveTime, ${DEFAULT_KEEP_ALIVE_TIME} (50 minutos)"$)
|
|
End If
|
|
processedKeys.Add("keepalivetime")
|
|
KeepAliveTimeConfig = keepAlive ' <-- ALMACENAMIENTO CRÍTICO
|
|
|
|
' --- INICIO: PROCESAMIENTO DE PROPIEDADES RESTANTES ---
|
|
' ... (El resto del código de procesamiento de propiedades restantes se mantiene igual)
|
|
Dim intValue As Int
|
|
Dim booleanValue As Boolean
|
|
Dim variableType As String
|
|
For Each k As String In properties.Keys
|
|
If processedKeys.IndexOf(k) = -1 Then
|
|
If poolProperties.ContainsKey(k) Then
|
|
variableType = poolProperties.Get(k)
|
|
Dim valueToUse As String = properties.Get(k)
|
|
If variableType = "string" Then
|
|
valueToUse = valueToUse.Trim
|
|
End If
|
|
|
|
Dim dynamicMethodName As String = $"set${k}"$
|
|
Try
|
|
If variableType = "int" Then
|
|
intValue = valueToUse
|
|
poolJO.RunMethod(dynamicMethodName, Array As Object(intValue))
|
|
Else If variableType = "string" Then
|
|
poolJO.RunMethod(dynamicMethodName, Array As Object(valueToUse))
|
|
Else If variableType = "boolean" Then
|
|
booleanValue = valueToUse
|
|
GetPoolJO.RunMethod(dynamicMethodName, Array As Object(booleanValue))
|
|
Else
|
|
Log($"Connection pool property ${k} has unsupported variable type of ${variableType}"$)
|
|
End If
|
|
Log($"Ponemos (Restante): ${k}, ${properties.Get(k)}"$)
|
|
Catch
|
|
Log($"Warning (Restante): Method: ${dynamicMethodName} not matched or type mismatch for property ${k}. Error: ${LastException.Message}"$)
|
|
End Try
|
|
Else
|
|
Log($"Warning: Property ${k} not supported"$)
|
|
End If
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
' // ---------------------------------------------------------------------------------------------------------------------------------------------------
|
|
' // NUEVA SUBRUTINA: Aplica propiedades específicas del Driver JDBC (Ej: MySQL caching)
|
|
' // Estas propiedades se aplican usando addDataSourceProperty, que no se soporta en SetProperties estándar.
|
|
' // ---------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
Public Sub SetDriverProperties(properties As Map)
|
|
' properties es el mapa que RDCConnector.LoadDriverProperties extrae (ej: driver.mysql.*).
|
|
Dim value As Object
|
|
For Each k As String In properties.Keys
|
|
value = properties.Get(k)
|
|
' CRÍTICO: Usar addDataSourceProperty para configurar el Driver, no el Pool.
|
|
poolJO.RunMethod("addDataSourceProperty", Array As Object(k, value))
|
|
Log($"HikariCP: Driver Property [${k}] added with value: ${value}"$)
|
|
Next
|
|
End Sub
|
|
|
|
|
|
'Check if JDBC URL is supported
|
|
Public Sub SupportUrl(jdbcUrl As String) As Boolean
|
|
If jdbcUrl.StartsWith("jdbc:sqlite") Then
|
|
Log("Error: Hikari connection pool does not support SQLite")
|
|
Return False
|
|
End If
|
|
Return True
|
|
End Sub
|
|
|
|
'See if pool's java object supports standard getConnection method
|
|
Public Sub IsStandardConnection As Boolean
|
|
Return True
|
|
End Sub
|
|
|
|
'Get pool's underlying java object. Used if IsStandardConnection is True
|
|
Public Sub GetPoolJO As JavaObject
|
|
Return poolJO
|
|
End Sub
|
|
|
|
'Retrieves a connection from the pool. Make sure to close the connection when you are done with it.
|
|
Public Sub GetConnection As SQL
|
|
Dim newSQL As SQL
|
|
Dim jo As JavaObject = newSQL
|
|
jo.SetField("connection", poolJO.RunMethod("getConnection", Null))
|
|
Return newSQL
|
|
End Sub
|
|
|
|
'Closes all unused pooled connections.
|
|
Public Sub ClosePool
|
|
If poolJO.IsInitialized Then
|
|
poolJO.RunMethod("close", Null)
|
|
End If
|
|
End Sub
|
|
|
|
|
|
' ** ADVERTENCIA: Esta subrutina traduce los nombres de métodos internos de HikariCP
|
|
' ** a las claves genéricas (ej. BusyConnections) que RDCConnector espera.
|
|
' ** CRÍTICO: Ahora incluye la CONFIGURACIÓN ESTÁTICA guardada en las variables de clase.
|
|
Public Sub GetStats As Map
|
|
Dim stats As Map
|
|
stats.Initialize
|
|
|
|
' 1. AGREGAR PROPIEDADES ESTÁTICAS (CONFIGURACIÓN ALMACENADA)
|
|
stats.Put("MaxPoolSize", PoolSizeConfig)
|
|
stats.Put("MinPoolSize", MinIdleConfig)
|
|
stats.Put("MaxLifetime", MaxLifeConfig)
|
|
stats.Put("ConnectionTimeout", ConnTimeoutConfig)
|
|
stats.Put("LeakDetectionThreshold", LeakDetectionThresholdConfig)
|
|
stats.Put("KeepaliveTime", KeepAliveTimeConfig)
|
|
' Nota: Aquí puedes agregar las propiedades estáticas adicionales que sean relevantes.
|
|
|
|
' 2. OBTENER MÉTRICAS DE TIEMPO DE EJECUCIÓN (JMX/MBean)
|
|
If poolJO.IsInitialized Then
|
|
Try
|
|
Dim poolMBean As JavaObject = poolJO.RunMethod("getHikariPoolMXBean", Null)
|
|
|
|
Dim busyConn As Object = poolMBean.RunMethod("getActiveConnections", Null)
|
|
stats.Put("BusyConnections", busyConn)
|
|
|
|
Dim idleConn As Object = poolMBean.RunMethod("getIdleConnections", Null)
|
|
stats.Put("IdleConnections", idleConn)
|
|
|
|
Dim activeCount As Int = busyConn
|
|
Dim idleCount As Int = idleConn
|
|
stats.Put("TotalConnections", activeCount + idleCount)
|
|
|
|
Dim awaitingConn As Object = poolMBean.RunMethod("getThreadsAwaitingConnection", Null)
|
|
stats.Put("ThreadsAwaitingConnection", awaitingConn)
|
|
Catch
|
|
Dim ErrorMsg As String = "HikariCP.GetStats: Error al obtener métricas dinámicas del MBean: " & LastException.Message
|
|
Log(ErrorMsg)
|
|
stats.Put("Error_Runtime", ErrorMsg)
|
|
End Try
|
|
Else
|
|
stats.Put("Error", "Pool JO no inicializado")
|
|
End If
|
|
|
|
Return stats
|
|
End Sub |