unit uDAMemDataTable;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  Classes,DB, uDAInterfaces,
  uDADataTable, uDAMemDataset;

type
  TDAMemDataset = class(TDAMemoryDataset, IDADataTableDataset)
  private
    FDeletedRecordsList: TStringList;
    FLogDeletedRecords: Boolean;
    procedure ClearDeletedRecords;
  protected
    function GetDataTable: TDADataTable; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure InternalRefresh; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    function GetStateFieldValue(State: TDataSetState;Field: TField): Variant; {$IFNDEF FPC}override;{$ENDIF}
    procedure InternalDelete; override;
    procedure InternalInsert; override;
    procedure InternalPost; override;
    procedure InternalClose; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
  end;

  TDAMemDataTable = class(TDADataTable,IDAMemDatasetBatchAdding,IDARangeController)
  private
    fMemDataset: TDAMemDataset;
    fWasReadonly: Boolean;
    function GetIndexDefs: TIndexDefs;
    function GetIndexName: string;
    procedure SetIndexDefs(const Value: TIndexDefs);
    procedure SetIndexName(const Value: string);
    function GetIndexFieldNames: string;
    procedure SetIndexFieldNames(const Value: string);
    function GetAutoCompactRecords: boolean;
    procedure SetAutoPackRecords(const Value: boolean);
  protected
    // IDAMemDatasetBatchAdding
    function AllocRecordBuffer: PAnsiChar;
    procedure FreeRecordBuffer(var Buffer: PAnsiChar);
    function GetFieldNativeBuffer(Buffer: PAnsiChar; Field: TField): Pointer;
    function MakeBlobFromString(Blob:AnsiString):pointer;
    procedure SetNullMask(Buffer: PAnsiChar; Field: TField; const Value: boolean);
    procedure SetAnsiString(NativeBuf: Pointer; Field: TField; const Value: Ansistring);
    procedure SetWideString(NativeBuf: Pointer; Field: TField; const Value: Widestring);
    procedure AddRecordsfromList(AList: TList);
  protected
    function GetDatasetClass: TDatasetClass; override;
    procedure CreateInternalFields(aDataset: TDataset; someFieldDefinitions: TDAFieldCollection); override;
    //    procedure DoAfterCloseDataset; override;
    procedure DoSort(const FieldNames: array of string; const Directions: array of TDASortDirection); override;

    procedure SetMasterSource(const Value: TDADataSource); override;
    function GetMasterSource: TDADataSource; override;
    procedure SetDetailsFields(const Value: string); override;
    procedure SetMasterFields(const Value: string); override;
    function GetDetailFields: string; override;
    function GetMasterFields: string; override;

    function GetFilter: string; override;
    function GetFiltered: boolean; override;
    procedure SetFilter(const Value: string); override;
    procedure SetFiltered(const Value: boolean); override;
    function GetReadOnly: boolean; override;
    procedure SetReadOnly(const Value: boolean); override;
  public
    constructor Create(aOwner: TComponent); override;
    procedure EnableConstraints; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure DisableConstraints; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure CloneCursor(Source: TDADataTable); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  { IDARangeController }
    procedure ApplyRange; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure CancelRange; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetRange(const StartValues, EndValues: array of const); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure EditRangeEnd; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure EditRangeStart; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetRangeEnd; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetRangeStart; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    //
    procedure SetKey;
    procedure EditKey;
    function FindKey(const KeyValues: array of const): Boolean;
    procedure FindNearest(const KeyValues: array of const);
    function GotoKey: Boolean;
    procedure GotoNearest;
    function LocateByIndex(const aIndexName: string; const KeyValues: Variant): Boolean;
    function LookupByIndex(const aIndexName: string; const KeyValues: Variant; const ResultFields: string): Variant;
    procedure PrepareIndexForSorting(const aIndexName: string = '');
  published
    property IndexDefs: TIndexDefs read GetIndexDefs write SetIndexDefs;
    property IndexName: string read GetIndexName write SetIndexName;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property AutoCompactRecords: boolean read GetAutoCompactRecords write SetAutoPackRecords default False;
  end;


implementation

uses SysUtils;

{ TDAMemDataset }


procedure TDAMemDataset.ClearDeletedRecords;
var
  buf: Dataset_PAnsiChar;
