mORMot Open Source

var
  uri: TUri;
begin
  if not uri.From(aUrl) then Exit;
  HttpGet(Format('%s://%s:%s/%s',[uri.Schema, uri.Server, uri.Port, UrlEncode(uri.Address)]));
end;

  // first class - to be referenced.
  TSQLRecordMaster=class(TSQLRecord)
  private
    fDummyName: RawUTF8;
  published
    property DummyName: RawUTF8 read fDummyName write fDummyName;
  end;

  // second class - references first one.
  TSQLRecordDetail=class(TSQLRecord)
  private
    fMaster: TSQLRecordMaster;
    fDummyName: RawUTF8;
  published
    property Master: TSQLRecordMaster read fMaster write fMaster;
    property DummyName: RawUTF8 read fDummyName write fDummyName;
  end;

function TDummyService.DetailGet(aMaster: TMaster; out aDetails: TDetails):
    Integer;
var
  qMaster: TSQLRecordMaster;
  qDetail: TSQLRecordDetail;
begin
  Result := 0;
  with TSQLRecordMaster.AutoFree(qMaster,fRest,'DummyName=?',
    [aMaster.MasterName]) do
    if qMaster.FillOne then
      with TSQLRecordDetail.AutoFree(qDetail,fRest,'Master=?',
        [qMaster]) do
        while qDetail.FillOne do           // always jump to the end
        begin
          SetLength(aDetails, Result+1);
          aDetails[Result].Master := aMaster;
          aDetails[Result].DetailName := qDetail.DummyName;
          Inc(Result);
        end;
end;

  TSQLRecordSomeEntity = class(TSQLRecord)
  protected
    fCaption: RawUTF8;
  published
    property Caption: RawUTF8 read fCaption write fCaption [b]stored AS_UNIQUE[/b];  // changed here
  end;

        // test update
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i, iText);
          Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
          Check(1 = cmd.GetCount);
          Check(cqrsSuccess = cmd.Get(entity));
          Check(iText = entity.Caption);
          iText := PreFix + iText;
          entity.Caption := iText;
          Check(cqrsSuccess = cmd.Update(entity));
        end;
        Check(cqrsSuccess = cmd.Commit);

        // check effect of update
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i, iText);
          iText := PreFix + iText;
          Check(cqrsSuccess = cmd.SelectOneByCaption(iText));   // error occurs here
          Check(1 = cmd.GetCount);
          Check(cqrsSuccess = cmd.Get(entity));
          Check(iText = entity.Caption);
        end;

unit DDDPersistenceMain;

interface

uses
  Classes, SysUtils,
  SynCommons, mORMot, mORMotDDD,
  SynTests;

