Tim

Would like to peek at Pool Code too - thanks.

Walter

Mario

<< I would really appreciated if you could share the thread safe code / pooling that you mention.  >>

Sure, here you go:

  TObjectArray = array of TObject;

  TObjectStack = class(TObject)
     private
        FOwnsObjects: Boolean;
        FCount: Integer;
        FCapacity: Integer;
        FObjects: TObjectArray;
        procedure FreeObjects;
        procedure SetCapacity(Value: Integer);
     protected
        function GetExpandCount: Integer; virtual;
     public
        constructor Create(OwnsObjects: Boolean=True); virtual;
        destructor Destroy; override;
        property Count: Integer read FCount;
        procedure Clear;
        procedure Push(Value: TObject); overload;
        procedure Push(Value: TObjectArray); overload;
        function Peek: TObject;
        function Pop: TObject;
     end;   

  TDataModulePool = class(TObject)
     private
        FSection: TCriticalSection;
        FStack: TObjectStack;
        function GetCount: Integer;
     protected
        function CreateDataModule: TDataModule; virtual;
        procedure Lock;
        procedure Unlock;
     public
        constructor Create; virtual;
        destructor Destroy; override;
        property Count: Integer read GetCount;
        procedure Put(Value: TDataModule);
        function Get: TDataModule;
        procedure Clear;
     end;

implementation

const
  STACK_EXPAND_COUNT = 128;

function BlockOffset(Value: Integer; BlockSize: Integer): Integer;
begin
  Result:=Value;
  if ((Result mod BlockSize) <> 0) then
     Result:=((BlockSize*(Result div BlockSize))+BlockSize);
end;

{ TObjectStack }

constructor TObjectStack.Create(OwnsObjects: Boolean=True);
begin
  inherited Create;
  FOwnsObjects:=OwnsObjects;
end;

destructor TObjectStack.Destroy;
begin
  FreeObjects;
  inherited Destroy;
end;

procedure TObjectStack.FreeObjects;
var
  I: Integer;
begin
  if FOwnsObjects then
     begin
     for I:=FCount-1 downto 0 do
        FreeAndNil(FObjects[I]);
     end;
  FCount:=0;
end;

function TObjectStack.GetExpandCount: Integer;
begin
  Result:=STACK_EXPAND_COUNT
end;

procedure TObjectStack.SetCapacity(Value: Integer);
begin
  Value:=BlockOffset(Value,GetExpandCount);
  if (Value > FCapacity) then
     begin
     SetLength(FObjects,Value);
     FCapacity:=Value;
     end;
end;

procedure TObjectStack.Clear;
begin
  FreeObjects;
end;

procedure TObjectStack.Push(Value: TObject);
begin
  Inc(FCount);
  SetCapacity(FCount);
  FObjects[FCount-1]:=Value;
end;

procedure TObjectStack.Push(Value: TObjectArray);
var
  TempCount: Integer;
begin
  TempCount:=FCount;
  Inc(FCount,Length(Value));
  SetCapacity(FCount);
  Move(Value[0],FObjects[TempCount],SizeOf(TObject)*Length(Value));
end;

function TObjectStack.Peek: TObject;
begin
  Result:=nil;
  if (FCount > 0) then
     Result:=FObjects[FCount-1];
end;

function TObjectStack.Pop: TObject;
begin
  Result:=nil;
  if (FCount > 0) then
     begin
     Result:=FObjects[FCount-1];
     FObjects[FCount-1]:=nil;
     Dec(FCount);
     end;
end;

{ TDataModulePool }

constructor TDataModulePool.Create;
begin
  inherited Create;
  FSection:=TCriticalSection.Create;
  FStack:=TObjectStack.Create;
end;

destructor TDataModulePool.Destroy;
begin
  Clear;
  FreeAndNil(FStack);
  FreeAndNil(FSection);
  inherited Destroy;
end;

function TDataModulePool.CreateDataModule: TDataModule;
begin
  Result:=TDataModule.Create(Self);
end;

procedure TDataModulePool.Lock;
begin
  FSection.Enter;
end;

procedure TDataModulePool.Unlock;
begin
  FSection.Leave;
end;

procedure TDataModulePool.Clear;
var
  TempDataModule: TDataModule;
begin
  Lock;
  try
     while (FStack.Count > 0) do
        begin
        TempDataModule:=TDataModule(FStack.Pop);
        FreeAndNil(TempDataModule);
        end;
  finally
     Unlock;
  end;
end;

function TDataModulePool.GetCount: Integer;
begin
  Lock;
  try
     Result:=FStack.Count;
  finally
     Unlock;
  end;
end;

procedure TDataModulePool.Put(Value: TDataModule);
begin
  if Assigned(Value) then
     begin
     Lock;
     try
        FStack.Push(Value);
     finally
        Unlock;
     end;
     end;
end;

function TDataModulePool.Get: TDataModule;
begin
  Lock;
  try
     Result:=TDataModule(FStack.Pop);
     if (Result=nil) then
        Result:=CreateDataModule;
  finally
     Unlock;
  end;
end;

The key thing to remember, however, is that this is going to dish out data modules that have already been created/used, so you might want to make it more specific to your data module instance and add some "Initialize"/"Reset" methods that automatically get called so that the data module instances can handle resetting their contents to the desired level in-between usages.

Tim Young
Elevate Software
www.elevatesoft.com

Cool Tim, Thanks for this! Am looking at REST/JSON soon myself and will check this out at that point.

Thank you very much Tim, I'm sure this code snippet would prove very valuable to me!

Regards,
Mario

Mario Enríquez wrote:

>>Secondly, you mention something about  the database access calls but I didn't find it

See the unit mORMot_ServerMethods. In that look at functions LoginAdmin and LogoffAdmin.
You will read my comments which indicate the point at which to call any database functionality.

I do not use one DataModule per interface call. I use one DataModule for all interface calls. I have a three figure number of interfaces. Having that many DataModules would be a nightmare.

My sample code has been helpful to people transitioning from DataSnap to mORMot.