begin
  while FDeletedRecordsList.Count <> 0 do begin
    buf := Pointer(FDeletedRecordsList.Objects[FDeletedRecordsList.Count-1]);
    FreeRecordBuffer(Buf);
    FDeletedRecordsList.Delete(FDeletedRecordsList.Count-1);
  end;
end;

constructor TDAMemDataset.Create(AOwner: TComponent);
begin
  inherited;
  FDeletedRecordsList := TStringList.Create;
  FLogDeletedRecords := True;
end;

destructor TDAMemDataset.Destroy;
begin
  inherited;
  ClearDeletedRecords;
  FDeletedRecordsList.Free;
end;

function TDAMemDataset.GetDataTable: TDADataTable;
begin
  result := TDADataTable(Owner);
end;

function TDAMemDataset.GetStateFieldValue(State: TDataSetState;
  Field: TField): Variant;
begin
  if (State = dsOldValue) and (Self.State in [dsEdit, dsInsert]) then
    Result := TDAMemDataTable(GetDataTable).fOldValues[Field.Index]
  else
   {$IFNDEF FPC} result := Inherited GetStateFieldValue(State, Field){$ENDIF};
end;

procedure TDAMemDataset.InternalClose;
begin
  ClearDeletedRecords;
  inherited;
end;

procedure TDAMemDataset.InternalDelete;
var
  buf: pointer;
begin
  if FLogDeletedRecords and (GetDataTable.LogChanges) then begin
    buf := CreateMemDatasetRecord(mrEmpty,0,True);
    RecordToBuffer(CurrentRecord, buf);
    FDeletedRecordsList.AddObject(Self.Fields[0].AsString, buf);
  end;
  inherited;
end;

procedure TDAMemDataset.InternalInitFieldDefs;
begin
  inherited;
end;

procedure TDAMemDataset.InternalInsert;
var
  fCurRec: String;
  i: integer;
  buf1: Pointer;
begin
  if FLogDeletedRecords then begin
     fCurRec := IntToStr(GetDataTable.CurrRecId);
     i := FDeletedRecordsList.IndexOf(fCurRec);
     if i <> -1  then begin
       buf1:=ActiveBuffer;
       DuplicateBuffer(Pointer(FDeletedRecordsList.Objects[i]), buf1, True);
     end;
  end;
  inherited;
end;

procedure TDAMemDataset.InternalOpen;
begin
  inherited;
end;

procedure TDAMemDataset.InternalPost;
var
  i: integer;
  buf: Dataset_PAnsiChar;
begin
  inherited;
  if FLogDeletedRecords and (State = dsInsert) then begin
     i := FDeletedRecordsList.IndexOf(Fields[0].AsString);
     if i <> -1  then begin
       buf := pointer(FDeletedRecordsList.Objects[i]);
       FreeRecordBuffer(buf);
       FDeletedRecordsList.Delete(i);
     end;
  end;
end;

procedure TDAMemDataset.InternalRefresh;
begin
  inherited;
end;

{ TDAMemDataTable }


procedure TDAMemDataTable.AddRecordsfromList(AList: TList);
var
  i: integer;
  Buffer: PAnsiChar;
  FRecIDOffset: Cardinal;
begin
  FRecIDOffset := fMemDataset.GetBin2FieldOffset(0);
  // setup RecID
  For i:=0 to AList.Count-1 do begin
    buffer:=AList[i];
    PCardinal(PMemDatasetrecord_Native(Buffer)^.Data+FRecIDOffset)^:=CurrRecId;
    fMemDataset.SetNullMask(PMemDatasetrecord_Native(Buffer)^.Data,0,False);  //RECID
    CurrRecId:=CurrRecId+1;
  end;
  fMemDataset.AddRecordsfromList(AList);
  fMemDataset.ProcessFilter;
end;

function TDAMemDataTable.AllocRecordBuffer: PAnsiChar;
begin
  Result:= Pointer(fMemDataset.CreateMemDatasetRecord(mrBin2Style,0,False));
end;

procedure TDAMemDataTable.ApplyRange;
begin
  fMemDataset.ApplyRange;
end;

procedure TDAMemDataTable.CancelRange;
begin
  fMemDataset.CancelRange;
end;

