mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
2478 lines
68 KiB
ObjectPascal
2478 lines
68 KiB
ObjectPascal
// *************************************************************************** }
|
|
//
|
|
// 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;
|
|
|
|
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)
|
|
public
|
|
Name: string;
|
|
constructor Create(aName: string);
|
|
end;
|
|
|
|
MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
FieldName: string;
|
|
FieldOptions: TMVCActiveRecordFieldOptions;
|
|
constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions); overload;
|
|
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;
|
|
fEntityAllowedActions: TMVCEntityActions;
|
|
fRQL2SQL: TRQL2SQL;
|
|
procedure MapColumnToTValue(const aFieldName: string; const aField: TField; const aRTTIField: TRttiField);
|
|
procedure MapTValueToParam(aValue: TValue; const aParam: TFDParam);
|
|
function GetPrimaryKeyIsAutogenerated: Boolean;
|
|
|
|
procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
|
|
function MapNullableColumnToTValue(const aValue: TValue;
|
|
const aField: TField; const aRTTIField: TRttiField): Boolean;
|
|
function MapNullableTValueToParam(aValue: TValue;
|
|
const aParam: TFDParam): Boolean;
|
|
protected
|
|
fRTTIType: TRttiType;
|
|
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 SelfConnection: 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;
|
|
|
|
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>
|
|
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;
|
|
|
|
function InternalCount(const RQL: String): int64;
|
|
function InternalSelectRQL(const RQL: string; const MaxRecordCount: Integer): TMVCActiveRecordList;
|
|
public
|
|
constructor Create(aLazyLoadConnection: Boolean); overload;
|
|
{ cannot be virtual! }
|
|
constructor Create; overload; virtual;
|
|
destructor Destroy; override;
|
|
function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean;
|
|
procedure Insert;
|
|
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;
|
|
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;
|
|
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;
|
|
|
|
TMVCActiveRecordHelper = class helper for TMVCActiveRecord
|
|
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: int64;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
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;
|
|
|
|
IMVCActiveRecordConnections = interface
|
|
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
|
|
procedure AddConnection(const aName: string; const aConnection: TFDConnection; const Owns: Boolean = false);
|
|
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false);
|
|
procedure RemoveConnection(const aName: string);
|
|
procedure RemoveDefaultConnection;
|
|
procedure SetCurrent(const aName: string);
|
|
function GetCurrent: TFDConnection;
|
|
function GetCurrentBackend: string;
|
|
end;
|
|
|
|
TMVCConnectionsRepository = class(TInterfacedObject, IMVCActiveRecordConnections)
|
|
private type
|
|
TConnHolder = class
|
|
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);
|
|
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false);
|
|
procedure RemoveConnection(const aName: string);
|
|
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;
|
|
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;
|
|
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;
|
|
|
|
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;
|
|
|
|
var
|
|
gCtx: TRttiContext;
|
|
gEntitiesRegistry: IMVCEntitiesRegistry;
|
|
gConnections: IMVCActiveRecordConnections;
|
|
gLock: TObject;
|
|
|
|
function GetBackEndByConnection(aConnection: TFDConnection): string;
|
|
begin
|
|
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;
|
|
|
|
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;
|
|
|
|
{ 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;
|
|
|
|
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(SeattleOrBetter)}
|
|
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(SeattleOrBetter)}
|
|
Result := nil;
|
|
{$ENDIF}
|
|
fMREW.BeginRead;
|
|
try
|
|
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
|
|
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;
|
|
|
|
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]);
|
|
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
|
|
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;
|
|
|
|
function TMVCActiveRecord.ExecNonQuery(const SQL: string; RefreshAutoGenerated: Boolean = false): int64;
|
|
var
|
|
lQry: TFDQuery;
|
|
lPar: TFDParam;
|
|
lPair: TPair<TRttiField, string>;
|
|
lValue: TValue;
|
|
lSQL: String;
|
|
lHandled: Boolean;
|
|
begin
|
|
lQry := TFDQuery.Create(nil);
|
|
try
|
|
lQry.Connection := fConn;
|
|
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) then
|
|
begin
|
|
lQry.Open;
|
|
lValue := fPrimaryKey.GetValue(Self);
|
|
if lValue.Kind = tkRecord then
|
|
begin
|
|
if lValue.IsType<NullableInt32> then
|
|
lValue := TValue.From<NullableInt32>(NullableInt32(lQry.FieldByName(fPrimaryKeyFieldName).AsInteger))
|
|
else if lValue.IsType<NullableInt64> then
|
|
lValue := TValue.From<NullableInt64>(NullableInt64(lQry.FieldByName(fPrimaryKeyFieldName).AsLargeInt))
|
|
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;
|
|
end;
|
|
fPrimaryKey.SetValue(Self, lValue);
|
|
OnAfterLoad;
|
|
end
|
|
else
|
|
begin
|
|
lQry.ExecSQL(lSQL);
|
|
end;
|
|
|
|
Result := lQry.RowsAffected;
|
|
finally
|
|
lQry.Free;
|
|
end;
|
|
end;
|
|
|
|
// class function TMVCActiveRecord.ExecNonQuery(const SQL: string;
|
|
// const Values: array of Variant; const Connection: TFDConnection): int64;
|
|
// var
|
|
// lQry: TFDQuery;
|
|
// begin
|
|
// lQry := TFDQuery.Create(nil);
|
|
// try
|
|
// lQry.FetchOptions.Unidirectional := True;
|
|
// if Connection = nil then
|
|
// begin
|
|
// lQry.Connection := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
// end
|
|
// else
|
|
// begin
|
|
// lQry.Connection := Connection;
|
|
// end;
|
|
// lQry.SQL.Text := SQL;
|
|
// lQry.Prepare;
|
|
// lQry.ExecSQL(SQL, Values);
|
|
// Result := lQry.RowsAffected;
|
|
// except
|
|
// lQry.Free;
|
|
// raise;
|
|
// end;
|
|
// end;
|
|
//
|
|
// class function TMVCActiveRecord.ExecNonQuery(const SQL: string;
|
|
// const Values: array of Variant): int64;
|
|
// begin
|
|
// Result := ExecNonQuery(SQL, Values, nil);
|
|
// 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
|
|
lQry.FetchOptions.Unidirectional := false; // True;
|
|
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;
|
|
|
|
class function TMVCActiveRecord.ExecQuery(const SQL: string; const Values: array of Variant): TDataSet;
|
|
begin
|
|
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);
|
|
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;
|
|
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;
|
|
SQL := SQLGenerator.CreateInsertSQL(fTableName, fMapNonTransientFields, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
ExecNonQuery(SQL, True);
|
|
OnAfterInsert;
|
|
OnAfterInsertOrUpdate;
|
|
end;
|
|
|
|
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
|
|
inherited Create;
|
|
fConn := nil;
|
|
SetLength(fMapping, 0);
|
|
{ TODO -oDanieleT -cGeneral : Consider lazyconnection }
|
|
// if not aLazyLoadConnection then
|
|
// begin
|
|
SelfConnection;
|
|
// 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(fConn);
|
|
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;
|
|
|
|
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;
|
|
Result := lList.ExtractAt(0);
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
|
|
var
|
|
lPair: TPair<TRttiField, string>;
|
|
i: Integer;
|
|
begin
|
|
if Length(fMapping) = 0 then
|
|
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;
|
|
|
|
for lPair in fMap do
|
|
begin
|
|
fMapping[i].InstanceFieldName := lPair.Key.Name.Substring(1).ToLower;
|
|
fMapping[i].DatabaseFieldName := lPair.Value;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
Result := fMapping;
|
|
end;
|
|
|
|
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;
|
|
begin
|
|
if fPrimaryKeyFieldName.IsEmpty then
|
|
raise Exception.Create('No primary key defined');
|
|
Result := fPrimaryKey.GetValue(Self);
|
|
if Result.Kind = tkRecord then
|
|
begin
|
|
if Result.IsType<NullableInt32>() then
|
|
Result := Result.AsType<NullableInt32>().Value
|
|
else if Result.IsType<NullableInt64>() then
|
|
Result := Result.AsType<NullableInt64>().Value
|
|
else if Result.IsType<NullableUInt32>() then
|
|
Result := Result.AsType<NullableUInt32>().Value
|
|
else if Result.IsType<NullableUInt64>() then
|
|
Result := Result.AsType<NullableUInt64>().Value
|
|
else if Result.IsType<NullableInt16>() then
|
|
Result := Result.AsType<NullableInt16>().Value
|
|
else if Result.IsType<NullableUInt16>() then
|
|
Result := Result.AsType<NullableUInt16>().Value
|
|
else
|
|
raise EMVCActiveRecord.Create('Invalid primary key type');
|
|
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;
|
|
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;
|
|
|
|
class function TMVCActiveRecord.Count(const aClass: TMVCActiveRecordClass; const RQL: String): int64;
|
|
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"
|
|
Result := lAR.InternalCount(RQL);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.Count(const RQL: String = ''): int64;
|
|
begin
|
|
Result := InternalCount(RQL);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Count<T>(const RQL: String = ''): int64;
|
|
begin
|
|
Result := TMVCActiveRecord.Count(TMVCActiveRecordClass(T), RQL);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.CurrentConnection: TFDConnection;
|
|
begin
|
|
Result := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end;
|
|
|
|
function TMVCActiveRecord.SelfConnection: TFDConnection;
|
|
begin
|
|
if fConn = nil then
|
|
begin
|
|
fConn := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end;
|
|
Result := fConn;
|
|
end;
|
|
|
|
constructor TMVCActiveRecord.Create;
|
|
begin
|
|
Create(false);
|
|
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;
|
|
|
|
function TMVCActiveRecord.MapNullableColumnToTValue(const aValue: TValue; const aField: TField;
|
|
const aRTTIField: TRttiField): Boolean;
|
|
begin
|
|
Assert(aValue.Kind = tkRecord);
|
|
Result := false;
|
|
if aValue.IsType(TypeInfo(NullableString)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableString>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableString>(aField.AsString));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableInt32)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableInt32>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableInt32>(aField.AsLargeInt));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableUInt32)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableUInt32>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableUInt32>(aField.AsLargeInt));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableInt64)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableInt64>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableInt64>(aField.AsLargeInt));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableUInt64)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableUInt64>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableUInt64>(aField.AsLargeInt));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableInt16)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableInt16>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableInt16>(aField.AsLargeInt));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableUInt16)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableUInt16>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableUInt16>(aField.AsInteger));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableDate)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableDate>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableDate>(aField.AsDateTime));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableDateTime)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableDateTime>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableDateTime>(aField.AsDateTime));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableTime)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableTime>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableTime>(aField.AsDateTime));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableBoolean)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableBoolean>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableBoolean>(aField.AsBoolean));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableDouble)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableDouble>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableDouble>(aField.AsFloat));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableSingle)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableSingle>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableSingle>(aField.AsSingle));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableExtended)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableExtended>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableExtended>(aField.AsExtended));
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableCurrency)) then
|
|
begin
|
|
if aField.IsNull then
|
|
begin
|
|
aRTTIField.GetValue(Self).AsType<NullableCurrency>().Clear;
|
|
end
|
|
else
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<NullableCurrency>(aField.AsCurrency));
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.MapColumnToTValue(const aFieldName: string; const aField: TField;
|
|
const aRTTIField: TRttiField);
|
|
var
|
|
lInternalStream: TStream;
|
|
lSStream: TStringStream;
|
|
lValue: TValue;
|
|
begin
|
|
lValue := aRTTIField.GetValue(Self);
|
|
if lValue.Kind = tkRecord then
|
|
begin
|
|
if MapNullableColumnToTValue(lValue, aField, aRTTIField) then
|
|
begin
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
// if we reached this point, the field is not a nullable type...
|
|
case aField.DataType of
|
|
ftString, ftWideString:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsString);
|
|
end;
|
|
ftLargeint, ftAutoInc:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsLargeInt);
|
|
end;
|
|
ftInteger, ftSmallint, ftShortint:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsInteger);
|
|
end;
|
|
ftLongWord, ftWord:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsLongWord);
|
|
end;
|
|
ftFMTBcd:
|
|
begin
|
|
aRTTIField.SetValue(Self, BCDtoCurrency(aField.AsBCD));
|
|
end;
|
|
ftDate:
|
|
begin
|
|
aRTTIField.SetValue(Self, Trunc(aField.AsDateTime));
|
|
end;
|
|
ftDateTime:
|
|
begin
|
|
aRTTIField.SetValue(Self, Trunc(aField.AsDateTime));
|
|
end;
|
|
ftTimeStamp:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsDateTime);
|
|
end;
|
|
ftBoolean:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsBoolean);
|
|
end;
|
|
ftMemo, ftWideMemo:
|
|
begin
|
|
if aRTTIField.FieldType.TypeKind in [tkString, tkUString { , tkWideString } ] then
|
|
begin
|
|
// In case you want to map a "TEXT" blob into a Delphi String
|
|
lSStream := TStringStream.Create('', TEncoding.Unicode);
|
|
try
|
|
TBlobField(aField).SaveToStream(lSStream);
|
|
aRTTIField.SetValue(Self, lSStream.DataString);
|
|
finally
|
|
lSStream.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// In case you want to map a bynary blob into a Delphi Stream
|
|
lInternalStream := aRTTIField.GetValue(Self).AsObject as TStream;
|
|
if lInternalStream = nil then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('Property target for %s field is nil', [aFieldName]);
|
|
end;
|
|
lInternalStream.Position := 0;
|
|
TBlobField(aField).SaveToStream(lInternalStream);
|
|
lInternalStream.Position := 0;
|
|
end;
|
|
end;
|
|
ftBCD:
|
|
begin
|
|
aRTTIField.SetValue(Self, BCDtoCurrency(aField.AsBCD));
|
|
end;
|
|
ftFloat:
|
|
begin
|
|
aRTTIField.SetValue(Self, aField.AsFloat);
|
|
end;
|
|
ftBlob:
|
|
begin
|
|
lInternalStream := aRTTIField.GetValue(Self).AsObject as TStream;
|
|
if lInternalStream = nil then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt('Property target for %s field is nil', [aFieldName]);
|
|
end;
|
|
lInternalStream.Position := 0;
|
|
TBlobField(aField).SaveToStream(lInternalStream);
|
|
lInternalStream.Position := 0;
|
|
end;
|
|
{$IF Defined(SeattleOrBetter)}
|
|
ftGuid:
|
|
begin
|
|
aRTTIField.SetValue(Self, TValue.From<TGUID>(aField.AsGuid));
|
|
end;
|
|
{$ENDIF}
|
|
else
|
|
raise EMVCActiveRecord.CreateFmt('Unsupported FieldType (%d) for field %s', [Ord(aField.DataType), aFieldName]);
|
|
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(NullableDate)) then
|
|
begin
|
|
if not aValue.AsType<NullableDate>().HasValue then
|
|
begin
|
|
aParam.DataType := ftDate;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TDate>(aValue.AsType<NullableDate>().Value);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableTime)) then
|
|
begin
|
|
if not aValue.AsType<NullableTime>().HasValue then
|
|
begin
|
|
aParam.DataType := ftTime;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TTime>(aValue.AsType<NullableTime>().Value);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else if aValue.IsType(TypeInfo(NullableDateTime)) then
|
|
begin
|
|
if not aValue.AsType<NullableDateTime>().HasValue then
|
|
begin
|
|
aParam.DataType := ftDateTime;
|
|
aParam.Clear;
|
|
Exit(True);
|
|
end
|
|
else
|
|
begin
|
|
aValue := TValue.From<TDateTime>(aValue.AsType<NullableDateTime>().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
|
|
{$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;
|
|
{$IF Defined(SeattleOrBetter)}
|
|
tkWideString:
|
|
begin
|
|
aParam.AsWideString := aValue.AsString;
|
|
end;
|
|
{$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
|
|
if lName = 'TDate' then
|
|
begin
|
|
aParam.AsDate := Trunc(aValue.AsExtended);
|
|
end
|
|
else
|
|
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 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}
|
|
lStream := aValue.AsType<TStream>();
|
|
{$ENDIF}
|
|
if Assigned(lStream) then
|
|
begin
|
|
lStream.Position := 0;
|
|
aParam.LoadFromStream(lStream, ftBlob);
|
|
end
|
|
else
|
|
begin
|
|
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;
|
|
MapColumnToTValue(lItem.Value, lField, lItem.Key);
|
|
end;
|
|
if not fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
MapColumnToTValue(fPrimaryKeyFieldName, aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey);
|
|
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], fConn);
|
|
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;
|
|
|
|
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;
|
|
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
|
|
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;
|
|
|
|
end;
|
|
|
|
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;
|
|
begin
|
|
Result := InternalSelectRQL(RQL, MaxRecordCount);
|
|
end;
|
|
|
|
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;
|
|
// 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);
|
|
try
|
|
Result := lAR.InternalSelectRQL(RQL, MaxRecordCount);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.SetPK(const aValue: TValue);
|
|
begin
|
|
if fPrimaryKeyFieldName.IsEmpty then
|
|
raise Exception.Create('No primary key defined');
|
|
fPrimaryKey.SetValue(Self, aValue);
|
|
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
|
|
fConn.Connected := True;
|
|
fSQLGenerator := TMVCSQLGeneratorRegistry.Instance.GetSQLGenerator(GetBackEnd).Create(GetMapping);
|
|
end;
|
|
Result := fSQLGenerator;
|
|
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;
|
|
|
|
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;
|
|
|
|
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;
|
|
begin
|
|
Result := Where(aClass, SQLWhere, Params, nil);
|
|
end;
|
|
|
|
class function TMVCActiveRecord.Where(const aClass: TMVCActiveRecordClass; const SQLWhere: string;
|
|
const Params: array of Variant; const Connection: TFDConnection): TMVCActiveRecordList;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
begin
|
|
lAR := aClass.Create;
|
|
try
|
|
Result := Select(aClass, lAR.GenerateSelectSQL + SQLWhere, Params, Connection);
|
|
finally
|
|
lAR.Free;
|
|
end;
|
|
end;
|
|
|
|
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
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + SQLWhere, Params);
|
|
end
|
|
else
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params);
|
|
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
|
|
fRQL2SQL := TRQL2SQL.Create; // (20);
|
|
end;
|
|
Result := fRQL2SQL;
|
|
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
|
|
if Connection.Connected then
|
|
Connection.Connected := false;
|
|
FreeAndNil(Connection);
|
|
End;
|
|
inherited;
|
|
end;
|
|
|
|
constructor MVCTableFieldAttribute.Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions);
|
|
begin
|
|
inherited Create;
|
|
FieldName := aFieldName;
|
|
FieldOptions := aFieldOptions;
|
|
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.
|