refactor(FiveSql2): per-session state — TSqlSession isolates txn + plan cache

Foundation for the upcoming PostgreSQL-wire server. The SQL engine
previously held transaction state and the plan cache in module-level
STATICs:

  TSqlTxn.prg:16-18
    STATIC s_aTxnLog := {}
    STATIC s_lInTxn  := .F.
    STATIC s_hSavepoints := NIL

  TFiveSQL.prg:37
    STATIC s_hPlanCache := { => }

gengo emits PRG STATIC as Go *package* variables, so two clients
sharing one process serialised through a single transaction log:
client A's `BEGIN; INSERT;` followed by client B's `ROLLBACK`
would silently undo A's insert. Acceptable for embedded single-
caller use; show-stopper for a multi-connection daemon.

Moved each of those into instance fields on a new TSqlSession class.
Every executor instance now carries an oSession pointer that's
inherited by nested subquery executors. A process-default session
is lazy-initialised by SqlDefaultSession() so embedded
`five_SQL(cSQL)` callers (today's only consumer) keep working
unchanged.

Changes
-------

* `_FiveSql2/src/TSqlSession.prg` (new) — class holding the four
  ex-STATICs plus seats for auth/ACL state and a list of workareas
  the session opened (used later for disconnect cleanup). Module-
  level `SqlDefaultSession()` lazily creates one process-wide
  default for embedded callers.

* `_FiveSql2/src/TSqlTxn.prg` — added `oSession` DATA; New() takes
  an optional oSession and falls back to the default. All STATIC
  reads/writes rewritten as `::oSession:aTxnLog`,
  `::oSession:lInTxn`, etc.

* `_FiveSql2/src/TFiveSQL.prg` — added `oSession` DATA; New() takes
  an optional second arg. Plan-cache reads/writes route through
  `::oSession:hPlanCache`. SQL_PLAN_CACHE_MAX now caps each session
  independently (a chatty client only flushes its own cache, not
  the shared one).

* `_FiveSql2/src/TSqlExecutor.prg` — added `oSession` DATA; New()
  takes an optional third arg; `::oTxn := TSqlTxn():New(::oSession)`
  propagates the binding. Every in-class `TSqlExecutor():New(...)`
  call site for subqueries / UNION / IN-list materialisation /
  EXISTS / lifted subqueries now passes `::oSession` through, so a
  child executor inherits the parent's session. Standalone helper
  functions (SqlEvalExprNode / SqlFetchRowArr / SqlJoinRecurse /
  SqlMaterializeSubquery) intentionally fall back to the default
  session — they don't BEGIN/COMMIT and the plan cache is keyed by
  schema-version anyway.

* `_FiveSql2/src/FiveSqlCls.prg` — `five_SQL()` gains an optional
  fourth arg `oSession`. Existing 1-/2-/3-arg callers keep working;
  pgserver will create one TSqlSession per connection and pass it.

Verification
------------

Per-session isolation pinned by a fresh PRG-level regression
(reproducer not committed yet — will land with pgserver test
suite). The scenario:

  oSessA := TSqlSession():New()
  oSessB := TSqlSession():New()
  oSqlA  := TFiveSQL():New(NIL, oSessA)
  oSqlB  := TFiveSQL():New(NIL, oSessB)
  oSqlA:Execute("BEGIN")              -- A in txn
  oSqlB:Execute("BEGIN")              -- B in txn, A unaffected
  oSqlB:Execute("INSERT ... VALUES(2,'b-row')")
  oSqlB:Execute("COMMIT")             -- B committed, A still in txn
  oSqlA:Execute("ROLLBACK")           -- A's empty rollback, B's row survives

All four assertions pass post-refactor, would fail pre-refactor
because both sessions wrote the same `s_aTxnLog`.

All six release gates green:
  go test ./...               ✓
  FiveSql2 SQL:1999 43/43     ✓
  Harbour compat 56/56        ✓
  std.ch 17/17                ✓
  FRB 7/7                     ✓
  examples 65/71              ✓ (unchanged baseline)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-05-14 17:47:00 +09:00
parent cde86730b8
commit 93cf5c8bfa
5 changed files with 194 additions and 84 deletions

View File

@@ -12,7 +12,7 @@
#include "FiveSqlDef.ch" #include "FiveSqlDef.ch"
/* /*
* five_SQL( cSQL [, aParams ] [, bBlock ] ) --> aResult | NIL * five_SQL( cSQL [, aParams ] [, bBlock ] [, oSession ] ) --> aResult | NIL
* *
* Execute a SQL statement against the current DBF workareas. * Execute a SQL statement against the current DBF workareas.
* *
@@ -30,14 +30,22 @@
* array mode even when a block is supplied, and the block is invoked * array mode even when a block is supplied, and the block is invoked
* once per row after the fact as a compatibility layer. * once per row after the fact as a compatibility layer.
* *
* Session parameter:
* When oSession is NIL (the common embedded case), the engine uses
* a lazy process-default session via SqlDefaultSession() so existing
* callers keep working unchanged. The pgserver frontend passes a
* fresh TSqlSession instance per connection so concurrent clients
* don't share transaction logs or plan caches.
*
* Accepts both parameter positions so existing callers still work: * Accepts both parameter positions so existing callers still work:
* five_SQL( cSQL ) * five_SQL( cSQL )
* five_SQL( cSQL, aParams ) * five_SQL( cSQL, aParams )
* five_SQL( cSQL, aParams, bBlock ) * five_SQL( cSQL, aParams, bBlock )
* five_SQL( cSQL, NIL, bBlock ) * five_SQL( cSQL, NIL, bBlock )
* five_SQL( cSQL, NIL, NIL, oSession )
*/ */
FUNCTION five_SQL( cSQL, aParams, bBlock ) FUNCTION five_SQL( cSQL, aParams, bBlock, oSession )
LOCAL oSql := TFiveSQL():New( aParams ) LOCAL oSql := TFiveSQL():New( aParams, oSession )
RETURN oSql:Execute( cSQL, bBlock ) RETURN oSql:Execute( cSQL, bBlock )

View File

@@ -3,6 +3,11 @@
* *
* Uses TSqlParser2 (Pratt parser) exclusively. * Uses TSqlParser2 (Pratt parser) exclusively.
* *
* The plan cache (formerly STATIC s_hPlanCache) now lives on
* TSqlSession so concurrent connections don't share parsed ASTs.
* Embedded callers that didn't pass an oSession transparently use
* the process-default session via SqlDefaultSession().
*
* FiveSql2 — SQL Engine for Harbour DBF/NTX * FiveSql2 — SQL Engine for Harbour DBF/NTX
* *
* Copyright (c) 2025-2026 Charles KWON (Charles KWON OhJun) * Copyright (c) 2025-2026 Charles KWON (Charles KWON OhJun)
@@ -14,27 +19,12 @@
#include "hbclass.ch" #include "hbclass.ch"
#include "FiveSqlDef.ch" #include "FiveSqlDef.ch"
/* Plan cache: cSQL → parsed hQuery. /* Plan cache size cap, per-session. Wipe wholesale on overflow.
* *
* The FiveSql2 parser runs lex + Pratt-style AST build per call; for * Each session's hPlanCache is independent — a chatty client running
* repeated identical SQL (typical in report / loop / benchmark workloads) * thousands of unique SQL templates only flushes its own cache, not
* this is pure overhead. We cache the pristine parse result keyed by * a global one shared with quiet siblings. */
* the raw SQL text and hand every subsequent call a deep clone via
* HbDeepClone so in-place mutations (SqlFoldConst, aTables rewriting)
* during Run() never corrupt the cached tree.
*
* Cached entries live until process exit; distinct SQL text count is
* bounded by the caller's template set in well-behaved callers, but
* a long-running server with diverse dynamic SQL (or one that bypasses
* the `?` placeholder convention and bakes literals into every query)
* can grow this hash without bound. SQL_PLAN_CACHE_MAX caps the entry
* count; on overflow we wipe the whole cache. Coarser than LRU but
* Five hashes have no insertion-order guarantee and the per-query
* bookkeeping for true LRU would dominate the parse cost we're
* trying to amortise. Reset cost is one extra parse per template
* already evicted, accepted in exchange for bounded memory. */
#define SQL_PLAN_CACHE_MAX 1000 #define SQL_PLAN_CACHE_MAX 1000
STATIC s_hPlanCache := { => }
CLASS TFiveSQL CLASS TFiveSQL
@@ -42,19 +32,25 @@ CLASS TFiveSQL
DATA oParser DATA oParser
DATA oExec DATA oExec
DATA aParams INIT {} DATA aParams INIT {}
DATA oSession /* per-connection state container */
METHOD New( aParams ) CONSTRUCTOR METHOD New( aParams, oSession ) CONSTRUCTOR
METHOD Execute( cSQL, bBlock ) METHOD Execute( cSQL, bBlock )
METHOD ExecuteWith( cSQL, aParams ) METHOD ExecuteWith( cSQL, aParams )
ENDCLASS ENDCLASS
METHOD New( aParams ) CLASS TFiveSQL METHOD New( aParams, oSession ) CLASS TFiveSQL
IF aParams != NIL IF aParams != NIL
::aParams := aParams ::aParams := aParams
ENDIF ENDIF
IF oSession == NIL
::oSession := SqlDefaultSession()
ELSE
::oSession := oSession
ENDIF
RETURN SELF RETURN SELF
@@ -63,6 +59,7 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
LOCAL aTokens, hQuery, aResult LOCAL aTokens, hQuery, aResult
LOCAL aLex, cKey, aParams, cVerPrefix LOCAL aLex, cKey, aParams, cVerPrefix
LOCAL hPlanCache := ::oSession:hPlanCache
/* Schema-version prefix: DDL (CREATE/ALTER/DROP) bumps SqlSchemaVer() /* Schema-version prefix: DDL (CREATE/ALTER/DROP) bumps SqlSchemaVer()
* so any plan that resolved columns or indexes against the pre-DDL * so any plan that resolved columns or indexes against the pre-DDL
@@ -82,28 +79,29 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
cKey := cVerPrefix + aLex[ 2 ] cKey := cVerPrefix + aLex[ 2 ]
aParams := aLex[ 3 ] aParams := aLex[ 3 ]
IF hb_HHasKey( s_hPlanCache, cKey ) IF hb_HHasKey( hPlanCache, cKey )
hQuery := HbDeepClone( s_hPlanCache[ cKey ] ) hQuery := HbDeepClone( hPlanCache[ cKey ] )
ELSE ELSE
::oParser := TSqlParser2():New( aTokens, aParams ) ::oParser := TSqlParser2():New( aTokens, aParams )
hQuery := ::oParser:Parse() hQuery := ::oParser:Parse()
IF hQuery == NIL IF hQuery == NIL
RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } } RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } }
ENDIF ENDIF
IF Len( s_hPlanCache ) >= SQL_PLAN_CACHE_MAX IF Len( hPlanCache ) >= SQL_PLAN_CACHE_MAX
s_hPlanCache := { => } ::oSession:hPlanCache := { => }
hPlanCache := ::oSession:hPlanCache
SqlDmlPcodeCacheReset() SqlDmlPcodeCacheReset()
ENDIF ENDIF
s_hPlanCache[ cKey ] := HbDeepClone( hQuery ) hPlanCache[ cKey ] := HbDeepClone( hQuery )
ENDIF ENDIF
::oExec := TSqlExecutor():New( hQuery, aParams ) ::oExec := TSqlExecutor():New( hQuery, aParams, ::oSession )
::oExec:cCacheKey := cKey ::oExec:cCacheKey := cKey
ELSE ELSE
/* Caller supplied explicit params — cache by raw SQL text. */ /* Caller supplied explicit params — cache by raw SQL text. */
cKey := cVerPrefix + cSQL cKey := cVerPrefix + cSQL
IF hb_HHasKey( s_hPlanCache, cKey ) IF hb_HHasKey( hPlanCache, cKey )
hQuery := HbDeepClone( s_hPlanCache[ cKey ] ) hQuery := HbDeepClone( hPlanCache[ cKey ] )
ELSE ELSE
aTokens := SqlLexerTokenize( cSQL ) aTokens := SqlLexerTokenize( cSQL )
::oParser := TSqlParser2():New( aTokens, ::aParams ) ::oParser := TSqlParser2():New( aTokens, ::aParams )
@@ -111,14 +109,15 @@ METHOD Execute( cSQL, bBlock ) CLASS TFiveSQL
IF hQuery == NIL IF hQuery == NIL
RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } } RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } }
ENDIF ENDIF
IF Len( s_hPlanCache ) >= SQL_PLAN_CACHE_MAX IF Len( hPlanCache ) >= SQL_PLAN_CACHE_MAX
s_hPlanCache := { => } ::oSession:hPlanCache := { => }
hPlanCache := ::oSession:hPlanCache
SqlDmlPcodeCacheReset() SqlDmlPcodeCacheReset()
ENDIF ENDIF
s_hPlanCache[ cKey ] := HbDeepClone( hQuery ) hPlanCache[ cKey ] := HbDeepClone( hQuery )
ENDIF ENDIF
::oExec := TSqlExecutor():New( hQuery, ::aParams ) ::oExec := TSqlExecutor():New( hQuery, ::aParams, ::oSession )
::oExec:cCacheKey := cKey ::oExec:cCacheKey := cKey
ENDIF ENDIF

