fivedev/five
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
8a3f296e9a878e1308aa10e7bd640863f4ce8c2c
five/_FiveSql2/src/TSqlDDL.prg
CharlesKWON e368402682 chore: audit cleanup — remove orphan parser + dead TSqlIndex methods 
Opus 4.7 audit of the codebase surfaced several items that Opus 4.6
sessions left behind. This pass removes what's definitively dead and
fixes one trivial defensive bug; the real logic bugs (transaction
ordering, missing RunUpdate/RunDelete validation) come in a separate
commit.

Deletions:

- `_FiveSql2/src/TSqlParser_orig.prg` (1173 lines) — superseded by
  `TSqlParser2.prg` (Pratt). Production never instantiates the old
  parser; the only callers were the comparison/benchmark test files
  also being removed.
- `_FiveSql2/test/test_parser_cmp.prg` — compared orig vs Pratt AST,
  useless now that orig is gone.
- `_FiveSql2/test/bench_parser.prg` — benched both, same reason.
- `_FiveSql2/Makefile` `test_cmp:` and `bench:` targets referenced
  the removed files.
- `TSqlIndex.prg` methods `ApplyScope`, `ClearScope`, `ApplySeek`,
  `IndexInfo`, `CreateTempIndex`, `DropTempIndex` — each declared in
  the class header and implemented (~165 lines total) but zero
  callers anywhere in `_FiveSql2/` or `hbrtl/`. Class declarations
  removed alongside the bodies.

Small fixes:

- `TSqlDDL.prg:179-180` stale comment claiming Five doesn't support
  `@byref` — false since commit e95afad (2026-04-13) wired @byref
  via RefCell. The same method uses @nPos correctly elsewhere.
- `hbrt/class.go:tryBinaryOp` defensive nil-check on AsArray().
  IsObject() checks the type tag; a corrupted Value with tag=Object
  but ptr=nil would crash on `.Class`. Correct construction paths
  never hit this, but the guard is cheap.

Compat tests: FiveSql2 43/43, Harbour compat 56/56, Go test ALL PASS.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-04-18 22:46:17 +09:00

1056 lines
27 KiB
Plaintext
Raw Blame History

