mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
- Improved nullable types Python generator
- Unit test refactoring
This commit is contained in:
Daniele Teti
parent
40f1f21381
commit
4a509b0eb0
@ -524,6 +524,8 @@ The current beta release is named 3.2.2-nitrogen. If you want to stay on the-edg
|
||||
|
||||
- ✅ Improved! PostgreSQL, FirebirdSQL, Interbase and SQLite now support tablename and fields with spaces.
|
||||
|
||||
- ✅ Improved Nullable Types. Now it's possible to assign `nil` to a nullable type and to check its state using the new property `IsNull` which is the negation of the already available property `HasValue`.
|
||||
|
||||
- ✅ Improved! Now `TMVCStaticFileMiddleware` is able to manage high-level criteria to show/hide/mask specific files in the documetn web root. Check [Issue 548](https://github.com/danieleteti/delphimvcframework/issues/548) and the updated sample `samples\middleware_staticfiles\` for more info.
|
||||
|
||||
- ⚡New! Mechanism to customize the JWT claims setup using the client request as suggested in [issue495](https://github.com/danieleteti/delphimvcframework/issues/495)
|
||||
@ -719,6 +721,8 @@ The current beta release is named 3.2.2-nitrogen. If you want to stay on the-edg
|
||||
|
||||
- Fix https://github.com/danieleteti/delphimvcframework/issues/542 (Thanks to [Lamberto Lodi](https://github.com/llodi-csw) for the hints)
|
||||
|
||||
- Fix https://github.com/danieleteti/delphimvcframework/issues/485
|
||||
|
||||
- Fixed *fileupload* sample
|
||||
|
||||
- Fixed an `IFDEF` compatibility problem on mobile platforms (Thanks to Marco Cotroneo)
|
||||
|
||||
@ -1696,6 +1696,8 @@ begin
|
||||
end;
|
||||
|
||||
function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
|
||||
var
|
||||
lNTType: TNullableType;
|
||||
begin
|
||||
Assert(aValue.Kind = tkRecord);
|
||||
Result := false;
|
||||
@ -2628,11 +2630,15 @@ begin
|
||||
if fPrimaryKey.GetValue(Self).Kind = tkRecord then
|
||||
begin
|
||||
lPKValue := fPrimaryKey.GetValue(Self);
|
||||
if lPKValue.IsType<NullableInt32> and aValue.IsType<NullableInt32>() then
|
||||
if lPKValue.IsType<NullableInt32> {and aValue.IsType<NullableInt32>()} then
|
||||
begin
|
||||
if aValue.IsType<UInt32> then
|
||||
if aValue.IsType<Int32> then
|
||||
begin
|
||||
lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
|
||||
end
|
||||
else
|
||||
begin
|
||||
raise EMVCActiveRecord.Create('Invalid type for primary key');
|
||||
end;
|
||||
end
|
||||
else if lPKValue.IsType<NullableInt64> and aValue.IsType<NullableInt64>() then
|
||||
|
||||
@ -54,7 +54,10 @@ type
|
||||
public
|
||||
constructor Create(const aConnectionFactory: TFunc<TFDConnection>;
|
||||
const aAuthorization: TMVCActiveRecordAuthFunc = nil;
|
||||
const aURLSegment: String = ''); reintroduce;
|
||||
const aURLSegment: String = ''); reintroduce; overload;
|
||||
constructor Create(const aConnectionDefName: String;
|
||||
const aAuthorization: TMVCActiveRecordAuthFunc = nil;
|
||||
const aURLSegment: String = ''); reintroduce; overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
[MVCPath('/($entityname)')]
|
||||
@ -314,6 +317,15 @@ begin
|
||||
fAuthorization := aAuthorization;
|
||||
end;
|
||||
|
||||
constructor TMVCActiveRecordController.Create(const aConnectionDefName: String;
|
||||
const aAuthorization: TMVCActiveRecordAuthFunc; const aURLSegment: String);
|
||||
begin
|
||||
inherited Create;
|
||||
fURLSegment := aURLSegment;
|
||||
ActiveRecordConnectionsRegistry.AddDefaultConnection(aConnectionDefName);
|
||||
fAuthorization := aAuthorization;
|
||||
end;
|
||||
|
||||
procedure TMVCActiveRecordController.CreateEntity(const entityname: string);
|
||||
var
|
||||
lAR: TMVCActiveRecord;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -8,7 +8,7 @@
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
|
||||
// Copyright (c) 2010-2022 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
@ -32,7 +32,7 @@ unit MVCFramework.Nullables;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Classes;
|
||||
System.SysUtils, System.Classes, System.TypInfo;
|
||||
|
||||
type
|
||||
EMVCNullable = class(Exception)
|
||||
@ -45,32 +45,41 @@ type
|
||||
fValue: $TYPE$;
|
||||
fHasValue: String;
|
||||
function GetHasValue: Boolean;
|
||||
function GetIsNull: Boolean;
|
||||
public
|
||||
procedure CheckHasValue;
|
||||
function GetValue: $TYPE$;
|
||||
procedure SetValue(const Value: $TYPE$);
|
||||
class operator Implicit(const Value: $TYPE$): Nullable$TYPE$;
|
||||
class operator Implicit(const Value: Nullable$TYPE$): $TYPE$;
|
||||
class operator Implicit(const Value: Pointer): Nullable$TYPE$;
|
||||
///<summary>
|
||||
///Returns `True` if the Nullable$TYPE$ contains a value
|
||||
///</summary>
|
||||
property HasValue: Boolean read GetHasValue;
|
||||
///<summary>
|
||||
///Alias of `SetNull`
|
||||
///</summary>
|
||||
///<summary>
|
||||
///Returns `True` if the Nullable$TYPE$ contains a null
|
||||
///</summary>
|
||||
property IsNull: Boolean read GetIsNull;
|
||||
///<summary>
|
||||
///Alias of `SetNull`
|
||||
///</summary>
|
||||
procedure Clear;
|
||||
///<summary>
|
||||
///Set the value to `null`
|
||||
///</summary>
|
||||
///<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>
|
||||
///<summary>
|
||||
///Returns the value stored or the default value for the type is the value is not set
|
||||
///</summary>
|
||||
function ValueOrDefault: $TYPE$;
|
||||
/// <summary>
|
||||
/// Returns true is both item have the same value and that value is not null.
|
||||
/// </summary>
|
||||
function Equals(const Value: Nullable$TYPE$): Boolean;
|
||||
///<summary>
|
||||
///Returns the value stored or raises exception if no value is stored
|
||||
///</summary>
|
||||
/// <summary>
|
||||
/// Returns true is both item have the same value and that value is not null.
|
||||
/// </summary>
|
||||
function Equals(const Value: Nullable$TYPE$): Boolean;
|
||||
///<summary>
|
||||
///Returns the value stored or raises exception if no value is stored
|
||||
///</summary>
|
||||
property Value: $TYPE$ read GetValue write SetValue;
|
||||
end;
|
||||
|
||||
@ -105,6 +114,11 @@ begin
|
||||
Result := fHasValue = '_';
|
||||
end;
|
||||
|
||||
function Nullable$TYPE$.GetIsNull: Boolean;
|
||||
begin
|
||||
Result := not HasValue;
|
||||
end;
|
||||
|
||||
function Nullable$TYPE$.GetValue: $TYPE$;
|
||||
begin
|
||||
CheckHasValue;
|
||||
@ -121,6 +135,18 @@ begin
|
||||
Result.Value := Value;
|
||||
end;
|
||||
|
||||
class operator Nullable$TYPE$.Implicit(const Value: Pointer): Nullable$TYPE$;
|
||||
begin
|
||||
if Value = nil then
|
||||
begin
|
||||
Result.SetNull;
|
||||
end
|
||||
else
|
||||
begin
|
||||
raise EInvalidPointer.Create('Pointer value can only be "nil"');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Nullable$TYPE$.SetNull;
|
||||
begin
|
||||
fValue := Default ($TYPE$);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
27
tasks.py
27
tasks.py
@ -376,7 +376,7 @@ def parse_template(tmpl: List[str]):
|
||||
if row.upper().strip() in ["///INTERFACE.END", "///IMPLEMENTATION.END"]:
|
||||
if state == "parsing.interface":
|
||||
main_tmpl.append("$INTERFACE$")
|
||||
if state == "parsing.implementation":
|
||||
if state == "parsing.implementation":
|
||||
main_tmpl.append("$IMPLEMENTATION$")
|
||||
state = "verbatim"
|
||||
continue
|
||||
@ -428,16 +428,35 @@ def generate_nullables(ctx):
|
||||
|
||||
intf_out = ""
|
||||
impl_out = ""
|
||||
|
||||
enum_declaration = ["ntInvalidNullableType"]
|
||||
enum_detect_line = []
|
||||
for delphi_type in delphi_types:
|
||||
enum_declaration.append('ntNullable' + delphi_type)
|
||||
enum_detect_line.append(f" if aTypeInfo = TypeInfo(Nullable{delphi_type}) then \n Exit(ntNullable{delphi_type}); ")
|
||||
|
||||
intf_out += (
|
||||
f"//**************************\n// ** Nullable{delphi_type}\n//**************************\n\n"
|
||||
+ str_intf_tmpl.replace("$TYPE$", delphi_type)
|
||||
)
|
||||
impl_out += str_impl_tmpl.replace("$TYPE$", delphi_type) + "\n"
|
||||
|
||||
str_main_tmpl = str_main_tmpl.replace("$INTERFACE$", intf_out).replace(
|
||||
"$IMPLEMENTATION$", impl_out
|
||||
)
|
||||
enum_declaration = ' TNullableType = (\n ' + '\n , '.join(enum_declaration) + ');\n\n'
|
||||
enum_detect_function = []
|
||||
enum_detect_function.append("function GetNullableType(const aTypeInfo: PTypeInfo): TNullableType;")
|
||||
enum_detect_function.append("begin")
|
||||
enum_detect_function.extend(enum_detect_line)
|
||||
enum_detect_function.append(" Result := ntInvalidNullableType;")
|
||||
enum_detect_function.append("end;")
|
||||
|
||||
intf_out += enum_declaration + "\n"
|
||||
intf_out += enum_detect_function[0] + "\n"
|
||||
impl_out += "\n".join(enum_detect_function) + "\n"
|
||||
|
||||
str_main_tmpl = str_main_tmpl \
|
||||
.replace("$INTERFACE$", intf_out) \
|
||||
.replace("$IMPLEMENTATION$", impl_out) \
|
||||
+ "\n"
|
||||
|
||||
with open(output_unitname, "w") as f:
|
||||
f.writelines(str_main_tmpl)
|
||||
|
||||
@ -29,16 +29,28 @@ interface
|
||||
uses
|
||||
DUnitX.TestFramework,
|
||||
FireDAC.Comp.Client, FireDAC.ConsoleUI.Wait, FireDAC.VCLUI.Wait,
|
||||
PGUtilsU;
|
||||
PGUtilsU, LiveServerTestU, MVCFramework.Server, MVCFramework.RESTClient.Intf;
|
||||
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TTestActiveRecordController = class(TObject)
|
||||
private
|
||||
fListener: IMVCListener;
|
||||
fClient: IMVCRESTClient;
|
||||
procedure LoadData;
|
||||
public
|
||||
class procedure CreatePrivateFirebirdSQLConnDef(const ConDefName: String; AIsPooled: boolean);
|
||||
[SetupFixture]
|
||||
procedure SetupFixture;
|
||||
[Teardown]
|
||||
procedure Teardown;
|
||||
procedure Setup;
|
||||
[TeardownFixture]
|
||||
procedure TearDown;
|
||||
[Test]
|
||||
procedure TestGetAll;
|
||||
[Test]
|
||||
procedure TestCRUD;
|
||||
[Test]
|
||||
procedure TestDelete;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -46,19 +58,242 @@ implementation
|
||||
uses
|
||||
System.Classes, System.IOUtils, BOs, MVCFramework.ActiveRecord,
|
||||
System.SysUtils, System.Threading, System.Generics.Collections, Data.DB,
|
||||
FireDAC.Stan.Intf, ShellAPI, Winapi.Windows, FDConnectionConfigU;
|
||||
FireDAC.Stan.Intf, ShellAPI, Winapi.Windows, FDConnectionConfigU,
|
||||
MVCFramework.Serializer.JsonDataObjects,
|
||||
MVCFramework.Server.Impl, ActiveRecordControllerWebModuleU,
|
||||
MVCFramework.RESTClient, JsonDataObjects, System.StrUtils,
|
||||
MVCFramework.Commons;
|
||||
|
||||
|
||||
{ TTestActiveRecordController }
|
||||
|
||||
procedure TTestActiveRecordController.SetupFixture;
|
||||
class procedure TTestActiveRecordController.CreatePrivateFirebirdSQLConnDef(const ConDefName: String; AIsPooled: boolean);
|
||||
var
|
||||
LParams: TStringList;
|
||||
lDriver: IFDStanDefinition;
|
||||
GDBFileName: string;
|
||||
GDBTemplateFileName: string;
|
||||
begin
|
||||
CreateFirebirdPrivateConnDef(True);
|
||||
if not Assigned(FDManager.DriverDefs.FindDefinition('FBEMBEDDED')) then
|
||||
begin
|
||||
lDriver := FDManager.DriverDefs.Add;
|
||||
lDriver.Name := 'FBEMBEDDED';
|
||||
lDriver.AsString['BaseDriverID'] := 'FB';
|
||||
lDriver.AsString['DriverID'] := 'FBEMBEDDED';
|
||||
lDriver.AsString['VendorLib'] := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebird\fbclient.dll');
|
||||
lDriver.Apply;
|
||||
end;
|
||||
|
||||
LParams := TStringList.Create;
|
||||
try
|
||||
GDBFileName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebirdtest2.fdb');
|
||||
GDBTemplateFileName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebirdtest_template.fdb');
|
||||
TFile.Copy(GDBTemplateFileName, GDBFileName, True);
|
||||
LParams.Add('Database=' + GDBFileName);
|
||||
LParams.Add('user_name=sysdba');
|
||||
LParams.Add('password=masterkey');
|
||||
if AIsPooled then
|
||||
begin
|
||||
LParams.Add('Pooled=True');
|
||||
LParams.Add('POOL_MaximumItems=100');
|
||||
end
|
||||
else
|
||||
begin
|
||||
LParams.Add('Pooled=False');
|
||||
end;
|
||||
FDManager.AddConnectionDef(ConDefName, 'FBEMBEDDED', LParams);
|
||||
finally
|
||||
LParams.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestActiveRecordController.LoadData;
|
||||
var
|
||||
lProc: TProc;
|
||||
const
|
||||
Cities: array [0 .. 4] of string = ('Rome', 'New York', 'London', 'Melbourne', 'Berlin');
|
||||
CompanySuffix: array [0 .. 5] of string = ('Corp.', 'Inc.', 'Ltd.', 'Srl', 'SPA', 'doo');
|
||||
Stuff: array [0 .. 4] of string = ('Burger', 'GAS', 'Motors', 'House', 'Boats');
|
||||
begin
|
||||
TMVCActiveRecord.DeleteRQL(TCustomer, 'in(City,["Rome","New York","London","Melbourne","Berlin"])');
|
||||
lProc := procedure
|
||||
var
|
||||
lCustomer: TCustomer;
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 1 to 30 do
|
||||
begin
|
||||
lCustomer := TCustomer.Create;
|
||||
try
|
||||
lCustomer.Code := Format('%5.5d', [TThread.CurrentThread.ThreadID, I]);
|
||||
lCustomer.City := Cities[I mod Length(Cities)];
|
||||
lCustomer.CompanyName := Format('%s %s %s', [lCustomer.City, Stuff[Random(high(Stuff) + 1)],
|
||||
CompanySuffix[Random(high(CompanySuffix) + 1)]]);
|
||||
lCustomer.Note := Stuff[I mod Length(Stuff)];
|
||||
lCustomer.Rating := 1;
|
||||
lCustomer.CreationTime := EncodeTime(I mod 23, I, 60 - 1, 0);
|
||||
lCustomer.CreationDate := EncodeDate(2020 - I, (I mod 12) + 1, (I mod 27) + 1);
|
||||
lCustomer.Insert;
|
||||
finally
|
||||
lCustomer.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
lProc();
|
||||
end;
|
||||
|
||||
procedure TTestActiveRecordController.Setup;
|
||||
begin
|
||||
CreatePrivateFirebirdSQLConnDef(AR_CONTROLLER_CON_DEF_NAME, True);
|
||||
|
||||
var lConn := TFDConnection.Create(nil);
|
||||
try
|
||||
lConn.ConnectionDefName := AR_CONTROLLER_CON_DEF_NAME;
|
||||
lConn.Open;
|
||||
for var lSQL in SQLs_FIREBIRD do
|
||||
begin
|
||||
lConn.ExecSQL(lSQL);
|
||||
end;
|
||||
ActiveRecordConnectionsRegistry.AddDefaultConnection(lConn, False);
|
||||
LoadData;
|
||||
ActiveRecordConnectionsRegistry.RemoveDefaultConnection();
|
||||
finally
|
||||
lConn.Free;
|
||||
end;
|
||||
|
||||
fListener := TMVCListener.Create(
|
||||
TMVCListenerProperties
|
||||
.New
|
||||
.SetName('Listener1')
|
||||
.SetPort(5000)
|
||||
.SetMaxConnections(512)
|
||||
.SetWebModuleClass(TActiveRecordControllerWebModule));
|
||||
fListener.Start;
|
||||
|
||||
fClient := TMVCRESTClient.New.BaseURL('http://localhost', 5000);
|
||||
fClient.ReadTimeout(60 * 1000 * 30);
|
||||
end;
|
||||
|
||||
procedure TTestActiveRecordController.Teardown;
|
||||
begin
|
||||
fListener.Stop;
|
||||
FDManager.CloseConnectionDef(AR_CONTROLLER_CON_DEF_NAME);
|
||||
FDManager.DeleteConnectionDef(AR_CONTROLLER_CON_DEF_NAME);
|
||||
end;
|
||||
|
||||
procedure TTestActiveRecordController.TestDelete;
|
||||
var
|
||||
lResp: IMVCRESTResponse;
|
||||
lLocation: String;
|
||||
begin
|
||||
var lCust := TCustomer.Create;
|
||||
try
|
||||
lCust.Code := 'MYCODE';
|
||||
lCust.CompanyName := 'bit Time Professionals';
|
||||
lCust.City := 'Rome';
|
||||
lResp := fClient.Post('/api/entities/customers', lCust, False);
|
||||
lLocation := lResp.HeaderValue('X-REF');
|
||||
finally
|
||||
lCust.Free;
|
||||
end;
|
||||
|
||||
lResp := fClient.Delete(lLocation);
|
||||
Assert.AreEqual(HTTP_STATUS.OK, lResp.StatusCode);
|
||||
lResp := fClient.Get(lLocation);
|
||||
Assert.AreEqual(HTTP_STATUS.NotFound, lResp.StatusCode);
|
||||
end;
|
||||
|
||||
procedure TTestActiveRecordController.TestGetAll;
|
||||
var
|
||||
lResp: IMVCRESTResponse;
|
||||
begin
|
||||
lResp := fClient.Get('/api/entities/customers');
|
||||
var lJSON := lResp.ToJSONObject;
|
||||
try
|
||||
Assert.IsTrue(lJSON.Contains('data') and (lJSON.Types['data'] = TJsonDataType.jdtArray), 'incorrect "data" property in JSON');
|
||||
var lCustomers := TJSONUtils.JSONArrayToListOf<TCustomer>(lJSON.A['data']);
|
||||
try
|
||||
Assert.AreEqual(20, lCustomers.Count);
|
||||
finally
|
||||
lCustomers.Free;
|
||||
end;
|
||||
finally
|
||||
lJSON.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestActiveRecordController.TestCRUD;
|
||||
var
|
||||
lResp: IMVCRESTResponse;
|
||||
lLocation: String;
|
||||
lJSON: TJsonObject;
|
||||
lPieces: TArray<String>;
|
||||
lIDFromURL: Integer;
|
||||
lCust: TCustomer;
|
||||
begin
|
||||
lCust := TCustomer.Create;
|
||||
try
|
||||
lCust.Code := 'MYCODE';
|
||||
lCust.CompanyName := 'The Company';
|
||||
lCust.City := 'Rome';
|
||||
lCust.CreationTime := Time;
|
||||
lCust.CreationDate := Date;
|
||||
lResp := fClient.Post('/api/entities/customers', lCust, False);
|
||||
lLocation := lResp.HeaderValue('X-REF');
|
||||
finally
|
||||
lCust.Free;
|
||||
end;
|
||||
|
||||
lResp := fClient.Get(lLocation);
|
||||
lJSON := lResp.ToJSONObject;
|
||||
try
|
||||
Assert.IsTrue(lJSON.Contains('data') and (lJSON.Types['data'] = TJsonDataType.jdtObject), 'incorrect "data" property in JSON');
|
||||
lCust := TJSONUtils.JSONObjectToObject<TCustomer>(lJSON.O['data']);
|
||||
try
|
||||
lPieces := lLocation.Split(['/']);
|
||||
lIDFromUrl := lPieces[High(lPieces)].ToInteger;
|
||||
Assert.AreEqual(lIDFromUrl, lCust.ID.Value);
|
||||
Assert.AreEqual('MYCODE', lCust.Code.Value);
|
||||
Assert.AreEqual('The Company', lCust.CompanyName.Value);
|
||||
Assert.AreEqual('Rome', lCust.City);
|
||||
Assert.IsFalse(lCust.Rating.HasValue);
|
||||
Assert.IsTrue(lCust.CreationTime.HasValue);
|
||||
Assert.IsTrue(lCust.CreationDate.HasValue);
|
||||
Assert.IsEmpty(lCust.Note);
|
||||
|
||||
//update
|
||||
lCust.Code := nil; //.SetNull;
|
||||
lCust.CompanyName.Value := 'bit Time Professionals';
|
||||
fClient.Put(lLocation, lCust, False);
|
||||
finally
|
||||
lCust.Free;
|
||||
end;
|
||||
finally
|
||||
lJSON.Free;
|
||||
end;
|
||||
|
||||
lResp := fClient.Get(lLocation);
|
||||
lJSON := lResp.ToJSONObject;
|
||||
try
|
||||
lCust := TJSONUtils.JSONObjectToObject<TCustomer>(lJSON.O['data']);
|
||||
try
|
||||
lPieces := lLocation.Split(['/']);
|
||||
lIDFromUrl := lPieces[High(lPieces)].ToInteger;
|
||||
Assert.AreEqual(lIDFromUrl, lCust.ID.Value);
|
||||
Assert.IsFalse(lCust.Code.HasValue);
|
||||
Assert.AreEqual('bit Time Professionals', lCust.CompanyName.Value);
|
||||
Assert.AreEqual('Rome', lCust.City);
|
||||
Assert.IsFalse(lCust.Rating.HasValue);
|
||||
Assert.IsTrue(lCust.CreationTime.HasValue);
|
||||
Assert.IsTrue(lCust.CreationDate.HasValue);
|
||||
Assert.IsEmpty(lCust.Note);
|
||||
finally
|
||||
lCust.Free;
|
||||
end;
|
||||
finally
|
||||
lJSON.Free;
|
||||
end;
|
||||
lResp := fClient.Delete(lLocation);
|
||||
Assert.AreEqual(HTTP_STATUS.OK, lResp.StatusCode);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -1989,12 +1989,15 @@ var
|
||||
LParams: TStringList;
|
||||
lDriver: IFDStanDefinition;
|
||||
begin
|
||||
lDriver := FDManager.DriverDefs.Add;
|
||||
lDriver.Name := 'FBEMBEDDED';
|
||||
lDriver.AsString['BaseDriverID'] := 'FB';
|
||||
lDriver.AsString['DriverID'] := 'FBEMBEDDED';
|
||||
lDriver.AsString['VendorLib'] := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebird\fbclient.dll');
|
||||
lDriver.Apply;
|
||||
if not Assigned(FDManager.DriverDefs.FindDefinition('FBEMBEDDED')) then
|
||||
begin
|
||||
lDriver := FDManager.DriverDefs.Add;
|
||||
lDriver.Name := 'FBEMBEDDED';
|
||||
lDriver.AsString['BaseDriverID'] := 'FB';
|
||||
lDriver.AsString['DriverID'] := 'FBEMBEDDED';
|
||||
lDriver.AsString['VendorLib'] := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)), 'firebird\fbclient.dll');
|
||||
lDriver.Apply;
|
||||
end;
|
||||
|
||||
LParams := TStringList.Create;
|
||||
try
|
||||
|
||||
@ -1429,4 +1429,9 @@ begin
|
||||
Result := inherited + Format(' [ID:%5d][Company: %s]', [ID.ValueOrDefault, CompanyName.ValueOrDefault]);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
ActiveRecordMappingRegistry.AddEntity('customers', TCustomer);
|
||||
|
||||
end.
|
||||
|
||||
@ -47,10 +47,10 @@ uses
|
||||
MVCFramework.ActiveRecord in '..\..\..\sources\MVCFramework.ActiveRecord.pas',
|
||||
MVCFramework.ActiveRecordController in '..\..\..\sources\MVCFramework.ActiveRecordController.pas',
|
||||
ActiveRecordControllerTestU in 'ActiveRecordControllerTestU.pas',
|
||||
WebModuleU in 'webmodules\WebModuleU.pas' {MyWebModule: TWebModule},
|
||||
FDConnectionConfigU in 'webmodules\FDConnectionConfigU.pas',
|
||||
StandaloneServerTestU in '..\StandaloneServer\StandaloneServerTestU.pas',
|
||||
StandAloneServerWebModuleTest in '..\StandaloneServer\StandAloneServerWebModuleTest.pas' {TestWebModule2: TWebModule},
|
||||
ActiveRecordControllerWebModuleU in 'webmodules\ActiveRecordControllerWebModuleU.pas' {ActiveRecordControllerWebModule: TWebModule},
|
||||
FDConnectionConfigU in '..\..\common\FDConnectionConfigU.pas',
|
||||
StandaloneServerTestU in 'StandaloneServerTestU.pas',
|
||||
StandAloneServerWebModuleTest in 'webmodules\StandAloneServerWebModuleTest.pas' {TestWebModule2: TWebModule},
|
||||
MVCFramework.Commons in '..\..\..\sources\MVCFramework.Commons.pas',
|
||||
MVCFramework.Serializer.JsonDataObjects.CustomTypes in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas',
|
||||
MVCFramework.SQLGenerators.Firebird in '..\..\..\sources\MVCFramework.SQLGenerators.Firebird.pas',
|
||||
@ -66,7 +66,10 @@ uses
|
||||
MVCFramework.RQL.AST2MySQL in '..\..\..\sources\MVCFramework.RQL.AST2MySQL.pas',
|
||||
MVCFramework.RQL.AST2PostgreSQL in '..\..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas',
|
||||
MVCFramework.RQL.AST2SQLite in '..\..\..\sources\MVCFramework.RQL.AST2SQLite.pas',
|
||||
MVCFramework.RQL.Parser in '..\..\..\sources\MVCFramework.RQL.Parser.pas';
|
||||
MVCFramework.RQL.Parser in '..\..\..\sources\MVCFramework.RQL.Parser.pas',
|
||||
Entities in 'Entities.pas',
|
||||
EntitiesProcessors in 'EntitiesProcessors.pas',
|
||||
MVCFramework.Nullables in '..\..\..\sources\MVCFramework.Nullables.pas';
|
||||
|
||||
{$R *.RES}
|
||||
|
||||
|
||||
@ -204,13 +204,13 @@
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.ActiveRecord.pas"/>
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.ActiveRecordController.pas"/>
|
||||
<DCCReference Include="ActiveRecordControllerTestU.pas"/>
|
||||
<DCCReference Include="webmodules\WebModuleU.pas">
|
||||
<Form>MyWebModule</Form>
|
||||
<DCCReference Include="webmodules\ActiveRecordControllerWebModuleU.pas">
|
||||
<Form>ActiveRecordControllerWebModule</Form>
|
||||
<DesignClass>TWebModule</DesignClass>
|
||||
</DCCReference>
|
||||
<DCCReference Include="webmodules\FDConnectionConfigU.pas"/>
|
||||
<DCCReference Include="..\StandaloneServer\StandaloneServerTestU.pas"/>
|
||||
<DCCReference Include="..\StandaloneServer\StandAloneServerWebModuleTest.pas">
|
||||
<DCCReference Include="..\..\common\FDConnectionConfigU.pas"/>
|
||||
<DCCReference Include="StandaloneServerTestU.pas"/>
|
||||
<DCCReference Include="webmodules\StandAloneServerWebModuleTest.pas">
|
||||
<Form>TestWebModule2</Form>
|
||||
<FormType>dfm</FormType>
|
||||
<DesignClass>TWebModule</DesignClass>
|
||||
@ -231,6 +231,9 @@
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas"/>
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.RQL.AST2SQLite.pas"/>
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.RQL.Parser.pas"/>
|
||||
<DCCReference Include="Entities.pas"/>
|
||||
<DCCReference Include="EntitiesProcessors.pas"/>
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.Nullables.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
250
unittests/general/Several/Entities.pas
Normal file
250
unittests/general/Several/Entities.pas
Normal file
@ -0,0 +1,250 @@
|
||||
unit Entities;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
MVCFramework.Serializer.Commons,
|
||||
MVCFramework.ActiveRecord,
|
||||
MVCFramework.Nullables,
|
||||
System.Classes,
|
||||
MVCFramework, System.Generics.Collections;
|
||||
|
||||
type
|
||||
|
||||
[MVCNameCase(ncLowerCase)]
|
||||
[MVCTable('people')]
|
||||
[MVCEntityActions([eaCreate, eaRetrieve, eaUpdate, eaDelete])]
|
||||
TPerson = class(TMVCActiveRecord)
|
||||
private
|
||||
[MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
|
||||
fID: Int64;
|
||||
[MVCTableField('LAST_NAME')]
|
||||
fLastName: string;
|
||||
[MVCTableField('FIRST_NAME')]
|
||||
fFirstName: string;
|
||||
[MVCTableField('DOB')]
|
||||
fDOB: NullableTDate;
|
||||
[MVCTableField('FULL_NAME')]
|
||||
fFullName: string;
|
||||
[MVCTableField('IS_MALE')]
|
||||
fIsMale: NullableBoolean;
|
||||
[MVCTableField('NOTE')]
|
||||
fNote: string;
|
||||
[MVCTableField('PHOTO')]
|
||||
fPhoto: TStream;
|
||||
|
||||
// transient fields
|
||||
fAge: NullableInt32;
|
||||
|
||||
procedure SetLastName(const Value: string);
|
||||
procedure SetID(const Value: Int64);
|
||||
procedure SetFirstName(const Value: string);
|
||||
procedure SetDOB(const Value: NullableTDate);
|
||||
function GetFullName: string;
|
||||
procedure SetIsMale(const Value: NullableBoolean);
|
||||
procedure SetNote(const Value: string);
|
||||
protected
|
||||
procedure OnAfterLoad; override;
|
||||
procedure OnBeforeInsertOrUpdate; override;
|
||||
procedure OnValidation(const Action: TMVCEntityAction); override;
|
||||
procedure OnBeforeInsert; override;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
property ID: Int64 read fID write SetID;
|
||||
property LastName: string read fLastName write SetLastName;
|
||||
property FirstName: string read fFirstName write SetFirstName;
|
||||
property Age: NullableInt32 read fAge;
|
||||
property DOB: NullableTDate read fDOB write SetDOB;
|
||||
property FullName: string read GetFullName;
|
||||
property IsMale: NullableBoolean read fIsMale write SetIsMale;
|
||||
property Note: string read fNote write SetNote;
|
||||
property Photo: TStream read fPhoto;
|
||||
end;
|
||||
|
||||
[MVCNameCase(ncLowerCase)]
|
||||
[MVCTable('phones')]
|
||||
[MVCEntityActions([eaCreate, eaRetrieve, eaUpdate, eaDelete])]
|
||||
TPhone = class(TMVCActiveRecord)
|
||||
private
|
||||
[MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
|
||||
fID: Integer;
|
||||
[MVCTableField('phone_number')]
|
||||
fPhoneNumber: string;
|
||||
[MVCTableField('number_type')]
|
||||
fNumberType: string;
|
||||
[MVCTableField('id_person')]
|
||||
fIDPerson: Integer;
|
||||
protected
|
||||
procedure OnValidation(const Action: TMVCEntityAction); override;
|
||||
public
|
||||
property ID: Integer read fID write fID;
|
||||
property IDPerson: Integer read fIDPerson write fIDPerson;
|
||||
property PhoneNumber: string read fPhoneNumber write fPhoneNumber;
|
||||
property NumberType: string read fNumberType write fNumberType;
|
||||
end;
|
||||
|
||||
[MVCNameCase(ncLowerCase)]
|
||||
[MVCTable('PEOPLE')]
|
||||
[MVCEntityActions([eaCreate, eaRetrieve, eaUpdate, eaDelete])]
|
||||
TContact = class(TPerson)
|
||||
private
|
||||
function GetPhones: TObjectList<TPhone>;
|
||||
public
|
||||
property Phones: TObjectList<TPhone> read GetPhones;
|
||||
end;
|
||||
|
||||
[MVCNameCase(ncLowerCase)]
|
||||
[MVCTable('articles')]
|
||||
[MVCEntityActions([eaCreate, eaRetrieve, eaUpdate, eaDelete])]
|
||||
TArticle = class(TMVCActiveRecord)
|
||||
private
|
||||
[MVCTableField('id', [foPrimaryKey, foAutoGenerated])]
|
||||
fID: Int64;
|
||||
[MVCTableField('price')]
|
||||
FPrice: UInt32;
|
||||
[MVCTableField('description')]
|
||||
FDescription: string;
|
||||
procedure SetID(const Value: Int64);
|
||||
procedure SetDescription(const Value: string);
|
||||
procedure SetPrice(const Value: UInt32);
|
||||
public
|
||||
property ID: Int64 read fID write SetID;
|
||||
property Description: string read FDescription write SetDescription;
|
||||
property Price: UInt32 read FPrice write SetPrice;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.DateUtils,
|
||||
System.SysUtils;
|
||||
|
||||
{ TPersona }
|
||||
|
||||
constructor TPerson.Create;
|
||||
begin
|
||||
inherited;
|
||||
fPhoto := TMemoryStream.Create;
|
||||
end;
|
||||
|
||||
destructor TPerson.Destroy;
|
||||
begin
|
||||
fPhoto.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TPerson.GetFullName: string;
|
||||
begin
|
||||
Result := fFullName;
|
||||
end;
|
||||
|
||||
procedure TPerson.OnAfterLoad;
|
||||
begin
|
||||
inherited;
|
||||
if fDOB.HasValue then
|
||||
begin
|
||||
fAge := Yearsbetween(fDOB, now);
|
||||
end
|
||||
else
|
||||
begin
|
||||
fAge.Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPerson.OnBeforeInsert;
|
||||
begin
|
||||
inherited;
|
||||
// TMemoryStream(fPhoto).LoadFromFile('C:\DEV\dmvcframework\samples\_\customer_small.png');
|
||||
end;
|
||||
|
||||
procedure TPerson.OnBeforeInsertOrUpdate;
|
||||
begin
|
||||
inherited;
|
||||
fLastName := fLastName.ToUpper;
|
||||
fFirstName := fFirstName.ToUpper;
|
||||
fFullName := fFirstName + ' ' + fLastName;
|
||||
end;
|
||||
|
||||
procedure TPerson.OnValidation(const Action: TMVCEntityAction);
|
||||
begin
|
||||
inherited;
|
||||
if fLastName.Trim.IsEmpty or fFirstName.Trim.IsEmpty then
|
||||
raise EMVCActiveRecord.Create
|
||||
('Validation error. FirstName and LastName are required');
|
||||
end;
|
||||
|
||||
procedure TPerson.SetLastName(const Value: string);
|
||||
begin
|
||||
fLastName := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetNote(const Value: string);
|
||||
begin
|
||||
fNote := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetDOB(const Value: NullableTDate);
|
||||
begin
|
||||
fDOB := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetID(const Value: Int64);
|
||||
begin
|
||||
fID := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetIsMale(const Value: NullableBoolean);
|
||||
begin
|
||||
fIsMale := Value;
|
||||
end;
|
||||
|
||||
procedure TPerson.SetFirstName(const Value: string);
|
||||
begin
|
||||
fFirstName := Value;
|
||||
end;
|
||||
|
||||
{ TArticle }
|
||||
|
||||
procedure TArticle.SetDescription(const Value: string);
|
||||
begin
|
||||
FDescription := Value;
|
||||
end;
|
||||
|
||||
procedure TArticle.SetID(const Value: Int64);
|
||||
begin
|
||||
fID := Value;
|
||||
end;
|
||||
|
||||
procedure TArticle.SetPrice(const Value: UInt32);
|
||||
begin
|
||||
FPrice := Value;
|
||||
end;
|
||||
|
||||
{ TPhone }
|
||||
|
||||
procedure TPhone.OnValidation(const Action: TMVCEntityAction);
|
||||
begin
|
||||
inherited;
|
||||
if fPhoneNumber.Trim.IsEmpty then
|
||||
raise EMVCActiveRecord.Create('Phone Number cannot be empty');
|
||||
end;
|
||||
|
||||
{ TContact }
|
||||
|
||||
function TContact.GetPhones: TObjectList<TPhone>;
|
||||
begin
|
||||
Result := TMVCActiveRecord.SelectRQL<TPhone>('eq(IDPerson, ' +
|
||||
self.ID.ToString + ')', 100);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
ActiveRecordMappingRegistry.AddEntity('people', TPerson);
|
||||
ActiveRecordMappingRegistry.AddEntity('contacts', TContact);
|
||||
ActiveRecordMappingRegistry.AddEntity('phones', TPhone);
|
||||
ActiveRecordMappingRegistry.AddEntity('articles', TArticle);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
245
unittests/general/Several/EntitiesProcessors.pas
Normal file
245
unittests/general/Several/EntitiesProcessors.pas
Normal file
@ -0,0 +1,245 @@
|
||||
unit EntitiesProcessors;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
MVCFramework.ActiveRecord,
|
||||
MVCFramework,
|
||||
MVCFramework.Serializer.Intf;
|
||||
|
||||
type
|
||||
TArticleProcessor = class(TInterfacedObject, IMVCEntityProcessor)
|
||||
public
|
||||
procedure CreateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string;
|
||||
var Handled: Boolean);
|
||||
procedure GetEntities(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string;
|
||||
var Handled: Boolean);
|
||||
procedure GetEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
procedure UpdateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
procedure DeleteEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
end;
|
||||
|
||||
TContactProcessor = class(TInterfacedObject, IMVCEntityProcessor)
|
||||
public
|
||||
procedure CreateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string;
|
||||
var Handled: Boolean);
|
||||
procedure GetEntities(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string;
|
||||
var Handled: Boolean);
|
||||
procedure GetEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
procedure UpdateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
procedure DeleteEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TArticleProcessor }
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
Entities,
|
||||
MVCFramework.Serializer.JsonDataObjects,
|
||||
JsonDataObjects,
|
||||
MVCFramework.Serializer.Commons,
|
||||
System.Generics.Collections,
|
||||
MVCFramework.DuckTyping, MVCFramework.Commons, System.NetEncoding;
|
||||
|
||||
procedure TArticleProcessor.CreateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
|
||||
var
|
||||
lArticle: TArticle;
|
||||
begin
|
||||
lArticle := Context.Request.BodyAs<TArticle>;
|
||||
try
|
||||
lArticle.Insert;
|
||||
Renderer.Render(lArticle, False);
|
||||
finally
|
||||
lArticle.Free;
|
||||
end;
|
||||
Handled := True;
|
||||
end;
|
||||
|
||||
procedure TArticleProcessor.DeleteEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
begin
|
||||
Handled := False;
|
||||
end;
|
||||
|
||||
procedure TArticleProcessor.GetEntities(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
|
||||
begin
|
||||
Handled := True;
|
||||
Renderer.Render(ObjectDict().Add('data', TMVCActiveRecord.All<TArticle>,
|
||||
procedure(const AObject: TObject; const Links: IMVCLinks)
|
||||
begin
|
||||
Links.AddRefLink
|
||||
.Add(HATEOAS.HREF, 'https://www.google.com/search?q=' + TNetEncoding.URL.EncodeQuery(TArticle(AObject).Description))
|
||||
.Add(HATEOAS._TYPE, 'text/html')
|
||||
.Add(HATEOAS.REL, 'googlesearch');
|
||||
end));
|
||||
end;
|
||||
|
||||
procedure TArticleProcessor.GetEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
begin
|
||||
Handled := False;
|
||||
end;
|
||||
|
||||
procedure TArticleProcessor.UpdateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
begin
|
||||
Handled := False;
|
||||
end;
|
||||
|
||||
{ TPeopleProcessor }
|
||||
|
||||
procedure TContactProcessor.CreateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
|
||||
var
|
||||
lSer: TMVCJsonDataObjectsSerializer;
|
||||
lJSON: TJsonObject;
|
||||
lPerson: TPerson;
|
||||
lPhones: TObjectList<TPhone>;
|
||||
lPhone: TPhone;
|
||||
lID: Int64;
|
||||
begin
|
||||
Handled := True;
|
||||
|
||||
// If you have an entity already defined you can use the usual BodyAs<T>, if not
|
||||
// you have to deserialize request body manually
|
||||
lSer := TMVCJsonDataObjectsSerializer.Create;
|
||||
try
|
||||
lJSON := lSer.ParseObject(Context.Request.Body);
|
||||
try
|
||||
lPerson := TPerson.Create;
|
||||
try
|
||||
// deserialize person
|
||||
lSer.JsonObjectToObject(lJSON, lPerson,
|
||||
TMVCSerializationType.stDefault, nil);
|
||||
|
||||
lPhones := TObjectList<TPhone>.Create(True);
|
||||
try
|
||||
// deserialize phones
|
||||
lSer.JsonArrayToList(lJSON.A['phones'], WrapAsList(lPhones), TPhone,
|
||||
TMVCSerializationType.stDefault, nil);
|
||||
|
||||
// persist to database using transaction
|
||||
TMVCActiveRecord.CurrentConnection.StartTransaction;
|
||||
try
|
||||
lPerson.Insert; // insert Person
|
||||
lID := lPerson.id;
|
||||
for lPhone in lPhones do
|
||||
begin
|
||||
lPhone.IDPerson := lPerson.id;
|
||||
lPhone.Insert; // insert phone
|
||||
end;
|
||||
TMVCActiveRecord.CurrentConnection.Commit;
|
||||
except
|
||||
TMVCActiveRecord.CurrentConnection.Rollback;
|
||||
raise;
|
||||
end;
|
||||
|
||||
finally
|
||||
lPhones.Free;
|
||||
end;
|
||||
finally
|
||||
lPerson.Free;
|
||||
end;
|
||||
finally
|
||||
lJSON.Free;
|
||||
end;
|
||||
finally
|
||||
lSer.Free;
|
||||
end;
|
||||
Context.Response.CustomHeaders.Values['X-REF'] := Context.Request.PathInfo +
|
||||
'/' + lID.ToString;
|
||||
Renderer.Render(TMVCResponse.Create(201, 'Contact created with phones', ''));
|
||||
end;
|
||||
|
||||
procedure TContactProcessor.DeleteEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
begin
|
||||
Handled := False; // inherit the default behaviour
|
||||
end;
|
||||
|
||||
procedure TContactProcessor.GetEntities(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; var Handled: Boolean);
|
||||
begin
|
||||
Handled := False; // inherit the default behaviour
|
||||
end;
|
||||
|
||||
procedure TContactProcessor.GetEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
var
|
||||
lContact: TContact;
|
||||
lSer: TMVCJsonDataObjectsSerializer;
|
||||
lJSON: TJsonObject;
|
||||
lPhones: TObjectList<TPhone>;
|
||||
begin
|
||||
// You can write your own entity which already load relations
|
||||
// The following is the manual approach
|
||||
lContact := TMVCActiveRecord.GetByPK<TContact>(id);
|
||||
try
|
||||
lPhones := TMVCActiveRecord.Where<TPhone>('id_person = ?', [id]);
|
||||
try
|
||||
lSer := TMVCJsonDataObjectsSerializer.Create;
|
||||
try
|
||||
lJSON := TJsonObject.Create;
|
||||
try
|
||||
lSer.ObjectToJsonObject(lContact, lJSON,
|
||||
TMVCSerializationType.stDefault, nil);
|
||||
lSer.ListToJsonArray(WrapAsList(lPhones), lJSON.A['phones'],
|
||||
TMVCSerializationType.stDefault, nil);
|
||||
Renderer.Render(lJSON, False);
|
||||
finally
|
||||
lJSON.Free;
|
||||
end;
|
||||
finally
|
||||
lSer.Free;
|
||||
end;
|
||||
finally
|
||||
lPhones.Free;
|
||||
end;
|
||||
finally
|
||||
lContact.Free;
|
||||
end;
|
||||
Handled := True;
|
||||
end;
|
||||
|
||||
procedure TContactProcessor.UpdateEntity(const Context: TWebContext;
|
||||
const Renderer: TMVCRenderer; const entityname: string; const id: Integer;
|
||||
var Handled: Boolean);
|
||||
begin
|
||||
Handled := False; // inherit the default behaviour
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
ActiveRecordMappingRegistry.AddEntityProcessor('articles',
|
||||
TArticleProcessor.Create);
|
||||
ActiveRecordMappingRegistry.AddEntityProcessor('contacts',
|
||||
TContactProcessor.Create);
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
@ -45,7 +45,7 @@ type
|
||||
[Setup]
|
||||
procedure Setup; virtual;
|
||||
[TearDown]
|
||||
procedure TearDown;
|
||||
procedure TearDown; virtual;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -1,5 +1,4 @@
|
||||
object TestWebModule2: TTestWebModule2
|
||||
OldCreateOrder = False
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <
|
||||
@ -22,11 +22,8 @@ type
|
||||
procedure HelloWorld(ctx: TWebContext);
|
||||
end;
|
||||
|
||||
|
||||
[TestFixture]
|
||||
TTestServerContainer = class(TObject)
|
||||
private
|
||||
|
||||
protected
|
||||
[SetUp]
|
||||
procedure SetUp;
|
||||
@ -66,45 +63,37 @@ procedure TTestServerContainer.TestListener;
|
||||
var
|
||||
lListener: IMVCListener;
|
||||
begin
|
||||
LListener := TMVCListener.Create(TMVCListenerProperties.New
|
||||
.SetName('Listener1')
|
||||
.SetPort(5000)
|
||||
.SetMaxConnections(512)
|
||||
.SetWebModuleClass(TestWebModuleClass)
|
||||
);
|
||||
lListener := TMVCListener.Create(TMVCListenerProperties.New.SetName('Listener1').SetPort(5000).SetMaxConnections(512)
|
||||
.SetWebModuleClass(TestWebModuleClass));
|
||||
|
||||
Assert.isTrue(Assigned(LListener));
|
||||
Assert.IsTrue(Assigned(lListener));
|
||||
|
||||
LListener.Start;
|
||||
Assert.isTrue(LListener.Active);
|
||||
lListener.Start;
|
||||
Assert.IsTrue(lListener.Active);
|
||||
|
||||
LListener.Stop;
|
||||
Assert.isFalse(LListener.Active);
|
||||
lListener.Stop;
|
||||
Assert.IsFalse(lListener.Active);
|
||||
end;
|
||||
|
||||
procedure TTestServerContainer.TestServerListenerAndClient;
|
||||
var
|
||||
LListener: IMVCListener;
|
||||
lListener: IMVCListener;
|
||||
LClient: IMVCRESTClient;
|
||||
begin
|
||||
LListener := TMVCListener.Create(TMVCListenerProperties.New
|
||||
.SetName('Listener1')
|
||||
.SetPort(6000)
|
||||
.SetMaxConnections(1024)
|
||||
.SetWebModuleClass(TestWebModuleClass)
|
||||
);
|
||||
lListener := TMVCListener.Create(TMVCListenerProperties.New.SetName('Listener1').SetPort(6000).SetMaxConnections(1024)
|
||||
.SetWebModuleClass(TestWebModuleClass));
|
||||
|
||||
Assert.isTrue(Assigned(LListener));
|
||||
Assert.IsTrue(Assigned(lListener));
|
||||
|
||||
LListener.Start;
|
||||
Assert.isTrue(LListener.Active);
|
||||
lListener.Start;
|
||||
Assert.IsTrue(lListener.Active);
|
||||
|
||||
LClient := TMVCRESTClient.New.BaseURL('localhost', 6000);
|
||||
LClient.SetBasicAuthorization('dmvc', '123');
|
||||
Assert.AreEqual('Hello World called with GET', LClient.Get('/hello').Content);
|
||||
|
||||
LListener.Stop;
|
||||
Assert.isFalse(LListener.Active);
|
||||
lListener.Stop;
|
||||
Assert.IsFalse(lListener.Active);
|
||||
end;
|
||||
|
||||
procedure TTestServerContainer.TestListenerContext;
|
||||
@ -113,39 +102,29 @@ var
|
||||
begin
|
||||
LListenerCtx := TMVCListenersContext.Create;
|
||||
|
||||
LListenerCtx.Add(TMVCListenerProperties.New
|
||||
.SetName('Listener2')
|
||||
.SetPort(6000)
|
||||
.SetMaxConnections(1024)
|
||||
.SetWebModuleClass(TestWebModuleClass)
|
||||
);
|
||||
LListenerCtx.Add(TMVCListenerProperties.New.SetName('Listener2').SetPort(6000).SetMaxConnections(1024)
|
||||
.SetWebModuleClass(TestWebModuleClass));
|
||||
|
||||
LListenerCtx.Add(TMVCListenerProperties.New
|
||||
.SetName('Listener3')
|
||||
.SetPort(7000)
|
||||
.SetMaxConnections(1024)
|
||||
.SetWebModuleClass(TestWebModuleClass2)
|
||||
);
|
||||
LListenerCtx.Add(TMVCListenerProperties.New.SetName('Listener3').SetPort(7000).SetMaxConnections(1024)
|
||||
.SetWebModuleClass(TestWebModuleClass2));
|
||||
|
||||
Assert.isTrue(Assigned(LListenerCtx.FindByName('Listener2')));
|
||||
Assert.isTrue(Assigned(LListenerCtx.FindByName('Listener3')));
|
||||
Assert.IsTrue(Assigned(LListenerCtx.FindByName('Listener2')));
|
||||
Assert.IsTrue(Assigned(LListenerCtx.FindByName('Listener3')));
|
||||
|
||||
LListenerCtx.StartAll;
|
||||
|
||||
Assert.isTrue(LListenerCtx.Count = 2);
|
||||
Assert.isTrue(LListenerCtx.FindByName('Listener2').Active);
|
||||
Assert.isTrue(LListenerCtx.FindByName('Listener3').Active);
|
||||
Assert.IsTrue(LListenerCtx.Count = 2);
|
||||
Assert.IsTrue(LListenerCtx.FindByName('Listener2').Active);
|
||||
Assert.IsTrue(LListenerCtx.FindByName('Listener3').Active);
|
||||
|
||||
LListenerCtx.StopAll;
|
||||
|
||||
Assert.isFalse(LListenerCtx.FindByName('Listener2').Active);
|
||||
Assert.isFalse(LListenerCtx.FindByName('Listener3').Active);
|
||||
Assert.IsFalse(LListenerCtx.FindByName('Listener2').Active);
|
||||
Assert.IsFalse(LListenerCtx.FindByName('Listener3').Active);
|
||||
|
||||
LListenerCtx
|
||||
.Remove('Listener2')
|
||||
.Remove('Listener3');
|
||||
LListenerCtx.Remove('Listener2').Remove('Listener3');
|
||||
|
||||
Assert.isTrue(LListenerCtx.Count = 0);
|
||||
Assert.IsTrue(LListenerCtx.Count = 0);
|
||||
end;
|
||||
|
||||
{ TTestController }
|
||||
@ -160,4 +139,3 @@ initialization
|
||||
TDUnitX.RegisterTestFixture(TTestServerContainer);
|
||||
|
||||
end.
|
||||
|
||||
@ -0,0 +1,7 @@
|
||||
object ActiveRecordControllerWebModule: TActiveRecordControllerWebModule
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <>
|
||||
Height = 230
|
||||
Width = 415
|
||||
end
|
||||
@ -0,0 +1,89 @@
|
||||
unit ActiveRecordControllerWebModuleU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
Web.HTTPApp,
|
||||
MVCFramework,
|
||||
FireDAC.Stan.Intf,
|
||||
FireDAC.Stan.Option,
|
||||
FireDAC.Stan.Error,
|
||||
FireDAC.UI.Intf,
|
||||
FireDAC.Phys.Intf,
|
||||
FireDAC.Stan.Def,
|
||||
FireDAC.Stan.Pool,
|
||||
FireDAC.Stan.Async,
|
||||
FireDAC.Phys,
|
||||
FireDAC.Phys.MySQL,
|
||||
FireDAC.Phys.MySQLDef,
|
||||
FireDAC.VCLUI.Wait,
|
||||
Data.DB,
|
||||
FireDAC.Comp.Client,
|
||||
FireDAC.Stan.Param,
|
||||
FireDAC.DatS,
|
||||
FireDAC.DApt.Intf,
|
||||
FireDAC.DApt,
|
||||
FireDAC.Comp.DataSet;
|
||||
|
||||
|
||||
const
|
||||
AR_CONTROLLER_CON_DEF_NAME = 'AR_CONTROLLER_CON_DEF_NAME';
|
||||
|
||||
type
|
||||
TActiveRecordControllerWebModule = class(TWebModule)
|
||||
procedure WebModuleCreate(Sender: TObject);
|
||||
procedure WebModuleDestroy(Sender: TObject);
|
||||
private
|
||||
FMVC: TMVCEngine;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
System.IOUtils,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.ActiveRecordController,
|
||||
MVCFramework.ActiveRecord,
|
||||
MVCFramework.Middleware.StaticFiles,
|
||||
FDConnectionConfigU;
|
||||
|
||||
procedure TActiveRecordControllerWebModule.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FMVC := TMVCEngine.Create(Self,
|
||||
procedure(Config: TMVCConfig)
|
||||
begin
|
||||
// session timeout (0 means session cookie)
|
||||
Config[TMVCConfigKey.SessionTimeout] := '0';
|
||||
// default content-type
|
||||
Config[TMVCConfigKey.DefaultContentType] := TMVCConstants.DEFAULT_CONTENT_TYPE;
|
||||
// default content charset
|
||||
Config[TMVCConfigKey.DefaultContentCharset] := TMVCConstants.DEFAULT_CONTENT_CHARSET;
|
||||
// unhandled actions are permitted?
|
||||
Config[TMVCConfigKey.AllowUnhandledAction] := 'false';
|
||||
// default view file extension
|
||||
Config[TMVCConfigKey.DefaultViewFileExtension] := 'html';
|
||||
// view path
|
||||
Config[TMVCConfigKey.ViewPath] := 'templates';
|
||||
// Enable Server Signature in response
|
||||
Config[TMVCConfigKey.ExposeServerSignature] := 'true';
|
||||
end);
|
||||
|
||||
FMVC.AddController(TMVCActiveRecordController,
|
||||
function: TMVCController
|
||||
begin
|
||||
Result := TMVCActiveRecordController.Create(AR_CONTROLLER_CON_DEF_NAME);
|
||||
end, '/api/entities');
|
||||
end;
|
||||
|
||||
procedure TActiveRecordControllerWebModule.WebModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
FMVC.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -0,0 +1,12 @@
|
||||
object TestWebModule2: TTestWebModule2
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <
|
||||
item
|
||||
Default = True
|
||||
Name = 'DefaultHandler'
|
||||
PathInfo = '/'
|
||||
end>
|
||||
Height = 230
|
||||
Width = 415
|
||||
end
|
||||
@ -0,0 +1,66 @@
|
||||
unit StandAloneServerWebModuleTest;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Web.HTTPApp,
|
||||
MVCFramework;
|
||||
|
||||
type
|
||||
|
||||
TTestWebModule2 = class(TWebModule)
|
||||
procedure WebModuleCreate(Sender: TObject);
|
||||
procedure WebModuleDestroy(Sender: TObject);
|
||||
private
|
||||
FMVCEngine: TMVCEngine;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
TestWebModuleClass: TComponentClass = TTestWebModule2;
|
||||
TestWebModuleClass2: TComponentClass = TTestWebModule2;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
MVCFramework.Middleware.Authentication,
|
||||
MVCFramework.Server,
|
||||
MVCFramework.Server.Impl,
|
||||
StandaloneServerTestU;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TTestWebModule2.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FMVCEngine := TMVCEngine.Create(Self);
|
||||
|
||||
// Add With Delegate Constructor Controller
|
||||
FMVCEngine.AddController(TTestController,
|
||||
function: TMVCController
|
||||
begin
|
||||
Result := TTestController.Create;
|
||||
end
|
||||
);
|
||||
|
||||
FMVCEngine.AddMiddleware(TMVCBasicAuthenticationMiddleware.Create(
|
||||
TMVCDefaultAuthenticationHandler.New
|
||||
.SetOnAuthentication(
|
||||
procedure(const AUserName, APassword: string;
|
||||
AUserRoles: TList<string>; var IsValid: Boolean; const ASessionData: TDictionary<String, String>)
|
||||
begin
|
||||
IsValid := AUserName.Equals('dmvc') and APassword.Equals('123');
|
||||
end
|
||||
)
|
||||
));
|
||||
end;
|
||||
|
||||
procedure TTestWebModule2.WebModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
FMVCEngine.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -1,5 +1,4 @@
|
||||
object MyWebModule: TMyWebModule
|
||||
OldCreateOrder = False
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <>
|
||||
|
||||
@ -73,23 +73,7 @@ begin
|
||||
FMVC.AddController(TMVCActiveRecordController,
|
||||
function: TMVCController
|
||||
begin
|
||||
Result := TMVCActiveRecordController.Create(
|
||||
function: TFDConnection
|
||||
begin
|
||||
Result := TFDConnection.Create(nil);
|
||||
Result.ConnectionDefName := CON_DEF_NAME;
|
||||
end,
|
||||
function(aContext: TWebContext; aClass: TMVCActiveRecordClass; aAction: TMVCActiveRecordAction): Boolean
|
||||
begin
|
||||
if aContext.LoggedUser.IsValid then
|
||||
begin
|
||||
Result := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := True; // not(aAction in [TMVCActiveRecordAction.Delete]);
|
||||
end;
|
||||
end);
|
||||
Result := TMVCActiveRecordController.Create(CON_DEF_NAME);
|
||||
end, '/api/entities');
|
||||
end;
|
||||
|
||||
|
||||
@ -25,7 +25,10 @@ uses
|
||||
RandomUtilsU in '..\..\..\samples\commons\RandomUtilsU.pas',
|
||||
MVCFramework.Serializer.HTML in '..\..\..\sources\MVCFramework.Serializer.HTML.pas',
|
||||
MVCFramework.Tests.Serializer.Entities in '..\..\common\MVCFramework.Tests.Serializer.Entities.pas',
|
||||
MVCFramework.Router in '..\..\..\sources\MVCFramework.Router.pas';
|
||||
MVCFramework.Router in '..\..\..\sources\MVCFramework.Router.pas',
|
||||
FDConnectionConfigU in '..\..\common\FDConnectionConfigU.pas',
|
||||
Entities in '..\Several\Entities.pas',
|
||||
EntitiesProcessors in '..\Several\EntitiesProcessors.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@ -121,6 +121,9 @@
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.Serializer.HTML.pas"/>
|
||||
<DCCReference Include="..\..\common\MVCFramework.Tests.Serializer.Entities.pas"/>
|
||||
<DCCReference Include="..\..\..\sources\MVCFramework.Router.pas"/>
|
||||
<DCCReference Include="..\..\common\FDConnectionConfigU.pas"/>
|
||||
<DCCReference Include="..\Several\Entities.pas"/>
|
||||
<DCCReference Include="..\Several\EntitiesProcessors.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@ -58,6 +58,7 @@ uses
|
||||
TestServerControllerExceptionU,
|
||||
SpeedMiddlewareU,
|
||||
MVCFramework.Middleware.Authentication,
|
||||
MVCFramework.ActiveRecordController,
|
||||
System.Generics.Collections,
|
||||
MVCFramework.Commons,
|
||||
TestServerControllerPrivateU,
|
||||
@ -67,7 +68,8 @@ uses
|
||||
MVCFramework.View.Renderers.Mustache,
|
||||
{$ENDIF}
|
||||
MVCFramework.Middleware.Compression,
|
||||
MVCFramework.Middleware.StaticFiles;
|
||||
MVCFramework.Middleware.StaticFiles, FireDAC.Comp.Client,
|
||||
MVCFramework.ActiveRecord, FDConnectionConfigU;
|
||||
|
||||
procedure TMainWebModule.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
@ -90,6 +92,11 @@ begin
|
||||
.AddController(TTestMultiPathController)
|
||||
.AddController(TTestJSONRPCController, '/jsonrpc')
|
||||
.AddController(TTestJSONRPCControllerWithGet, '/jsonrpcwithget')
|
||||
.AddController(TMVCActiveRecordController,
|
||||
function: TMVCController
|
||||
begin
|
||||
Result := TMVCActiveRecordController.Create(CON_DEF_NAME);
|
||||
end, '/api/entities')
|
||||
.PublishObject(
|
||||
function: TObject
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user