View File

@@ -83,7 +83,13 @@ CLASS TSqlExecutor
DATA hSubCache DATA hSubCache
METHOD New( hQuery, aParams ) CONSTRUCTOR /* Session container — carries txn log, plan cache, current user,
* role grants. Nested subquery executors inherit the parent's
* session so a child query's BEGIN/COMMIT operates on the same
* connection-scoped state. */
DATA oSession
METHOD New( hQuery, aParams, oSession ) CONSTRUCTOR
METHOD Run() METHOD Run()
METHOD RunImpl() METHOD RunImpl()
METHOD RunSelect() METHOD RunSelect()
@@ -134,15 +140,23 @@ CLASS TSqlExecutor
ENDCLASS ENDCLASS
METHOD New( hQuery, aParams ) CLASS TSqlExecutor METHOD New( hQuery, aParams, oSession ) CLASS TSqlExecutor
::hQuery := hQuery ::hQuery := hQuery
::aParams := iif( aParams == NIL, {}, aParams ) ::aParams := iif( aParams == NIL, {}, aParams )
/* Inherit caller's session if provided; otherwise fall back to
* the process-default session so embedded `five_SQL(cSQL)` callers
* and any TSqlExecutor created without the new arg keep working. */
IF oSession == NIL
::oSession := SqlDefaultSession()
ELSE
::oSession := oSession
ENDIF
::oIndex := TSqlIndex():New() ::oIndex := TSqlIndex():New()
::oAgg := TSqlAgg():New() ::oAgg := TSqlAgg():New()
::oSort := TSqlSort():New() ::oSort := TSqlSort():New()
::oDDL := TSqlDDL():New() ::oDDL := TSqlDDL():New()
::oTxn := TSqlTxn():New() ::oTxn := TSqlTxn():New( ::oSession )
::oAlias := TSqlAlias():New() ::oAlias := TSqlAlias():New()
::nDepth := 0 ::nDepth := 0
::aOpened := {} ::aOpened := {}
@@ -2390,7 +2404,7 @@ METHOD RunSelect() CLASS TSqlExecutor
* which meant LIMIT clipped the first SELECT before UNION added * which meant LIMIT clipped the first SELECT before UNION added
* the second's rows, producing more rows than intended. */ * the second's rows, producing more rows than intended. */
IF hUnion != NIL IF hUnion != NIL
aU := TSqlExecutor():New( hUnion, ::aParams ):Run() aU := TSqlExecutor():New( hUnion, ::aParams, ::oSession ):Run()
/* SQL standard: set operations require the same column count on /* SQL standard: set operations require the same column count on
* both sides. Previously a mismatch silently truncated the wider * both sides. Previously a mismatch silently truncated the wider
* side to the narrower's width, masking schema bugs (`SELECT a * side to the narrower's width, masking schema bugs (`SELECT a
@@ -2843,7 +2857,7 @@ METHOD TryBuildSemiJoin( xSubNode ) CLASS TSqlExecutor
hLifted[ "having" ] := NIL hLifted[ "having" ] := NIL
/* Run the lifted query once. No PushOuter — it's now non-correlated. */ /* Run the lifted query once. No PushOuter — it's now non-correlated. */
oSub := TSqlExecutor():New( hLifted, ::aParams ) oSub := TSqlExecutor():New( hLifted, ::aParams, ::oSession )
oSub:nDepth := ::nDepth oSub:nDepth := ::nDepth
aResult := oSub:Run() aResult := oSub:Run()
IF ValType( aResult ) != "A" .OR. Len( aResult ) < 2 .OR. ValType( aResult[ 2 ] ) != "A" IF ValType( aResult ) != "A" .OR. Len( aResult ) < 2 .OR. ValType( aResult[ 2 ] ) != "A"
@@ -3033,7 +3047,7 @@ METHOD SubqueryCached( xSubNode ) CLASS TSqlExecutor
aRecSave := ::SnapshotAreaRecNos() aRecSave := ::SnapshotAreaRecNos()
::PushOuter() ::PushOuter()
BEGIN SEQUENCE BEGIN SEQUENCE
oSub := TSqlExecutor():New( hQ, ::aParams ) oSub := TSqlExecutor():New( hQ, ::aParams, ::oSession )
/* +2 (not +1): the alias-rename gate in the table-open loop /* +2 (not +1): the alias-rename gate in the table-open loop
* requires `nDepth > 1` to fire. Bumping by 1 from a top-level * requires `nDepth > 1` to fire. Bumping by 1 from a top-level
* (depth-0) outer landed at depth 1 which still shares aliases * (depth-0) outer landed at depth 1 which still shares aliases
@@ -3244,7 +3258,7 @@ METHOD CacheSubquery( xSubExpr ) CLASS TSqlExecutor
* negligible; correlated callers go through SubqueryCached. */ * negligible; correlated callers go through SubqueryCached. */
nSavedWA := Select() nSavedWA := Select()
aRecSave := ::SnapshotAreaRecNos() aRecSave := ::SnapshotAreaRecNos()
oSub := TSqlExecutor():New( xSubExpr, ::aParams ) oSub := TSqlExecutor():New( xSubExpr, ::aParams, ::oSession )
oSub:nDepth := ::nDepth + 2 oSub:nDepth := ::nDepth + 2
aSubResult := oSub:Run() aSubResult := oSub:Run()
::RestoreAreaRecNos( aRecSave ) ::RestoreAreaRecNos( aRecSave )
@@ -3269,7 +3283,7 @@ METHOD MaterializeCTE( aCTE ) CLASS TSqlExecutor
/* Execute the CTE subquery */ /* Execute the CTE subquery */
IF ValType( xSubQ ) == "A" .AND. xSubQ[ 1 ] == ND_SUB .AND. xSubQ[ 2 ] != NIL IF ValType( xSubQ ) == "A" .AND. xSubQ[ 1 ] == ND_SUB .AND. xSubQ[ 2 ] != NIL
aSub := TSqlExecutor():New( xSubQ[ 2 ], ::aParams ):Run() aSub := TSqlExecutor():New( xSubQ[ 2 ], ::aParams, ::oSession ):Run()
ELSE ELSE
aSub := NIL aSub := NIL
ENDIF ENDIF
@@ -3396,7 +3410,7 @@ METHOD RunInsert() CLASS TSqlExecutor
* from VALUES (...) tuples or from a SELECT. */ * from VALUES (...) tuples or from a SELECT. */
IF hb_HHasKey( ::hQuery, "select" ) IF hb_HHasKey( ::hQuery, "select" )
hSelect := ::hQuery[ "select" ] hSelect := ::hQuery[ "select" ]
aSelResult := TSqlExecutor():New( hSelect, ::aParams ):Run() aSelResult := TSqlExecutor():New( hSelect, ::aParams, ::oSession ):Run()
IF ValType( aSelResult ) == "A" .AND. Len( aSelResult ) >= 1 .AND. ; IF ValType( aSelResult ) == "A" .AND. Len( aSelResult ) >= 1 .AND. ;
ValType( aSelResult[ 1 ] ) == "A" .AND. Len( aSelResult[ 1 ] ) > 0 .AND. ; ValType( aSelResult[ 1 ] ) == "A" .AND. Len( aSelResult[ 1 ] ) > 0 .AND. ;
aSelResult[ 1 ][ 1 ] == "__error__" aSelResult[ 1 ][ 1 ] == "__error__"
@@ -4629,7 +4643,7 @@ METHOD MaterializeRecursiveCTE( aCTE ) CLASS TSqlExecutor
hSubQ[ "union" ] := NIL hSubQ[ "union" ] := NIL
/* Execute anchor query (the first SELECT before UNION ALL) */ /* Execute anchor query (the first SELECT before UNION ALL) */
aSub := TSqlExecutor():New( hSubQ, ::aParams ):Run() aSub := TSqlExecutor():New( hSubQ, ::aParams, ::oSession ):Run()
/* Restore the union reference for later use */ /* Restore the union reference for later use */
hSubQ[ "union" ] := hRecQuery hSubQ[ "union" ] := hRecQuery