procedure TDAMemDataTable.CloneCursor(Source: TDADataTable);
begin
  if Source = nil then Exception.Create('CloneCursor. Source should be specified.');
  if not (Source is TDAMemDataTable) then Exception.Create('Can''t clone cursor from ' + Source.ClassName);

  if Active then raise Exception.Create('Datatable is already open');

  try
    fCloneSource := Source;

    Fields.Clear;
    Fields.Assign(Source.Fields);

    // Proceeds
    fMemDataset.CloneCursor(Source.Dataset as TDAMemDataset, False);

    RecIDField := fMemDataset.FieldByName(RecIDFieldName) as TIntegerField;
    RecIDField.Visible := FALSE;

    Fields.Bind(fMemDataset);

    // Prepares the delta
    Delta := Source.Delta;

    // Finishes to prepare the internal dataset (descendant might need additional customization and might not be open)
    DoBeforeOpenDataset;
    if not Dataset.Active then Dataset.Open;
    DoAfterOpenDataset;
  except
    // Restores the previous state
    fCloneSource := NIL;
    Delta := NIL;

    raise;
  end;
end;

constructor TDAMemDataTable.Create(aOwner: TComponent);
begin
  inherited;
  fMemDataset := TDAMemDataset(Dataset);
end;

procedure TDAMemDataTable.CreateInternalFields(aDataset: TDataset;
  someFieldDefinitions: TDAFieldCollection);
begin
  inherited;
  fMemDataset.Open;
end;

procedure TDAMemDataTable.DisableConstraints;
begin
  fWasReadonly := ReadOnly;
  ReadOnly := False;
//  fMemDataset.DisableConstraints;
end;

procedure TDAMemDataTable.DoSort(const FieldNames: array of string;
  const Directions: array of TDASortDirection);
var
  i: integer;
  s,s1: string;
begin
  if Length(FieldNames) <> Length(Directions) then DatabaseError('Can''t perform sorting: FieldNames and Directions should have same dimension.');
  s := '';
  s1:='';
  for i := Low(FieldNames) to High(FieldNames) do begin
    s := s + FieldNames[i] + ';';
    if Directions[i] = sdDescending then
      s1 :=  s1 + FieldNames[i] + ';';
  end;
  fMemDataset.SortOnFields(s,'',s1);
end;

procedure TDAMemDataTable.EditKey;
begin
  fMemDataset.EditKey;
end;

procedure TDAMemDataTable.EditRangeEnd;
begin
  fMemDataset.EditRangeEnd;
end;

procedure TDAMemDataTable.EditRangeStart;
begin
  fMemDataset.EditRangeStart;
end;

procedure TDAMemDataTable.EnableConstraints;
begin
  //fMemDataset.EnableConstraints;
  ReadOnly := fWasReadonly;
end;

function TDAMemDataTable.FindKey(const KeyValues: array of const): Boolean;
begin
  Result := fMemDataset.FindKey(KeyValues);
end;

procedure TDAMemDataTable.FindNearest(const KeyValues: array of const);
begin
  fMemDataset.FindNearest(KeyValues);
end;

procedure TDAMemDataTable.FreeRecordBuffer(var Buffer: PAnsiChar);
begin
  fMemDataset.FreeMemDatasetRecord(PMemDatasetrecord_Native(Buffer));
  Buffer := nil;
end;

function TDAMemDataTable.GetAutoCompactRecords: boolean;
begin
  Result := fMemDataset.AutoCompactRecords;
end;

function TDAMemDataTable.GetDatasetClass: TDatasetClass;
begin
  Result := TDAMemDataset;
end;

function TDAMemDataTable.GetDetailFields: string;
begin
  result := fMemDataset.DetailFields;
end;

function TDAMemDataTable.GetFieldNativeBuffer(Buffer: PAnsiChar;
  Field: TField): Pointer;
begin
  Result:= fMemDataset.IntFindFieldData(PMemDatasetrecord_Native(Buffer)^.Data, Field, True);
end;

function TDAMemDataTable.GetFilter: string;
begin
  Result := fMemDataset.Filter;
end;

function TDAMemDataTable.GetFiltered: boolean;
begin
  Result := fMemDataset.Filtered;
end;

function TDAMemDataTable.GetIndexDefs: TIndexDefs;
begin
  result := fMemDataset.IndexDefs;
