diff --git a/src/Runtime/XSharp.SQLRdd/Classes/Command.prg b/src/Runtime/XSharp.SQLRdd/Classes/Command.prg
index 3c589696fb..677694f7b3 100644
--- a/src/Runtime/XSharp.SQLRdd/Classes/Command.prg
+++ b/src/Runtime/XSharp.SQLRdd/Classes/Command.prg
@@ -103,6 +103,7 @@ class SqlDbCommand inherit SqlDbHandleObject implements IDisposable
///
method GetSchemaTable() as DataTable
try
+ self:Connection:ForceOpen()
if ! SELF:_TryBindParameters()
return null
endif
@@ -150,6 +151,7 @@ class SqlDbCommand inherit SqlDbHandleObject implements IDisposable
///
method ExecuteScalar(cTable := "" as string) as object
try
+ self:Connection:ForceOpen()
if String.IsNullOrEmpty(cTable)
cTable := SELF:Name
endif
@@ -176,6 +178,7 @@ class SqlDbCommand inherit SqlDbHandleObject implements IDisposable
///
method ExecuteReader(cTable := "" as string) as DbDataReader
try
+ self:Connection:ForceOpen()
if String.IsNullOrEmpty(cTable)
cTable := SELF:Name
endif
@@ -202,6 +205,7 @@ class SqlDbCommand inherit SqlDbHandleObject implements IDisposable
///
method ExecuteNonQuery(cTable := "" as string) as LOGIC
try
+ self:Connection:ForceOpen()
if String.IsNullOrEmpty(cTable)
cTable := SELF:Name
endif
diff --git a/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg b/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg
index d7f0d349d7..e7bef071a4 100644
--- a/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg
+++ b/src/Runtime/XSharp.SQLRdd/Classes/Connection.prg
@@ -47,6 +47,9 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
private _metadataCollections as List
private _databaseRestrictions as int
private _tableRestrictions as int
+ // Must be kept in a field: a System.Timers.Timer with no other root gets garbage
+ // collected (it stops firing silently), which would disable the periodic stale-lock cleanup.
+ private _lockTimer as System.Timers.Timer
#region Connection Only Properties
/// Dictionary with properties defined by the Ado.Net provider
@@ -74,7 +77,17 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
/// Provider for the Metadata, such as columnlist, maxrecords etc.
property MetadataProvider as ISqlMetadataProvider auto
/// Last exception that occurred in the RDD
- property LastException as Exception auto get internal set
+ property LastException as Exception
+ get
+ return _lastException
+ end get
+ internal set
+ _lastException := value
+ if value != null
+ System.Diagnostics.Trace.WriteLine(String.Format("SqlDbConnection '{0}': {1}", self:Name, value:ToString()))
+ endif
+ end set
+ end property
/// Connection State
PROPERTY State as ConnectionState get iif(self:DbConnection == null, ConnectionState.Closed, self:DbConnection:State)
@@ -264,6 +277,8 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
BufferSize := DEFAULT_BUFFERSIZE
DeletedColumn := DEFAULT_DELETEDCOLUMN
RecnoColumn := DEFAULT_RECNOCOLUMN
+ LockRefreshInterval:= DEFAULT_LOCKREFRESHINTERVAL
+ LockStaleThreshold := DEFAULT_LOCKSTALETHRESHOLD
cConnectionString := self:AnalyzeConnectionString(cConnectionString)
self:ConnectionString := cConnectionString
DbConnection := Provider:CreateConnection()
@@ -284,6 +299,9 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
SELF:_FillDataSourceProperties()
SELF:_CreateLockTable()
SELF:InitializeLockTimer()
+ // Sweep stale locks (e.g. left behind by a crashed/killed previous process) right away,
+ // instead of waiting for the first 120-second timer tick.
+ SELF:LockTimerElapsedEvent(null, null)
// Todo: Check for # of open users and close the connection when no users are left and then throw an exception
return
end constructor
@@ -299,6 +317,11 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
if self:RDDs:Count > 0
return false
endif
+ if _lockTimer != null
+ _lockTimer:Enabled := false
+ _lockTimer:Dispose()
+ _lockTimer := null
+ endif
// Logout the workstation from the Open Connections table
if _command != null
_command:Dispose()
@@ -368,7 +391,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
return false
endif
catch e as Exception
- _lastException := e
+ self:LastException := e
self:DbTransaction := null
end try
return self:DbTransaction != null
@@ -388,7 +411,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
return false
endif
catch e as Exception
- _lastException := e
+ self:LastException := e
self:DbTransaction := null
end try
return self:DbTransaction != null
@@ -447,7 +470,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
_command:CommandText := cCommand
result := _command:ExecuteScalar(cTable)
catch e as Exception
- _lastException := e
+ self:LastException := e
result := null
end try
return result
@@ -465,7 +488,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
_command:CommandText := cCommand
result := _command:ExecuteNonQuery(cTable)
catch e as Exception
- _lastException := e
+ self:LastException := e
result := false
end try
return result
@@ -483,7 +506,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
_command:CommandText := cCommand
result := _command:ExecuteReader(cTable)
catch e as Exception
- _lastException := e
+ self:LastException := e
result := null
end try
return result
@@ -501,7 +524,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
_command:CommandText := cCommand
result := _command:GetDataTable(cTable)
catch e as Exception
- _lastException := e
+ self:LastException := e
result := null
end try
return result
@@ -583,7 +606,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
next
return oTd
catch e as Exception
- _lastException := e
+ self:LastException := e
end try
return null
end method
@@ -613,7 +636,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
self:Schema:Add(TableName, oTd)
return oTd
catch e as Exception
- _lastException := e
+ self:LastException := e
end try
return null
end method
@@ -630,6 +653,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
// DROP TABLE) causes DoesTableExist() to keep reporting a just-dropped table as
// existing, which then skips re-creating it.
try
+ self:ForceOpen()
if !SELF:HasCollection(TABLECOLLECTION)
return false
endif
@@ -650,7 +674,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
next
endif
catch e as Exception
- _lastException := e
+ self:LastException := e
end try
return false
end method
@@ -662,6 +686,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
/// Name of the database to check
method DoesDatabaseExist(cDatabase as string) as logic
try
+ self:ForceOpen()
if !SELF:HasCollection(DATABASECOLLECTION)
return false
endif
@@ -682,7 +707,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
next
endif
catch e as Exception
- _lastException := e
+ self:LastException := e
end try
return false
end method
@@ -693,6 +718,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
/// List of table names that match the filter
method GetTables(filter := "" as string) as List
try
+ self:ForceOpen()
var result := List{}
if self:HasCollection(TABLECOLLECTION)
var dt := self:DbConnection:GetSchema(TABLECOLLECTION)
@@ -709,7 +735,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
endif
return result
catch e as Exception
- _lastException := e
+ self:LastException := e
end try
return null
end method
@@ -719,6 +745,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
///
/// List of metadata collections
method GetMetaDataCollections() as List
+ self:ForceOpen()
var dt := self:DbConnection:GetSchema(DbMetaDataCollectionNames.MetaDataCollections)
var result := List{}
foreach row as DataRow in dt:Rows
@@ -737,6 +764,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
///
/// List of metadata collections
method GetMetaDataCollection(cCollection as string) as DataTable
+ self:ForceOpen()
var dt := self:DbConnection:GetSchema(cCollection)
return dt
end method
@@ -751,6 +779,39 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
#endregion
+ // Interval at which a connection refreshes the timestamp on its own locks, and the age at
+ // which another connection's lock is considered abandoned and cleared. The threshold must
+ // stay comfortably above the refresh interval: with no margin, a lock could be judged
+ // abandoned just before its owner's own refresh tick runs, e.g. under GC/scheduler jitter,
+ // and a still-active user on another workstation (or another instance) would lose their lock.
+ // Both are overridable per connection, via ini or callback, same as PageSize/BufferSize -
+ // see SqlRDDEventReason.LockRefreshInterval/LockStaleThreshold and Metadata/Abstract.prg.
+ INTERNAL CONST DEFAULT_LOCKREFRESHINTERVAL := 120 AS INT
+ INTERNAL CONST DEFAULT_LOCKSTALETHRESHOLD := 600 AS INT
+
+ ///
+ /// The interval (in seconds) at which this connection refreshes the timestamp on its own
+ /// locks and sweeps locks older than (also in seconds).
+ ///
+ property LockRefreshInterval as int
+ get
+ return _lockRefreshInterval
+ end get
+ set
+ _lockRefreshInterval := value
+ if _lockTimer != null
+ _lockTimer:Interval := value * 1000
+ endif
+ end set
+ end property
+ private _lockRefreshInterval as int
+
+ ///
+ /// The age (in seconds) after which another connection's lock is considered abandoned and
+ /// cleared. Must stay comfortably above (see remarks above).
+ ///
+ property LockStaleThreshold as int auto
+
INTERNAL CONST DEFAULT_ALLOWUPDATES := TRUE AS LOGIC
INTERNAL CONST DEFAULT_COMPAREMEMO := TRUE AS LOGIC
INTERNAL CONST DEFAULT_DELETEDCOLUMN := "" AS STRING
@@ -854,10 +915,10 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
end method
private method InitializeLockTimer() as void
- var timer := System.Timers.Timer{120000} // 120 sec
- timer:Elapsed += System.Timers.ElapsedEventHandler{ @@LockTimerElapsedEvent }
- timer:AutoReset := true
- timer:Enabled := true
+ _lockTimer := System.Timers.Timer{SELF:LockRefreshInterval * 1000}
+ _lockTimer:Elapsed += System.Timers.ElapsedEventHandler{ @@LockTimerElapsedEvent }
+ _lockTimer:AutoReset := true
+ _lockTimer:Enabled := true
return
method LockTimerElapsedEvent(sender as object, e as System.Timers.ElapsedEventArgs) as void
@@ -883,7 +944,7 @@ class SqlDbConnection inherit SqlDbHandleObject implements IDisposable
endif
cmdClear:CommandText := SELF:Provider:DeleteStatement:Replace(SqlDbProvider.TableNameMacro, LockTableName):Replace(SqlDbProvider.WhereMacro, "LockDateTime < " + parameterName1)
cmdClear:Parameters := List{}
- cmdClear:Parameters:Add(SqlDbParameter{parameterName1, DateTime.Now.AddSeconds(-120)})
+ cmdClear:Parameters:Add(SqlDbParameter{parameterName1, DateTime.Now.AddSeconds(-SELF:LockStaleThreshold)})
cmdClear:ExecuteNonQuery()
return
diff --git a/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg b/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg
index b6e4de2e5a..76eebd0637 100644
--- a/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg
+++ b/src/Runtime/XSharp.SQLRdd/Metadata/Abstract.prg
@@ -81,6 +81,8 @@ ABSTRACT CLASS SqlMetadataProviderAbstract IMPLEMENTS ISqlMetadataProvider
_connection:AllowUpdates := SELF:GetLogic(oPar, SqlRDDEventReason.AllowUpdates, _connection:AllowUpdates)
_connection:PageSize := SELF:GetInt(oPar, SqlRDDEventReason.PageSize, _connection:PageSize)
_connection:BufferSize := SELF:GetInt(oPar, SqlRDDEventReason.BufferSize, _connection:BufferSize)
+ _connection:LockRefreshInterval := SELF:GetInt(oPar, SqlRDDEventReason.LockRefreshInterval, _connection:LockRefreshInterval)
+ _connection:LockStaleThreshold := SELF:GetInt(oPar, SqlRDDEventReason.LockStaleThreshold, _connection:LockStaleThreshold)
_connection:RecnoColumn := SELF:GetString(oPar, SqlRDDEventReason.RecnoColumn, _connection:RecnoColumn)
_connection:DeletedColumn := SELF:GetString(oPar, SqlRDDEventReason.DeletedColumn, _connection:DeletedColumn)
_connection:CompareMemo := SELF:GetLogic(oPar, SqlRDDEventReason.CompareMemo, _connection:CompareMemo)
diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLDbOrder.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLDbOrder.prg
index 69ef435396..320fedadc7 100644
--- a/src/Runtime/XSharp.SQLRdd/RDD/SQLDbOrder.prg
+++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLDbOrder.prg
@@ -258,6 +258,15 @@ internal class SqlDbOrder inherit SqlDbObject
if seekInfo:Value is string var strValue
var strLen := strValue:Length
if strLen < self:KeyLength
+ var cColumnCondition := SELF:BuildColumnAwareCondition(strValue, seekInfo:SoftSeek, cComp)
+ if cColumnCondition != null
+ return cColumnCondition
+ endif
+ // Fallback for keys we can't map onto individual columns (functions in the key
+ // expression, unknown column metadata, ...): the original, always-correct
+ // condition against the fully concatenated SQLKey expression. SQL Server cannot
+ // use a normal index to seek into this - it has to compute the concatenation for
+ // every row - so prefer the column-aware path above whenever possible.
if (! seekInfo:SoftSeek)
cComp := " like "
strValue += "%"
@@ -278,5 +287,72 @@ internal class SqlDbOrder inherit SqlDbObject
return cWhereClause
end method
+ ///
+ /// Build a seek/scope condition against the individual columns that make up a plain
+ /// concatenated key (e.g. ALORT+NAMEUMLAUT), instead of against the fully concatenated
+ /// SQLKey expression.
+ ///
+ ///
+ /// A condition like `[ALORT]+[NAMEUMLAUT] LIKE 'X%'` cannot use a normal index on
+ /// (ALORT, NAMEUMLAUT, ...) - SQL Server has to evaluate the concatenation for every row.
+ /// A value that covers one or more leading columns exactly can instead be expressed as
+ /// `[ALORT] = 'X' AND [NAMEUMLAUT] LIKE 'Y%'`, which is a normal composite-index seek.
+ /// Returns NULL when the key has functions in it, or column metadata/widths can't be
+ /// determined - callers must fall back to the concatenation-based condition in that case.
+ ///
+ private method BuildColumnAwareCondition(strValue as string, lSoftSeek as logic, cRangeComp as string) as string
+ if self:HasFunctions
+ return null
+ endif
+ var columns := self:ColumnList
+ if columns == null .or. columns:Count == 0
+ return null
+ endif
+ var widths := List{}
+ foreach var cCol in columns
+ var cName := cCol:Trim({'[',']','"','`'})
+ var oCol := self:RDD:TableColumns:FirstOrDefault({ c => String.Compare(c:Name, cName, true) == 0 })
+ if oCol == null
+ return null
+ endif
+ widths:Add((int) oCol:Length)
+ next
+
+ var sb := StringBuilder{}
+ var cRemaining := strValue
+ for var i := 0 upto columns:Count-1
+ if cRemaining:Length == 0
+ exit
+ endif
+ var nWidth := widths[i]
+ var cColExpr := columns[i]
+ if sb:Length > 0
+ sb:Append(SqlDbProvider.AndClause)
+ endif
+ if cRemaining:Length >= nWidth
+ // The seek value fully covers this column - pin it down with equality and
+ // carry on with whatever's left over into the next column.
+ var cPart := cRemaining:Substring(0, nWidth)
+ sb:Append(cColExpr + " = " + Functions.XsValueToSqlValue(cPart))
+ cRemaining := cRemaining:Substring(nWidth)
+ else
+ // Partial match on this column - the same range/prefix logic the concatenation
+ // fallback uses, just scoped to this one column so the index can still be used.
+ if !lSoftSeek
+ sb:Append(cColExpr + " like " + Functions.XsValueToSqlValue(cRemaining + "%"))
+ else
+ var cSubstr := Provider:GetFunction("SUBSTR(%1%,%2%,%3%)")
+ cSubstr := cSubstr:Replace("%1%", cColExpr):Replace("%2%","1"):Replace("%3%", cRemaining:Length:ToString())
+ sb:Append(cSubstr + cRangeComp + Functions.XsValueToSqlValue(cRemaining))
+ endif
+ cRemaining := ""
+ endif
+ next
+ if sb:Length == 0
+ return null
+ endif
+ return sb:ToString()
+ end method
+
end class
end namespace // XSharp.RDD.SqlRDD
diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg
index 76d20fe292..ce38474003 100644
--- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg
+++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Main.prg
@@ -389,7 +389,9 @@ partial class SQLRDD inherit Workarea
if current == null
return false
endif
- var lWasHot := current:RowState != DataRowState.Unchanged
+ // RowState alone misses rows only marked via Delete()/Recall() without a DeletedColumn,
+ // since those touch no DataColumn and leave RowState Unchanged.
+ var lWasHot := current:RowState != DataRowState.Unchanged .or. _updatedRecNos:Count > 0
local lOk := TRUE as logic
if lWasHot .and. self:DataTable != null
@@ -441,6 +443,29 @@ partial class SQLRDD inherit Workarea
return lOk
end method
+ /// Is the given row marked for deletion?
+ ///
+ /// When a DeletedColumn is defined, then the value of that column is checked.
+ /// Otherwise the row's recno is looked up in the internal _deletedRowIds set,
+ /// since Workarea.Deleted is a hardcoded stub that cannot track this state.
+ ///
+ private method _IsRowDeleted(row as DataRow) as logic
+ if self:_deletedColumnNo > -1
+ var res := row[self:_deletedColumnNo]
+ if res is logic
+ return (logic) res
+ else
+ try
+ var iRes := Convert.ToInt64(res)
+ return iRes != 0
+ catch
+ return false
+ end try
+ endif
+ endif
+ return self:_deletedRowIds:Contains((int)row[self:_recnoColumNo])
+ end method
+
/// Mark the row at the current cursor position for deletion.
///
///
@@ -449,14 +474,20 @@ partial class SQLRDD inherit Workarea
///
override method Delete() as logic
+ var row := self:CurrentRow
if self:_deletedColumnNo > -1
- var row := self:CurrentRow
if self:_deletedColumnIsLogic
row[_deletedColumnNo] := true
else
row[_deletedColumnNo] := 1
endif
+ else
+ self:_deletedRowIds:Add((int)row[self:_recnoColumNo])
endif
+ if !_updatedRecNos:Contains((int)row[self:_recnoColumNo])
+ _updatedRecNos:Add((int)row[self:_recnoColumNo])
+ endif
+ self:GoHot()
return true
end method
@@ -467,17 +498,21 @@ partial class SQLRDD inherit Workarea
/// Otherwise when the current row is deleted and not persisted to the server yet, then the deletion is undone.
///
override method Recall() as logic
+ var row := self:CurrentRow
if self:_deletedColumnNo >= 0
- var row := self:CurrentRow
if self:_deletedColumnIsLogic
row[_deletedColumnNo] := false
else
row[_deletedColumnNo] := 0
endif
+ else
+ self:_deletedRowIds:Remove((int)row[self:_recnoColumNo])
endif
- // Must position the DBF on the right row for the recall
- super:GoTo((DWORD) SELF:RowNumber)
- return super:Recall()
+ if !_updatedRecNos:Contains((int)row[self:_recnoColumNo])
+ _updatedRecNos:Add((int)row[self:_recnoColumNo])
+ endif
+ self:GoHot()
+ return true
end method
/// Retrieve and optionally change information about a work area.
@@ -488,10 +523,53 @@ partial class SQLRDD inherit Workarea
return false
elseif uiOrdinal == DbInfo.DBI_ISDBF
return false
+ elseif uiOrdinal == DbInfo.DBI_GETLOCKARRAY
+ return SELF:_GetMyLockedRecords()
+ elseif uiOrdinal == DbInfo.DBI_LOCKCOUNT
+ return (int) SELF:_GetMyLockedRecords():Length
endif
return super:Info(uiOrdinal, oNewValue)
end method
+ ///
+ /// Records currently locked by this connection in this table, per the xs_locks table.
+ ///
+ ///
+ /// Backs DBI_GETLOCKARRAY/DBI_LOCKCOUNT (and therefore VO's RLockList/IsLocked()), since
+ /// SQLRDD's locking is tracked entirely in xs_locks rather than in the base RDD's own
+ /// bookkeeping. Without this, IsLocked() always reports false for SQLRDD tables, and
+ /// callers relying on it (e.g. HomeBase's transaction end) never commit pending changes.
+ ///
+ private method _GetMyLockedRecords() as DWORD[]
+ var recNos := List{}
+ if Connection?:Provider is null .or. !self:Connection:IsOpen .or. _oTd == null
+ return recNos:ToArray()
+ endif
+ try
+ var sb := StringBuilder{}
+ sb:AppendLine("select recno from " + SqlDbConnection.LockTableName)
+ sb:AppendLine("where tablename = "+self:Provider:ParameterPrefix+"p1")
+ sb:AppendLine(" and connectionid = "+self:Provider:ParameterPrefix+"p2")
+ sb:AppendLine(" and workarea = "+self:Provider:ParameterPrefix+"p3")
+
+ using var cmd := SqlDbCommand{"GetLockArray", self:Connection, false}
+ cmd:CommandText := sb:ToString()
+ cmd:AddParameter(self:Provider:ParameterPrefix+"p1", _oTd:RealName)
+ cmd:AddParameter(self:Provider:ParameterPrefix+"p2", self:Connection:ConnectionId:ToString())
+ cmd:AddParameter(self:Provider:ParameterPrefix+"p3", (int)super:Area)
+
+ using var reader := cmd:ExecuteReader()
+ do while reader:Read()
+ var recNoTemp := (int) reader["recno"]
+ if recNoTemp > 0
+ recNos:Add((DWORD) recNoTemp)
+ endif
+ end do
+ catch
+ nop
+ end try
+ return recNos:ToArray()
+ end method
///
///
@@ -501,6 +579,7 @@ partial class SQLRDD inherit Workarea
if !self:_ForceOpen()
return false
endif
+ SELF:_outsideOrder := FALSE
SELF:_ClearTable()
SELF:_FetchPage( 1)
SELF:RowNumber := 1
@@ -525,6 +604,7 @@ partial class SQLRDD inherit Workarea
if !self:_ForceOpen()
return false
endif
+ SELF:_outsideOrder := FALSE
SELF:_ClearTable()
local nMaxRecNo as dword
if self:CurrentOrder = Null
@@ -536,7 +616,19 @@ partial class SQLRDD inherit Workarea
if SELF:RecCount % self:_oTd:PageSize != 0
nPage += 1
ENDIF
- SELF:_FetchPage((INT) nPage)
+ // For a large table, fetching the last page via the normal ascending, OFFSET-based
+ // query (_FetchPage) forces the server to walk/skip almost the entire ordered result -
+ // the further from the top, the worse. _FetchLastPage avoids that by sorting in
+ // reverse and asking for OFFSET 0 instead, which is always cheap. Only safe when the
+ // order isn't already descending (that would invert the reversal); falls back to the
+ // original approach for natural order, descending orders, or if it fails outright.
+ if self:CurrentOrder == null .or. !self:CurrentOrder:Descending
+ if !SELF:_FetchLastPage((INT) nPage)
+ SELF:_FetchPage((INT) nPage)
+ endif
+ else
+ SELF:_FetchPage((INT) nPage)
+ endif
SELF:RowNumber := SELF:RowCount
SELF:_Top := FALSE
SELF:_Bottom := TRUE
@@ -558,7 +650,6 @@ partial class SQLRDD inherit Workarea
return false
endif
LOCAL isOK := TRUE AS LOGIC
- //
SELF:GoCold()
IF nToSkip == 0
NOP
@@ -574,6 +665,17 @@ partial class SQLRDD inherit Workarea
ELSE
SELF:RowNumber := newRow
SELF:_FetchPage(SELF:_currentPageNo +1)
+ if SELF:RowNumber > SELF:RowCount
+ // The page we just fetched turned out to be empty (we were already on
+ // the last real row) - report EOF right away instead of leaving RowNumber
+ // past the end with EOF still FALSE, which otherwise sits stale until a
+ // second Skip() happens to see _hasEOF. In between, RecNo/CurrentRow
+ // reflect the phantom row - e.g. nextrec()'s "IF EOF THEN GOTO(oldRecno)"
+ // never fires on the first PgDn past the end, and the recno it captures
+ // on the following call is the phantom row's blank value, not a real one.
+ SELF:RowNumber := 0
+ SELF:_SetEOF(TRUE)
+ endif
endif
ELSE
IF SELF:_currentPageNo == 1
@@ -622,6 +724,7 @@ partial class SQLRDD inherit Workarea
ENDIF
// Normal positioning, VO resets FOUND to FALSE after a recprd movement
SELF:_Found := FALSE
+ SELF:_outsideOrder := FALSE
IF SELF:_tableMode == TableMode.Query .and. self:_recnoColumNo == -1
RETURN SELF:_GotoRow((LONG) nRec)
ENDIF
@@ -638,9 +741,9 @@ partial class SQLRDD inherit Workarea
rowIndex++
next
- SELF:_GotoRecord(nRec)
+ var found := SELF:_GotoRecord(nRec)
SELF:_CheckEofBof()
- RETURN TRUE
+ RETURN found
end method
@@ -678,6 +781,21 @@ partial class SQLRDD inherit Workarea
SELF:_Bottom := FALSE
IF nToSkip == 0
result := SELF:GoCold()
+ ELSEIF SELF:_outsideOrder
+ // Positioned (via GoTo()) on a record outside the current order (OrderKeyNo 0).
+ // RowNumber/_currentPageNo do not correspond to any real position in the order's
+ // sequence, so a relative skip from here is meaningless. Matching DBF: a negative
+ // skip always lands on the first record of the order; a positive skip lands on
+ // record nToSkip, as if skipping forward from just before the top.
+ SELF:GoCold()
+ result := SELF:GoTop()
+ IF result
+ IF nToSkip < 0
+ SELF:BoF := TRUE
+ ELSEIF nToSkip > 1
+ result := SELF:Skip(nToSkip - 1)
+ ENDIF
+ ENDIF
ELSE
result := SELF:SkipRaw( nToSkip )
if result
@@ -710,21 +828,10 @@ partial class SQLRDD inherit Workarea
///
override property Deleted as logic
get
- if self:_deletedColumnNo > 0
- var res:= CurrentRow[self:_deletedColumnNo]
- if res is logic
- return (logic) res
- else
- try
- var iRes := Convert.ToInt64(res)
- return iRes != 0
- catch
- return false
- end try
- endif
- else
- return super:Deleted
+ if self:CurrentRow == null
+ return false
endif
+ return self:_IsRowDeleted(self:CurrentRow)
end get
end property
diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Orders.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Orders.prg
index 5989d8e71a..6123f471aa 100644
--- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Orders.prg
+++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Orders.prg
@@ -168,6 +168,14 @@ partial class SQLRDD
local result := false as logic
if self:_tableMode == TableMode.Table
var currentRecord := SELF:RecNo
+ // Flush any pending field changes on the CURRENTLY loaded row/order BEFORE
+ // tearing down the cursor. _CloseCursor() below nulls out the table the
+ // CurrentRow property reads from, so GoCold() called any later (e.g. via the
+ // GoTo() further down) would see the phantom row instead of the real dirty one
+ // and silently report success without writing anything - a change made via
+ // SetOrder()/RestDB() around a write (the standard "write outside the active
+ // index/order" pattern used throughout the app) would be lost.
+ SELF:GoCold()
self:_CloseCursor()
if (orderInfo:Order is long var nOrder0 .and. nOrder0 == 0) .or. ;
(orderInfo:Order is string var cOrder0 .and. String.IsNullOrEmpty(cOrder0))
@@ -441,7 +449,15 @@ partial class SQLRDD
self:_ForceOpen()
info:Result := self:OrderKeyCount
case DBOI_POSITION
- info:Result := self:RowNumber + (self:_currentPageNo-1) * self:_oTd:PageSize
+ // OrdKeyNo()/DBOI_POSITION reports the record's position within the current order.
+ // When the cursor sits on a record outside the order (see GoTo()/_outsideOrder),
+ // RowNumber/_currentPageNo just reflect the ad-hoc single-row buffer we loaded for
+ // it, not a real position - matching DBF, that must report 0, not a bogus row number.
+ if self:_outsideOrder
+ info:Result := 0
+ else
+ info:Result := self:RowNumber + (self:_currentPageNo-1) * self:_oTd:PageSize
+ endif
case DBOI_RECNO
// our position is the row number in the local cursor
info:Result := self:RowNumber + (self:_currentPageNo-1) * self:_oTd:PageSize
@@ -480,17 +496,14 @@ partial class SQLRDD
SELF:_ClearTable()
SELF:_currentPageNo := 1
- // save PageSize
- var nPageSize := SELF:_oTd:PageSize
- // When a filter is active we may need to skip past several candidate
- // keys to find one that also satisfies the filter, so we need more
- // than a single row in the buffer. Only shrink the page to 1 row
- // when there is no filter to evaluate.
- if ! SELF:_FilterInfo:Active
- SELF:_oTd:PageSize := 1
- endif
+ // Fetch a normal, full-size page here - NOT a single-row buffer. _FetchPage()'s
+ // paging math ((CurrentPage-1) * PageSize) assumes every page, including this first
+ // one, holds a full PageSize worth of rows; a caller that finds a match and then
+ // walks forward with Skip() past this buffer (the common "seek to the first record
+ // of a key, then Skip() while the key still matches" idiom) would otherwise jump
+ // straight to absolute offset PageSize on the next fetch instead of to row 2,
+ // silently skipping every other row that shares this seek's key.
self:_OpenTable(cSeekWhere)
- SELF:_oTd:PageSize := nPageSize
IF SELF:DataTable:Rows:Count = 0 .and. !seekInfo.SoftSeek
SELF:GoTo(0)
diff --git a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg
index aee3b2297b..a8b8b011b2 100644
--- a/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg
+++ b/src/Runtime/XSharp.SQLRdd/RDD/SQLRDD-Private.prg
@@ -40,6 +40,9 @@ partial class SQLRDD
private _updatableColumns as List
private _keyColumns as List
private _updatedRecNos as List
+ /// Recnos of rows marked for deletion via Delete() when there is no DeletedColumn on the table.
+ /// Workarea.Deleted is a hardcoded stub (always FALSE), so this state cannot be tracked in the base class.
+ private _deletedRowIds as HashSet
private _orderBagList as List
private _rowNumber as long
@@ -56,6 +59,13 @@ partial class SQLRDD
private _numHiddenColumns as long
private _serverReccount as dword
+ ///
+ /// TRUE when the cursor is positioned (via GoTo()) on a record that physically exists but
+ /// does not satisfy the current order's FOR-condition/scope, i.e. OrderKeyNo is 0. Skip()
+ /// needs this because RowNumber/_currentPageNo no longer correspond to any real position in
+ /// the order's sequence, so the normal relative-skip logic cannot be used from here.
+ ///
+ private _outsideOrder as logic
#region Properties
internal property Connection as SqlDbConnection get _connection
@@ -128,6 +138,7 @@ partial class SQLRDD
SELF:_firstPageNo := 1
self:_trimValues := true // trim String Valuess
SELF:_updatedRecNos := List{}
+ SELF:_deletedRowIds := HashSet{}
SELF:_keyColumns := List{}
SELF:_updatableColumns := List{}
SELF:_orderBagList := List{}
@@ -137,7 +148,14 @@ partial class SQLRDD
destructor()
Command?:Dispose()
- _connection?:Dispose()
+ // Mirror the explicit Close() path (SQLRDD-Main.prg): unregister from the
+ // shared connection so a leaked/finalized work area only closes the physical
+ // connection when it was truly the last one AND KeepOpen is off. Calling
+ // Dispose() here instead used to force-close and deregister the shared
+ // SqlDbConnection unconditionally, ignoring KeepOpen, whenever this work area
+ // happened to be the last one registered at finalization time - killing the
+ // connection for every other still-open table on the same connection.
+ _connection?:UnregisterRdd(self)
end destructor
internal method _ClearTable() AS VOID
@@ -432,6 +450,42 @@ partial class SQLRDD
return true
end method
+ ///
+ /// Fetch the last page of the current order/scope/filter directly, without going through
+ /// the ascending, huge-OFFSET query GoBottom() would otherwise need for a large table.
+ ///
+ /// See SqlDbTableCommandBuilder.BuildLastPageStatement for why this exists.
+ private method _FetchLastPage(nPage as int) as logic
+ try
+ SELF:_command:CommandText := _builder:BuildLastPageStatement()
+ SELF:_command:ClearParameters()
+ var newTable := SELF:_command:GetDataTable(SELF:Alias)
+ if newTable == null
+ return false
+ endif
+ // The query is sorted DESCENDING (to avoid the large OFFSET) - insert forwards at
+ // position 0 so the rows end up in the normal ascending order the rest of the RDD
+ // (Skip, RecNo lookups, ...) expects from the buffer.
+ for var nRow := 0 upto newTable:Rows:Count-1
+ var row := newTable:Rows[nRow]
+ var newRow := SELF:DataTable:NewRow()
+ newRow:ItemArray := row:ItemArray
+ SELF:DataTable:Rows:InsertAt(newRow, 0)
+ newRow:AcceptChanges()
+ next
+ SELF:_currentPageNo := nPage
+ SELF:_firstPageNo := nPage
+ // This IS the last page by definition - without this, a Skip(1) right after
+ // GoBottom() (e.g. GoTo(0)'s GoBottom()+Skip(1)) would not know it's already at
+ // the end, and would fall through to fetching "the next page" via the normal
+ // ascending, huge-OFFSET query - the exact cost this method exists to avoid.
+ SELF:_hasEOF := true
+ return true
+ catch as Exception
+ return false
+ end try
+ end method
+
protected method _ForceOpen() as logic
if self:_tableMode != TableMode.Table
return true
@@ -459,6 +513,11 @@ partial class SQLRDD
try
SELF:_currentPageNo := 1
SELF:_firstPageNo := 1
+ // A fresh open/reposition (e.g. from Seek()) must not inherit a stale "no more
+ // rows" flag left over from whatever this buffer was doing before - otherwise
+ // Skip() refuses to fetch the next page and reports EOF even though the new
+ // WHERE clause has plenty more rows past the first page.
+ SELF:_hasEOF := false
SELF:DataTable := self:_ReadTable(sWhereClause)
self:_GetRecCount()
catch as Exception
@@ -542,7 +601,16 @@ partial class SQLRDD
return
private method _GetRecCount() as void
- self:_serverReccount := self:_builder:GetRecCount()
+ // Must respect the current order's scope/condition, same as GoBottom() already does -
+ // otherwise a scope/seek-scoped browse (e.g. one city's streets) gets its RecCount
+ // silently overwritten with the whole unscoped table's count the moment anything
+ // triggers a recount (GoCold() does, on every flush of a "hot" row), corrupting the
+ // page/EOF math for the rest of the browse.
+ if self:CurrentOrder == null
+ self:_serverReccount := self:_builder:GetRecCount()
+ else
+ self:_serverReccount := self:OrderKeyCount
+ endif
end method
private method _FetchPage(nNewPageNo as int ) as logic
@@ -598,7 +666,15 @@ partial class SQLRDD
newRow:AcceptChanges()
next
endif
- if lForward .and. newTable:Rows:Count < _oTd:PageSize
+ // A short page always means EOF. But when the total record count is an exact
+ // multiple of PageSize, the last page comes back FULL - "short page" never fires,
+ // so also check whether this page's absolute record range already reaches the
+ // known total. Without this, sequential forward paging (unlike GoBottom(), which
+ // jumps straight to the last page and marks it via _FetchLastPage) never sets
+ // _hasEOF on that exactly-full last page: the next Skip() then fetches a
+ // nonexistent page past it, landing on a bogus RowNumber instead of staying put.
+ var nAbsoluteRowsSeen := ((nNewPageNo - 1) * _oTd:PageSize) + newTable:Rows:Count
+ if lForward .and. (newTable:Rows:Count < _oTd:PageSize .or. nAbsoluteRowsSeen >= SELF:_serverReccount)
SELF:_hasEOF := true
else
_currentPageNo := nNewPageNo
@@ -613,10 +689,23 @@ partial class SQLRDD
// the page that actually contains nRec, so this brute walk must always run.
SELF:_command:CommandText := _builder:BuildRowNumberStatement(nRec)
var result := SELF:_command:ExecuteScalar(SELF:_oTd:Name)
+ if result == null .or. result == DBNull.Value
+ // nRec does not satisfy the current order's FOR-condition/scope. DBF's GoTo() is a
+ // physical positioning operation, independent of the active order: it must still
+ // succeed when the record exists at all - Found/OrderKeyNo separately reflect that
+ // it has no valid position in this order.
+ return SELF:_GotoRecordOutsideOrder(nRec)
+ endif
var iResult := Convert.ToInt64(result)
// determine correct page
SELF:_currentPageNo := (INT) ((iResult - 1) / SELF:_oTd:PageSize) + 1
+ // This is a freshly loaded page - whether it happens to be the last one needs to be
+ // re-determined from here, not inherited from whatever a previous, unrelated GoBottom()
+ // (e.g. on a completely different page) left behind. Without this, a stale _hasEOF=true
+ // makes every subsequent forward Skip() from this page falsely believe it's already at
+ // the end and never fetch the next page.
+ SELF:_hasEOF := false
SELF:_ClearTable()
SELF:DataTable := SELF:_ReadTable("")
@@ -630,6 +719,25 @@ partial class SQLRDD
ENDDO
RETURN FALSE
+ PRIVATE METHOD _GotoRecordOutsideOrder(nRec as DWORD) AS LOGIC
+ try
+ SELF:_command:CommandText := _builder:BuildDirectRecnoStatement(nRec)
+ SELF:_command:ClearParameters()
+ var oTable := SELF:_command:GetDataTable(SELF:Alias)
+ if oTable == null .or. oTable:Rows:Count == 0
+ // Does not exist even physically.
+ return false
+ endif
+ SELF:_ClearTable()
+ SELF:DataTable := oTable
+ SELF:RowNumber := 1
+ SELF:_outsideOrder := true
+ SELF:_hasEOF := false
+ return true
+ catch as Exception
+ return false
+ end try
+
PRIVATE METHOD _GotoRow(nRow as LONG) AS LOGIC
SELF:_Found := FALSE
var nCount := SELF:DataTable:Rows:Count
@@ -664,6 +772,11 @@ partial class SQLRDD
endif
next
+ if row == null
+ self:_dbfError(ERDD.WRITE, XSharp.Gencode.EG_WRITE, "SqlRDD:GoCold", "Record "+nRecNo:ToString()+" no longer in buffer, cannot save changes" )
+ return false
+ endif
+
// Check row lock
var dbLockInfo := DbLockInfo{}
dbLockInfo:RecId := row[_oTd:RecnoColumn]
@@ -679,7 +792,7 @@ partial class SQLRDD
endif
lOk := true
- if super:Deleted
+ if self:_IsRowDeleted(row)
local wasNew := false as logic
// Append from may add deleted rows
if row:RowState.HasFlag(DataRowState.Added)
diff --git a/src/Runtime/XSharp.SQLRdd/Support/Enums.prg b/src/Runtime/XSharp.SQLRdd/Support/Enums.prg
index 479d7f2734..96414f5466 100644
--- a/src/Runtime/XSharp.SQLRdd/Support/Enums.prg
+++ b/src/Runtime/XSharp.SQLRdd/Support/Enums.prg
@@ -76,6 +76,10 @@ enum SqlRDDEventReason
member TagName
/// Retrieve Buffersize in pages
member BufferSize
+/// Specifies the interval (in seconds) at which a connection refreshes its own locks and sweeps stale ones
+ member LockRefreshInterval
+/// Specifies the age (in seconds) after which another connection's lock is considered abandoned and cleared
+ member LockStaleThreshold
end enum
diff --git a/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg b/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg
index 937ae5632a..a082f9f303 100644
--- a/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg
+++ b/src/Runtime/XSharp.SQLRdd/Support/SqlDbTableCommandBuilder.prg
@@ -194,6 +194,78 @@ internal class SqlDbTableCommandBuilder
return sb:ToString()
+ ///
+ /// Build a fetch of the last page of the current order/scope/filter, without the classic
+ /// "large OFFSET" performance problem.
+ ///
+ ///
+ /// GoBottom() needs the last PageSize rows of a potentially huge result set. The normal
+ /// paging query (BuildSqlStatement) would ask for that via `ORDER BY ... OFFSET (millions)
+ /// ROWS FETCH NEXT PageSize ROWS`, which forces SQL Server to walk/skip almost the entire
+ /// ordered result before it can return anything - the cost grows with table size even
+ /// though the caller only wants a handful of rows. Sorting in reverse and asking for
+ /// OFFSET 0 is always cheap regardless of table size; the caller is responsible for
+ /// reversing the returned rows back into ascending order.
+ ///
+ method BuildLastPageStatement() as string
+ var sb := System.Text.StringBuilder{}
+ local scopeWhere := null as string
+ var CurrentOrder := _oRdd:CurrentOrder
+ var whereClauses := List{}
+ sb:Append(SqlDbProvider.SelectClause)
+ sb:Append(self:ColumnList())
+ sb:Append(SqlDbProvider.FromClause)
+ sb:Append(Provider:QuoteIdentifier(self:_oTable:RealName))
+ if CurrentOrder != null
+ scopeWhere := CurrentOrder:GetScopeClause()
+ if ! String.IsNullOrEmpty(CurrentOrder:SqlWhere)
+ whereClauses:Add(CurrentOrder:SqlWhere)
+ endif
+ endif
+ if ! String.IsNullOrEmpty(scopeWhere)
+ whereClauses:Add(scopeWhere)
+ endif
+ if SELF:_oTable:HasServerFilter
+ whereClauses:Add(_oTable:ServerFilter)
+ endif
+ var sWhereClause := self:CombineWhereClauses(whereClauses)
+ sWhereClause := _connection:RaiseStringEvent(_connection, SqlRDDEventReason.WhereClause, _cTable, sWhereClause)
+ if ! String.IsNullOrEmpty(sWhereClause)
+ sb:Append(SqlDbProvider.WhereClause)
+ sb:Append(sWhereClause)
+ endif
+ local cOrderby := "" AS string
+ if CurrentOrder != null
+ sb:Append(Provider.OrderByClause)
+ foreach var cCol in CurrentOrder:OrderList
+ if !String.IsNullOrEmpty(cOrderby)
+ cOrderby += ", "
+ endif
+ cOrderby += cCol + " DESC"
+ next
+ if SELF:_oTable:HasRecnoColumn
+ var cRecnoCol := Provider:QuoteIdentifier(self:_oTable:RecnoColumn)
+ if ! String.IsNullOrEmpty(cOrderby)
+ if !cOrderby:Contains(cRecnoCol)
+ cOrderby := cOrderby + ", " + cRecnoCol + " DESC"
+ endif
+ else
+ cOrderby := cRecnoCol + " DESC"
+ endif
+ endif
+ elseif SELF:_oTable:HasRecnoColumn
+ sb:Append(Provider:OrderByClause)
+ cOrderby := Provider:QuoteIdentifier(self:_oTable:RecnoColumn) + " DESC"
+ endif
+ cOrderby :=_connection:RaiseStringEvent(_connection, SqlRDDEventReason.OrderByClause, _cTable, cOrderby)
+ sb:Replace(SqlDbProvider.ColumnsMacro, cOrderby)
+
+ sb:Append(Provider:PagingClause)
+ sb:Replace(SqlDbProvider.PagesizeMacro, _oTable:PageSize:ToString())
+ sb:Replace(SqlDbProvider.StartRecMacro, "0")
+
+ return sb:ToString()
+
METHOD BuildRowNumberStatement(nRec as DWORD) AS STRING
var sb := System.Text.StringBuilder{}
@@ -246,6 +318,28 @@ internal class SqlDbTableCommandBuilder
sb:Replace(SqlDbProvider.WhereMacro, nRec:ToString())
return sb:ToString()
+ ///
+ /// Build a fetch of a single record by its physical recno, ignoring the current order's
+ /// FOR-condition/scope and any filter.
+ ///
+ ///
+ /// DBF's GoTo() is a physical positioning operation: it must succeed even for a record that
+ /// does not match the active order, unlike BuildRowNumberStatement/BuildSqlStatement which
+ /// always fold the order's condition into the query. Found and OrderKeyNo separately reflect
+ /// that the record has no valid position in the current order.
+ ///
+ method BuildDirectRecnoStatement(nRec as DWORD) as string
+ var sb := System.Text.StringBuilder{}
+ sb:Append(SqlDbProvider.SelectClause)
+ sb:Append(self:ColumnList())
+ sb:Append(SqlDbProvider.FromClause)
+ sb:Append(Provider:QuoteIdentifier(self:_oTable:RealName))
+ sb:Append(SqlDbProvider.WhereClause)
+ sb:Append(Provider:QuoteIdentifier(self:_oTable:RecnoColumn))
+ sb:Append(" = ")
+ sb:Append(nRec:ToString())
+ return sb:ToString()
+
method ColumnList() as string
var sb := StringBuilder{}