fivedev/five
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: FiveSql2 43/43, @byref, mutable closure, RTL 479, DateTime fix

Browse Source 
Major changes since last commit:
- FiveSql2 SQL:1999 engine (10,458 LOC) — 43/43 ALL PASS
- 21 compiler/runtime bugs fixed (short-circuit AND/OR, FOR LOOP, etc.)
- @byref pass-by-reference via RefCell pattern
- Mutable closure capture (EnsureLocalRef + RefCell sharing)
- RTL: 400 → 479 functions (+79: file, string, datetime, hash, UTF-8)
- DateTime/Timestamp fully working (hb_DateTime, hb_Hour/Min/Sec, display)
- Reserved word guard (39 keywords blocked from function calls)
- AEval arg order fix (element before index)
- Closure capture redecl fix (unique _cap_ names per block)
- Hash/string indexing in ArrayPush/ArrayPop
- Harbour compat test suite: 51/51
- 4 docs: Porting Report, Implementation Plan, Optimization Plan, Commercialization

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
Charles KWON OhJun
2026-04-11 11:35:37 +09:00
parent d451b836a6
commit 486e466592
129 changed files with 35248 additions and 241 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
_FiveSql2/src/FiveSqlCls.prg Normal file
View File

@@ -0,0 +1,25 @@
/*
* FiveSqlCls.prg — Public API wrapper: five_SQL() function
*
* FiveSql2 — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025-2026 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "FiveSqlDef.ch"
/*
* five_SQL( cSQL [, aParams ] ) --> aResult
*
* Execute a SQL statement against the current DBF workareas.
* Returns { aFieldNames, aRows } on success,
* { {"__error__"}, {{nCode, cMsg, cSQL}} } on failure.
*/
FUNCTION five_SQL( cSQL, aParams )
LOCAL oSql := TFiveSQL():New( aParams )
RETURN oSql:Execute( cSQL )

72
_FiveSql2/src/FiveSqlDef.ch Normal file
View File

@@ -0,0 +1,72 @@
/*
* FiveSqlDef.ch — Shared constant definitions for FiveSql engine
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#ifndef FIVESQLDEF_CH
#define FIVESQLDEF_CH
/* Token types produced by the lexical analyzer */
#define TK_END 0 /* End of input */
#define TK_NAME 1 /* Identifier or keyword */
#define TK_TEXT 2 /* String literal */
#define TK_NUM 3 /* Numeric literal */
#define TK_COMMA 4 /* , */
#define TK_DOT 5 /* . */
#define TK_STAR 6 /* * */
#define TK_LPAR 7 /* ( */
#define TK_RPAR 8 /* ) */
#define TK_EQ 9 /* = */
#define TK_NEQ 10 /* <> or != */
#define TK_LT 11 /* < */
#define TK_GT 12 /* > */
#define TK_LTE 13 /* <= */
#define TK_GTE 14 /* >= */
#define TK_QMARK 15 /* ? (parameter placeholder) */
#define TK_PLUS 16 /* + */
#define TK_MINUS 17 /* - */
#define TK_SLASH 18 /* / */
#define TK_PIPES 19 /* || (string concatenation) */
/* Token array element indices */
#define TK_TYPE 1
#define TK_VALUE 2
/* Expression AST node types */
#define ND_LIT 1 /* Literal value */
#define ND_COL 2 /* Column reference */
#define ND_FN 3 /* Function call */
#define ND_BIN 4 /* Binary operation */
#define ND_UNI 5 /* Unary operation */
#define ND_CASE 6 /* CASE expression */
#define ND_SUB 7 /* Subquery */
#define ND_LIST 8 /* Value list */
#define ND_PAR 9 /* Bound parameter */
#define ND_NIL 10 /* NULL value */
#define ND_RANGE 11 /* BETWEEN range */
#define ND_WINDOW 12 /* Window function */
#define ND_FRAME 13 /* Window frame specification */
#define ND_LATERAL 14 /* LATERAL subquery */
/* Error codes */
#define SQL_ERR_NONE 0
#define SQL_ERR_SYNTAX 1001
#define SQL_ERR_NO_TABLE 1002
#define SQL_ERR_NO_FIELD 1003
#define SQL_ERR_TYPE 1004
#define SQL_ERR_LOCKED 1005
#define SQL_ERR_GRAMMAR 1006
#define SQL_ERR_UNSUPPORTED 1007
#define SQL_ERR_TXN 1008
/* Recognized aggregate function names */
#define AGG_FUNCTIONS "COUNT,SUM,AVG,MIN,MAX,GROUP_CONCAT,STRING_AGG,LISTAGG,JSON_ARRAYAGG,JSON_OBJECTAGG,XMLAGG,ANY_VALUE,BOOL_AND,BOOL_OR"
/* Recognized scalar function names */
#define SCALAR_FUNCTIONS "UPPER,LOWER,TRIM,LTRIM,RTRIM,SUBSTR,SUBSTRING,LEN,LENGTH,REPLACE,SPACE,REPLICATE,STUFF,CHARINDEX,CONCAT,ABS,ROUND,INT,FLOOR,CEILING,CEIL,MOD,POWER,SQRT,SIGN,YEAR,MONTH,DAY,NOW,DATE,TIME,DTOS,DTOC,CTOD,STOD,CAST,CONVERT,STR,VAL,ALLTRIM,IIF,COALESCE,NULLIF,DATEADD,DATEDIFF,EOMONTH,INSTR,REVERSE,PADL,PADR,PADC,ISNUMERIC,ISDATE,ISVALID,TYPEOF,TYPE,FORMAT,HB_HOUR,HB_MINUTE,HB_SECOND,HB_DATETIME,HB_TTOC,HB_CTOT,TIMESTAMP,ROUND_BANKER,EXISTS,EXTRACT,POSITION,OVERLAY,ARRAY,ROW,JSON_VALUE,JSON_QUERY,JSON_EXISTS,JSON_TABLE,JSON_OBJECT,JSON_ARRAY,JSON_OBJECTAGG,JSON_ARRAYAGG,XMLELEMENT,XMLFOREST,XMLAGG,GREATEST,LEAST,LPAD,RPAD,ANY_VALUE,BOOL_AND,BOOL_OR"
#endif

66
_FiveSql2/src/TFiveSQL.prg Normal file
View File

@@ -0,0 +1,66 @@
/*
* TFiveSQL.prg — Main facade class for FiveSql2 engine
*
* Uses TSqlParser2 (Pratt parser) exclusively.
*
* 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 TFiveSQL
DATA oLexer
DATA oParser
DATA oExec
DATA aParams INIT {}
METHOD New( aParams ) CONSTRUCTOR
METHOD Execute( cSQL )
METHOD ExecuteWith( cSQL, aParams )
ENDCLASS
METHOD New( aParams ) CLASS TFiveSQL
IF aParams != NIL
::aParams := aParams
ENDIF
RETURN SELF
METHOD Execute( cSQL ) CLASS TFiveSQL
LOCAL aTokens, hQuery, aResult
/* Parse — no caching (plan trees are mutated during execution) */
::oLexer := TSqlLexer():New( cSQL )
::oLexer:Tokenize()
aTokens := ::oLexer:GetTokens()
::oParser := TSqlParser2():New( aTokens, ::aParams )
hQuery := ::oParser:Parse()
IF hQuery == NIL
RETURN { { "__error__" }, { { SQL_ERR_SYNTAX, "Failed to parse SQL", cSQL } } }
ENDIF
::oExec := TSqlExecutor():New( hQuery, ::aParams )
aResult := ::oExec:Run()
RETURN aResult
METHOD ExecuteWith( cSQL, aParams ) CLASS TFiveSQL
::aParams := aParams
RETURN ::Execute( cSQL )

336
_FiveSql2/src/TSqlAgg.prg Normal file
View File

