ich versuche ernsthaft, unser System auf PGDBE zu migrieren. Ist nicht leicht, aber strategisch vielversprechend.
Vieles geht auch gut, aber ein besonderes Problemgebiet derzeit ist noch das Thema FILTER (da sind einige PDRs offen).
Ich versuche nun wonötig Xbase++ Filterausdrücke (und FOR-Klausel) in WHERE-Klausel von SQL SELECT Befehle zu umwandeln, dabei muss ich auch Ähnliches für die ORDER BY Klausel machen.
Da in unserem System viele solche Ausdrücke dynamisch zusammengesetzt werden (oder gar von fortgeschrittenen Anwender selbst angegeben werden), habe ich die folgende Funktionen geschrieben, die (zugegeben, mehr schlecht als recht) einfache Xbase++ Expressions in SQL-Syntax umwandeln sollen.
Aufgerufen wird wie folgt:
Code: Alles auswählen
XbaseToSQL(cXbaseExpression, DBSTRUCT())
Natürlich keinerlei Haftung meinerseits!
Viel Spaß damit,
David
Code: Alles auswählen
****************
FUNC XbaseToSQL(cExpression, aDbStructParam)
LOCAL cSQL:="", aTokens:={}, nEnd:=XbaseToTokens(cExpression, aTokens)
PRIVATE aDbStruct:=aDbStructParam
IF nEnd < LEN(cExpression)
ALERT("Klammer Fehler!")
END
RETURN TokensToSQL(aTokens)
****************
FUNC XbaseToTokens(cExpression, aReturn)
// Converts string to array of tokens; token is array for subexpression or function parameters
// Does minimal "on-the-fly" translation to SQL syntax for operators, logical constants and string literals
// Returns position in cExpression where finished - either at ")" or at end
LOCAL nPos:=1, nLen:=LEN(cExpression), cToken:="", cChar, nLiteralLen:=0, i:=0, cOp:="",;
cRest:="", nLastParam:=0, nParamStart:=0, nReturnLen:=0, aSubexpression:={},;
aOpsXba:={"**",">=","<=","<>","!=","#", "==",".IN.","!", ".NOT.",".AND.",".OR.",".T.", ".F."},;
aOpsSQL:={"^", ">=","<=","<>","!=","!=","==","$", "NOT","NOT", "AND", "OR", "TRUE","FALSE"}
WHILE nPos <= nLen
cChar := SUBSTR(cExpression, nPos, 1)
DO CASE
CASE cChar == "," // Comma ends token - create subexpression for function parameter if necessary
nReturnLen := LEN(aReturn)
nParamStart := nLastParam + 1
IF nReturnLen = nParamStart
AddToken(@cToken, aReturn) // Simple parameter, not subexpression
ELSE
// Extract subexpression from aReturn
aSubexpression:={}
FOR i := nParamStart TO nReturnLen
AADD(aSubexpression, aReturn[i])
NEXT
AddToken(@cToken, aSubexpression)
IF nParamStart <= nReturnLen
AREMOVE(aReturn, nParamStart, 9999)
END
AADD(aReturn, IF(LEN(aSubexpression)=1, aSubexpression[1], aSubexpression))
END
nLastParam := LEN(aReturn)
CASE EMPTY(cChar) // Whitespace ends token
AddToken(@cToken, aReturn)
CASE cChar == "(" // Subexpression or function parameters
AddToken(@cToken, aReturn)
AADD(aReturn, {})
nPos += XbaseToTokens(SUBSTR(cExpression, nPos+1), ATAIL(aReturn))
CASE cChar == ")"
EXIT // WHILE
CASE cCHAR $ "'" + '"' // String literals
AddToken(@cToken, aReturn)
nLiteralLen := AT(cCHAR, cExpression, nPos+1) - (nPos+1)
cToken := "'"
cToken += SUBSTR(cExpression, nPos+1, nLiteralLen)
cToken += "'"
AddToken(@cToken, aReturn)
nPos += nLiteralLen + 1
CASE cCHAR $ "+-*/^%=<>#$!." // Operators and logical constants
AddToken(@cToken, aReturn)
cToken := cChar
cRest := UPPER(SUBSTR(cExpression, nPos))
FOR i := 1 TO LEN(aOpsXba)
cOp := aOpsXba[i]
IF LIKE(cOp + "*", cRest) // Check for "#" or multi-character operator / logical constant
cToken := aOpsSQL[i]
nPos += LEN(cOp) - 1
EXIT // FOR
END
NEXT
AddToken(@cToken, aReturn)
OTHERWISE // Character in token (name)
cToken += cChar
ENDCASE
nPos++
END
AddToken(@cToken, aReturn)
RETURN nPos
****************
PROC AddToken(cToken, aReturn)
IF !EMPTY(cToken)
AADD(aReturn, cToken)
cToken := ""
END
RETURN
****************
FUNC TokensToSQL(aTokens)
// Main cases: functions, string operators ($, +, = and ==) and subexpressions (recurse)
LOCAL cSQL:="", i:=1, nLen:=LEN(aTokens), oToken, oToken2, oToken3, oToken4,;
nLength:=0, nDecimals:=0, lStringFunction:=.F., cLHS:=""
IF !IsArray(aTokens)
RETURN aTokens
END
WHILE i <= nLen
oToken := aTokens[i]
IF i = nLen
cSQL += TokenToString(oToken) // Array (subexpression or function parameters), otherwise single token
ELSE
// Single (not last) token: could be variable, string literal, function or operator
oToken2 := aTokens[i+1]
oToken3 := IF(i <= nLen - 2, aTokens[i+2], "")
IF IsArray(oToken2) .AND. ("!"+UPPER(oToken)+"!") $ "!CTOD!DATE!DTOS!EMPTY!IF!IIF!STR!"
// Functions to be translated - see also IsStringValue()
lStringFunction := .F.
cLHS := ""
DO CASE
CASE oToken == "CTOD"
cLHS := "DATE(" + TokensToSQL(oToken2) + ") "
CASE oToken == "DATE"
cLHS := "CURRENT_DATE "
CASE oToken == "DTOS"
lStringFunction := .T.
cLHS := "TO_CHAR(" + TokensToSQL(oToken2) + ", 'YYYYMMDD') "
CASE oToken == "EMPTY"
cLHS := TokensToSQL(oToken2) + " IS NULL "
CASE oToken == "IF" .OR. oToken == "IIF"
IF LEN(oToken2) < 3
ALERT("IF(...) bedarf 3 Parameter!")
ELSE
lStringFunction := IsStringValue(oToken2, 3)
cLHS += "CASE WHEN " + TokensToSQL(oToken2[1]) + " THEN " +;
TokensToSQL(oToken2[2]) + " ELSE " +;
TokensToSQL(oToken2[3]) + " END "
END
CASE oToken == "STR"
lStringFunction := .T.
cLHS := "TO_CHAR(" + TokensToSQL(oToken2[1])
IF LEN(oToken2) > 1
cLHS += ", '"
nLength := VAL(oToken2[2])
nDecimals := IF(LEN(oToken2) > 2, VAL(oToken2[3]), 0)
IF nDecimals == 0
cLHS += REPLICATE("9", nLength)
ELSE
cLHS += REPLICATE("9", nLength - (nDecimals + 1)) + "D" + REPLICATE("9", nDecimals)
END
cLHS += "'"
END
cLHS += ") "
ENDCASE
IF lStringFunction .AND. i <= nLen - 2 // Only if operator can follow (s. Redmine #858)
i += AddStringOperator(@cSQL, cLHS, aTokens, i) // Skip tokens...
ELSE
cSQL += cLHS
i++ // Skip token 2
END
ELSEIF !IsArray(oToken2) .AND. IsStringValue(aTokens, i) // i -> oToken
IF IsArray(oToken)
cLHS := cSQL
cSQL := ""
ELSE
cLHS := oToken + " "
END
i += AddStringOperator(@cSQL, cLHS, aTokens, i+1) // Skip tokens...
ELSE
cSQL += TokenToString(oToken) + " " // Array (subexpression or function parameters), otherwise single token
END
END
i++ // Next token
END // WHILE
RETURN cSQL
****************
FUNC AddStringOperator(cSQL, cLHS, aTokens, nOpIndex)
// Check aTokens[nOpIndex] for string operators ($, +, = and ==) and append to cSQL
// cSQL must be a reference string parameter
// cLHS must contain an SQL string expression
// Returns number of tokens (starting at operator) to be skipped
// If string operator not found, appends cLHS + " " and returns 0
LOCAL nLen:=LEN(aTokens), cOp:=IF(nOpIndex<=nLen,aTokens[nOpIndex],""),;
nSkipTokens:=0, oRightToken:=IF(nOpIndex<=nLen-1,aTokens[nOpIndex+1],""),;
oRightParametersToken:=""
DO CASE
CASE cOp == "=="
cSQL += cLHS + "= "
nSkipTokens := 1 // Skip cOp token
CASE cOp == "+"
cSQL += cLHS + "|| "
nSkipTokens := 1 // Skip cOp token
CASE cOp == "=" .AND. nOpIndex <= nLen - 1 .AND. IsStringValue(aTokens, nOpIndex+1)
// e.g. bezeichn="WIDERST" -> bezeichn LIKE 'WIDERST%'
cSQL += cLHS + "LIKE (" + TokenToString(oRightToken) + " || '%') "
nSkipTokens := 2 // Skip cOp and right operand tokens
CASE cOp == "$" .AND. nOpIndex <= nLen - 1
// Not just next token relevant, e.g. also (bezeichn+bez2) in the expression:
// "XYZ"$UPPER(bezeichn+bez2) -> UPPER(bezeichn || bez2) LIKE '%XYZ%'
cSQL += TokenToString(oRightToken)
IF !IsArray(oRightToken)
oRightParametersToken := IF(nOpIndex <= nLen - 2, aTokens[nOpIndex+2], "")
IF IsArray(oRightParametersToken)
cSQL += TokenToString(oRightParametersToken)
nSkipTokens++ // Skip token containing parameters of right operand (function)
END
cSQL += " "
END
cSQL += "LIKE ('%' || " + cLHS + " || '%') "
nSkipTokens += 2 // Skip cOp and right operand tokens
ENDCASE
IF nSkipTokens == 0
cSQL += cLHS + " "
END
RETURN nSkipTokens
****************
FUNC IsArray(oToken)
RETURN (VALTYPE(oToken) == "A" )
****************
FUNC TokenToString(oToken) // Array (subexpression or function parameters), otherwise single token
RETURN IF(IsArray(oToken), "(" + TokensToSQL(oToken) + ")", oToken)
****************
FUNC IsStringValue(aTokens, nToken)
LOCAL i:=0, nLen:=LEN(aDbStruct), cFieldType:="",;
oToken:=IF(nToken<=LEN(aTokens),aTokens[nToken],NIL), cToken:="", cSearch:=""
IF IsArray(oToken)
IF nToken > 1
cSearch := "!" + UPPER(aTokens[nToken-1]) + "!"
// Note: List of functions may need to be extended... See also !CTOD! etc. in TokensToSQL()
IF cSearch $ "!DTOS!STR!"
RETURN .T. // Function with string result
END
IF cSearch $ "!CTOD!DATE!EMPTY!"
RETURN .F. // Function with non-string result
END
END
// Otherwise parenthesised expression, or function with same return type as (last) parameter, e.g. IF/IIF
RETURN (LEN(oToken) > 0 .AND. IsStringValue(oToken, LEN(oToken)))
END
cToken := IF(oToken == NIL, "", oToken)
IF LEFT(cToken, 1) == "'"
RETURN .T. // String literal
END
cToken := UPPERG(cToken)
FOR i := 1 TO nLen
IF cToken == UPPERG(aDbStruct[i, DBS_NAME]) // aDbStruct is PRIVATE in XbaseToSQL()
cFieldType := aDbStruct[i, DBS_TYPE]
RETURN (cFieldType == "C" .OR. cFieldType == "M")
END
NEXT
RETURN .F.