xtool/contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/uian2000/DDDPersistence/DDDPersistenceMain.pas

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;
  end;

  IDomEntityQuery = interface(ICQRSService)
    ['{74EA5045-2062-47D0-AE0F-E9163BBC731B}']
    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 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 GetCount: Integer;
    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;

  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.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
    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
        for i := 1 to MAX do
        begin
          UInt32ToUtf8(i,iText);
          entity.Caption := '  ' + iText;
          Check(cqrsSuccess = cmd.Add(entity));
        end;
        Check(cqrsSuccess = cmd.Commit);

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

        Check(cqrsSuccess = cmd.SelectAllByCaption('1'));
        Check(1 = cmd.GetCount);
        Check(cqrsSuccess = cmd.GetNext(entity));
        entity.Caption := 'hello';
        Check(cqrsSuccess = cmd.Update(entity));
        Check(cqrsSuccess = cmd.Commit);
      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.