Browse Source

* Introduce DA Data types

michael 5 years ago
parent
commit
c1081c8573
2 changed files with 264 additions and 5 deletions
  1. 63 3
      packages/dataabstract/da.pas
  2. 201 2
      packages/dataabstract/dadataset.pas

+ 63 - 3
packages/dataabstract/da.pas

@@ -20,9 +20,15 @@ unit DA;
 
 
 interface
 interface
 
 
-uses Types, JS, DASDK;
+uses Sysutils, Types, JS, DASDK;
 
 
 Type
 Type
+  TDADataType = ( datUnknown, datString, datDateTime, datFloat, datCurrency,
+          datAutoInc, datInteger, datLargeInt, datBoolean, datMemo,
+          datBlob, datWideString, datWideMemo, datLargeAutoInc, datByte,
+          datShortInt, datWord, datSmallInt, datCardinal, datLargeUInt,
+          datGuid, datXml, datDecimal, datSingleFloat, datFixedChar, datFixedWideChar, datCursor);
+
   // Forward classes
   // Forward classes
   TDADataTable = class;
   TDADataTable = class;
   TDABIN2DataStreamer = class;
   TDABIN2DataStreamer = class;
@@ -210,7 +216,9 @@ Type
     __newValues : array of JSValue;
     __newValues : array of JSValue;
   end;
   end;
 
 
-  TDAExpression  = class external name 'RemObjects.DataAbstract.Expression' (TJSObject);
+  TDAExpression  = class external name 'RemObjects.DataAbstract.Expression' (TJSObject)
+    function toXML : String;
+  end;
 
 
   TDADynamicWhere = class external name 'RemObjects.DataAbstract.DynamicWhere' (TJSObject)
   TDADynamicWhere = class external name 'RemObjects.DataAbstract.DynamicWhere' (TJSObject)
   Public
   Public
@@ -264,7 +272,13 @@ Type
   public
   public
     constructor new(aList : array of TDAExpression);
     constructor new(aList : array of TDAExpression);
   end;
   end;
-  
+
+  TDABinaryOperator = (dboAnd, dboOr, dboXor, dboLess, dboLessOrEqual, dboGreater,
+    dboGreaterOrEqual, dboNotEqual, dboEqual, dboLike, dboIn, dboAddition, dboSubtraction,
+    dboMultiply, dboDivide, dboNotIn);
+
+  TDAUnaryOperator = (duoNot, duoMinus);
+
 
 
   TDAUtil = Class external name 'RemObjects.DataAbstract.Util' (TJSObject)
   TDAUtil = Class external name 'RemObjects.DataAbstract.Util' (TJSObject)
   Public
   Public
@@ -313,6 +327,52 @@ Type
   Public
   Public
     constructor new(aTable : TDADataTable; aHTMLTableID : String);
     constructor new(aTable : TDADataTable; aHTMLTableID : String);
   end;
   end;
+
+Const
+  BinaryOperatorNames : Array[TDABinaryOperator] of string =
+    ('And', 'Or', 'Xor', 'Less', 'LessOrEqual', 'Greater',
+    'GreaterOrEqual', 'NotEqual', 'Equal', 'Like', 'In', 'Addition', 'Subtraction',
+    'Multiply', 'Divide', 'NotIn');
+
+  UnaryOperatorNames: Array[TDAUnaryOperator] of string = ('Not', 'Minus');
+
+  DataTypeNames : Array[TDADataType] of string = ('Unknown', 'String', 'eTime', 'Float', 'Currency',
+          'AutoInc', 'Integer', 'LargeInt', 'Boolean', 'Memo',
+          'Blob', 'WideString', 'WideMemo', 'LargeAutoInc', 'Byte',
+          'ShortInt', 'Word', 'SmallInt', 'Cardinal', 'LargeUInt',
+          'Guid', 'Xml', 'Decimal', 'SingleFloat', 'FixedChar', 'FixedWideChar', 'Cursor');
+
+Function JSValueToDataType(aValue : JSValue) : TDADataType;
+Function JSValueToDataTypeName(aValue : JSValue) : String;
+
 Implementation
 Implementation
 
 
