delphimvcframework/sources/MVCFramework.ActiveRecord.pas

2384 lines
66 KiB
ObjectPascal
Raw Normal View History

// *************************************************************************** }
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// ***************************************************************************
unit MVCFramework.ActiveRecord;
{$I dmvcframework.inc}
interface
uses
System.Generics.Defaults,
System.Generics.Collections,
System.RTTI,
FireDAC.DApt,
Data.DB,
FireDAC.Comp.Client,
FireDAC.Stan.Def,
FireDAC.Stan.Pool,
FireDAC.Stan.Async,
FireDAC.Stan.Param,
System.SysUtils,
MVCFramework,
MVCFramework.Commons,
MVCFramework.RQL.Parser,
MVCFramework.Serializer.Intf, MVCFramework.Serializer.Commons;
type
EMVCActiveRecord = class(EMVCException)
public
constructor Create(const AMsg: string); reintroduce; { do not override!! }
end;
EMVCActiveRecordNotFound = class(EMVCActiveRecord)
public
procedure AfterConstruction; override;
end;
TMVCActiveRecordClass = class of TMVCActiveRecord;
TMVCActiveRecordFieldOption = (foPrimaryKey, foAutoGenerated, foTransient);
TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption;
TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete);
TMVCEntityActions = set of TMVCEntityAction;
TMVCActiveRecordLoadOption = (loIgnoreNotExistentFields);
TMVCActiveRecordLoadOptions = set of TMVCActiveRecordLoadOption;
IMVCEntityProcessor = interface
['{E7CD11E6-9FF9-46D2-B7B0-DA5B38EAA14E}']
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 CreateEntity(const Context: TWebContext; const Renderer: TMVCRenderer; const entityname: string;
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;
MVCActiveRecordCustomAttribute = class(TCustomAttribute)
end;
MVCTableAttribute = class(MVCActiveRecordCustomAttribute)
2019-01-08 12:48:27 +01:00
public
Name: string;
constructor Create(aName: string);
end;
MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute)
public
FieldName: string;
2019-02-15 12:21:11 +01:00
FieldOptions: TMVCActiveRecordFieldOptions;
SequenceName: string;
constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
const aSequenceName: String = ''); overload;
2019-02-15 12:21:11 +01:00
constructor Create(aFieldName: string); overload;
end;
MVCPrimaryKeyAttribute = MVCTableFieldAttribute deprecated '(ERROR) Use MVCTableFieldAttribute';
MVCEntityActionsAttribute = class(MVCActiveRecordCustomAttribute)
private
EntityAllowedActions: TMVCEntityActions;
public
constructor Create(const aEntityAllowedActions: TMVCEntityActions);
end;
TMVCActiveRecord = class;
TMVCSQLGenerator = class;
TMVCActiveRecordList = class(TObjectList<TMVCActiveRecord>)
public
constructor Create; virtual;
end;
TMVCActiveRecord = class
private
fConn: TFDConnection;
fSQLGenerator: TMVCSQLGenerator;
fPrimaryKeyFieldName: string;
fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
fPrimaryKeySequenceName: String;
fEntityAllowedActions: TMVCEntityActions;
fRQL2SQL: TRQL2SQL;
procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam);
function MapNullableTValueToParam(aValue: TValue;
const aParam: TFDParam): Boolean;
function GetPrimaryKeyIsAutogenerated: Boolean;
procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
protected
fRTTIType: TRttiInstanceType;
fProps: TArray<TRttiField>;
fObjAttributes: TArray<TCustomAttribute>;
fPropsAttributes: TArray<TCustomAttribute>;
fTableName: string;
fMap: TDictionary<TRttiField, string>;
fMapNonTransientFields: TDictionary<TRttiField, string>;
fPrimaryKey: TRttiField;
fBackendDriver: string;
fMapping: TMVCFieldsMapping;
function GetBackEnd: string;
function GetConnection: TFDConnection;
procedure InitTableInfo;
class function ExecQuery(const SQL: string; const Values: array of Variant): TDataSet; overload;
class function ExecQuery(const SQL: string; const Values: array of Variant; const Connection: TFDConnection)
: TDataSet; overload;
procedure FillPrimaryKey(const SequenceName: String);
function ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64; overload;
// load events
/// <summary>
/// Called everywhere before persist object into database
/// </summary>
procedure OnValidation; virtual;
/// <summary>
/// Called just after load the object state from database
/// </summary>
procedure OnAfterLoad; virtual;
/// <summary>
/// Called before load the object state from database
/// </summary>
procedure OnBeforeLoad; virtual;
/// <summary>
/// Called before insert the object state to database
/// </summary>
procedure OnBeforeInsert; virtual;
/// <summary>
/// Called after insert the object state to database
/// </summary>
procedure OnAfterInsert; virtual;
/// <summary>
/// Called before update the object state to database
/// </summary>
procedure OnBeforeUpdate; virtual;
/// <summary>
/// Called after update the object state to database
/// </summary>
procedure OnAfterUpdate; virtual;
/// <summary>
/// Called before delete object from database
/// </summary>
procedure OnBeforeDelete; virtual;
/// <summary>
/// Called after delete object from database
/// </summary>
procedure OnAfterDelete; virtual;
/// <summary>
/// Called before insert or update the object to the database
/// </summary>
procedure OnBeforeInsertOrUpdate; virtual;
/// <summary>
/// Called before execute sql
/// </summary>
2019-05-09 20:53:52 +02:00
procedure OnBeforeExecuteSQL(var SQL: String); virtual;
/// <summary>
/// Called after insert or update the object to the database
/// </summary>
procedure OnAfterInsertOrUpdate; virtual;
procedure MapObjectToParams(const Params: TFDParams; var Handled: Boolean); virtual;
procedure MapDatasetToObject(const DataSet: TDataSet; const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean); virtual;
function GenerateSelectSQL: string;
function SQLGenerator: TMVCSQLGenerator;
2019-08-02 12:32:23 +02:00
function InternalCount(const RQL: String): int64;
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
public
constructor Create(aLazyLoadConnection: Boolean); overload;
{ cannot be virtual! }
2018-09-28 13:01:46 +02:00
constructor Create; overload; virtual;
destructor Destroy; override;
procedure EnsureConnection;
/// <summary>
/// Executes an Insert or an Update if primary key is defined or not
/// </summary>
procedure Store;
function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean;
procedure Insert;
2018-09-28 13:01:46 +02:00
function GetMapping: TMVCFieldsMapping;
function LoadByPK(id: int64): Boolean; virtual;
procedure Update;
procedure Delete;
function TableInfo: string;
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;
const RaiseExceptionIfNotFound: Boolean = True): TMVCActiveRecord; overload;
class function GetScalar(const SQL: string; const Params: array of Variant): Variant;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant)
: TMVCActiveRecordList; overload;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
class function SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList; overload;
class function DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
function SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList; overload;
class function Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant)
: TMVCActiveRecordList; overload;
class function Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string; const Params: array of Variant;
const Connection: TFDConnection): TMVCActiveRecordList; overload;
class function All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>; overload;
class function DeleteAll(const aClass: TMVCActiveRecordClass): int64; overload;
2019-05-09 20:53:52 +02:00
function Count(const RQL: String = ''): int64; overload;
class function Count(const aClass: TMVCActiveRecordClass; const RQL: String = ''): int64; overload;
class function SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet;
class function CurrentConnection: TFDConnection;
end;
2019-08-02 12:32:23 +02:00
TMVCActiveRecordHelper = class helper for TMVCActiveRecord
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: int64;
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
2019-08-02 12:32:23 +02:00
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string; const MaxRecordCount: Integer)
: TObjectList<T>; overload;
class function All<T: TMVCActiveRecord, constructor>: TObjectList<T>; overload;
class function Count<T: TMVCActiveRecord>(const RQL: String = ''): int64; overload;
class function Where<T: TMVCActiveRecord, constructor>(const SQLWhere: string; const Params: array of Variant)
: TObjectList<T>; overload;
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T;
class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean = True): T;
end;
IMVCEntitiesRegistry = interface
['{BB227BEB-A74A-4637-8897-B13BA938C07B}']
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
procedure AddEntityProcessor(const aURLSegment: string; const aEntityProcessor: IMVCEntityProcessor);
function FindEntityClassByURLSegment(const aURLSegment: string;
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
function FindProcessorByURLSegment(const aURLSegment: string; out aMVCEntityProcessor: IMVCEntityProcessor)
: Boolean;
end;
TMVCEntitiesRegistry = class(TInterfacedObject, IMVCEntitiesRegistry)
private
fEntitiesDict: TDictionary<string, TMVCActiveRecordClass>;
fProcessorsDict: TDictionary<string, IMVCEntityProcessor>;
public
constructor Create; virtual;
destructor Destroy; override;
protected
procedure AddEntityProcessor(const aURLSegment: string; const aEntityProcessor: IMVCEntityProcessor);
procedure AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
function FindEntityClassByURLSegment(const aURLSegment: string;
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
function FindProcessorByURLSegment(const aURLSegment: string; out aMVCEntityProcessor: IMVCEntityProcessor)
: Boolean;
end;
2018-09-28 13:01:46 +02:00
IMVCActiveRecordConnections = interface
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false);
2019-05-09 20:53:52 +02:00
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false);
procedure RemoveConnection(const aName: string);
2019-05-09 20:53:52 +02:00
procedure RemoveDefaultConnection;
procedure SetCurrent(const aName: string);
function GetCurrent: TFDConnection;
function GetCurrentBackend: string;
end;
TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnections)
private type
TConnHolder = class
2019-01-08 12:48:27 +01:00
public
Connection: TFDConnection;
OwnsConnection: Boolean;
destructor Destroy; override;
end;
var
fMREW: TMultiReadExclusiveWriteSynchronizer;
fConnectionsDict: TDictionary<string, TConnHolder>;
fCurrentConnectionsByThread: TDictionary<TThreadID, string>;
function GetKeyName(const aName: string): string;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const aOwns: Boolean = false);
2019-05-09 20:53:52 +02:00
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false);
procedure RemoveConnection(const aName: string);
2019-05-09 20:53:52 +02:00
procedure RemoveDefaultConnection;
procedure SetCurrent(const aName: string);
function GetCurrent: TFDConnection;
function GetByName(const aName: string): TFDConnection;
function GetCurrentBackend: string;
end;
TMVCSQLGenerator = class abstract
private
fMapping: TMVCFieldsMapping;
fCompiler: TRQLCompiler;
fRQL2SQL: TRQL2SQL;
protected
function GetRQLParser: TRQL2SQL;
function GetCompiler: TRQLCompiler;
function GetCompilerClass: TRQLCompilerClass; virtual; abstract;
function GetMapping: TMVCFieldsMapping;
function TableFieldsDelimited(const Map: TDictionary<TRttiField, string>; const PKFieldName: string;
const Delimiter: string): string;
public
constructor Create(Mapping: TMVCFieldsMapping); virtual;
destructor Destroy; override;
// capabilities
function HasSequences: Boolean; virtual;
function HasReturning: Boolean; virtual;
// end-capabilities
function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
const UseArtificialLimit: Boolean = True): string; virtual; abstract;
function CreateSelectSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
function CreateSelectByPKSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: int64): string;
virtual; abstract;
function CreateInsertSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
function CreateUpdateSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
function CreateDeleteSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: int64): string;
virtual; abstract;
function CreateDeleteAllSQL(const TableName: string): string; virtual; abstract;
function CreateSelectCount(const TableName: String): String; virtual; abstract;
function GetSequenceValueSQL(
const PKFieldName: String; const SequenceName: String; const Step: Integer = 1): String; virtual;
end;
TMVCSQLGeneratorClass = class of TMVCSQLGenerator;
TMVCSQLGeneratorRegistry = class sealed
private
class var cInstance: TMVCSQLGeneratorRegistry;
class var
cLock: TObject;
fSQLGenerators: TDictionary<string, TMVCSQLGeneratorClass>;
protected
constructor Create;
public
destructor Destroy; override;
class function Instance: TMVCSQLGeneratorRegistry;
class destructor Destroy;
class constructor Create;
procedure RegisterSQLGenerator(const aBackend: string; const aRQLBackendClass: TMVCSQLGeneratorClass);
procedure UnRegisterSQLGenerator(const aBackend: string);
function GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
end;
2018-09-28 13:01:46 +02:00
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
function GetBackEndByConnection(aConnection: TFDConnection): string;
implementation
uses
System.TypInfo,
System.IOUtils,
System.Classes,
MVCFramework.DataSet.Utils,
MVCFramework.Logger,
MVCFramework.Nullables,
FireDAC.Stan.Option,
Data.FmtBcd, System.Variants;
var
gCtx: TRttiContext;
gEntitiesRegistry: IMVCEntitiesRegistry;
gConnections: IMVCActiveRecordConnections;
gLock: TObject;
function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
2019-08-02 12:32:23 +02:00
case Ord(aConnection.RDBMSKind) of
0:
Exit('unknown');
1:
Exit('oracle');
2:
Exit('mssql');
3:
Exit('msaccess');
4:
Exit('mysql');
5:
Exit('db2');
6:
Exit('sqlanywhere');
7:
Exit('advantage');
8:
Exit('interbase');
9:
Exit('firebird');
10:
Exit('sqlite');
11:
Exit('postgresql');
12:
Exit('nexusdb');
13:
Exit('dataSnap');
14:
Exit('informix');
15:
Exit('teradata');
16:
Exit('mongodb');
17:
Exit('other');
else
raise EMVCActiveRecord.Create('Unknown RDBMS Kind');
end;
end;
2018-09-28 13:01:46 +02:00
function ActiveRecordConnectionsRegistry: IMVCActiveRecordConnections;
begin
if gConnections = nil then // double check here
begin
TMonitor.Enter(gLock);
try
if gConnections = nil then
begin
gConnections := TMVCConnectionsRepository.Create;
end;
finally
TMonitor.Exit(gLock);
end;
end;
Result := gConnections;
end;
function IntToNullableInt(const Value: Integer): NullableInt32;
begin
Result.SetValue(Value);
end;
{ TConnectionsRepository }
procedure TMVCConnectionsRepository.AddConnection(const aName: string; const aConnection: TFDConnection;
const aOwns: Boolean = false);
var
lName: string;
lConnKeyName: string;
lConnHolder: TConnHolder;
begin
lName := aName.ToLower;
lConnKeyName := GetKeyName(lName);
fMREW.BeginWrite;
try
lConnHolder := TConnHolder.Create;
lConnHolder.Connection := aConnection;
lConnHolder.OwnsConnection := aOwns;
fConnectionsDict.Add(lConnKeyName, lConnHolder);
// raise exception on duplicates
if (lName = 'default') and (not fCurrentConnectionsByThread.ContainsKey(TThread.CurrentThread.ThreadID)) then
begin
fCurrentConnectionsByThread.AddOrSetValue(TThread.CurrentThread.ThreadID, lName);
end;
finally
fMREW.EndWrite;
end;
end;
2019-05-09 20:53:52 +02:00
procedure TMVCConnectionsRepository.AddDefaultConnection(
const aConnection: TFDConnection; const aOwns: Boolean);
begin
AddConnection('default', aConnection, aOwns);
end;
constructor TMVCConnectionsRepository.Create;
begin
inherited;
fMREW := TMultiReadExclusiveWriteSynchronizer.Create;
fConnectionsDict := TDictionary<string, TConnHolder>.Create;
fCurrentConnectionsByThread := TDictionary<TThreadID, string>.Create;
end;
destructor TMVCConnectionsRepository.Destroy;
begin
fConnectionsDict.Free;
fCurrentConnectionsByThread.Free;
fMREW.Free;
inherited;
end;
function TMVCConnectionsRepository.GetByName(const aName: string): TFDConnection;
var
lKeyName: string;
lConnHolder: TConnHolder;
begin
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result := nil;
{$ENDIF}
lKeyName := GetKeyName(aName.ToLower);
fMREW.BeginRead;
try
if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
raise Exception.CreateFmt('Unknown connection %s', [aName]);
Result := lConnHolder.Connection;
finally
fMREW.EndRead;
end;
end;
function TMVCConnectionsRepository.GetCurrent: TFDConnection;
var
lName: string;
begin
{$IF not Defined(TokyoOrBetter)}
2019-08-02 12:32:23 +02:00
Result := nil;
{$ENDIF}
fMREW.BeginRead;
try
2019-08-02 12:32:23 +02:00
if fCurrentConnectionsByThread.TryGetValue(TThread.CurrentThread.ThreadID, lName) then
begin
Result := GetByName(lName);
end
else
begin
raise EMVCActiveRecord.Create('No current connection for thread');
end;
finally
fMREW.EndRead;
end;
end;
function TMVCConnectionsRepository.GetCurrentBackend: string;
begin
Result := GetBackEndByConnection(GetCurrent);
end;
function TMVCConnectionsRepository.GetKeyName(const aName: string): string;
begin
2019-08-02 12:32:23 +02:00
Result := Format('%10.10d::%s', [TThread.CurrentThread.ThreadID, aName]);
end;
procedure TMVCConnectionsRepository.RemoveConnection(const aName: string);
var
lName: string;
lKeyName: string;
lConnHolder: TConnHolder;
begin
lName := aName.ToLower;
lKeyName := GetKeyName(lName);
fMREW.BeginWrite;
try
if not fConnectionsDict.TryGetValue(lKeyName, lConnHolder) then
raise Exception.CreateFmt('Unknown connection %s', [aName]);
fConnectionsDict.Remove(lKeyName);
try
FreeAndNil(lConnHolder);
except
on E: Exception do
begin
LogE('ActiveRecord: ' + E.ClassName + ' > ' + E.Message);
raise;
end;
end;
finally
fMREW.EndWrite;
end;
end;
2019-05-09 20:53:52 +02:00
procedure TMVCConnectionsRepository.RemoveDefaultConnection;
begin
RemoveConnection('default');
end;
procedure TMVCConnectionsRepository.SetCurrent(const aName: string);
var
lName: string;
lKeyName: string;
begin
lName := aName.ToLower;
lKeyName := GetKeyName(lName);
fMREW.BeginWrite;
try
if not fConnectionsDict.ContainsKey(lKeyName) then
raise Exception.CreateFmt('Unknown connection %s', [aName]);
2019-08-02 12:32:23 +02:00
fCurrentConnectionsByThread.AddOrSetValue(TThread.CurrentThread.ThreadID, lName);
finally
fMREW.EndWrite;
end;
end;
function ActiveRecordMappingRegistry: IMVCEntitiesRegistry;
begin
if gEntitiesRegistry = nil then
begin
TMonitor.Enter(gLock);
try
if gEntitiesRegistry = nil then
begin
gEntitiesRegistry := TMVCEntitiesRegistry.Create;
end;
finally
TMonitor.Exit(gLock);
end;
end;
Result := gEntitiesRegistry;
end;
{ TableFieldAttribute }
constructor MVCTableFieldAttribute.Create(aFieldName: string);
begin
2019-02-15 12:21:11 +01:00
Create(aFieldName, []);
end;
{ TableAttribute }
constructor MVCTableAttribute.Create(aName: string);
begin
inherited Create;
name := aName;
end;
{ TActiveRecord }
destructor TMVCActiveRecord.Destroy;
begin
fMap.Free;
fMapNonTransientFields.Free;
fSQLGenerator.Free;
fRQL2SQL.Free;
fConn := nil; // do not free it!!
inherited;
end;
procedure TMVCActiveRecord.EnsureConnection;
begin
GetConnection;
end;
function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
var
lQry: TFDQuery;
lPar: TFDParam;
lPair: TPair<TRttiField, string>;
lValue: TValue;
2019-05-09 20:53:52 +02:00
lSQL: String;
lHandled: Boolean;
begin
lQry := TFDQuery.Create(nil);
try
lQry.Connection := GetConnection;
lSQL := SQL;
OnBeforeExecuteSQL(lSQL);
lQry.SQL.Text := lSQL;
lHandled := false;
// lQry.Prepare;
MapObjectToParams(lQry.Params, lHandled);
if not lHandled then
begin
for lPair in fMap do
begin
lPar := lQry.FindParam(lPair.Value);
if lPar <> nil then
begin
lValue := lPair.Key.GetValue(Self);
MapTValueToParam(lValue, lPar);
end
end;
// check if it's the primary key
lPar := lQry.FindParam(fPrimaryKeyFieldName);
if lPar <> nil then
begin
if lPar.DataType = ftUnknown then
begin
{ TODO -oDanieleT -cGeneral : Let's find a smarter way to do this if the engine cannot recognize parameter's datatype }
lPar.DataType := ftLargeint;
end;
MapTValueToParam(fPrimaryKey.GetValue(Self), lPar);
end;
end;
if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated in fPrimaryKeyOptions) and
fPrimaryKeySequenceName.IsEmpty then
begin
lValue := fPrimaryKey.GetValue(Self);
lQry.Open;
if (lValue.Kind = tkRecord) then
begin
2020-02-05 23:46:38 +01:00
MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fPrimaryKey, Self);
// if SameText(lValue.TypeInfo.Name, 'Nullable<System.Integer>') then
// begin
// lInteger :=lQry.FieldByName(fPrimaryKeyFieldName).AsInteger;
// TValue.MakeWithoutCopy(@lInteger, TypeInfo(NullableInteger), lValue);
// //lValue := TValue.From<NullableInteger>(Nullable<Integer>(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger))
// // if lValue.IsType<NullableInt32> then
// // lValue := TValue.From<NullableInt32>(NullableInt32(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger))
// end
// else if SameText(lValue.TypeInfo.Name, 'Nullable<System.Int64>') then
// begin
/// / lLargeInt :=lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt;
/// / TValue.MakeWithoutCopy(@lLargeInt, TypeInfo(NullableInt64), lValue);
// lNullableInt64.Value := lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt;
/// / fPrimaryKey.SetValue(Self, TValue.From<Nullable<System.Int64>>(lNullableInt64));
// TValue.Make(@lNullableInt64, TypeInfo(NullableInt64), lOutValue);
// fPrimaryKey.SetValue(Self,3);
// //fPrimaryKey.SetValue(Self,lOutValue);
//
/// / TValue.MakeWithoutCopy(@lNullableInt64, TypeInfo(NullableInt64), lValue);
// //lValue := TValue.From<NullableInt64>(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt)
// // else if lValue.IsType<NullableInt64> then
// // lValue := TValue.From<NullableInt64>(NullableInt64(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt))
// end
// else if SameText(lValue.TypeInfo.Name, 'Nullable<System.UInt32>') then
// lValue := lQry.FieldByName(fPrimaryKeyFieldName).AsInteger
/// / else if lValue.IsType<NullableUInt32> then
/// / lValue := TValue.From<NullableUInt32>(NullableUInt32(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger))
// else if lValue.IsType<NullableUInt64> then
// lValue := TValue.From<NullableUInt64>(NullableUInt64(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt))
// else if lValue.IsType<NullableInt16> then
// lValue := TValue.From<NullableInt16>(NullableInt16(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger))
// else if lValue.IsType<NullableUInt16> then
// lValue := TValue.From<NullableUInt16>(NullableUInt16(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger))
// else
// raise EMVCActiveRecord.Create('Invalid type for primary key');
end
else
begin
lValue := lQry.FieldByName(fPrimaryKeyFieldName).AsInteger;
fPrimaryKey.SetValue(Self, lValue);
end;
end
else
begin
lQry.ExecSQL(lSQL);
end;
Result := lQry.RowsAffected;
finally
lQry.Free;
end;
end;
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant;
const Connection: TFDConnection): TDataSet;
var
lQry: TFDQuery;
begin
lQry := TFDQuery.Create(nil);
try
2019-05-09 20:53:52 +02:00
lQry.FetchOptions.Unidirectional := false; // True;
2018-09-28 13:01:46 +02:00
if Connection = nil then
begin
lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
end
else
begin
lQry.Connection := Connection;
end;
lQry.SQL.Text := SQL;
// lQry.Prepare;
lQry.Open(SQL, Values);
Result := lQry;
except
lQry.Free;
raise;
end;
end;
procedure TMVCActiveRecord.FillPrimaryKey(const SequenceName: String);
var
lDS: TDataSet;
lSQL: string;
begin
if not SequenceName.IsEmpty then
begin
lSQL := SQLGenerator.GetSequenceValueSQL(fPrimaryKeyFieldName, SequenceName);
if lSQL.IsEmpty then
begin
Exit;
end;
lDS := ExecQuery(lSQL, []);
try
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField(lDS.Fields[0], fPrimaryKey, Self);
finally
lDS.Free;
end;
end;
end;
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant): TDataSet;
begin
2018-09-28 13:01:46 +02:00
Result := ExecQuery(SQL, Values, nil);
end;
procedure TMVCActiveRecord.InitTableInfo;
var
lAttribute: TCustomAttribute;
lRTTIField: TRttiField;
begin
fEntityAllowedActions := [TMVCEntityAction.eaCreate, TMVCEntityAction.eaRetrieve, TMVCEntityAction.eaUpdate,
TMVCEntityAction.eaDelete];
fTableName := '';
fRTTIType := gCtx.GetType(Self.ClassInfo) as TRttiInstanceType;
fObjAttributes := fRTTIType.GetAttributes;
for lAttribute in fObjAttributes do
begin
if lAttribute is MVCTableAttribute then
begin
fTableName := MVCTableAttribute(lAttribute).Name;
continue;
end;
if lAttribute is MVCEntityActionsAttribute then
begin
fEntityAllowedActions := MVCEntityActionsAttribute(lAttribute).EntityAllowedActions;
Break;
end;
end;
if fTableName = '' then
raise Exception.Create('Cannot find TableNameAttribute');
fProps := fRTTIType.GetFields;
for lRTTIField in fProps do
begin
fPropsAttributes := lRTTIField.GetAttributes;
if Length(fPropsAttributes) = 0 then
continue;
for lAttribute in fPropsAttributes do
begin
if lAttribute is MVCTableFieldAttribute then
begin
if foPrimaryKey in MVCTableFieldAttribute(lAttribute).FieldOptions then
begin
fPrimaryKey := lRTTIField;
fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName;
fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName;
continue;
end;
fMap.Add(lRTTIField, { fTableName + '.' + } MVCTableFieldAttribute(lAttribute).FieldName);
if not(foTransient in MVCTableFieldAttribute(lAttribute).FieldOptions) then
fMapNonTransientFields.Add(lRTTIField, MVCTableFieldAttribute(lAttribute).FieldName);
end;
end;
end;
end;
procedure TMVCActiveRecord.Insert;
var
SQL: string;
begin
CheckAction(TMVCEntityAction.eaCreate);
OnValidation;
OnBeforeInsert;
OnBeforeInsertOrUpdate;
if fMapNonTransientFields.Count = 0 then
begin
raise EMVCActiveRecord.CreateFmt
('Cannot insert an entity if all fields are transient. Class [%s] mapped on table [%s]', [ClassName, fTableName]);
end;
if (foAutoGenerated in fPrimaryKeyOptions) then
begin
if not SQLGenerator.HasReturning then
begin
if not SQLGenerator.HasSequences then
begin
raise EMVCActiveRecord.Create
('Cannot use AutoGenerated primary keys if the engine doesn''t support returning clause nor sequences');
end
else
begin
if fPrimaryKeySequenceName.IsEmpty then
begin
raise EMVCActiveRecord.Create('SequenceName is empty for entity ' + ClassName + ' but ' + GetBackEnd +
' requires it');
end;
FillPrimaryKey(fPrimaryKeySequenceName);
end;
end;
end;
SQL := SQLGenerator.CreateInsertSQL(fTableName, fMapNonTransientFields, fPrimaryKeyFieldName, fPrimaryKeyOptions);
ExecNonQuery(SQL, True);
OnAfterInsert;
OnAfterInsertOrUpdate;
end;
2019-08-02 12:32:23 +02:00
function TMVCActiveRecord.InternalCount(const RQL: String): int64;
var
lSQL: string;
begin
lSQL := Self.SQLGenerator.CreateSelectCount(fTableName);
if not RQL.IsEmpty then
begin
lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false);
end;
Result := GetScalar(lSQL, []);
end;
function TMVCActiveRecord.InternalSelectRQL(const RQL: string;
const MaxRecordCount: Integer): TMVCActiveRecordList;
var
lSQL: string;
begin
lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping);
LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, []);
end;
constructor TMVCActiveRecord.Create(aLazyLoadConnection: Boolean);
begin
2018-09-28 13:01:46 +02:00
inherited Create;
fConn := nil;
SetLength(fMapping, 0);
{ TODO -oDanieleT -cGeneral : Consider lazyconnection }
if not aLazyLoadConnection then
begin
GetConnection;
end;
fMap := TDictionary<TRttiField, string>.Create;
fMapNonTransientFields := TDictionary<TRttiField, string>.Create;
InitTableInfo;
end;
function TMVCActiveRecord.GenerateSelectSQL: string;
begin
Result := SQLGenerator.CreateSelectSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
end;
function TMVCActiveRecord.GetBackEnd: string;
begin
if fBackendDriver.IsEmpty then
begin
fBackendDriver := GetBackEndByConnection(GetConnection);
end;
Result := fBackendDriver;
end;
class function TMVCActiveRecord.GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
const RaiseExceptionIfNotFound: Boolean): TMVCActiveRecord;
begin
Result := aClass.Create;
if not Result.LoadByPK(aValue) then
begin
Result.Free;
if RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound.Create('Data not found');
end
else
begin
Result := nil;
end;
end;
end;
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: int64;
const RaiseExceptionIfNotFound: Boolean = True): T;
var
lActiveRecord: TMVCActiveRecord;
begin
Result := T.Create;
lActiveRecord := TMVCActiveRecord(Result);
if not lActiveRecord.LoadByPK(aValue) then
begin
Result.Free;
if RaiseExceptionIfNotFound then
begin
raise EMVCActiveRecordNotFound.Create('Data not found');
end
else
begin
Result := nil;
end;
end;
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
const RaiseExceptionIfNotFound: Boolean): T;
var
lList: TObjectList<T>;
begin
lList := Where<T>(SQLWhere, Params);
try
if lList.Count = 0 then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecord.Create('Got 0 rows');
Exit(nil);
end;
2020-02-05 23:46:38 +01:00
Result := lList.Extract(lList.First);
finally
lList.Free;
end;
end;
2018-09-28 13:01:46 +02:00
function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
var
lPair: TPair<TRttiField, string>;
i: Integer;
begin
if Length(fMapping) = 0 then
2018-09-28 13:01:46 +02:00
begin
if not fPrimaryKeyFieldName.IsEmpty then
begin
SetLength(fMapping, fMap.Count + 1);
fMapping[0].InstanceFieldName := fPrimaryKey.Name.Substring(1).ToLower;
fMapping[0].DatabaseFieldName := fPrimaryKeyFieldName;
i := 1;
end
else
begin
SetLength(fMapping, fMap.Count);
i := 0;
end;
2018-09-28 13:01:46 +02:00
for lPair in fMap do
begin
fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
fMapping[i].DatabaseFieldName := lPair.Value;
inc(i);
end;
2018-09-28 13:01:46 +02:00
end;
Result := fMapping;
2018-09-28 13:01:46 +02:00
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string; const Params: array of Variant;
const RaiseExceptionIfNotFound: Boolean): T;
begin
Result := GetFirstByWhere<T>(SQLWhere, Params, false);
if Result = nil then
begin
if RaiseExceptionIfNotFound then
raise EMVCActiveRecord.Create('Got 0 rows when exactly 1 was expected');
end;
end;
function TMVCActiveRecord.GetPK: TValue;
var
lIsNullableType: Boolean;
begin
if not TryGetPKValue(Result, lIsNullableType) then
begin
if not lIsNullableType then
begin
raise EMVCActiveRecord.Create('Primary key not available');
end;
end;
end;
function TMVCActiveRecord.GetPrimaryKeyIsAutogenerated: Boolean;
begin
Result := foAutoGenerated in fPrimaryKeyOptions;
end;
class function TMVCActiveRecord.GetScalar(const SQL: string; const Params: array of Variant): Variant;
2019-01-08 12:48:27 +01:00
begin
Result := CurrentConnection.ExecSQLScalar(SQL, Params);
end;
function TMVCActiveRecord.CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean): Boolean;
begin
Result := aEntityAction in fEntityAllowedActions;
if (not Result) and aRaiseException then
raise EMVCActiveRecord.CreateFmt('Action not allowed on "%s"', [ClassName]);
end;
2019-05-09 20:53:52 +02:00
class function TMVCActiveRecord.Count(const aClass: TMVCActiveRecordClass; const RQL: String): int64;
2019-01-13 19:18:57 +01:00
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
// Up to 10.1 BErlin, here the compiler try to call the Count<T> introduced by the class helper
// Instead of the Count() which exists in "TMVCActiveRecord"
2019-08-02 12:32:23 +02:00
Result := lAR.InternalCount(RQL);
2019-01-13 19:18:57 +01:00
finally
lAR.Free;
end;
end;
function TMVCActiveRecord.Count(const RQL: String = ''): int64;
2019-05-09 20:53:52 +02:00
begin
2019-08-02 12:32:23 +02:00
Result := InternalCount(RQL);
2019-05-09 20:53:52 +02:00
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.Count<T>(const RQL: String = ''): int64;
2019-05-09 20:53:52 +02:00
begin
Result := TMVCActiveRecord.Count(TMVCActiveRecordClass(T), RQL);
2019-01-13 19:18:57 +01:00
end;
class function TMVCActiveRecord.CurrentConnection: TFDConnection;
begin
Result := ActiveRecordConnectionsRegistry.GetCurrent;
end;
function TMVCActiveRecord.GetConnection: TFDConnection;
2018-09-28 13:01:46 +02:00
begin
if fConn = nil then
begin
fConn := ActiveRecordConnectionsRegistry.GetCurrent;
end;
Result := fConn;
end;
constructor TMVCActiveRecord.Create;
begin
Create(True);
2018-09-28 13:01:46 +02:00
end;
procedure TMVCActiveRecord.Delete;
var
SQL: string;
begin
OnBeforeDelete;
if not Assigned(fPrimaryKey) then
raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
SQL := SQLGenerator.CreateDeleteSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions,
GetPK.AsInt64);
ExecNonQuery(SQL, false);
OnAfterDelete;
end;
class function TMVCActiveRecord.DeleteAll(const aClass: TMVCActiveRecordClass): int64;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableName));
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.DeleteRQL(const aClass: TMVCActiveRecordClass; const RQL: string): int64;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create(True);
try
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL(lAR.fTableName) +
lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping, false));
finally
lAR.Free;
end;
end;
procedure TMVCActiveRecord.MapDatasetToObject(const DataSet: TDataSet;
const Options: TMVCActiveRecordLoadOptions;
var Handled: Boolean);
begin
// do nothing
end;
procedure TMVCActiveRecord.MapObjectToParams(const Params: TFDParams;
var Handled: Boolean);
begin
// do nothing
end;
function TMVCActiveRecord.MapNullableTValueToParam(aValue: TValue; const aParam: TFDParam): Boolean;
begin
Assert(aValue.Kind = tkRecord);
Result := false;
if aValue.IsType(TypeInfo(NullableString)) then
begin
if not aValue.AsType<NullableString>().HasValue then
begin
aParam.DataType := ftString;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableString>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableInt32)) then
begin
if not aValue.AsType<NullableInt32>().HasValue then
begin
aParam.DataType := ftInteger;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableInt32>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableTDate)) then
begin
if not aValue.AsType<NullableTDate>().HasValue then
begin
aParam.DataType := ftDate;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TDate>(aValue.AsType<NullableTDate>().Value);
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableTTime)) then
begin
if not aValue.AsType<NullableTTime>().HasValue then
begin
aParam.DataType := ftTime;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TTime>(aValue.AsType<NullableTTime>().Value);
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableTDateTime)) then
begin
if not aValue.AsType<NullableTDateTime>().HasValue then
begin
aParam.DataType := ftDateTime;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<TDateTime>(aValue.AsType<NullableTDateTime>().Value);
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableUInt32)) then
begin
if not aValue.AsType<NullableUInt32>().HasValue then
begin
aParam.DataType := ftInteger;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableUInt32>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableInt64)) then
begin
if not aValue.AsType<NullableInt64>().HasValue then
begin
aParam.DataType := ftLargeint;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableInt64>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableInt16)) then
begin
if not aValue.AsType<NullableInt16>().HasValue then
begin
aParam.DataType := ftInteger;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableInt16>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableUInt64)) then
begin
if not aValue.AsType<NullableUInt64>().HasValue then
begin
aParam.DataType := ftLargeint;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableUInt64>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableUInt16)) then
begin
if not aValue.AsType<NullableUInt16>().HasValue then
begin
aParam.DataType := ftInteger;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableUInt16>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableBoolean)) then
begin
if not aValue.AsType<NullableBoolean>().HasValue then
begin
aParam.DataType := ftBoolean;
aParam.Clear;
Exit(True);
end
else
begin
aValue := TValue.From<Boolean>(aValue.AsType<NullableBoolean>().Value);
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableSingle)) then
begin
if not aValue.AsType<NullableSingle>().HasValue then
begin
aParam.DataType := TFieldType.ftSingle;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableSingle>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableDouble)) then
begin
if not aValue.AsType<NullableDouble>().HasValue then
begin
aParam.DataType := TFieldType.ftFloat;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableDouble>().Value;
Result := True;
end;
end
else if aValue.IsType(TypeInfo(NullableCurrency)) then
begin
if not aValue.AsType<NullableCurrency>().HasValue then
begin
aParam.DataType := TFieldType.ftCurrency;
aParam.Clear;
Exit(True);
end
else
begin
aValue := aValue.AsType<NullableCurrency>().Value;
Result := True;
end;
end;
if Result then
begin
MapTValueToParam(aValue, aParam);
end;
end;
procedure TMVCActiveRecord.MapTValueToParam(aValue: TValue; const aParam: TFDParam);
var
lStream: TStream;
lName: String;
begin
2019-05-09 20:53:52 +02:00
{$IFDEF NEXTGEN}
lName := aValue.TypeInfo.NameFld.ToString;
{$ELSE}
lName := String(aValue.TypeInfo.Name);
{$ENDIF}
if (aValue.TypeInfo.Kind = tkRecord) then
begin
if MapNullableTValueToParam(aValue, aParam) then
begin
Exit;
end;
end;
case aValue.TypeInfo.Kind of
tkString, tkUString:
begin
case aParam.DataType of
ftUnknown, ftString, ftWideString:
begin
aParam.AsString := aValue.AsString;
end;
ftWideMemo:
begin
aParam.AsWideMemo := aValue.AsString;
end;
ftMemo:
begin
aParam.AsMemo := AnsiString(aValue.AsString);
end;
else
begin
raise EMVCActiveRecord.CreateFmt('Invalid parameter type for (tkString, tkUString) [%s]', [lName]);
end;
end;
end;
2019-08-02 12:32:23 +02:00
{$IF Defined(SeattleOrBetter)}
tkWideString:
begin
aParam.AsWideString := aValue.AsString;
end;
2019-08-02 12:32:23 +02:00
{$ENDIF}
tkInt64:
begin
aParam.AsLargeInt := aValue.AsInt64;
end;
tkInteger:
begin
aParam.AsInteger := aValue.AsInteger;
end;
tkEnumeration:
begin
if aValue.TypeInfo = TypeInfo(System.Boolean) then
begin
aParam.AsBoolean := aValue.AsBoolean;
end
else
begin
aParam.AsInteger := Ord(aValue.AsInteger);
end;
end;
tkFloat:
begin
2019-05-09 20:53:52 +02:00
if lName = 'TDate' then
begin
aParam.AsDate := Trunc(aValue.AsExtended);
end
else
2019-05-09 20:53:52 +02:00
if lName = 'TDateTime' then
begin
aParam.AsDateTime := aValue.AsExtended;
end
else
if lName = 'TTime' then
begin
aParam.AsTime := aValue.AsExtended;
end
else
if lName = 'Currency' then
begin
aParam.AsCurrency := aValue.AsCurrency;
end
else
begin
aParam.AsFloat := aValue.AsExtended;
end;
end;
tkClass:
begin
if (aValue.AsObject <> nil) and (not aValue.IsInstanceOf(TStream)) then
raise EMVCActiveRecord.CreateFmt('Unsupported reference type for param %s: %s',
[aParam.Name, aValue.AsObject.ClassName]);
{$IF Defined(SeattleOrBetter)}
lStream := aValue.AsType<TStream>();
{$ELSE}
2019-08-02 12:32:23 +02:00
lStream := aValue.AsType<TStream>();
{$ENDIF}
if Assigned(lStream) then
begin
lStream.Position := 0;
aParam.LoadFromStream(lStream, ftBlob);
end
else
begin
aParam.DataType := TFieldType.ftBlob;
aParam.Clear;
end;
end;
tkRecord:
begin
if aValue.IsType(TypeInfo(TGUID)) then
begin
aParam.AsGuid := aValue.AsType<TGUID>;
end
else
begin
raise Exception.CreateFmt('Unsupported Record TypeKind (%d) for param %s',
[Ord(aValue.TypeInfo.Kind), aParam.Name]);
end;
end;
else
raise Exception.CreateFmt('Unsupported TypeKind (%d) for param %s', [Ord(aValue.TypeInfo.Kind), aParam.Name]);
end;
// case aParam.DataType of
// ftUnknown:
// begin
// { aParam.DataType could be pkUndefined for some RDBMS (es. MySQL), so we rely on Variant }
// if (aValue.TypeInfo.Kind = tkClass) then
// begin
// if not aValue.IsInstanceOf(TStream) then
// raise EMVCActiveRecord.CreateFmt('Unsupported type for param %s', [aParam.Name]);
// lStream := aValue.AsType<TStream>(false);
// if Assigned(lStream) then
// begin
// lStream.Position := 0;
// aParam.LoadFromStream(lStream, ftBlob);
// end
// else
// begin
// aParam.Clear;
// end;
//
// end
// else
// begin
// aParam.value := aValue.AsVariant;
// end;
// end;
// ftString:
// begin
// aParam.AsString := aValue.AsString;
// end;
// ftWideString:
// begin
// aParam.AsWideString := aValue.AsString;
// end;
// ftLargeint:
// begin
// aParam.AsLargeInt := aValue.AsInt64;
// end;
// ftSmallint:
// begin
// aParam.AsSmallInt := aValue.AsInteger;
// end;
// ftInteger:
// begin
// aParam.AsInteger := aValue.AsInteger;
// end;
// ftLongWord:
// begin
// aParam.AsLongWord := aValue.AsInteger;
// end;
// ftWord:
// begin
// aParam.AsWord := aValue.AsInteger;
// end;
// ftDate:
// begin
// aParam.AsDate := Trunc(aValue.AsExtended);
// end;
// ftDateTime:
// begin
// aParam.AsDateTime := aValue.AsExtended;
// end;
// ftBoolean:
// begin
// aParam.AsBoolean := aValue.AsBoolean;
// end;
// ftMemo:
// begin
// aParam.AsMemo := AnsiString(aValue.AsString);
// end;
// ftWideMemo:
// begin
// aParam.AsWideMemo := aValue.AsString;
// end;
// ftBCD:
// begin
// aParam.AsBCD := aValue.AsCurrency;
// end;
// ftBlob:
// begin
// lStream := aValue.AsType<TStream>(false);
// if Assigned(lStream) then
// begin
// lStream.Position := 0;
// aParam.LoadFromStream(lStream, ftBlob);
// end
// else
// begin
// aParam.Clear;
// end;
// end;
// else
// raise Exception.CreateFmt('Unsupported FieldType (%d) for param %s', [Ord(aParam.DataType), aParam.Name]);
// end;
end;
procedure TMVCActiveRecord.LoadByDataset(const aDataSet: TDataSet; const aOptions: TMVCActiveRecordLoadOptions);
var
lItem: TPair<TRttiField, string>;
lField: TField;
lHandled: Boolean;
begin
CheckAction(TMVCEntityAction.eaRetrieve);
OnBeforeLoad;
lHandled := false;
MapDatasetToObject(aDataSet, aOptions, lHandled);
if not lHandled then
begin
for lItem in fMap do
begin
if lItem.Value.IsEmpty then
begin
continue;
end;
lField := aDataSet.FindField(lItem.Value);
if lField = nil then
begin
if TMVCActiveRecordLoadOption.loIgnoreNotExistentFields in aOptions then
continue
else
raise EMVCActiveRecord.CreateFmt
('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields',
[lItem.Value]);
end;
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField(lField, lItem.Key, Self);
end;
if not fPrimaryKeyFieldName.IsEmpty then
begin
2020-02-05 23:46:38 +01:00
MapDataSetFieldToRTTIField(aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey, Self);
end;
end;
OnAfterLoad;
end;
function TMVCActiveRecord.LoadByPK(id: int64): Boolean;
var
SQL: string;
lDataSet: TDataSet;
begin
CheckAction(TMVCEntityAction.eaRetrieve);
SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions, id);
lDataSet := ExecQuery(SQL, [id], GetConnection);
try
Result := not lDataSet.Eof;
if Result then
begin
LoadByDataset(lDataSet);
end;
finally
lDataSet.Free;
end;
end;
procedure TMVCActiveRecord.OnAfterDelete;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterInsert;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterInsertOrUpdate;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterLoad;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnAfterUpdate;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeDelete;
begin
// do nothing
end;
2019-05-09 20:53:52 +02:00
procedure TMVCActiveRecord.OnBeforeExecuteSQL(var SQL: String);
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeInsert;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeInsertOrUpdate;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeLoad;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnBeforeUpdate;
begin
// do nothing
end;
procedure TMVCActiveRecord.OnValidation;
begin
// do nothing
end;
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant): TMVCActiveRecordList;
2018-09-28 13:01:46 +02:00
begin
Result := Select(aClass, SQL, Params, nil);
end;
class function TMVCActiveRecord.Select(const aClass: TMVCActiveRecordClass; const SQL: string;
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
begin
Result := TMVCActiveRecordList.Create;
try
2018-09-28 13:01:46 +02:00
lDataSet := ExecQuery(SQL, Params, Connection);
try
while not lDataSet.Eof do
begin
lAR := aClass.Create;
Result.Add(lAR);
lAR.LoadByDataset(lDataSet);
lDataSet.Next;
end;
finally
lDataSet.Free;
end;
except
Result.Free;
raise;
end;
2018-09-28 13:01:46 +02:00
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
lHandled: Boolean;
begin
Result := TObjectList<T>.Create(True);
try
lDataSet := ExecQuery(SQL, Params);
try
while not lDataSet.Eof do
begin
lAR := T.Create;
Result.Add(lAR);
lAR.LoadByDataset(lDataSet, Options);
lDataSet.Next;
end;
finally
lDataSet.Free;
end;
except
Result.Free;
raise;
end;
end;
class function TMVCActiveRecord.SelectDataSet(const SQL: string; const Params: array of Variant): TDataSet;
begin
Result := TMVCActiveRecord.ExecQuery(SQL, Params);
end;
function TMVCActiveRecord.SelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
2018-09-27 12:26:50 +02:00
begin
2019-08-02 12:32:23 +02:00
Result := InternalSelectRQL(RQL, MaxRecordCount);
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.SelectRQL<T>(const RQL: string; const MaxRecordCount: Integer): TObjectList<T>;
var
lAR: TMVCActiveRecord;
lSQL: string;
begin
lAR := T.Create;
try
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping).Trim;
2019-01-13 19:18:57 +01:00
// LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
if lSQL.StartsWith('where', True) then
lSQL := lSQL.Remove(0, 5).Trim;
Result := Where<T>(lSQL, []);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.SelectRQL(const aClass: TMVCActiveRecordClass; const RQL: string;
const MaxRecordCount: Integer): TMVCActiveRecordList;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create(True);
2018-09-27 12:26:50 +02:00
try
2019-08-02 12:32:23 +02:00
Result := lAR.InternalSelectRQL(RQL, MaxRecordCount);
2018-09-27 12:26:50 +02:00
finally
lAR.Free;
2018-09-27 12:26:50 +02:00
end;
end;
procedure TMVCActiveRecord.SetPK(const aValue: TValue);
var
lPKValue: TValue;
begin
if fPrimaryKeyFieldName.IsEmpty then
begin
raise Exception.Create('No primary key defined');
end;
if fPrimaryKey.GetValue(Self).Kind = tkRecord then
begin
lPKValue := fPrimaryKey.GetValue(Self);
if lPKValue.IsType<NullableInt32> then
begin
if aValue.IsType<UInt32> then
begin
lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
end;
//
// if aValue.AsType<NullableInt32>().HasValue then
// begin
// lPKValue := aValue;
// end
// else
// begin
// lPKValue.AsType<NullableInt32>().Clear;
// end;
end
else if lPKValue.IsType<NullableInt64> then
begin
if aValue.AsType<NullableInt64>().HasValue then
begin
lPKValue := aValue;
end
else
begin
lPKValue.AsType<NullableInt64>().Clear;
end;
end
else if lPKValue.IsType<NullableUInt32> then
begin
if aValue.AsType<NullableUInt32>().HasValue then
begin
lPKValue := aValue;
end
else
begin
lPKValue.AsType<NullableUInt32>().Clear;
end;
end
else if lPKValue.IsType<NullableUInt64> then
begin
if aValue.AsType<NullableUInt64>().HasValue then
begin
lPKValue := aValue;
end
else
begin
lPKValue.AsType<NullableUInt64>().Clear;
end;
end
else
raise EMVCActiveRecord.Create('Invalid type for primary key');
fPrimaryKey.SetValue(Self, lPKValue);
end
else
begin
fPrimaryKey.SetValue(Self, aValue)
end;
end;
procedure TMVCActiveRecord.SetPrimaryKeyIsAutogenerated(const Value: Boolean);
begin
if Value then
begin
Include(fPrimaryKeyOptions, foAutoGenerated);
end
else
begin
Exclude(fPrimaryKeyOptions, foAutoGenerated);
end;
end;
function TMVCActiveRecord.SQLGenerator: TMVCSQLGenerator;
begin
if not Assigned(fSQLGenerator) then
begin
GetConnection.Connected := True;
fSQLGenerator := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd).Create(GetMapping);
end;
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<TRttiField, string>;
begin
Result := 'Table Name: ' + fTableName;
for keyvalue in fMap do
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<NullableInt32>() then
begin
Result := Value.AsType<NullableInt32>().HasValue;
if Result then
Value := Value.AsType<NullableInt32>().Value;
end
else if Value.IsType<NullableInt64>() then
begin
Result := Value.AsType<NullableInt64>().HasValue;
if Result then
Value := Value.AsType<NullableInt64>().Value;
end
else if Value.IsType<NullableUInt32>() then
begin
Result := Value.AsType<NullableUInt32>().HasValue;
if Result then
Value := Value.AsType<NullableUInt32>().Value;
end
else if Value.IsType<NullableUInt64>() then
begin
Result := Value.AsType<NullableUInt64>().HasValue;
if Result then
Value := Value.AsType<NullableUInt64>().Value;
end
else if Value.IsType<NullableInt16>() then
begin
Result := Value.AsType<NullableInt16>().HasValue;
if Result then
Value := Value.AsType<NullableInt16>().Value;
end
else if Value.IsType<NullableUInt16>() then
begin
Result := Value.AsType<NullableUInt16>().HasValue;
if Result then
Value := Value.AsType<NullableUInt16>().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;
begin
CheckAction(TMVCEntityAction.eaUpdate);
OnValidation;
OnBeforeUpdate;
OnBeforeInsertOrUpdate;
if fMapNonTransientFields.Count = 0 then
begin
raise EMVCActiveRecord.CreateFmt
('Cannot update an entity if all fields are transient. Class [%s] mapped on table [%s]', [ClassName, fTableName]);
end;
SQL := SQLGenerator.CreateUpdateSQL(fTableName, fMapNonTransientFields, fPrimaryKeyFieldName, fPrimaryKeyOptions);
ExecNonQuery(SQL, false);
OnAfterUpdate;
OnAfterInsertOrUpdate;
end;
class function TMVCActiveRecord.All(const aClass: TMVCActiveRecordClass): TObjectList<TMVCActiveRecord>;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := Select(aClass, lAR.GenerateSelectSQL, []);
finally
lAR.Free;
end;
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.All<T>: TObjectList<T>;
var
lAR: TMVCActiveRecord;
begin
lAR := T.Create;
try
Result := Select<T>(lAR.GenerateSelectSQL, []);
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
const Params: array of Variant): TMVCActiveRecordList;
2018-09-28 13:01:46 +02:00
begin
Result := Where(aClass, SQLWhere, Params, nil);
2018-09-28 13:01:46 +02:00
end;
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
2018-09-27 12:26:50 +02:00
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
2018-09-27 12:26:50 +02:00
finally
lAR.Free;
end;
end;
2019-08-02 12:32:23 +02:00
class function TMVCActiveRecordHelper.Where<T>(const SQLWhere: string; const Params: array of Variant): TObjectList<T>;
var
lAR: TMVCActiveRecord;
begin
lAR := T.Create;
try
if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then
2018-09-27 12:26:50 +02:00
begin
Result := Select<T>(lAR.GenerateSelectSQL + SQLWhere, Params);
2018-09-27 12:26:50 +02:00
end
else
begin
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params);
2018-09-27 12:26:50 +02:00
end;
finally
lAR.Free;
end;
end;
{ PrimaryKeyAttribute }
// constructor MVCPrimaryKeyAttribute.Create(const aFieldName: string);
// begin
// Create(aFieldName, []);
// end;
//
// constructor MVCPrimaryKeyAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions);
// begin
// inherited Create;
// FieldName := aFieldName;
// FieldOptions := aFieldOptions;
// end;
{ TMVCEntitiesRegistry }
procedure TMVCEntitiesRegistry.AddEntity(const aURLSegment: string; const aActiveRecordClass: TMVCActiveRecordClass);
begin
fEntitiesDict.AddOrSetValue(aURLSegment.ToLower, aActiveRecordClass);
end;
procedure TMVCEntitiesRegistry.AddEntityProcessor(const aURLSegment: string;
const aEntityProcessor: IMVCEntityProcessor);
begin
fProcessorsDict.Add(aURLSegment, aEntityProcessor);
end;
constructor TMVCEntitiesRegistry.Create;
begin
inherited;
fEntitiesDict := TDictionary<string, TMVCActiveRecordClass>.Create;
fProcessorsDict := TDictionary<string, IMVCEntityProcessor>.Create;
end;
destructor TMVCEntitiesRegistry.Destroy;
begin
fEntitiesDict.Free;
fProcessorsDict.Free;
inherited;
end;
function TMVCEntitiesRegistry.FindEntityClassByURLSegment(const aURLSegment: string;
out aMVCActiveRecordClass: TMVCActiveRecordClass): Boolean;
begin
Result := fEntitiesDict.TryGetValue(aURLSegment.ToLower, aMVCActiveRecordClass);
end;
function TMVCEntitiesRegistry.FindProcessorByURLSegment(const aURLSegment: string;
out aMVCEntityProcessor: IMVCEntityProcessor): Boolean;
begin
Result := fProcessorsDict.TryGetValue(aURLSegment.ToLower, aMVCEntityProcessor);
end;
{ EMVCActiveRecord }
constructor EMVCActiveRecord.Create(const AMsg: string);
begin
inherited Create(http_status.BadRequest, AMsg);
end;
{ EntityActionsAttribute }
constructor MVCEntityActionsAttribute.Create(const aEntityAllowedActions: TMVCEntityActions);
begin
inherited Create;
EntityAllowedActions := aEntityAllowedActions;
end;
{ TMVCActiveRecordList }
constructor TMVCActiveRecordList.Create;
begin
inherited Create(True);
end;
{ TMVCSQLGeneratorRegistry }
constructor TMVCSQLGeneratorRegistry.Create;
begin
inherited;
fSQLGenerators := TDictionary<string, TMVCSQLGeneratorClass>.Create;
end;
class constructor TMVCSQLGeneratorRegistry.Create;
begin
cLock := TObject.Create;
end;
class destructor TMVCSQLGeneratorRegistry.Destroy;
begin
cLock.Free;
cInstance.Free;
end;
destructor TMVCSQLGeneratorRegistry.Destroy;
begin
fSQLGenerators.Free;
inherited;
end;
function TMVCSQLGeneratorRegistry.GetSQLGenerator(const aBackend: string): TMVCSQLGeneratorClass;
begin
if not fSQLGenerators.TryGetValue(aBackend, Result) then
begin
raise ERQLCompilerNotFound.CreateFmt('SQLGenerator not found for "%s"', [aBackend]);
end;
end;
class function TMVCSQLGeneratorRegistry.Instance: TMVCSQLGeneratorRegistry;
begin
if not Assigned(cInstance) then
begin
TMonitor.Enter(cLock);
try
if not Assigned(cInstance) then
begin
cInstance := TMVCSQLGeneratorRegistry.Create;
end;
finally
TMonitor.Exit(cLock);
end;
end;
Result := cInstance;
end;
procedure TMVCSQLGeneratorRegistry.RegisterSQLGenerator(const aBackend: string;
const aRQLBackendClass: TMVCSQLGeneratorClass);
begin
fSQLGenerators.AddOrSetValue(aBackend, aRQLBackendClass);
end;
procedure TMVCSQLGeneratorRegistry.UnRegisterSQLGenerator(const aBackend: string);
begin
fSQLGenerators.Remove(aBackend);
end;
{ TMVCSQLGenerator }
constructor TMVCSQLGenerator.Create(Mapping: TMVCFieldsMapping);
begin
inherited Create;
fMapping := Mapping;
end;
function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping;
begin
Result := fMapping;
end;
destructor TMVCSQLGenerator.Destroy;
begin
fCompiler.Free;
fRQL2SQL.Free;
inherited;
end;
function TMVCSQLGenerator.GetCompiler: TRQLCompiler;
begin
if fCompiler = nil then
begin
fCompiler := GetCompilerClass.Create(fMapping);
end;
Result := fCompiler;
end;
function TMVCSQLGenerator.GetRQLParser: TRQL2SQL;
begin
if fRQL2SQL = nil then
begin
2019-05-09 20:53:52 +02:00
fRQL2SQL := TRQL2SQL.Create; // (20);
end;
Result := fRQL2SQL;
end;
function TMVCSQLGenerator.GetSequenceValueSQL(
const PKFieldName: String; const SequenceName: String; const Step: Integer = 1): String;
begin
Result := '';
end;
function TMVCSQLGenerator.HasReturning: Boolean;
begin
Result := True;
end;
function TMVCSQLGenerator.HasSequences: Boolean;
begin
Result := True;
end;
function TMVCSQLGenerator.TableFieldsDelimited(const Map: TDictionary<TRttiField, string>; const PKFieldName: string;
const Delimiter: string): string;
var
lPair: TPair<TRttiField, string>;
begin
for lPair in Map do
begin
if not lPair.Value.IsEmpty then
begin
Result := Result + lPair.Value + Delimiter;
end;
end;
Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
if not PKFieldName.IsEmpty then
begin
Result := PKFieldName + ',' + Result;
end;
end;
{ TMVCConnectionsRepository.TConnHolder }
destructor TMVCConnectionsRepository.TConnHolder.Destroy;
begin
if OwnsConnection then
Begin
2019-05-09 20:53:52 +02:00
if Connection.Connected then
Connection.Connected := false;
FreeAndNil(Connection);
End;
inherited;
end;
constructor MVCTableFieldAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
const aSequenceName: String);
2019-02-15 12:21:11 +01:00
begin
inherited Create;
FieldName := aFieldName;
FieldOptions := aFieldOptions;
SequenceName := aSequenceName;
2019-02-15 12:21:11 +01:00
end;
{ EMVCActiveRecordNotFound }
procedure EMVCActiveRecordNotFound.AfterConstruction;
begin
inherited;
fHttpErrorCode := http_status.NotFound;
end;
initialization
gLock := TObject.Create;
gCtx := TRttiContext.Create;
gCtx.FindType('');
finalization
gCtx.Free;
gLock.Free;
end.