//> TableQueryFunctions.pkg
//>
//> The idea is that you declare a variable of type tTableQuery and tell it what table and what
//> filters you want and what output order you want. TQ then calculates the index to use for the.
//> scan. If it can not find an index in accordance with the desired output it will collect
//> all the sorting information in memory and refind the records in the desired order.
//>
//> If the code happens to be running against an MSSQL backend it will skip all the figuring
//> out and apply embedded SQL to the problem. This gives a potentially huge performance
//> increase at no effort on behalf of the programmer.
//>
//> oTQ is a global object (of class cTableQueryFunctions) that encapsulates a group of
//> functions. Using it to scan all orders in the order table goes like this:
//>
//>
//> Use TableQueryFunctions.pkg // Define oTableQueryFunctions object
//>
//> Procedure RunQuery
//> tTableQuery strQuery // I use the prefix 'str' to signify a struct type variable.
//>
//> Get NewQuery of oTQ Order.File_Number to strQuery
//>
//> While (FindRecord(oTQ,&strQuery))
//> Showln Order.Order_Number
//> Loop
//> End_Procedure
//>
//>
//> Note that the strQuery parameter is passed "by reference" to the FindRecord
//> function. That variable maintains the complete state of the scan and it is
//> modified for each iteration. The table query object itself is stateless.
//>
//> For every loop of the FindRecord function the record buffer of the order
//> table will be active with the record found. If you are planning on modifying or
//> deleting these rows you should force a "prefetch" of the rows by inserting
//>
//>
//> Send ForcePrefetch of oTQ (&strQuery)
//>
//>
//> right after the "Get NewQuery..." line. Transparantly to the FindRecord loop this
//> will find all the rows in advance and store their rowid's in an array. Only
//> then will it start looping through the array finding each record (again) by its rowid.
//>
//>
//> Not having to constantly write 'of oTQ' the code becomes easier to
//> read and therefore this form will be used from here on. But in real life, always
//> use the oTQ object.
//>
//>
//> Now let us say that we wanted (1) all invoices for a particular customer that was (2)
//> payed after a given date. Furthermore this Invoice table has a column called Country
//> and (3) we only want invoices for a subset of countries. And the records should be
//> ordered by the amount on the order, highest amount first (4).
//>
//>
//> Object oMyQuery is a cTableQueryFunctions
//> Procedure RunQuery
//> String[] aCountries
//> tTableQuery strQuery
//>
//> Get ListOfCountries to aCountries // Arbitrary list. It's an array of strings. That's what's important.
//>
//> Get NewQuery Invoice.File_Number to strQuery
//> Send AddFilterRelate (&strQuery) Customer.File_Number // 1
//> Send AddFilter (&strQuery) File_Field Invoice.Payed_Date tqGT dSomeDate // 2
//> Send AddFilterOrlist (&strQuery) File_Field Invoice.Country aCountries // 3 (must be a string array no matter the column data type)
//>
//> // And we also want it to be ordered backwards by the order total:
//> Send AddOrderBy (&strQuery) File_Field Invoice.Total True False // 4 (bDescending=True bUppercase=False)
//> // (add more ordering segments)
//>
//> While (FindRecord(Self,&strQuery))
//> Showln Invoice.Invoice_Number " " Invoice.Total
//> Loop
//> End_Procedure
//> End_Object
//>
//>
//> If you look at filter (2) in the example above you can see that the ">"-comperator is represented by
//> a tqGT symbol. Other comperators that may be used are:
//>
//> tqLT, tqLE, tqEQ, tqGE, tqGT
//>
//> end then there are these special ones intended for string evaluation and which cannot be used
//> for search optimization:
//>
//> tqNE, tqMATCH, tqUCMATCH
//>
//> Well, tqNE is not just for string evaluation.
//>
//>
//> You can run nested queries like this:
//>
//>
//> Object oMyQuery is a cTableQueryFunctions
//> Procedure RunQuery
//> tTableQuery strOrderQ strOrderLineQ
//>
//> Get NewQuery Order.File_Number to strOrderQ
//>
//> While (FindRecord(Self,&strOrderQ)) // <-- Go through all orders
//> Get NewQuery OrderLine.File_Number to strOrderLineQ
//> Send AddFilterRelate (&strOrderLineQ) Order.File_Number
//>
//> While (FindRecord(Self,&strOrderLineQ)) // <-- Go through all lines on active order
//> // Something
//> Loop
//> Loop
//> End_Procedure
//> End_Object
//>
//>
//> If you have a 2 level scan like above, you can save execution time by creating
//> the sub-query only once and then call ReUse to reinitialise it.
//>
//> With the ReUse method you can skip the repeated compilation (of the inner query):
//>
//>
//> Object oMyQuery is a cTableQueryFunctions
//> Procedure RunQuery
//> Open Order
//> Open OrderLin
//> tTableQuery strOrderQ strOrderlineQ
//> Get NewQuery Order.file_number to strOrderQ
//> Get NewQuery OrderLin.file_number to strOrderlineQ
//> Send AddFilterRelate (&strOrderlineQ) Order.file_number
//>
//> While (FindRecord(Self,&strOrderQ))
//> Send ReUse (&strOrderlineQ) // Only "compile" once
//> While (FindRecord(Self,&strOrderlineQ))
//> Loop
//> Loop
//> End_Procedure
//> End_Object
//>
//>
//> You may use the .iLimit member of the tTableQuery value to limit
//> the number of rows returned:
//>
//>
//> Send SetLimit (&strQuery) 50
//>
//>
//> And finally, to quickly find out if a query will return any rows at all
//> you can call function HasData:
//>
//>
//> Get HasData strQuery to bContinue // Note that strQuery for once is _not_ byref'ed.
//>
//>
//> Calling HasData could be a lot faster than setting iLimit to 1 since the latter
//> strategy may still force the query machine into generating the whole result-set and
//> sort it some way in order to find out which record is actually the first. Calling
//> HasData does not do that.
//>
//> If the table that you are table querying is an SQL table and it has been "opened as", TableQuery
//> has no way of knowing what table name to use in the select statement. If you prepare the
//> query with this line:
//>
//>
//> Send ForceSQLTableName (&strQuery) "Customer"
//>
//>
//> that name will be used in the ESQL select statement and you'll be fine.
//>
//> A note on the source code in this package:
//>
//> An "_" character in the beginning of a name indicates that the procedure, property or whatever is
//> meant to be used internally by this package only.
//>
//> Variable names are prefixed by s if string, b if boolean asf. Struct type variables are prefixed
//> 'str' which should make one think 'struct' (not 'string').
//>
//> In order to test the function of TableQueryFunctions.pkg without actually programming you may
//> download VDFXray (a multi-purpose VDF utility) from this address:
//>
//> ftp.stureaps.dk/software/visualdataflex/vdfxray/
//>
//> Use VDFXray to open a workspace, select a table in the tables list. Right click and select
//> "TableQuery Engine Inspector".
//>
//> You'll notice two panels appearing with the "TableQuery test facility" panel on top. If
//> your screen is large enough try to position that panel so that you can see the list of
//> columns in the panel behind it. If necessary by dragging the second panel partly off
//> screen. You'll see the selection of that list changes as you specify columns to filter by.
//> pkg.doc.end
// DAW packages:
Use VdfBase.pkg
Use cli.pkg
Use sql.pkg
// StureApsPublicLib packages
Use DateFunctions.pkg // oDateFunctions object
Use StringFunctions.pkg // oStringFunctions object
Use IndexFunctions.pkg
Use StackFunctions.pkg // oStackFunctions object
Use FileFunctions.pkg // oFileFunctions object
Use TemporaryTables.pkg
Use WindowsInfo.pkg
Use SQLStatementHandles.pkg
Use TableDriverFunctions.pkg
Use StructFunctions.pkg
Use RecordBufferFunctions.pkg
Enum_List // Column value types
Define tqSTRING
Define tqNUMBER
Define tqTEXT
Define tqDATE
Define tqDATETIME
End_Enum_List
Enum_List // Filter comparison modes
Define tqLT
Define tqLE
Define tqEQ
Define tqGE
Define tqGT
Define tqNE
// These can never be used for index optimization:
// Define tqCONTAINS // DO NOT USE
// Define tqIN // DO NOT USE (use orlist instead)
Define tqMATCH // When evaluated on the embedded database tqMATCH and tqUCMATCH may be
Define tqUCMATCH // expensive. On SQL they are converted to 'like' predicates and they fly.
Define _tqComparisonMax // Stop-marker
End_Enum_List
// Struct tTQResultRow
// RowID riRowId
// String sSortValue
// String[] aColumnValues
// End_Struct
class _cTQResultRow is a cArray
item_property_list
item_property string psRowID
item_property string psSortValue
item_property array phColumnValues // Pointer to string array
end_item_property_list _cTQResultRow
end_class
// Struct tTQResultSet
// Integer iTable
// tTQResultRow[] aRecords
// Integer _iCurrentRowPointer
// End_Struct
class _cTQResultSet is a cArray
procedure construct_object integer liImg
forward send construct_object liImg
property integer piTable
property integer phRecords // Points to _cTQResultRow type object
property integer _piCurrentRowPointer
end_procedure
end_class
// Struct _tTQValueSource
// // An actual value is derived like this:
// // If iTable<>0 then: get_field_value iTable iColumn
// // Else If (hFunction<>0) then: get hFunction of hObject iColumn // Column is passed to hFunction as argument
// // Else If aOrList has elements the value of the _iOrListPointer'th element in aOrList is assumed
// // Else: sConstant
// Integer iTable
// Integer iColumn
//
// Integer hObject
// Integer hFunction
//
// Integer iType
// Integer iLen
// Integer iDecimals
//
// String sConstant
//
// String _sValue
//
// String[] aOrList
// Integer _iOrListPointer
//
// String sSQLResultSetColumnName
// // Integer iSQLResultSetColumnNumber // This is implicitly given by the position of the _tTQValueSource member in the aSelectedColumns array of a tTableQuery type variable.
// End_Struct
class _cTQValueSource is a cArray
procedure construct_object integer liImg
forward send construct_object liImg
end_procedure
end_class
Struct tTQFilterSegment
_tTQValueSource strLeftValue
Integer iComp // tqEQ, tqLT, tgLE, tqMATCH etc...
tWildCardEvalSequence strMatchEvalSequence // If selection by wild card string matching this member is needed
_tTQValueSource strRightValue
End_Struct
Struct _tTQTableRelationSegment
Integer iSourceTable
Integer iSourceColumn
Integer iInnerJoinComp
Integer iTargetColumn
End_Struct
Struct tTQTableRelation
Integer iTargetTable // The table that is being related to
String sForceSQLTableName // If represented in a select statement we can force its name by setting this
_tTQTableRelationSegment[] aSegments // The columns being used for the relation. Note that these may stem from a number of different
// child tables. Note also that if aSegments is empty the record of the iTargetTable table is
// constant for the duration of the query execution. But they are all in effect "outer left joins".
Integer _iEmbeddedIndex // What embedded index should be used to find a record of this kind (the iTargetTable kind)
Boolean bFixed // A table is fixed if the record buffer is constant through the query.
Boolean bInnerJoin // If a relation is marked as "inner join" the SQL generated will do something I can't remember.
End_Struct
Struct tTQFilterExpression //
Number nExpense // Expected expense of evaluating this expression.
Boolean bNot // Applies to strOperand or aSubExpressions whichever is 'active'
tTQFilterSegment strOperand
tTQFilterExpression[] aSubExpressions // If this array has members then tTQFilterSegment is disregarded
Integer iAndOr // 0=leaf(nothing), 1=and, 2=or, 3=xOr
Boolean _bOpen
End_Struct
// a or b and c xor (d or not(e))
Enum_List // Filter expression 'keys'
Define _tqKeyNULL
Define tqKeyAND
Define tqKeyOR
Define tqKeyNOT
Define tqKeyPARLEFT
Define tqKeyPARRIGHT
End_Enum_List
Struct tTQOrderBySegment
Boolean bDescending
Boolean bUppercase
_tTQValueSource strValueSource
End_Struct
Struct _tTQInnerJoinControlBlock
Boolean bEnabled // Inner join enabled
Boolean bInitialized // Inner join initialised
String[] aCurrentParentSortValues // Sort values of current parent record
Boolean bSkipNextFetch // First run in inner join
Boolean bEndOfResultSet
End_Struct
Struct tTQPrefetchCacheControl
Boolean bUseSettings
Integer iPrefetchRecordCount
Integer iPrefetchRecordTimeout
End_Struct
Struct tTSQueryControlBlock
Boolean bCompiled
Boolean bInitialized
// How much do we prefer to limit the number of finds performed against the
// database over not having to sort all the selected rows in an array?
//
// A value of 0.1 (its default value) indicates that we are willing to accept
// 10 times more finds to not have to prefetch the whole set. A value of 1
// would mean that we are not willing to perform any unnecessary finds and
// thus prefetching would only occur if absolutely necessary.
//
// (actually it might make sense to set it according to the computing power or the
// network speed of the client and the expected size of the result set)
//
// If you set it higher than 1 it will prefer prefetch indices for no good
// reason (so don't do that).
Number nPrefetchAvoidanceFactor // Default assigned by NewQuery is 0.1
Integer iFindCount
Integer iSelectCount
Boolean bFirstRecord
Boolean bBreakScan
String sLogTag
Integer iCursor
Boolean[] aRelatedRecords // True if the same index in the aTableRelations array has already been executed
Integer iQueryMethod // tqDataFlex, tqSQLPKG or tqMERTECHINC
tSQLStatementHandle strSQLStatementHandle
Boolean bSQLTableIsAnsi
tTQPrefetchCacheControl strSQLCacheControl
tTQPrefetchCacheControl _strPreviousSQLCacheControl // Used to push the cache settings and restore previous value upon loop exit
_tTQInnerJoinControlBlock strInnerJoinCB
Boolean bFilterExpressionActive
End_Struct
Enum_List // Query methods
Define tqDATAFLEX
Define tqSQLPKG
Define tqMERTECHINC
End_Enum_List
// Struct tTSQueryCompiled
// Integer iIndex
// Boolean bBackwards
//
// Number nENR // Expected number of rows according to iIndex. If nENR is zero the index is fully specified
//
// Boolean bPrefetch
// Boolean bIndexSeedSharpeningEnabled
// Integer _iLimit
// Integer _iPushLimit
// tTQFilterSegment[] aJumpInValues
// tTQFilterSegment[] aJumpOutValues
// tTQFilterSegment[] aOtherConditions // Non optimized conditions
// End_Struct
class _cTSQueryCompiled is an cArray
procedure construct_object integer liImg
forward send construct_object liImg
property integer piIndex
property integer pbBackwards
property number pnENR
property integer pbPrefetch
property integer pbIndexSeedSharpeningEnabled
property integer _piLimit
property integer _piPushLimit
end_procedure
end_class
class _cTSQueryControlBlock is an cArray
procedure construct_object integer liImg
forward send construct_object liImg
end_procedure
end_class
class _cTQResultSet is an cArray
procedure construct_object integer liImg
forward send construct_object liImg
end_procedure
end_class
class cTableQueryCM is an cArray
procedure construct_object integer liImg
forward send construct_object liImg
property integer piTable
property integer pbNoESQL //> If true: Do not use ESQL even if SQL table.
property integer pbForcePrefetch //> If true: Force finding of all rows before FindRecord loop execution.
property integer piForceLimit //> If you don't care what the query analyzer says, you may force the table scan to be performed by this index (-1 means no force)
property integer piLImit //> Limits the amount of rows returned by the loop
property string psForceSQLTableName //> Use this table name when generating ESQL (over the default value from filelist.cfg)
property string psForceSQLStatement //> DANGER! Use this to completely overtake the SQL generated by TQ. It's your responsability then that the columns of the result set are in synch with what TQ expects (qua the result set specification).
property integer _pbOutputColumnsFixated
property integer pbRestoreRecordBuffersOnQueryCompletion
object _ostrCompiled is an Array NO_IMAGE
end_object
object _ostrControlBlock is an Array NO_IMAGE
end_object
object _ostrResultSet is an Array NO_IMAGE
end_object
end_procedure
end_class
//> The supreme struct!
Struct tTableQuery
Integer iTable
Boolean bNoESQL //> If true: Do not use ESQL even if SQL table.
Boolean bForcePrefetch //> If true: Force finding of all rows before FindRecord loop execution.
Integer iForceIndex //> If you don't care what the query analyzer says, you may force the table scan to be performed by this index (-1 means no force)
Integer iLimit //> Limits the amount of rows returned by the loop
String sForceSQLTableName //> Use this table name when generating ESQL (over the default value from filelist.cfg)
String sForceSQLStatement //> DANGER! Use this to completely overtake the SQL generated by TQ. It's your responsability then that the columns of the result set are in synch with what TQ expects (qua the result set specification).
// Select:
_tTQValueSource[] aColumnSources //> If this array is empty TQ will by default activate the iTable buffer.
_tTQValueSource[] aOutputColumns //> This array contains a copy of the items added to aColumnSources that are column specific. The order of the columns will be identical to the order in which they were added
Boolean _bOutputColumnsFixated
Boolean bRestoreRecordBuffersOnQueryCompletion
// Where:
tTQFilterSegment[] aFilters //> Segments are and'ed
// Where (for filterexpressions):
tTQFilterExpression[] aFilterExpressions //> are of course also and'ed if there are more of them
// Order by:
tTQOrderBySegment[] aOrdering
// House keeping:
tTSQueryCompiled _strCompiled
tTSQueryControlBlock _strControlBlock
tTQResultSet strResultSet
tTQTableRelation[] aTableRelations //> Defines relations to parent tables
End_Struct
Struct _tTQIndexRating
Integer iIndex
Number nExpectedNumberRows // With the filters supplied, how many rows can we expect to find by this index.
Boolean bOutputAgree // Does the index agree with the output order specified?
Integer iKeyLevels
Integer iKeyLength // A short key length might rate better if everything else was equal.
End_Struct
Struct _tTQIndexAnalysis
Number[] aSegmentReductions
End_Struct
Struct tTQTableAnalysis
Boolean bInitialized
DateTime dtAnalysisDateTime
Number nNumberOfRecords
_tTQIndexAnalysis[] aIndices
String sTimeToComplete
End_Struct
Struct tTQTableMeta
Integer _iIsInitialized
Integer[] aIndices // Indices to scan
End_Struct
Global_Variable tTQTableAnalysis[] _gTQaTableAnalysis
Global_Variable tTQTableMeta[] _gTQaTableMeta
Global_Variable Integer _giTQLogState // 0=No logging, 1=Log when LogTag'ed, 2=Log always
Global_Variable Integer[] _gaTQLogTables
Procedure Set TableQuery_LogState Global Integer iState
Move iState to _giTQLogState
End_Procedure
Class cTableQuerySQL is a cObject // Generates an SQL statement
Procedure Construct_Object
Forward Send Construct_Object
Property String psCollation "Latin1_General_BIN" // Or maybe "SQL_Latin1_CP850_BIN"? Who knows?
End_Procedure
Function _SQL_ColumnName tTableQuery strQ Integer hoTQ Integer iTable Integer iColumn Returns String
String sValue
Get ColumnName of hoTQ strQ iTable iColumn True to sValue
Function_Return sValue
End_Function
Function _SQL_TableName tTableQuery strQ Integer hoTQ Integer iTable Returns String
String sValue
Get TableName of hoTQ strQ iTable to sValue
Move ("["+sValue+"]") to sValue
Function_Return sValue
End_Function
Function _SQL_SelectColumns tTableQuery strQ Integer hoTQ Returns String
Integer iMax iItem iTable iColumn
String sColumnList sColumnName sTableName
Move (SizeOfArray(strQ.aColumnSources)-1) to iMax
If (iMax>=0) Begin
For iItem from 0 to iMax
If (iItem<>0) Begin
Move (sColumnList+",") to sColumnList
End
Move strQ.aColumnSources[iItem].iTable to iTable
Move strQ.aColumnSources[iItem].iColumn to iColumn
If (iColumn<>0) Begin
Get _SQL_ColumnName strQ hoTQ iTable iColumn to sColumnName
End
Else Begin
Get TableName of hoTQ strQ iTable to sTableName
Move (sTableName+".*") to sColumnName
End
Move (sColumnList+sColumnName) to sColumnList
Loop
End
Else Begin
Move "*" to sColumnList
End
Function_Return sColumnList
End_Function
Procedure _SQL_OuterLeftJoin_AddSegments tTableQuery strQ Integer hoTQ String ByRef sFromTables Integer iRelateItem
Integer iItem iItemMax
String sColumnName sComp
tTQTableRelation strRelation
Move strQ.aTableRelations[iRelateItem] to strRelation
Move (SizeOfArray(strRelation.aSegments)-1) to iItemMax
For iItem from 0 to iItemMax
If (iItem<>0) Begin
Move (sFromTables+" AND") to sFromTables
End
Get _SQL_ColumnName strQ hoTQ strRelation.aSegments[iItem].iSourceTable strRelation.aSegments[iItem].iSourceColumn to sColumnName
Move (sFromTables*sColumnName) to sFromTables
Get _SQL_WhereClauseComperator strRelation.aSegments[iItem].iInnerJoinComp False to sComp
Move (sFromTables*sComp) to sFromTables
Get _SQL_ColumnName strQ hoTQ strRelation.iTargetTable strRelation.aSegments[iItem].iTargetColumn to sColumnName
Move (sFromTables*sColumnName) to sFromTables
Loop
End_Procedure
//select f.foo
// , b.bar
// , q.qux
// from footable as f
//left outer
// join bartable as b
// on f.id = b.fid
//left outer
// join quxtable as q
// on b.id = q.bid
Function _SQL_OuterLeftJoins tTableQuery strQ Integer hoTQ Returns String
Integer iItem iItemMax
String sFromTables sTableName
Get TableName of hoTQ strQ strQ.iTable to sFromTables
Move (SizeOfArray(strQ.aTableRelations)-1) to iItemMax
For iItem from 0 to iItemMax
If (not(strQ.aTableRelations[iItem].bFixed)) Begin
Get _SQL_TableName strQ hoTQ strQ.aTableRelations[iItem].iTargetTable to sTableName
Move (sFromTables+" left outer join"*sTableName+" on (") to sFromTables
Send _SQL_OuterLeftJoin_AddSegments strQ hoTQ (&sFromTables) iItem
Move (sFromTables+")") to sFromTables
End
Loop
Function_Return sFromTables
End_Function
Function _SQL_InnerJoins tTableQuery strQ Integer hoTQ Returns String
Integer iItem iItemMax
String sFromTables sTableName
Move (SizeOfArray(strQ.aTableRelations)-1) to iItemMax
For iItem from 0 to iItemMax
If (strQ.aTableRelations[iItem].bInnerJoin) Begin
Get _SQL_TableName strQ hoTQ strQ.aTableRelations[iItem].iTargetTable to sTableName
Move (sFromTables+" inner join"*sTableName+" on (") to sFromTables
Send _SQL_OuterLeftJoin_AddSegments strQ hoTQ (&sFromTables) iItem
Move (sFromTables+")") to sFromTables
End
Loop
Function_Return sFromTables
End_Function
Function _SQL_WhereClauseComperator Integer iComp Boolean bIn Returns String
If (bIn) Begin
Function_Return " in "
End
If (iComp=tqLT) Function_Return "<"
If (iComp=tqLE) Function_Return "<="
If (iComp=tqEQ) Function_Return "="
If (iComp=tqGE) Function_Return ">="
If (iComp=tqGT) Function_Return ">"
If (iComp=tqNE) Function_Return "<>"
If (iComp=tqMATCH) Function_Return " like " // This can't be guaranteed on SQL. or what?
If (iComp=tqUCMATCH) Function_Return " like "
// If (iComp=tqCONTAINS) Function_Return "contains"
Function_Return "error"
End_Function
Function EscapeStringConstant String sValue Returns String
Function_Return (Replaces("'",sValue,"''")) // cross fingers
End_Function
Function _SQL_WhereClauseValue tTableQuery strQ Integer hoTQ Integer iComp _tTQValueSource strValue Returns String
Boolean bFixed bDoValue
Integer iMax iItem
String sValue sColumnName sSQLdate
If (iComp=tqEQ and SizeOfArray(strValue.aOrList)<>0) Begin // IN
Move (SizeOfArray(strValue.aOrList)-1) to iMax
Move "(" to sValue
For iItem from 0 to iMax
If (iItem>0) Begin
Move (sValue+",") to sValue
End
If (strValue.iType=tqSTRING or strValue.iType=tqTEXT) Begin
Move (sValue+"'"+EscapeStringConstant(Self,strValue.aOrList[iItem])+"'") to sValue
End
Else If (strValue.iType=tqDATE or strValue.iType=tqDATETIME) Begin
Get DFDateToSQLDate of strQ._strControlBlock.strSQLStatementHandle.hHandle (Date(strValue.aOrList[iItem])) to sSQLdate
Move (sValue+"'"+sSQLdate+"'") to sValue
End
Else Begin
Move (sValue+strValue.aOrList[iItem]) to sValue
End
Loop
Move (sValue+")") to sValue
End
Else Begin
Move True to bDoValue
If (strValue.iTable<>0) Begin
Get _IsTableFixed of hoTQ strQ strValue.iTable to bFixed
If (not(bFixed)) Begin
Get _SQL_ColumnName strQ hoTQ strValue.iTable strValue.iColumn to sColumnName
Move sColumnName to sValue
Move False to bDoValue
End
End
If (bDoValue) Begin // Either it's a constant or it's a fixed table:
Get _ValueSourceValue of hoTQ (&strQ) strValue to sValue
If (iComp=tqMATCH or iComp=tqUCMATCH) Begin
Move (Replaces("%",sValue,"\%")) to sValue // Escape all SQL wildcard patterns
Move (Replaces("_",sValue,"\_")) to sValue // that happens to be in the string
Move (Replaces("[",sValue,"\[")) to sValue // by chance.
Move (Replaces("]",sValue,"\]")) to sValue
Move (Replaces("*",sValue,"%")) to sValue // Replace our own * and ? wildcards
Move (Replaces("?",sValue,"_")) to sValue // with their SQL counterparts.
If (iComp=tqUCMATCH) Begin
Move (Uppercase(sValue)) to sValue
End
End
If (strValue.iType=tqSTRING or strValue.iType=tqTEXT) Begin
Move ("'"+EscapeStringConstant(Self,sValue)+"'") to sValue
End
Else If (strValue.iType=tqDATE or strValue.iType=tqDATETIME) Begin
Get DFDateToSQLDate of strQ._strControlBlock.strSQLStatementHandle.hHandle (Date(sValue)) to sValue
Move ("'"+sValue+"'") to sValue
End
If (iComp=tqMATCH or iComp=tqUCMATCH) Begin
Move (sValue*"ESCAPE '\'") to sValue // tell mssql that the pattern has been escaped with the "\" character.
End
End
End
Function_Return sValue
End_Function
Function _SQL_WhereClauseSegment tTableQuery strQ tTQFilterSegment strSegment Integer hoTQ Returns String
Integer iTable iColumn
Boolean bIn
String sValue
Move strSegment.strLeftValue.iTable to iTable
Move strSegment.strLeftValue.iColumn to iColumn
Get _SQL_ColumnName strq hoTQ iTable iColumn to sValue
Move (SizeOfArray(strSegment.strRightValue.aOrList)<>0) to bIn
Move (sValue+_SQL_WhereClauseComperator(Self,strSegment.iComp,bIn)) to sValue
Move (sValue+_SQL_WhereClauseValue(Self,strQ,hoTQ,strSegment.iComp,strSegment.strRightValue)) to sValue
Function_Return sValue
End_Function
Function _SQL_WhereClauseExpressionSegment tTableQuery strQ tTQFilterExpression[] aSegments Integer hoTQ Returns String
Integer iItem iItemMax
String sValue
Move (SizeOfArray(aSegments)-1) to iItemMax
For iItem from 0 to iItemMax
If (iItem>0) Begin
If (aSegments[iItem-1].iAndOr=tqKeyAND) Begin
Move (sValue*"AND") to sValue
End
Else If (aSegments[iItem-1].iAndOr=tqKeyOR) Begin
Move (sValue*"OR") to sValue
End
Else Begin
Send OnError 738 "Illegal operator in where clause expression"
End
End
If (aSegments[iItem].bNot) Begin
Move (sValue*"NOT") to sValue
End
If (SizeOfArray(aSegments[iItem].aSubExpressions)>0) Begin
Move (sValue*_SQL_WhereClauseExpressionSegment(Self,strQ,aSegments[iItem].aSubExpressions,hoTQ)) to sValue
End
Else Begin
Move (sValue*_SQL_WhereClauseSegment(Self,strQ,aSegments[iItem].strOperand,hoTQ)) to sValue
End
Loop
Function_Return ("("+Trim(sValue)+")")
End_Function
Function _SQL_WhereClause tTableQuery strQ Integer hoTQ Returns String
Integer iMax iItem
Boolean bAddAND
String sValue
Move (SizeOfArray(strQ.aFilters)-1) to iMax
For iItem from 0 to iMax
If (iItem<>0) Begin
Move (sValue*"and") to sValue
End
Move (sValue*_SQL_WhereClauseSegment(Self,strQ,strQ.aFilters[iItem],hoTQ)) to sValue
Loop
Move (iMax>=0) to bAddAND
Move (SizeOfArray(strQ.aFilterExpressions)-1) to iMax
For iItem from 0 to iMax
If (iItem>0 or bAddAND) Begin
Move (sValue*"and") to sValue
End
Move (sValue*_SQL_WhereClauseExpressionSegment(Self,strQ,strQ.aFilterExpressions[iItem].aSubExpressions,hoTQ)) to sValue
Loop
Function_Return sValue
End_Function
Function _SQL_OrderByClause tTableQuery strQ Integer hoTQ Returns String
Integer iItem iMax iTable iColumn
String sValue sColumnName
Move (SizeOfArray(strQ.aOrdering)-1) to iMax
For iItem from 0 to iMax
If (iItem<>0) Begin
Move (sValue+", ") to sValue
End
Move strQ.aOrdering[iItem].strValueSource.iTable to iTable
Move strQ.aOrdering[iItem].strValueSource.iColumn to iColumn
Get _SQL_ColumnName strQ hoTQ iTable iColumn to sColumnName
Move (sValue+sColumnName) to sValue
If (strQ.aOrdering[iItem].strValueSource.iType=tqSTRING) Begin
Move (sValue+" collate "+psCollation(Self)) to sValue
End
If (strQ.aOrdering[iItem].bDescending) Begin
Move (sValue*"DESC") to sValue
End
// ToDo: uppercase ordering
// If (strQ.aOrdering[iItem].bUppercase) Begin
// // Somethings wrong here. And it's not the 'lower' instead of 'upper'
// Move (sValue*"lower("+sValue+")") to sValue
// End
Loop
Function_Return sValue
End_Function
Function _SQLSelectStatement tTableQuery strQ Integer hoTQ Returns String
String sStatement
Move "select" to sStatement
If (strQ.iLimit>0) Begin
Move (sStatement*"top "+String(strQ.iLimit)) to sStatement
End
If (strQ.iLimit<0) Begin
Move (sStatement*"bottom "+String(0-strQ.iLimit)) to sStatement
End
Move (sStatement*_SQL_SelectColumns(Self,strQ,hoTQ)) to sStatement
Move (sStatement*" from") to sStatement
Move (sStatement*_SQL_OuterLeftJoins(Self,strQ,hoTQ)) to sStatement // related records
Move (sStatement*_SQL_InnerJoins(Self,strQ,hoTQ)) to sStatement // find child records for each parent
If (SizeOfArray(strQ.aFilters)<>0 or SizeOfArray(strQ.aFilterExpressions)<>0) Begin
Move (sStatement*" where") to sStatement
Move (sStatement*_SQL_WhereClause(Self,strQ,hoTQ)) to sStatement
End
If (SizeOfArray(strQ.aOrdering)<>0) Begin
Move (sStatement*" order by") to sStatement
Move (sStatement*_SQL_OrderByClause(Self,strQ,hoTQ)) to sStatement
End
Function_Return sStatement
End_Function
Function _SQLDeleteStatement tTableQuery strQ Integer hoTQ Returns String
String sStatement
Move "delete" to sStatement
// If (strQ.iLimit<>0) Begin
// Send OnError 742 "Limit not allowed on delete statement"
// Function_Return "" // Error
// End
//
// If (SizeOfArray(strQ.aColumnSources)>0) Begin
// Send OnError 743 "Result column not allowed on delete statement"
// Function_Return "" // Error
// End
Move (sStatement*" from") to sStatement
Move (sStatement*_SQL_OuterLeftJoins(Self,strQ,hoTQ)) to sStatement // related records
Move (sStatement*_SQL_InnerJoins(Self,strQ,hoTQ)) to sStatement // find child records for each parent
If (SizeOfArray(strQ.aFilters)<>0 or SizeOfArray(strQ.aFilterExpressions)<>0) Begin
Move (sStatement*" where") to sStatement
Move (sStatement*_SQL_WhereClause(Self,strQ,hoTQ)) to sStatement
End
// If (SizeOfArray(strQ.aOrdering)>0) Begin
// Send OnError 744 "Ordering not allowed on delete statement"
// Function_Return "" // Error
// End
Function_Return sStatement
End_Function
End_Class
Class cTableQueryFunctions is a cObject
Procedure Construct_Object
Forward Send Construct_Object
Property Number _pnPrefetchAvoidanceFactor // Temporary property used by index rating sort algorithm
Object oSQLGeneratorMSSQLDRV is a cTableQuerySQL
End_Object
Property Handle phoSQLGeneratorMSSQLDRC (oSQLGeneratorMSSQLDRV(Self))
End_Procedure
Function Version Returns String
// Function_Return "0.96" // 9-05-2012
// Fixed error in MSSQLDRV SQL generating when an ordering segment is both ASCII and descending
// Removed timing and track of current-record
// Function_Return "0.97" // 10-05-2012
// Addded methods ResetResultSetColumns and ResetOrdering
// Fixed seeding error on backwards ASCII columns
// Bug in ResultColumnValue function fixed
// Bug in _FindFirstRecordAux function fixed (related to 'VFind GE')
// SQL handling of dates repaired
// Parent column filter bugfix. No longer ends up in jump-in/out filters by accident
// Fixed _ValidateQuery to correctly complain about over-constrain on parent table columns
// function SQLStatement renamed to SQLSelectStatement
// Function_Return "0.98" // 29-11-2012
// SQL date handling is now also effective if column type is DF_DATETIME (may go wrong if value also has a time part)
// Implementation of private function _DeleteConstraint changed (old one still there for 15.1)
// Method DeleteRecords added (ignore, not tested)
// Function_Return "0.99" // 04-04-2013
// Fixed bug in AddFilterTableColumn method.
// Comperators tqCONTAINS and tqIN have been removed.
// Filter evaluating for index seeding capacitance has been fixed. Until now filters on parent tables may have wronged the index selection process.
// Error handling changed. All errors are now declared as DFERR_PROGRAM. If cTableQueryFunctions is subclassed procedure OnError may be augmented to do otherwise.
// Function HasData was designed to check for data before the main finding loop was entered. It may now also meaningfully be called after the main loop to query if the loop had any data at all.
// Function FixedTables added. Returns an array of tables that are referenced as "fixed" during the execution of a query. So if I want to repeat the find loop of a particular tTableQuery variable at a later time, the record buffers of these fixed tables must be restored to that of the original query. Does this make sense?
// Similarly NotFixedTables has been added.
// Function Belongs added. Returns true if the record currently in the buffer of the query main table evaluates true against the filters of query variable passed.
// Procedure RestoreRecordBuffersOnQueryCompletion added. Use to have TQ restore all affected record buffers on find loop completion.
// Function_Return "0.991" // 25-09-2013
Function_Return "0.992"
End_Function
Function NewQuery Integer iTable Returns tTableQuery
Integer iFilterTable iArg
tTableQuery strQuery
Move iTable to strQuery.iTable
Move -1 to strQuery.iForceIndex
Move False to strQuery.bForcePrefetch
Move False to strQuery.bNoESQL
Move False to strQuery.bRestoreRecordBuffersOnQueryCompletion
Move False to strQuery._strControlBlock.bInitialized
Move False to strQuery._strControlBlock.bCompiled
Move -1 to strQuery._strControlBlock.iQueryMethod
Move 0.1 to strQuery._strControlBlock.nPrefetchAvoidanceFactor
Move False to strQuery._strControlBlock.strInnerJoinCB.bEnabled // (CB=Control Block)
Move False to strQuery._strControlBlock.strInnerJoinCB.bInitialized
Move False to strQuery._strControlBlock.bFilterExpressionActive
Move True to strQuery._strCompiled.bIndexSeedSharpeningEnabled
Move False to strQuery._strCompiled.bBackwards
Move -1 to strQuery._strCompiled.nENR
Move False to strQuery._bOutputColumnsFixated
Send ReadTableDefinition of oOverlapColumnFunctions iTable // Make sure that oOverlapColumnFunctions knows about this table
If (num_arguments>1) Begin // For a while multiple parameters was allowed. Therefore this. Also for a while.
Error 343 "TQ: Illegal call to NewQuery"
End
Function_Return strQuery
End_Function
Procedure OnError Integer iErrNo String sErrorText
Error DFERR_PROGRAM ("TQ-"+String(iErrNo)+": "+sErrorText)
End_Procedure
//> If you have a 2 level scan (scanning orders, and order lines for each order) you can save execution time by creating
//> the sub-query only once and then call ReUse to reinitialise it.
//>
//> This is how you might go about it without the ReUse method:
//>
//> Open Order
//> Open OrderLin
//> tTableQuery strOrderQuery strOrderlineQuery
//>
//> Get NewQuery of oTQ Order.file_number to strOrderQuery
//>
//> While (FindRecord(oTQ,&strOrderQuery))
//> Get NewQuery of oTQ OrderLin.file_number to strOrderlineQuery // New query for each order
//> Send AddFilterRelate of oTQ (&strOrderlineQuery) Order.file_number
//> While (FindRecord(oTQ,&strOrderlineQuery))
//> Loop
//> Loop
//>
//> With the ReUse method you can skip the repeated "compilation" of the inner query:
//>
//> Open Order
//> Open OrderLin
//> tTableQuery strOrderQuery strOrderlineQuery
//> Get NewQuery of oTQ Order.file_number to strOrderQuery
//> Get NewQuery of oTQ OrderLin.file_number to strOrderlineQuery
//> Send AddFilterRelate of oTQ (&strOrderlineQuery) Order.file_number
//>
//> While (FindRecord(oTQ,&strOrderQuery))
//> Send ReUse of oTQ (&strOrderlineQuery)
//> While (FindRecord(oTQ,&strOrderlineQuery))
//> Loop
//> Loop
//>
Procedure ReUse tTableQuery ByRef strQuery
Move False to strQuery._strControlBlock.bInitialized
End_Procedure
//> The scanning algorithm may transparantly to the FindRecord loop decide
//> to find all the rows in advance (if for example the desired output order
//> is incompatible with the optimum search order). But if you call ForcePrefind
//> you can force the algorithm to pre-find the rows regardless of whether it
//> is necessary (or not?).
//> This is relevant if editing indexed columns of the rows found during the
//> FindRecord loop.
//
//> ForcePrefetch has no relevance (but does no harm) when run on a SQL table because the
//> algorithm in this case generates an SQL statement via the driver. In this
//> mode way the rows are "pre-found" anyway.
Procedure ForcePrefetch tTableQuery ByRef strQuery // Records will be prefetched.
Move True to strQuery.bForcePrefetch
End_Procedure
//> Even if we are querying an SQL table we may have reasons to force TQ to use
//> the record oriented driver interface. This call does that:
//>
//> Send ForcePrefetch of oTQ (&strQ)
//>
//> If in addition we also want to specify the cache parameters used by the
//> driver we can also specify prefetch count and cache timeout (for the
//> duration of the query:
//>
//> Send ForcePrefetch of oTQ (&strQ) 1000 2000
//>
//> This sets the prefetch cache to 1000 records and cache timeout to 2 seconds
//> and this will most certaimly give you a boost compared to the default values
//> which are 10/records/10ms.
Procedure ForceNoESQL tTableQuery ByRef strQuery Integer iPrefetchSize Integer iCacheTimeoutMS // ESQL will not be applied
Move True to strQuery.bNoESQL
If (num_arguments>1) Begin
Move True to strQuery._strControlBlock.strSQLCacheControl.bUseSettings
Move iPrefetchSize to strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordCount
If (num_arguments>2) Begin
Move iCacheTimeoutMS to strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordTimeout
End
Else Begin
Move 0 to strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordTimeout
End
End
Else Begin
Move False to strQuery._strControlBlock.strSQLCacheControl.bUseSettings
End
End_Procedure
//> Don't evaluate, just use iIndex I tell you. Ignored by ESQL
Procedure ForceIndex tTableQuery ByRef strQuery Integer iIndex
Move iIndex to strQuery.iForceIndex
End_Procedure
//> Limit number of rows in the result set.
Procedure SetLimit tTableQuery ByRef strQuery Integer iLimit
Move iLimit to strQuery.iLimit
End_Procedure
// Procedure SetExpectedNumberOfRecords tTableQuery ByRef strQuery Integer iResultSetSize // Just a thought
// End_Procedure
//> Use this table name when generating ESQL rather than the default one. Because I tell you to!
Procedure ForceSQLTableName tTableQuery ByRef strQuery String sSqlTableName
Move sSqlTableName to strQuery.sForceSQLTableName
End_Procedure
//> DANGER! Completely overtakes the scene. Make sure to "select" the columns expected by TQ
Procedure ForceSQLStatement tTableQuery ByRef strQuery String sSQLStatement
Move sSQLStatement to strQuery.sForceSQLStatement
End_Procedure
Procedure RestoreRecordBuffersOnQueryCompletion tTableQuery ByRef strQuery Boolean bState
Move bState to strQuery.bRestoreRecordBuffersOnQueryCompletion
End_Procedure
//> Use LogTag to distinguish between different FindRecord loops in the log. Or
//> between different situations in different runs of the same FindLoop. When this is set, TQ
//> will create a record in an un-listed log table by the name of (LogTableName(oTQ,strQuery))
Procedure SetLogTag tTableQuery ByRef strQuery String sTag
Move sTag to strQuery._strControlBlock.sLogTag
End_Procedure
//> Call BreakScan to terminate the FindRecord loop on next iteration. Note that when (explicitly or implicitly) we have set
//> the bForcePrefetch attribute, this will not be effective until we enter the actual find-loop. Which in that case will be
//> after all the rows have been found.
Procedure BreakScan tTableQuery ByRef strQuery
Move True to strQuery._strControlBlock.bBreakScan
End_Procedure
//> After query execution this will return an (english) string: "So many selected rows in so many finds"
Function StatisticsString tTableQuery strQuery Returns String
Integer iFound iSelect
Move strQuery._strControlBlock.iFindCount to iFound
Move strQuery._strControlBlock.iSelectCount to iSelect
Function_Return (String(iSelect)+" selected rows (in "+String(iFound)+" finds)")
End_Function
//> Returns the number of milliseconds it takes to make an "empty" round-trip to the SQL server. It makes at least 4 server calls.
Function ZeroSelectTime Integer iTable Returns Number
tSystemTimeMS strStart strStop
tTableQuery strQuery
Boolean bFound
Get NewQuery iTable to strQuery
Send ForceSQLStatement (&strQuery) "select 1"
Repeat
Get FindRecord (&strQuery) to bFound
Until (not(bFound))
Send ReUse (&strQuery)
Get SystemTimeMilliSeconds of oDateFunctions to strStart // We time the second loop (in case the first loop had to set up a connection)
Repeat
Get FindRecord (&strQuery) to bFound
Until (not(bFound))
Get SystemTimeMilliSeconds of oDateFunctions to strStop
Function_Return (SystemTimeMilliSecondsElapsed(oDateFunctions,strStart, strStop))
End_Function
//> Returns the table name of iTable as used (in SQL staments) in the strQuery context.
Function TableName tTableQuery strQuery Integer iTable Returns String
Integer iRelateItem
String sValue
If (iTable=strQuery.iTable) Begin
Move strQuery.sForceSQLTableName to sValue
End
Else Begin
Get _FindTableRelation strQuery iTable to iRelateItem
If (iRelateItem>=0) Begin
Move strQuery.aTableRelations[iRelateItem].sForceSQLTableName to sValue
End
End
If (sValue="") Begin
Get_Attribute DF_FILE_LOGICAL_NAME of iTable to sValue
End
If (sValue="") Begin
Send OnError 701 ("Table name could not be found for table "+String(iTable))
End
Function_Return sValue
End_Function
//> Returns column name of iTable.iColumn as used (in SQL staments) in the strQuery context.
Function ColumnName tTableQuery strQuery Integer iTable Integer iColumn Boolean bIncludeTableName Returns String
String sColumnName sTableName
Get_Attribute DF_FIELD_NAME of iTable iColumn to sColumnName
If (sColumnName<>"") Begin
If (bIncludeTableName) Begin
Get TableName strQuery iTable iColumn to sTableName
Function_Return (sTableName+"."+sColumnName)
End
Else Begin
Function_Return sColumnName
End
End
Function_Return ""
End_Function
Function ComperatorID2String Integer iComp Returns String
If (iComp=tqLT) Function_Return "<"
If (iComp=tqLE) Function_Return "<="
If (iComp=tqEQ) Function_Return "="
If (iComp=tqGE) Function_Return ">="
If (iComp=tqGT) Function_Return ">"
If (iComp=tqNE) Function_Return "<>"
// If (iComp=tqIN) Function_Return "in"
// If (iComp=tqCONTAINS) Function_Return "contains"
If (iComp=tqMATCH) Function_Return "match"
If (iComp=tqUCMATCH) Function_Return "ucmatch"
Function_Return "error"
End_Function
Function ComperatorID2ComperatorString Integer iComp Returns String
If (iComp=tqLT) Function_Return "tqLT"
If (iComp=tqLE) Function_Return "tqLE"
If (iComp=tqEQ) Function_Return "tqEQ"
If (iComp=tqGE) Function_Return "tqGE"
If (iComp=tqGT) Function_Return "tqGT"
If (iComp=tqNE) Function_Return "tqNE"
// If (iComp=tqIN) Function_Return "tqIN"
// If (iComp=tqCONTAINS) Function_Return "tqCONTAINS"
If (iComp=tqMATCH) Function_Return "tqMATCH"
If (iComp=tqUCMATCH) Function_Return "tqUCMATCH"
End_Function
Function ComperatorString2ID String sComp Returns Integer
Integer iMax iItem
Move (_tqComparisonMax-1) to iMax
Move (Lowercase(sComp)) to sComp
For iItem from 0 to iMax
If (sComp=Lowercase(ComperatorID2String(Self,iItem))) Begin
Function_Return iItem
End
Loop
Function_Return -1 // not found
End_Function
Procedure AddOrderBy tTableQuery ByRef strQuery Integer iTable Integer iColumn Boolean bDescending Boolean bUppercase
Integer iCount iRelateItem
Move (SizeOfArray(strQuery.aOrdering)) to iCount
Move iTable to strQuery.aOrdering[iCount].strValueSource.iTable
Move iColumn to strQuery.aOrdering[iCount].strValueSource.iColumn
Get _ColumnType iTable iColumn to strQuery.aOrdering[iCount].strValueSource.iType
If (num_arguments>=4) Begin
Move bDescending to strQuery.aOrdering[iCount].bDescending
End
Else Begin
Move False to strQuery.aOrdering[iCount].bDescending
End
If (num_arguments>=5) Begin
Move bUppercase to strQuery.aOrdering[iCount].bUppercase
End
Else Begin
Move False to strQuery.aOrdering[iCount].bUppercase
End
If (iTable<>strQuery.iTable) Begin
// We will also check if this parent table is accessible via the known table relations:
Get _FindTableRelation strQuery iTable to iRelateItem
If (iRelateItem=-1) Begin
Send OnError 702 ("Unknown table relation to table "+String(iTable))
End
Else Begin
// We're ordering by a parent table column which makes us have to prefetch the result:
Move True to strQuery.bForcePrefetch
End
End
End_Procedure
//> Delete all ordering information from the strQuery variable
Procedure ResetOrdering tTableQuery ByRef strQuery
// Check that the query is not already executing
If (strQuery._strControlBlock.bInitialized) Begin
Send OnError 740 "ResetOrdering called while query is executing"
End
Else Begin
Move (ResizeArray(strQuery.aOrdering,0)) to strQuery.aOrdering
End
End_Procedure
Function _FindOrderBySegment tTableQuery strQuery Integer iTable Integer iColumn Returns Integer
Integer iItem iItemMax
Move (SizeOfArray(strQuery.aOrdering)-1) to iItemMax
For iItem from 0 to iItemMax
If (iTable=strQuery.aOrdering[iItem].strValueSource.iTable and iColumn=strQuery.aOrdering[iItem].strValueSource.iColumn) Begin
Function_Return iItem
End
Loop
Function_Return -1 // Not found
End_Function
//> Shorthand for sending the AddOrdering a number of times to match the factual search order of a particular index. It's hard to explain why you'd do it, but I have.
Procedure SetOrderByToIndex tTableQuery ByRef strQuery Integer iIndex
tOCIndex strIndex
Integer iSegment iSegments
Get IndexDefinition of oOverlapColumnFunctions strQuery.iTable iIndex to strIndex
Move (SizeOfArray(strIndex.aSegments)-1) to iSegments
For iSegment from 0 to iSegments
Send AddOrderBy (&strQuery) strQuery.iTable strIndex.aSegments[iSegment].iColumn strIndex.aSegments[iSegment].bDescending strIndex.aSegments[iSegment].bUppercase
Loop
End_Procedure
Function _ColumnType Integer iTable Integer iColumn Returns Integer
Integer iVdfType
Get_Attribute DF_FIELD_TYPE of iTable iColumn to iVdfType
If (iVdfType=DF_ASCII) Function_Return tqSTRING
If (iVdfType=DF_OVERLAP) Function_Return tqSTRING
If (iVdfType=DF_BCD) Function_Return tqNUMBER
If (iVdfType=DF_DATE) Function_Return tqDATE
If (iVdfType=DF_DATETIME) Function_Return tqDATETIME
If (iVdfType=DF_TEXT) Function_Return tqTEXT
Function_Return -1
End_Function
Procedure AddFilter tTableQuery ByRef strQuery Integer iTable Integer iColumn Integer iComp String sConstant
Integer iConstraintIndex iRelateItem
tTQFilterSegment strSegment
Move iTable to strSegment.strLeftValue.iTable
Move iColumn to strSegment.strLeftValue.iColumn
Get _ColumnType iTable iColumn to strSegment.strLeftValue.iType
Move iComp to strSegment.iComp
Move sConstant to strSegment.strRightValue.sConstant
Get _ColumnType iTable iColumn to strSegment.strRightValue.iType
If (iTable<>strQuery.iTable) Begin
// Check if this parent table is accessible via the known table relations:
Get _FindTableRelation strQuery iTable to iRelateItem
If (iRelateItem=-1) Begin
Send OnError 703 ("Unknown table relation to table "+String(iTable))
End
End
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Send FilterExpressionAddOperand (&strQuery) strSegment
End
Else Begin
Move (SizeOfArray(strQuery.aFilters)) to iConstraintIndex
Move strSegment to strQuery.aFilters[iConstraintIndex]
End
End_Procedure
Procedure AddFilterOrList tTableQuery ByRef strQuery Integer iTable Integer iColumn String[] aOrList
Integer iConstraintIndex iRelateItem
tTQFilterSegment strSegment
Move iTable to strSegment.strLeftValue.iTable
Move iColumn to strSegment.strLeftValue.iColumn
Get _ColumnType iTable iColumn to strSegment.strLeftValue.iType
Move tqEQ to strSegment.iComp
Move aOrList to strSegment.strRightValue.aOrList
Move 0 to strSegment.strRightValue._iOrListPointer
Get _ColumnType iTable iColumn to strSegment.strRightValue.iType
If (iTable<>strQuery.iTable) Begin
// Check if this parent table is accessible via the known table relations:
Get _FindTableRelation strQuery iTable to iRelateItem
If (iRelateItem=-1) Begin
Send OnError 704 ("Unknown table relation to table "+String(iTable))
End
End
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Send FilterExpressionAddOperand (&strQuery) strSegment
End
Else Begin
Move (SizeOfArray(strQuery.aFilters)) to iConstraintIndex
Move strSegment to strQuery.aFilters[iConstraintIndex]
End
End_Procedure
Procedure AddFilterTableColumn tTableQuery ByRef strQuery Integer iTable Integer iColumn Integer iComp Integer iFilterTable Integer iFilterColumn
Integer iConstraintIndex iRelateItem
tTQFilterSegment strSegment
Move iTable to strSegment.strLeftValue.iTable
Move iColumn to strSegment.strLeftValue.iColumn
Get _ColumnType iTable iColumn to strSegment.strLeftValue.iType
Move iComp to strSegment.iComp
Move iFilterTable to strSegment.strRightValue.iTable
Move iFilterColumn to strSegment.strRightValue.iColumn
Get _ColumnType iFilterTable iFilterColumn to strSegment.strRightValue.iType
If (strSegment.strLeftValue.iTable<>strQuery.iTable) Begin
// Check if left hand table is accessible via the known table relations:
Get _FindTableRelation strQuery strSegment.strLeftValue.iTable to iRelateItem
If (iRelateItem=-1) Begin
Send OnError 705 ("Unknown table relation to table "+String(strSegment.strLeftValue.iTable))
End
End
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Send FilterExpressionAddOperand (&strQuery) strSegment
End
Else Begin
Move (SizeOfArray(strQuery.aFilters)) to iConstraintIndex
Move strSegment to strQuery.aFilters[iConstraintIndex]
End
End_Procedure
Procedure _AddConstrainRelateSegments tTableQuery ByRef strQuery Integer iTable Integer[] aColumns Integer iRelTable Integer[] aRelColumns
Integer iColumns iItem
Move (SizeOfArray(aColumns)-1) to iColumns
If ((iColumns+1)<>SizeOfArray(aRelColumns)) Begin
Send OnError 706 "Number of segments do not match in AddFilterRelate method"
End
For iItem from 0 to iColumns
If (iItem<>0 and strQuery._strControlBlock.bFilterExpressionActive) Begin
Send FilterPressKey (&strQuery) tqKeyAND // Put and between the segments
End
Send AddFilterTableColumn (&strQuery) iTable aColumns[iItem] tqEQ iRelTable aRelColumns[iItem]
Loop
End_Procedure
Procedure AddFilterRelate tTableQuery ByRef strQuery Integer iParentTable
Integer iTable iColumn iColumns iRelTable iRelColumn
Boolean bAnyColumnsAtAll
Send ReadTableDefinition of oOverlapColumnFunctions iParentTable
Move strQuery.iTable to iTable
Move False to bAnyColumnsAtAll
Get_Attribute DF_FILE_NUMBER_FIELDS of iTable to iColumns
For iColumn from 1 to iColumns
Get_Attribute DF_FIELD_RELATED_FILE of iTable iColumn to iRelTable
If (iRelTable=iParentTable) Begin
Get_Attribute DF_FIELD_RELATED_FIELD of iTable iColumn to iRelColumn
Send _AddConstrainRelateSegments (&strQuery) strQuery.iTable (TranslateOverlap(oOverlapColumnFunctions,iTable,iColumn)) iRelTable (TranslateOverlap(oOverlapColumnFunctions,iRelTable,iRelColumn))
Move True to bAnyColumnsAtAll
End
Loop
If (bAnyColumnsAtAll) Begin // If there were any segments relating we assume that the relation is good. If not we consider it an error of the table definitions.
// Tell the relationship handler that it should not worry about iParentTable. It is automatically and constantly related.
Send AddTableRelationFixedRecord (&strQuery) iParentTable
End
Else Begin
Send OnError 707 "Main query table does not relate to the parent table passed"
End
End_Procedure
//> AddFilterRelateFixedRecord is equivalent to AddFilterRelate but it defines the
//> filter based on constant filters rather than dynamic "table column filters".
Procedure AddFilterRelateFixedRecord tTableQuery ByRef strQuery Integer iParentTable
Integer iTable iColumn iColumns iRelTable iRelColumn iIndex iMax
Integer[] aColumns aRelColumns
String sValue
Boolean bAnythingAtAll
Send ReadTableDefinition of oOverlapColumnFunctions iParentTable
Move strQuery.iTable to iTable
Move False to bAnythingAtAll
Get_Attribute DF_FILE_NUMBER_FIELDS of iTable to iColumns
For iColumn from 1 to iColumns
Get_Attribute DF_FIELD_RELATED_FILE of iTable iColumn to iRelTable
If (iRelTable=iParentTable) Begin
Get_Attribute DF_FIELD_RELATED_FIELD of iTable iColumn to iRelColumn
Get TranslateOverlap of oOverlapColumnFunctions iTable iColumn to aColumns
Get TranslateOverlap of oOverlapColumnFunctions iRelTable iRelColumn to aRelColumns
Move (SizeOfArray(aColumns)-1) to iMax
If ((iMax+1)=SizeOfArray(aRelColumns)) Begin
Get_Field_Value iRelColumn aRelColumns[iIndex] to sValue
Send AddFilter (&strQuery) iTable aColumns[iIndex] tqEQ sValue
Move True to bAnythingAtAll
End
Else Begin
Send OnError 745 "Number of segments do not match in AddFilterRelateAsConstant method"
End
End
Loop
If (not(bAnythingAtAll)) Begin // If there were any segments relating we assume that the relation is good. If not we consider it an error of the table definitions.
Send OnError 746 "Main query table does not relate to the parent table passed"
End
End_Procedure
Procedure FilterKeyPadOn tTableQuery ByRef strQuery
Integer iItem
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Send OnError 708 "Filter expression already active (keypad is already on)"
End
Else Begin
Move (SizeOfArray(strQuery.aFilterExpressions)) to iItem
Move True to strQuery._strControlBlock.bFilterExpressionActive
Move False to strQuery.aFilterExpressions[iItem]._bOpen
End
End_Procedure
Procedure _FilterExpressionAndOr tTQFilterExpression[] ByRef aSegments Integer iKey
Integer iItem
Move (SizeOfArray(aSegments)-1) to iItem
If (iItem>=0 and aSegments[iItem].iAndOr=_tqKeyNULL) Begin
If (aSegments[iItem]._bOpen) Begin
Send _FilterExpressionAndOr (&aSegments[iItem].aSubExpressions) iKey
End
Else Begin
Move iKey to aSegments[iItem].iAndOr
End
End
Else Begin
Send OnError 709 "Logical operator (AND/OR) not allowed"
End
End_Procedure
Procedure _FilterExpressionNot tTQFilterExpression[] ByRef aSegments
Integer iItem
Move (SizeOfArray(aSegments)-1) to iItem
If (iItem>=0) Begin
If (aSegments[iItem]._bOpen) Begin
Send _FilterExpressionNot (&aSegments[iItem].aSubExpressions)
End
Else Begin
If (aSegments[iItem].iAndOr=_tqKeyNULL) Begin
Move True to aSegments[iItem].bNot
End
Else Begin
Send OnError 710 "Logical operator (NOT) not allowed"
End
End
End
Else Begin
Send OnError 711 "Logical operator (NOT) not allowed"
End
End_Procedure
Procedure _FilterExpressionLeftParenthesis tTQFilterExpression[] ByRef aSegments
Integer iItem
Move (SizeOfArray(aSegments)-1) to iItem
If (iItem>=0) Begin
If (aSegments[iItem]._bOpen) Begin
Send _FilterExpressionLeftParenthesis (&aSegments[iItem].aSubExpressions)
End
Else Begin
If (aSegments[iItem].iAndOr=_tqKeyNULL) Begin
Move True to aSegments[iItem]._bOpen
End
Else Begin
Move True to aSegments[iItem+1]._bOpen
End
End
End
Else Begin
Send OnError 713 "'(' not allowed"
End
End_Procedure
Procedure _FilterExpressionRightParenthesis tTQFilterExpression[] ByRef aSegments
Integer iItem
Move (SizeOfArray(aSegments)-1) to iItem
If (iItem>=0) Begin
If (aSegments[iItem]._bOpen) Begin
If (SizeOfArray(aSegments[iItem].aSubExpressions)=0 or not(aSegments[iItem].aSubExpressions[SizeOfArray(aSegments[iItem].aSubExpressions)-1]._bOpen)) Begin
Move False to aSegments[iItem]._bOpen
End
Else Begin
Send _FilterExpressionRightParenthesis (&aSegments[iItem].aSubExpressions)
End
End
Else Begin
Send OnError 714 "')' not allowed"
End
End
Else Begin
Send OnError 715 "Empty sub-expression, ')' not allowed"
End
End_Procedure
Procedure _FilterPressKey tTableQuery ByRef strQuery Integer iKey
Integer iActiveFilterExpression
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Move (SizeOfArray(strQuery.aFilterExpressions)-1) to iActiveFilterExpression
If (iKey=tqKeyAND or iKey=tqKeyOR) Begin
Send _FilterExpressionAndOr (&strQuery.aFilterExpressions[iActiveFilterExpression].aSubExpressions) iKey
End
Else If (iKey=tqKeyNOT) Begin
Send _FilterExpressionNot (&strQuery.aFilterExpressions[iActiveFilterExpression].aSubExpressions)
End
Else If (iKey=tqKeyPARLEFT or iKey=tqKeyPARRIGHT) Begin
If (iKey=tqKeyPARLEFT) Begin
Send _FilterExpressionLeftParenthesis (&strQuery.aFilterExpressions[iActiveFilterExpression].aSubExpressions)
End
Else If (iKey=tqKeyPARRIGHT) Begin
Send _FilterExpressionRightParenthesis (&strQuery.aFilterExpressions[iActiveFilterExpression].aSubExpressions)
End
End
Else Begin
Send OnError 716 "Unknown 'key' passed to FilterPressKey method"
End
End
Else Begin
Send OnError 717 "No active filter expression"
End
End_Procedure
Procedure FilterPressKey tTableQuery ByRef strQuery Integer iKey
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Send _FilterPressKey (&strQuery) iKey
End
Else Begin
Send OnError 718 "No active filter expression"
End
End_Procedure
Procedure _FilterExpressionAddOperand tTableQuery ByRef strQuery tTQFilterExpression[] ByRef aFilterSegments tTQFilterSegment strConstrainSegment
Integer iItem
// Boolean bHasSubExp
Move (SizeOfArray(aFilterSegments)-1) to iItem
If (iItem>=0) Begin
If (aFilterSegments[iItem]._bOpen) Begin
Send _FilterExpressionAddOperand (&strQuery) (&aFilterSegments[iItem].aSubExpressions) strConstrainSegment
End
Else Begin
// Move (SizeOfArray(aFilterSegments[iItem].aSubExpressions)>0) to bHasSubExp
If (aFilterSegments[iItem].iAndOr=_tqKeyNULL) Begin // if operator has not been added
Move strConstrainSegment to aFilterSegments[iItem].strOperand
End
Else Begin // Operator has been added, well take the next segment
Move strConstrainSegment to aFilterSegments[iItem+1].strOperand
End
End
End
Else Begin
Move strConstrainSegment to aFilterSegments[0].strOperand
End
End_Procedure
Procedure FilterExpressionAddOperand tTableQuery ByRef strQuery tTQFilterSegment strFilterSegment
Integer iActiveFilterExpression
Move (SizeOfArray(strQuery.aFilterExpressions)-1) to iActiveFilterExpression
If (iActiveFilterExpression>=0) Begin
Send _FilterExpressionAddOperand (&strQuery) (&strQuery.aFilterExpressions[iActiveFilterExpression].aSubExpressions) strFilterSegment
End
Else Begin
Send OnError 719 "No active expression filter"
End
End_Procedure
Procedure FilterEnterOverAndOut tTableQuery ByRef strQuery
If (strQuery._strControlBlock.bFilterExpressionActive) Begin
Move False to strQuery._strControlBlock.bFilterExpressionActive
End
Else Begin
Send OnError 720 "No active filter expression to close"
End
End_Procedure
Function _ValidateQuery tTableQuery strQuery Returns Boolean
// Check that no more than 1 constraints is put on each column (allow for interval checking though)
Integer iConstrainMax iConstrainIndex iComp
Integer iNewLoad iCurrentLoad iColumn
Integer iTable
Integer[][] aaConstrainLoads
Move (SizeOfArray(strQuery.aFilters)-1) to iConstrainMax
For iConstrainIndex from 0 to iConstrainMax
Move strQuery.aFilters[iConstrainIndex].strLeftValue.iTable to iTable
If (iTable>=SizeOfArray(aaConstrainLoads)) Begin
Move 0 to aaConstrainLoads[iTable][0]
End
// Check that no more than 1 constraints is put on each column (allow for interval checking though)
Move strQuery.aFilters[iConstrainIndex].iComp to iComp
If (iComp=tqGT or iComp=tqGE) Move 1 to iNewLoad // 01
Else If (iComp=tqLT or iComp=tqLE) Move 2 to iNewLoad // 10
Else Move 3 to iNewLoad // 11
Move strQuery.aFilters[iConstrainIndex].strLeftValue.iColumn to iColumn
If (iColumn>=SizeOfArray(aaConstrainLoads[iTable])) Begin
Move 0 to iCurrentLoad
End
Else Begin
Move aaConstrainLoads[iTable][iColumn] to iCurrentLoad
End
If (iNewLoad iand iCurrentLoad) Begin
Send OnError 739 (Replace("#","Illegal filter. Column # is over-constrained",ColumnName(Self,strQuery,iTable,iColumn,True)))
Function_Return False
End
Move (iCurrentLoad+iNewLoad) to aaConstrainLoads[iTable][iColumn]
// ToDo: (maybe) Check that tables used for AddFilterRelate are not used as relate tables also.
Loop
Function_Return True
End_Function
Function _IsTableFixed tTableQuery strQ Integer iTable Returns Boolean
Integer iRelateItem
If (iTable=strQ.iTable) Begin
Function_Return False // If it's the main table of the query it is definitely not fixed.
End
Get _FindTableRelation strQ iTable to iRelateItem
If (iRelateItem<>-1) Begin
Function_Return strQ.aTableRelations[iRelateItem].bFixed
End
Send OnError 735 ("Table not related: "+String(iTable))
End_Function
Function _ColumnRatings tTableQuery strQuery Returns Number[]
// Calculate an array of columns that can be used for jump-in /jump-out.
// If a column has a jump-in value or a jump-out value it is rated (apr) 0.5.
// If a column has both it is rated 2.0.
Integer iColumn
Integer iIndex iIndices
Integer iSegment iSegments
Integer iConstraint iConstraints
Integer iTable iComp
Number[] aColumnRatings
tOCTable strTable
Move strQuery.iTable to iTable
Get TableDefinition of oOverlapColumnFunctions iTable to strTable
Move (SizeOfArray(strTable.aIndices)-1) to iIndices
Move (SizeOfArray(strQuery.aFilters)-1) to iConstraints
Move (ResizeArray(aColumnRatings,SizeOfArray(strTable.aColumns))) to aColumnRatings
For iIndex from 1 to iIndices
Move (SizeOfArray(strTable.aIndices[iIndex].aSegments)-1) to iSegments
For iSegment from 0 to iSegments
Move strTable.aIndices[iIndex].aSegments[iSegment].iColumn to iColumn
If (aColumnRatings[iColumn]=0) Begin // To avoid the same column getting added ratings because appearing in multiple indices
For iConstraint from 0 to iConstraints
// Only evaluate filters that:
// 1. (left side) filters on a column in the query main table
// 2. (right side) does not filter on a column from a table that changes on each new main table record
If ( strQuery.aFilters[iConstraint].strLeftValue.iTable=iTable and ;
( strQuery.aFilters[iConstraint].strRightValue.iTable=0 or ;
_IsTableFixed(Self,strQuery,strQuery.aFilters[iConstraint].strRightValue.iTable) )) Begin
Move strQuery.aFilters[iConstraint].iComp to iComp
If (iColumn=strQuery.aFilters[iConstraint].strLeftValue.iColumn) Begin
If (iComp=tqEQ) Begin
Move 2 to aColumnRatings[iColumn]
End
Else If (iComp=tqGE or iComp=tqGT) Begin
Move (aColumnRatings[iColumn]+0.49) to aColumnRatings[iColumn]
End
Else If (iComp=tqLT or iComp=tqLE) Begin
Move (aColumnRatings[iColumn]+0.51) to aColumnRatings[iColumn]
End
// Note: Using the values 0.49 and 0.51 is a trick to allow the consumer
// of these data to determine whether the constraining operator
// was Lx or Gx (or both). It means nothing to the final ranking
// of the indices. They are both weighed by 0.5.
End
End
Loop
End
Loop
Loop
Function_Return aColumnRatings
End_Function
// If this returns true column iColumn is constrained to a fixed value. (If it is, the
// column may be discarded if appearing as a most-significant index segment)
Function _ColumnFixedByEqConstraint tTableQuery strQuery Integer iColumn Returns Boolean
Integer iConstraintIndex iConstraintMax
tTQFilterSegment strConstraint
Move (SizeOfArray(strQuery.aFilters)-1) to iConstraintMax
For iConstraintIndex from 0 to iConstraintMax
Move strQuery.aFilters[iConstraintIndex] to strConstraint
If (strConstraint.iComp=tqEQ and ;
strConstraint.strLeftValue.iTable=strQuery.iTable and ;
strConstraint.strLeftValue.iColumn=iColumn and ;
SizeOfArray(strConstraint.strRightValue.aOrList)<2) Begin
Function_Return True
End
Loop
Function_Return False
End_Function
Function _IndexSegmentAgreement tTQOrderBySegment strOrderSegment Integer iTable tOCIndexSegment[] aIndexSegments Integer iIndexSegment Boolean bBackwards Boolean bEQ Returns Boolean
If (iIndexSegment0) Begin
Move (CopyArray(aIndexSegments,iSkipSegments,iSegments)) to aRemainingSegments
End
Function_Return aRemainingSegments
End_Function
Function _TrimOrderBySegments tTableQuery strQuery tTQOrderBySegment[] aOrderingBySegments Returns tTQOrderBySegment[]
Integer iTable
Integer iSegments iSkipSegments
tTQOrderBySegment[] aRemainingSegments
Move strQuery.iTable to iTable
Move 0 to iSkipSegments
Move (SizeOfArray(aOrderingBySegments)-1) to iSegments
If (iSegments>=0) Begin
While (iSkipSegments<=iSegments and aOrderingBySegments[iSkipSegments].strValueSource.iTable=iTable and _ColumnFixedByEqConstraint(Self,strQuery,aOrderingBySegments[iSkipSegments].strValueSource.iColumn))
Increment iSkipSegments
Loop
Move (CopyArray(aOrderingBySegments,iSkipSegments,iSegments)) to aRemainingSegments
End
Function_Return aRemainingSegments
End_Function
Function _IndexAgreement tTableQuery strQuery Integer iIndex Boolean bFinalDecision Returns Boolean
// Is the index in agreement with the specified output order?
//
// For each segment in the desired output order it must be the case that it is a
// table column based segment and that either:
//
// 1) its value is fixed by a eq-constraint and all segments before it has been
// satisfied the same way (if the column happens to be the same as the
// "next segment" in the index we're testing, then we must disregard that
// segment from then on).
// or
// 2) it is satisfied by the "next segment" in the index we're testing
//
tOCIndex strIndex
tOCIndexSegment[] aIndexSegments
tTQOrderBySegment[] aOrderingSegments
_tTQValueSource strValueSource
Boolean bOrderSegmentOK bIndexSegmentMatch
Boolean bBackwards bEq
Integer iIndexSegment iIndexSegments
Integer iOrderingSegment iOrderingSegments
Integer iConstraint
If (strQuery._strCompiled.nENR=0) Begin // If index is fully specified all indices agree
Function_Return True
End
If (bFinalDecision) Begin
Move strQuery._strCompiled.bBackwards to bBackwards
End
Else Begin
If (iIndex>1000) Begin
Move (iIndex-1000) to iIndex
Move True to bBackwards
End
Else Begin
Move False to bBackwards
End
End
Get IndexDefinition of oOverlapColumnFunctions strQuery.iTable iIndex to strIndex
Get _TrimIndexSegments strQuery strIndex.aSegments to aIndexSegments
Get _TrimOrderBySegments strQuery strQuery.aOrdering to aOrderingSegments
Move (SizeOfArray(aIndexSegments)-1) to iIndexSegments
Move (SizeOfArray(aOrderingSegments)-1) to iOrderingSegments
Move 0 to iIndexSegment
For iOrderingSegment from 0 to iOrderingSegments
Move False to bOrderSegmentOK
Move aOrderingSegments[iOrderingSegment].strValueSource to strValueSource
If (iOrderingSegment<=iIndexSegments and strValueSource.iTable=strQuery.iTable) Begin // If the order-segment is main-table-based
Get _FindConstraintEQ strQuery.aFilters strQuery.iTable strValueSource.iColumn False to iConstraint
Move (iConstraint<>-1) to bEq
Get _IndexSegmentAgreement aOrderingSegments[iOrderingSegment] strQuery.iTable aIndexSegments iIndexSegment bBackwards bEq to bIndexSegmentMatch
If (bIndexSegmentMatch) Begin
Move True to bOrderSegmentOK
Increment iIndexSegment
End
Else Begin
// If the segment is constrained by an EQ we are still in agreement
If (_ColumnFixedByEqConstraint(Self,strQuery,strValueSource.iColumn)) Begin
Move True to bOrderSegmentOK
End
End
End
If (not(bOrderSegmentOK)) Begin
Function_Return False
End
Loop
Function_Return True
End_Function
Function _IndexExpectedNumberRows tTableQuery strQuery Integer iIndex Number[] aColumnRatings _tTQIndexAnalysis strIndexA Returns Number
Boolean bAccept
Integer iTable iColumn
Integer iSegmentIndex iSegmentMax iPushIndex
Number nExpectedNumberRows
tOCIndex strIndex
Number nColumnRating
If (iIndex>=1000) Begin
Move (iIndex-1000) to iIndex
End
Move strQuery.iTable to iTable
Get_Attribute DF_FILE_RECORDS_USED of iTable to nExpectedNumberRows
Get IndexDefinition of oOverlapColumnFunctions iTable iIndex to strIndex
Move (SizeOfArray(strIndex.aSegments)) to iSegmentMax
Move True to bAccept
Move 0 to iSegmentIndex
While (bAccept and iSegmentIndex=1 or nColumnRating=0.49) to bAccept
If (bAccept) Begin
Move (nExpectedNumberRows*0.5) to nExpectedNumberRows
Increment iSegmentIndex
End
Loop
Move iPushIndex to iSegmentIndex
Move True to bAccept
While (bAccept and iSegmentIndex=1 or nColumnRating=0.51) to bAccept
If (bAccept) Begin
Move (nExpectedNumberRows*0.5) to nExpectedNumberRows
Increment iSegmentIndex
End
Loop
Function_Return nExpectedNumberRows
End_Function
Function _IndexRating tTableQuery strQuery Integer iIndex Number[] aColumnRatings _tTQIndexAnalysis strIndexA Returns _tTQIndexRating
Integer iTable
_tTQIndexRating strRating
Move strQuery.iTable to iTable
Move iIndex to strRating.iIndex
Get _IndexExpectedNumberRows strQuery iIndex aColumnRatings strIndexA to strRating.nExpectedNumberRows
If (strRating.nExpectedNumberRows=0) Begin
Move True to strRating.bOutputAgree
End
Else Begin
Get _IndexAgreement strQuery iIndex False to strRating.bOutputAgree
End
If (iIndex>=1000) Begin // find lt by index iIndex-1000
Move (iIndex-1000) to iIndex
Get_Attribute DF_INDEX_LEVELS of iTable iIndex 0 to strRating.iKeyLevels
Get_Attribute DF_INDEX_KEY_LENGTH of iTable iIndex 0 to strRating.iKeyLength
Move (strRating.iKeyLength+1) to strRating.iKeyLength // Always prefer find gt to find lt when all else is equal
End
Else Begin
Get_Attribute DF_INDEX_LEVELS of iTable iIndex 0 to strRating.iKeyLevels
Get_Attribute DF_INDEX_KEY_LENGTH of iTable iIndex 0 to strRating.iKeyLength
End
Function_Return strRating
End_Function
Function _IndexRatings tTableQuery strQuery Returns _tTQIndexRating[]
// Create an array of defined indices on the table and for each index assign a rating
// Sort the array of indices according to rating and pick the one with the highest one.
Integer iItem iMax
Integer iIndex
Integer[] aIndices
Number[] aColumnRatings
tTQTableAnalysis strAnalysis
_tTQIndexRating strRating
_tTQIndexRating[] aIndexRatings
Get TableAnalysis strQuery.iTable to strAnalysis
Get _ColumnRatings strQuery to aColumnRatings
Get TableIndices strQuery.iTable to aIndices // All on-line indices
Move (SizeOfArray(aIndices)-1) to iMax
For iItem from 0 to iMax
Move aIndices[iItem] to iIndex
Get _IndexRating strQuery iIndex aColumnRatings strAnalysis.aIndices[iIndex] to strRating
Move strRating to aIndexRatings[SizeOfArray(aIndexRatings)]
// Also check the reverse index:
Get _IndexRating strQuery (1000+iIndex) aColumnRatings strAnalysis.aIndices[iIndex] to strRating
Move strRating to aIndexRatings[SizeOfArray(aIndexRatings)]
Loop
Function_Return aIndexRatings
End_Function
Function _LowestIndexNumber Integer iTable Returns Integer
Integer iIndex iIndexMax iSegments
Get_Attribute DF_FILE_LAST_INDEX_NUMBER of iTable to iIndexMax
Move 1 to iIndex
While (iIndex<=iIndexMax)
Get_Attribute DF_INDEX_NUMBER_SEGMENTS of iTable iIndex to iSegments
If (iSegments<>0) Begin
Function_Return iIndex
End
Loop
Function_Return 0 // None found
End_Function
Function _CompareIndexRating _tTQIndexRating strRatingLeft _tTQIndexRating strRatingRight Returns Integer
Number nFactorLeft nFactorRight
Number nPrefetchAvoidanceFactor
Get _pnPrefetchAvoidanceFactor to nPrefetchAvoidanceFactor
// This means that we accept an index in agreement with the output order if it is more
// than 10 times less efficient (assuming that nPrefetchAvoidanceFactor is 0.1 (which it is (by default)))
Move (If(strRatingLeft.bOutputAgree,nPrefetchAvoidanceFactor,1)) to nFactorLeft
Move (If(strRatingRight.bOutputAgree,nPrefetchAvoidanceFactor,1)) to nFactorRight
Move (strRatingLeft.nExpectedNumberRows*nFactorLeft) to nFactorLeft
Move (strRatingRight.nExpectedNumberRows*nFactorRight) to nFactorRight
If (nFactorLeft > nFactorRight) Function_Return (GT) // Right is best
If (nFactorLeft < nFactorRight) Function_Return (LT) // Left is best
If (strRatingLeft.iKeyLevels>strRatingRight.iKeyLevels) Function_Return (GT) // Right is best
If (strRatingLeft.iKeyLevelsstrRatingRight.iKeyLength) Function_Return (GT) // Right is best
If (strRatingLeft.iKeyLength=0) Begin
If (strQuery.bForcePrefetch) Begin
// If prefetch is forced anyway, we will not consider prefetch an "extra" cost.
Set _pnPrefetchAvoidanceFactor to 1
End
Else Begin
Set _pnPrefetchAvoidanceFactor to strQuery._strControlBlock.nPrefetchAvoidanceFactor
End
Move (SortArray(aIndexRatings,Self,GET__CompareIndexRating)) to aIndexRatings
Move aIndexRatings[0].iIndex to iIndex
Move aIndexRatings[0].nExpectedNumberRows to nENR
End
Else Begin
Move 0 to iIndex
Move -1 to nENR // No idea
End
If (iIndex>=1000) Begin
Move (iIndex-1000) to iIndex
Move (not(strQuery._strCompiled.bBackwards)) to strQuery._strCompiled.bBackwards // Flip
End
Move iIndex to strQuery._strCompiled.iIndex
Move nENR to strQuery._strCompiled.nENR
Function_Return aIndexRatings
End_Function
Function IndexRatingText tTableQuery strQuery _tTQIndexRating[] aIndexRatings Returns String
Boolean bBackwards
Integer iItem iMax iTable iIndex
Number nRecCount nFactor
String sValue sIndex sTemp
Move strQuery.iTable to iTable
Get_Attribute DF_FILE_RECORDS_USED of iTable to nRecCount
If (strQuery.bForcePrefetch) Begin
Move 1 to nFactor
End
Else Begin
Move strQuery._strControlBlock.nPrefetchAvoidanceFactor to nFactor
End
If (strQuery.iForceIndex=-1) Begin
Move "Index Ratings\n\nRatings are based on expected number of rows (ENR). If the use of an index implies prefetching and sorting data then ENR is multiplied by # (but not shown).\n\nIndex ratings, best to worst (there is # rows in table #):\n" to sValue
Move (Replace("#",sValue,String(1.0/nFactor))) to sValue
Move (Replace("#",sValue,NumberToString(oStringFunctions,nRecCount,0))) to sValue
Move (Replace("#",sValue,TableName(Self,strQuery,iTable))) to sValue
Move (SizeOfArray(aIndexRatings)-1) to iMax
For iItem from 0 to iMax
Move "Index ##: ENR=#, #, Levels/length=#/#" to sIndex
Move aIndexRatings[iItem].iIndex to iIndex
If (iIndex>1000) Begin
Move (iIndex-1000) to iIndex
Move True to bBackwards
End
Else Begin
Move False to bBackwards
End
Move (Replace("#",sIndex,String(iIndex))) to sIndex
If (bBackwards) Begin
Move (Replace("#",sIndex," (backwards)")) to sIndex
End
Else Begin
Move (Replace("#",sIndex,"")) to sIndex
End
Move (Replace("#",sIndex,String(aIndexRatings[iItem].nExpectedNumberRows))) to sIndex
Move (If(aIndexRatings[iItem].bOutputAgree,"Ordering ok","Prefetch needed")) to sTemp
Move (Replace("#",sIndex,sTemp)) to sIndex
Move (Replace("#",sIndex,String(aIndexRatings[iItem].iKeyLevels))) to sIndex
Move (Replace("#",sIndex,String(aIndexRatings[iItem].iKeyLength))) to sIndex
Move (sValue+"\n"+sIndex) to sValue
Loop
End
Else Begin
Move "Indices have not been rated (index was forced)" to sValue
End
Function_Return sValue
End_Function
Procedure OnIndexCalculated tTableQuery strQuery _tTQIndexRating[] aIndexRatings
End_Procedure
Function _FindConstraintEQ tTQFilterSegment[] aFilters Integer iTable Integer iColumn Boolean bOrListOnly Returns Integer
Integer iConstraint iConstraints
Move (SizeOfArray(aFilters)-1) to iConstraints
For iConstraint from 0 to iConstraints
If (iTable=aFilters[iConstraint].strLeftValue.iTable and ;
iColumn=aFilters[iConstraint].strLeftValue.iColumn and aFilters[iConstraint].iComp=tqEQ) Begin
If (not(bOrListOnly) or SizeOfArray(aFilters[iConstraint].strRightValue.aOrList)>0) Begin
Function_Return iConstraint
End
End
Loop
Function_Return -1
End_Function
Procedure _AppendConstraint tTQFilterSegment[] ByRef aConstraint tTQFilterSegment strConstraint
Integer iIndex
Move (SizeOfArray(aConstraint)) to iIndex
Move strConstraint to aConstraint[iIndex]
End_Procedure
Procedure _DeleteConstraint tTQFilterSegment[] ByRef aFilters Integer iConstraint
#IF (FMAC_VERSION<15)
Integer iIndex iMax iCount
tTQFilterSegment[] aResultConstraints
Move 0 to iCount
Move (SizeOfArray(aFilters)-1) to iMax
For iIndex from 0 to iMax
If (iIndex<>iConstraint) Begin // If not the one we delete
Move aFilters[iIndex] to aResultConstraints[iCount]
Increment iCount
End
Loop
Move aResultConstraints to aFilters
#ELSE
Move (RemoveFromArray(aFilters,iConstraint)) to aFilters
#ENDIF
End_Procedure
Procedure _CalculateJumpInOutConditionsStep01 tTableQuery ByRef strQuery Integer ByRef iSegment Integer iSegments tOCIndex strIndex
// 1: As long as we can consequetively provide EQ constraints on the segment, we copy the constraint to
// both the JumpInValues and JumpOutValues (and disregard that constraint from then on)
Integer iTable iIndex iColumn iConstraint
Boolean bCont
Move strQuery.iTable to iTable
Move strQuery._strCompiled.iIndex to iIndex
Move True to bCont
While (bCont and iSegment<=iSegments)
Move strIndex.aSegments[iSegment].iColumn to iColumn
Get _FindConstraintEQ strQuery.aFilters iTable iColumn False to iConstraint
Move (iConstraint<>-1) to bCont
If (bCont) Begin
Send _AppendConstraint (&strQuery._strCompiled.aJumpInValues) strQuery.aFilters[iConstraint]
Send _AppendConstraint (&strQuery._strCompiled.aJumpOutValues) strQuery.aFilters[iConstraint]
Send _DeleteConstraint (&strQuery.aFilters) iConstraint
Increment iSegment
End
Loop
End_Procedure
Function _FindConstraintGEGT tTQFilterSegment[] aFilters Integer iTable Integer iColumn Boolean bAlsoEQ Returns Integer
Integer iConstraint iConstraints iComp
Move (SizeOfArray(aFilters)-1) to iConstraints
For iConstraint from 0 to iConstraints
If (iTable=aFilters[iConstraint].strLeftValue.iTable and iColumn=aFilters[iConstraint].strLeftValue.iColumn) Begin
Move aFilters[iConstraint].iComp to iComp
If (iComp=tqGT or iComp=tqGE or (bAlsoEQ and iComp=tqEQ)) Begin
Function_Return iConstraint
End
End
Loop
Function_Return -1
End_Function
Function _FindConstraintLELT tTQFilterSegment[] aFilters Integer iTable Integer iColumn Boolean bAlsoEQ Returns Integer
Integer iConstraint iConstraints iComp
Move (SizeOfArray(aFilters)-1) to iConstraints
For iConstraint from 0 to iConstraints
If (iTable=aFilters[iConstraint].strLeftValue.iTable and iColumn=aFilters[iConstraint].strLeftValue.iColumn) Begin
Move aFilters[iConstraint].iComp to iComp
If (iComp=tqLT or iComp=tqLE or (bAlsoEQ and iComp=tqEQ)) Begin
Function_Return iConstraint
End
End
Loop
Function_Return -1
End_Function
Procedure _CalculateJumpInOutConditionsStep02 tTableQuery ByRef strQuery Integer ByRef iJumpInSegment Integer ByRef iJumpOutSegment Integer iSegments tOCIndex strIndex
// 2. If we can then provide a LT,LE,GE,GT type constraint (for JumpInValues and JumpOutValues
// indepentdantly) we move the constraint to JumpInValues/JumpOutValues (and disregard that
// constraint from then on *unless* it's a jump-in constraint and the comperator is GT (or LT
// if it's a descending index segment))
Integer iTable iIndex iColumn iConstraint
Boolean bCont
Move strQuery.iTable to iTable
Move strQuery._strCompiled.iIndex to iIndex
// Jump in
If (iJumpInSegment<=iSegments) Begin
Move strIndex.aSegments[iJumpInSegment].iColumn to iColumn
If (strIndex.aSegments[iJumpInSegment].bDescending) Begin
Get _FindConstraintLELT strQuery.aFilters iTable iColumn False to iConstraint
If (iConstraint<>-1) Begin
Send _AppendConstraint (&strQuery._strCompiled.aJumpInValues) strQuery.aFilters[iConstraint]
If (strQuery.aFilters[iConstraint].iComp=tqLE) Begin
Send _DeleteConstraint (&strQuery.aFilters) iConstraint
End
Increment iJumpInSegment
End
Else Begin
Move -1 to iJumpInSegment
End
End
Else Begin
Get _FindConstraintGEGT strQuery.aFilters iTable iColumn False to iConstraint
If (iConstraint<>-1) Begin
Send _AppendConstraint (&strQuery._strCompiled.aJumpInValues) strQuery.aFilters[iConstraint]
If (strQuery.aFilters[iConstraint].iComp=tqGE) Begin
Send _DeleteConstraint (&strQuery.aFilters) iConstraint
End
Increment iJumpInSegment
End
Else Begin
Move -1 to iJumpInSegment
End
End
End
// Jump out
If (iJumpOutSegment<=iSegments) Begin
Move strIndex.aSegments[iJumpOutSegment].iColumn to iColumn
If (strIndex.aSegments[iJumpOutSegment].bDescending) Begin
Get _FindConstraintGEGT strQuery.aFilters iTable iColumn False to iConstraint
If (iConstraint<>-1) Begin
Send _AppendConstraint (&strQuery._strCompiled.aJumpOutValues) strQuery.aFilters[iConstraint]
Send _DeleteConstraint (&strQuery.aFilters) iConstraint
Increment iJumpOutSegment
End
Else Begin
Move -1 to iJumpOutSegment
End
End
Else Begin
Get _FindConstraintLELT strQuery.aFilters iTable iColumn False to iConstraint
If (iConstraint<>-1) Begin
Send _AppendConstraint (&strQuery._strCompiled.aJumpOutValues) strQuery.aFilters[iConstraint]
Send _DeleteConstraint (&strQuery.aFilters) iConstraint
Increment iJumpOutSegment
End
Else Begin
Move -1 to iJumpOutSegment
End
End
End
End_Procedure
Procedure _CalculateJumpInOutConditions tTableQuery ByRef strQuery
Integer iSegment iSegments iTable iIndex iTempIndex
Integer iJumpInSegment iJumpOutSegment
Boolean bBackwards
tTQFilterSegment[] aBackupConstraints
tOCIndex strIndex
Move strQuery.iTable to iTable
Move strQuery._strCompiled.iIndex to iIndex
Move strQuery._strCompiled.bBackwards to bBackwards
Move strQuery.aFilters to aBackupConstraints
// If the scan index is not compatible with the output index we are forced to
// prefetch the record set in order to sort it before we "output" it:
If (not(_IndexAgreement(Self,strQuery,iIndex,True))) Begin
// If the index is the exact uppersite we still consider the index in agreement.
// Therefore we do not pass the information that the index is scanned backwards to
// the _IndexAgreement function.
Move True to strQuery._strCompiled.bPrefetch
Move strQuery._strCompiled._iLimit to strQuery._strCompiled._iPushLimit
If (strQuery._strCompiled.bBackwards) Begin // set to the opposite of what was tested above _IndexAgreement call
Move strQuery._strCompiled.iIndex to iTempIndex
End
Else Begin
Move (strQuery._strCompiled.iIndex+1000) to iTempIndex
End
If (strQuery.iForceIndex=-1 and strQuery.iLimit<>0 and _IndexAgreement(Self,strQuery,iTempIndex,False)) Begin
// If tail and negated index is ok then we do _not_ reset the limit.
End
Else Begin
Move 0 to strQuery._strCompiled._iLimit
End
End
Else Begin
Move 0 to strQuery._strCompiled._iPushLimit
End
// Initialize:
Move (ResizeArray(strQuery._strCompiled.aJumpInValues,0)) to strQuery._strCompiled.aJumpInValues
Move (ResizeArray(strQuery._strCompiled.aJumpOutValues,0)) to strQuery._strCompiled.aJumpOutValues
Move (ResizeArray(strQuery._strCompiled.aOtherConditions,0)) to strQuery._strCompiled.aOtherConditions
Get IndexDefinition of oOverlapColumnFunctions strQuery.iTable iIndex to strIndex
Move (SizeOfArray(strIndex.aSegments)-1) to iSegments
Move 0 to iSegment // Used to be 1
// Calculating the JumpInValues:
// Starting with the most significant segment we go through the segments of the iScanIndex
// 1. As long as we can consequetively provide EQ constraints on the segment, we copy the
// constraint to both the JumpInValues and JumpOutValues (and disregard that constraint
// from then on)
Send _CalculateJumpInOutConditionsStep01 (&strQuery) (&iSegment) iSegments strIndex
// 2. If we can then provide a LT,LE,GE,GT type constraint (for JumpInValues and JumpOutValues
// respectively) we move the constraint to JumpInValues/JumpOutValues (and disregard that
// constraint from then on)
Move iSegment to iJumpInSegment
Move iSegment to iJumpOutSegment
Send _CalculateJumpInOutConditionsStep02 (&strQuery) (&iJumpInSegment) (&iJumpOutSegment) iSegments strIndex
// 3. The constraints that are then left are copied to the aOtherConstraints array
Move strQuery.aFilters to strQuery._strCompiled.aOtherConditions
Move aBackupConstraints to strQuery.aFilters
End_Procedure
Procedure _IncrementJumpInOutCondition _tTQValueSource ByRef stValue Integer ByRef bIncrement Integer ByRef bCarry
Integer iMax
Move (SizeOfArray(stValue.aOrList)-1) to iMax
If (iMax>=0) Begin // If it's an or-list
If (bIncrement or bCarry) Begin
Increment stValue._iOrListPointer
If (stValue._iOrListPointer>iMax) Begin
Move True to bCarry
Move 0 to stValue._iOrListPointer
End
Else Begin
Move False to bCarry
End
Move False to bIncrement
End
End
End_Procedure
Procedure _ResetOrListPointer _tTQValueSource ByRef stValue
If (SizeOfArray(stValue.aOrList)>0) Begin
Move 0 to stValue._iOrListPointer
End
End_Procedure
Function _IncrementJumpInOutConditions tTableQuery ByRef strQuery Integer iJumpOutTriggerIndex Returns Boolean
// This function increments jump-in/out pointers and returns false if pointers could not
// be incremented. The pointers are into arrays of or-list values
// Parameter iJumpOutTriggerIndex points to the constrain segment that triggered the jump-out
// that in turn triggered the call of this function.
// The or-list pointers to the left of (and including) iJumpOutTriggerIndex must be incremented
// while the or-list pointers to the right must be reset.
Integer iItem iMax iIndex
Boolean bCarry bIncrement bSuccess bReturnFalse
Move (SizeOfArray(strQuery._strCompiled.aJumpOutValues)-1) to iMax
Move False to bReturnFalse
If (iJumpOutTriggerIndex>=0) Begin
// Increment pointers to the left
Move False to bCarry
Move True to bIncrement
If (SizeOfArray(strQuery._strCompiled.aJumpOutValues)>0) Begin // Only of there are any jumpout values to increment upon
For iItem from 0 to iJumpOutTriggerIndex
Move (iJumpOutTriggerIndex-iItem) to iIndex // Go throught it backwards (least significant first)
Send _IncrementJumpInOutCondition (&strQuery._strCompiled.aJumpOutValues[iIndex].strRightValue) (&bIncrement) (&bCarry)
Loop
End
Move (not(bCarry) and not(bIncrement)) to bSuccess
End
Else Begin
Move True to bSuccess
Move True to bReturnFalse
End
// Reset the or-lists to the lessor significant side of iJumpOutTriggerIndex
If (bSuccess) Begin
For iItem from (iJumpOutTriggerIndex+1) to iMax
Send _ResetOrListPointer (&strQuery._strCompiled.aJumpOutValues[iItem].strRightValue)
Loop
End
If (bReturnFalse) Begin
// The point is that no-way will we return true if nothing was actually incremented
Function_Return False
End
Function_Return bSuccess
End_Function
Procedure _SortVariantArray String[] ByRef aValues Integer iType Boolean bReverseArray
Integer iMax iItem
String[] aStringValues
Number[] aNumberValues
Date[] aDateValues
DateTime[] aDateTimeValues
Move (SizeOfArray(aValues)-1) to iMax
If (iType=tqSTRING or iType=tqTEXT) Begin
Move (SortArray(aValues)) to aValues
End
Else If (iType=tqNUMBER) Begin
For iItem from 0 to iMax
Move aValues[iItem] to aNumberValues[iItem]
Loop
Move (SortArray(aNumberValues)) to aNumberValues
For iItem from 0 to iMax
Move aNumberValues[iItem] to aValues[iItem]
Loop
End
Else If (iType=tqDATE) Begin
For iItem from 0 to iMax
Move aValues[iItem] to aDateValues[iItem]
Loop
Move (SortArray(aDateValues)) to aDateValues
For iItem from 0 to iMax
Move aDateValues[iItem] to aValues[iItem]
Loop
End
Else If (iType=tqDATETIME) Begin
For iItem from 0 to iMax
Move aValues[iItem] to aDateTimeValues[iItem]
Loop
Move (SortArray(aDateTimeValues)) to aDateTimeValues
For iItem from 0 to iMax
Move aDateTimeValues[iItem] to aValues[iItem]
Loop
End
If (bReverseArray) Begin
Move (ReverseArray(aValues)) to aValues
End
End_Procedure
Function _SortSegmentReversed tTableQuery strQ _tTQValueSource strLeftValue Returns Boolean
Integer iItem iMax
Move (SizeOfArray(strQ.aOrdering)-1) to iMax
For iItem from 0 to iMax
If (strQ.aOrdering[iItem].strValueSource.iTable=strQ.iTable and ;
strQ.iTable=strLeftValue.iTable and ;
strQ.aOrdering[iItem].strValueSource.iColumn=strLeftValue.iColumn) Begin
Function_Return strQ.aOrdering[iItem].bDescending
End
Loop
End_Function
Procedure _SortOrListValues tTableQuery ByRef strQ
// Sorting the OrList values serves two purposes:
// 1: The rows will be found in the order specified by the scan index
// 2: The mechanism that determines which OrList to "increment" will be confused
// if the OrList values do not appear in sequence (it's the break level
// computation that will go wrong)
Boolean bReverseArray
Integer iItem iMax
Move (SizeOfArray(strQ._strCompiled.aJumpInValues)-1) to iMax
For iItem from 0 to iMax
// Should we sort backwards?
Get _SortSegmentReversed strQ strQ._strCompiled.aJumpInValues[iItem].strLeftValue to bReverseArray
Send _SortVariantArray (&strQ._strCompiled.aJumpInValues[iItem].strRightValue.aOrList) strQ._strCompiled.aJumpInValues[iItem].strLeftValue.iType bReverseArray //(Integer(bReverseArray)+Integer(strQ._strCompiled.bBackwards)=1)
Loop
Move (SizeOfArray(strQ._strCompiled.aJumpOutValues)-1) to iMax
For iItem from 0 to iMax
// Should we sort backwards?
Get _SortSegmentReversed strQ strQ._strCompiled.aJumpOutValues[iItem].strLeftValue to bReverseArray
Send _SortVariantArray (&strQ._strCompiled.aJumpOutValues[iItem].strRightValue.aOrList) strQ._strCompiled.aJumpOutValues[iItem].strLeftValue.iType bReverseArray //(Integer(bReverseArray)+Integer(strQ._strCompiled.bBackwards)=1)
Loop
End_Procedure
Function _CanFindIndexInRatings _tTQIndexRating[] aIndexRatings Integer iIndex Boolean ByRef bBackwards Number ByRef nENR Returns Boolean
Integer iItem iMax
Move (SizeOfArray(aIndexRatings)-1) to iMax
For iItem from 0 to iMax
If (iIndex=aIndexRatings[iItem].iIndex or (iIndex+1000)=aIndexRatings[iItem].iIndex) Begin
Move (aIndexRatings[iItem].iIndex>1000) to bBackwards
Move aIndexRatings[iItem].nExpectedNumberRows to nENR
Function_Return True
End
Loop
Function_Return False
End_Function
Function SQLSelectStatement tTableQuery strQuery Returns String
Handle hoSQLGenerator
String sStatement
Send _TableRelateStatesReset (&strQuery)
If (strQuery.sForceSQLStatement<>"") Begin
Function_Return strQuery.sForceSQLStatement
End
Get phoSQLGeneratorMSSQLDRC to hoSQLGenerator
Get _SQLSelectStatement of hoSQLGenerator strQuery Self to sStatement
Function_Return sStatement
End_Function
Function SQLDeleteStatement tTableQuery strQuery Returns String
Handle hoSQLGenerator
String sStatement
Send _TableRelateStatesReset (&strQuery)
Get phoSQLGeneratorMSSQLDRC to hoSQLGenerator
Get _SQLDeleteStatement of hoSQLGenerator strQuery Self to sStatement
Function_Return sStatement
End_Function
// Used by TableQueryStructureFunctions.pkg
Procedure _ReadParentSortValues tTableQuery ByRef strParentQuery tTableQuery ByRef strChildQuery
Integer iItem iItemMax
String sValue
String[] aValues
Move (SizeOfArray(strParentQuery.aOrdering)-1) to iItemMax
For iItem from 0 to iItemMax
Get ResultColumnValue (&strParentQuery) strParentQuery.aOrdering[iItem].strValueSource.iTable strParentQuery.aOrdering[iItem].strValueSource.iColumn to sValue
If (strParentQuery.aOrdering[iItem].bUppercase) Begin
Move (Uppercase(sValue)) to sValue
End
Move sValue to aValues[iItem]
Loop
Move aValues to strChildQuery._strControlBlock.strInnerJoinCB.aCurrentParentSortValues
End_Procedure
// Global_Variable Integer _giSQLHandleCheckIndent
// Move 0 to _giSQLHandleCheckIndent
// Procedure ShowInit tSQLStatementHandle strStatement Integer iTable
// Showln (Repeat(" ",_giSQLHandleCheckIndent)) "Initialize using connection " (String(strStatement.strConnectionHandle.hHandle)) ". Statement handle is: " (String(strStatement.hHandle)) " (Table " (String(iTable)) ")"
// Increment _giSQLHandleCheckIndent
// End_Procedure
// Procedure ShowDeInit tSQLStatementHandle strStatement Integer iTable
// Decrement _giSQLHandleCheckIndent
// Showln (Repeat(" ",_giSQLHandleCheckIndent)) "Deinitialize using connection " (String(strStatement.strConnectionHandle.hHandle)) ". Statement handle is: " (String(strStatement.hHandle)) " (Table " (String(iTable)) ")"
// End_Procedure
Function _InitializeQuery tTableQuery ByRef strQuery Returns Boolean
Integer iTable iPrefetchCount iPrefetchTimeout
Integer iDecimalSeparator iDriverIndex
String sDriver sStatement
tSQLStatementHandle strStatement
If (not(strQuery._strControlBlock.bInitialized)) Begin
Move True to strQuery._strControlBlock.bInitialized
If (strQuery.bRestoreRecordBuffersOnQueryCompletion) Begin
Send _PushNoneFixedBuffers strQuery
End
Move strQuery.iTable to iTable
Get_Attribute DF_FILE_DRIVER of iTable to sDriver
If (strQuery._strControlBlock.iQueryMethod=tqSQLPKG) Begin
If (not(strQuery._strControlBlock.strInnerJoinCB.bEnabled) or not(strQuery._strControlBlock.strInnerJoinCB.bInitialized)) Begin
If (OpenStatementOnTable(oSQLStatementHandles,strQuery.iTable,&strStatement)) Begin
Move strStatement to strQuery._strControlBlock.strSQLStatementHandle
Send _TableRelateStatesReset (&strQuery)
Get SQLSelectStatement strQuery Self to sStatement
Move (ToANSI(sStatement)) to sStatement
Send SQLExecDirect of strStatement.hHandle sStatement
Send SQLFetchActivatesBuffer of strStatement.hHandle strQuery.iTable True // True: DF_FILE_ACTIVATE will be true
If (strQuery._strControlBlock.strInnerJoinCB.bEnabled) Begin
Move True to strQuery._strControlBlock.strInnerJoinCB.bInitialized
Move False to strQuery._strControlBlock.strInnerJoinCB.bSkipNextFetch
Move False to strQuery._strControlBlock.strInnerJoinCB.bEndOfResultSet
End
// Send ShowInit strStatement strQuery.iTable
End
End
End
Else Begin
If (sDriver<>"DATAFLEX") Begin // We're on an SQL backend
// This means that we have been 'forced' to use the record oriented
// interface but we are in fact an SQL table and therefore we might
// might want to tamper with the prefetch cache settings:
If (strQuery._strControlBlock.strSQLCacheControl.bUseSettings) Begin
Move strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordCount to iPrefetchCount
Move strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordTimeout to iPrefetchTimeout
If (iPrefetchCount<>0) Begin
Get_Attribute DF_FILE_BLOCK_SIZE of iTable to strQuery._strControlBlock._strPreviousSQLCacheControl.iPrefetchRecordCount
Set_Attribute DF_FILE_BLOCK_SIZE of iTable to iPrefetchCount
End
If (iPrefetchTimeout<>0) Begin
Get TableCacheTimeout of oTableDriverFunctions iTable to strQuery._strControlBlock._strPreviousSQLCacheControl.iPrefetchRecordTimeout
Set TableCacheTimeout of oTableDriverFunctions iTable to iPrefetchTimeout
End
End
End
End
End
Function_Return (strQuery._strControlBlock.bInitialized)
End_Function
Procedure _DeinitializeQuery tTableQuery ByRef strQuery
Integer iTable iPrefetchCount iPrefetchTimeout
String sDriver
If (strQuery._strControlBlock.iQueryMethod=tqSQLPKG) Begin
If (not(strQuery._strControlBlock.strInnerJoinCB.bInitialized)) Begin // inner join => don't close the statement
// Send ShowDeInit strQuery._strControlBlock.strSQLStatementHandle strQuery.iTable
Send CloseStatement of oSQLStatementHandles strQuery._strControlBlock.strSQLStatementHandle
End
End
Else Begin
Move strQuery.iTable to iTable
Get_Attribute DF_FILE_DRIVER of iTable to sDriver
If (sDriver<>"DATAFLEX") Begin // We're on an SQL backend
// This means that we have been 'forced' to use the record oriented
// interface but we are in fact an SQL table and therefore we want
// to restore the prefetch cache settings (if they were originally set):
If (strQuery._strControlBlock.strSQLCacheControl.bUseSettings) Begin
Move strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordCount to iPrefetchCount
Move strQuery._strControlBlock.strSQLCacheControl.iPrefetchRecordTimeout to iPrefetchTimeout
If (iPrefetchCount<>0) Begin // Only then did we change it in the first place
// Reset prefetch setting
Set_Attribute DF_FILE_BLOCK_SIZE of iTable to strQuery._strControlBlock._strPreviousSQLCacheControl.iPrefetchRecordCount
End
If (iPrefetchTimeout<>0) Begin // Only then did we change it in the first place
// Restore cache time out setting
Set TableCacheTimeout of oTableDriverFunctions iTable to strQuery._strControlBlock._strPreviousSQLCacheControl.iPrefetchRecordTimeout
End
End
End
End
End_Procedure
Function _QueryMethodSQL tTableQuery strQuery Returns Boolean
String sDriver
Integer iQueryMethod
Move tqDATAFLEX to iQueryMethod
If (not(strQuery.bNoESQL)) Begin
Get_Attribute DF_FILE_DRIVER of strQuery.iTable to sDriver
If (sDriver="MSSQLDRV") Begin
Move tqSQLPKG to iQueryMethod
End
End
Function_Return (iQueryMethod<>tqDATAFLEX)
End_Function
Function _CompileQuery tTableQuery ByRef strQuery Returns Boolean
Boolean bBackwards
Boolean[] aSortDescending
Number nENR
Number[] aColumnRatings
String sDriver sFormat
_tTQIndexRating strRating
_tTQIndexRating[] aIndexRatings
tTQFilterSegment[] aTemp
If (not(strQuery._strControlBlock.bCompiled)) Begin
If (_ValidateQuery(Self,strQuery)) Begin
// Determine query method:
Move tqDATAFLEX to strQuery._strControlBlock.iQueryMethod
If (not(strQuery.bNoESQL)) Begin
Get_Attribute DF_FILE_DRIVER of strQuery.iTable to sDriver
If (sDriver="MSSQLDRV") Begin
Move tqSQLPKG to strQuery._strControlBlock.iQueryMethod
Get_Attribute DF_FILE_TABLE_CHARACTER_FORMAT of strQuery.iTable to sFormat
Move (sFormat<>"OEM") to strQuery._strControlBlock.bSQLTableIsAnsi
End
End
If (strQuery._strControlBlock.iQueryMethod=tqDATAFLEX) Begin
Move False to strQuery._strCompiled.bBackwards
Move strQuery.bForcePrefetch to strQuery._strCompiled.bPrefetch
Get _CalculateIndex (&strQuery) to aIndexRatings
If (strQuery.iForceIndex<>-1) Begin
If (_CanFindIndexInRatings(Self,aIndexRatings,strQuery.iForceIndex,&bBackwards,&nENR)) Begin
Move strQuery.iForceIndex to strQuery._strCompiled.iIndex
Move bBackwards to strQuery._strCompiled.bBackwards
Move nENR to strQuery._strCompiled.nENR
End
Else Begin
Send OnError 721 "Illegal index forced"
End
End
If (strQuery.iLimit>=0) Begin
Move strQuery.iLimit to strQuery._strCompiled._iLimit
End
Else Begin
// If limit is -3 for example, we only want the 3 last rows of the
// set. In this case we instruct TableQuery to reverse the ordering
// and return the first three. Hokus pokus. (and then of course they
// will be occurring in the wrong order). ((deal with that later))
Move (-strQuery.iLimit) to strQuery._strCompiled._iLimit
Move (not(strQuery._strCompiled.bBackwards)) to strQuery._strCompiled.bBackwards // reverse index search
End
Send OnIndexCalculated strQuery aIndexRatings
Send _CalculateJumpInOutConditions (&strQuery)
Send _SortOrListValues (&strQuery) // Make sure that values occur in the sequence they would be if occurring in an index
If (strQuery._strCompiled.bBackwards) Begin // If backwards, we swap jump-in and jump-out conditions
Move strQuery._strCompiled.aJumpInValues to aTemp
Move strQuery._strCompiled.aJumpOutValues to strQuery._strCompiled.aJumpInValues
Move aTemp to strQuery._strCompiled.aJumpOutValues
End
End
Move True to strQuery._strControlBlock.bCompiled
End
Move False to strQuery._strControlBlock.bInitialized
End
Function_Return (strQuery._strControlBlock.bCompiled)
End_Function
//> This will analyse the query and calculate a query strategy. The strategy may be
//> inspected by inspecting the values of strQuery members
Function CompileQuery tTableQuery ByRef strQuery Returns Boolean
Move False to strQuery._strControlBlock.bCompiled
Function_Return (_CompileQuery(Self,&strQuery))
End_Function
Function _ValueSourceValue tTableQuery ByRef strQuery _tTQValueSource strValue Returns String
Integer iColumn
String sValue
If (strValue.iTable<>0) Begin
If (strValue.iTable<>strQuery.iTable) Begin // Only called when dataflex handling
Send _RelateToTable (&strQuery) strValue.iTable
End
Move strValue.iColumn to iColumn
If (iColumn=0) Begin
Move (SerializeRowID(GetRowID(strValue.iTable))) to sValue
End
Else Begin
Get_Field_Value strValue.iTable iColumn to sValue
Move (Rtrim(sValue)) to sValue
End
End
Else If (strValue.hFunction<>0) Begin
Get strValue.hFunction of strValue.hObject strValue.iColumn to sValue
End
Else If (SizeOfArray(strValue.aOrList)>0) Begin
Move strValue.aOrList[strValue._iOrListPointer] to sValue
End
Else Begin
Move strValue.sConstant to sValue
End
If (strValue.iType=tqNUMBER and sValue="") Begin
Move "0" to sValue
End
Function_Return sValue
End_Function
Function _ValueSourceScriptValueOrListFormat String[] aOrList Integer iType Returns String
Integer iItem iMax
Boolean bOk
String sValue
If (iType=tqSTRING or iType=tqTEXT) Begin
Move (SizeOfArray(aOrList)-1) to iMax
Move True to bOk
For iItem from 0 to iMax
If (bOk) Begin
Get AddQuotes of oStringFunctions (&aOrList[iItem]) "'" to bOk
End
Loop
If (bOk) Begin
Get JoinString aOrList "," 0 0 to sValue
Move ("("+sValue+")") to sValue
End
Else Begin
Move "" to sValue // Signals an error
End
End
Else Begin
Get JoinString aOrList "," 0 0 to sValue
Move ("("+sValue+")") to sValue
End
Function_Return sValue
End_Function
Function _ValueSourceDisplayValue tTableQuery ByRef strQ _tTQValueSource strValue Returns String // Called by TQ test facility in VDFxray
Integer iMax iItem
String sValue
Move (SizeOfArray(strValue.aOrList)-1) to iMax
If (iMax>=0) Begin
For iItem from 0 to iMax
Move (sValue+strValue.aOrList[iItem]) to sValue
If (iItem<>iMax) Begin
Move (sValue+" ; ") to sValue
End
Loop
End
Else Begin
Get _ValueSourceValue (&strQ) strValue to sValue
End
Function_Return sValue
End_Function
Procedure _AssignConstraintValues tTableQuery ByRef strQuery tTQFilterSegment[] ByRef aFilters
Integer iMax iIndex
Move (SizeOfArray(aFilters)-1) to iMax
For iIndex from 0 to iMax
// If it's a contraint by a table column value and if the table is not fixed we do not bother to assign
// initial values. Instead we "calculate" them on each record.
If (aFilters[iIndex].strRightValue.iTable=0 or _IsTableFixed(Self,strQuery,aFilters[iIndex].strRightValue.iTable)) Begin
Get _ValueSourceValue (&strQuery) aFilters[iIndex].strRightValue to aFilters[iIndex].strRightValue._sValue
If (aFilters[iIndex].iComp=tqMATCH) Begin
Get WildCardEvalSequence of oStringFunctions aFilters[iIndex].strRightValue._sValue to aFilters[iIndex].strMatchEvalSequence
End
If (aFilters[iIndex].iComp=tqUCMATCH) Begin
Get WildCardEvalSequence of oStringFunctions (Uppercase(aFilters[iIndex].strRightValue._sValue)) to aFilters[iIndex].strMatchEvalSequence
End
End
Loop
End_Procedure
Procedure _AssignFilterExpressionValue tTableQuery ByRef strQuery tTQFilterExpression ByRef strFilterExpression
Integer iItem iItemMax
Get _ValueSourceValue (&strQuery) strFilterExpression.strOperand.strRightValue to strFilterExpression.strOperand.strRightValue._sValue
If (strFilterExpression.strOperand.iComp=tqMATCH) Begin
Get WildCardEvalSequence of oStringFunctions strFilterExpression.strOperand.strRightValue._sValue to strFilterExpression.strOperand.strMatchEvalSequence
End
If (strFilterExpression.strOperand.iComp=tqUCMATCH) Begin
Get WildCardEvalSequence of oStringFunctions (Uppercase(strFilterExpression.strOperand.strRightValue._sValue)) to strFilterExpression.strOperand.strMatchEvalSequence
End
Move (SizeOfArray(strFilterExpression.aSubExpressions)-1) to iItemMax
For iItem from 0 to iItemMax
Send _AssignFilterExpressionValue (&strQuery) (&strFilterExpression.aSubExpressions[iItem])
Loop
End_Procedure
Procedure _AssignFilterExpressionValues tTableQuery ByRef strQuery
Integer iItem iItemMax
tTQFilterExpression strFilterExpression
Move (SizeOfArray(strQuery.aFilterExpressions)-1) to iItemMax
For iItem from 0 to iItemMax
Send _AssignFilterExpressionValue (&strQuery) (&strQuery.aFilterExpressions[iItem])
Loop
End_Procedure
Procedure _ReassignJumpInOutConstraintValues tTableQuery ByRef strQuery tTQFilterSegment[] ByRef aJumpInConstraints tTQFilterSegment[] ByRef aJumpOutConstraints
Integer iTable iColumn iJumpOutItem
_tTQValueSource stSource
String sValue
Integer iItem iMax
Move (SizeOfArray(aJumpOutConstraints)-1) to iMax
For iItem from 0 to iMax
If (SizeOfArray(aJumpOutConstraints[iItem].strRightValue.aOrList)>0) Begin
Move aJumpOutConstraints[iItem].strLeftValue.iTable to iTable
Move aJumpOutConstraints[iItem].strLeftValue.iColumn to iColumn
Move aJumpOutConstraints[iItem].strRightValue to stSource
Get _ValueSourceValue (&strQuery) stSource to sValue
Move sValue to aJumpOutConstraints[iItem].strRightValue._sValue
Get _FindConstraintEQ aJumpInConstraints iTable iColumn True to iJumpOutItem
If (iJumpOutItem>-1) Begin
Move sValue to aJumpInConstraints[iJumpOutItem].strRightValue._sValue
End
Else Begin
Send OnError 722 "Unmatched jumpin or-list (should have been matched in jump-out constraints)"
End
End
Loop
End_Procedure
Function _SharpenJumpInValue String sValue Integer iTable Integer iColumn Boolean bDescending Returns String
// NOTE: If the function does not succeed in sharpening the value, no harm
// is done (other than some potentially unnescessary finds).
Integer iType iLen iDecs
Number nValue
Date dValue
DateTime dtValue
Get_Attribute DF_FIELD_TYPE of iTable iColumn to iType
Get_Attribute DF_FIELD_LENGTH of iTable iColumn to iLen
Get_Attribute DF_FIELD_PRECISION of iTable iColumn to iDecs
If (iType=DF_BCD) Begin
Move sValue to nValue
// OBS! Here we need a check that we do not in- or decrement the value out of range
If (bDescending) Begin
If (iDecs=0) Move (nValue-1) to nValue
Else If (iDecs=2) Move (nValue-0.01) to nValue
Else If (iDecs=4) Move (nValue-0.0001) to nValue
Else If (iDecs=6) Move (nValue-0.000001) to nValue
Else If (iDecs=8) Move (nValue-0.00000001) to nValue
End
Else Begin
If (iDecs=0) Move (nValue+1) to nValue
Else If (iDecs=2) Move (nValue+0.01) to nValue
Else If (iDecs=4) Move (nValue+0.0001) to nValue
Else If (iDecs=6) Move (nValue+0.000001) to nValue
Else If (iDecs=8) Move (nValue+0.00000001) to nValue
End
Move nValue to sValue
End
Else If (iType=DF_DATE) Begin
Move sValue to dValue
If (bDescending) Begin
If (Integer(dValue>0)) Begin
Get DateIncrement of oDateFunctions dValue DS_DAY -1 to dValue
End
End
Else Begin
If (dValue0 or bBackwards) Begin // Don't seed a negative recnum !!!!
Send SeedMinValue of oIndexFunctions strQ.iTable strIndex.aSegments[iIndex].iColumn (bBackwards)
End
Loop
End_Procedure
Function _TestNumber Number nValueLeft Integer iComp Number nValueRight Returns Boolean
If (iComp=tqEQ) Function_Return (nValueLeft = nValueRight)
If (iComp=tqLT) Function_Return (nValueLeft < nValueRight)
If (iComp=tqLE) Function_Return (nValueLeft <= nValueRight)
If (iComp=tqGE) Function_Return (nValueLeft >= nValueRight)
If (iComp=tqGT) Function_Return (nValueLeft > nValueRight)
If (iComp=tqNE) Function_Return (nValueLeft <> nValueRight)
Function_Return False
End_Function
Function _TestString String sValueLeft Integer iComp tWildCardEvalSequence strMatchSequence String sValueRight Returns Boolean
If (iComp=tqEQ) Function_Return (sValueLeft = sValueRight)
If (iComp=tqLT) Function_Return (sValueLeft < sValueRight)
If (iComp=tqLE) Function_Return (sValueLeft <= sValueRight)
If (iComp=tqGE) Function_Return (sValueLeft >= sValueRight)
If (iComp=tqGT) Function_Return (sValueLeft > sValueRight)
If (iComp=tqNE) Function_Return (sValueLeft <> sValueRight)
// If (iComp=tqCONTAINS) Function_Return (sValueLeft contains sValueRight)
// If (iComp=tqIN) Begin
// If sValueLeft in sValueRight Begin
// Function_Return True
// End
// End
If (iComp=tqMATCH) Begin
Function_Return (WildCardMatch(oStringFunctions,sValueLeft,strMatchSequence))
End
If (iComp=tqUCMATCH) Begin
Function_Return (WildCardMatch(oStringFunctions,Uppercase(sValueLeft),strMatchSequence))
End
Function_Return False
End_Function
Function _TestText String sValueLeft Integer iComp tWildCardEvalSequence stMatchSequence String sValueRight Returns Boolean
Function_Return (_TestString(Self,sValueLeft,iComp,stMatchSequence,sValueRight))
End_Function
Function _TestDate Date dValueLeft Integer iComp Date dValueRight Returns Boolean
If (iComp=tqEQ) Function_Return (dValueLeft = dValueRight)
If (iComp=tqLT) Function_Return (dValueLeft < dValueRight)
If (iComp=tqLE) Function_Return (dValueLeft <= dValueRight)
If (iComp=tqGE) Function_Return (dValueLeft >= dValueRight)
If (iComp=tqGT) Function_Return (dValueLeft > dValueRight)
If (iComp=tqNE) Function_Return (dValueLeft <> dValueRight)
Function_Return False
End_Function
Function _TestDateTime DateTime dtValueLeft Integer iComp DateTime dtValueRight Returns Boolean
If (iComp=tqEQ) Function_Return (dtValueLeft = dtValueRight)
If (iComp=tqLT) Function_Return (dtValueLeft < dtValueRight)
If (iComp=tqLE) Function_Return (dtValueLeft <= dtValueRight)
If (iComp=tqGE) Function_Return (dtValueLeft >= dtValueRight)
If (iComp=tqGT) Function_Return (dtValueLeft > dtValueRight)
If (iComp=tqNE) Function_Return (dtValueLeft <> dtValueRight)
Function_Return False
End_Function
Function _EvaluateFilter tTableQuery ByRef strQuery tTQFilterSegment strFilter Boolean bOrlistAllItems Returns Boolean
Integer iType iOrListMax iOrListIndex
Boolean bEval bFoundInOrList
String sLeftValue sRightValue
Get _ValueSourceValue (&strQuery) strFilter.strLeftValue to sLeftValue
Move strFilter.strLeftValue.iType to iType
Move (SizeOfArray(strFilter.strRightValue.aOrList)-1) to iOrListMax
If (bOrlistAllItems and iOrListMax>=0) Begin
Move False to bFoundInOrList
For iOrListIndex from 0 to iOrListMax
If (not(bFoundInOrList)) Begin
If (iType=tqSTRING) Get _TestString sLeftValue strFilter.iComp strFilter.strMatchEvalSequence strFilter.strRightValue.aOrList[iOrListIndex] to bFoundInOrList
Else If (iType=tqNUMBER) Get _TestNumber sLeftValue strFilter.iComp strFilter.strRightValue.aOrList[iOrListIndex] to bFoundInOrList
Else If (iType=tqTEXT) Get _TestText sLeftValue strFilter.iComp strFilter.strMatchEvalSequence strFilter.strRightValue.aOrList[iOrListIndex] to bFoundInOrList
Else If (iType=tqDATE) Get _TestDate sLeftValue strFilter.iComp strFilter.strRightValue.aOrList[iOrListIndex] to bFoundInOrList
Else If (iType=tqDATETIME) Get _TestDateTime sLeftValue strFilter.iComp strFilter.strRightValue.aOrList[iOrListIndex] to bFoundInOrList
End
Loop
Move bFoundInOrList to bEval
End
Else Begin
If (strFilter.strRightValue.iTable<>0 and not(_IsTableFixed(Self,strQuery,strFilter.strRightValue.iTable))) Begin
Get _ValueSourceValue (&strQuery) strFilter.strRightValue to sRightValue
If (strFilter.iComp=tqMATCH or strFilter.iComp=tqUCMATCH) Begin
Get WildCardEvalSequence of oStringFunctions sRightValue to strFilter.strMatchEvalSequence
End
end
Else Begin
Move strFilter.strRightValue._sValue to sRightValue
End
If (iType=tqSTRING) Get _TestString sLeftValue strFilter.iComp strFilter.strMatchEvalSequence sRightValue to bEval
Else If (iType=tqNUMBER) Get _TestNumber sLeftValue strFilter.iComp sRightValue to bEval
Else If (iType=tqTEXT) Get _TestText sLeftValue strFilter.iComp strFilter.strMatchEvalSequence sRightValue to bEval
Else If (iType=tqDATE) Get _TestDate sLeftValue strFilter.iComp sRightValue to bEval
Else If (iType=tqDATETIME) Get _TestDateTime sLeftValue strFilter.iComp sRightValue to bEval
End
Function_Return bEval
End_Function
Function _EvaluateConstraints tTableQuery ByRef strQuery tTQFilterSegment[] aFilters Boolean bOrlistAllItems Integer ByRef iFailedConstrainIndex Returns Boolean
Integer iMax iIndex
Boolean bEval
Move (SizeOfArray(aFilters)-1) to iMax
For iIndex from 0 to iMax
Get _EvaluateFilter (&strQuery) aFilters[iIndex] bOrlistAllItems to bEval
If (not(bEval)) Begin
Move iIndex to iFailedConstrainIndex
Function_Return False
End
Loop
Move -1 to iFailedConstrainIndex // Nothing failed
Function_Return True
End_Function
Function _EvaluateFilterExpression tTableQuery ByRef strQuery tTQFilterExpression[] aExpressions Returns Boolean
Integer iItem iItemMax
Boolean bRvalDetermined bEvalResult bAtomExpression
Move False to bRvalDetermined
Move (SizeOfArray(aExpressions)-1) to iItemMax
Move 0 to iItem
While (iItem<=iItemMax)
If (iItem>0 and ((bEvalResult and aExpressions[iItem-1].iAndOr=tqKeyOR) or ;
(not(bEvalResult) and aExpressions[iItem-1].iAndOr=tqKeyAND))) Begin
// Do nothing! Evaluating the current item will not change the overall value
End
Else Begin
If (SizeOfArray(aExpressions[iItem].aSubExpressions)>0) Begin
Get _EvaluateFilterExpression (&strQuery) aExpressions[iItem].aSubExpressions to bAtomExpression
End
Else Begin
Get _EvaluateFilter (&strQuery) aExpressions[iItem].strOperand True to bAtomExpression
End
If (aExpressions[iItem].bNot) Begin
Move (not(bAtomExpression)) to bAtomExpression
End
If (iItem=0) Begin
Move bAtomExpression to bEvalResult
End
Else Begin
If (aExpressions[iitem-1].iAndOr=tqKeyAND) Begin
Move (bEvalResult and bAtomExpression) to bEvalResult
End
Else If (aExpressions[iitem-1].iAndOr=tqKeyOR) Begin
Move (bEvalResult or bAtomExpression) to bEvalResult
End
Else Begin
Send OnError 723 "Unknown operator (should be AND or OR)"
End
End
End
Increment iItem
Loop
// If (not(bRvalDetermined)) Begin
// Error 724 "Expression could not evaluate"
// End
Function_Return bEvalResult
End_Function
Function _EvaluateFilterExpressions tTableQuery ByRef strQuery Returns Boolean
Boolean bEvalResult
Integer iItem iItemMax
Move True to bEvalResult
Move (SizeOfArray(strQuery.aFilterExpressions)-1) to iItemMax
Move 0 to iItem
While (bEvalResult and iItem<=iItemMax)
Get _EvaluateFilterExpression (&strQuery) strQuery.aFilterExpressions[iItem].aSubExpressions to bEvalResult
Increment iItem
Loop
Function_Return bEvalResult
End_Function
//> The function returns true if the record currently in
//> the buffer of the query main table evaluates true
//> against the filters of strQuery.
Function Belongs tTableQuery strQuery Returns Boolean
Boolean bBelongs
Integer iGrb
// New record! Indicate that related buffers have to be reconsidered
// and found if needed:
Send _TableRelateStatesReset (&strQuery)
// Evaluate against all filters added to the query:
Get _EvaluateConstraints (&strQuery) strQuery.aFilters True (&iGrb) to bBelongs
Function_Return bBelongs
End_Function
// Procedure ExecuteQuery tTableQuery ByRef strQuery
// Boolean bFound
// Move True to strQuery.bForcePrefetch
// If (_CompileQuery(Self,&strQuery)) Begin
// If (_InitializeQuery(Self,&strQuery)) Begin
// // When bForcePrefetch is true finding the record will populate the
// // result array inside strQuery:
// Get FindRecord (&strQuery) to bFound // and that's all we need
// Get SystemTimeMilliSeconds of oDateFunctions to strQuery._strControlBlock.strStopTime
// End
// End
// End_Procedure
Procedure PurgeResultSet tTableQuery ByRef strQuery
Move strQuery.iTable to strQuery.strResultSet.iTable
Move (ResizeArray(strQuery.strResultSet.aRecords,0)) to strQuery.strResultSet.aRecords
Move -1 to strQuery.strResultSet._iCurrentRowPointer
End_Procedure
Procedure _ResultSetAddCurrentRecord tTableQuery ByRef strQuery
Integer iRow iSegment iMax iColumn
Integer iTable
String sValue sSortValue
tocIndexSegment stSegment
// Row ID
Move (SizeOfArray(strQuery.strResultSet.aRecords)) to iRow
Move (GetRowID(strQuery.iTable)) to strQuery.strResultSet.aRecords[iRow].riRowId
// Calculate sort value
Move "" to sSortValue
Move (SizeOfArray(strQuery.aOrdering)-1) to iMax
For iSegment from 0 to iMax
Move strQuery.aOrdering[iSegment].strValueSource.iTable to iTable
Move strQuery.aOrdering[iSegment].strValueSource.iColumn to stSegment.iColumn
Move strQuery.aOrdering[iSegment].bDescending to stSegment.bDescending
Move strQuery.aOrdering[iSegment].bUppercase to stSegment.bUppercase
If (iTable<>strQuery.iTable) Begin
Send _RelateToTable (&strQuery) iTable
End
Get IndexSegmentSortValue of oIndexFunctions iTable stSegment to sValue
Move (sSortValue+sValue) to sSortValue
Loop
Move sSortValue to strQuery.strResultSet.aRecords[iRow].sSortValue
// Read selected column values
Move (SizeOfArray(strQuery.aColumnSources)-1) to iMax
For iColumn from 0 to iMax
Get _ValueSourceValue (&strQuery) strQuery.aColumnSources[iColumn] to strQuery.strResultSet.aRecords[iRow].aColumnValues[iColumn]
Loop
End_Procedure
Function _ResultSetRecordsCompare tTQResultRow stVal1 tTQResultRow stVal2 Returns Integer
If (stVal1.sSortValuestVal2.sSortValue) Function_Return (GT)
Function_Return (EQ)
End_Function
Procedure _ResultSetSort tTableQuery ByRef strQuery
If (SizeOfArray(strQuery.aOrdering)>0) Begin
Move (SortArray(strQuery.strResultSet.aRecords,Self,GET__ResultSetRecordsCompare)) to strQuery.strResultSet.aRecords
End
End_Procedure
Procedure _ResultSetActivateCurrentRecord tTableQuery ByRef strQuery
Boolean bFound
Integer iTable
RowID riRowID
Move strQuery.iTable to iTable
Move strQuery.strResultSet.aRecords[strQuery.strResultSet._iCurrentRowPointer].riRowId to riRowID
Move (FindByRowID(iTable,riRowID)) to bFound
Send _TableRelateStatesReset (&strQuery)
If (bFound) Begin
Send _RelateMainRecord (&strQuery)
End
Else Begin
Send OnError 725 "Result set record not found"
End
End_Procedure
Function _FindFirstRecordAux tTableQuery ByRef strQuery Integer ByRef iFailedConstrainIndex Returns Boolean
Boolean bFound bEval
Integer iTable iIndex iJunk
Move strQuery.iTable to iTable
Move strQuery._strCompiled.iIndex to iIndex
Clear iTable
Send _TableRelateStatesReset (&strQuery) // Reset information about what related records have already been found
Send _SeedRecordBuffer strQuery
If (strQuery._strCompiled.bBackwards) Begin
Vfind iTable iIndex LE
End
Else Begin
Vfind iTable iIndex GE
If (Found) Begin // Problem and fix pointed out by Russell McDougall
// From the on-line help:
// "A Find GE always finds a record unless the table is empty. A find GE after
// the last record in the table will still return the last record. It always sets
// the Predefined Indicators Found to True and FindErr to False). Note that this
// behavior is different than for LE. A Find LE before the first record in the table
// will not return a record, and will set the predefined indicators Found to False
// and FindErr to True."
// This feature of the find and vfind commands forces us to check
// that the record found is not a record that it really shouldn't have found in the
// first place:
Get _EvaluateConstraints (&strQuery) strQuery._strCompiled.aJumpInValues False (&iFailedConstrainIndex) to bEval
Move bEval to Found
End
End
Move (Found) to bFound
Increment strQuery._strControlBlock.iFindCount
If (bFound) Begin
Repeat
// Jump out?
Get _EvaluateConstraints (&strQuery) strQuery._strCompiled.aJumpOutValues False (&iFailedConstrainIndex) to bEval
If (not(bEval)) Begin // If jump-out criteria does not evaluate: jump out
Function_Return False
End
// Evaluate 'other' criteria
Get _EvaluateConstraints (&strQuery) strQuery._strCompiled.aOtherConditions True (&iJunk) to bEval
If (bEval) Begin // Evaluate filter expressions
Get _EvaluateFilterExpressions (&strQuery) to bEval
End
If (not(bEval)) Begin
If (strQuery._strCompiled.bBackwards) Begin
Vfind iTable iIndex LT
End
Else Begin
Vfind iTable iIndex GT
End
Move (Found) to bFound
Increment strQuery._strControlBlock.iFindCount
Send _TableRelateStatesReset (&strQuery)
If (not(bFound)) Begin // end of table
Move (SizeOfArray(strQuery._strCompiled.aJumpOutValues)-1) to iFailedConstrainIndex
Function_Return False
End
End
Until (bEval)
End
// Move (GetRowID(iTable)) to strQuery._strControlBlock.rCurrentRecord
If (bFound) Begin
Increment strQuery._strControlBlock.iSelectCount
End
Function_Return bFound
End_Function // _FindFirstRecordAux
Procedure _SQLBindResultTables tTableQuery ByRef strQuery
Integer iItem iItemMax
Move (SizeOfArray(strQuery.aColumnSources)-1) to iItemMax
If (iItemMax>=0) Begin
For iItem from 0 to iItemMax
If (strQuery.aColumnSources[iItem].iColumn=0) Begin
Send SQLBindFile of strQuery._strControlBlock.strSQLStatementHandle.hHandle strQuery.aColumnSources[iItem].iTable
End
Loop
End
Else Begin
Send SQLBindFile of strQuery._strControlBlock.strSQLStatementHandle.hHandle strQuery.iTable
End
End_Procedure
Function _SQLCheckAgainstParentRecord_CompareSortingSegmentValues String sValue1 String sValue2 Integer iType Returns Integer
Date dValue1 dValue2
DateTime dtValue1 dtValue2
Number nValue1 nValue2
If (iType=tqNUMBER) Begin
Move sValue1 to nValue1
Move sValue2 to nValue2
If (nValue1>nValue2) Function_Return tqGT
If (nValue1dValue2) Function_Return tqGT
If (dValue1dtValue2) Function_Return tqGT
If (dtValue1sValue2) Function_Return tqGT
If (sValue1 child query must catch up
Move True to bCatchUpWithParent
Function_Return False
End
Else If (iCompareResult=tqLT) Begin // Child is greater which means we must fake a end-of-result set
Move False to bCatchUpWithParent
Function_Return False
End
Loop
Move False to bCatchUpWithParent
Function_Return True
End_Function
Function _SQLFindNextRecord tTableQuery ByRef strQuery Returns Boolean
Integer iFetchResult iItem iItemMax
Boolean bFound bSelect bInnerJoin bCatchUpWithParent bBelongsToCurrentParent
Move (SizeOfArray(strQuery._strControlBlock.strInnerJoinCB.aCurrentParentSortValues)-1) to iItemMax
Move (iItemMax>=0) to bInnerJoin // We are an inner join and should be prepared to fake a 'record not found'
If (bInnerJoin) Begin
If (strQuery._strControlBlock.strInnerJoinCB.bEndOfResultSet) Begin
Function_Return False
End
Repeat
If (strQuery._strControlBlock.strInnerJoinCB.bSkipNextFetch) Begin
Move False to strQuery._strControlBlock.strInnerJoinCB.bSkipNextFetch
Move True to bFound
End
Else Begin
Get SQLFetch of strQuery._strControlBlock.strSQLStatementHandle.hHandle to iFetchResult
Move (iFetchResult<>0) to bFound
Increment strQuery._strControlBlock.iFindCount
End
If (bFound) Begin
Send _TableRelateStatesReset (&strQuery)
Send _SQLBindResultTables (&strQuery)
Get _SQLCheckAgainstParentRecord (&strQuery) (&bCatchUpWithParent) to bBelongsToCurrentParent
If (bBelongsToCurrentParent) Begin
Move True to bSelect
End
Else Begin
If (not(bCatchUpWithParent)) Begin
Move True to strQuery._strControlBlock.strInnerJoinCB.bSkipNextFetch
End
End
End
Else Begin
Move True to strQuery._strControlBlock.strInnerJoinCB.bEndOfResultSet
End
Until (not(bFound) or bSelect or not(bCatchUpWithParent))
If (bSelect) Begin
Increment strQuery._strControlBlock.iSelectCount
Function_Return True
End
End
Else Begin
Get SQLFetch of strQuery._strControlBlock.strSQLStatementHandle.hHandle to iFetchResult
Move (iFetchResult<>0) to bFound
If (bFound) Begin
Send _SQLBindResultTables (&strQuery)
Increment strQuery._strControlBlock.iSelectCount
End
Increment strQuery._strControlBlock.iFindCount
Function_Return bFound
End
Function_Return False
End_Function
Register_Function FindRecord tTableQuery ByRef strQuery Returns Boolean
Function _FindFirstRecord tTableQuery ByRef strQuery Returns Boolean
Boolean bFound bIncremented bTmp
Integer iLastIndex iSize iTable
Integer iFailedConstrainIndex
Integer iLogState iFetchResult
Move 0 to strQuery._strControlBlock.iFindCount
Move 0 to strQuery._strControlBlock.iSelectCount
Move False to strQuery._strControlBlock.bBreakScan
Send PurgeResultSet (&strQuery) // Zero the result set
If (strQuery._strControlBlock.iQueryMethod=tqSQLPKG) Begin
Get _SQLFindNextRecord (&strQuery) to bFound
End
Else Begin
// Makes the procedure reset all OrList pointers. Return value not used:
Get _IncrementJumpInOutConditions (&strQuery) -1 to bFound
Move strQuery.iTable to iTable
Clear iTable //
Send _TableRelateStatesReset (&strQuery)
Send _AssignConstraintValues (&strQuery) (&strQuery._strCompiled.aJumpInValues)
Send _AssignConstraintValues (&strQuery) (&strQuery._strCompiled.aJumpOutValues)
Send _AssignConstraintValues (&strQuery) (&strQuery._strCompiled.aOtherConditions)
Send _AssignFilterExpressionValues (&strQuery)
If (strQuery._strCompiled.bPrefetch) Begin
Move False to strQuery._strCompiled.bPrefetch // Temporarily set bPrefetch to false
Send ReUse (&strQuery) // resets strQuery.blabla.bInitialized
Move strQuery.bForcePrefetch to bTmp
// Here comes a dirty trick to avoid FindRecord deleting
// the ResultArray of the strQuery variable on completion. The
// default behavior is to reset the resultset on completion if
// prefetch was not forced. It's dirty because I am fooling
// FindRecord into not re-compiling the report. Here it goes:
Move True to strQuery.bForcePrefetch
Move _giTQLogState to iLogState
Move 0 to _giTQLogState // Do not log the "inner" loop
While (FindRecord(Self,&strQuery))
Send _ResultSetAddCurrentRecord (&strQuery)
Loop
Move bTmp to strQuery.bForcePrefetch
Move iLogState to _giTQLogState // Restore log-state
Send _ResultSetSort (&strQuery)
Move False to strQuery._strControlBlock.bBreakScan // Cancel effect of possible break imposed by limit
Move True to strQuery._strCompiled.bPrefetch // Restore bPrefetch
If (strQuery._strCompiled._iPushLimit<>0) Begin
If (SizeOfArray(strQuery.strResultSet.aRecords)>Abs(strQuery._strCompiled._iPushLimit)) Begin
// If the record set is greater than our limit we'll have to prune it.
If (strQuery.iLimit>0) Begin // We're supposed to return the head
Move (ResizeArray(strQuery.strResultSet.aRecords,strQuery._strCompiled._iPushLimit)) to strQuery.strResultSet.aRecords
End
Else Begin // We're supposed to take the tail
Move (SizeOfArray(strQuery.strResultSet.aRecords)-1) to iLastIndex
Move strQuery._strCompiled._iPushLimit to iSize
Move (CopyArray(strQuery.strResultSet.aRecords,iLastIndex-iSize+1,iLastIndex)) to strQuery.strResultSet.aRecords
End
Move (SizeOfArray(strQuery.strResultSet.aRecords)) to strQuery._strControlBlock.iSelectCount
End
If (SizeOfArray(strQuery.strResultSet.aRecords)>strQuery._strCompiled._iPushLimit) Begin
Move (ResizeArray(strQuery.strResultSet.aRecords,strQuery._strCompiled._iPushLimit)) to strQuery.strResultSet.aRecords
Move (SizeOfArray(strQuery.strResultSet.aRecords)) to strQuery._strControlBlock.iSelectCount
End
Move strQuery._strCompiled._iPushLimit to strQuery._strCompiled._iLimit
Move 0 to strQuery._strCompiled._iPushLimit
End
Move (SizeOfArray(strQuery.strResultSet.aRecords)>0) to bFound
If (bFound) Begin
Move 0 to strQuery.strResultSet._iCurrentRowPointer
Send _ResultSetActivateCurrentRecord (&strQuery)
End
End
Else Begin
Repeat
Get _FindFirstRecordAux (&strQuery) (&iFailedConstrainIndex) to bFound
If (not(bFound)) Begin
Get _IncrementJumpInOutConditions (&strQuery) iFailedConstrainIndex to bIncremented
If (bIncremented) Begin
Send _ReassignJumpInOutConstraintValues (&strQuery) (&strQuery._strCompiled.aJumpInValues) (&strQuery._strCompiled.aJumpOutValues)
End
End
Until (bFound or not(bIncremented))
End
End
Function_Return bFound
End_Function // _FindFirstRecord
Function _FindNextRecordAux tTableQuery ByRef strQuery Integer ByRef iFailedConstrainIndex Returns Boolean
Integer iTable iIndex iJunk
Boolean bFound bEval
Move strQuery.iTable to iTable
Move strQuery._strCompiled.iIndex to iIndex
If (strQuery._strCompiled.bBackwards) Begin
Vfind iTable iIndex LT
End
Else Begin
Vfind iTable iIndex GT
End
Move (Found) to bFound
Increment strQuery._strControlBlock.iFindCount
Send _TableRelateStatesReset (&strQuery)
If (bFound) Begin
Repeat
// Jump out?
Get _EvaluateConstraints (&strQuery) strQuery._strCompiled.aJumpOutValues False (&iFailedConstrainIndex) to bEval
If (not(bEval)) Begin // If jump-out criteria does not evaluate: jump out
Function_Return False
End
// Evaluate 'other' criteria
Get _EvaluateConstraints (&strQuery) strQuery._strCompiled.aOtherConditions True (&iJunk) to bEval
If (bEval) Begin // Evaluate filter expressions
Get _EvaluateFilterExpressions (&strQuery) to bEval
End
If (not(bEval)) Begin
If (strQuery._strCompiled.bBackwards) Begin
Vfind iTable iIndex LT
End
Else Begin
Vfind iTable iIndex GT
End
Increment strQuery._strControlBlock.iFindCount
Move (Found) to bFound
Send _TableRelateStatesReset (&strQuery)
If (not(bFound)) Begin // end of table
Move (SizeOfArray(strQuery._strCompiled.aJumpOutValues)-1) to iFailedConstrainIndex
Function_Return False
End
End
Until (bEval)
End
If (bFound) Begin
Increment strQuery._strControlBlock.iSelectCount
End
Function_Return bFound
End_Function
Function _FindNextRecord tTableQuery ByRef strQuery Returns Boolean
Boolean bFound bIncremented
Integer iFailedConstrainIndex iFetchResult
If (strQuery._strControlBlock.bBreakScan) Begin
Move False to bFound
End
Else Begin
If (strQuery._strControlBlock.iQueryMethod=tqSQLPKG) Begin
Get _SQLFindNextRecord (&strQuery) to bFound
End
Else Begin
If (strQuery._strCompiled.bPrefetch) Begin
Move ((strQuery.strResultSet._iCurrentRowPointer+1) Internal function used to find the index for the relation recip‚ for tabel iTable.
Function _FindTableRelation tTableQuery strQ Integer iTable Returns Integer
Integer iItem iMax
Move (SizeOfArray(strQ.aTableRelations)-1) to iMax
For iItem from 0 to iMax
If (strQ.aTableRelations[iItem].iTargetTable=iTable) Begin
Function_Return iItem
End
Loop
Function_Return -1 // not found
End_Function
// If bFixed is true it means that the parent record is fixed for the duration of the query. In turn, that means
// that the relation mechanism will not find records in that table (iTargetTable).
Procedure _AddTableRelation tTableQuery ByRef strQ Integer iTargetTable Boolean bFixed
Integer iItem
Get _FindTableRelation strQ iTargetTable to iItem
If (iItem=-1) Begin
Move (SizeOfArray(strQ.aTableRelations)) to iItem
Move iTargetTable to strQ.aTableRelations[iItem].iTargetTable
Move -1 to strQ.aTableRelations[iItem]._iEmbeddedIndex
Move bFixed to strQ.aTableRelations[iItem].bFixed
End
Else Begin
If (bFixed) Begin // If it's already there then bFixed=true wins.
Move bFixed to strQ.aTableRelations[iItem].bFixed
End
End
End_Procedure
Function _CompareTableRelationSegments _tTQTableRelationSegment strValue1 _tTQTableRelationSegment strValue2 Returns Integer
Number nValue1 nValue2
Move (strValue1.iInnerJoinComp*10000+strValue1.iSourceColumn*10000+strValue1.iSourceTable*10000+strValue1.iTargetColumn) to nValue1
Move (strValue2.iInnerJoinComp*10000+strValue2.iSourceColumn*10000+strValue2.iSourceTable*10000+strValue2.iTargetColumn) to nValue2
If (nValue1nValue2) Function_Return (GT)
Function_Return (EQ)
End_Function
Function _TableRelationsAreSegmentArraysIdentical _tTQTableRelationSegment[] aSegments1 _tTQTableRelationSegment[] aSegments2 Returns Boolean
Integer iItem iItemMax1 iItemMax2
Move (SizeOfArray(aSegments1)-1) to iItemMax1
Move (SizeOfArray(aSegments2)-1) to iItemMax2
If (iItemMax1<>iItemMax2) Begin
Function_Return False
End
// The arrays are not ordered so to tell if they are identical they need to be sorted first.
Move (SortArray(aSegments1,Self,GET__CompareTableRelationSegments)) to aSegments1
Move (SortArray(aSegments2,Self,GET__CompareTableRelationSegments)) to aSegments2
For iItem from 0 to iItemMax1
If (_CompareTableRelationSegments(Self,aSegments1[iItem],aSegments2[iItem])<>EQ) Begin
Function_Return False
End
Loop
End_Function
Function _TableRelationsAreIdentical tTQTableRelation strRel1 tTQTableRelation strRel2 Returns Boolean
If (strRel1.iTargetTable<>strRel2.iTargetTable or strRel1.bFixed<>strRel2.bFixed) Begin
Function_Return False
End
If (not(_TableRelationsAreSegmentArraysIdentical(Self,strRel1.aSegments,strRel2.aSegments))) Begin
Function_Return False
End
Function_Return True
End_Function
Function _AddTableRelationB2B tTableQuery ByRef strQ tTQTableRelation strRelation Returns Boolean
Integer iItem
Get _FindTableRelation strQ strRelation.iTargetTable to iItem
If (iItem=-1) Begin
Move strRelation to strQ.aTableRelations[SizeOfArray(strQ.aTableRelations)]
End
Else Begin
If (not(_TableRelationsAreIdentical(Self,strRelation,strQ.aTableRelations[iItem]))) Begin
Send OnError 727 "Table takes on more than one role"
Function_Return False
End
End
Function_Return True
End_Function
Procedure AddTableRelation tTableQuery ByRef strQ Integer iTargetTable
Send _AddTableRelation (&strQ) iTargetTable False
End_Procedure
// This is called from the AddFilterRelate procedure.
Procedure AddTableRelationFixedRecord tTableQuery ByRef strQ Integer iTargetTable
Send _AddTableRelation (&strQ) iTargetTable True
End_Procedure
Procedure _AddTableRelationSegment tTableQuery ByRef strQ Integer iSourceTable Integer iSourceColumn Integer iComp Integer iTargetTable Integer iTargetColumn
Integer iItem
tTQTableRelation strRelatation
_tTQTableRelationSegment strSegment
Get _FindTableRelation strQ iTargetTable to iItem
If (iItem>=0) Begin
// Check that iSourceTable is already available in the .aRelations member. If not: error!
If (iSourceTable=strQ.iTable or _FindTableRelation(Self,strQ,iSourceTable)<>-1) Begin
Move strQ.aTableRelations[iItem] to strRelatation
Move iSourceTable to strSegment.iSourceTable
Move iComp to strSegment.iInnerJoinComp
Move iSourceColumn to strSegment.iSourceColumn
Move iTargetColumn to strSegment.iTargetColumn
Move strSegment to strRelatation.aSegments[SizeOfArray(strRelatation.aSegments)]
Move strRelatation to strQ.aTableRelations[iItem]
End
Else Begin
Send OnError 728 ("No relation has been set up for table "+String(iSourceTable))
End
End
Else Begin
Send OnError 729 ("No relation has been set up for table "+String(iTargetTable))
End
End_Procedure
Procedure AddTableRelationSegment tTableQuery ByRef strQ Integer iSourceTable Integer iSourceColumn Integer iTargetTable Integer iTargetColumn
Send _AddTableRelationSegment (&strQ) iSourceTable iSourceColumn tqEQ iTargetTable iTargetColumn
End_Procedure
Procedure _AddTableRelationInnerJoinSegment tTableQuery ByRef strQ Integer iSourceTable Integer iSourceColumn Integer iComp Integer iTargetTable Integer iTargetColumn
Send _AddTableRelationSegment (&strQ) iSourceTable iSourceColumn iComp iTargetTable iTargetColumn
End_Procedure
//> Use this method over the AddTableRelation ditto to register a table relation by its generic relation
Procedure _AddTableRelationAuto tTableQuery ByRef strQ Integer iSourceTable Integer iTargetTable Boolean bFixed
Integer iItem iMax iRelateItem
Integer[] aSourceColumns aTargetColumns
Get _FindTableRelation strQ iTargetTable to iRelateItem
If (iRelateItem=-1) Begin
If (TableColumnsRelatingBetweenTables(oOverlapColumnFunctions,iSourceTable,iTargetTable,&aSourceColumns,&aTargetColumns)) Begin
Send AddTableRelation (&strQ) iTargetTable
Move (SizeOfArray(aSourceColumns)-1) to iMax
For iItem from 0 to iMax
Send AddTableRelationSegment (&strQ) iSourceTable aSourceColumns[iItem] iTargetTable aTargetColumns[iItem]
Loop
End
Else Begin
Send OnError 730 ("Tables do not relate ("+String(iSourceTable)+"->"+String(iTargetTable)+")")
End
End
Else Begin // If a relation is already there:
// ToDo: // Here we need to check if the current segment array is empty.
// If it is, we add the relation segments
// If it's not, we should check that it is currently set
// to the "plain df relation" and give an Error if it's not.
End
End_Procedure
Procedure AddTableRelationAuto tTableQuery ByRef strQ Integer iSourceTable Integer iTargetTable
Send _AddTableRelationAuto (&strQ) iSourceTable iTargetTable False
End_Procedure
Procedure AddTableRelationAutoFixed tTableQuery ByRef strQ Integer iSourceTable Integer iTargetTable
Send _AddTableRelationAuto (&strQ) iSourceTable iTargetTable True
End_Procedure
Function _TableRelationAlreadyOK tTableQuery ByRef strQ tTQTableRelation strRelation Returns Boolean
Integer iSegment iSegmentMax
String sSourceValue sTargetValue
If (not(strRelation.bFixed)) Begin
Move (SizeOfArray(strRelation.aSegments)-1) to iSegmentMax
For iSegment from 0 to iSegmentMax
Get ResultColumnValue (&strQ) strRelation.aSegments[iSegment].iSourceTable strRelation.aSegments[iSegment].iSourceColumn to sSourceValue
Get_Field_Value strRelation.iTargetTable strRelation.aSegments[iSegment].iTargetColumn to sTargetValue
If (sSourceValue<>sTargetValue) Begin
Function_Return (False)
End
Loop
End
Function_Return (True)
End_Function
Function _SQLNumericToDFNumeric Integer iTable String sValue Returns String
Integer iDriverDS iRuntimeDS iDriverIndex
String sDriver
Get_Attribute DF_FILE_DRIVER of iTable to sDriver
Get DriverIndex of oTableDriverFunctions sDriver to iDriverIndex
Get_Attribute DF_DRIVER_DRIVER_DECIMAL_SEPARATOR of iDriverIndex to iDriverDS
Get_Attribute DF_DECIMAL_SEPARATOR to iRuntimeDS
If (iRuntimeDS<>iDriverDS) Begin
Move (Replaces(Character(iDriverDS),sValue,Character(iRuntimeDS))) to sValue
End
If (Left(sValue,1)=Character(iRuntimeDS)) Begin
Move ("0"+sValue) to sValue
End
Function_Return sValue
End_Function
Function ResultColumnValue tTableQuery ByRef strQ Integer iTable Integer iColumn Returns String
Integer iRelateItem iColumnSourceItem iType
Integer iDriverDecimalPlaces iDecimalPlaces
String sValue
If (strQ._strControlBlock.iQueryMethod=tqDATAFLEX) Begin
Send _RelateToTable (&strQ) iTable
If (iColumn=0) Begin
Move (SerializeRowID(GetRowID(iTable))) to sValue
End
Else Begin
Get_Field_Value iTable iColumn to sValue
Move (Rtrim(sValue)) to sValue
End
End
Else Begin
If (SizeOfArray(strQ.aColumnSources)=0) Begin
If (iTable=strQ.iTable) Begin
Get_Field_Value iTable iColumn to sValue
Move (Rtrim(sValue)) to sValue
End
Else Begin
Send OnError 731 "Column not part of result set."
End
End
Else Begin
Get _ColumnSourceFind strQ iTable iColumn to iColumnSourceItem
If (iColumnSourceItem<>-1) Begin
If (strQ.aColumnSources[iColumnSourceItem].iColumn=0) Begin
Get_Field_Value iTable iColumn to sValue
Move (Rtrim(sValue)) to sValue
End
Else Begin
//
Get SQLColumnValue of strQ._strControlBlock.strSQLStatementHandle.hHandle (iColumnSourceItem+1) to sValue
Move strQ.aColumnSources[iColumnSourceItem].iType to iType
If (iType=tqDATE) Begin
Get SQLDateToDFDate of strQ._strControlBlock.strSQLStatementHandle.hHandle sValue to sValue
End
Else If (iType=tqNUMBER) Begin
Get _SQLNumericToDFNumeric iTable sValue to sValue
End
Else If (iType=tqSTRING or iType=tqTEXT) Begin
If (strQ._strControlBlock.bSQLTableIsAnsi) Begin
Move (ToOEM(sValue)) to sValue
End
Move (Rtrim(sValue)) to sValue
End
End
End
Else Begin
Send OnError 732 "Unknown result column"
End
End
End
Function_Return sValue
End_Function
Function ResultColumnValues tTableQuery ByRef strQ Boolean bIncludeRowIDs Returns String[]
Boolean bDone
Integer iItem iMax iTable iColumn
String[] aValues
Move (SizeOfArray(strQ.aColumnSources)-1) to iMax
Move 0 to iItem
Move False to bDone
While (not(bDone) and iItem<=iMax)
If (not(bIncludeRowIDs)) Begin
Move (strQ.aColumnSources[iItem].iColumn=0) to bDone // The ones that are Table.* are excluded
End
If (not(bDone)) Begin
Get ResultColumnValue (&strQ) strQ.aColumnSources[iItem].iTable strQ.aColumnSources[iItem].iColumn to aValues[iItem]
End
Increment iItem
Loop
Function_Return aValues
End_Function
Function OutputColumnValues tTableQuery ByRef strQ Boolean bIncludeRowIDs Returns String[]
Boolean bDone
Integer iItem iMax iTable iColumn
String[] aValues
Move (SizeOfArray(strQ.aOutputColumns)-1) to iMax
Move 0 to iItem
Move False to bDone
While (not(bDone) and iItem<=iMax)
If (not(bIncludeRowIDs)) Begin
Move (strQ.aOutputColumns[iItem].iColumn=0) to bDone // The ones that are Table.* are excluded
End
If (not(bDone)) Begin
Get ResultColumnValue (&strQ) strQ.aOutputColumns[iItem].iTable strQ.aOutputColumns[iItem].iColumn to aValues[iItem]
End
Increment iItem
Loop
Function_Return aValues
End_Function
Function __RelateSegmentsToColumns _tTQTableRelationSegment[] aSegments Returns Integer[]
Integer iItem iMax
Integer[] aColumns
Move (SizeOfArray(aSegments)-1) to iMax
For iItem from 0 to iMax
Move aSegments[iItem].iTargetColumn to aColumns[iItem]
Loop
Function_Return aColumns
End_Function
Procedure _RelateTablePerform tTableQuery ByRef strQ Integer iRelateItem // Is only called when i embedded mode
Integer iMax iItem iIndex
Integer iSourceTable iSourceColumn iTargetTable iTargetColumn
String sValue
Integer[] aColumns
tTQTableRelation strRelation
Move strQ.aTableRelations[iRelateItem] to strRelation
If (not(strRelation.bFixed)) Begin // If fixed we will just accept the record that is there.
Move (SizeOfArray(strRelation.aSegments)-1) to iMax
Move strRelation.iTargetTable to iTargetTable
Clear iTargetTable
For iItem from 0 to iMax
Move strRelation.aSegments[iItem].iSourceTable to iSourceTable
Move strRelation.aSegments[iItem].iSourceColumn to iSourceColumn
Move strRelation.aSegments[iItem].iTargetColumn to iTargetColumn
Get ResultColumnValue (&strQ) iSourceTable iSourceColumn to sValue
Set_Field_Value iTargetTable iTargetColumn to sValue
Loop
If (strRelation._iEmbeddedIndex=-1) Begin
Get __RelateSegmentsToColumns strRelation.aSegments to aColumns
Get FindEQIndex of oIndexFunctions iTargetTable aColumns to iIndex
If (iIndex=-1) Begin
Send OnError 733 ("Can't identify record in related table "+String(iTargetTable))
End
Move iIndex to strRelation._iEmbeddedIndex
Move strRelation to strQ.aTableRelations[iRelateItem]
End
Else Begin
Move strRelation._iEmbeddedIndex to iIndex
End
Vfind iTargetTable iIndex EQ
If (not(Found)) Begin
Clear iTargetTable
End
End
End_Procedure
Procedure _RelateToTable tTableQuery ByRef strQ Integer iTable // This is only called for embedded type queries (from the ResultColumnValue function)
Integer iRelateItem
Boolean bTableRelated
tTQTableRelation strRelation
If (iTable<>strQ.iTable) Begin // If iTable is not the main table of the query
Get _FindTableRelation strQ iTable to iRelateItem
If (iRelateItem<>-1) Begin
Move strQ._strControlBlock.aRelatedRecords[iRelateItem] to bTableRelated
If (not(bTableRelated)) Begin //
Move strQ.aTableRelations[iRelateItem] to strRelation
If (not(strRelation.bFixed)) Begin // If no items we will just accept the current record
If (IsNullRowID(GetRowID(strQ.iTable))) Begin
Clear iTable
End
Else Begin
If (not(_TableRelationAlreadyOK(Self,&strQ,strRelation))) Begin // If not already good by chance.
// It could already be OK by chance in which case it will not perform a relate. If the parent
// record is the same as for the previous child record. Or if it has been "fixated" by an
// outer loop in which case it would be constant. It is the responsability of the
// programmer to ensure that tables do have to take on double roles.
Send _RelateTablePerform (&strQ) iRelateItem
End
End
End
Move True to strQ._strControlBlock.aRelatedRecords[iRelateItem] // update TableRelateState to "performed"
End
End
Else Begin
Send OnError 734 "Table not related"
End
End
End_Procedure
// This is called in preparation for a new record to indicate the related buffers have
// to be reconsidered and rectified if needed.
Procedure _TableRelateStatesReset tTableQuery ByRef strQ
Boolean[] abEmpty
Move abEmpty to strQ._strControlBlock.aRelatedRecords
Move (ResizeArray(strQ._strControlBlock.aRelatedRecords,SizeOfArray(strQ.aTableRelations),False)) to strQ._strControlBlock.aRelatedRecords
End_Procedure
Function __CompareColumnSource _tTQValueSource strValue1 _tTQValueSource strValue2 Returns Integer
Boolean bCompleteRecord1 bCompleteRecord2
Move (strValue1.iColumn=0) to bCompleteRecord1
Move (strValue2.iColumn=0) to bCompleteRecord2
If (bCompleteRecord1=bCompleteRecord2) Begin
Function_Return (EQ)
End
If (bCompleteRecord1) Begin
Function_Return (GT)
End
Else Begin
Function_Return (LT)
End
End_Function
//> Add table column to the result set.
Procedure AddResultColumn tTableQuery ByRef strQ Integer iTable Integer iColumn Boolean bRejectIfAlreadyThere
Integer iColumnSourceItem
Boolean _bRejectIfAlreadyThere
If (num_arguments>=4) Begin
Move bRejectIfAlreadyThere to _bRejectIfAlreadyThere
End
Else Begin
Move False to _bRejectIfAlreadyThere
End
If (_bRejectIfAlreadyThere) Begin
Get _ColumnSourceFind strQ iTable iColumn to iColumnSourceItem
If (iColumnSourceItem>=0) Begin
Procedure_Return // The column is already there => skip it
End
End
If (iTable=strQ.iTable or _FindTableRelation(Self,strQ,iTable)<>-1) Begin // We accept only ourselves or one of our related.
Move (SizeOfArray(strQ.aColumnSources)) to iColumnSourceItem
Move iTable to strQ.aColumnSources[iColumnSourceItem].iTable
Move iColumn to strQ.aColumnSources[iColumnSourceItem].iColumn
Get _ColumnType iTable iColumn to strQ.aColumnSources[iColumnSourceItem].iType
If (not(strQ._bOutputColumnsFixated)) Begin
Move strQ.aColumnSources[iColumnSourceItem] to strQ.aOutputColumns[SizeOfArray(strQ.aOutputColumns)]
End
Move (SortArray(strQ.aColumnSources,Self,GET___CompareColumnSource)) to strQ.aColumnSources
End
Else Begin
Send OnError 736 ("Unknown table in result set ("+String(iTable)+")")
End
End_Procedure
Procedure FixateOutputColumns tTableQuery ByRef strQ
Move True to strQ._bOutputColumnsFixated
End_Procedure
Procedure AddResultTable tTableQuery ByRef strQ Integer iTable
Send AddResultColumn (&strQ) iTable 0
End_Procedure
Procedure ResetResultSetColumns tTableQuery ByRef strQuery
// Check that the query is not already executing
If (strQuery._strControlBlock.bInitialized) Begin
Send OnError 741 "ResetResultSetColumns called while query is executing"
End
Else Begin
Move (ResizeArray(strQuery.aColumnSources,0)) to strQuery.aColumnSources
Move (ResizeArray(strQuery.aOutputColumns,0)) to strQuery.aOutputColumns
End
End_Procedure
Function _IsColumnIncludedInResultSet tTableQuery strQ Integer iTable Integer iColumn Returns Boolean
Integer iItem iItemMax
Move (SizeOfArray(strQ.aColumnSources)-1) to iItemMax
If (strQ.iTable=iTable and iItemMax=-1) Begin
Function_Return True //
End
For iItem from 0 to iItemMax
If (iTable=strQ.aColumnSources[iItem].iTable) Begin
If (iColumn=strQ.aColumnSources[iItem].iColumn or strQ.aColumnSources[iItem].iColumn=0) Begin
Function_Return True
End
End
Loop
Function_Return False
End_Function
// *** End of TableRelation functions *** End of TableRelation functions *** End of TableRelation functions *** End of TableRelation functions *** End of TableRelation functions ***
// If iTable has a name in filelist.cfg we use that, other wise
// we try the SQL table name.
Function LogTableName tTableQuery strQuery Returns String
Integer iTable
String sTableName
Move strQuery.iTable to iTable
Get_Attribute DF_FILE_LOGICAL_NAME of iTable to sTableName
If (sTableName="") Begin
Move strQuery.sForceSQLTableName to sTableName
End
If (sTableName<>"") Begin
Move (sTableName+"_tqlog.dat") to sTableName
End
Function_Return sTableName
End_Function
Function LogTableNameFullPath tTableQuery strQuery Returns String
String sFolder sTablePath
Get VdfFolderPath of oFileFunctions VDF_FILELIST to sFolder
Get AppendPath of oFileFunctions sFolder "tq-logdata" to sFolder
Get AppendPath of oFileFunctions sFolder (LogTableName(Self,strQuery)) to sTablePath
Function_Return sTablePath
End_Function
Function LogTableCreate tTableQuery strQuery Returns Boolean
tTempTableDefinition strTable
Get EmptyTempTableDefinition of oTemporaryTablesFunctions to strTable
Move 20000 to strTable.iMaxRecords // Max number of logs
Get LogTableName strQuery to strTable.sFileName
Move "" to strTable.sFolder // blank means it goes in the data folder
Move "tq-logdata" to strTable.sSubFolder // means it goes in a subfolder of the data folder called "tq-logdata"
Send AddColumn of oTemporaryTablesFunctions (&strTable) "DateTime" DF_ASCII 23 0 // field no 1
Send AddColumn of oTemporaryTablesFunctions (&strTable) "ExecTime" DF_BCD 8 0 // field no 2
Send AddColumn of oTemporaryTablesFunctions (&strTable) "LogTag" DF_ASCII 20 0 // field no 3
Send AddColumn of oTemporaryTablesFunctions (&strTable) "User" DF_ASCII 20 0 // field no 4
Send AddColumn of oTemporaryTablesFunctions (&strTable) "Application" DF_ASCII 20 0 // field no 5
Send AddColumn of oTemporaryTablesFunctions (&strTable) "SessionStart" DF_ASCII 23 0 // field no 6
Send AddColumn of oTemporaryTablesFunctions (&strTable) "FullTableScan" DF_BCD 2 0 // field no 7
Send AddColumn of oTemporaryTablesFunctions (&strTable) "RecordsFound" DF_BCD 10 0 // field no 8
Send AddColumn of oTemporaryTablesFunctions (&strTable) "RecordsSelected" DF_BCD 10 0 // field no 9
Send AddColumn of oTemporaryTablesFunctions (&strTable) "UnusedFilters" DF_BCD 4 0 // field no 10
Send AddColumn of oTemporaryTablesFunctions (&strTable) "Index" DF_BCD 4 0 // field no 11
Send AddColumn of oTemporaryTablesFunctions (&strTable) "IndexForced" DF_BCD 2 0 // field no 12
Send AddColumn of oTemporaryTablesFunctions (&strTable) "PrefetchForced" DF_BCD 2 0 // field no 13
Send AddColumn of oTemporaryTablesFunctions (&strTable) "Limit" DF_BCD 6 0 // field no 14
Send AddColumn of oTemporaryTablesFunctions (&strTable) "ScanComplete" DF_BCD 2 0 // field no 15
Send AddColumn of oTemporaryTablesFunctions (&strTable) "TQserialised" DF_BINARY 2040 0 // field no 16
Move True to strTable.bCompression
If (CreateTable(oTemporaryTablesFunctions,strTable,True)) Begin
// Showln "LogTableCreate Success"
Function_Return True
End
Else Begin
// Showln "LogTableCreate Failure"
End
Function_Return False
End_Function
Function OpenLogTable tTableQuery strQuery Returns Integer
Integer iLogTable
String sLogTableName
Move 0 to iLogTable
Get LogTableNameFullPath strQuery to sLogTableName
// We do not expect the log file to have an entry in filelist.cfg
// so we open it "as".
If (sLogTableName<>"") Begin
Get OpenTableAsAutoHandle of oTableAccessFunctions sLogTableName DF_SHARE 0 to iLogTable
If (iLogTable=0) Begin // If the table isn't there, we create it
If (LogTableCreate(Self,strQuery)) Begin
Get OpenTableAsAutoHandle of oTableAccessFunctions sLogTableName DF_SHARE 0 to iLogTable
End
End
End
Else Begin
// No error! (I changed my mind)
// Error xxx ("Table name for log file could not be calculated (table: "+String(strQuery.iTable)+")")
End
Function_Return iLogTable
End_Function
Function LogTableHandle tTableQuery strQuery Returns Integer
Integer iLogTable
Move 0 to iLogTable
If (strQuery.iTable Returns an array of tables that are referenced as constants during the execution of a query.
//> So if you want to repeat the find loop of a particular tTableQuery variable, the record
//> buffers of fixed tables must be restored to that of the original query. Does this make sense?
Function _FixedTables tTableQuery strQuery Boolean bFixed Returns Integer[]
Integer iMax iIndex
Integer[] aTables
Move (SizeOfArray(strQuery.aTableRelations)-1) to iMax
For iIndex from 0 to iMax
If (strQuery.aTableRelations[iIndex].bFixed=bFixed) Begin
If (IntegerAddToSet(oStackFunctions,&aTables,strQuery.aTableRelations[iIndex].iTargetTable)) Begin
// Do nothing
End
End
Loop
Function_Return aTables
End_Function
Function FixedTables tTableQuery strQuery Returns Integer[]
Function_Return (_FixedTables(Self,strQuery,True))
End_Function
Function NotFixedTables tTableQuery strQuery Returns Integer[]
Boolean bGrb
Integer[] aTables
Get _FixedTables strQuery False to aTables
Get IntegerAddToSet of oStackFunctions (&aTables) strQuery.iTable to bGrb
Function_Return aTables
End_Function
Function FixedTablesRowIDs tTableQuery strQuery Returns RowID[]
Integer iItem iMax
Integer[] aFixedTables
RowID[] aRowIDs
Get FixedTables strQuery to aFixedTables
Move (SizeOfArray(aFixedTables)-1) to iItem
For iItem from 0 to iMax
Move (GetRowID(aFixedTables[iItem])) to aRowIDs[iItem]
Loop
Function_Return aRowIDs
End_Function
Function FixedTablesRowIDs_Serialized tTableQuery strQuery Returns String[]
Integer iItem iMax
Integer[] aFixedTables
String[] aRowIDs
Get FixedTables strQuery to aFixedTables
Move (SizeOfArray(aFixedTables)-1) to iItem
For iItem from 0 to iMax
Move (SerializeRowID(GetRowID(aFixedTables[iItem]))) to aRowIDs[iItem]
Loop
Function_Return aRowIDs
End_Function
Function FixedTablesRestore tTableQuery strQuery RowID[] aRowIDs Returns Boolean
Boolean bFound
RowID riRow
Integer iItem iMax
Integer[] aFixedTables
Get FixedTables strQuery to aFixedTables
Move (SizeOfArray(aFixedTables)-1) to iMax
For iItem from 0 to iMax
Move aRowIDs[iItem] to riRow
If (IsNullRowID(riRow)) Begin
Clear aFixedTables[iItem]
End
Else Begin
Move (FindByRowID(aFixedTables[iItem],aRowIDs[iItem])) to bFound
If (not(bFound)) Begin
Function_Return False
End
End
Loop
Function_Return True
End_Function
Function FixedTablesRestore_Serialized tTableQuery strQuery String[] asRowIDs Returns Boolean
Integer iItem iMax
RowID[] ariRowIDs
Move (SizeOfArray(asRowIDs)-1) to iMax
For iItem from 0 to iMax
Move (DeserializeRowID(asRowIDs[iItem])) to ariRowIDs[iItem]
Loop
Function_Return (FixedTablesRestore(Self,strQuery,ariRowIDs))
End_Function
Procedure _PushNoneFixedBuffers tTableQuery strQuery
Integer iItem iMax iTable
Integer[] aTables
Get NotFixedTables strQuery to aTables
Move (SizeOfArray(aTables)-1) to iMax
For iItem from 0 to iMax
Move aTables[iItem] to iTable
Send PushRecord of oRecordBufferFunctions iTable
Loop
End_Procedure
Procedure _PopNoneFixedBuffers tTableQuery strQuery
Integer iItem iMax iTable
Integer[] aTables
Get NotFixedTables strQuery to aTables
Move (ReverseArray(aTables)) to aTables
Move (SizeOfArray(aTables)-1) to iMax
For iItem from 0 to iMax
Move aTables[iItem] to iTable
Send PopRecord of oRecordBufferFunctions iTable
Loop
End_Procedure
Function TableQueryToString tTableQuery strQuery Returns String
String sTQ
Get VariantToString of oStructFunctions strQuery to sTQ
Function_Return sTQ
End_Function
Function StringToTableQuery String sTQ Returns tTableQuery
tTableQuery strQuery
tValueTree strValueTree
Get StringToValueTree of oStructFunctions sTQ to strValueTree
ValueTreeDeserializeParameter strValueTree to strQuery
Function_Return strQuery
End_Function
Function TableQuerySerializedForLog tTableQuery strQuery Returns String
String sTQ
Get TableQueryToString strQuery to sTQ
Function_Return ("V1.0,"+sTQ)
End_Function
Function _NextValueInArray String[] aValues Integer ByRef iPos Returns String
String sValue
Move aValues[iPos] to sValue
Increment iPos
Function_Return sValue
End_Function
Function _LogReadValueSource String[] aValues Integer ByRef iPos Returns _tTQValueSource
_tTQValueSource strValue
Integer iItem iMax
Get _NextValueInArray aValues (&iPos) to strValue.iTable
Get _NextValueInArray aValues (&iPos) to strValue.iColumn
Get _NextValueInArray aValues (&iPos) to strValue.iType
Get _NextValueInArray aValues (&iPos) to strValue.iLen
Get _NextValueInArray aValues (&iPos) to strValue.iDecimals
Get _NextValueInArray aValues (&iPos) to strValue.sConstant
Get _NextValueInArray aValues (&iPos) to strValue.sSQLResultSetColumnName
Get _NextValueInArray aValues (&iPos) to iMax
For iItem from 0 to iMax
Get _NextValueInArray aValues (&iPos) to strValue.aOrList[iItem]
Loop
Function_Return strValue
End_Function
Function _LogReadFilter String[] aValues Integer ByRef iPos Returns tTQFilterSegment
tTQFilterSegment strFilter
Get _LogReadValueSource aValues (&iPos) to strFilter.strLeftValue
Get _NextValueInArray aValues (&iPos) to strFilter.iComp
Get _LogReadValueSource aValues (&iPos) to strFilter.strRightValue
End_Function
Function _LogReadOrderingSegment String[] aValues Integer ByRef iPos Returns tTQOrderBySegment
tTQOrderBySegment strSegment
Get _NextValueInArray aValues (&iPos) to strSegment.bDescending
Get _NextValueInArray aValues (&iPos) to strSegment.bUppercase
Get _LogReadValueSource aValues (&iPos) to strSegment.strValueSource
End_Function
Function TableQueryDeserializedFromLog String sValue Returns tTableQuery
Integer iPos iItem iMax
tTableQuery strQuery
tTQFilterSegment strFilter
tTQOrderBySegment strSegment
String[] aValues
Send SplitString of oStringFunctions sValue (Character(10)) False False (&aValues)
If (SizeOfArray(aValues)>1) Begin
Move 1 to iPos
If (aValues[0]="V1.0") Begin
Get _NextValueInArray aValues (&iPos) to strQuery.iTable
Get _NextValueInArray aValues (&iPos) to strQuery.bNoESQL
Get _NextValueInArray aValues (&iPos) to strQuery.bForcePrefetch
Get _NextValueInArray aValues (&iPos) to strQuery.iForceIndex
Get _NextValueInArray aValues (&iPos) to strQuery.iLimit
// Filters:
Get _NextValueInArray aValues (&iPos) to iMax
For iItem from 0 to iMax
Get _LogReadFilter aValues (&iPos) to strFilter
Move strFilter to strQuery.aFilters[iItem]
Loop
// Ordering:
Get _NextValueInArray aValues (&iPos) to iMax
For iItem from 0 to iMax
Get _LogReadOrderingSegment aValues (&iPos) to strSegment
Move strSegment to strQuery.aOrdering[iItem]
Loop
End
End
Function_Return strQuery
End_Function
Procedure OnLogStatus tTableQuery strQuery
Boolean bVal
Integer iLogTable iSize iValue
String sModule sValue
Get LogTableHandle strQuery to iLogTable
If (iLogTable>0) Begin
Clear iLogTable
Get SystemTimeToString23 of oDateFunctions (SystemTimeMilliSeconds(oDateFunctions)) to sValue
Set_Field_Value iLogTable 1 to sValue
Set_Field_Value iLogTable 3 to strQuery._strControlBlock.sLogTag
Get TableQueryUser to sValue
Set_Field_Value iLogTable 4 to sValue // (TableQueryUser(Self))
Get Module_Name to sModule
Set_Field_Value iLogTable 5 to sModule
Get ModuleStartTime of oDateFunctions to sValue
Set_Field_Value iLogTable 6 to sValue
Move (SizeOfArray(strQuery._strCompiled.aJumpInValues)=0 and SizeOfArray(strQuery._strCompiled.aJumpOutValues)=0 and strQuery.iLimit=0) to bVal
Set_Field_Value iLogTable 7 to bVal // Full table scan
Set_Field_Value iLogTable 8 to strQuery._strControlBlock.iFindCount
Set_Field_Value iLogTable 9 to strQuery._strControlBlock.iSelectCount
Move (SizeOfArray(strQuery._strCompiled.aOtherConditions)) to iSize
Set_Field_Value iLogTable 10 to iSize // Unused filters
Set_Field_Value iLogTable 11 to strQuery._strCompiled.iIndex
Move (strQuery.iForceIndex<>-1) to iValue
Set_Field_Value iLogTable 12 to iValue
Set_Field_Value iLogTable 13 to strQuery.bForcePrefetch
Set_Field_Value iLogTable 14 to strQuery.iLimit
Set_Field_Value iLogTable 15 to (not(strQuery._strControlBlock.bBreakScan))
Get TableQuerySerializedForLog strQuery to sValue
Set_Field_Value iLogTable 16 to sValue
SaveRecord iLogTable
End
End_Procedure
Procedure OnComplete tTableQuery strQuery
End_Procedure
Procedure _RelateMainRecord tTableQuery ByRef strQuery
Integer iItem iItemMax
Move (SizeOfArray(strQuery.aColumnSources)-1) to iItemMax
For iItem from 0 to iItemMax
Send _RelateToTable (&strQuery) strQuery.aColumnSources[iItem].iTable
Loop
End_Procedure
Function FindRecord tTableQuery ByRef strQuery Returns Boolean
Boolean bFound bInitialize
Move False to bInitialize
If (strQuery._strControlBlock.bCompiled) Begin
If (not(strQuery._strControlBlock.bInitialized)) Begin
Move True to bInitialize // Initialize!
End
End
Else Begin
Get _CompileQuery (&strQuery) to bInitialize // If it compiles we will initialize it
End
If (bInitialize) Begin
If (_InitializeQuery(Self,&strQuery)) Begin
Move True to strQuery._strControlBlock.bInitialized
Get _FindFirstRecord (&strQuery) to bFound
End
Else Begin
Move False to bFound
End
Move True to strQuery._strControlBlock.bFirstRecord
End
Else Begin
// This is the mechanism that enforces iLimit. However, if the record set is pre-fetched
// this has already been taken care of.
if (strQuery._strCompiled._iLimit<>0) Begin
If (not(strQuery._strCompiled.bPrefetch) and ;
strQuery._strControlBlock.iSelectCount>=strQuery._strCompiled._iLimit) Begin
Move True to strQuery._strControlBlock.bBreakScan
End
End
Get _FindNextRecord (&strQuery) to bFound
Move False to strQuery._strControlBlock.bFirstRecord
End
If (bFound) Begin
If (strQuery._strControlBlock.iQueryMethod=tqDATAFLEX) Begin
// If we are in embedded mode we must find all parent related records specified by the aSelectedColumns member.
Send _RelateMainRecord (&strQuery)
End
Else Begin
// If we are in ESQL mode we expect the fetch-record mechnism to have already done this
End
End
Else Begin
If (not(strQuery.bForcePrefetch)) Begin
Send PurgeResultSet (&strQuery) // if we didn't ask for it we'll get rid of it here (if it's there at all)
End
If (_giTQLogState=2 or ( _giTQLogState=1 and strQuery._strControlBlock.sLogTag<>"")) Begin
Send OnLogStatus strQuery
End
Send _DeinitializeQuery (&strQuery) // Get rid of SQL handles (if emploid)
Send OnComplete strQuery
If (strQuery.bRestoreRecordBuffersOnQueryCompletion) Begin
Send _PopNoneFixedBuffers strQuery // restore buffers of tables that were possibly changed by the query
End
// This is where we _*ALWAYS*_ exit the FindRecord loop
End
Function_Return bFound
End_Function
Function IsFirstRecord tTableQuery strQuery Returns Boolean
Function_Return strQuery._strControlBlock.bFirstRecord
End_Function
//> Returns the current row number of the result set.
Function ResultRowNumber tTableQuery strQuery Returns Integer
If (strQuery._strCompiled.bPrefetch) Begin
Function_Return (strQuery.strResultSet._iCurrentRowPointer+1)
End
Function_Return strQuery._strControlBlock.iFindCount
End_Function
Function HasData tTableQuery strQuery Returns Boolean
Boolean bHasData
tTQOrderBySegment[] aEmpty
If (strQuery._strControlBlock.bInitialized) Begin
// If the query has already been initialized the function will return whether or
// not any records have been selected yet (this would only ever be relevant to a
// person subclassing the cTableQuery class). More relevant is the fact that this
// means that you can query HasData after loop completion and get to know if the
// loop was ever executed.
Function_Return (strQuery._strControlBlock.iSelectCount<>0)
End
Else Begin
// If the loop hasn't yet been initialized we will produce the simplest
// possible query to find out if the loop will have any data.
Move False to strQuery.bForcePrefetch // Prefetch would be stupid
Move aEmpty to strQuery.aOrdering // Do not dictate the ordering
Move 1 to strQuery.iLimit // This will prevent the complete set being built.
Move -1 to strQuery.iForceIndex // Do not force any particular index
// Dilemma! If there are no non-optimizable filters then it's faster to not use
// ESQL. But then I have to compile the query before executing the loop.
// I just haven't gotten around to that yet.
// Move True to strQuery.bNoESQL // (do not use ESQL)
Move False to bHasData
While (FindRecord(Self,&strQuery))
Move True to bHasData
Loop
End
Function_Return bHasData
End_Function
Function QueryToRowIdArray tTableQuery ByRef strQuery Returns RowID[]
Integer iTable iCount
RowID[] aRecords
Move strQuery.iTable to iTable
Move 0 to iCount
While (FindRecord(Self,&strQuery))
Move (GetRowID(iTable)) to aRecords[iCount]
Increment iCount
Loop
Function_Return aRecords
End_Function
Function DeleteRecords tTableQuery strQuery Returns Boolean
Integer iTable
String sStatement
tSQLStatementHandle strStatement
If (strQuery.iLimit<>0) Begin
Send OnError 742 "Limit not allowed on delete statement"
End
Else Begin
Send ResetOrdering (&strQuery) // Ordering irrelevant!
Send ResetResultSetColumns (&strQuery) // Resultset irrelevant!
If (_QueryMethodSQL(Self,strQuery)) Begin // ESQL
If (OpenStatementOnTable(oSQLStatementHandles,strQuery.iTable,&strStatement)) Begin
Move strStatement to strQuery._strControlBlock.strSQLStatementHandle // Is used during the generating of the SQL statement.
Send _TableRelateStatesReset (&strQuery)
Get SQLDeleteStatement strQuery Self to sStatement
Move (ToANSI(sStatement)) to sStatement
If (sStatement<>"") Begin
Send SQLExecDirect of strStatement.hHandle sStatement
End
Send CloseStatement of oSQLStatementHandles strStatement
End
End
Else Begin
Move strQuery.iTable to iTable
While (FindRecord(Self,&strQuery))
Delete iTable
Loop
End
End
Function_Return False
End_Function
Function _TableRootNameStripDriver String sRootName Returns String
Integer iPos
Move (Pos(":",sRootName)) to iPos
If (iPos>2) Begin
Move (Remove(sRootName,1,iPos)) to sRootName
End
Function_Return sRootName
End_Function
Function _TableAnalysisFileName Integer iTable Returns String
String sFolder sTableName
Get VdfFolderPath of oFileFunctions VDF_FILELIST to sFolder
Get_Attribute DF_FILE_ROOT_NAME of iTable to sTableName
Get _TableRootNameStripDriver sTableName to sTableName
Get PathStripType of oFileFunctions sTableName to sTableName
Get AppendPath of oFileFunctions sFolder (sTableName+".tq") to sTableName
Function_Return sTableName
End_Function
Function _TableAnalysisReadIndex Integer iChannel Returns _tTQIndexAnalysis
Integer iItem iMax
_tTQIndexAnalysis strIndexA
Readln iMax
For iItem from 0 to iMax
Get Readln of oFileFunctions iChannel to strIndexA.aSegmentReductions[iItem]
Loop
Function_Return strIndexA
End_Function
Function TableAnalysisRead Integer iTable tTQTableAnalysis ByRef strA Returns Boolean
Integer iChannel iItem iMax
String sFile
tTQTableAnalysis strEmpty
Move strEmpty to strA
Get _TableAnalysisFileName iTable to sFile
Get DirectInput of oFileFunctions sFile to iChannel
If (iChannel>=0) Begin
If (Readln(oFileFunctions,iChannel)="VER 1.0") Begin
Get StringToDateTime of oDateFunctions (Readln(oFileFunctions,iChannel)) DF_DATE_MILITARY to strA.dtAnalysisDateTime
Readln channel iChannel strA.nNumberOfRecords
Readln strA.sTimeToComplete
Readln iMax
For iItem from 0 to iMax
Get _TableAnalysisReadIndex iChannel to strA.aIndices[iItem]
Loop
Send CloseInput of oFileFunctions iChannel
Function_Return True
End
Else Begin
Send OnError 737 ("TQ cache file not recognized ("+sFile+")")
End
Send CloseInput of oFileFunctions iChannel
End
Function_Return False
End_Function
Procedure _TableAnalysisSaveIndex Integer iChannel _tTQIndexAnalysis strIndexA
Integer iMax iItem
Move (SizeOfArray(strIndexA.aSegmentReductions)-1) to iMax
Writeln channel iChannel iMax
For iItem from 0 to iMax
Writeln strIndexA.aSegmentReductions[iItem]
Loop
End_Procedure
Function TableAnalysisSave Integer iTable tTQTableAnalysis strA Returns Boolean
Integer iChannel iItem iMax
String sFile
Get _TableAnalysisFileName iTable to sFile
Get DirectOutput of oFileFunctions sFile to iChannel
If (iChannel>=0) Begin
Writeln channel iChannel "VER 1.0"
Writeln (DateTimeToString(oDateFunctions,strA.dtAnalysisDateTime,DF_DATE_MILITARY,True,"-"))
Writeln strA.nNumberOfRecords
Writeln strA.sTimeToComplete
Move (SizeOfArray(strA.aIndices)-1) to iMax
Writeln iMax
For iItem from 0 to iMax
Send _TableAnalysisSaveIndex iChannel strA.aIndices[iItem]
Loop
Send CloseOutput of oFileFunctions iChannel
Function_Return True
End
Function_Return False
End_Function
Function _TableAnalysisDefault Integer iTable Returns tTQTableAnalysis
Integer iIndex iItem iMax
Integer iSegment iSegments
Integer[] aIndices
Number nRecordCount nFactor
tocIndex strIndex
tTQTableAnalysis strA
Get IndexSet of oIndexFunctions iTable 3 to aIndices // 3 means all online indices
Get_Attribute DF_FILE_RECORDS_USED of iTable 0 0 to nRecordCount
Move (SizeOfArray(aIndices)-1) to iMax
For iItem from 0 to iMax
Move aIndices[iItem] to iIndex
Get IndexDefinition of oOverlapColumnFunctions iTable iIndex to strIndex
Move (SizeOfArray(strIndex.aSegments)) to iSegments
Move (nRecordCount^(1.0/iSegments)) to nFactor
Move (1.0/nFactor) to nFactor
Decrement iSegments
For iSegment from 0 to iSegments
Move nFactor to strA.aIndices[iIndex].aSegmentReductions[iSegment]
Loop
Loop
Function_Return strA
End_Function
//> The TableAnalysis returns a struct that contains information that helps the index analyzer
//> to make informed guesses about which index seeds the best. VDFxray can be used to generate
//> a small text file for each table with this information. If this is the case then function
//> TableAnalysis will read that file and return the by now much mentioned information. And if not
//> the best possible guess is calculated and returned. Actually, in addition to being returned
//> by the function it is also copied to a global cache so subsequent calls will take no time.
Function TableAnalysis Integer iTable Returns tTQTableAnalysis
tTQTableAnalysis strA
Move False to strA.bInitialized
If (SizeOfArray(_gTQaTableAnalysis)>iTable and _gTQaTableAnalysis[iTable].bInitialized) Begin
Move _gTQaTableAnalysis[iTable] to strA
End
Else Begin
If (not(TableAnalysisRead(Self,iTable,&strA))) Begin
Get _TableAnalysisDefault iTable to strA // Calculate one
End
Move True to strA.bInitialized
Move strA to _gTQaTableAnalysis[iTable]
End
Function_Return strA
End_Function
//> Information about configuration of indices for a table. A caching mechanism makes sure that
//> this configuration is not read on subsequent calls to the function.
Function TableMeta Integer iTable Returns tTQTableMeta
tTQTableMeta strM
Move 0 to strM._iIsInitialized
If (SizeOfArray(_gTQaTableMeta)>iTable and _gTQaTableMeta[iTable]._iIsInitialized<>0) Begin
Move _gTQaTableMeta[iTable] to strM
End
Else Begin
Get IndexSet of oIndexFunctions iTable 3 to strM.aIndices // 3 means all on-line indices
Move 1 to strM._iIsInitialized
Move strM to _gTQaTableMeta[iTable]
End
Function_Return strM
End_Function
Function TableIndices Integer iTable Returns Integer[]
tTQTableMeta strM
Get TableMeta iTable to strM
Function_Return strM.aIndices
End_Function
//> This majesticly named procedure clears all cached values and closes
//> any log tables that might have been opened.
Procedure ClearTableQueryMetaDataGlobalArraysAndCloseLogFiles
Integer iItem iMax iLogTable
Move (SizeOfArray(_gaTQLogTables)-1) to iMax
For iItem from 0 to iMax
Move _gaTQLogTables[iItem] to iLogTable
If (iLogTable>0) Begin
Send CloseTable of oTableAccessFunctions iLogTable
End
Loop
Move (ResizeArray(_gTQaTableMeta,0)) to _gTQaTableMeta
Move (ResizeArray(_gTQaTableAnalysis,0)) to _gTQaTableAnalysis
Move (ResizeArray(_gaTQLogTables,0)) to _gaTQLogTables
End_Procedure
End_Class // cTableQueryFunctions
Global_Variable Integer oTQ // Holder of the global singleton object.
Object _oTQ is a cTableQueryFunctions
Move Self to oTQ
// Is called by VDFXray when new WS is selected (TableQuery.pkg is used by VDFXray)
Procedure OnNewFilelistSelected
Send ClearTableQueryMetaDataGlobalArraysAndCloseLogFiles
End_Procedure
End_Object
Class cTableQueryAnalyzer is a cObject
Function _BreakLevel String[] aNewValues String[] aOldValues Returns Integer
Integer iMax iItem
Move (SizeOfArray(aNewValues)-1) to iMax
For iItem from 0 to iMax
If (aNewValues[iItem]<>aOldValues[iItem]) Begin
Function_Return iItem
End
Loop
Function_Return -1 // no break
End_Function
Procedure _IncrementBreakCounter Integer[] ByRef aBreakCounters Integer iLevel
Integer iMax iItem
If (iLevel>=0) Begin
Move (SizeOfArray(aBreakCounters)-1) to iMax
For iItem from 0 to iMax
If (iItem>=iLevel) Begin
Move (aBreakCounters[iItem]+1) to aBreakCounters[iItem]
End
Loop
End
End_Procedure
Procedure _AnalyseTableIndexAux _tTQIndexAnalysis ByRef strIndexA Integer iTable Integer iIndex Integer[] aBreakCounters
Integer iMax iItem
Number nFactor
Move (ResizeArray(strIndexA.aSegmentReductions,0)) to strIndexA.aSegmentReductions
Move (SizeOfArray(aBreakCounters)-1) to iMax
For iItem from 0 to iMax
If (iItem=0) Begin
Move (1.0/aBreakCounters[iItem]) to nFactor
End
Else Begin // 211 644 2200 11331 => 1/211, 211/644, 644/2200, 2200/11331
Move (Number(aBreakCounters[iItem-1])/aBreakCounters[iItem]) to nFactor
End
Move nFactor to strIndexA.aSegmentReductions[iItem]
Loop
End_Procedure
Procedure _AnalyseTableIndex _tTQIndexAnalysis ByRef strIndexA Integer iTable Integer iIndex
Integer iCount iLevel iMax
String[] aNewValues aOldValues
Integer[] aBreakCounters
tocIndex strIndex
_tTQIndexAnalysis strEmpty
tTableQuery strQ
Get IndexDefinition of oOverlapColumnFunctions iTable iIndex to strIndex
Move 0 to iCount
Get_Attribute DF_FILE_RECORDS_USED of iTable to iMax
Get NewQuery of oTQ iTable to strQ
Send SetOrderByToIndex of oTQ (&strQ) iIndex
While (FindRecord(oTQ,&strQ))
Increment iCount
Get IndexSegmentValueArray of oIndexFunctions iTable iIndex to aNewValues
If (iCount=1) Begin
Move (ResizeArray(aBreakCounters,SizeOfArray(aNewValues))) to aBreakCounters
Move aNewValues to aOldValues // No break on the first one
End
If (((iCount/5000)*5000)=iCount) Begin
Send OnAnalyseIndexProgress iTable iCount iMax
End
Get _BreakLevel aNewValues aOldValues to iLevel
If (iLevel>=0) Begin
Send _IncrementBreakCounter (&aBreakCounters) iLevel
End
Move aNewValues to aOldValues
Loop
Send OnAnalyseIndexProgress iTable iCount iCount
If (iCount<>0) Begin
Send _IncrementBreakCounter (&aBreakCounters) 0
End
Move strEmpty to strIndexA
Send _AnalyseTableIndexAux (&strIndexA) iTable iIndex aBreakCounters
End_Procedure
Procedure OnAnalyseTableIndex Integer iTable Integer iIndex Integer iIndexIndex Integer IndexCount
End_Procedure
Procedure OnAnalyseTable Integer iTable Integer iIndexCount
End_Procedure
Procedure OnAnalyseIndexProgress Integer iTable Integer iCount Integer iMax
End_Procedure
Procedure AnalyzeTable tTQTableAnalysis ByRef strTableA Integer iTable
Integer iItem iMax iIndex
Integer[] aIndices
Number nElapsed nRecords
tSystemTimeMS strStart strStop
tTQTableAnalysis strEmptyTable
_tTQIndexAnalysis strIndexA
Move strEmptyTable to strTableA
Get_Attribute DF_FILE_RECORDS_USED of iTable to nRecords
If (nRecords>100) Begin
Get SystemTimeMilliSeconds of oDateFunctions to strStart
Get_Attribute DF_FILE_RECORDS_USED of iTable to strTableA.nNumberOfRecords
Get IndexSet of oIndexFunctions iTable 3 to aIndices // All on-line indices
Move (SizeOfArray(aIndices)-1) to iMax
Send OnAnalyseTable iTable (iMax+1)
For iItem from 0 to iMax
Move aIndices[iItem] to iIndex
Send OnAnalyseTableIndex iTable iIndex iItem (iMax+1)
Send _AnalyseTableIndex (&strIndexA) iTable iIndex
Move strIndexA to strTableA.aIndices[iIndex]
Loop
Send OnAnalyseTableIndex iTable iIndex (iMax+1) (iMax+1)
Get SystemTimeMilliSeconds of oDateFunctions to strStop
Get SystemTimeMilliSecondsElapsed of oDateFunctions strStart strStop to nElapsed
Get MilliSecondsToTimeString of oDateFunctions nElapsed to strTableA.sTimeToComplete
Get SystemDateTime of oDateFunctions to strTableA.dtAnalysisDateTime
End
End_Procedure
Procedure DeleteAnalysis Integer[] aTables
Integer iItem iMax iFailure
String sFile
Move (SizeOfArray(aTables)-1) to iMax
For iItem from 0 to iMax
Get _TableAnalysisFileName of oTQ aTables[iItem] to sFile
If (FileExists(oFileFunctions,sFile)=1) Begin
Get DeleteFileNew of oFileFunctions sFile True to iFailure
End
Loop
End_Procedure
End_Class
Class cTableQueryTester is a cObject
// Based on a tTableQuery value strQ, TestSuite will return
// an array of all queries that should return the same resultset.
Function TestSuite tTableQuery strQ Returns tTableQuery[]
Integer iForcePrefetch iItem iMax
tTableQuery[] aQueries
Integer[] aIndices
Send ReUse of oTQ (&strQ)
Move False to strQ._strControlBlock.bCompiled
Get TableIndices of oTQ strQ.iTable to aIndices
Move (SizeOfArray(aIndices)-1) to iMax
For iForcePrefetch from 0 to 1
Move (iForcePrefetch=1) to strQ.bForcePrefetch
For iItem from 0 to iMax
Send ForceIndex of oTQ (&strQ) aIndices[iItem]
Move strQ to aQueries[SizeOfArray(aQueries)]
Loop
Loop
Function_Return aQueries
End_Function
Function CompareRowID RowID ri1 RowID ri2 Returns Integer
If (IsSameRowID(ri1,ri2)) Function_Return (EQ)
Function_Return (GT)
End_Function
Function ResultSetsIdentical RowID[] aResult1 RowID[] aResult2 Returns Boolean
Integer iMax iItem iItem2
Move (SizeOfArray(aResult1)-1) to iMax
If (iMax=(SizeOfArray(aResult2)-1)) Begin
For iItem from 0 to iMax
Move (SearchArray(aResult1[iItem],aResult2,Self,GET_CompareRowID)) to iItem2
If (iItem2=-1) Begin
Function_Return False
End
Loop
Function_Return True
End
Function_Return False
End_Function
Procedure OnNotIdentical tTableQuery strQ1 tTableQuery strQ2
End_Procedure
Function RunSuite tTableQuery[] ByRef aQueries Returns RowID[][]
Integer iItem iMax
Boolean bIdentical
RowID[] aResult
RowID[][] aMatrix // An array of result-arrays
Move (SizeOfArray(aQueries)-1) to iMax
For iItem from 0 to iMax
Get QueryToRowIdArray of oTQ (&aQueries[iItem]) to aResult
Move aResult to aMatrix[iItem]
Loop
Function_Return aMatrix
End_Function
End_Class // cTableQueryTester
//
//
//
//
//Struct tTQTestBedInput
// tTableQuery strPQ
// tTableQuery strCQ
// tTQTableRelation strRel
// String sName // Is used as part of a file name
// Boolean bNoESQL
// Boolean bRubQueries
//End_Struct
//
//Struct tTQTestBedRowID
// String sRowID
// String[] aColumnSourceValues
// tTQTestBedRowID[] aChildRowIDs
//End_Struct
//
//Struct tTQTestBedOutput
// tTQTestBedInput strInput
// tTQTestBedRowID[] aResultRowIDs
// Number nExecMs
//End_Struct
//
//Class cTableQueryTestBed is a cObject
// Function RunTest tTQTestBedInput strIn Returns tTQTestBedOutput
// Integer iChildResultIndex iParentResultIndex iParentMaxColumn iChildMaxColumn iItem
// tTQTestBedOutput strOut
// _tTQValueSource strValueSource
//
// Move strIn.bNoESQL to strIn.strPQ.bNoESQL
//
// Move strIn to strOut.strInput
// Move 0 to iParentResultIndex
//
// Move (SizeOfArray(strIn.strPQ.aColumnSources)-1) to iParentMaxColumn
// Move (SizeOfArray(strIn.strCQ.aColumnSources)-1) to iChildMaxColumn
//
// While (FindRecord(oTQ,&strIn.strPQ))
// Move (SerializeRowID(FileRowId(strIn.strPQ.iTable))) to strOut.aResultRowIDs[iParentResultIndex].sRowID
// For iItem from 0 to iParentMaxColumn
// Move strIn.strPQ.aColumnSources[iItem] to strValueSource
// Get ResultColumnValue of oTQ (&strIn.strPQ) strValueSource.iTable strValueSource.iColumn to strOut.aResultRowIDs[iParentResultIndex].aColumnSourceValues[iItem]
// Loop
//
// Move 0 to iChildResultIndex
// While (FindRecord(oTQ,&strIn.strCQ))
// Move (SerializeRowID(FileRowId(strIn.strCQ.iTable))) to strOut.aResultRowIDs[iParentResultIndex].aChildRowIDs[iChildResultIndex].sRowID
// For iItem from 0 to iChildMaxColumn
// Move strIn.strCQ.aColumnSources[iItem] to strValueSource
// Get ResultColumnValue of oTQ (&strIn.strCQ) strValueSource.iTable strValueSource.iColumn to strOut.aResultRowIDs[iParentResultIndex].aChildRowIDs[iChildResultIndex].aColumnSourceValues[iItem]
// Loop
// Increment iChildResultIndex
// Loop
// Increment iParentResultIndex
// Loop
//
// Get SystemTimeMilliSecondsElapsed of oDateFunctions strIn.strPQ._strControlBlock.strStartTime strIn.strPQ._strControlBlock.strStopTime to strOut.nExecMs
//
// Function_Return strOut
// End_Function
//
// Procedure AddAutoRelation tTQTestBedInput ByRef strIn
// Send AddTableRelationAutoFixed of oTQ (&strIn.strCQ) strIn.strCQ.iTable strIn.strPQ.iTable
// End_Procedure
//End_Class