+Function JSValueToDataType(aValue : JSValue) : TDADataType;
+
+begin
+  if isNull(aValue) then
+    Result:=datUnknown
+  else if isString(aValue) then
+    Result:=datWideString
+  else if isBoolean(aValue) then
+    Result:=datBoolean
+  else if isNumber(aValue) then
+    begin
+    if isInteger(aValue) then
+      Result:=datLargeInt
+    else
+      Result:=datFloat
+    end
+  else if isDate(aValue) then
+    Result:=datDateTime
+  else
+    Raise EConvertError.Create('Cannot convert JSValue to DADataType: Unknown/Unsupported type');
+end;
+
+Function JSValueToDataTypeName(aValue : JSValue) : String;
+
+begin
+  Result:=DataTypeNames[JSValueToDataType(aValue)];
+end;
+
 end.
 end.

+ 201 - 2
packages/dataabstract/dadataset.pas

@@ -23,6 +23,35 @@ Type
   EDADataset = Class(EDatabaseError);
   EDADataset = Class(EDatabaseError);
   TDAConnection = Class;
   TDAConnection = Class;
 
 
+  { TDAWhereClauseBuilder }
+
+  TDAWhereClauseBuilder = class
+  public
+    class function NewBinaryExpression(aLeft, aRight: TDAExpression; anOp: TDABinaryOperator): TDAExpression;overload;
+    class function NewBinaryExpression(aLeft: TDAExpression; anOp: TDABinaryOperator;const aValue: JSValue): TDAExpression;overload;
+    class function NewBinaryExpression(aLeft: TDAExpression; anOp: TDABinaryOperator;const aValue: JSValue; aType: TDADataType): TDAExpression;overload;
+    class function NewBinaryExpression(const aTableName,aFieldName: string; anOp: TDABinaryOperator; const aJSValue: JSValue; aType: TDADataType): TDAExpression; overload;
+    class function NewBinaryExpression(const aTableName,aFieldName: string; anOp: TDABinaryOperator; const aJSValue: JSValue): TDAExpression; overload;
+    class function NewBinaryExpression(const aTableName,aFieldName: string; const aParameterName: string; aParameterType: TDADataType; anOp: TDABinaryOperator): TDAExpression; overload;
+    class function NewBinaryExpressionList(const aExpressions: array of TDAExpression; anOp: TDABinaryOperator): TDAExpression;
+    class function NewUnaryExpression(anExpression: TDAExpression; anOp: TDAUnaryOperator): TDAExpression;
+    class function NewConstant(const aValue: jsValue): TDAExpression; overload;
+    class function NewConstant(const aValue: jsValue; aType: TDADataType): TDAExpression; overload;
+    class function NewList(const aValues: array of TDAExpression): TDAExpression;
+    class function NewParameter(const aParameterName: string; aParameterType: TDADataType = datUnknown): TDAExpression;
+    class function NewField(const aTableName,aFieldName: string): TDAExpression;
+    class function NewNull: TDAExpression;
+    class function NewIsNotNull: TDAExpression; overload;
+    class function NewIsNotNull(const aTableName,aFieldName: string): TDAExpression; overload;
+    class function NewMacro(const aName: string): TDAExpression; overload;
+    class function NewMacro(const aName: string; const aValues: array of TDAExpression): TDAExpression; overload;
+    class function NewBetweenExpression(aExpression, aLower, aUpper: TDAExpression): TDAExpression; overload;
+    class function NewBetweenExpression(const aExprTableName, aExprFieldName: string; aLower, aUpper: TDAExpression): TDAExpression; overload;
+    class function NewBetweenExpression(const aExprTableName, aExprFieldName: string; aLowerValue, aUpperValue: JSValue; aValuesDataType: TDADataType): TDAExpression; overload;
+    class function GetWhereClause (aExpression : TDAExpression) : String;
+  end;
+
+
   { TDADataset }
   { TDADataset }
 
 
   TDADataset = class(TBaseJSONDataset)
   TDADataset = class(TBaseJSONDataset)
