mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
7576ab8bf8
Improved the primary key type handling for manual handling in MVCActiveRecord. Improved activerecord_showcase sample.
2847 lines
79 KiB
ObjectPascal
2847 lines
79 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,
|
|
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, { it's the primary key of the mapped table }
|
|
foAutoGenerated, { not written, read - similar to readonly }
|
|
foTransient, { not written, not read }
|
|
foReadOnly, { not written, read }
|
|
foWriteOnly); { written, not read }
|
|
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;
|
|
|
|
TFieldInfo = class
|
|
public
|
|
// TableName: string;
|
|
FieldName: string;
|
|
FieldOptions: TMVCActiveRecordFieldOptions;
|
|
DataTypeName: string;
|
|
Writeable, Readable: Boolean;
|
|
procedure EndUpdates;
|
|
end;
|
|
|
|
TFieldsMap = class(TObjectDictionary<TRTTIField, TFieldInfo>)
|
|
private
|
|
fWritableFieldsCount: Integer;
|
|
fReadableFieldsCount: Integer;
|
|
public
|
|
constructor Create;
|
|
procedure EndUpdates;
|
|
property WritableFieldsCount: Integer read fWritableFieldsCount;
|
|
property ReadableFieldsCount: Integer read fWritableFieldsCount;
|
|
function GetInfoByFieldName(const FieldName: string): TFieldInfo;
|
|
end;
|
|
|
|
MVCActiveRecordCustomAttribute = class(TCustomAttribute)
|
|
|
|
end;
|
|
|
|
MVCTableAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
Name: string;
|
|
constructor Create(aName: string);
|
|
end;
|
|
|
|
MVCTableFieldAttribute = class(MVCActiveRecordCustomAttribute)
|
|
public
|
|
FieldName: string;
|
|
FieldOptions: TMVCActiveRecordFieldOptions;
|
|
SequenceName, DataTypeName: string;
|
|
constructor Create(const aFieldName: string; const aFieldOptions: TMVCActiveRecordFieldOptions;
|
|
const aSequenceName: string = ''; const aDataTypeName: string = ''); overload;
|
|
constructor Create(aFieldName: string; const aDataTypeName: 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
|
|
fChildren: TObjectList<TObject>;
|
|
fConn: TFDConnection;
|
|
fSQLGenerator: TMVCSQLGenerator;
|
|
fPrimaryKeyFieldName: string;
|
|
fPrimaryKeyOptions: TMVCActiveRecordFieldOptions;
|
|
fPrimaryKeySequenceName: string;
|
|
fPrimaryKeyFieldType: TFieldType;
|
|
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);
|
|
function GetPrimaryKeyFieldType: TFieldType;
|
|
procedure SetTableName(const Value: string);
|
|
protected
|
|
fRTTIType: TRttiInstanceType;
|
|
fProps: TArray<TRTTIField>;
|
|
fObjAttributes: TArray<TCustomAttribute>;
|
|
fPropsAttributes: TArray<TCustomAttribute>;
|
|
fTableName: string;
|
|
fMap: TFieldsMap;
|
|
// fMapNonTransientFields: TFieldsMap;
|
|
// fMapFieldDataTypes: TDictionary<string, 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;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType): TDataSet; overload;
|
|
class function ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType;
|
|
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(const EntityAction: TMVCEntityAction); 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;
|
|
procedure EnsureConnection;
|
|
procedure InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
|
|
/// <summary>
|
|
/// Executes an Insert (pk is null) or an Update (pk is not null)
|
|
/// </summary>
|
|
procedure Store;
|
|
function CheckAction(const aEntityAction: TMVCEntityAction; const aRaiseException: Boolean = True): Boolean;
|
|
procedure Insert;
|
|
function GetMapping: TMVCFieldsMapping;
|
|
function LoadByPK(const id: int64): Boolean; overload; virtual;
|
|
function LoadByPK(const id: string): Boolean; overload; 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;
|
|
procedure AddChildren(const ChildObject: TObject);
|
|
procedure RemoveChildren(const ChildObject: TObject);
|
|
[MVCDoNotSerialize]
|
|
property TableName: string read fTableName write SetTableName;
|
|
[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 GetByPK(const aClass: TMVCActiveRecordClass; const aValue: string;
|
|
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; overload;
|
|
class function SelectDataSet(const SQL: string; const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType): TDataSet; overload;
|
|
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 GetByPK<T: TMVCActiveRecord, constructor>(const aValue: string;
|
|
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 Select<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
|
|
class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions = [];
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function SelectOne<T: TMVCActiveRecord, constructor>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function SelectRQL<T: constructor, TMVCActiveRecord>(const RQL: string; const MaxRecordCount: Integer)
|
|
: TObjectList<T>; overload;
|
|
class function SelectOneByRQL<T: constructor, TMVCActiveRecord>(
|
|
const RQL: string;
|
|
const RaiseExceptionIfNotFound: Boolean): 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 Where<T: TMVCActiveRecord, constructor>(
|
|
const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType): TObjectList<T>; overload;
|
|
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(
|
|
const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetOneByWhere<T: TMVCActiveRecord, constructor>(const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(
|
|
const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
class function GetFirstByWhere<T: TMVCActiveRecord, constructor>(
|
|
const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean = True): T; overload;
|
|
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;
|
|
procedure SetDefault;
|
|
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;
|
|
procedure SetDefault;
|
|
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: TFieldsMap; 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;
|
|
const UseFilterOnly: Boolean = false
|
|
): string; virtual; abstract;
|
|
function CreateSelectSQL(const TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
|
|
function CreateSelectByPKSQL(const TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string;
|
|
virtual; abstract;
|
|
function CreateInsertSQL(const TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
|
|
function CreateUpdateSQL(const TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
|
|
function CreateDeleteSQL(const TableName: string; const Map: TFieldsMap;
|
|
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): 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;
|
|
|
|
// Overwritten by descendant if the SQL syntaxt requires more than the simple table name
|
|
// or if the table name contains spaces.
|
|
function GetTableNameForSQL(const TableName: string): string; virtual;
|
|
// Overwritten by descendant if the SQL syntaxt requires more than the simple field name
|
|
// or if the field name contains spaces.
|
|
function GetFieldNameForSQL(const FieldName: string): string; virtual;
|
|
function GetParamNameForSQL(const FieldName: string): 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;
|
|
|
|
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
|
|
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;
|
|
|
|
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);
|
|
|
|
{ If the transaction is not started, initialize TxIsolation as ReadCommitted }
|
|
if aConnection.Transaction = nil then
|
|
begin
|
|
{ needed for Delphi 10.4 Sydney+ }
|
|
aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted;
|
|
end;
|
|
|
|
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(TokyoOrBetter)}
|
|
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)}
|
|
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;
|
|
|
|
procedure TMVCConnectionsRepository.SetDefault;
|
|
begin
|
|
SetCurrent('default');
|
|
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; const aDataTypeName: string = '');
|
|
begin
|
|
Create(aFieldName, [], '', aDataTypeName);
|
|
end;
|
|
|
|
{ TableAttribute }
|
|
|
|
constructor MVCTableAttribute.Create(aName: string);
|
|
begin
|
|
inherited Create;
|
|
name := aName;
|
|
end;
|
|
|
|
{ TActiveRecord }
|
|
|
|
destructor TMVCActiveRecord.Destroy;
|
|
begin
|
|
fChildren.Free;
|
|
fMap.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, TFieldInfo>;
|
|
lValue: TValue;
|
|
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(SQLGenerator.GetParamNameForSQL(lPair.Value.FieldName));
|
|
if lPar <> nil then
|
|
begin
|
|
lValue := lPair.Key.GetValue(Self);
|
|
lPar.DataTypeName := fMap.GetInfoByFieldName(lPair.Value.FieldName).DataTypeName;
|
|
// if fMapFieldDataTypes.TryGetValue(lPar.Name, lDataType) then
|
|
// begin
|
|
// lPar.DataTypeName := lDataType;
|
|
// end;
|
|
MapTValueToParam(lValue, lPar);
|
|
end
|
|
end;
|
|
|
|
// check if it's the primary key
|
|
lPar := lQry.FindParam(SQLGenerator.GetParamNameForSQL(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 := GetPrimaryKeyFieldType;
|
|
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
|
|
MapDataSetFieldToNullableRTTIField(lValue, lQry.Fields[0], fPrimaryKey, Self);
|
|
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;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, [], Connection);
|
|
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
|
|
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
|
|
Result := ExecQuery(SQL, Values, nil);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.InitTableInfo;
|
|
var
|
|
lAttribute: TCustomAttribute;
|
|
lRTTIField: TRTTIField;
|
|
lFieldInfo: TFieldInfo;
|
|
lPrimaryFieldTypeAsStr: string;
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
if fTableName = '' then
|
|
begin
|
|
if [eaCreate, eaUpdate, eaDelete] * fEntityAllowedActions <> [] then
|
|
begin
|
|
raise Exception.Create('Cannot find TableNameAttribute');
|
|
end;
|
|
end;
|
|
|
|
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;
|
|
lPrimaryFieldTypeAsStr := fPrimaryKey.FieldType.ToString.ToLower;
|
|
if lPrimaryFieldTypeAsStr.EndsWith('int64') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftLargeInt;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('integer') or lPrimaryFieldTypeAsStr.EndsWith('int32') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftInteger;
|
|
end
|
|
else if lPrimaryFieldTypeAsStr.EndsWith('string') then
|
|
begin
|
|
fPrimaryKeyFieldType := ftString;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create
|
|
('Allowed primary key types are: (Nullable)Integer, (Nullable)Int64, (Nullable)String - found: ' +
|
|
lPrimaryFieldTypeAsStr);
|
|
end;
|
|
fPrimaryKeyFieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
fPrimaryKeyOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
|
|
fPrimaryKeySequenceName := MVCTableFieldAttribute(lAttribute).SequenceName;
|
|
continue;
|
|
end;
|
|
|
|
lFieldInfo := TFieldInfo.Create;
|
|
// lFieldInfo.TableName := fTableName;
|
|
lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
lFieldInfo.FieldOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
|
|
lFieldInfo.DataTypeName := MVCTableFieldAttribute(lAttribute).DataTypeName;
|
|
|
|
fMap.Add(lRTTIField, lFieldInfo);
|
|
|
|
// if not(foTransient in MVCTableFieldAttribute(lAttribute).FieldOptions) then
|
|
// begin
|
|
// lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
|
|
// fMapNonTransientFields.Add(lRTTIField, lFieldInfo);
|
|
// end;
|
|
//
|
|
// if not MVCTableFieldAttribute(lAttribute).DataTypeName.IsEmpty then
|
|
// begin
|
|
// fMapFieldDataTypes.Add(MVCTableFieldAttribute(lAttribute).FieldName.ToUpper,
|
|
// MVCTableFieldAttribute(lAttribute).DataTypeName);
|
|
// end;
|
|
|
|
end;
|
|
end;
|
|
end;
|
|
fMap.EndUpdates;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Insert;
|
|
var
|
|
SQL: string;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaCreate);
|
|
OnValidation(TMVCEntityAction.eaCreate);
|
|
OnBeforeInsert;
|
|
OnBeforeInsertOrUpdate;
|
|
if fMap.WritableFieldsCount = 0 then
|
|
begin
|
|
raise EMVCActiveRecord.CreateFmt
|
|
('Cannot insert an entity if all fields are not writable or 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, fMap, 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, True);
|
|
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
|
|
GetConnection;
|
|
end;
|
|
fMap := TFieldsMap.Create;
|
|
// fMapNonTransientFields := TFieldsMap.Create;
|
|
// fMapFieldDataTypes := TDictionary<string, 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: string;
|
|
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 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;
|
|
lLoaded: Boolean;
|
|
begin
|
|
Result := T.Create;
|
|
lActiveRecord := TMVCActiveRecord(Result);
|
|
|
|
try
|
|
lLoaded := lActiveRecord.LoadByPK(aValue);
|
|
except
|
|
FreeAndNil(Result);
|
|
raise;
|
|
end;
|
|
|
|
if not lLoaded then
|
|
begin
|
|
FreeAndNil(Result);
|
|
if RaiseExceptionIfNotFound then
|
|
begin
|
|
raise EMVCActiveRecordNotFound.Create('Data not found');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: string;
|
|
const RaiseExceptionIfNotFound: Boolean): 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 ParamTypes: array of TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
var
|
|
lList: TObjectList<T>;
|
|
begin
|
|
lList := Where<T>(SQLWhere, Params, ParamTypes);
|
|
try
|
|
if lList.Count = 0 then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when at least 1 was expected');
|
|
Exit(nil);
|
|
end;
|
|
Result := lList.Extract(lList.First);
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetFirstByWhere<T>(const SQLWhere: string; const Params: array of Variant;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetFirstByWhere<T>(SQLWhere, Params, [], RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.GetOneByWhere<T>(const SQLWhere: string;
|
|
const Params: array of Variant; const ParamTypes: array of TFieldType;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := GetFirstByWhere<T>(SQLWhere, Params, ParamTypes, false);
|
|
if Result = nil then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.GetMapping: TMVCFieldsMapping;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
i: Integer;
|
|
begin
|
|
{ TODO -oDanieleT -cGeneral : Let share the mapping for instances of the same type }
|
|
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.FieldName;
|
|
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 EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
|
|
end;
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectOneByRQL<T>(
|
|
const RQL: string;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
var
|
|
lAR: TMVCActiveRecord;
|
|
lSQL: string;
|
|
begin
|
|
lAR := T.Create;
|
|
try
|
|
lSQL := lAR.SQLGenerator.CreateSQLWhereByRQL(RQL, lAR.GetMapping).Trim;
|
|
if lSQL.StartsWith('where', True) then
|
|
lSQL := lSQL.Remove(0, 5).Trim;
|
|
Result := GetFirstByWhere<T>(lSQL, [], RaiseExceptionIfNotFound);
|
|
if Result = nil then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected');
|
|
end;
|
|
finally
|
|
lAR.Free;
|
|
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.GetPrimaryKeyFieldType: TFieldType;
|
|
begin
|
|
Result := fPrimaryKeyFieldType;
|
|
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.GetConnection: TFDConnection;
|
|
begin
|
|
if fConn = nil then
|
|
begin
|
|
fConn := ActiveRecordConnectionsRegistry.GetCurrent;
|
|
end;
|
|
Result := fConn;
|
|
end;
|
|
|
|
constructor TMVCActiveRecord.Create;
|
|
begin
|
|
Create(True);
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.Delete;
|
|
var
|
|
SQL: string;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaDelete);
|
|
OnValidation(TMVCEntityAction.eaDelete);
|
|
OnBeforeDelete;
|
|
if not Assigned(fPrimaryKey) then
|
|
raise Exception.CreateFmt('Cannot delete %s without a primary key', [ClassName]);
|
|
SQL := SQLGenerator.CreateDeleteSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
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
|
|
{$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 (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}
|
|
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, TFieldInfo>;
|
|
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 not lItem.Value.Readable then
|
|
begin
|
|
continue;
|
|
end;
|
|
lField := aDataSet.FindField(lItem.Value.FieldName);
|
|
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.FieldName]);
|
|
end;
|
|
MapDataSetFieldToRTTIField(lField, lItem.Key, Self);
|
|
end;
|
|
if not fPrimaryKeyFieldName.IsEmpty then
|
|
begin
|
|
MapDataSetFieldToRTTIField(aDataSet.FieldByName(fPrimaryKeyFieldName), fPrimaryKey, Self);
|
|
end;
|
|
end;
|
|
OnAfterLoad;
|
|
end;
|
|
|
|
function TMVCActiveRecord.LoadByPK(const id: string): Boolean;
|
|
var
|
|
SQL: string;
|
|
lDataSet: TDataSet;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaRetrieve);
|
|
SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
lDataSet := ExecQuery(SQL, [id], GetConnection);
|
|
try
|
|
Result := not lDataSet.Eof;
|
|
if Result then
|
|
begin
|
|
LoadByDataset(lDataSet);
|
|
end;
|
|
finally
|
|
lDataSet.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCActiveRecord.LoadByPK(const id: int64): Boolean;
|
|
var
|
|
SQL: string;
|
|
lDataSet: TDataSet;
|
|
begin
|
|
CheckAction(TMVCEntityAction.eaRetrieve);
|
|
SQL := SQLGenerator.CreateSelectByPKSQL(fTableName, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
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;
|
|
|
|
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(const EntityAction: TMVCEntityAction);
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.RemoveChildren(const ChildObject: TObject);
|
|
begin
|
|
if fChildren <> nil then
|
|
begin
|
|
fChildren.Extract(ChildObject);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.InvalidateConnection(const ReacquireAfterInvalidate: Boolean = false);
|
|
begin
|
|
FreeAndNil(fConn);
|
|
if ReacquireAfterInvalidate then
|
|
begin
|
|
EnsureConnection;
|
|
end;
|
|
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 TMVCActiveRecord.SelectDataSet(const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType): TDataSet;
|
|
begin
|
|
Result := TMVCActiveRecord.ExecQuery(SQL, Params, ParamTypes);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.Select<T>(const SQL: string; const Params: array of Variant;
|
|
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
|
|
begin
|
|
Result := Select<T>(SQL, Params, [], Options);
|
|
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.Select<T>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
lHandled: Boolean;
|
|
begin
|
|
Result := TObjectList<T>.Create(True);
|
|
try
|
|
lDataSet := ExecQuery(SQL, Params, ParamTypes);
|
|
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 TMVCActiveRecordHelper.SelectOne<T>(const SQL: string;
|
|
const Params: array of Variant; const RaiseExceptionIfNotFound: Boolean): T;
|
|
begin
|
|
Result := SelectOne<T>(SQL, Params, [], [], RaiseExceptionIfNotFound);
|
|
end;
|
|
|
|
class function TMVCActiveRecordHelper.SelectOne<T>(const SQL: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType;
|
|
const Options: TMVCActiveRecordLoadOptions;
|
|
const RaiseExceptionIfNotFound: Boolean): T;
|
|
var
|
|
lDataSet: TDataSet;
|
|
lAR: TMVCActiveRecord;
|
|
lHandled: Boolean;
|
|
lList: TObjectList<T>;
|
|
begin
|
|
Result := nil;
|
|
lList := Select<T>(SQL, Params, ParamTypes, Options);
|
|
try
|
|
if (lList.Count = 0) then
|
|
begin
|
|
if RaiseExceptionIfNotFound then
|
|
raise EMVCActiveRecordNotFound.Create('Got 0 rows when exactly 1 was expected')
|
|
else
|
|
Exit(nil);
|
|
end;
|
|
if lList.Count > 1 then
|
|
begin
|
|
raise EMVCActiveRecordNotFound.CreateFmt('Got %d rows when exactly 1 was expected', [lList.Count]);
|
|
end;
|
|
Result := lList.Extract(lList.First);
|
|
finally
|
|
lList.Free;
|
|
end;
|
|
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 TMVCActiveRecordHelper.Where<T>(const SQLWhere: string;
|
|
const Params: array of Variant;
|
|
const ParamTypes: array of TFieldType): 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, ParamTypes);
|
|
end
|
|
else
|
|
begin
|
|
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params, ParamTypes);
|
|
end;
|
|
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);
|
|
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> and aValue.IsType<NullableInt32>() then
|
|
begin
|
|
if aValue.IsType<UInt32> then
|
|
begin
|
|
lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
|
|
end;
|
|
end
|
|
else if lPKValue.IsType<NullableInt64> and aValue.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<NullableString> and aValue.IsType<NullableString>() then
|
|
begin
|
|
if aValue.AsType<NullableString>().HasValue then
|
|
begin
|
|
lPKValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lPKValue.AsType<NullableString>().Clear;
|
|
end;
|
|
end
|
|
else if lPKValue.IsType<NullableUInt32> and aValue.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> and aValue.IsType<NullableUInt64>() then
|
|
begin
|
|
if aValue.AsType<NullableUInt64>().HasValue then
|
|
begin
|
|
lPKValue := aValue;
|
|
end
|
|
else
|
|
begin
|
|
lPKValue.AsType<NullableUInt64>().Clear;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCActiveRecord.Create('Invalid type for primary key [HINT] Double check if TypeInfo(PK) is equal to TypeInfo(Value)');
|
|
end;
|
|
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;
|
|
|
|
procedure TMVCActiveRecord.SetTableName(const Value: string);
|
|
begin
|
|
fTableName := Value;
|
|
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, TFieldInfo>;
|
|
begin
|
|
Result := 'Table Name: ' + fTableName;
|
|
for keyvalue in fMap do
|
|
Result := Result + sLineBreak + #9 + keyvalue.Key.Name + ' = ' + keyvalue.Value.FieldName;
|
|
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 if Value.IsType<NullableString>() then
|
|
begin
|
|
Result := Value.AsType<NullableString>().HasValue;
|
|
if Result then
|
|
Value := Value.AsType<NullableString>().Value;
|
|
end
|
|
else
|
|
raise EMVCActiveRecord.Create
|
|
('Invalid primary key type [HINT: Use Int64, String, NullableInt64 or NullableString, 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(TMVCEntityAction.eaUpdate);
|
|
OnBeforeUpdate;
|
|
OnBeforeInsertOrUpdate;
|
|
if fMap.WritableFieldsCount = 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, fMap, fPrimaryKeyFieldName, fPrimaryKeyOptions);
|
|
ExecNonQuery(SQL, false);
|
|
OnAfterUpdate;
|
|
OnAfterInsertOrUpdate;
|
|
end;
|
|
|
|
procedure TMVCActiveRecord.AddChildren(const ChildObject: TObject);
|
|
begin
|
|
if fChildren = nil then
|
|
begin
|
|
fChildren := TObjectList<TObject>.Create(True);
|
|
end;
|
|
if not(fChildren.Contains(ChildObject)) and (not(ChildObject = Self)) then
|
|
begin
|
|
fChildren.Add(ChildObject);
|
|
end;
|
|
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>;
|
|
begin
|
|
Result := Where<T>(SQLWhere, Params, []);
|
|
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;
|
|
GetCompiler;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetMapping: TMVCFieldsMapping;
|
|
begin
|
|
Result := fMapping;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetParamNameForSQL(const FieldName: string): string;
|
|
begin
|
|
Result := fCompiler.GetParamNameForSQL(FieldName);
|
|
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.GetFieldNameForSQL(const FieldName: string): string;
|
|
begin
|
|
Result := fCompiler.GetFieldNameForSQL(FieldName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.GetRQLParser: TRQL2SQL;
|
|
begin
|
|
if fRQL2SQL = nil then
|
|
begin
|
|
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.GetTableNameForSQL(const TableName: string): string;
|
|
begin
|
|
Result := fCompiler.GetTableNameForSQL(TableName);
|
|
end;
|
|
|
|
function TMVCSQLGenerator.HasReturning: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.HasSequences: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TMVCSQLGenerator.TableFieldsDelimited(const Map: TFieldsMap; const PKFieldName: string;
|
|
const Delimiter: string): string;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
for lPair in Map do
|
|
begin
|
|
// if not lPair.Value.FieldName.IsEmpty then
|
|
if lPair.Value.Readable then
|
|
begin
|
|
Result := Result + GetFieldNameForSQL(lPair.Value.FieldName) + Delimiter;
|
|
end;
|
|
end;
|
|
Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
|
|
if not PKFieldName.IsEmpty then
|
|
begin
|
|
if not Result.IsEmpty then
|
|
begin
|
|
Result := GetFieldNameForSQL(PKFieldName) + ', ' + Result
|
|
end
|
|
else
|
|
begin
|
|
Result := GetFieldNameForSQL(PKFieldName)
|
|
end;
|
|
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;
|
|
const aSequenceName: string; const aDataTypeName: string);
|
|
begin
|
|
inherited Create;
|
|
FieldName := aFieldName;
|
|
FieldOptions := aFieldOptions;
|
|
SequenceName := aSequenceName;
|
|
DataTypeName := aDataTypeName;
|
|
end;
|
|
|
|
{ EMVCActiveRecordNotFound }
|
|
|
|
procedure EMVCActiveRecordNotFound.AfterConstruction;
|
|
begin
|
|
inherited;
|
|
fHttpErrorCode := http_status.NotFound;
|
|
end;
|
|
|
|
class
|
|
function TMVCActiveRecord.ExecQuery(
|
|
const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType;
|
|
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;
|
|
if Length(ValueTypes) = 0 then
|
|
begin
|
|
lQry.Open(SQL, Values);
|
|
end
|
|
else
|
|
begin
|
|
lQry.Open(SQL, Values, ValueTypes);
|
|
end;
|
|
Result := lQry;
|
|
except
|
|
lQry.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
class
|
|
function TMVCActiveRecord.ExecQuery(const SQL: string;
|
|
const Values: array of Variant;
|
|
const ValueTypes: array of TFieldType): TDataSet;
|
|
begin
|
|
Result := ExecQuery(SQL, Values, ValueTypes, nil);
|
|
end;
|
|
|
|
{ TFieldsMap }
|
|
|
|
constructor TFieldsMap.Create;
|
|
begin
|
|
inherited Create([doOwnsValues]);
|
|
fWritableFieldsCount := -1;
|
|
fReadableFieldsCount := -1;
|
|
end;
|
|
|
|
procedure TFieldsMap.EndUpdates;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
fWritableFieldsCount := 0;
|
|
fReadableFieldsCount := 0;
|
|
for lPair in Self do
|
|
begin
|
|
lPair.Value.EndUpdates;
|
|
// if not(foTransient in lPair.Value.FieldOptions) then
|
|
if lPair.Value.Writeable then
|
|
begin
|
|
Inc(fWritableFieldsCount);
|
|
end;
|
|
if lPair.Value.Readable then
|
|
begin
|
|
Inc(fReadableFieldsCount);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TFieldsMap.GetInfoByFieldName(const FieldName: string): TFieldInfo;
|
|
var
|
|
lPair: TPair<TRTTIField, TFieldInfo>;
|
|
begin
|
|
for lPair in Self do
|
|
begin
|
|
if SameText(FieldName, lPair.Value.FieldName) then
|
|
begin
|
|
Result := Items[lPair.Key];
|
|
Exit;
|
|
end;
|
|
end;
|
|
raise EMVCActiveRecord.CreateFmt('FieldName not found in table [%s]', [FieldName]);
|
|
end;
|
|
|
|
{ TFieldInfo }
|
|
|
|
procedure TFieldInfo.EndUpdates;
|
|
begin
|
|
if FieldName.IsEmpty then
|
|
begin
|
|
Writeable := false;
|
|
Readable := false;
|
|
end
|
|
else
|
|
begin
|
|
// Writeable := (not (foReadOnly in FieldOptions)) and (not((foAutoGenerated in FieldOptions) or (foTransient in FieldOptions)));
|
|
Writeable := ((FieldOptions * [foReadOnly, foTransient, foAutoGenerated]) = []);
|
|
// Readable := (not (foWriteOnly in FieldOptions)) and (not(foTransient in FieldOptions));
|
|
Readable := (FieldOptions * [foWriteOnly, foTransient]) = [];
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
|
|
gLock := TObject.Create;
|
|
gCtx := TRttiContext.Create;
|
|
gCtx.FindType('');
|
|
|
|
finalization
|
|
|
|
gCtx.Free;
|
|
gLock.Free;
|
|
|
|
end.
|