delphimvcframework/sources/MVCFramework.ActiveRecord.pas
Daniele Teti a57cc3581f - New! TMVCActiveRecord.DeleteAll deletes all the records from a table
- New! `TMVCActiveRecord.DeleteRQL` deletes records using an `RQL` expression as `where` clause.
- New! Microsoft SQLServer Support in ActiveRecord and RQL (thanks to one of the biggest Delphi based company in Italy which heavily uses DMVCFramework)
- Improved! `ActiveRecordShowCase` sample is much better now.
2019-02-21 18:12:01 +01:00

1969 lines
52 KiB
ObjectPascal

// *************************************************************************** }
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2019 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;
interface
uses
System.Generics.Defaults,
System.Generics.Collections,
System.RTTI,
FireDAC.DApt,
Data.DB,
MVCFramework.Commons,
MVCFramework.RQL.Parser,
MVCFramework,
MVCFramework.Serializer.Intf,
FireDAC.Comp.Client,
FireDAC.Stan.Param,
System.SysUtils;
type
EMVCActiveRecord = class(EMVCException)
public
constructor Create(const AMsg: string); reintroduce; { do not override!! }
end;
EMVCActiveRecordNotFound = class(EMVCActiveRecord)
end;
TMVCActiveRecordClass = class of TMVCActiveRecord;
TMVCActiveRecordFieldOption = (foAutoGenerated, foNoUpdate);
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 = class(MVCActiveRecordCustomAttribute)
public
FieldName: string;
FieldOptions: TMVCActiveRecordFieldOptions;
constructor Create(const aFieldName: string;
const aFieldOptions: TMVCActiveRecordFieldOptions); overload;
constructor Create(const aFieldName: string); overload;
end;
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(const aValue: TValue; const aParam: TFDParam);
protected
fRTTIType: TRttiType;
fProps: TArray<TRttiField>;
fObjAttributes: TArray<TCustomAttribute>;
fPropsAttributes: TArray<TCustomAttribute>;
fTableName: string;
fMap: TDictionary<TRttiField, string>;
fMapUpdate: 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;
// class function ExecNonQuery(const SQL: string; const Values: array of Variant): int64; overload;
// class function ExecNonQuery(const SQL: string; const Values: array of Variant; const Connection: TFDConnection): int64; 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 after insert or update the object to the database
/// </summary>
procedure OnAfterInsertOrUpdate; virtual;
function GenerateSelectSQL: string;
function SQLGenerator: TMVCSQLGenerator;
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;
class function GetByPK<T: TMVCActiveRecord, constructor>
(const aValue: int64): T; overload;
class function GetByPK(const aClass: TMVCActiveRecordClass;
const aValue: int64): TMVCActiveRecord; overload;
class function GetScalar(const SQL: string;
const Params: array of Variant): Variant;
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string;
const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>;
overload;
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;
class function SelectRQL<T: constructor, TMVCActiveRecord>
(const RQL: string; const MaxRecordCount: Integer)
: TObjectList<T>; overload;
function SelectRQL(const RQL: string; const MaxRecordCount: Integer)
: TMVCActiveRecordList; 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;
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<T: TMVCActiveRecord, constructor>
: TObjectList<T>; overload;
class function All(const aClass: TMVCActiveRecordClass)
: TObjectList<TMVCActiveRecord>; overload;
class function DeleteAll(const aClass: TMVCActiveRecordClass)
: int64; overload;
function Count: int64; overload;
class function Count<T: TMVCActiveRecord>: int64; overload;
class function Count(const aClass: TMVCActiveRecordClass): int64; overload;
class function SelectDataSet(const SQL: string;
const Params: array of Variant): TDataSet;
class function CurrentConnection: TFDConnection;
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 RemoveConnection(const aName: string);
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 RemoveConnection(const aName: string);
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,
FireDAC.Stan.Option,
Data.FmtBcd;
var
gCtx: TRttiContext;
gEntitiesRegistry: IMVCEntitiesRegistry;
gConnections: IMVCActiveRecordConnections;
gLock: TObject;
function GetBackEndByConnection(aConnection: TFDConnection): string;
begin
case 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;
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
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
fMREW.BeginRead;
try
if fCurrentConnectionsByThread.TryGetValue(TThread.Current.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.Current.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.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.Current.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;
fMapUpdate.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;
begin
lQry := TFDQuery.Create(nil);
try
lQry.Connection := fConn;
lQry.SQL.Text := SQL;
// lQry.Prepare;
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;
if RefreshAutoGenerated and (TMVCActiveRecordFieldOption.foAutoGenerated
in fPrimaryKeyOptions) then
begin
lQry.Open;
fPrimaryKey.SetValue(Self, lQry.FieldByName(fPrimaryKeyFieldName)
.AsInteger);
OnAfterLoad;
end
else
begin
lQry.ExecSQL(SQL);
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 := 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
fMap.Add(lRTTIField, { fTableName + '.' + } MVCTableFieldAttribute
(lAttribute).FieldName);
if not(foNoUpdate in MVCTableFieldAttribute(lAttribute).FieldOptions)
then
fMapUpdate.Add(lRTTIField, MVCTableFieldAttribute(lAttribute)
.FieldName);
end
else if lAttribute is MVCPrimaryKeyAttribute then
begin
fPrimaryKey := lRTTIField;
fPrimaryKeyFieldName := MVCPrimaryKeyAttribute(lAttribute).FieldName;
fPrimaryKeyOptions := MVCPrimaryKeyAttribute(lAttribute).FieldOptions;
end;
end;
end;
end;
procedure TMVCActiveRecord.Insert;
var
SQL: string;
begin
CheckAction(TMVCEntityAction.eaCreate);
OnValidation;
OnBeforeInsert;
OnBeforeInsertOrUpdate;
SQL := SQLGenerator.CreateInsertSQL(fTableName, fMapUpdate,
fPrimaryKeyFieldName, fPrimaryKeyOptions);
ExecNonQuery(SQL, True);
OnAfterInsert;
OnAfterInsertOrUpdate;
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;
fMapUpdate := 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): TMVCActiveRecord;
begin
Result := aClass.Create;
if not Result.LoadByPK(aValue) then
begin
Result.Free;
raise EMVCActiveRecordNotFound.Create('Record not found');
end;
end;
class function TMVCActiveRecord.GetByPK<T>(const aValue: int64): T;
var
lActiveRecord: TMVCActiveRecord;
begin
Result := T.Create;
lActiveRecord := TMVCActiveRecord(Result);
if not lActiveRecord.LoadByPK(aValue) then
begin
Result.Free;
raise EMVCActiveRecordNotFound.Create('Record not found');
end;
end;
class function TMVCActiveRecord.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;
lList.OwnsObjects := false;
Result := lList.First;
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 TMVCActiveRecord.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);
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): int64;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := lAR.Count;
finally
lAR.Free;
end;
end;
function TMVCActiveRecord.Count: int64;
begin
Result := GetScalar(Self.SQLGenerator.CreateSelectCount(fTableName), []);
end;
class function TMVCActiveRecord.Count<T>: int64;
begin
Result := Count(TMVCActiveRecordClass(T));
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, fPrimaryKey.GetValue(Self).AsInt64);
ExecNonQuery(SQL, false);
OnAfterDelete;
end;
class function TMVCActiveRecord.DeleteAll(const aClass
: TMVCActiveRecordClass): int64;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create;
try
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL
(lAR.fTableName));
finally
lAR.Free;
end;
end;
class function TMVCActiveRecord.DeleteRQL(const aClass: TMVCActiveRecordClass;
const RQL: string): int64;
var
lAR: TMVCActiveRecord;
begin
lAR := aClass.Create(True);
try
Result := lAR.ExecNonQuery(lAR.SQLGenerator.CreateDeleteAllSQL
(lAR.fTableName) + lAR.SQLGenerator.CreateSQLWhereByRQL(RQL,
lAR.GetMapping, False));
finally
lAR.Free;
end;
end;
procedure TMVCActiveRecord.MapColumnToTValue(const aFieldName: string;
const aField: TField; const aRTTIField: TRttiField);
var
lInternalStream: TStream;
lSStream: TStringStream;
begin
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, 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;
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;
else
raise EMVCActiveRecord.CreateFmt('Unsupported FieldType (%d) for field %s',
[Ord(aField.DataType), aFieldName]);
end;
end;
procedure TMVCActiveRecord.MapTValueToParam(const aValue: TValue;
const aParam: TFDParam);
var
lStream: TStream;
begin
case aValue.TypeInfo.Kind of
// tkUnknown:
// 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;
tkString, tkUString:
begin
aParam.AsString := aValue.AsString;
end;
tkWideString:
begin
aParam.AsWideString := aValue.AsString;
end;
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 aValue.TypeInfo.Name = 'TDate' then
begin
aParam.AsDate := Trunc(aValue.AsExtended);
end
else if aValue.TypeInfo.Name = 'TDateTime' then
begin
aParam.AsDateTime := aValue.AsExtended;
end
else if aValue.TypeInfo.Name = '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]);
lStream := aValue.AsType<TStream>(false);
if Assigned(lStream) then
begin
lStream.Position := 0;
aParam.LoadFromStream(lStream, ftBlob);
end
else
begin
aParam.Clear;
end;
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 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;
begin
CheckAction(TMVCEntityAction.eaRetrieve);
OnBeforeLoad;
for lItem in fMap do
begin
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;
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.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;
// lDataSet.First;
// TFile.WriteAllText('output.json', lDataSet.AsJSONArray);
finally
lDataSet.Free;
end;
except
Result.Free;
raise;
end;
end;
class function TMVCActiveRecord.Select<T>(const SQL: string;
const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions)
: TObjectList<T>;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
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;
var
lSQL: string;
begin
lSQL := SQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping);
LogD(Format('RQL [%s] => SQL [%s]', [RQL, lSQL]));
Result := Where(TMVCActiveRecordClass(Self.ClassType), lSQL, []);
end;
class function TMVCActiveRecord.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.SelectRQL(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;
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;
{ TODO -oDanieleT -cSQLGenerators : Add a parameter to update to allow to update only selected fields }
SQL := SQLGenerator.CreateUpdateSQL(fTableName, fMapUpdate,
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 TMVCActiveRecord.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 TMVCActiveRecord.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
Result := Result + lPair.value + Delimiter;
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
FreeAndNil(Connection);
inherited;
end;
constructor MVCTableFieldAttribute.Create(const aFieldName: string;
const aFieldOptions: TMVCActiveRecordFieldOptions);
begin
inherited Create;
FieldName := aFieldName;
FieldOptions := aFieldOptions;
end;
initialization
gLock := TObject.Create;
gCtx := TRttiContext.Create;
gCtx.FindType('');
finalization
gCtx.Free;
gLock.Free;
end.