type
  TSomeEntity = class(TSynPersistent)
  protected
    fCaption: RawUTF8;
  published
    property Caption: RawUTF8 read fCaption write fCaption;
  end;

  TSomeEntityObjArray = array of TSomeEntity;

  TSQLRecordSomeEntity = class(TSQLRecord)
  protected
    fCaption: RawUTF8;
  published
    property Caption: RawUTF8 read fCaption write fCaption stored AS_UNIQUE;
  end;

  IDomEntityQuery = interface(ICQRSService)
    ['{74EA5045-2062-47D0-AE0F-E9163BBC731B}']
    function SelectOneByCaption(const aCaption: RawUTF8): TCQRSResult;
    function SelectAllByCaption(const aCaption: RawUTF8): TCQRSResult;
    function SelectAll: TCQRSResult;
    function Get(out aAggregate: TSomeEntity): TCQRSResult;
    function GetAll(out aAggretates: TSomeEntityObjArray): TCQRSResult;
    function GetNext(out aAggregate: TSomeEntity): TCQRSResult;
    function GetCount: Integer;
  end;

  IDomEntityCommand = interface(IDomEntityQuery)
    ['{FEC02E2A-A76F-4CDD-B378-E4E1EA6043F9}']
    function Add(const aAggregate: TSomeEntity): TCQRSResult;
    function Update(const aUpdatedAggregate: TSomeEntity): TCQRSResult;
    function Delete: TCQRSResult;
    function DeleteAll: TCQRSResult;
    function Commit: TCQRSResult;
    function Rollback: TCQRSResult;
  end;

  TInfraRepoEntity = class(TDDDRepositoryRestCommand, IDomEntityCommand, IDomEntityQuery)
  public
    function SelectOneByCaption(const aCaption: RawUTF8): TCQRSResult;
    function SelectAllByCaption(const aCaption: RawUTF8): TCQRSResult;
    function SelectAll: TCQRSResult;
    function Get(out aAggregate: TSomeEntity): TCQRSResult;
    function GetAll(out aAggregates: TSomeEntityObjArray): TCQRSResult;
    function GetNext(out aAggregate: TSomeEntity): TCQRSResult;
    function Add(const aAggregate: TSomeEntity): TCQRSResult;
    function Update(const aUpdatedAggregate: TSomeEntity): TCQRSResult;
  end;

  TInfraRepoEntityFactory = class(TDDDRepositoryRestFactory)
  public
    constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce;
    class procedure RegressionTests(test: TSynTestCase);
  end;

  TTestRepoEntity = class(TSynTestCase)
  published
    procedure TestSelf;
  end;

  TTestSuit = class(TSynTests)
  published
    procedure TestAll;
  end;

  procedure RunTestProject;

implementation

procedure RunTestProject;
begin
  with TTestSuit.Create() do
  try
    Run;
    ReadLn;
  finally
    Free;
  end;
end;

{ TInfraRepoEntity }

function TInfraRepoEntity.Add(const aAggregate: TSomeEntity): TCQRSResult;
begin
  Result := ORMAdd(aAggregate);
end;

function TInfraRepoEntity.Get(out aAggregate: TSomeEntity): TCQRSResult;
begin
  Result := ORMGetAggregate(aAggregate);
end;

function TInfraRepoEntity.GetAll(out aAggregates: TSomeEntityObjArray): TCQRSResult;
begin
  Result := ORMGetAllAggregates(aAggregates);
end;

function TInfraRepoEntity.GetNext(out aAggregate: TSomeEntity): TCQRSResult;
begin
  Result := ORMGetNextAggregate(aAggregate);
end;

function TInfraRepoEntity.SelectAll: TCQRSResult;
begin
  Result := ORMSelectAll('', []);
end;

function TInfraRepoEntity.SelectAllByCaption(const aCaption: RawUTF8): TCQRSResult;
begin
  Result := ORMSelectAll('Caption=?', [aCaption], (''=aCaption));
end;

function TInfraRepoEntity.SelectOneByCaption(
  const aCaption: RawUTF8): TCQRSResult;
begin
  Result := ORMSelectOne('Caption=?', [aCaption], (''=aCaption));
end;

function TInfraRepoEntity.Update(
  const aUpdatedAggregate: TSomeEntity): TCQRSResult;
begin
  Result := ORMUpdate(aUpdatedAggregate);
end;

{ TInfraRepoEntityFactory }

constructor TInfraRepoEntityFactory.Create(aRest: TSQLRest;
  aOwner: TDDDRepositoryRestManager);
begin
  inherited Create(IDomEntityCommand,TInfraRepoEntity,TSomeEntity,aRest,TSQLRecordSomeEntity,aOwner);
  AddFilterOrValidate(['*'], TSynFilterTrim.Create);
  AddFilterOrValidate(['Caption'],TSynValidateNonVoidText.Create);
end;

