Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

+ First merge with "GUID support for Primary Keys"

Browse Source
This commit is contained in:
Daniele Teti 2022-06-16 14:05:01 +02:00
parent eea09f1d94
commit dfbcadb8fa
17 changed files with 316 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -486,6 +486,8 @@ The current beta release is named 3.2.2-nitrogen. If you want to stay on the-edg
- ⚡New! Added parameter `RootNode` in `BodyFor`<T> and `BodyForListOf<T>` methods, just like the `BodyAs*` methods.
- ⚡New! Added `NullableTGUID` in `MVCFramework.Nullables.pas`.
- ⚡New `property CustomIntfObject: IInterface` in `TWebContext`. This property can be used to inject custom services factory.
```delphi

27
samples/activerecord_showcase/EntitiesU.pas
View File

@ -340,6 +340,33 @@ type
procedure OnBeforeInsert; override;
end;
[MVCNameCase(ncLowerCase)]
[MVCTable('customers_with_guid')]
TCustomerWithGUID = class(TCustomEntity)
private
[MVCTableField('idguid', [foPrimaryKey])]
fGUID: NullableTGUID;
[MVCTableField('code')]
fCode: NullableString;
[MVCTableField('description')]
fCompanyName: NullableString;
[MVCTableField('city')]
fCity: string;
[MVCTableField('rating')]
fRating: NullableInt32;
[MVCTableField('note')]
fNote: string;
public
property GUID: NullableTGUID read fGUID write fGUID;
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;
[MVCNameCase(ncLowerCase)]
[MVCTable('orders')]
TOrder = class(TCustomEntity)

3
samples/activerecord_showcase/FDConnectionConfigU.pas
View File

@ -154,6 +154,9 @@ begin
LParams.Add('Server=localhost');
LParams.Add('User_Name=postgres');
LParams.Add('Password=postgres');
// https://quality.embarcadero.com/browse/RSP-19755?jql=text%20~%20%22firedac%20guid%22
LParams.Add('GUIDEndian=Big');
if AIsPooled then
begin
LParams.Add('Pooled=True');

32
samples/activerecord_showcase/MainFormU.dfm
View File

@ -12,7 +12,6 @@ object MainForm: TMainForm
Font.Style = []
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
DesignSize = (
1104
569)
@ -28,7 +27,7 @@ object MainForm: TMainForm
end
object btnSelect: TButton
Left = 8
Top = 203
Top = 242
Width = 121
Height = 33
Caption = 'Queries'
@ -59,7 +58,7 @@ object MainForm: TMainForm
end
object btnRelations: TButton
Left = 8
Top = 242
Top = 281
Width = 121
Height = 35
Caption = 'Relations'
@ -68,7 +67,7 @@ object MainForm: TMainForm
end
object btnInheritance: TButton
Left = 8
Top = 283
Top = 322
Width = 121
Height = 34
Caption = 'Inheritance'
@ -77,7 +76,7 @@ object MainForm: TMainForm
end
object btnValidation: TButton
Left = 8
Top = 323
Top = 362
Width = 121
Height = 34
Caption = 'Validation'
@ -95,7 +94,7 @@ object MainForm: TMainForm
end
object btnRQL: TButton
Left = 8
Top = 363
Top = 402
Width = 121
Height = 34
Caption = 'RQL Query'
@ -104,7 +103,7 @@ object MainForm: TMainForm
end
object btnTransientFields: TButton
Left = 8
Top = 164
Top = 203
Width = 121
Height = 33
Caption = 'CRUD Transient'
@ -122,7 +121,7 @@ object MainForm: TMainForm
end
object btnCRUDNoAutoInc: TButton
Left = 8
Top = 47
Top = 86
Width = 121
Height = 33
Caption = 'CRUD (no autoinc)'
@ -131,7 +130,7 @@ object MainForm: TMainForm
end
object btnCRUDWithStringPKs: TButton
Left = 8
Top = 86
Top = 125
Width = 121
Height = 33
Caption = 'CRUD (string pks)'
@ -140,7 +139,7 @@ object MainForm: TMainForm
end
object btnWithSpaces: TButton
Left = 8
Top = 125
Top = 164
Width = 121
Height = 33
Caption = 'CRUD (entity with spaces)'
@ -220,8 +219,17 @@ object MainForm: TMainForm
TabOrder = 20
OnClick = btnPartitioningClick
end
object btnCRUDWithGUID: TButton
Left = 8
Top = 47
Width = 121
Height = 33
Caption = 'CRUD (with GUID PK)'
TabOrder = 21
OnClick = btnCRUDWithGUIDClick
end
object FDConnection1: TFDConnection
Left = 56
Top = 408
Left = 168
Top = 464
end
end

54
samples/activerecord_showcase/MainFormU.pas
View File

@ -53,6 +53,7 @@ type
btnMerge: TButton;
btnTableFilter: TButton;
btnPartitioning: TButton;
btnCRUDWithGUID: TButton;
procedure btnCRUDClick(Sender: TObject);
procedure btnInheritanceClick(Sender: TObject);
procedure btnMultiThreadingClick(Sender: TObject);
@ -76,6 +77,7 @@ type
procedure btnMergeClick(Sender: TObject);
procedure btnTableFilterClick(Sender: TObject);
procedure btnPartitioningClick(Sender: TObject);
procedure btnCRUDWithGUIDClick(Sender: TObject);
private
procedure Log(const Value: string);
procedure LoadCustomers;
@ -333,6 +335,58 @@ begin
end;
end;
procedure TMainForm.btnCRUDWithGUIDClick(Sender: TObject);
var
lTestNote: string;
lCustWithGUID: TCustomerWithGUID;
lIDGUID: TGUID;
begin
Log('** Using GUID as primary key');
lCustWithGUID := TCustomerWithGUID.Create;
try
Log('Entity ' + TCustomerWithGUID.ClassName + ' is mapped to table ' + lCustWithGUID.TableName);
lCustWithGUID.GUID := TGUID.NewGuid;
lCustWithGUID.CompanyName := 'Google Inc.';
lCustWithGUID.City := 'Montain View, CA';
lCustWithGUID.Note := 'Μῆνιν ἄειδε θεὰ Πηληϊάδεω Ἀχιλῆος οὐλομένην 😁';
lCustWithGUID.Insert;
lIDGUID := lCustWithGUID.GUID;
Log('Just inserted Customer With GUID ' + lIDGUID.ToString);
finally
lCustWithGUID.Free;
end;
lCustWithGUID := TMVCActiveRecord.GetByPK<TCustomerWithGUID>(lIDGUID);
try
Assert(not lCustWithGUID.Code.HasValue);
lCustWithGUID.Code.Value := '5678';
lCustWithGUID.Note := lCustWithGUID.Note + sLineBreak + 'Code changed to 5678 🙂';
lTestNote := lCustWithGUID.Note;
lCustWithGUID.Update;
Log('Just updated Customer ' + lIDGUID.ToString);
finally
lCustWithGUID.Free;
end;
lCustWithGUID := TCustomerWithGUID.Create;
try
lCustWithGUID.LoadByPK(lIDGUID);
lCustWithGUID.Code.Value := '😉9012🙂';
lCustWithGUID.Update;
finally
lCustWithGUID.Free;
end;
lCustWithGUID := TMVCActiveRecord.GetByPK<TCustomerWithGUID>(lIDGUID);
try
lCustWithGUID.Delete;
Log('Just deleted Customer ' + lIDGUID.ToString);
finally
lCustWithGUID.Free;
end;
end;
procedure TMainForm.btnCRUDWithStringPKsClick(Sender: TObject);
var
lCustomer: TCustomerWithCode;

40
samples/activerecord_showcase/activerecord_showcase.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{F8576ED6-649F-4E28-B364-1F60687C75F2}</ProjectGuid>
<ProjectVersion>19.3</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>activerecord_showcase.dpr</MainSource>
<Base>True</Base>
@ -163,6 +163,12 @@
</Excluded_Packages>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="BUILD" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_showcase.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="BULD" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_showcase.exe</RemoteName>
@ -175,24 +181,18 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="SQLITE" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_showcase.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="BUILD" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_showcase.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="POSTGRESQL" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_showcase.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="SQLITE" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_showcase.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
@ -1324,18 +1324,18 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>

BIN
samples/data/ACTIVERECORDDB.FDB
View File

Binary file not shown.

BIN
samples/data/activerecorddb.db
View File

Binary file not shown.

10
samples/data/activerecorddb_firebird_script.sql
View File

@ -15,6 +15,16 @@ CREATE TABLE customers (
CONSTRAINT customers_pk PRIMARY KEY (id)
);
CREATE TABLE CUSTOMERS_WITH_GUID (
IDGUID VARCHAR(38) NOT NULL,
CODE VARCHAR(20),
DESCRIPTION VARCHAR(200),
CITY VARCHAR(200),
NOTE BLOB SUB_TYPE TEXT,
RATING INTEGER,
CONSTRAINT CUSTOMERS_WITH_GUID_PK PRIMARY KEY (IDGUID)
);
CREATE TABLE customers_plain (
id integer NOT NULL,
code varchar(20),

10
samples/data/activerecorddb_interbase_script.sql
View File

@ -18,6 +18,16 @@ CREATE TABLE customers (
CONSTRAINT customers_pk PRIMARY KEY (id)
);
CREATE TABLE CUSTOMERS_WITH_GUID (
IDGUID VARCHAR(38) NOT NULL,
CODE VARCHAR(20),
DESCRIPTION VARCHAR(200),
CITY VARCHAR(200),
NOTE BLOB SUB_TYPE TEXT,
RATING INTEGER,
CONSTRAINT CUSTOMERS_WITH_GUID_PK PRIMARY KEY (IDGUID)
);
CREATE TABLE customers_plain (
id integer NOT NULL,
code varchar(20) character set utf8 ,

18
samples/data/activerecorddb_postgresql_script.sql
View File

@ -207,6 +207,24 @@ CREATE TABLE public.customers_with_code (
ALTER TABLE public.customers_with_code OWNER TO postgres;
-- public.customers_with_guid definition
-- Drop table
-- DROP TABLE public.customers_with_guid;
CREATE TABLE public.customers_with_guid (
idguid uuid NOT NULL,
code varchar(20) NULL,
description varchar(200) NULL,
city varchar(200) NULL,
note text NULL,
rating int4 NULL,
CONSTRAINT customers_with_guid_pk PRIMARY KEY (idguid)
);
--
-- TOC entry 209 (class 1259 OID 58884)
-- Name: nullables_test; Type: TABLE; Schema: public; Owner: postgres

11
sources/MVCFramework.ActiveRecord.pas
View File

@ -1190,7 +1190,7 @@ begin
else
begin
raise EMVCActiveRecord.Create
('Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String - found: '
('Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String, GUID - found: '
+
lPrimaryFieldTypeAsStr);
end;
@ -1344,7 +1344,7 @@ begin
if not Result.LoadByPK(aValue, aFieldType) then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecordNotFound.Create('Data not found')
raise EMVCActiveRecordNotFound.Create('No data found')
else
FreeAndNil(Result);
end;
@ -2063,6 +2063,13 @@ begin
begin
aParam.AsGuid := aValue.AsType<TGUID>;
end
else if aValue.IsType(TypeInfo(NullableTGUID)) then
begin
if aValue.AsType<NullableTGUID>.HasValue then
aParam.AsGuid := aValue.AsType<NullableTGUID>.Value
else
aParam.Clear();
end
else
begin
raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',

107
sources/MVCFramework.Nullables.pas
View File

@ -8,7 +8,7 @@
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2022 Daniele Teti and the DMVCFramework Team
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
@ -609,6 +609,44 @@ type
property Value: UInt64 read GetValue write SetValue;
end;
//**************************
// ** NullableTGUID
//**************************
NullableTGUID = record
private
fValue: TGUID;
fHasValue: String;
function GetHasValue: Boolean;
public
procedure CheckHasValue;
function GetValue: TGUID;
procedure SetValue(const Value: TGUID);
class operator Implicit(const Value: TGUID): NullableTGUID;
class operator Implicit(const Value: NullableTGUID): TGUID;
property HasValue: Boolean read GetHasValue;
///<summary>
///Alias of `SetNull`
///</summary>
procedure Clear;
///<summary>
///Set the value to `null`
///</summary>
procedure SetNull;
///<summary>
///Returns the value stored or the default value for the type is the value is not set
///</summary>
function ValueOrDefault: TGUID;
/// <summary>
/// Returns true is both item have the same value and that value is not null.
/// </summary>
function Equals(const Value: NullableTGUID): Boolean;
///<summary>
///Returns the value stored or raises exception if no value is stored
///</summary>
property Value: TGUID read GetValue write SetValue;
end;
implementation
@ -1618,4 +1656,71 @@ end;
{ NullableTGUID }
procedure NullableTGUID.CheckHasValue;
begin
if not GetHasValue then
begin
raise EMVCNullable.Create('Value is null');
end;
end;
procedure NullableTGUID.Clear;
begin
SetNull;
end;
function NullableTGUID.Equals(const Value: NullableTGUID): Boolean;
begin
Result := (Self.HasValue and Value.HasValue) and (Self.Value = Value.Value);
end;
function NullableTGUID.GetHasValue: Boolean;
begin
Result := fHasValue = '_';
end;
function NullableTGUID.GetValue: TGUID;
begin
CheckHasValue;
Result := fValue;
end;
class operator NullableTGUID.Implicit(const Value: NullableTGUID): TGUID;
begin
Result := Value.Value;
end;
class operator NullableTGUID.Implicit(const Value: TGUID): NullableTGUID;
begin
Result.Value := Value;
end;
procedure NullableTGUID.SetNull;
begin
fValue := Default (TGUID);
fHasValue := '';
end;
procedure NullableTGUID.SetValue(const Value: TGUID);
begin
fValue := Value;
fHasValue := '_';
end;
function NullableTGUID.ValueOrDefault: TGUID;
begin
if HasValue then
begin
Result := GetValue
end
else
begin
Result := Default (TGUID);
end;
end;
end.

10
sources/MVCFramework.RQL.AST2MSSQL.pas
View File

@ -33,15 +33,13 @@ uses
type
TRQLMSSQLCompiler = class(TRQLCompiler)
private
FMapping: TMVCFieldsMapping;
function RQLFilterToSQL(const aRQLFIlter: TRQLFilter): string;
function RQLSortToSQL(const aRQLSort: TRQLSort): string;
function RQLLimitToSQL(const aRQLLimit: TRQLLimit): string;
function RQLWhereToSQL(const aRQLWhere: TRQLWhere): string;
function RQLLogicOperatorToSQL(const aRQLFIlter: TRQLLogicOperator): string;
protected
function RQLCustom2SQL(const aRQLCustom: TRQLCustom): string; override;
public
constructor Create(const Mapping: TMVCFieldsMapping); override;
end;
implementation
@ -51,12 +49,6 @@ uses
{ TRQLMSSQLCompiler }
constructor TRQLMSSQLCompiler.Create(const Mapping: TMVCFieldsMapping);
begin
inherited Create(Mapping);
FMapping := Mapping;
end;
function TRQLMSSQLCompiler.RQLCustom2SQL(
const aRQLCustom: TRQLCustom): string;
begin

29
sources/MVCFramework.Serializer.Commons.pas
View File

@ -1075,6 +1075,10 @@ begin
begin
aRTTIField.SetValue(AObject, AField.AsString);
end;
tkWideString:
begin
aRTTIField.SetValue(AObject, AField.AsWideString);
end;
tkClass: { mysql - maps a tiny field, identified as string, into a TStream }
begin
lInternalStream := aRTTIField.GetValue(AObject).AsObject as TStream;
@ -1235,7 +1239,18 @@ begin
ftGuid:
begin
{$IF Defined(TokyoOrBetter)}
aRTTIField.SetValue(AObject, TValue.From<TGUID>(AField.AsGuid));
if AField.IsNull then
begin
aRTTIField.SetValue(AObject, TValue.Empty)
end
else if TypeInfo(NullableTGUID) = aRTTIField.FieldType.Handle then
begin
aRTTIField.SetValue(AObject, TValue.From<NullableTGUID>(AField.AsGuid));
end
else
begin
aRTTIField.SetValue(AObject, TValue.From<TGUID>(AField.AsGuid));
end;
{$ELSE}
lFieldValue := AField.AsString;
if lFieldValue.IsEmpty then
@ -1475,6 +1490,18 @@ begin
end;
Result := True;
end
else if AValue.IsType(TypeInfo(NullableTGUID)) then
begin
if AField.IsNull then
begin
aRTTIField.GetValue(AObject).AsType<NullableTGUID>().Clear;
end
else
begin
aRTTIField.SetValue(AObject, TValue.From<NullableTGUID>(AField.AsGuid));
end;
Result := True;
end
end;
function MapDataSetFieldToNullableRTTIProperty(const AValue: TValue; const AField: TField;

9
sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
View File

@ -357,9 +357,14 @@ end;
procedure TMVCGUIDSerializer.SerializeAttribute(const AElementValue: TValue; const APropertyName: string;
const ASerializerObject: TObject; const AAttributes: TArray<TCustomAttribute>);
var
lValue: String;
begin
if TMVCSerializerHelper.AttributeExists<MVCSerializeGuidWithoutBracesAttribute>(AAttributes) then
(ASerializerObject as TJDOJsonObject).S[APropertyName] := Copy(AElementValue.AsType<TGUID>.ToString, 2, 36)
lValue := AElementValue.AsType<TGUID>.ToString;
if (lValue.Chars[0] = '{') and TMVCSerializerHelper.AttributeExists<MVCSerializeGuidWithoutBracesAttribute>(AAttributes) then
begin
(ASerializerObject as TJDOJsonObject).S[APropertyName] := lValue.Substring(1, lValue.Length - 1) // Copy(AElementValue.AsType<TGUID>.ToString, 2, 36)
end
else
(ASerializerObject as TJDOJsonObject).S[APropertyName] := AElementValue.AsType<TGUID>.ToString;
end;

1
tasks.py
View File

@ -419,6 +419,7 @@ def generate_nullables(ctx):
"UInt32",
"Int64",
"UInt64",
"TGUID",
]
str_main_tmpl = "".join(main_tmpl)