@@ -31,6 +60,7 @@ Type
     FTableName: String;
     FTableName: String;
     FDAConnection: TDAConnection;
     FDAConnection: TDAConnection;
     FWhereClause: String;
     FWhereClause: String;
+    FWhereClauseBuilder : TDAWhereClauseBuilder;
     function DataTypeToFieldType(s: String): TFieldType;
     function DataTypeToFieldType(s: String): TFieldType;
     procedure SetParams(AValue: TParams);
     procedure SetParams(AValue: TParams);
   Protected
   Protected
@@ -41,6 +71,9 @@ Type
     constructor create(aOwner : TComponent); override;
     constructor create(aOwner : TComponent); override;
     Destructor Destroy; override;
     Destructor Destroy; override;
     function DoGetDataProxy: TDataProxy; override;
     function DoGetDataProxy: TDataProxy; override;
+    Function ParamByName(Const aName : string) : TParam;
+    Function FindParam(Const aName : string) : TParam;
+    Property WhereClauseBuilder : TDAWhereClauseBuilder Read FWhereClauseBuilder;
     // DA is index based. So create array field mapper.
     // DA is index based. So create array field mapper.
     function CreateFieldMapper : TJSONFieldMapper; override;
     function CreateFieldMapper : TJSONFieldMapper; override;
     Procedure CreateFieldDefs(a : TJSArray);
     Procedure CreateFieldDefs(a : TJSArray);
@@ -50,6 +83,8 @@ Type
     Property WhereClause : String Read FWhereClause Write FWhereClause;
     Property WhereClause : String Read FWhereClause Write FWhereClause;
   end;
   end;
 
 
+
+
   TDADataRequest = Class(TDataRequest)
   TDADataRequest = Class(TDataRequest)
   Public
   Public
     Procedure doSuccess(res : JSValue) ;
     Procedure doSuccess(res : JSValue) ;
@@ -159,6 +194,156 @@ uses strutils, sysutils;
 resourcestring
 resourcestring
   SErrInvalidDate = '%s is not a valid date value for %s';
   SErrInvalidDate = '%s is not a valid date value for %s';
 
 