class procedure TInfraRepoEntityFactory.RegressionTests(test: TSynTestCase);
  procedure TestOne(Rest: TSQLRest);
  const
    PreFix = 'Modified';
    MAX = 1000;
  var
    cmd: IDomEntityCommand;
    qry: IDomEntityQuery;
    entity: TSomeEntity;
    entitys: TSomeEntityObjArray;
    i,entityCount: Integer;
    iText: RawUTF8;
  begin
    with test do
    begin
      entity := TSomeEntity.Create;
      Check(Rest.Services.Resolve(IDomEntityCommand, cmd));
      try
        // test Add
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i,iText);
          entity.Caption := '  ' + iText;
          Check(cqrsSuccess = cmd.Add(entity));
        end;
        Check(cqrsSuccess = cmd.Commit);

        // test select
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i, iText);
          // testing SelectAllByCaption
          Check(cqrsSuccess = cmd.SelectAllByCaption(iText));
          Check(1 = cmd.GetCount);
          Check(cqrsSuccess = cmd.GetNext(entity));
          Check(iText = entity.Caption);
          // testing SelectOneByCaption
          Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
          Check(1 = cmd.GetCount);
          Check(cqrsSuccess = cmd.Get(entity));
          Check(iText = entity.Caption);
        end;

        // test update
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i, iText);
          Check(cqrsSuccess = cmd.SelectOneByCaption(iText));
          Check(1 = cmd.GetCount);
          Check(cqrsSuccess = cmd.Get(entity));
          Check(iText = entity.Caption);
          iText := PreFix + iText;
          entity.Caption := iText;
          Check(cqrsSuccess = cmd.Update(entity));
        end;
        Check(cqrsSuccess = cmd.Commit);

        // check effect of update
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i, iText);
          iText := PreFix + iText;
          Check(cqrsSuccess = cmd.SelectOneByCaption(iText));   // error occurs here
          Check(1 = cmd.GetCount);
          Check(cqrsSuccess = cmd.Get(entity));
          Check(iText = entity.Caption);
        end;

        // test delete
        Check(cqrsSuccess = cmd.SelectAll);
        Check(cqrsSuccess = cmd.DeleteAll);
        Check(cqrsSuccess = cmd.Commit);
        Check(cqrsSuccess = cmd.SelectAll);
        Check(0 = cmd.GetCount);
      finally
        entity.Free;
      end;
    end;
  end;
var
  RestServer: TSQLRestServerFullMemory;
  RestClient: TSQLRestClientURI;
begin
  RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordSomeEntity]);
  try // first try directly on server side
    RestServer.ServiceContainer.InjectResolver([TInfraRepoEntityFactory.Create(RestServer)],true);
    TestOne(RestServer); // sub function will ensure that all I*Command are released
  finally
    RestServer.Free;
  end;
  RestServer := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordSomeEntity]);
  try // then try from a client-server process
    RestServer.ServiceContainer.InjectResolver([TInfraRepoEntityFactory.Create(RestServer)],true);
    RestServer.ServiceDefine(TInfraRepoEntity,[IDomEntityCommand,IDomEntityQuery],sicClientDriven);
    test.Check(RestServer.ExportServer);
    RestClient := TSQLRestClientURIDll.Create(TSQLModel.Create(RestServer.Model),@URIRequest);
    try
      RestClient.Model.Owner := RestClient;
      RestClient.ServiceDefine([IDomEntityCommand],sicClientDriven);
      TestOne(RestServer);
      RestServer.DropDatabase;
      USEFASTMM4ALLOC := true; // for slightly faster process
      TestOne(RestClient);
    finally
      RestClient.Free;
    end;
  finally
    RestServer.Free;
  end;
end;

{ TTestRepoEntity }

procedure TTestRepoEntity.TestSelf;
begin
  TInfraRepoEntityFactory.RegressionTests(Self);
end;

{ TTestSuit }

procedure TTestSuit.TestAll;
begin
  AddCase([TTestRepoEntity]);
end;

initialization
  TJSONSerializer.RegisterObjArrayForJSON([
    TypeInfo(TSomeEntityObjArray), TSomeEntity]);

  TInterfaceFactory.RegisterInterfaces([
    TypeInfo(IDomEntityQuery), TypeInfo(IDomEntityCommand)]);
end.