@@ -0,0 +1,336 @@
/*
* TSqlAgg.prg — GROUP BY aggregation and HAVING filter
*
* FiveSql — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "hbclass.ch"
#include "FiveSqlDef.ch"
CLASS TSqlAgg
METHOD New() CONSTRUCTOR
METHOD GroupBy( aRows, aFN, aCols, aGroupBy, xHaving, aTables, aParams )
METHOD ComputeAgg( xE, aGR, aFN )
METHOD FindColIdx( xExpr, aFN )
METHOD FindColIdx2( cN, aFN )
METHOD EvalHaving( xHaving, aNewRow, aCols, aGroupRows, aFN, aParams )
METHOD HasAgg( aCols )
METHOD EvalHavingExpr( xE, aNewRow, aCols, aGR, aFN, aParams )
ENDCLASS
METHOD New() CLASS TSqlAgg
RETURN SELF
METHOD HasAgg( aCols ) CLASS TSqlAgg
LOCAL i
FOR i := 1 TO Len( aCols )
IF SqlExprHasAgg( aCols[ i ][ 1 ] )
RETURN .T.
ENDIF
NEXT
RETURN .F.
METHOD GroupBy( aRows, aFN, aCols, aGroupBy, xHaving, aTables, aParams ) CLASS TSqlAgg
LOCAL hGroups := { => }
LOCAL i, j, cKey, aGroupRows, aResult := {}
LOCAL aNewRow
LOCAL nGCol, cN, nCI, lPass
/* Aggregate on empty set */
IF Len( aRows ) == 0 .AND. ::HasAgg( aCols )
aNewRow := {}
FOR j := 1 TO Len( aCols )
IF SqlExprHasAgg( aCols[ j ][ 1 ] )
AAdd( aNewRow, 0 )
ELSE
AAdd( aNewRow, NIL )
ENDIF
NEXT
RETURN { aNewRow }
ENDIF
/* Build group buckets */
IF Len( aGroupBy ) == 0 .AND. ::HasAgg( aCols )
hGroups[ "__ALL__" ] := aRows
ELSE
FOR i := 1 TO Len( aRows )
cKey := ""
FOR j := 1 TO Len( aGroupBy )
nGCol := ::FindColIdx( aGroupBy[ j ], aFN )
IF nGCol > 0 .AND. nGCol <= Len( aRows[ i ] )
cKey += SqlValToStr( aRows[ i ][ nGCol ] ) + "|"
ENDIF
NEXT
IF ! hb_HHasKey( hGroups, cKey )
hGroups[ cKey ] := {}
ENDIF
AAdd( hGroups[ cKey ], aRows[ i ] )
NEXT
ENDIF
/* Compute aggregates for each group */
FOR EACH aGroupRows IN hb_HValues( hGroups )
aNewRow := {}
FOR j := 1 TO Len( aCols )
IF SqlExprHasAgg( aCols[ j ][ 1 ] )
AAdd( aNewRow, ::ComputeAgg( aCols[ j ][ 1 ], aGroupRows, aFN ) )
ELSE
cN := SqlExprName( aCols[ j ][ 1 ] )
nCI := ::FindColIdx2( cN, aFN )
IF nCI > 0 .AND. Len( aGroupRows ) > 0 .AND. nCI <= Len( aGroupRows[ 1 ] )
AAdd( aNewRow, aGroupRows[ 1 ][ nCI ] )
ELSE
AAdd( aNewRow, NIL )
ENDIF
ENDIF
NEXT
/* HAVING filter */
IF xHaving != NIL
lPass := ::EvalHaving( xHaving, aNewRow, aCols, aGroupRows, aFN, aParams )
IF ! lPass
LOOP
ENDIF
ENDIF
AAdd( aResult, aNewRow )
NEXT
RETURN aResult
METHOD FindColIdx( xExpr, aFN ) CLASS TSqlAgg
LOCAL cN, i
IF xExpr != NIL .AND. xExpr[ 1 ] == ND_COL
cN := Upper( xExpr[ 2 ] )
IF "." $ cN
cN := SubStr( cN, At( ".", cN ) + 1 )
ENDIF
FOR i := 1 TO Len( aFN )
IF Upper( aFN[ i ] ) == cN
RETURN i
ENDIF
NEXT
ENDIF
RETURN 0
METHOD FindColIdx2( cN, aFN ) CLASS TSqlAgg
LOCAL i
cN := Upper( cN )
FOR i := 1 TO Len( aFN )
IF Upper( aFN[ i ] ) == cN
RETURN i
ENDIF
NEXT
RETURN 0
METHOD ComputeAgg( xE, aGR, aFN ) CLASS TSqlAgg
LOCAL cFunc, cArgName, nCol, i, xVal
LOCAL nCount := 0, nSum := 0, xMin := NIL, xMax := NIL
LOCAL cResult, cSep
LOCAL xArg
IF xE == NIL .OR. xE[ 1 ] != ND_FN
RETURN 0
ENDIF
cFunc := Upper( xE[ 2 ] )
IF Len( xE[ 3 ] ) > 0
xArg := xE[ 3 ][ 1 ]
IF xArg[ 1 ] == ND_COL .AND. xArg[ 2 ] == "*"
IF cFunc == "COUNT"
RETURN Len( aGR )
ENDIF
RETURN 0
ENDIF
cArgName := SqlExprName( xArg )
ELSE
IF cFunc == "COUNT"
RETURN Len( aGR )
ENDIF
RETURN 0
ENDIF
nCol := ::FindColIdx2( cArgName, aFN )
IF nCol == 0 .AND. xArg[ 1 ] == ND_COL
IF cFunc == "COUNT"
RETURN Len( aGR )
ENDIF
RETURN 0
ENDIF
FOR i := 1 TO Len( aGR )
IF nCol > 0 .AND. nCol <= Len( aGR[ i ] )
xVal := aGR[ i ][ nCol ]
ELSEIF nCol == 0
/* Complex expression (CASE, BIN, etc.) inside aggregate:
* evaluate the expression tree against the current row data. */
xVal := SqlEvalRowExpr( xArg, aFN, aGR[ i ] )
ELSE
xVal := NIL
ENDIF
IF xVal != NIL
nCount++
nSum += SqlCoerceNum( xVal )
IF xMin == NIL .OR. SqlCoerceNum( xVal ) < SqlCoerceNum( xMin )
xMin := xVal
ENDIF
IF xMax == NIL .OR. SqlCoerceNum( xVal ) > SqlCoerceNum( xMax )
xMax := xVal
ENDIF
ENDIF
NEXT
DO CASE
CASE cFunc == "COUNT"
RETURN nCount
CASE cFunc == "SUM"
RETURN nSum
CASE cFunc == "AVG"
RETURN iif( nCount > 0, nSum / nCount, 0 )
CASE cFunc == "MIN"
RETURN iif( xMin != NIL, xMin, 0 )
CASE cFunc == "MAX"
RETURN iif( xMax != NIL, xMax, 0 )
CASE cFunc == "GROUP_CONCAT" .OR. cFunc == "STRING_AGG"
cResult := ""
cSep := ", "
FOR i := 1 TO Len( aGR )
IF nCol > 0 .AND. nCol <= Len( aGR[ i ] )
xVal := aGR[ i ][ nCol ]
ELSEIF nCol == 0
xVal := SqlEvalRowExpr( xArg, aFN, aGR[ i ] )
ELSE
xVal := NIL
ENDIF
IF xVal != NIL
IF ! Empty( cResult )
cResult += cSep
ENDIF
cResult += SqlCoerceStr( xVal )
ENDIF
NEXT
RETURN cResult
ENDCASE
RETURN 0
METHOD EvalHaving( xHaving, aNewRow, aCols, aGroupRows, aFN, aParams ) CLASS TSqlAgg
LOCAL xResult
xResult := ::EvalHavingExpr( xHaving, aNewRow, aCols, aGroupRows, aFN, aParams )
RETURN SqlIsTrue( xResult )
METHOD EvalHavingExpr( xE, aNewRow, aCols, aGR, aFN, aParams ) CLASS TSqlAgg
LOCAL xL, xR, cOp, i, nCI, cN
IF xE == NIL
RETURN NIL
ENDIF
DO CASE
CASE xE[ 1 ] == ND_LIT
RETURN xE[ 2 ]
CASE xE[ 1 ] == ND_NIL
RETURN NIL
CASE xE[ 1 ] == ND_COL
cN := xE[ 2 ]
IF "." $ cN
cN := SubStr( cN, At( ".", cN ) + 1 )
ENDIF
FOR i := 1 TO Len( aCols )
IF Upper( aCols[ i ][ 2 ] ) == Upper( cN ) .AND. i <= Len( aNewRow )
RETURN aNewRow[ i ]
ENDIF
NEXT
nCI := ::FindColIdx2( cN, aFN )
IF nCI > 0 .AND. Len( aGR ) > 0 .AND. nCI <= Len( aGR[ 1 ] )
RETURN aGR[ 1 ][ nCI ]
ENDIF
RETURN NIL
CASE xE[ 1 ] == ND_FN
IF SqlIsAggName( xE[ 2 ] )
RETURN ::ComputeAgg( xE, aGR, aFN )
ENDIF
RETURN NIL
CASE xE[ 1 ] == ND_BIN
cOp := xE[ 2 ]
IF cOp == "AND"
xL := ::EvalHavingExpr( xE[ 3 ], aNewRow, aCols, aGR, aFN, aParams )
xR := ::EvalHavingExpr( xE[ 4 ], aNewRow, aCols, aGR, aFN, aParams )
RETURN SqlIsTrue( xL ) .AND. SqlIsTrue( xR )
ENDIF
IF cOp == "OR"
xL := ::EvalHavingExpr( xE[ 3 ], aNewRow, aCols, aGR, aFN, aParams )
xR := ::EvalHavingExpr( xE[ 4 ], aNewRow, aCols, aGR, aFN, aParams )
RETURN SqlIsTrue( xL ) .OR. SqlIsTrue( xR )
ENDIF
xL := ::EvalHavingExpr( xE[ 3 ], aNewRow, aCols, aGR, aFN, aParams )
xR := ::EvalHavingExpr( xE[ 4 ], aNewRow, aCols, aGR, aFN, aParams )
xL := SqlCoerceForCmp( xL )
xR := SqlCoerceForCmp( xR )
IF cOp == "=" .OR. cOp == "=="
RETURN SqlCmpEq( xL, xR )
ENDIF
IF cOp == "<>" .OR. cOp == "!="
RETURN ! SqlCmpEq( xL, xR )
ENDIF
IF cOp == ">"
RETURN SqlCmpLt( xR, xL )
ENDIF
IF cOp == "<"
RETURN SqlCmpLt( xL, xR )
ENDIF
IF cOp == ">="
RETURN SqlCmpEq( xL, xR ) .OR. SqlCmpLt( xR, xL )
ENDIF
IF cOp == "<="
RETURN SqlCmpEq( xL, xR ) .OR. SqlCmpLt( xL, xR )
ENDIF
RETURN NIL
CASE xE[ 1 ] == ND_UNI
IF xE[ 2 ] == "NOT"
xL := ::EvalHavingExpr( xE[ 3 ], aNewRow, aCols, aGR, aFN, aParams )
RETURN ! SqlIsTrue( xL )
ENDIF
RETURN NIL
ENDCASE
RETURN NIL

