XbaseToSQL

Hier dreht es sich um den PostGre Server

Moderator: Moderatoren

Antworten
Benutzeravatar
dtmackenzie
Rekursionen-Architekt
Rekursionen-Architekt
Beiträge: 265
Registriert: Do, 22. Nov 2007 9:02
Wohnort: Leipzig
Hat sich bedankt: 66 Mal
Danksagung erhalten: 22 Mal
Kontaktdaten:

XbaseToSQL

Beitrag von dtmackenzie »

Hallo zusammen,
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())
Einiges funktioniert, vieles nicht - aber falls es jemandem von Nutzen sein soll, würde ich mich freuen.
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.
Viele Grüße,
David
Benutzeravatar
Tom
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 9345
Registriert: Do, 22. Sep 2005 23:11
Wohnort: Berlin
Hat sich bedankt: 100 Mal
Danksagung erhalten: 359 Mal
Kontaktdaten:

Re: XbaseToSQL

Beitrag von Tom »

Interessanter Ansatz, David. Danke fürs Teilen!
Herzlich,
Tom
Benutzeravatar
dtmackenzie
Rekursionen-Architekt
Rekursionen-Architekt
Beiträge: 265
Registriert: Do, 22. Nov 2007 9:02
Wohnort: Leipzig
Hat sich bedankt: 66 Mal
Danksagung erhalten: 22 Mal
Kontaktdaten:

Re: XbaseToSQL

Beitrag von dtmackenzie »

Hallo Tom,
ich kann mich noch gut daran erinnern, wie sehr Du und andere mir insbesondere am Anfang geholfen haben.
Wenn ich der Gruppe auch ein bisschen zurückgeben kann, bin ich froh. :-)
Außerdem ist Selbstinteresse dabei - falls jemand meine Bugs meldet, profitiere ich auch davon.
Viele Grüße,
David
Benutzeravatar
dtmackenzie
Rekursionen-Architekt
Rekursionen-Architekt
Beiträge: 265
Registriert: Do, 22. Nov 2007 9:02
Wohnort: Leipzig
Hat sich bedankt: 66 Mal
Danksagung erhalten: 22 Mal
Kontaktdaten:

Re: XbaseToSQL

Beitrag von dtmackenzie »

Viele Grüße,
David
Benutzeravatar
Tom
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 9345
Registriert: Do, 22. Sep 2005 23:11
Wohnort: Berlin
Hat sich bedankt: 100 Mal
Danksagung erhalten: 359 Mal
Kontaktdaten:

Re: XbaseToSQL

Beitrag von Tom »

Aber schon ein bisschen ärgerlich, dass das große Uüdate, das die meisten Fehler der PGDBE beheben soll, trotz mehrfacher Ankündigung nach wie vor durch Nichtexistenz auffällt.
Herzlich,
Tom
Benutzeravatar
Werner_Bayern
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2120
Registriert: Sa, 30. Jan 2010 22:58
Wohnort: Niederbayern
Hat sich bedankt: 29 Mal
Danksagung erhalten: 70 Mal

Re: XbaseToSQL

Beitrag von Werner_Bayern »

Im Update 1741 wurden offensichtlich endlich die ganzen ISAM-Index-Probleme der PGDBE gefixed. Getestet hab ich es aber noch nicht.
es grüßt

Werner

<when the music is over, turn off the lights!>
Benutzeravatar
dtmackenzie
Rekursionen-Architekt
Rekursionen-Architekt
Beiträge: 265
Registriert: Do, 22. Nov 2007 9:02
Wohnort: Leipzig
Hat sich bedankt: 66 Mal
Danksagung erhalten: 22 Mal
Kontaktdaten:

Re: XbaseToSQL

Beitrag von dtmackenzie »

Danke Werner!
Irgendwie habe ich die Update-Benachrichtigung verpasst.
Die Beschreibungen im PGDBE-Bereich sehen vielversprechend aus, das Update probiere ich in ein paar Wochen aus (nach meinem Urlaub).
Viele Grüße,
David
Benutzeravatar
Werner_Bayern
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2120
Registriert: Sa, 30. Jan 2010 22:58
Wohnort: Niederbayern
Hat sich bedankt: 29 Mal
Danksagung erhalten: 70 Mal

Re: XbaseToSQL

Beitrag von Werner_Bayern »

dtmackenzie hat geschrieben: Di, 28. Feb 2023 14:23 Irgendwie habe ich die Update-Benachrichtigung verpasst.
Funktioniert bei mir schon lange nicht mehr, ich muss das manuell machen.

Schönen Urlaub!
es grüßt

Werner

<when the music is over, turn off the lights!>
Benutzeravatar
Tom
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 9345
Registriert: Do, 22. Sep 2005 23:11
Wohnort: Berlin
Hat sich bedankt: 100 Mal
Danksagung erhalten: 359 Mal
Kontaktdaten:

Re: XbaseToSQL

Beitrag von Tom »

Die Beschreibungen im PGDBE-Bereich sehen vielversprechend aus
Ich find's ein bisschen dünn. Aber okay, dass es überhaupt vorangeht.
Herzlich,
Tom
Antworten