unit XData.Web.DatasetCommon;

interface

uses
  DB,
  XData.Model.Classes;

procedure InitFieldDefsFromEntityType(Dataset: TDataset; EntityType: TXDataEntityType;
  SubPropsDepth: Integer);
procedure AddFieldDefsFromEntityType(Dataset: TDataset; SubPropsDepth: Integer; const APrefix: string;
  EntityType: TXDataEntityType; ADepth: Integer);
function XDataTypeToFieldType(AType: TXDataType; ALength: Integer;
  ForceAnsiString: boolean): TFieldType;

implementation

{$IFDEF PAS2JS}
const
  { Field types with a fixed size.  TField.Size = 0 for all of these }
  ftFixedSizeTypes = [ftInteger, ftBoolean, ftFloat,
    ftDate, ftTime, ftDateTime, ftAutoInc, ftLargeint];
{$ENDIF}

procedure InitFieldDefsFromEntityType(Dataset: TDataset; EntityType: TXDataEntityType; SubPropsDepth: Integer);
begin
  if EntityType = nil then
  begin
    Dataset.FieldDefs.Clear;
    Exit;
  end;

  AddFieldDefsFromEntityType(Dataset, SubPropsDepth, '', EntityType, 0);
end;

procedure AddFieldDefsFromEntityType(Dataset: TDataset; SubPropsDepth: Integer; const APrefix: string;
  EntityType: TXDataEntityType; ADepth: Integer);
var
  DataType: TFieldType;
  Len: integer;
  FieldDef: TFieldDef;
  NavProp: TXDataNavigationProperty;
  Prop: TXDataSimpleProperty;
  I: Integer;
begin
  for I := 0 to EntityType.NavigationProperties.Count - 1 do
  begin
    NavProp := EntityType.NavigationProperties[I];
    if NavProp.Target <> nil then
    begin
      if not NavProp.Target.IsCollection then
      begin
        FieldDef := Dataset.FieldDefs.AddFieldDef;
        FieldDef.Name := APrefix + NavProp.Name;
        FieldDef.DataType := ftVariant;
        FieldDef.Required := NavProp.Required and (ADepth = 0);

//        if not NavProp.CanWrite then
//          FieldDef.Attributes := FieldDef.Attributes + [TFieldAttribute.faReadonly];

        if ADepth < SubPropsDepth then
          AddFieldDefsFromEntityType(Dataset, SubPropsDepth, APrefix + NavProp.Name + '.', NavProp.Target, ADepth + 1);
      end else
      begin
        FieldDef := Dataset.FieldDefs.AddFieldDef;
        FieldDef.Name := APrefix + NavProp.Name;
        FieldDef.DataType := ftDataSet;
        FieldDef.Required := false;
        FieldDef.Attributes := FieldDef.Attributes + [TFieldAttribute.faReadonly];
      end;
    end;
  end;

  for I := 0 to EntityType.Properties.Count - 1 do
  begin
    Prop := EntityType.Properties[I];
    if Prop.PropertyType <> nil then
    begin
      Len := Prop.Length;
      DataType := XDataTypeToFieldType(Prop.PropertyType, Len, True);

      // Put a default value for field length. This should not be needed
      // as XData model should always return length for string types
      if (Len = 0) and (DataType in [ftString{$IFNDEF PAS2JS}, ftWideString{$ENDIF}]) then
        Len := 255;

      // Force guid fields to be size of 38 (required by Guid fields)
      {$IFNDEF PAS2JS}
      if DataType = ftGuid then
        Len := 38;
      {$ENDIF}

      FieldDef := Dataset.FieldDefs.AddFieldDef;
      FieldDef.Name := APrefix + Prop.Name;
      FieldDef.DataType := DataType;

      // Only set length for field types that need size. This avoids problems, for example, with enumerated types
      // enumerated field type will always be integer here (due to call to RttiTypeToFieldType above. But if the enumerated
      // is mapped in model as a string field, then Len will be not zero here (although datatype is ftInteger).
      // So we must keep Size 0 for integer fields otherwise an error will be raised by the dataset
      if not (FieldDef.DataType in ftFixedSizeTypes) then
        FieldDef.Size := Len;

      FieldDef.Required := Prop.Required;
//      FieldDef.Required := not (O.IsNullable or (DataType in [ftMemo, ftBlob, ftWideMemo]));
      FieldDef.Required := FieldDef.Required and (ADepth = 0);

      // Make read-only properties to become read-only fields. Except dynamic properties which are always writeable
//      if not Prop.CanWrite then
//        FieldDef.Attributes := FieldDef.Attributes + [TFieldAttribute.faReadonly];

//      if (C <> nil) and (TColumnProp.NoUpdate in C.Properties) then
//        FieldDef.Attributes := FieldDef.Attributes + [TFieldAttribute.faReadonly];
    end;
  end;
end;

function XDataTypeToFieldType(AType: TXDataType; ALength: Integer;
  ForceAnsiString: boolean): TFieldType;
var
  IsMemo: Boolean;
begin
  case AType.TypeKind of
    TXTypeKind.xtText:
      begin
        IsMemo := ALength > 65535; {arbitrary big number}
        if IsMemo then
        begin
          {$IFDEF PAS2JS}
          Result := TFieldType.ftMemo;
          {$ELSE}
          if ForceAnsiString then
            Result := TFieldType.ftMemo
          else
            Result := TFieldType.ftWideMemo;
          {$ENDIF}
        end
        else
        begin
          {$IFDEF PAS2JS}
          Result := TFieldType.ftString;
          {$ELSE}
          if ForceAnsiString then
            Result := TFieldType.ftString
          else
            Result := TFieldType.ftWideString;
          {$ENDIF}
        end;
      end;
    TXTypeKind.xtInt32:
      Result := ftInteger;
    TXTypeKind.xtInt64:
      Result := ftLargeInt;
    TXTypeKind.xtDouble:
      Result := ftFloat;
    TXTypeKind.xtBoolean:
      Result := ftBoolean;
    TXTypeKind.xtDateTime:
      Result := ftDateTime;
    TXTypeKind.xtDate:
      Result := ftDate;
    TXTypeKind.xtTime:
      Result := ftTime;
    TXTypeKind.xtCurrency:
      {$IFDEF PAS2JS}
      Result := ftFloat;
      {$ELSE}
      Result := ftCurrency;
      {$ENDIF}
    TXTypeKind.xtGuid:
      {$IFDEF PAS2JS}
      Result := ftString;
      {$ELSE}
      Result := ftGuid;
      {$ENDIF}
    TXTypeKind.xtVariant:
      Result := ftVariant;
    TXTypeKind.xtBinary:
      Result := ftBlob;
    TXTypeKind.xtStream:
      Result := ftBlob;
    TXTypeKind.xtInt16:
      {$IFDEF PAS2JS}
      Result := ftInteger;
      {$ELSE}
      Result := ftSmallInt;
      {$ENDIF}
    TXTypeKind.xtByte:
      {$IFDEF PAS2JS}
      Result := ftInteger;
      {$ELSE}
      Result := ftSmallInt;
      {$ENDIF}
    TXTypeKind.xtSByte:
      {$IFDEF PAS2JS}
      Result := ftInteger;
      {$ELSE}
      Result := ftSmallInt;
      {$ENDIF}
    TXTypeKind.xtEnum:
      Result := ftInteger;
  else
    Result := ftUnknown;
  end;
end;

end.