246
_FiveSql2/src/TSqlAlias.prg Normal file
View File

@@ -0,0 +1,246 @@
/*
* TSqlAlias.prg — Central alias manager for FiveSql
*
* Eliminates hardcoded alias names and prevents workarea collisions.
* Every table open goes through this manager, which:
* - Generates unique, non-colliding alias names
* - Tracks all open workareas per query execution
* - Closes all managed workareas on cleanup
* - Handles self-join (same table opened multiple times)
*
* Usage:
* oAlias := TSqlAlias():New()
* cAlias := oAlias:Acquire( "employees", "e" ) // returns "FA_001"
* cAlias := oAlias:Acquire( "employees", "m" ) // returns "FA_002" (independent)
* oAlias:Release( cAlias ) // closes one workarea
* oAlias:ReleaseAll() // closes all managed workareas
*
* FiveSql — 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"
STATIC s_nGlobalSeq := 0 /* global sequence counter — never resets */
CLASS TSqlAlias
DATA aSlots /* array of { cAlias, cTable, cUserAlias, lOpen } */
METHOD New() CONSTRUCTOR
METHOD Acquire( cTable, cUserAlias )
METHOD AcquireCTE( cCteName )
METHOD AcquireTemp( cPurpose )
METHOD FindByUser( cUserAlias )
METHOD FindByTable( cTable )
METHOD RealAlias( cUserAlias )
METHOD Release( cAlias )
METHOD ReleaseAll()
METHOD IsManaged( cAlias )
ENDCLASS
METHOD New() CLASS TSqlAlias
::aSlots := {}
RETURN SELF
/*
* Acquire — open a table and return a unique alias name.
*
* cTable: DBF file name (without .dbf extension)
* cUserAlias: the alias the SQL query uses (e.g., "e", "m", "t")
*
* Returns: the actual Harbour alias assigned (e.g., "FA_001")
* or "" if the table cannot be opened.
*
* The same table can be acquired multiple times with different user
* aliases — each gets an independent workarea. This is how self-join
* works: "FROM employees e JOIN employees m" opens two copies.
*/
METHOD Acquire( cTable, cUserAlias ) CLASS TSqlAlias
LOCAL cAlias, cDbfFile, nWA
s_nGlobalSeq++
cAlias := "FA_" + StrZero( s_nGlobalSeq, 4 )
cDbfFile := Lower( cTable )
IF ! ( ".dbf" $ cDbfFile )
cDbfFile := cDbfFile + ".dbf"
ENDIF
/* Open the table with unique alias */
BEGIN SEQUENCE
USE ( cDbfFile ) NEW SHARED ALIAS ( cAlias )
RECOVER
/* Try exclusive if shared fails */
BEGIN SEQUENCE
USE ( cDbfFile ) NEW EXCLUSIVE ALIAS ( cAlias )
RECOVER
RETURN ""
END SEQUENCE
END SEQUENCE
AAdd( ::aSlots, { cAlias, Upper( cTable ), Upper( cUserAlias ), .T. } )
RETURN cAlias
/*
* AcquireCTE — open a CTE temp DBF with unique alias.
* CTE temp files are named "__cte_<name>.dbf".
*/
METHOD AcquireCTE( cCteName ) CLASS TSqlAlias
LOCAL cAlias, cDbfFile
s_nGlobalSeq++
cAlias := "FA_" + StrZero( s_nGlobalSeq, 4 )
cDbfFile := "__cte_" + Lower( cCteName ) + ".dbf"
BEGIN SEQUENCE
USE ( cDbfFile ) NEW SHARED ALIAS ( cAlias )
RECOVER
RETURN ""
END SEQUENCE
AAdd( ::aSlots, { cAlias, Upper( cCteName ), Upper( cCteName ), .T. } )
RETURN cAlias
/*
* AcquireTemp — create a unique alias for temp/derived tables.
*/
METHOD AcquireTemp( cPurpose ) CLASS TSqlAlias
LOCAL cAlias
s_nGlobalSeq++
cAlias := "FA_" + StrZero( s_nGlobalSeq, 4 )
AAdd( ::aSlots, { cAlias, cPurpose, cPurpose, .F. } )
RETURN cAlias
/*
* FindByUser — find the real Harbour alias for a user-specified alias.
* Example: FindByUser("e") returns "FA_001"
*/
METHOD FindByUser( cUserAlias ) CLASS TSqlAlias
LOCAL i, cUpper
cUpper := Upper( cUserAlias )
FOR i := Len( ::aSlots ) TO 1 STEP -1
IF ::aSlots[ i ][ 3 ] == cUpper .AND. ::aSlots[ i ][ 4 ]
RETURN ::aSlots[ i ][ 1 ]
ENDIF
NEXT
RETURN ""
/*
* FindByTable — find the real alias for a table name.
* Returns the FIRST open alias for this table.
*/
METHOD FindByTable( cTable ) CLASS TSqlAlias
LOCAL i, cUpper
cUpper := Upper( cTable )
FOR i := 1 TO Len( ::aSlots )
IF ::aSlots[ i ][ 2 ] == cUpper .AND. ::aSlots[ i ][ 4 ]
RETURN ::aSlots[ i ][ 1 ]
ENDIF
NEXT
RETURN ""
/*
* RealAlias — resolve any alias reference to the actual Harbour alias.
* Checks user alias first, then table name.
*/
METHOD RealAlias( cUserAlias ) CLASS TSqlAlias
LOCAL cResult
cResult := ::FindByUser( cUserAlias )
IF ! Empty( cResult )
RETURN cResult
ENDIF
RETURN ::FindByTable( cUserAlias )
/*
* Release — close one managed workarea.
*/
METHOD Release( cAlias ) CLASS TSqlAlias
LOCAL i, nWA
FOR i := 1 TO Len( ::aSlots )
IF ::aSlots[ i ][ 1 ] == cAlias .AND. ::aSlots[ i ][ 4 ]
nWA := Select( cAlias )
IF nWA > 0
dbSelectArea( nWA )
dbCloseArea()
ENDIF
::aSlots[ i ][ 4 ] := .F.
RETURN NIL
ENDIF
NEXT
RETURN NIL
/*
* ReleaseAll — close ALL managed workareas.
* Called at the end of query execution.
*/
METHOD ReleaseAll() CLASS TSqlAlias
LOCAL i, nWA
FOR i := 1 TO Len( ::aSlots )
IF ::aSlots[ i ][ 4 ]
nWA := Select( ::aSlots[ i ][ 1 ] )
IF nWA > 0
dbSelectArea( nWA )
dbCloseArea()
ENDIF
::aSlots[ i ][ 4 ] := .F.
ENDIF
NEXT
::aSlots := {}
RETURN NIL
/*
* IsManaged — check if an alias was opened by this manager.
*/
METHOD IsManaged( cAlias ) CLASS TSqlAlias
LOCAL i
FOR i := 1 TO Len( ::aSlots )
IF ::aSlots[ i ][ 1 ] == cAlias
RETURN .T.
ENDIF
NEXT
RETURN .F.

1056
_FiveSql2/src/TSqlDDL.prg Normal file
View File

File diff suppressed because it is too large Load Diff

2733
_FiveSql2/src/TSqlExecutor.prg Normal file
View File

File diff suppressed because it is too large Load Diff

330
_FiveSql2/src/TSqlExpr.prg Normal file
View File