View File

@@ -0,0 +1,79 @@
/*
* TSqlSession.prg — Per-connection session container
*
* Holds all state that must be isolated between concurrent FiveSql2
* clients (transaction log, plan cache, current user, role grants).
* Previously this state lived in module-level STATICs of TSqlTxn /
* TFiveSQL, but gengo emits PRG STATIC as Go *package* variables —
* so two PostgreSQL-wire clients sharing the same Go process would
* stomp each other's transaction state.
*
* Embedded usage (`five_SQL(cSQL)` with no explicit session) keeps
* working because FiveSqlCls.prg falls back to a process-default
* session lazily created by SqlDefaultSession().
*
* FiveSql2 — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025-2026 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "hbclass.ch"
#include "FiveSqlDef.ch"
CLASS TSqlSession
/* Transaction state (was STATIC in TSqlTxn.prg). */
DATA aTxnLog INIT {}
DATA lInTxn INIT .F.
DATA hSavepoints INIT NIL
/* Plan cache (was STATIC s_hPlanCache in TFiveSQL.prg). Keyed by
* "<schemaVer>|<sqlOrTemplate>". Bounded by SQL_PLAN_CACHE_MAX —
* wiped wholesale on overflow (cheaper than per-entry LRU). */
DATA hPlanCache INIT { => }
/* Auth / ACL state — populated by pgserver after AuthenticationOk.
* Empty in embedded mode (no row-level checks). */
DATA cCurrentUser INIT ""
DATA hRolePerms INIT { => }
/* Workarea aliases this session opened, for cleanup on disconnect. */
DATA aOpenAreas INIT {}
METHOD New() CONSTRUCTOR
METHOD Reset() /* drop txn + plan cache, keep auth */
ENDCLASS
METHOD New() CLASS TSqlSession
RETURN SELF
METHOD Reset() CLASS TSqlSession
::aTxnLog := {}
::lInTxn := .F.
::hSavepoints := NIL
::hPlanCache := { => }
RETURN SELF
/*
* SqlDefaultSession — process-wide default session.
*
* Used by embedded callers that don't manage their own session
* (the existing `five_SQL(cSQL)` callsite). Lazy-initialized on
* first use so the cost is paid only by callers that use the
* engine at all. pgserver creates a fresh session per connection
* and bypasses this entirely.
*/
STATIC s_oDefaultSession := NIL
FUNCTION SqlDefaultSession()
IF s_oDefaultSession == NIL
s_oDefaultSession := TSqlSession():New()
ENDIF
RETURN s_oDefaultSession