+{ TDAWhereClauseBuilder }
+
+class function TDAWhereClauseBuilder.NewBinaryExpression(aLeft, aRight: TDAExpression; anOp: TDABinaryOperator): TDAExpression;
+begin
+  Result:=TDABinaryExpression.New(aLeft,aRight,BinaryOperatorNames[anOp]);
+end;
+
+class function TDAWhereClauseBuilder.NewBinaryExpression(aLeft: TDAExpression; anOp: TDABinaryOperator; const aValue: JSValue
+  ): TDAExpression;
+begin
+  Result:=TDABinaryExpression.New(aLeft,NewConstant(aValue),BinaryOperatorNames[anOp]);
+end;
+
+class function TDAWhereClauseBuilder.NewBinaryExpression(aLeft: TDAExpression; anOp: TDABinaryOperator; const aValue: JSValue;
+  aType: TDADataType): TDAExpression;
+begin
+  Result:=TDABinaryExpression.New(aLeft,NewConstant(aValue,aType),BinaryOperatorNames[anOp]);
+end;
+
+class function TDAWhereClauseBuilder.NewBinaryExpression(const aTableName, aFieldName: string; anOp: TDABinaryOperator;
+  const aJSValue: JSValue; aType: TDADataType): TDAExpression;
+
+begin
+  Result:=TDABinaryExpression.New(NewField(aTableName,aFieldName),NewConstant(aJSValue,aType),BinaryOperatorNames[anOp])
+end;
+
+class function TDAWhereClauseBuilder.NewBinaryExpression(const aTableName, aFieldName: string; anOp: TDABinaryOperator;
+  const aJSValue: JSValue): TDAExpression;
+
+begin
+  Result:=TDABinaryExpression.New(NewField(aTableName,aFieldName),NewConstant(aJSValue),BinaryOperatorNames[anOp])
+end;
+
+class function TDAWhereClauseBuilder.NewBinaryExpression(const aTableName, aFieldName: string; const aParameterName: string;
+  aParameterType: TDADataType; anOp: TDABinaryOperator): TDAExpression;
+
+begin
+  Result:=TDABinaryExpression.New(NewField(aTableName,aFieldName),NewParameter(aParameterName,aParameterType),BinaryOperatorNames[anOp])
+end;
+
+class function TDAWhereClauseBuilder.NewBinaryExpressionList(const aExpressions: array of TDAExpression; anOp: TDABinaryOperator): TDAExpression;
+
+var
+  i, len: integer;
+begin
+  len:=Length(aExpressions);
+  Case Len of
+    0: Result:=nil;
+    1: Result:=aExpressions[0];
+  else
+    Result:=NewBinaryExpression(aExpressions[0],aExpressions[1],anOp);
+    for i := 2 to Len-1 do
+      Result:=NewBinaryExpression(Result,aExpressions[i],anOp);
+  end;
+end;
+
+class function TDAWhereClauseBuilder.NewUnaryExpression(anExpression: TDAExpression; anOp: TDAUnaryOperator): TDAExpression;
+begin
+  Result:=TDAUnaryExpression.New(anExpression,UnaryOperatorNames[anOp]);
+end;
+
+class function TDAWhereClauseBuilder.NewConstant(const aValue: jsValue): TDAExpression;
+begin
+  Result:=TDAConstantExpression.New(JSValueToDataTypeName(aValue),aValue,Ord(IsNull(aValue)));
+end;
+
+class function TDAWhereClauseBuilder.NewConstant(const aValue: jsValue; aType: TDADataType): TDAExpression;
+begin
+  Result:=TDAConstantExpression.New(JSValueToDataTypeName(aValue),aValue,Ord(IsNull(aValue)));
+end;
+
+class function TDAWhereClauseBuilder.NewList(const aValues: array of TDAExpression): TDAExpression;
+begin
+  Result:=TDAListExpression.New(aValues);
+end;
+
+class function TDAWhereClauseBuilder.NewParameter(const aParameterName: string; aParameterType: TDADataType): TDAExpression;
+begin
+  Result:=TDAParameterExpression.New(aParameterName,DataTypeNames[aParameterType],0);
+end;
+
+class function TDAWhereClauseBuilder.NewField(const aTableName, aFieldName: string): TDAExpression;
+var
+  aName : String;
+
+begin
+  aName:=aFieldName;
+  if aTableName<>'' then
+    aName:=aTableName+'.'+aName;
+  Result:=TDAFieldExpression.New(aName);
+end;
+
+class function TDAWhereClauseBuilder.NewNull: TDAExpression;
+begin
+  Result:=TDANullExpression.new;
+end;
+
+class function TDAWhereClauseBuilder.NewIsNotNull: TDAExpression;
+begin
+  Result:=NewUnaryExpression(TDANullExpression.new,duoNot);
+end;
+
+class function TDAWhereClauseBuilder.NewIsNotNull(const aTableName, aFieldName: string): TDAExpression;
+begin
+  Result:=NewBinaryExpression(NewField(aTableName,aFieldName),NewIsNotNull,dboEqual);
+end;
+
+class function TDAWhereClauseBuilder.NewMacro(const aName: string): TDAExpression;
+begin
+  Result:=TDAMacroExpression.New(aName);
+end;
+
+class function TDAWhereClauseBuilder.NewMacro(const aName: string; const aValues: array of TDAExpression): TDAExpression;
+begin
+  Result:=TDAMacroExpression.New(aName); // ??
+end;
+
+class function TDAWhereClauseBuilder.NewBetweenExpression(aExpression, aLower, aUpper: TDAExpression): TDAExpression;
+begin
+  Result:=TDABetweenExpression.New(aExpression,aLower,aUpper);
+end;
+
+class function TDAWhereClauseBuilder.NewBetweenExpression(const aExprTableName, aExprFieldName: string; aLower,
+  aUpper: TDAExpression): TDAExpression;
+begin
+  Result:=NewBetweenExpression(NewField(aExprTableName,aExprFieldName),aLower,aUpper);
+end;
+
+class function TDAWhereClauseBuilder.NewBetweenExpression(const aExprTableName, aExprFieldName: string; aLowerValue,
+  aUpperValue: JSValue; aValuesDataType: TDADataType): TDAExpression;
+begin
+  Result:=NewBetweenExpression(NewField(aExprTableName,aExprFieldName),
+                               NewConstant(aLowerValue,aValuesDataType),
+                               NewConstant(aUpperValue,aValuesDataType));
+end;
+
+class function TDAWhereClauseBuilder.GetWhereClause(aExpression: TDAExpression): String;
+
+Var
+  DW : TDADynamicWhere;
+
+begin
+  DW:=TDADynamicWhere.New(aExpression);
+  try
+    Result:=dw.toXml
+  Finally
+    DW:=Nil;
+  end;
+end;
+
 { TDAConnection }
 { TDAConnection }
 
 
 
 