@@ -0,0 +1,330 @@
/*
* TSqlExpr.prg — Expression AST node constructor
*
* FiveSql — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "FiveSqlDef.ch"
/* Expression node: { nKind, xValue, xLeft, xRight, xExtra } */
FUNCTION SqlNode( nKind, xVal, xL, xR, xE )
RETURN { nKind, xVal, xL, xR, xE }
/* Derive a display name from an expression node */
FUNCTION SqlExprName( xE )
LOCAL cR
IF xE == NIL
RETURN "?"
ENDIF
IF xE[ 1 ] == ND_COL
cR := xE[ 2 ]
IF "." $ cR
RETURN SubStr( cR, At( ".", cR ) + 1 )
ENDIF
RETURN cR
ENDIF
IF xE[ 1 ] == ND_FN
RETURN xE[ 2 ] + "(...)"
ENDIF
IF xE[ 1 ] == ND_WINDOW
RETURN xE[ 2 ] + "(...)"
ENDIF
IF xE[ 1 ] == ND_LIT
RETURN SqlValToStr( xE[ 2 ] )
ENDIF
RETURN "expr"
/* Check whether an expression node is an aggregate function call */
FUNCTION SqlExprHasAgg( xE )
IF xE == NIL
RETURN .F.
ENDIF
IF xE[ 1 ] == ND_FN .AND. SqlIsAggName( xE[ 2 ] )
RETURN .T.
ENDIF
RETURN .F.
/* Return .T. if the function name is an aggregate */
FUNCTION SqlIsAggName( c )
RETURN ( "," + c + "," ) $ ( "," + AGG_FUNCTIONS + "," )
/* Return .T. if the function name is a recognized scalar */
FUNCTION SqlIsScalarName( c )
RETURN ( "," + c + "," ) $ ( "," + SCALAR_FUNCTIONS + "," )
/* Convert any value to string (NULL-safe) */
FUNCTION SqlValToStr( x )
IF x == NIL
RETURN "NULL"
ENDIF
DO CASE
CASE ValType( x ) == "C" ; RETURN AllTrim( x )
CASE ValType( x ) == "N" ; RETURN AllTrim( Str( x ) )
CASE ValType( x ) == "D" ; RETURN DToC( x )
CASE ValType( x ) == "L" ; RETURN iif( x, ".T.", ".F." )
CASE ValType( x ) == "T" ; RETURN hb_TToC( x )
ENDCASE
RETURN ""
/* Constant folding: pre-compute literal expressions at parse time */
FUNCTION SqlFoldConst( xExpr )
LOCAL xL, xR, cOp, xResult, nPI
IF xExpr == NIL
RETURN NIL
ENDIF
DO CASE
CASE xExpr[ 1 ] == ND_LIT .OR. xExpr[ 1 ] == ND_NIL .OR. ;
xExpr[ 1 ] == ND_COL .OR. xExpr[ 1 ] == ND_PAR .OR. ;
xExpr[ 1 ] == ND_SUB
RETURN xExpr
CASE xExpr[ 1 ] == ND_BIN
xExpr[ 3 ] := SqlFoldConst( xExpr[ 3 ] )
xExpr[ 4 ] := SqlFoldConst( xExpr[ 4 ] )
IF xExpr[ 3 ] != NIL .AND. xExpr[ 3 ][ 1 ] == ND_LIT .AND. ;
xExpr[ 4 ] != NIL .AND. xExpr[ 4 ][ 1 ] == ND_LIT
cOp := xExpr[ 2 ]
xL := xExpr[ 3 ][ 2 ]
xR := xExpr[ 4 ][ 2 ]
xResult := NIL
IF cOp == "+"
IF ValType( xL ) == "C" .AND. ValType( xR ) == "C"
xResult := xL + xR
ELSEIF ValType( xL ) == "N" .AND. ValType( xR ) == "N"
xResult := xL + xR
ENDIF
ELSEIF cOp == "-" .AND. ValType( xL ) == "N" .AND. ValType( xR ) == "N"
xResult := xL - xR
ELSEIF cOp == "*" .AND. ValType( xL ) == "N" .AND. ValType( xR ) == "N"
xResult := xL * xR
ELSEIF cOp == "/" .AND. ValType( xL ) == "N" .AND. ValType( xR ) == "N" .AND. xR != 0
xResult := xL / xR
ELSEIF cOp == "||" .AND. ValType( xL ) == "C" .AND. ValType( xR ) == "C"
xResult := xL + xR
ENDIF
IF xResult != NIL
RETURN SqlNode( ND_LIT, xResult, NIL, NIL, NIL )
ENDIF
ENDIF
RETURN xExpr
CASE xExpr[ 1 ] == ND_UNI
xExpr[ 3 ] := SqlFoldConst( xExpr[ 3 ] )
IF xExpr[ 3 ] != NIL .AND. xExpr[ 3 ][ 1 ] == ND_LIT
IF xExpr[ 2 ] == "-" .AND. ValType( xExpr[ 3 ][ 2 ] ) == "N"
RETURN SqlNode( ND_LIT, -xExpr[ 3 ][ 2 ], NIL, NIL, NIL )
ENDIF
ENDIF
RETURN xExpr
CASE xExpr[ 1 ] == ND_FN
IF ValType( xExpr[ 3 ] ) == "A"
xL := AClone( xExpr[ 3 ] )
FOR nPI := 1 TO Len( xL )
xL[ nPI ] := SqlFoldConst( xL[ nPI ] )
NEXT
xExpr[ 3 ] := xL
ENDIF
RETURN xExpr
CASE xExpr[ 1 ] == ND_CASE
IF ValType( xExpr[ 2 ] ) == "A"
FOR nPI := 1 TO Len( xExpr[ 2 ] )
xExpr[ 2 ][ nPI ][ 1 ] := SqlFoldConst( xExpr[ 2 ][ nPI ][ 1 ] )
xExpr[ 2 ][ nPI ][ 2 ] := SqlFoldConst( xExpr[ 2 ][ nPI ][ 2 ] )
NEXT
ENDIF
xExpr[ 3 ] := SqlFoldConst( xExpr[ 3 ] )
RETURN xExpr
CASE xExpr[ 1 ] == ND_RANGE
xExpr[ 3 ] := SqlFoldConst( xExpr[ 3 ] )
xExpr[ 4 ] := SqlFoldConst( xExpr[ 4 ] )
xExpr[ 5 ] := SqlFoldConst( xExpr[ 5 ] )
RETURN xExpr
CASE xExpr[ 1 ] == ND_WINDOW
/* Window functions cannot be constant-folded */
RETURN xExpr
ENDCASE
RETURN xExpr
/*
* Evaluate an expression against an in-memory row (no workarea).
* Used for recursive CTE where temp files cause conflicts.
*/
FUNCTION SqlEvalRowExpr( xExpr, aFN, aRow )
LOCAL xL, xR, cOp, cName, i
IF xExpr == NIL
RETURN NIL
ENDIF
DO CASE
CASE xExpr[ 1 ] == ND_LIT
RETURN xExpr[ 2 ]
CASE xExpr[ 1 ] == ND_NIL
RETURN NIL
CASE xExpr[ 1 ] == ND_COL
cName := Upper( xExpr[ 2 ] )
/* First try qualified name as-is (e.g. "E.MGR_ID") */
FOR i := 1 TO Len( aFN )
IF Upper( AllTrim( aFN[ i ] ) ) == cName .AND. i <= Len( aRow )
RETURN aRow[ i ]
ENDIF
NEXT
/* Fall back: strip alias prefix and match unqualified name */
IF "." $ cName
cName := SubStr( cName, At( ".", cName ) + 1 )
FOR i := 1 TO Len( aFN )
IF Upper( AllTrim( aFN[ i ] ) ) == cName .AND. i <= Len( aRow )
RETURN aRow[ i ]
ENDIF
NEXT
ENDIF
RETURN NIL
CASE xExpr[ 1 ] == ND_BIN
cOp := xExpr[ 2 ]
xL := SqlEvalRowExpr( xExpr[ 3 ], aFN, aRow )
xR := SqlEvalRowExpr( xExpr[ 4 ], aFN, aRow )
IF cOp == "+"
IF ValType( xL ) == "N" .AND. ValType( xR ) == "N"
RETURN xL + xR
ENDIF
RETURN SqlCoerceNum( xL ) + SqlCoerceNum( xR )
ENDIF
IF cOp == "-"
RETURN SqlCoerceNum( xL ) - SqlCoerceNum( xR )
ENDIF
IF cOp == "*"
RETURN SqlCoerceNum( xL ) * SqlCoerceNum( xR )
ENDIF
IF cOp == "AND"
RETURN SqlIsTrue( xL ) .AND. SqlIsTrue( xR )
ENDIF
IF cOp == "OR"
RETURN SqlIsTrue( xL ) .OR. SqlIsTrue( xR )
ENDIF
IF cOp == "="
RETURN SqlCmpEq( xL, xR )
ENDIF
IF cOp == "<"
RETURN SqlCmpLt( xL, xR )
ENDIF
IF cOp == ">"
RETURN SqlCmpLt( xR, xL )
ENDIF
IF cOp == "<="
RETURN SqlCmpEq( xL, xR ) .OR. SqlCmpLt( xL, xR )
ENDIF
IF cOp == ">="
RETURN SqlCmpEq( xL, xR ) .OR. SqlCmpLt( xR, xL )
ENDIF
IF cOp == "<>" .OR. cOp == "!="
RETURN ! SqlCmpEq( xL, xR )
ENDIF
RETURN NIL
CASE xExpr[ 1 ] == ND_CASE
IF ValType( xExpr[ 2 ] ) == "A"
FOR i := 1 TO Len( xExpr[ 2 ] )
xL := SqlEvalRowExpr( xExpr[ 2 ][ i ][ 1 ], aFN, aRow )
IF SqlIsTrue( xL )
RETURN SqlEvalRowExpr( xExpr[ 2 ][ i ][ 2 ], aFN, aRow )
ENDIF
NEXT
ENDIF
IF xExpr[ 3 ] != NIL
RETURN SqlEvalRowExpr( xExpr[ 3 ], aFN, aRow )
ENDIF
RETURN NIL
CASE xExpr[ 1 ] == ND_FN
IF Len( xExpr[ 3 ] ) > 0
RETURN SqlEvalFunc( xExpr[ 2 ], { SqlEvalRowExpr( xExpr[ 3 ][ 1 ], aFN, aRow ) } )
ENDIF
RETURN SqlEvalFunc( xExpr[ 2 ], {} )
CASE xExpr[ 1 ] == ND_UNI
xL := SqlEvalRowExpr( xExpr[ 3 ], aFN, aRow )
IF xExpr[ 2 ] == "NOT"
RETURN ! SqlIsTrue( xL )
ENDIF
IF xExpr[ 2 ] == "-"
RETURN -SqlCoerceNum( xL )
ENDIF
RETURN xL
ENDCASE
RETURN NIL
/* Collect all ND_COL leaf column names from an expression tree.
* Returns an array of bare (unqualified) column name strings. */
FUNCTION SqlCollectCols( xE, aCols )
LOCAL i
IF aCols == NIL
aCols := {}
ENDIF
IF xE == NIL
RETURN aCols
ENDIF
DO CASE
CASE xE[ 1 ] == ND_COL
IF xE[ 2 ] != "*"
AAdd( aCols, SqlExprName( xE ) )
ENDIF
CASE xE[ 1 ] == ND_BIN
SqlCollectCols( xE[ 3 ], aCols )
SqlCollectCols( xE[ 4 ], aCols )
CASE xE[ 1 ] == ND_UNI
SqlCollectCols( xE[ 3 ], aCols )
CASE xE[ 1 ] == ND_FN
IF ValType( xE[ 3 ] ) == "A"
FOR i := 1 TO Len( xE[ 3 ] )
SqlCollectCols( xE[ 3 ][ i ], aCols )
NEXT
ENDIF
CASE xE[ 1 ] == ND_CASE
IF ValType( xE[ 2 ] ) == "A"
FOR i := 1 TO Len( xE[ 2 ] )
SqlCollectCols( xE[ 2 ][ i ][ 1 ], aCols )
SqlCollectCols( xE[ 2 ][ i ][ 2 ], aCols )
NEXT
ENDIF
SqlCollectCols( xE[ 3 ], aCols )
ENDCASE
RETURN aCols

