diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas
index e6c9f459c..7223cb62d 100644
--- a/sources/MVCFramework.ActiveRecord.pas
+++ b/sources/MVCFramework.ActiveRecord.pas
@@ -231,6 +231,10 @@ TMVCActiveRecord = class
constructor Create; overload; virtual;
destructor Destroy; override;
procedure EnsureConnection;
+ ///
+ /// Executes an Insert or an Update if primary key is defined or not
+ ///
+ procedure Store;
function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean;
procedure Insert;
function GetMapping: TMVCFieldsMapping;
@@ -241,6 +245,7 @@ TMVCActiveRecord = class
procedure LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions = []);
procedure SetPK(const aValue: TValue);
function GetPK: TValue;
+ function TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
[MVCDoNotSerialize]
property PrimaryKeyIsAutogenerated: Boolean read GetPrimaryKeyIsAutogenerated write SetPrimaryKeyIsAutogenerated;
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
@@ -1100,26 +1105,15 @@ class function TMVCActiveRecordHelper.GetOneByWhere(const SQLWhere: string; c
end;
function TMVCActiveRecord.GetPK: TValue;
+var
+ lIsNullableType: Boolean;
begin
- if fPrimaryKeyFieldName.IsEmpty then
- raise Exception.Create('No primary key defined');
- Result := fPrimaryKey.GetValue(Self);
- if Result.Kind = tkRecord then
- begin
- if Result.IsType() then
- Result := Result.AsType().Value
- else if Result.IsType() then
- Result := Result.AsType().Value
- else if Result.IsType() then
- Result := Result.AsType().Value
- else if Result.IsType() then
- Result := Result.AsType().Value
- else if Result.IsType() then
- Result := Result.AsType().Value
- else if Result.IsType() then
- Result := Result.AsType().Value
- else
- raise EMVCActiveRecord.Create('Invalid primary key type');
+ if not TryGetPKValue(Result, lIsNullableType) then
+ begin
+ if not lIsNullableType then
+ begin
+ raise EMVCActiveRecord.Create('Primary key not available');
+ end;
end;
end;
@@ -2280,6 +2274,27 @@ function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
Result := fSQLGenerator;
end;
+procedure TMVCActiveRecord.Store;
+var
+ lValue: TValue;
+ lRes: Boolean;
+ lIsNullableType: Boolean;
+begin
+ lRes := TryGetPKValue(lValue, lIsNullableType);
+ if not lIsNullableType then
+ begin
+ raise EMVCActiveRecord.Create('Store can be used only with nullable PKs [HINT] Use NullableInt64 as PK');
+ end;
+ if lRes then
+ begin
+ Update;
+ end
+ else
+ begin
+ Insert;
+ end;
+end;
+
function TMVCActiveRecord.TableInfo: string;
var
keyvalue: TPair;
@@ -2289,6 +2304,60 @@ function TMVCActiveRecord.TableInfo: string;
Result := Result + sLineBreak + #9 + keyvalue.Key.Name + ' = ' + keyvalue.Value;
end;
+function TMVCActiveRecord.TryGetPKValue(var Value: TValue; out IsNullableType: Boolean): Boolean;
+begin
+ IsNullableType := false;
+ if fPrimaryKeyFieldName.IsEmpty then
+ raise Exception.Create('No primary key defined');
+ Value := fPrimaryKey.GetValue(Self);
+ if Value.Kind = tkRecord then
+ begin
+ if Value.IsType() then
+ begin
+ Result := Value.AsType().HasValue;
+ if Result then
+ Value := Value.AsType().Value;
+ end
+ else if Value.IsType() then
+ begin
+ Result := Value.AsType().HasValue;
+ if Result then
+ Value := Value.AsType().Value;
+ end
+ else if Value.IsType() then
+ begin
+ Result := Value.AsType().HasValue;
+ if Result then
+ Value := Value.AsType().Value;
+ end
+ else if Value.IsType() then
+ begin
+ Result := Value.AsType().HasValue;
+ if Result then
+ Value := Value.AsType().Value;
+ end
+ else if Value.IsType() then
+ begin
+ Result := Value.AsType().HasValue;
+ if Result then
+ Value := Value.AsType().Value;
+ end
+ else if Value.IsType() then
+ begin
+ Result := Value.AsType().HasValue;
+ if Result then
+ Value := Value.AsType().Value;
+ end
+ else
+ raise EMVCActiveRecord.Create('Invalid primary key type [HINT: Use Int64 or NullableInt64, so that Store method is available too.]');
+ IsNullableType := True;
+ end
+ else
+ begin
+ Result := not Value.IsEmpty;
+ end;
+end;
+
procedure TMVCActiveRecord.Update;
var
SQL: string;
diff --git a/unittests/general/Several/ActiveRecordTestsU.pas b/unittests/general/Several/ActiveRecordTestsU.pas
index 2df3d0cd7..ef8954f8a 100644
--- a/unittests/general/Several/ActiveRecordTestsU.pas
+++ b/unittests/general/Several/ActiveRecordTestsU.pas
@@ -44,6 +44,8 @@ TTestActiveRecord = class(TObject)
[Test]
procedure TestCRUD;
[Test]
+ procedure TestStore;
+ [Test]
procedure TestLifeCycle;
[Test]
procedure TestRQL;
@@ -301,6 +303,39 @@ procedure TTestActiveRecord.TestRQL;
Assert.AreEqual(Int64(0), TMVCActiveRecord.Count(RQL1));
end;
+procedure TTestActiveRecord.TestStore;
+var
+ lCustomer: TCustomerWithNullablePK;
+ lID: Integer;
+begin
+ Assert.AreEqual(Int64(0), TMVCActiveRecord.Count());
+ lCustomer := TCustomerWithNullablePK.Create;
+ try
+ lCustomer.CompanyName := 'bit Time Professionals';
+ lCustomer.City := 'Rome, IT';
+ lCustomer.Note := 'note1';
+ lCustomer.Store; { pk is not set, so it should do an insert }
+ lID := lCustomer.ID;
+ Assert.AreEqual(1, lID);
+ finally
+ lCustomer.Free;
+ end;
+
+ lCustomer := TMVCActiveRecord.GetByPK(lID);
+ try
+ Assert.IsFalse(lCustomer.Code.HasValue);
+ Assert.IsFalse(lCustomer.Rating.HasValue);
+ lCustomer.Code := '1234';
+ lCustomer.Rating := 3;
+ lCustomer.Note := lCustomer.Note + 'noteupdated';
+ lCustomer.Store; { pk is set, so it should do an update }
+ Assert.AreEqual(1, lCustomer.ID.Value);
+ finally
+ lCustomer.Free;
+ end;
+
+end;
+
procedure TTestActiveRecord.LoadData;
var
lTasks: TArray;
diff --git a/unittests/general/Several/BOs.pas b/unittests/general/Several/BOs.pas
index 175aa073f..5180fca26 100644
--- a/unittests/general/Several/BOs.pas
+++ b/unittests/general/Several/BOs.pas
@@ -65,6 +65,30 @@ TCustomer = class(TMVCActiveRecord)
property Note: String read fNote write fNote;
end;
+ [MVCTable('customers')]
+ TCustomerWithNullablePK = class(TMVCActiveRecord)
+ private
+ [MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
+ fID: NullableInt64;
+ [MVCTableField('code')]
+ fCode: NullableString;
+ [MVCTableField('description')]
+ fCompanyName: NullableString;
+ [MVCTableField('city')]
+ fCity: string;
+ [MVCTableField('rating')]
+ fRating: NullableInt32;
+ [MVCTableField('note')]
+ fNote: String;
+ public
+ property ID: NullableInt64 read fID write fID;
+ property Code: NullableString read fCode write fCode;
+ property CompanyName: NullableString read fCompanyName write fCompanyName;
+ property City: string read fCity write fCity;
+ property Rating: NullableInt32 read fRating write fRating;
+ property Note: String read fNote write fNote;
+ end;
+
[MVCTable('customers')]
TCustomerWithLF = class(TCustomer)
private
diff --git a/unittests/general/Several/DMVCFrameworkTests.dpr b/unittests/general/Several/DMVCFrameworkTests.dpr
index ac8a6b6d2..ccb9cfbb3 100644
--- a/unittests/general/Several/DMVCFrameworkTests.dpr
+++ b/unittests/general/Several/DMVCFrameworkTests.dpr
@@ -18,7 +18,6 @@ uses
DUnitX.TestFramework,
FrameworkTestsU in 'FrameworkTestsU.pas',
LiveServerTestU in 'LiveServerTestU.pas',
- MessagingExtensionsTestU in 'MessagingExtensionsTestU.pas',
BOs in 'BOs.pas',
TestServerControllerU in '..\TestServer\TestServerControllerU.pas',
RESTAdapterTestsU in 'RESTAdapterTestsU.pas',
diff --git a/unittests/general/Several/DMVCFrameworkTests.dproj b/unittests/general/Several/DMVCFrameworkTests.dproj
index 1917c4651..168361a86 100644
--- a/unittests/general/Several/DMVCFrameworkTests.dproj
+++ b/unittests/general/Several/DMVCFrameworkTests.dproj
@@ -164,7 +164,6 @@
-
diff --git a/unittests/general/Several/LiveServerTestU.pas b/unittests/general/Several/LiveServerTestU.pas
index 0c207f032..42844d0c0 100644
--- a/unittests/general/Several/LiveServerTestU.pas
+++ b/unittests/general/Several/LiveServerTestU.pas
@@ -192,7 +192,9 @@ TServerTest = class(TBaseServerTest)
// test nullables
[Test]
- procedure TestDeserializeNullables;
+ procedure TestDeserializeNullablesWithValue;
+ [Test]
+ procedure TestDeserializeNullablesWithNulls;
[Test]
procedure TestSerializeAndDeserializeNullables;
@@ -1240,12 +1242,50 @@ procedure TServerTest.TestResponseNoContent;
// end;
// end;
-procedure TServerTest.TestDeserializeNullables;
+procedure TServerTest.TestDeserializeNullablesWithNulls;
+var
+ lRes: IRESTResponse;
+ lSer: TMVCJsonDataObjectsSerializer;
+ lNullableTest: TNullablesTest;
+begin
+ /// nullables/getsinglewithnulls
+
+ lRes := RESTClient.doGET('/nullables/getsinglewithnulls', []);
+ lSer := TMVCJsonDataObjectsSerializer.Create;
+ try
+ lNullableTest := TNullablesTest.Create();
+ try
+ lSer.DeserializeObject(lRes.BodyAsString, lNullableTest);
+ Assert.isFalse(lNullableTest.f_int2.HasValue);
+ Assert.isFalse(lNullableTest.f_int4.HasValue);
+ Assert.isFalse(lNullableTest.f_int8.HasValue);
+ Assert.isFalse(lNullableTest.f_date.HasValue);
+ Assert.isFalse(lNullableTest.f_time.HasValue);
+ Assert.isFalse(lNullableTest.f_datetime.HasValue);
+ Assert.isFalse(lNullableTest.f_bool.HasValue);
+ Assert.isFalse(lNullableTest.f_float4.HasValue);
+ Assert.isFalse(lNullableTest.f_float8.HasValue);
+ Assert.isFalse(lNullableTest.f_string.HasValue);
+ Assert.isFalse(lNullableTest.f_currency.HasValue);
+ { TODO -oDanieleT -cGeneral : Compare streams too }
+ // Assert.AreEqual('0123456789', lNullableTest.f_blob.Value, 0);
+ finally
+ lNullableTest.Free;
+ end;
+ finally
+ lSer.Free;
+ end;
+
+end;
+
+procedure TServerTest.TestDeserializeNullablesWithValue;
var
lRes: IRESTResponse;
lSer: TMVCJsonDataObjectsSerializer;
lNullableTest: TNullablesTest;
begin
+ /// nullables/getsinglewithnulls
+
lRes := RESTClient.doGET('/nullables/getsingle', []);
lSer := TMVCJsonDataObjectsSerializer.Create;
try
diff --git a/unittests/general/TestServer/TestServerControllerU.pas b/unittests/general/TestServer/TestServerControllerU.pas
index 58f9a4345..fa4bcf9d1 100644
--- a/unittests/general/TestServer/TestServerControllerU.pas
+++ b/unittests/general/TestServer/TestServerControllerU.pas
@@ -205,6 +205,10 @@ TTestServerController = class(TMVCController)
[MVCPath('/nullables/getsingle')]
procedure TestSerializeNullables;
+ [MVCHTTPMethod([httpGET])]
+ [MVCPath('/nullables/getsinglewithnulls')]
+ procedure TestSerializeNullablesWithNulls;
+
// Response Objects Tests
[MVCHTTPMethod([httpPOST])]
@@ -608,6 +612,14 @@ procedure TTestServerController.TestSerializeNullables;
Render(lObj);
end;
+procedure TTestServerController.TestSerializeNullablesWithNulls;
+var
+ lObj: TNullablesTest;
+begin
+ lObj := TNullablesTest.Create();
+ Render(lObj);
+end;
+
procedure TTestServerController.TestStringDictionary;
var
lDict: TMVCStringDictionary;