@@ -351,6 +536,7 @@ begin
     case LowerCase(s) of
     case LowerCase(s) of
      'widestring' : result:=ftString;
      'widestring' : result:=ftString;
      'currency' : result:=ftFloat;
      'currency' : result:=ftFloat;
+     'decimal' : result:=ftFloat;
      'smallint' : result:=ftInteger;
      'smallint' : result:=ftInteger;
     else
     else
       writeln('Unknown field type:',S)
       writeln('Unknown field type:',S)
@@ -394,15 +580,27 @@ begin
   TDADataProxy(Result).Connection:=DAConnection;
   TDADataProxy(Result).Connection:=DAConnection;
 end;
 end;
 
 
+function TDADataset.ParamByName(const aName: string): TParam;
+begin
+  Result:=FParams.ParamByname(aName);
+end;
+
+function TDADataset.FindParam(const aName: string): TParam;
+begin
+  Result:=FParams.FindParam(aName);
+end;
+
 constructor TDADataset.create(aOwner: TComponent);
 constructor TDADataset.create(aOwner: TComponent);
 begin
 begin
   inherited;
   inherited;
   DataProxy:=nil;
   DataProxy:=nil;
   FParams:=TParams.Create(Self);
   FParams:=TParams.Create(Self);
+  FWhereClauseBuilder:=TDAWhereClauseBuilder.Create;
 end;
 end;
 
 
 destructor TDADataset.Destroy;
 destructor TDADataset.Destroy;
 begin
 begin
+  FreeAndNil(FWhereClauseBuilder);
   FreeAndNil(FParams);
   FreeAndNil(FParams);
   Inherited;
   Inherited;
 end;
 end;
@@ -587,9 +785,10 @@ begin
   DT:=TDADataTable.New;
   DT:=TDADataTable.New;
   DT.name:=DADS.TableName;
   DT.name:=DADS.TableName;
   DStr.ReadDataset(DT);
   DStr.ReadDataset(DT);
-  Rows:=TJSArray.New;
+  // Writeln('Row count : ',Length(DT.rows));
+  Rows:=TJSArray.New(Length(DT.rows));
   for I:=0 to length(DT.rows)-1 do
   for I:=0 to length(DT.rows)-1 do
-     Rows.Push(DT.Rows[i].__newValues);
+     Rows[i]:=DT.Rows[i].__newValues;
   (Dataset as TDADataset).Metadata:=New(['fields',TJSArray(DT.Fields)]);
   (Dataset as TDADataset).Metadata:=New(['fields',TJSArray(DT.Fields)]);
   // Data:=aJSON['data'];
   // Data:=aJSON['data'];
   (Dataset as TDADataset).Rows:=Rows;
   (Dataset as TDADataset).Rows:=Rows;