557
_FiveSql2/src/TSqlFunc.prg Normal file
View File

@@ -0,0 +1,557 @@
/*
* TSqlFunc.prg — Scalar function library and type coercion helpers
*
* FiveSql — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "FiveSqlDef.ch"
STATIC s_cCollation := ""
/* Evaluate a scalar or aggregate function by name */
FUNCTION SqlEvalFunc( cName, aArgs )
LOCAL i, xV, xV2, cS, nN, nN2, cRev
/* Aggregate functions return placeholder during row-level fetch */
IF SqlIsAggName( cName )
IF Len( aArgs ) > 0
RETURN aArgs[ 1 ]
ENDIF
RETURN 0
ENDIF
/* String functions */
DO CASE
CASE cName == "UPPER"
RETURN Upper( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "LOWER"
RETURN Lower( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "TRIM" .OR. cName == "ALLTRIM"
RETURN AllTrim( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "LTRIM"
RETURN LTrim( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "RTRIM"
RETURN RTrim( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "SUBSTR" .OR. cName == "SUBSTRING"
cS := SqlCoerceStr( SqlArg(aArgs,1) )
nN := Int( SqlCoerceNum( SqlArg(aArgs,2) ) )
IF Len( aArgs ) >= 3
RETURN SubStr( cS, nN, Int( SqlCoerceNum( SqlArg(aArgs,3) ) ) )
ENDIF
RETURN SubStr( cS, nN )
CASE cName == "LEFT"
RETURN Left( SqlCoerceStr( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
CASE cName == "RIGHT"
RETURN Right( SqlCoerceStr( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
CASE cName == "LEN" .OR. cName == "LENGTH"
RETURN Len( AllTrim( SqlCoerceStr( SqlArg(aArgs,1) ) ) )
CASE cName == "REPLACE"
RETURN StrTran( SqlCoerceStr( SqlArg(aArgs,1) ), SqlCoerceStr( SqlArg(aArgs,2) ), SqlCoerceStr( SqlArg(aArgs,3) ) )
CASE cName == "SPACE"
RETURN Space( Int( SqlCoerceNum( SqlArg(aArgs,1) ) ) )
CASE cName == "REPLICATE"
RETURN Replicate( SqlCoerceStr( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
CASE cName == "STUFF"
cS := SqlCoerceStr( SqlArg(aArgs,1) )
RETURN Left( cS, Int(SqlCoerceNum(SqlArg(aArgs,2))) - 1 ) + SqlCoerceStr( SqlArg(aArgs,4) ) + ;
SubStr( cS, Int(SqlCoerceNum(SqlArg(aArgs,2))) + Int(SqlCoerceNum(SqlArg(aArgs,3))) )
CASE cName == "CHARINDEX"
RETURN At( SqlCoerceStr( SqlArg(aArgs,1) ), SqlCoerceStr( SqlArg(aArgs,2) ) )
CASE cName == "CONCAT"
cS := ""
FOR i := 1 TO Len( aArgs )
cS += SqlCoerceStr( aArgs[ i ] )
NEXT
RETURN cS
/* Math functions */
CASE cName == "ABS"
RETURN Abs( SqlCoerceNum( SqlArg(aArgs,1) ) )
CASE cName == "ROUND"
RETURN Round( SqlCoerceNum( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
CASE cName == "INT" .OR. cName == "FLOOR"
RETURN Int( SqlCoerceNum( SqlArg(aArgs,1) ) )
CASE cName == "CEILING" .OR. cName == "CEIL"
nN := SqlCoerceNum( SqlArg(aArgs,1) )
IF nN == Int( nN )
RETURN nN
ENDIF
RETURN Int( nN ) + iif( nN > 0, 1, 0 )
CASE cName == "MOD"
nN2 := SqlCoerceNum( SqlArg(aArgs,2) )
IF nN2 != 0
RETURN SqlCoerceNum( SqlArg(aArgs,1) ) % nN2
ENDIF
RETURN 0
CASE cName == "POWER"
RETURN SqlCoerceNum( SqlArg(aArgs,1) ) ^ SqlCoerceNum( SqlArg(aArgs,2) )
CASE cName == "SQRT"
RETURN Sqrt( SqlCoerceNum( SqlArg(aArgs,1) ) )
CASE cName == "SIGN"
nN := SqlCoerceNum( SqlArg(aArgs,1) )
RETURN iif( nN > 0, 1, iif( nN < 0, -1, 0 ) )
/* Date/time functions */
CASE cName == "YEAR"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "D"
RETURN Year( xV )
ENDIF
RETURN 0
CASE cName == "MONTH"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "D"
RETURN Month( xV )
ENDIF
RETURN 0
CASE cName == "DAY"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "D"
RETURN Day( xV )
ENDIF
RETURN 0
CASE cName == "NOW"
RETURN hb_DateTime()
CASE cName == "DATE"
RETURN Date()
CASE cName == "TIME"
RETURN Time()
CASE cName == "DTOS"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "D"
RETURN DToS( xV )
ENDIF
RETURN ""
CASE cName == "DTOC"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "D"
RETURN DToC( xV )
ENDIF
RETURN ""
CASE cName == "CTOD"
RETURN CToD( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "STOD"
RETURN SToD( SqlCoerceStr( SqlArg(aArgs,1) ) )
/* Type conversion functions */
CASE cName == "STR"
IF Len( aArgs ) >= 2
RETURN Str( SqlCoerceNum( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
ENDIF
RETURN AllTrim( Str( SqlCoerceNum( SqlArg(aArgs,1) ) ) )
CASE cName == "VAL"
RETURN Val( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "CAST"
RETURN SqlArg(aArgs,1)
CASE cName == "CONVERT"
RETURN SqlArg(aArgs,1)
/* Conditional functions */
CASE cName == "IIF"
IF SqlIsTrue( SqlArg(aArgs,1) )
RETURN SqlArg(aArgs,2)
ENDIF
RETURN SqlArg(aArgs,3)
CASE cName == "COALESCE"
FOR i := 1 TO Len( aArgs )
IF aArgs[ i ] != NIL .AND. ;
!( ValType( aArgs[ i ] ) == "C" .AND. Empty( AllTrim( aArgs[ i ] ) ) )
RETURN aArgs[ i ]
ENDIF
NEXT
RETURN NIL
CASE cName == "NULLIF"
IF SqlCmpEq( SqlArg(aArgs,1), SqlArg(aArgs,2) )
RETURN NIL
ENDIF
RETURN SqlArg(aArgs,1)
/* Date arithmetic */
CASE cName == "DATEADD"
xV := SqlArg(aArgs,3)
nN := Int( SqlCoerceNum( SqlArg(aArgs,2) ) )
cS := Upper( SqlCoerceStr( SqlArg(aArgs,1) ) )
IF ValType( xV ) == "D"
IF cS == "D" .OR. cS == "DAY" .OR. cS == "DD"
RETURN xV + nN
ELSEIF cS == "M" .OR. cS == "MONTH" .OR. cS == "MM"
RETURN SToD( StrZero( Year(xV), 4 ) + StrZero( Month(xV) + nN, 2 ) + StrZero( Day(xV), 2 ) )
ELSEIF cS == "Y" .OR. cS == "YEAR" .OR. cS == "YY" .OR. cS == "YYYY"
RETURN SToD( StrZero( Year(xV) + nN, 4 ) + StrZero( Month(xV), 2 ) + StrZero( Day(xV), 2 ) )
ENDIF
ENDIF
RETURN xV
CASE cName == "DATEDIFF"
xV := SqlArg(aArgs,2)
xV2 := SqlArg(aArgs,3)
cS := Upper( SqlCoerceStr( SqlArg(aArgs,1) ) )
IF ValType( xV ) == "D" .AND. ValType( xV2 ) == "D"
IF cS == "D" .OR. cS == "DAY"
RETURN xV2 - xV
ELSEIF cS == "M" .OR. cS == "MONTH"
RETURN ( Year(xV2) - Year(xV) ) * 12 + ( Month(xV2) - Month(xV) )
ELSEIF cS == "Y" .OR. cS == "YEAR"
RETURN Year(xV2) - Year(xV)
ENDIF
ENDIF
RETURN 0
CASE cName == "EOMONTH"
xV := SqlArg(aArgs,1)
nN := iif( Len(aArgs) >= 2, Int( SqlCoerceNum( SqlArg(aArgs,2) ) ), 0 )
IF ValType( xV ) == "D"
xV := SToD( StrZero( Year(xV), 4 ) + StrZero( Month(xV) + nN + 1, 2 ) + "01" ) - 1
RETURN xV
ENDIF
RETURN NIL
/* Extended string functions */
CASE cName == "INSTR"
RETURN At( SqlCoerceStr( SqlArg(aArgs,1) ), SqlCoerceStr( SqlArg(aArgs,2) ) )
CASE cName == "REVERSE"
cS := SqlCoerceStr( SqlArg(aArgs,1) )
cRev := ""
FOR i := Len(cS) TO 1 STEP -1
cRev += SubStr( cS, i, 1 )
NEXT
RETURN cRev
CASE cName == "PADL"
RETURN PadL( SqlCoerceStr( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
CASE cName == "PADR"
RETURN PadR( SqlCoerceStr( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
CASE cName == "PADC"
RETURN PadC( SqlCoerceStr( SqlArg(aArgs,1) ), Int( SqlCoerceNum( SqlArg(aArgs,2) ) ) )
/* Type check functions */
CASE cName == "ISNUMERIC"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "N"
RETURN .T.
ELSEIF ValType( xV ) == "C"
RETURN Val( AllTrim( xV ) ) != 0 .OR. AllTrim( xV ) == "0"
ENDIF
RETURN .F.
CASE cName == "ISDATE"
xV := SqlArg(aArgs,1)
RETURN ValType( xV ) == "D"
CASE cName == "ISVALID"
RETURN SqlArg(aArgs,1) != NIL
CASE cName == "TYPEOF" .OR. cName == "TYPE"
xV := SqlArg(aArgs,1)
RETURN ValType( xV )
/* Timestamp functions */
CASE cName == "HB_HOUR"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "T"
RETURN hb_Hour( xV )
ENDIF
RETURN 0
CASE cName == "HB_MINUTE"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "T"
RETURN hb_Minute( xV )
ENDIF
RETURN 0
CASE cName == "HB_SECOND"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "T"
RETURN hb_Sec( xV )
ENDIF
RETURN 0
CASE cName == "HB_DATETIME"
RETURN hb_DateTime()
CASE cName == "HB_TTOC"
xV := SqlArg(aArgs,1)
IF ValType( xV ) == "T"
RETURN hb_TToC( xV )
ENDIF
RETURN ""
CASE cName == "HB_CTOT"
RETURN hb_CToT( SqlCoerceStr( SqlArg(aArgs,1) ) )
CASE cName == "TIMESTAMP"
RETURN hb_CToT( SqlCoerceStr( SqlArg(aArgs,1) ) )
/* Banker's rounding */
CASE cName == "ROUND_BANKER"
nN := SqlCoerceNum( SqlArg(aArgs,1) )
nN2 := iif( Len(aArgs) >= 2, Int( SqlCoerceNum( SqlArg(aArgs,2) ) ), 2 )
RETURN SqlBankerRound( nN, nN2 )
/* Format function */
CASE cName == "FORMAT"
nN := SqlCoerceNum( SqlArg(aArgs,1) )
nN2 := iif( Len(aArgs) >= 2, Int( SqlCoerceNum( SqlArg(aArgs,2) ) ), 2 )
RETURN AllTrim( Str( nN, 20, nN2 ) )
ENDCASE
RETURN NIL
/* Safe argument accessor */
FUNCTION SqlArg( a, n )
IF n <= Len( a )
RETURN a[ n ]
ENDIF
RETURN NIL
/* Coerce to string */
FUNCTION SqlCoerceStr( x )
IF x == NIL
RETURN ""
ENDIF
IF ValType( x ) == "C"
RETURN x
ENDIF
IF ValType( x ) == "N"
RETURN AllTrim( Str( x ) )
ENDIF
IF ValType( x ) == "D"
RETURN DToC( x )
ENDIF
IF ValType( x ) == "L"
RETURN iif( x, "T", "F" )
ENDIF
RETURN ""
/* Coerce to numeric */
FUNCTION SqlCoerceNum( x )
IF x == NIL
RETURN 0
ENDIF
IF ValType( x ) == "N"
RETURN x
ENDIF
IF ValType( x ) == "C"
RETURN Val( AllTrim( x ) )
ENDIF
IF ValType( x ) == "L"
RETURN iif( x, 1, 0 )
ENDIF
RETURN 0
/* Normalize for comparison: trim and uppercase strings */
FUNCTION SqlCoerceForCmp( x )
IF x == NIL
RETURN x
ENDIF
IF ValType( x ) == "C"
RETURN Upper( AllTrim( x ) )
ENDIF
RETURN x
/* Evaluate truthiness */
FUNCTION SqlIsTrue( x )
IF x == NIL
RETURN .F.
ENDIF
IF ValType( x ) == "L"
RETURN x
ENDIF
IF ValType( x ) == "N"
RETURN x != 0
ENDIF
IF ValType( x ) == "C"
RETURN ! Empty( x )
ENDIF
RETURN .F.
/* Case-insensitive equality comparison with cross-type coercion */
FUNCTION SqlCmpEq( a, b )
IF a == NIL .OR. b == NIL
RETURN a == NIL .AND. b == NIL
ENDIF
IF ValType( a ) == ValType( b )
IF ValType( a ) == "C"
RETURN Upper( AllTrim( a ) ) == Upper( AllTrim( b ) )
ENDIF
RETURN a == b
ENDIF
IF ValType( a ) == "N" .AND. ValType( b ) == "C"
RETURN a == Val( AllTrim( b ) )
ENDIF
IF ValType( a ) == "C" .AND. ValType( b ) == "N"
RETURN Val( AllTrim( a ) ) == b
ENDIF
RETURN .F.
/* Case-insensitive less-than comparison */
FUNCTION SqlCmpLt( a, b )
IF a == NIL .OR. b == NIL
RETURN .F.
ENDIF
IF ValType( a ) == ValType( b )
IF ValType( a ) == "C"
RETURN Upper( AllTrim( a ) ) < Upper( AllTrim( b ) )
ENDIF
RETURN a < b
ENDIF
IF ValType( a ) == "N" .AND. ValType( b ) == "C"
RETURN a < Val( AllTrim( b ) )
ENDIF
IF ValType( a ) == "C" .AND. ValType( b ) == "N"
RETURN Val( AllTrim( a ) ) < b
ENDIF
RETURN .F.
/* SQL LIKE pattern matching with optional escape character */
FUNCTION SqlLikeMatch( cStr, cPat, cEscape )
LOCAL nS, nP, nSLen, nPLen, chP, chS
IF ValType( cStr ) != "C" .OR. ValType( cPat ) != "C"
RETURN .F.
ENDIF
cStr := Upper( AllTrim( cStr ) )
cPat := Upper( AllTrim( cPat ) )
IF cEscape == NIL
cEscape := ""
ENDIF
IF ValType( cEscape ) == "C"
cEscape := Upper( AllTrim( cEscape ) )
ELSE
cEscape := ""
ENDIF
nSLen := Len( cStr )
nPLen := Len( cPat )
nS := 1
nP := 1
RETURN SqlLikeRecurse( cStr, cPat, nS, nP, nSLen, nPLen, cEscape )
/* Recursive LIKE matcher supporting %, _ and ESCAPE */
FUNCTION SqlLikeRecurse( cStr, cPat, nS, nP, nSLen, nPLen, cEsc )
LOCAL chP, chS
DO WHILE nP <= nPLen
chP := SubStr( cPat, nP, 1 )
/* Escape character: next pattern char is literal */
IF ! Empty( cEsc ) .AND. chP == cEsc .AND. nP < nPLen
nP++
chP := SubStr( cPat, nP, 1 )
IF nS > nSLen
RETURN .F.
ENDIF
chS := SubStr( cStr, nS, 1 )
IF chS != chP
RETURN .F.
ENDIF
nS++
nP++
LOOP
ENDIF
IF chP == "%"
/* Skip consecutive % */
DO WHILE nP <= nPLen .AND. SubStr( cPat, nP, 1 ) == "%"
nP++
ENDDO
IF nP > nPLen
RETURN .T.
ENDIF
DO WHILE nS <= nSLen
IF SqlLikeRecurse( cStr, cPat, nS, nP, nSLen, nPLen, cEsc )
RETURN .T.
ENDIF
nS++
ENDDO
RETURN .F.
ENDIF
IF chP == "_"
IF nS > nSLen
RETURN .F.
ENDIF
nS++
nP++
LOOP
ENDIF
/* Literal character match */
IF nS > nSLen
RETURN .F.
ENDIF
chS := SubStr( cStr, nS, 1 )
IF chS != chP
RETURN .F.
ENDIF
nS++
nP++
ENDDO
RETURN nS > nSLen
/* Banker's rounding (round half to even) */
FUNCTION SqlBankerRound( nVal, nDec )
LOCAL nFactor, nScaled, nInt, nFrac
IF nDec == NIL
nDec := 2
ENDIF
nFactor := 10 ^ nDec
nScaled := nVal * nFactor
nInt := Int( nScaled )
nFrac := Abs( nScaled - nInt )
IF Abs( nFrac - 0.5 ) > 0.0000001
RETURN Round( nVal, nDec )
ENDIF
IF nInt % 2 == 0
RETURN nInt / nFactor
ENDIF
IF nVal >= 0
RETURN ( nInt + 1 ) / nFactor
ENDIF
RETURN ( nInt - 1 ) / nFactor
/* Collation support */
FUNCTION SqlSetCollation( cCollation )
s_cCollation := Upper( AllTrim( cCollation ) )
IF s_cCollation != "NOCASE" .AND. ! Empty( s_cCollation )
hb_cdpSelect( s_cCollation )
ENDIF
RETURN NIL
FUNCTION SqlGetCollation()
RETURN s_cCollation

1050
_FiveSql2/src/TSqlIndex.prg Normal file
View File

File diff suppressed because it is too large Load Diff

208
_FiveSql2/src/TSqlLexer.prg Normal file
View File

@@ -0,0 +1,208 @@
/*
* TSqlLexer.prg — SQL lexical analyzer (tokenizer)
*
* FiveSql — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "hbclass.ch"
#include "FiveSqlDef.ch"
CLASS TSqlLexer
DATA cInput
DATA aTokens
DATA nLen
METHOD New( cSQL ) CONSTRUCTOR
METHOD Tokenize()
METHOD GetTokens()
ENDCLASS
METHOD New( cSQL ) CLASS TSqlLexer
::cInput := cSQL
::aTokens := {}
::nLen := Len( cSQL )
RETURN SELF
METHOD GetTokens() CLASS TSqlLexer
RETURN ::aTokens
METHOD Tokenize() CLASS TSqlLexer
LOCAL nPos, ch, cToken
nPos := 1
::aTokens := {}
WHILE nPos <= ::nLen
ch := SubStr( ::cInput, nPos, 1 )
/* Skip whitespace */
IF ch == " " .OR. ch == Chr(9) .OR. ch == Chr(10) .OR. ch == Chr(13)
nPos++
LOOP
ENDIF
/* Skip single-line comment: -- ... */
IF ch == "-" .AND. nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "-"
WHILE nPos <= ::nLen .AND. SubStr( ::cInput, nPos, 1 ) != Chr(10)
nPos++
ENDDO
LOOP
ENDIF
/* Skip block comment */
IF ch == "/" .AND. nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "*"
nPos += 2
WHILE nPos < ::nLen
IF SubStr( ::cInput, nPos, 1 ) == "*" .AND. SubStr( ::cInput, nPos + 1, 1 ) == "/"
nPos += 2
EXIT
ENDIF
nPos++
ENDDO
LOOP
ENDIF
/* String literal (single-quoted) */
IF ch == "'"
nPos++
cToken := ""
WHILE nPos <= ::nLen
ch := SubStr( ::cInput, nPos, 1 )
IF ch == "'"
IF nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "'"
cToken += "'"
nPos += 2
ELSE
nPos++
EXIT
ENDIF
ELSE
cToken += ch
nPos++
ENDIF
ENDDO
AAdd( ::aTokens, { TK_TEXT, cToken } )
LOOP
ENDIF
/* Numeric literal */
IF ch >= "0" .AND. ch <= "9"
cToken := ""
WHILE nPos <= ::nLen
ch := SubStr( ::cInput, nPos, 1 )
IF ( ch >= "0" .AND. ch <= "9" ) .OR. ch == "."
cToken += ch
nPos++
ELSE
EXIT
ENDIF
ENDDO
AAdd( ::aTokens, { TK_NUM, cToken } )
LOOP
ENDIF
/* Identifier or keyword */
IF IsAlpha( ch ) .OR. ch == "_"
cToken := ""
WHILE nPos <= ::nLen
ch := SubStr( ::cInput, nPos, 1 )
IF IsAlpha( ch ) .OR. IsDigit( ch ) .OR. ch == "_"
cToken += ch
nPos++
ELSE
EXIT
ENDIF
ENDDO
AAdd( ::aTokens, { TK_NAME, Upper( cToken ) } )
LOOP
ENDIF
/* Bracketed identifier: [column_name] */
IF ch == "["
nPos++
cToken := ""
WHILE nPos <= ::nLen .AND. SubStr( ::cInput, nPos, 1 ) != "]"
cToken += SubStr( ::cInput, nPos, 1 )
nPos++
ENDDO
IF nPos <= ::nLen
nPos++
ENDIF
AAdd( ::aTokens, { TK_NAME, Upper( cToken ) } )
LOOP
ENDIF
/* Positional parameter placeholder */
IF ch == "?"
AAdd( ::aTokens, { TK_QMARK, "?" } )
nPos++
LOOP
ENDIF
/* Punctuation and operators */
DO CASE
CASE ch == ","
AAdd( ::aTokens, { TK_COMMA, "," } ) ; nPos++
CASE ch == "."
AAdd( ::aTokens, { TK_DOT, "." } ) ; nPos++
CASE ch == "*"
AAdd( ::aTokens, { TK_STAR, "*" } ) ; nPos++
CASE ch == "("
AAdd( ::aTokens, { TK_LPAR, "(" } ) ; nPos++
CASE ch == ")"
AAdd( ::aTokens, { TK_RPAR, ")" } ) ; nPos++
CASE ch == "+"
AAdd( ::aTokens, { TK_PLUS, "+" } ) ; nPos++
CASE ch == "-"
AAdd( ::aTokens, { TK_MINUS, "-" } ) ; nPos++
CASE ch == "/"
AAdd( ::aTokens, { TK_SLASH, "/" } ) ; nPos++
CASE ch == "|"
IF nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "|"
AAdd( ::aTokens, { TK_PIPES, "||" } ) ; nPos += 2
ELSE
nPos++
ENDIF
CASE ch == "="
AAdd( ::aTokens, { TK_EQ, "=" } ) ; nPos++
CASE ch == "<"
IF nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "="
AAdd( ::aTokens, { TK_LTE, "<=" } ) ; nPos += 2
ELSEIF nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == ">"
AAdd( ::aTokens, { TK_NEQ, "<>" } ) ; nPos += 2
ELSE
AAdd( ::aTokens, { TK_LT, "<" } ) ; nPos++
ENDIF
CASE ch == ">"
IF nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "="
AAdd( ::aTokens, { TK_GTE, ">=" } ) ; nPos += 2
ELSE
AAdd( ::aTokens, { TK_GT, ">" } ) ; nPos++
ENDIF
CASE ch == "!"
IF nPos < ::nLen .AND. SubStr( ::cInput, nPos + 1, 1 ) == "="
AAdd( ::aTokens, { TK_NEQ, "!=" } ) ; nPos += 2
ELSE
nPos++
ENDIF
CASE ch == ";"
nPos++
OTHERWISE
nPos++
ENDCASE
ENDDO
/* End-of-input sentinel */
AAdd( ::aTokens, { TK_END, "" } )
RETURN SELF

2245
_FiveSql2/src/TSqlParser2.prg Normal file
View File

File diff suppressed because it is too large Load Diff

1173
_FiveSql2/src/TSqlParser_orig.prg Normal file
View File

File diff suppressed because it is too large Load Diff

166
_FiveSql2/src/TSqlSort.prg Normal file
View File

@@ -0,0 +1,166 @@
/*
* TSqlSort.prg — ORDER BY sorting and DISTINCT elimination
*
* FiveSql — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "hbclass.ch"
#include "FiveSqlDef.ch"
/* Module-level state for the sort comparator callback */
STATIC s_aOBCols := {}
STATIC s_aOBNames := {}
CLASS TSqlSort
METHOD New() CONSTRUCTOR
METHOD OrderBy( aRows, aFN, aOB, aTables, aParams )
METHOD Distinct( aRows )
METHOD RowKey( aR )
ENDCLASS
METHOD New() CLASS TSqlSort
RETURN SELF
METHOD OrderBy( aRows, aFN, aOB, aTables, aParams ) CLASS TSqlSort
LOCAL i, nCol
IF Len( aRows ) < 2 .OR. Len( aOB ) == 0
RETURN aRows
ENDIF
/* Pre-resolve column indexes */
s_aOBCols := {}
s_aOBNames := aFN
FOR i := 1 TO Len( aOB )
nCol := SqlFindColIdx( aOB[ i ][ 1 ], aFN )
IF nCol == 0
nCol := SqlFindColIdx2( SqlExprName( aOB[ i ][ 1 ] ), aFN )
ENDIF
AAdd( s_aOBCols, { nCol, aOB[ i ][ 2 ] } )
NEXT
ASort( aRows,,, {|a, b| SqlRowCompare( a, b ) < 0 } )
RETURN aRows
METHOD Distinct( aRows ) CLASS TSqlSort
LOCAL aR := {}, i, cKey
LOCAL hSeen := { => }
FOR i := 1 TO Len( aRows )
cKey := ::RowKey( aRows[ i ] )
IF ! hb_HHasKey( hSeen, cKey )
hSeen[ cKey ] := .T.
AAdd( aR, aRows[ i ] )
ENDIF
NEXT
RETURN aR
METHOD RowKey( aR ) CLASS TSqlSort
LOCAL c := "", i
FOR i := 1 TO Len( aR )
c += SqlValToStr( aR[ i ] ) + "|"
NEXT
RETURN c
/* Find column index from expression in field name array */
FUNCTION SqlFindColIdx( xExpr, aFN )
LOCAL cN, i
IF xExpr != NIL .AND. xExpr[ 1 ] == ND_COL
cN := Upper( xExpr[ 2 ] )
IF "." $ cN
cN := SubStr( cN, At( ".", cN ) + 1 )
ENDIF
FOR i := 1 TO Len( aFN )
IF Upper( aFN[ i ] ) == cN
RETURN i
ENDIF
NEXT
ENDIF
RETURN 0
/* Find column index by name */
FUNCTION SqlFindColIdx2( cN, aFN )
LOCAL i
cN := Upper( cN )
FOR i := 1 TO Len( aFN )
IF Upper( aFN[ i ] ) == cN
RETURN i
ENDIF
NEXT
RETURN 0
/* Multi-key row comparator for ASort */
FUNCTION SqlRowCompare( aRowA, aRowB )
LOCAL i, nCol, cDir, xA, xB, nCmp
FOR i := 1 TO Len( s_aOBCols )
nCol := s_aOBCols[ i ][ 1 ]
cDir := s_aOBCols[ i ][ 2 ]
IF nCol <= 0 .OR. nCol > Len( aRowA ) .OR. nCol > Len( aRowB )
LOOP
ENDIF
xA := aRowA[ nCol ]
xB := aRowB[ nCol ]
/* NULLs sort last */
IF xA == NIL .AND. xB == NIL
LOOP
ENDIF
IF xA == NIL
RETURN iif( cDir == "DESC", -1, 1 )
ENDIF
IF xB == NIL
RETURN iif( cDir == "DESC", 1, -1 )
ENDIF
nCmp := 0
IF ValType( xA ) == ValType( xB )
IF xA < xB
nCmp := -1
ELSEIF xA > xB
nCmp := 1
ENDIF
ELSEIF ValType( xA ) == "N" .AND. ValType( xB ) == "C"
nCmp := iif( xA < Val( AllTrim( xB ) ), -1, iif( xA > Val( AllTrim( xB ) ), 1, 0 ) )
ELSEIF ValType( xA ) == "C" .AND. ValType( xB ) == "N"
nCmp := iif( Val( AllTrim( xA ) ) < xB, -1, iif( Val( AllTrim( xA ) ) > xB, 1, 0 ) )
ENDIF
IF nCmp != 0
IF cDir == "DESC"
RETURN -nCmp
ENDIF
RETURN nCmp
ENDIF
NEXT
RETURN 0

220
_FiveSql2/src/TSqlTxn.prg Normal file
View File

@@ -0,0 +1,220 @@
/*
* TSqlTxn.prg — Transaction manager (BEGIN/COMMIT/ROLLBACK)
*
* FiveSql — SQL Engine for Harbour DBF/NTX
*
* Copyright (c) 2025 Charles KWON (Charles KWON OhJun)
* Email: charleskwonohjun@gmail.com
*
* All rights reserved.
*/
#include "hbclass.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
METHOD New() CONSTRUCTOR
METHOD Begin()
METHOD Commit()
METHOD Rollback()
METHOD RollbackTo( cName )
METHOD SetSavepoint( cName )
METHOD LogRecord( cAlias, nRecNo, cAction )
METHOD IsActive()
ENDCLASS
METHOD New() CLASS TSqlTxn
RETURN SELF
METHOD IsActive() CLASS TSqlTxn
RETURN s_lInTxn
METHOD Begin() CLASS TSqlTxn
s_aTxnLog := {}
s_lInTxn := .T.
s_hSavepoints := { => }
RETURN { { "result" }, { { "Transaction started" } } }
METHOD Commit() CLASS TSqlTxn
LOCAL nArea
IF ! s_lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction to COMMIT", "" } } }
ENDIF
FOR nArea := 1 TO 250
IF ( nArea )->( Used() )
dbSelectArea( nArea )
dbCommit()
ENDIF
NEXT
s_aTxnLog := {}
s_lInTxn := .F.
RETURN { { "result" }, { { "Transaction committed" } } }
METHOD Rollback() CLASS TSqlTxn
LOCAL i, j, cAlias, nRecNo, aFldVals, nWA, nSaved
LOCAL lOpened
IF ! s_lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction to ROLLBACK", "" } } }
ENDIF
nSaved := Select()
FOR i := Len( s_aTxnLog ) TO 1 STEP -1
cAlias := s_aTxnLog[ i ][ 1 ]
nRecNo := s_aTxnLog[ i ][ 2 ]
aFldVals := s_aTxnLog[ i ][ 3 ]
lOpened := .F.
nWA := Select( cAlias )
IF nWA == 0
BEGIN SEQUENCE
dbUseArea( .T., "DBFNTX", Lower( cAlias ) + ".dbf", cAlias, .F., .F. )
nWA := Select( cAlias )
lOpened := .T.
RECOVER
nWA := 0
END SEQUENCE
ENDIF
IF nWA > 0
dbSelectArea( nWA )
dbGoto( nRecNo )
IF dbRLock( nRecNo )
FOR j := 1 TO Len( aFldVals )
FieldPut( j, aFldVals[ j ] )
NEXT
IF Len( s_aTxnLog[ i ] ) >= 4 .AND. s_aTxnLog[ i ][ 4 ] == "INSERT"
dbDelete()
ENDIF
dbRUnlock( nRecNo )
ENDIF
dbCommit()
IF lOpened
dbCloseArea()
ENDIF
ENDIF
NEXT
dbSelectArea( nSaved )
s_aTxnLog := {}
s_lInTxn := .F.
RETURN { { "result" }, { { "Transaction rolled back" } } }
METHOD SetSavepoint( cName ) CLASS TSqlTxn
IF ! s_lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction for SAVEPOINT", "" } } }
ENDIF
IF s_hSavepoints == NIL
s_hSavepoints := { => }
ENDIF
s_hSavepoints[ Upper( cName ) ] := Len( s_aTxnLog )
RETURN { { "result" }, { { "Savepoint " + cName + " set" } } }
METHOD RollbackTo( cName ) CLASS TSqlTxn
LOCAL i, j, cAlias, nRecNo, aFldVals, nWA, nSaved, nSpPos
LOCAL lOpened
IF ! s_lInTxn
RETURN { { "__error__" }, { { SQL_ERR_TXN, "No active transaction for ROLLBACK TO", "" } } }
ENDIF
IF s_hSavepoints == NIL .OR. ! hb_HHasKey( s_hSavepoints, Upper( cName ) )
RETURN { { "__error__" }, { { SQL_ERR_TXN, "Savepoint " + cName + " not found", "" } } }
ENDIF
nSpPos := s_hSavepoints[ Upper( cName ) ]
nSaved := Select()
/* Undo log entries from end back to savepoint position */
FOR i := Len( s_aTxnLog ) TO nSpPos + 1 STEP -1
cAlias := s_aTxnLog[ i ][ 1 ]
nRecNo := s_aTxnLog[ i ][ 2 ]
aFldVals := s_aTxnLog[ i ][ 3 ]
lOpened := .F.
nWA := Select( cAlias )
IF nWA == 0
BEGIN SEQUENCE
dbUseArea( .T., "DBFNTX", Lower( cAlias ) + ".dbf", cAlias, .F., .F. )
nWA := Select( cAlias )
lOpened := .T.
RECOVER
nWA := 0
END SEQUENCE
ENDIF
IF nWA > 0
dbSelectArea( nWA )
dbGoto( nRecNo )
IF dbRLock( nRecNo )
FOR j := 1 TO Len( aFldVals )
FieldPut( j, aFldVals[ j ] )
NEXT
IF Len( s_aTxnLog[ i ] ) >= 4 .AND. s_aTxnLog[ i ][ 4 ] == "INSERT"
dbDelete()
ENDIF
dbRUnlock( nRecNo )
ENDIF
dbCommit()
IF lOpened
dbCloseArea()
ENDIF
ENDIF
NEXT
/* Trim the log back to the savepoint position */
ASize( s_aTxnLog, nSpPos )
dbSelectArea( nSaved )
RETURN { { "result" }, { { "Rolled back to savepoint " + cName } } }
METHOD LogRecord( cAlias, nRecNo, cAction ) CLASS TSqlTxn
LOCAL nWA, nSaved, aFldVals := {}, i
IF ! s_lInTxn
RETURN NIL
ENDIF
nSaved := Select()
nWA := Select( cAlias )
IF nWA > 0
dbSelectArea( nWA )
dbGoto( nRecNo )
FOR i := 1 TO FCount()
AAdd( aFldVals, FieldGet( i ) )
NEXT
AAdd( s_aTxnLog, { cAlias, nRecNo, aFldVals, cAction } )
ENDIF
dbSelectArea( nSaved )
RETURN NIL