View File

@@ -1,9 +1,15 @@
/* /*
* TSqlTxn.prg — Transaction manager (BEGIN/COMMIT/ROLLBACK) * TSqlTxn.prg — Transaction manager (BEGIN/COMMIT/ROLLBACK)
* *
* Transaction state lives on the TSqlSession passed at construction
* time so concurrent connections (pgserver and embedded callers)
* don't share a single global txn log. New() without an oSession
* argument falls back to SqlDefaultSession() so legacy embedded
* call sites keep working.
*
* FiveSql — SQL Engine for Harbour DBF/NTX * FiveSql — SQL Engine for Harbour DBF/NTX
* *
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun) * Copyright (c) 2025-2026 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com * Email: charleskwonohjun@gmail.com
* *
* All rights reserved. * All rights reserved.
@@ -12,14 +18,11 @@
#include "hbclass.ch" #include "hbclass.ch"
#include "FiveSqlDef.ch" #include "FiveSqlDef.ch"
/* Transaction state must be global across all executor instances */
STATIC s_aTxnLog := {}
STATIC s_lInTxn := .F.
STATIC s_hSavepoints := NIL
CLASS TSqlTxn CLASS TSqlTxn
METHOD New() CONSTRUCTOR DATA oSession /* per-connection state container */
METHOD New( oSession ) CONSTRUCTOR
METHOD Begin() METHOD Begin()
METHOD Commit() METHOD Commit()
METHOD Rollback() METHOD Rollback()
@@ -31,19 +34,24 @@ CLASS TSqlTxn
ENDCLASS ENDCLASS
METHOD New() CLASS TSqlTxn METHOD New( oSession ) CLASS TSqlTxn
IF oSession == NIL
::oSession := SqlDefaultSession()
ELSE
::oSession := oSession
ENDIF
RETURN SELF RETURN SELF
METHOD IsActive() CLASS TSqlTxn METHOD IsActive() CLASS TSqlTxn
RETURN s_lInTxn RETURN ::oSession:lInTxn
METHOD Begin() CLASS TSqlTxn METHOD Begin() CLASS TSqlTxn
s_aTxnLog := {} ::oSession:aTxnLog := {}
s_lInTxn := .T. ::oSession:lInTxn := .T.
s_hSavepoints := { => } ::oSession:hSavepoints := { => }
RETURN { { "result" }, { { "Transaction started" } } } RETURN { { "result" }, { { "Transaction started" } } }
@@ -52,7 +60,7 @@ METHOD Commit() CLASS TSqlTxn
LOCAL nArea LOCAL nArea
IF ! s_lInTxn IF ! ::oSession:lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction to COMMIT", "" } } } RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction to COMMIT", "" } } }
ENDIF ENDIF
@@ -63,8 +71,8 @@ METHOD Commit() CLASS TSqlTxn
ENDIF ENDIF
NEXT NEXT
s_aTxnLog := {} ::oSession:aTxnLog := {}
s_lInTxn := .F. ::oSession:lInTxn := .F.
RETURN { { "result" }, { { "Transaction committed" } } } RETURN { { "result" }, { { "Transaction committed" } } }
@@ -73,17 +81,18 @@ METHOD Rollback() CLASS TSqlTxn
LOCAL i, j, cAlias, nRecNo, aFldVals, nWA, nSaved LOCAL i, j, cAlias, nRecNo, aFldVals, nWA, nSaved
LOCAL lOpened LOCAL lOpened
LOCAL aLog := ::oSession:aTxnLog
IF ! s_lInTxn IF ! ::oSession:lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction to ROLLBACK", "" } } } RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction to ROLLBACK", "" } } }
ENDIF ENDIF
nSaved := Select() nSaved := Select()
FOR i := Len( s_aTxnLog ) TO 1 STEP -1 FOR i := Len( aLog ) TO 1 STEP -1
cAlias := s_aTxnLog[ i ][ 1 ] cAlias := aLog[ i ][ 1 ]
nRecNo := s_aTxnLog[ i ][ 2 ] nRecNo := aLog[ i ][ 2 ]
aFldVals := s_aTxnLog[ i ][ 3 ] aFldVals := aLog[ i ][ 3 ]
lOpened := .F. lOpened := .F.
nWA := Select( cAlias ) nWA := Select( cAlias )
@@ -103,7 +112,7 @@ METHOD Rollback() CLASS TSqlTxn
FOR j := 1 TO Len( aFldVals ) FOR j := 1 TO Len( aFldVals )
FieldPut( j, aFldVals[ j ] ) FieldPut( j, aFldVals[ j ] )
NEXT NEXT
IF Len( s_aTxnLog[ i ] ) >= 4 .AND. s_aTxnLog[ i ][ 4 ] == "INSERT" IF Len( aLog[ i ] ) >= 4 .AND. aLog[ i ][ 4 ] == "INSERT"
dbDelete() dbDelete()
ENDIF ENDIF
dbRUnlock( nRecNo ) dbRUnlock( nRecNo )
@@ -117,22 +126,22 @@ METHOD Rollback() CLASS TSqlTxn
dbSelectArea( nSaved ) dbSelectArea( nSaved )
s_aTxnLog := {} ::oSession:aTxnLog := {}
s_lInTxn := .F. ::oSession:lInTxn := .F.
RETURN { { "result" }, { { "Transaction rolled back" } } } RETURN { { "result" }, { { "Transaction rolled back" } } }
METHOD SetSavepoint( cName ) CLASS TSqlTxn METHOD SetSavepoint( cName ) CLASS TSqlTxn
IF ! s_lInTxn IF ! ::oSession:lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction for SAVEPOINT", "" } } } RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction for SAVEPOINT", "" } } }
ENDIF ENDIF
IF s_hSavepoints == NIL IF ::oSession:hSavepoints == NIL
s_hSavepoints := { => } ::oSession:hSavepoints := { => }
ENDIF ENDIF
s_hSavepoints[ Upper( cName ) ] := Len( s_aTxnLog ) ::oSession:hSavepoints[ Upper( cName ) ] := Len( ::oSession:aTxnLog )
RETURN { { "result" }, { { "Savepoint " + cName + " set" } } } RETURN { { "result" }, { { "Savepoint " + cName + " set" } } }
@@ -141,23 +150,24 @@ METHOD RollbackTo( cName ) CLASS TSqlTxn
LOCAL i, j, cAlias, nRecNo, aFldVals, nWA, nSaved, nSpPos LOCAL i, j, cAlias, nRecNo, aFldVals, nWA, nSaved, nSpPos
LOCAL lOpened LOCAL lOpened
LOCAL aLog := ::oSession:aTxnLog
IF ! s_lInTxn IF ! ::oSession:lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction for ROLLBACK TO", "" } } } RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction for ROLLBACK TO", "" } } }
ENDIF ENDIF
IF s_hSavepoints == NIL .OR. ! hb_HHasKey( s_hSavepoints, Upper( cName ) ) IF ::oSession:hSavepoints == NIL .OR. ! hb_HHasKey( ::oSession:hSavepoints, Upper( cName ) )
RETURN { { "__error__" }, { { SQL_ERR_TXN, "Savepoint " + cName + " not found", "" } } } RETURN { { "__error__" }, { { SQL_ERR_TXN, "Savepoint " + cName + " not found", "" } } }
ENDIF ENDIF
nSpPos := s_hSavepoints[ Upper( cName ) ] nSpPos := ::oSession:hSavepoints[ Upper( cName ) ]
nSaved := Select() nSaved := Select()
/* Undo log entries from end back to savepoint position */ /* Undo log entries from end back to savepoint position */
FOR i := Len( s_aTxnLog ) TO nSpPos + 1 STEP -1 FOR i := Len( aLog ) TO nSpPos + 1 STEP -1
cAlias := s_aTxnLog[ i ][ 1 ] cAlias := aLog[ i ][ 1 ]
nRecNo := s_aTxnLog[ i ][ 2 ] nRecNo := aLog[ i ][ 2 ]
aFldVals := s_aTxnLog[ i ][ 3 ] aFldVals := aLog[ i ][ 3 ]
lOpened := .F. lOpened := .F.
nWA := Select( cAlias ) nWA := Select( cAlias )
@@ -177,7 +187,7 @@ METHOD RollbackTo( cName ) CLASS TSqlTxn
FOR j := 1 TO Len( aFldVals ) FOR j := 1 TO Len( aFldVals )
FieldPut( j, aFldVals[ j ] ) FieldPut( j, aFldVals[ j ] )
NEXT NEXT
IF Len( s_aTxnLog[ i ] ) >= 4 .AND. s_aTxnLog[ i ][ 4 ] == "INSERT" IF Len( aLog[ i ] ) >= 4 .AND. aLog[ i ][ 4 ] == "INSERT"
dbDelete() dbDelete()
ENDIF ENDIF
dbRUnlock( nRecNo ) dbRUnlock( nRecNo )
@@ -190,7 +200,7 @@ METHOD RollbackTo( cName ) CLASS TSqlTxn
NEXT NEXT
/* Trim the log back to the savepoint position */ /* Trim the log back to the savepoint position */
ASize( s_aTxnLog, nSpPos ) ASize( ::oSession:aTxnLog, nSpPos )
dbSelectArea( nSaved ) dbSelectArea( nSaved )
@@ -201,7 +211,7 @@ METHOD LogRecord( cAlias, nRecNo, cAction ) CLASS TSqlTxn
LOCAL nWA, nSaved, aFldVals := {}, i LOCAL nWA, nSaved, aFldVals := {}, i
IF ! s_lInTxn IF ! ::oSession:lInTxn
RETURN NIL RETURN NIL
ENDIF ENDIF
@@ -213,7 +223,7 @@ METHOD LogRecord( cAlias, nRecNo, cAction ) CLASS TSqlTxn
FOR i := 1 TO FCount() FOR i := 1 TO FCount()
AAdd( aFldVals, FieldGet( i ) ) AAdd( aFldVals, FieldGet( i ) )
NEXT NEXT
AAdd( s_aTxnLog, { cAlias, nRecNo, aFldVals, cAction } ) AAdd( ::oSession:aTxnLog, { cAlias, nRecNo, aFldVals, cAction } )
ENDIF ENDIF
dbSelectArea( nSaved ) dbSelectArea( nSaved )