/*
* TSqlDDL.prg — DDL executor (CREATE, ALTER, DROP TABLE/INDEX/VIEW)
*
* 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 "dbstruct.ch"
#include "dbinfo.ch"
#include "FiveSqlDef.ch"
CLASS TSqlDDL
METHOD New() CONSTRUCTOR
METHOD CreateTable( aTokens, nPos )
METHOD CreateIndex( aTokens, nPos )
METHOD DropTable( aTokens, nPos )
METHOD DropIndex( aTokens, nPos )
METHOD AlterTable( aTokens, nPos )
METHOD CreateView( aTokens, nPos )
METHOD DropView( aTokens, nPos )
METHOD DDL_TT( aT, n )
METHOD DDL_TV( aT, n )
METHOD DDL_IsKW( aT, n, c )
METHOD DDL_EatKW( aT, n, c )
METHOD DDL_ExtractParens( aT, n )
ENDCLASS
METHOD New() CLASS TSqlDDL
RETURN SELF
/* Token accessor helpers for DDL (operate on passed-in token arrays) */
METHOD DDL_TT( aT, n ) CLASS TSqlDDL
IF n > 0 .AND. n <= Len( aT )
RETURN aT[ n ][ TK_TYPE ]
ENDIF
RETURN TK_END
METHOD DDL_TV( aT, n ) CLASS TSqlDDL
IF n > 0 .AND. n <= Len( aT )
RETURN aT[ n ][ TK_VALUE ]
ENDIF
RETURN ""
METHOD DDL_IsKW( aT, n, c ) CLASS TSqlDDL
RETURN ::DDL_TT( aT, n ) == TK_NAME .AND. ::DDL_TV( aT, n ) == c
METHOD DDL_EatKW( aT, n, c ) CLASS TSqlDDL
IF ::DDL_IsKW( aT, n, c )
n++
RETURN .T.
ENDIF
RETURN .F.
/* Extract text within parentheses as a flat string */
METHOD DDL_ExtractParens( aT, n ) CLASS TSqlDDL
LOCAL cResult := "", nDepth := 0
IF ::DDL_TT( aT, n ) == TK_LPAR
n++
ENDIF
DO WHILE n <= Len( aT ) .AND. ::DDL_TT( aT, n ) != TK_END
IF ::DDL_TT( aT, n ) == TK_LPAR
nDepth++
cResult += "("
n++
ELSEIF ::DDL_TT( aT, n ) == TK_RPAR
IF nDepth == 0
n++
EXIT
ENDIF
nDepth--
cResult += ")"
n++
ELSE
IF ! Empty( cResult )
cResult += " "
ENDIF
cResult += ::DDL_TV( aT, n )
n++
ENDIF
ENDDO
RETURN cResult
METHOD CreateTable( aTokens, nPos ) CLASS TSqlDDL
LOCAL cTable, aFields := {}, cCol, cType, nWidth, nDec, i
LOCAL cHbType, aPKCols := {}, aAutoIncCols := {}
LOCAL aUniqCols := {}, aCheckExprs := {}, aFKDefs := {}
LOCAL cFKCol, cFKRefTable, cFKRefCol
LOCAL nHandle, cMeta
LOCAL cCheckExpr, nCheckDepth
IF ::DDL_IsKW( aTokens, nPos, "TABLE" )
nPos++
ENDIF
cTable := ::DDL_TV( aTokens, nPos )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
WHILE ::DDL_TT( aTokens, nPos ) != TK_RPAR .AND. ::DDL_TT( aTokens, nPos ) != TK_END
/* PRIMARY KEY constraint */
IF ::DDL_IsKW( aTokens, nPos, "PRIMARY" )
nPos++
IF ::DDL_IsKW( aTokens, nPos, "KEY" )
nPos++
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
WHILE ::DDL_TT( aTokens, nPos ) == TK_NAME
AAdd( aPKCols, ::DDL_TV( aTokens, nPos ) )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
ENDDO
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
LOOP
ENDIF
/* Table-level CONSTRAINT keyword */
IF ::DDL_IsKW( aTokens, nPos, "CONSTRAINT" )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_NAME
nPos++ /* skip constraint name */
ENDIF
ENDIF
/* UNIQUE constraint (table-level) */
IF ::DDL_IsKW( aTokens, nPos, "UNIQUE" )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
WHILE ::DDL_TT( aTokens, nPos ) == TK_NAME
AAdd( aUniqCols, ::DDL_TV( aTokens, nPos ) )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
ENDDO
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
LOOP
ENDIF
/* CHECK constraint (table-level) — inline parens extraction. */
IF ::DDL_IsKW( aTokens, nPos, "CHECK" )
nPos++
cCheckExpr := ""
nCheckDepth := 0
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
ENDIF
DO WHILE nPos <= Len( aTokens ) .AND. ::DDL_TT( aTokens, nPos ) != TK_END
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nCheckDepth++
cCheckExpr += "("
nPos++
ELSEIF ::DDL_TT( aTokens, nPos ) == TK_RPAR
IF nCheckDepth == 0
nPos++
EXIT
ENDIF
nCheckDepth--
cCheckExpr += ")"
nPos++
ELSE
IF ! Empty( cCheckExpr )
cCheckExpr += " "
ENDIF
cCheckExpr += ::DDL_TV( aTokens, nPos )
nPos++
ENDIF
ENDDO
AAdd( aCheckExprs, cCheckExpr )
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
LOOP
ENDIF
/* FOREIGN KEY constraint (table-level) */
IF ::DDL_IsKW( aTokens, nPos, "FOREIGN" )
nPos++
IF ::DDL_IsKW( aTokens, nPos, "KEY" )
nPos++
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
cFKCol := ::DDL_TV( aTokens, nPos )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
IF ::DDL_IsKW( aTokens, nPos, "REFERENCES" )
nPos++
ENDIF
cFKRefTable := ::DDL_TV( aTokens, nPos )
nPos++
cFKRefCol := ""
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
cFKRefCol := ::DDL_TV( aTokens, nPos )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
AAdd( aFKDefs, { cFKCol, cFKRefTable, cFKRefCol } )
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
LOOP
ENDIF
/* Column name */
cCol := ::DDL_TV( aTokens, nPos )
nPos++
/* Data type */
cType := Upper( ::DDL_TV( aTokens, nPos ) )
nPos++
nWidth := 10
nDec := 0
cHbType := "C"
DO CASE
CASE cType $ "CHAR,CHARACTER,VARCHAR"
cHbType := "C"
nWidth := 10
CASE cType $ "NUMERIC,NUMBER,DECIMAL,DEC"
cHbType := "N"
nWidth := 10
nDec := 0
CASE cType $ "INT,INTEGER,SMALLINT,BIGINT"
cHbType := "N"
nWidth := 10
nDec := 0
CASE cType $ "DOUBLE,FLOAT,REAL"
cHbType := "N"
nWidth := 18
nDec := 6
CASE cType == "DATE"
cHbType := "D"
nWidth := 8
CASE cType $ "LOGICAL,BOOLEAN,BOOL"
cHbType := "L"
nWidth := 1
CASE cType $ "MEMO,TEXT,CLOB"
cHbType := "M"
nWidth := 10
CASE cType $ "TIMESTAMP,DATETIME"
cHbType := "T"
nWidth := 8
OTHERWISE
cHbType := "C"
nWidth := 10
ENDCASE
/* Optional width/precision */
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_NUM
nWidth := Val( ::DDL_TV( aTokens, nPos ) )
nPos++
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_NUM
nDec := Val( ::DDL_TV( aTokens, nPos ) )
nPos++
ENDIF
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
/* Skip NOT NULL, DEFAULT, AUTO_INCREMENT, IDENTITY */
WHILE ::DDL_IsKW( aTokens, nPos, "NOT" ) .OR. ::DDL_IsKW( aTokens, nPos, "NULL" ) .OR. ;
::DDL_IsKW( aTokens, nPos, "DEFAULT" ) .OR. ::DDL_IsKW( aTokens, nPos, "AUTO_INCREMENT" ) .OR. ;
::DDL_IsKW( aTokens, nPos, "IDENTITY" )
IF ::DDL_IsKW( aTokens, nPos, "AUTO_INCREMENT" ) .OR. ::DDL_IsKW( aTokens, nPos, "IDENTITY" )
AAdd( aAutoIncCols, cCol )
ENDIF
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_TEXT .OR. ::DDL_TT( aTokens, nPos ) == TK_NUM
nPos++
ENDIF
ENDDO
AAdd( aFields, { cCol, cHbType, nWidth, nDec } )
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
ENDDO
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
/* Execute: create the DBF file */
BEGIN SEQUENCE
dbCreate( Lower( cTable ) + ".dbf", aFields )
RECOVER
RETURN { { "error" }, { { "CREATE TABLE failed: " + cTable } } }
END SEQUENCE
/* Register auto-increment fields */
FOR i := 1 TO Len( aAutoIncCols )
SqlSetAutoInc( cTable, aAutoIncCols[ i ] )
NEXT
/* Primary key index */
IF Len( aPKCols ) > 0
BEGIN SEQUENCE
USE ( Lower( cTable ) + ".dbf" ) NEW EXCLUSIVE
INDEX ON &( SqlBuildIndexExpr( aPKCols ) ) TO ( Lower( cTable ) + "_pk.ntx" ) UNIQUE
CLOSE
RECOVER
END SEQUENCE
ENDIF
/* UNIQUE constraint index */
IF Len( aUniqCols ) > 0
BEGIN SEQUENCE
USE ( Lower( cTable ) + ".dbf" ) NEW EXCLUSIVE
INDEX ON &( SqlBuildIndexExpr( aUniqCols ) ) TO ( Lower( cTable ) + "_uq.ntx" ) UNIQUE
CLOSE
RECOVER
END SEQUENCE
ENDIF
/* Store CHECK and FOREIGN KEY constraints in .fsc metadata file */
IF Len( aCheckExprs ) > 0 .OR. Len( aFKDefs ) > 0 .OR. Len( aUniqCols ) > 0
cMeta := ""
FOR i := 1 TO Len( aCheckExprs )
cMeta += "CHECK:" + aCheckExprs[ i ] + Chr( 10 )
NEXT
FOR i := 1 TO Len( aFKDefs )
cMeta += "FK:" + aFKDefs[ i ][ 1 ] + ":" + aFKDefs[ i ][ 2 ] + ":" + aFKDefs[ i ][ 3 ] + Chr( 10 )
NEXT
FOR i := 1 TO Len( aUniqCols )
cMeta += "UNIQUE:" + aUniqCols[ i ] + Chr( 10 )
NEXT
nHandle := FCreate( Lower( cTable ) + ".fsc" )
IF nHandle >= 0
FWrite( nHandle, cMeta )
FClose( nHandle )
ENDIF
ENDIF
RETURN { { "result" }, { { "Table " + cTable + " created (" + hb_ntos( Len( aFields ) ) + " columns)" } } }
METHOD CreateIndex( aTokens, nPos ) CLASS TSqlDDL
LOCAL lUnique := .F., cIndex, cTable, aCols := {}, cExpr
IF ::DDL_IsKW( aTokens, nPos, "UNIQUE" )
lUnique := .T.
nPos++
ENDIF
IF ::DDL_IsKW( aTokens, nPos, "INDEX" )
nPos++
ENDIF
cIndex := ::DDL_TV( aTokens, nPos )
nPos++
::DDL_EatKW( aTokens, @nPos, "ON" )
cTable := ::DDL_TV( aTokens, nPos )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
WHILE ::DDL_TT( aTokens, nPos ) == TK_NAME
AAdd( aCols, ::DDL_TV( aTokens, nPos ) )
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
ENDIF
ENDDO
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
IF Len( aCols ) == 0
RETURN { { "error" }, { { "CREATE INDEX: no columns specified" } } }
ENDIF
cExpr := SqlBuildIndexExpr( aCols )
BEGIN SEQUENCE
USE ( Lower( cTable ) + ".dbf" ) NEW EXCLUSIVE
IF lUnique
INDEX ON &( cExpr ) TO ( Lower( cIndex ) + ".ntx" ) UNIQUE
ELSE
INDEX ON &( cExpr ) TO ( Lower( cIndex ) + ".ntx" )
ENDIF
CLOSE
RECOVER
RETURN { { "error" }, { { "CREATE INDEX failed: " + cIndex + " on " + cTable } } }
END SEQUENCE
RETURN { { "result" }, { { "Index " + cIndex + " created on " + cTable + " (" + cExpr + ")" } } }
METHOD DropTable( aTokens, nPos ) CLASS TSqlDDL
LOCAL cTable
IF ::DDL_IsKW( aTokens, nPos, "TABLE" )
nPos++
ENDIF
IF ::DDL_IsKW( aTokens, nPos, "IF" )
nPos++
::DDL_EatKW( aTokens, @nPos, "EXISTS" )
ENDIF
cTable := ::DDL_TV( aTokens, nPos )
nPos++
FErase( Lower( cTable ) + ".dbf" )
FErase( Lower( cTable ) + ".dbt" )
FErase( Lower( cTable ) + ".fpt" )
FErase( Lower( cTable ) + ".fsc" )
FErase( Lower( cTable ) + "_pk.ntx" )
FErase( Lower( cTable ) + "_uq.ntx" )
RETURN { { "result" }, { { "Table " + cTable + " dropped" } } }
METHOD DropIndex( aTokens, nPos ) CLASS TSqlDDL
LOCAL cIndex
IF ::DDL_IsKW( aTokens, nPos, "INDEX" )
nPos++
ENDIF
IF ::DDL_IsKW( aTokens, nPos, "IF" )
nPos++
::DDL_EatKW( aTokens, @nPos, "EXISTS" )
ENDIF
cIndex := ::DDL_TV( aTokens, nPos )
nPos++
FErase( Lower( cIndex ) + ".ntx" )
RETURN { { "result" }, { { "Index " + cIndex + " dropped" } } }
METHOD AlterTable( aTokens, nPos ) CLASS TSqlDDL
LOCAL cTable, cAction, cCol, cType, nWidth, nDec, cHbType
IF ::DDL_IsKW( aTokens, nPos, "TABLE" )
nPos++
ENDIF
cTable := ::DDL_TV( aTokens, nPos )
nPos++
cAction := Upper( ::DDL_TV( aTokens, nPos ) )
nPos++
IF ::DDL_IsKW( aTokens, nPos, "COLUMN" )
nPos++
ENDIF
IF cAction == "ADD"
cCol := ::DDL_TV( aTokens, nPos )
nPos++
cType := Upper( ::DDL_TV( aTokens, nPos ) )
nPos++
nWidth := 10
nDec := 0
DO CASE
CASE cType $ "CHAR,CHARACTER,VARCHAR"
cHbType := "C"
CASE cType $ "NUMERIC,NUMBER,INT,INTEGER"
cHbType := "N"
CASE cType == "DATE"
cHbType := "D"
nWidth := 8
CASE cType $ "LOGICAL,BOOLEAN"
cHbType := "L"
nWidth := 1
CASE cType $ "MEMO,TEXT"
cHbType := "M"
OTHERWISE
cHbType := "C"
ENDCASE
IF ::DDL_TT( aTokens, nPos ) == TK_LPAR
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_NUM
nWidth := Val( ::DDL_TV( aTokens, nPos ) )
nPos++
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_COMMA
nPos++
IF ::DDL_TT( aTokens, nPos ) == TK_NUM
nDec := Val( ::DDL_TV( aTokens, nPos ) )
nPos++
ENDIF
ENDIF
IF ::DDL_TT( aTokens, nPos ) == TK_RPAR
nPos++
ENDIF
ENDIF
RETURN SqlAlterAddColumn( cTable, cCol, cHbType, nWidth, nDec )
ELSEIF cAction == "DROP"
cCol := ::DDL_TV( aTokens, nPos )
nPos++
RETURN SqlAlterDropColumn( cTable, cCol )
ENDIF
RETURN { { "error" }, { { "ALTER TABLE: unsupported action " + cAction } } }
METHOD CreateView( aTokens, nPos ) CLASS TSqlDDL
LOCAL cView, cSQL, i, nHandle
IF ::DDL_IsKW( aTokens, nPos, "VIEW" )
nPos++
ENDIF
cView := ::DDL_TV( aTokens, nPos )
nPos++
::DDL_EatKW( aTokens, @nPos, "AS" )
cSQL := ""
FOR i := nPos TO Len( aTokens )
IF aTokens[ i ][ 1 ] == TK_END
EXIT
ENDIF
IF ! Empty( cSQL )
cSQL += " "
ENDIF
cSQL += aTokens[ i ][ 2 ]
NEXT
IF Empty( cSQL )
RETURN { { "error" }, { { "CREATE VIEW: empty SELECT" } } }
ENDIF
nHandle := FCreate( Lower( cView ) + ".fsv" )
IF nHandle < 0
RETURN { { "error" }, { { "CREATE VIEW: cannot create .fsv file" } } }
ENDIF
FWrite( nHandle, cSQL )
FClose( nHandle )
RETURN { { "result" }, { { "View " + cView + " created" } } }
METHOD DropView( aTokens, nPos ) CLASS TSqlDDL
LOCAL cView
IF ::DDL_IsKW( aTokens, nPos, "VIEW" )
nPos++
ENDIF
IF ::DDL_IsKW( aTokens, nPos, "IF" )
nPos++
::DDL_EatKW( aTokens, @nPos, "EXISTS" )
ENDIF
cView := ::DDL_TV( aTokens, nPos )
nPos++
FErase( Lower( cView ) + ".fsv" )
RETURN { { "result" }, { { "View " + cView + " dropped" } } }
/* Standalone helper functions used by DDL */
FUNCTION SqlBuildIndexExpr( aCols )
LOCAL cExpr := "", i
FOR i := 1 TO Len( aCols )
IF i > 1
cExpr += " + "
ENDIF
cExpr += aCols[ i ]
NEXT
RETURN cExpr
FUNCTION SqlAlterAddColumn( cTable, cCol, cType, nWidth, nDec )
LOCAL aStruct, cFile, cTmp, i
cFile := Lower( cTable ) + ".dbf"
cTmp := Lower( cTable ) + "_tmp.dbf"
BEGIN SEQUENCE
USE ( cFile ) NEW EXCLUSIVE ALIAS ALTSRC
aStruct := dbStruct()
AAdd( aStruct, { cCol, cType, nWidth, nDec } )
dbCreate( cTmp, aStruct )
USE ( cTmp ) NEW EXCLUSIVE ALIAS ALTDST
SELECT ALTSRC
dbGoTop()
WHILE ! Eof()
SELECT ALTDST
dbAppend()
FOR i := 1 TO FCount() - 1
IF i <= ALTSRC->( FCount() )
FieldPut( i, ALTSRC->( FieldGet( i ) ) )
ENDIF
NEXT
SELECT ALTSRC
dbSkip()
ENDDO
SELECT ALTSRC ; dbCloseArea() ; SELECT ALTDST ; dbCloseArea()
FErase( cFile )
FRename( cTmp, cFile )
RECOVER
RETURN { { "error" }, { { "ALTER TABLE ADD failed" } } }
END SEQUENCE
RETURN { { "result" }, { { "Column " + cCol + " added to " + cTable } } }
FUNCTION SqlAlterDropColumn( cTable, cCol )
LOCAL aStruct, aNewStruct := {}, cFile, cTmp, i, nOldPos
cFile := Lower( cTable ) + ".dbf"
cTmp := Lower( cTable ) + "_tmp.dbf"
BEGIN SEQUENCE
USE ( cFile ) NEW EXCLUSIVE ALIAS ALTSRC
aStruct := dbStruct()
FOR i := 1 TO Len( aStruct )
IF Upper( aStruct[ i ][ 1 ] ) != Upper( cCol )
AAdd( aNewStruct, aStruct[ i ] )
ENDIF
NEXT
IF Len( aNewStruct ) == Len( aStruct )
SELECT ALTSRC ; dbCloseArea()
Break( NIL )
ENDIF
dbCreate( cTmp, aNewStruct )
USE ( cTmp ) NEW EXCLUSIVE ALIAS ALTDST
SELECT ALTSRC
dbGoTop()
WHILE ! Eof()
SELECT ALTDST
dbAppend()
FOR i := 1 TO Len( aNewStruct )
nOldPos := ALTSRC->( FieldPos( aNewStruct[ i ][ 1 ] ) )
IF nOldPos > 0
FieldPut( i, ALTSRC->( FieldGet( nOldPos ) ) )
ENDIF
NEXT
SELECT ALTSRC
dbSkip()
ENDDO
SELECT ALTSRC ; dbCloseArea() ; SELECT ALTDST ; dbCloseArea()
FErase( cFile )
FRename( cTmp, cFile )
RECOVER
RETURN { { "error" }, { { "ALTER TABLE DROP failed: " + cCol } } }
END SEQUENCE
RETURN { { "result" }, { { "Column " + cCol + " dropped from " + cTable } } }
/* ======================================================================
* Constraint validation helpers
* ====================================================================== */
/* Load constraint metadata from .fsc file */
FUNCTION SqlLoadConstraints( cTable )
LOCAL cFile, cBuf, aLines, i, aParts
LOCAL hResult := { => }
hResult[ "check" ] := {}
hResult[ "fk" ] := {}
hResult[ "unique" ] := {}
cFile := Lower( cTable ) + ".fsc"
IF ! hb_FileExists( cFile )
RETURN hResult
ENDIF
cBuf := MemoRead( cFile )
aLines := hb_ATokens( cBuf, Chr( 10 ) )
FOR i := 1 TO Len( aLines )
IF Left( aLines[ i ], 6 ) == "CHECK:"
AAdd( hResult[ "check" ], SubStr( aLines[ i ], 7 ) )
ELSEIF Left( aLines[ i ], 3 ) == "FK:"
aParts := hb_ATokens( SubStr( aLines[ i ], 4 ), ":" )
IF Len( aParts ) >= 3
AAdd( hResult[ "fk" ], { aParts[ 1 ], aParts[ 2 ], aParts[ 3 ] } )
ENDIF
ELSEIF Left( aLines[ i ], 7 ) == "UNIQUE:"
AAdd( hResult[ "unique" ], SubStr( aLines[ i ], 8 ) )
ENDIF
NEXT
RETURN hResult
/* Validate CHECK constraints for the current record */
FUNCTION SqlValidateCheck( cTable )
LOCAL hC, i, cExpr, xResult
hC := SqlLoadConstraints( cTable )
IF Len( hC[ "check" ] ) == 0
RETURN .T.
ENDIF
FOR i := 1 TO Len( hC[ "check" ] )
cExpr := AllTrim( hC[ "check" ][ i ] )
/* Evaluate the CHECK expression via SQL engine */
xResult := five_SQL( "SELECT CASE WHEN " + cExpr + " THEN 1 ELSE 0 END AS chk" )
IF ValType( xResult ) == "A" .AND. Len( xResult ) >= 2 .AND. ;
Len( xResult[ 2 ] ) > 0 .AND. Len( xResult[ 2 ][ 1 ] ) > 0
IF SqlCoerceNum( xResult[ 2 ][ 1 ][ 1 ] ) == 0
RETURN .F.
ENDIF
ENDIF
NEXT
RETURN .T.
/* Validate FOREIGN KEY constraints for a child record */
FUNCTION SqlValidateFK( cTable, cCol, xValue )
LOCAL hC, i, aRes
hC := SqlLoadConstraints( cTable )
IF Len( hC[ "fk" ] ) == 0
RETURN .T.
ENDIF
FOR i := 1 TO Len( hC[ "fk" ] )
IF Upper( hC[ "fk" ][ i ][ 1 ] ) == Upper( cCol )
/* Verify parent row exists */
aRes := five_SQL( "SELECT COUNT(*) AS cnt FROM " + hC[ "fk" ][ i ][ 2 ] + ;
" WHERE " + hC[ "fk" ][ i ][ 3 ] + " = " + SqlQuoteVal( xValue ) )
IF ValType( aRes ) == "A" .AND. Len( aRes ) >= 2 .AND. ;
Len( aRes[ 2 ] ) > 0 .AND. Len( aRes[ 2 ][ 1 ] ) > 0
IF SqlCoerceNum( aRes[ 2 ][ 1 ][ 1 ] ) == 0
RETURN .F.
ENDIF
ENDIF
ENDIF
NEXT
RETURN .T.
/* Validate UNIQUE constraint */
FUNCTION SqlValidateUnique( cTable, cCol, xValue, nExcludeRec )
LOCAL hC, i, nWA, nFPos, lDup, nSaved
hC := SqlLoadConstraints( cTable )
IF Len( hC[ "unique" ] ) == 0
RETURN .T.
ENDIF
nSaved := Select()
nWA := Select( cTable )
IF nWA == 0
RETURN .T.
ENDIF
FOR i := 1 TO Len( hC[ "unique" ] )
IF Upper( hC[ "unique" ][ i ] ) == Upper( cCol )
dbSelectArea( nWA )
nFPos := FieldPos( cCol )
IF nFPos > 0
lDup := .F.
dbGoTop()
DO WHILE ! Eof()
IF RecNo() != nExcludeRec
IF SqlCmpEq( FieldGet( nFPos ), xValue )
lDup := .T.
EXIT
ENDIF
ENDIF
dbSkip()
ENDDO
dbSelectArea( nSaved )
IF lDup
RETURN .F.
ENDIF
ENDIF
ENDIF
NEXT
dbSelectArea( nSaved )
RETURN .T.
/* Quote a value for SQL expression building */
FUNCTION SqlQuoteVal( xVal )
IF xVal == NIL
RETURN "NULL"
ENDIF
IF ValType( xVal ) == "C"
RETURN "'" + StrTran( AllTrim( xVal ), "'", "''" ) + "'"
ENDIF
IF ValType( xVal ) == "N"
RETURN AllTrim( Str( xVal ) )
ENDIF
RETURN "''"
/*
* Validate CHECK constraints against the current record's actual field values.
* Substitutes each field name in the CHECK expression with its current value.
*/
FUNCTION SqlValidateCheckRecord( cTable )
LOCAL hC, i, cExpr, j, cField, xVal, cSubst, aResult, lCheckOk
hC := SqlLoadConstraints( cTable )
IF Len( hC[ "check" ] ) == 0
RETURN .T.
ENDIF
FOR i := 1 TO Len( hC[ "check" ] )
cExpr := Upper( AllTrim( hC[ "check" ][ i ] ) )
/* Substitute field names with their current record values.
* Use word-boundary-aware replacement to avoid "ID" matching inside "AND". */
cSubst := cExpr
FOR j := 1 TO FCount()
cField := Upper( AllTrim( FieldName( j ) ) )
xVal := FieldGet( j )
IF ValType( xVal ) == "N"
cSubst := SqlReplaceWord( cSubst, cField, AllTrim( Str( xVal ) ) )
ELSEIF ValType( xVal ) == "C"
cSubst := SqlReplaceWord( cSubst, cField, "'" + AllTrim( xVal ) + "'" )
ELSEIF ValType( xVal ) == "L"
cSubst := SqlReplaceWord( cSubst, cField, iif( xVal, ".T.", ".F." ) )
ENDIF
NEXT
/* Evaluate substituted expression: e.g. "25 >= 0 AND 25 <= 150" */
lCheckOk := .T.
BEGIN SEQUENCE
aResult := five_SQL( "SELECT CASE WHEN " + cSubst + " THEN 1 ELSE 0 END AS chk" )
IF ValType( aResult ) == "A" .AND. Len( aResult ) >= 2 .AND. ;
Len( aResult[ 2 ] ) > 0 .AND. Len( aResult[ 2 ][ 1 ] ) > 0
IF SqlCoerceNum( aResult[ 2 ][ 1 ][ 1 ] ) == 0
lCheckOk := .F.
ENDIF
ENDIF
RECOVER
lCheckOk := .F.
END SEQUENCE
IF ! lCheckOk
RETURN .F.
ENDIF
NEXT
RETURN .T.
/*
* Validate FOREIGN KEY constraints against the current record.
* Opens the parent table to verify the referenced row exists.
*/
FUNCTION SqlValidateFKRecord( cTable, cCol, xValue )
LOCAL hC, i, cParentTable, cParentCol
LOCAL nSaved, nParentWA, nFPos, lFound
hC := SqlLoadConstraints( cTable )
IF Len( hC[ "fk" ] ) == 0
RETURN .T.
ENDIF
FOR i := 1 TO Len( hC[ "fk" ] )
IF Upper( hC[ "fk" ][ i ][ 1 ] ) == Upper( cCol )
cParentTable := hC[ "fk" ][ i ][ 2 ]
cParentCol := hC[ "fk" ][ i ][ 3 ]
nSaved := Select()
/* Open parent table in a separate workarea */
nParentWA := Select( Upper( cParentTable ) )
IF nParentWA == 0
BEGIN SEQUENCE
dbUseArea( .T., "DBFNTX", Lower( cParentTable ) + ".dbf", ;
"__FK_" + Upper( cParentTable ), .T., .T. )
nParentWA := Select( "__FK_" + Upper( cParentTable ) )
RECOVER
dbSelectArea( nSaved )
RETURN .T. /* Cannot open parent — skip validation */
END SEQUENCE
ENDIF
/* Scan parent for matching value */
dbSelectArea( nParentWA )
nFPos := FieldPos( cParentCol )
lFound := .F.
IF nFPos > 0
dbGoTop()
WHILE ! Eof()
IF SqlCmpEq( FieldGet( nFPos ), xValue )
lFound := .T.
EXIT
ENDIF
dbSkip()
ENDDO
ENDIF
/* Close if we opened it */
IF Left( Alias(), 5 ) == "__FK_"
dbCloseArea()
ENDIF
dbSelectArea( nSaved )
IF ! lFound
RETURN .F.
ENDIF
ENDIF
NEXT
RETURN .T.
/*
* SqlReplaceWord: Replace a whole-word occurrence of cWord in cText with cReplace.
* Avoids replacing "ID" inside "AND" etc.
*/
FUNCTION SqlReplaceWord( cText, cWord, cReplace )
LOCAL cResult := "", nPos, nLen, cBefore, cAfter, i
nLen := Len( cWord )
i := 1
DO WHILE i <= Len( cText )
nPos := At( cWord, SubStr( cText, i ) )
IF nPos == 0
cResult += SubStr( cText, i )
EXIT
ENDIF
/* Check character before the match */
IF nPos > 1
cBefore := SubStr( cText, i + nPos - 2, 1 )
ELSE
cBefore := " "
ENDIF
/* Check character after the match */
IF i + nPos - 1 + nLen <= Len( cText )
cAfter := SubStr( cText, i + nPos - 1 + nLen, 1 )
ELSE
cAfter := " "
ENDIF
/* Is it a whole word? (surrounded by non-alphanumeric) */
IF ! IsAlphaNum( cBefore ) .AND. ! IsAlphaNum( cAfter )
cResult += SubStr( cText, i, nPos - 1 ) + cReplace
i := i + nPos - 1 + nLen
ELSE
cResult += SubStr( cText, i, nPos )
i := i + nPos
ENDIF
ENDDO
RETURN cResult
STATIC FUNCTION IsAlphaNum( c )
IF c >= "A" .AND. c <= "Z"
RETURN .T.
ENDIF
IF c >= "a" .AND. c <= "z"
RETURN .T.
ENDIF
IF c >= "0" .AND. c <= "9"
RETURN .T.
ENDIF
IF c == "_"
RETURN .T.
ENDIF
RETURN .F.
Reference in New Issue View Git Blame Copy Permalink