end;

function TDAMemDataTable.GetIndexFieldNames: string;
begin
  Result := fMemDataset.IndexFieldNames;
end;

function TDAMemDataTable.GetIndexName: string;
begin
  result := fMemDataset.IndexName;
end;

function TDAMemDataTable.GetMasterFields: string;
begin
  result := fMemDataset.MasterFields
end;

function TDAMemDataTable.GetMasterSource: TDADataSource;
begin
  result := TDADataSource(fMemDataset.DataSource);
end;

function TDAMemDataTable.GetReadOnly: boolean;
begin
  Result := fMemDataset.ReadOnly;
end;

function TDAMemDataTable.GotoKey: Boolean;
begin
  Result := fMemDataset.GotoKey;
end;

procedure TDAMemDataTable.GotoNearest;
begin
  fMemDataset.GotoNearest;
end;

function TDAMemDataTable.LocateByIndex(const aIndexName: string;
  const KeyValues: Variant): Boolean;
begin
  Result:= fMemDataset.LocateByIndex(aIndexName,KeyValues);
end;

function TDAMemDataTable.LookupByIndex(const aIndexName: string;
  const KeyValues: Variant; const ResultFields: string): Variant;
begin
  Result:= fMemDataset.LookupByIndex(aIndexName,KeyValues,ResultFields);
end;

function TDAMemDataTable.MakeBlobFromString(Blob: AnsiString): pointer;
begin
  Result:= fMemDataset.MakeBlobFromString(Blob);
end;

procedure TDAMemDataTable.PrepareIndexForSorting(const aIndexName: string);
begin
  fMemDataset.PrepareIndexForSorting(aIndexName);
end;

procedure TDAMemDataTable.SetAnsiString(NativeBuf: Pointer; Field: TField;
  const Value: Ansistring);
begin
  fMemDataset.SetAnsiString(NativeBuf,Field, Value);
end;

procedure TDAMemDataTable.SetAutoPackRecords(const Value: boolean);
begin
  fMemDataset.AutoCompactRecords := Value;
end;

procedure TDAMemDataTable.SetDetailsFields(const Value: string);
begin
  fMemDataset.DetailFields := Value
end;

procedure TDAMemDataTable.SetFilter(const Value: string);
begin
  fMemDataset.Filter := Value;
end;

procedure TDAMemDataTable.SetFiltered(const Value: boolean);
begin
  fMemDataset.Filtered := Value;
end;

procedure TDAMemDataTable.SetIndexDefs(const Value: TIndexDefs);
begin
  fMemDataset.IndexDefs.Assign(Value);
end;

procedure TDAMemDataTable.SetIndexFieldNames(const Value: string);
begin
  fMemDataset.IndexFieldNames := Value;
end;

procedure TDAMemDataTable.SetIndexName(const Value: string);
begin
  fMemDataset.IndexName:=Value;
end;

procedure TDAMemDataTable.SetKey;
begin
  fMemDataset.SetKey;
end;

procedure TDAMemDataTable.SetMasterFields(const Value: string);
begin
  inherited;
  fMemDataset.MasterFields := Value
end;

procedure TDAMemDataTable.SetMasterSource(const Value: TDADataSource);
begin
  fMemDataset.MasterSource := Value;
  inherited;
end;

procedure TDAMemDataTable.SetNullMask(Buffer: PAnsiChar; Field: TField;
  const Value: boolean);
begin
  fMemDataset.SetNullMask(Dataset_PAnsiChar(Buffer),Field.Index,Value);
end;

procedure TDAMemDataTable.SetRange(const StartValues,
  EndValues: array of const);
begin
  fMemDataset.SetRange(StartValues, EndValues);
end;

procedure TDAMemDataTable.SetRangeEnd;
begin
  fMemDataset.SetRangeEnd;
end;

procedure TDAMemDataTable.SetRangeStart;
begin
  fMemDataset.SetRangeStart;
end;

procedure TDAMemDataTable.SetReadOnly(const Value: boolean);
begin
  fMemDataset.ReadOnly := Value;
end;

procedure TDAMemDataTable.SetWideString(NativeBuf: Pointer; Field: TField;
  const Value: Widestring);
begin
  fMemDataset.SetWideString(NativeBuf, Field, Value);
end;

end.