Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 15:55:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Added PostgreSQL SQLGenerator

Browse Source
This commit is contained in:
Daniele Teti 2019-01-13 18:56:33 +01:00
parent 5c7c8ade66
commit f09ae31a91
7 changed files with 263 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
samples/activerecord_showcase/EntitiesU.pas
View File

@ -35,7 +35,7 @@ uses
type
[MVCNameCase(ncLowerCase)]
[MVCTable('ARTICOLI')]
[MVCTable('articoli')]
TArticle = class(TMVCActiveRecord)
private
[MVCTableField('ID')]
@ -58,7 +58,7 @@ type
TOrder = class;
[MVCNameCase(ncLowerCase)]
[MVCTable('CLIENTI')]
[MVCTable('clienti')]
TCustomer = class(TMVCActiveRecord)
private
[MVCPrimaryKey('ID', [foAutoGenerated])]
@ -79,7 +79,7 @@ type
end;
[MVCNameCase(ncLowerCase)]
[MVCTable('DETTAGLIO_ORDINI')]
[MVCTable('dettaglio_ordini')]
TOrderDetail = class(TMVCActiveRecord)
private
[MVCPrimaryKey('ID', [foAutoGenerated])]
@ -112,7 +112,7 @@ type
end;
[MVCNameCase(ncLowerCase)]
[MVCTable('ORDINI')]
[MVCTable('ordini')]
TOrder = class(TMVCActiveRecord)
private
[MVCPrimaryKey('ID', [foAutoGenerated])]
@ -133,7 +133,7 @@ type
end;
[MVCNameCase(ncLowerCase)]
[MVCTable('CLIENTI')]
[MVCTable('clienti')]
TCustomerEx = class(TCustomer)
private
fOrders: TObjectList<TOrder>;
@ -145,7 +145,7 @@ type
end;
[MVCNameCase(ncLowerCase)]
[MVCTable('CLIENTI')]
[MVCTable('clienti')]
TCustomerWithLogic = class(TCustomer)
private
fIsLocatedInRome: Boolean;

28
samples/activerecord_showcase/FDConnectionConfigU.pas
View File

@ -7,6 +7,7 @@ const
procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean);
procedure CreateMySQLPrivateConnDef(AIsPooled: boolean);
procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean);
implementation
@ -68,4 +69,31 @@ begin
end;
end;
procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
begin
LParams := TStringList.Create;
try
LParams.Add('Database=activerecorddb');
LParams.Add('Protocol=TCPIP');
LParams.Add('Server=localhost');
LParams.Add('User_Name=postgres');
LParams.Add('Password=daniele');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'PG', LParams);
finally
LParams.Free;
end;
end;
end.

38
samples/activerecord_showcase/MainFormU.pas
View File

@ -26,7 +26,9 @@ uses
Data.DB,
FireDAC.Comp.Client,
FireDAC.Phys.FB,
FireDAC.Phys.FBDef;
FireDAC.Phys.FBDef,
FireDAC.Phys.PGDef,
FireDAC.Phys.PG;
type
TMainForm = class(TForm)
@ -61,6 +63,7 @@ implementation
{$R *.dfm}
uses
MVCFramework.ActiveRecord,
EntitiesU,
@ -132,6 +135,7 @@ procedure TMainForm.btnMultiThreadingClick(Sender: TObject);
var
lTasks: TArray<ITask>;
lProc: TProc;
lConnParams: string;
const
Cities: array [0 .. 4] of string = ('Rome', 'New York', 'London', 'Melbourne', 'Berlin');
begin
@ -139,9 +143,12 @@ begin
TMVCActiveRecord.CurrentConnection.ExecSQL('DELETE FROM CLIENTI WHERE RAG_SOC STARTING ''Company ''')
else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mysql' then
TMVCActiveRecord.CurrentConnection.ExecSQL('DELETE FROM CLIENTI WHERE RAG_SOC LIKE ''Company %''')
else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql' then
TMVCActiveRecord.CurrentConnection.ExecSQL('DELETE FROM CLIENTI WHERE RAG_SOC LIKE ''Company %''')
else
raise Exception.Create('Unknown backend for direct SQL execution');
lConnParams := FDConnection1.Params.Text;
lProc := procedure
var
lConn: TFDConnection;
@ -151,8 +158,8 @@ begin
lConn := TFDConnection.Create(nil);
try
lConn.ConnectionDefName := CON_DEF_NAME;
ActiveRecordConnectionsRegistry.AddConnection('default', lConn);
lConn.Params.Assign(FDConnection1.Params);
ActiveRecordConnectionsRegistry.AddConnection('default', lConn, True);
lConn.Params.Text := lConnParams;
lConn.Open;
for I := 1 to 10 do
begin
@ -260,6 +267,7 @@ var
lItem: TMVCActiveRecord;
lCustomer: TCustomer;
begin
Log('**RQL Query');
lList := TMVCActiveRecord.SelectRQL(TCustomer, 'eq(City,"Rome")', 20);
try
for lItem in lList do
@ -279,11 +287,16 @@ var
lDS: TDataSet;
begin
Log('** Query SQL');
//Bypassing the RQL parser you can use DBMS-specific features or just joining your tables.
// Bypassing the RQL parser you can use DBMS-specific features or just joining your tables.
if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'firebird' then
lCustomers := TMVCActiveRecord.Select<TCustomer>('SELECT * FROM CLIENTI WHERE RAG_SOC CONTAINING ?', ['google'])
else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mysql' then
lCustomers := TMVCActiveRecord.Select<TCustomer>('SELECT * FROM CLIENTI WHERE RAG_SOC LIKE ''%google%''', [])
else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql' then
lCustomers := TMVCActiveRecord.Select<TCustomer>('SELECT * FROM CLIENTI WHERE RAG_SOC ILIKE ''%google%''', [])
else
lCustomers := TMVCActiveRecord.Select<TCustomer>('SELECT * FROM CLIENTI WHERE RAG_SOC LIKE ''%google%''', []);
raise Exception.Create('Unsupported backend: ' + ActiveRecordConnectionsRegistry.GetCurrentBackend);
try
for lCustomer in lCustomers do
begin
@ -296,8 +309,13 @@ begin
Log('** Query SQL returning DataSet');
if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'firebird' then
lDS := TMVCActiveRecord.SelectDataSet('SELECT * FROM CLIENTI WHERE RAG_SOC CONTAINING ?', ['google'])
else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'mysql' then
lDS := TMVCActiveRecord.SelectDataSet('SELECT * FROM CLIENTI WHERE RAG_SOC LIKE ''%google%''', [])
else if ActiveRecordConnectionsRegistry.GetCurrentBackend = 'postgresql' then
lDS := TMVCActiveRecord.SelectDataSet('SELECT * FROM CLIENTI WHERE RAG_SOC ILIKE ''%google%''', [])
else
lDS := TMVCActiveRecord.SelectDataSet('SELECT * FROM CLIENTI WHERE RAG_SOC LIKE ''%google%''', []);
raise Exception.Create('Unsupported backend: ' + ActiveRecordConnectionsRegistry.GetCurrentBackend);
try
while not lDS.Eof do
begin
@ -338,15 +356,19 @@ end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
// To use Firebird uncomment the following line (and comment the next one)
// To use Firebird uncomment the following line (and comment the others one)
FDConnectionConfigU.CreateFirebirdPrivateConnDef(True);
// To use MySQL uncomment the following line (and comment the previous one)
// To use MySQL uncomment the following line (and comment the others one)
// FDConnectionConfigU.CreateMySQLPrivateConnDef(True);
// To use Postgresql uncomment the following line (and comment the others one)
// FDConnectionConfigU.CreatePostgresqlPrivateConnDef(True);
FDConnection1.Params.Clear;
FDConnection1.ConnectionDefName := FDConnectionConfigU.CON_DEF_NAME;
ActiveRecordConnectionsRegistry.AddConnection('default', FDConnection1);
Caption := Caption + ' (Curr Backend: ' + ActiveRecordConnectionsRegistry.GetCurrentBackend + ')';
end;
procedure TMainForm.FormDestroy(Sender: TObject);

3
samples/activerecord_showcase/activerecord_showcase.dpr
View File

@ -11,7 +11,8 @@ uses
MVCFramework.SQLGenerators.Firebird in '..\..\sources\MVCFramework.SQLGenerators.Firebird.pas',
MVCFramework.RQL.AST2MySQL in '..\..\sources\MVCFramework.RQL.AST2MySQL.pas',
MVCFramework.RQL.AST2InterbaseSQL in '..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas',
MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas';
MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas',
MVCFramework.SQLGenerators.PostgreSQL in '..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas';
{$R *.res}

1
samples/activerecord_showcase/activerecord_showcase.dproj
View File

@ -115,6 +115,7 @@
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2MySQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.SQLGenerators.PostgreSQL.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

195
sources/MVCFramework.SQLGenerators.PostgreSQL.pas Normal file
View File

@ -0,0 +1,195 @@
// *************************************************************************** }
//
// 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.SQLGenerators.PostgreSQL;
interface
uses
System.Rtti,
System.Generics.Collections,
FireDAC.Phys.FB,
FireDAC.Phys.FBDef,
MVCFramework.ActiveRecord,
MVCFramework.Commons,
MVCFramework.RQL.Parser;
type
TMVCSQLGeneratorPostgreSQL = class(TMVCSQLGenerator)
protected
function GetCompilerClass: TRQLCompilerClass; override;
public
function CreateSelectSQL(
const TableName: string;
const Map: TDictionary<TRttiField, string>;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string; override;
function CreateInsertSQL(
const TableName: string;
const Map: TDictionary<TRttiField, string>;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string; override;
function CreateUpdateSQL(
const TableName: string;
const Map: TDictionary<TRttiField, string>;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string; override;
function CreateDeleteSQL(
const TableName: string;
const Map: TDictionary<TRttiField, string>;
const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions;
const PrimaryKeyValue: Int64): string; override;
function CreateSelectByPKSQL(
const TableName: string;
const Map: TDictionary<TRttiField, string>; const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions;
const PrimaryKeyValue: Int64): string; override;
function CreateSelectSQLByRQL(
const RQL: string;
const Mapping: TMVCFieldsMapping): string; override;
end;
implementation
{
All identifiers (including column names) that are not double-quoted are folded to
lower case in PostgreSQL. Column names that were created with double-quotes and thereby
retained upper-case letters (and/or other syntax violations) have to be double-quoted
for the rest of their life.
}
uses
System.SysUtils,
MVCFramework.RQL.AST2PostgreSQL;
function TMVCSQLGeneratorPostgreSQL.CreateInsertSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string;
var
lKeyValue: TPair<TRttiField, string>;
lSB: TStringBuilder;
begin
lSB := TStringBuilder.Create;
try
lSB.Append('INSERT INTO ' + TableName.QuotedString('"') + ' (');
for lKeyValue in Map do
lSB.Append(lKeyValue.value + ',');
lSB.Remove(lSB.Length - 1, 1);
lSB.Append(') values (');
for lKeyValue in Map do
begin
lSB.Append(':' + lKeyValue.value + ',');
end;
lSB.Remove(lSB.Length - 1, 1);
lSB.Append(')');
if TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions then
begin
lSB.Append(' RETURNING ' + PKFieldName);
// case GetBackEnd of
// cbPostgreSQL:
// begin
// lSB.Append(' RETURNING ' + fPrimaryKeyFieldName);
// end;
// cbMySQL:
// begin
// lSB.Append(';SELECT LAST_INSERT_ID() as ' + fPrimaryKeyFieldName);
// end;
// else
// raise EMVCActiveRecord.Create('Unsupported backend engine');
// end;
end;
Result := lSB.ToString;
finally
lSB.Free;
end;
end;
function TMVCSQLGeneratorPostgreSQL.CreateSelectByPKSQL(
const TableName: string;
const Map: TDictionary<TRttiField, string>; const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions;
const PrimaryKeyValue: Int64): string;
begin
Result := CreateSelectSQL(TableName, Map, PKFieldName, PKOptions) + ' WHERE ' +
PKFieldName + '= :' + PKFieldName; // IntToStr(PrimaryKeyValue);
end;
function TMVCSQLGeneratorPostgreSQL.CreateSelectSQL(const TableName: string;
const Map: TDictionary<TRttiField, string>; const PKFieldName: string;
const PKOptions: TMVCActiveRecordFieldOptions): string;
begin
Result := 'SELECT ' + TableFieldsDelimited(Map, PKFieldName, ',') + ' FROM ' + TableName.QuotedString('"');
end;
function TMVCSQLGeneratorPostgreSQL.CreateSelectSQLByRQL(const RQL: string;
const Mapping: TMVCFieldsMapping): string;
var
lPostgreSQLCompiler: TRQLPostgreSQLCompiler;
begin
lPostgreSQLCompiler := TRQLPostgreSQLCompiler.Create(Mapping);
try
GetRQLParser.Execute(RQL, Result, lPostgreSQLCompiler);
finally
lPostgreSQLCompiler.Free;
end;
end;
function TMVCSQLGeneratorPostgreSQL.CreateUpdateSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string;
var
keyvalue: TPair<TRttiField, string>;
begin
Result := 'UPDATE ' + TableName.QuotedString('"') + ' SET ';
for keyvalue in Map do
begin
Result := Result + keyvalue.value + ' = :' + keyvalue.value + ',';
end;
Result[Length(Result)] := ' ';
if not PKFieldName.IsEmpty then
begin
Result := Result + ' where ' + PKFieldName + '= :' + PKFieldName;
end;
end;
function TMVCSQLGeneratorPostgreSQL.GetCompilerClass: TRQLCompilerClass;
begin
Result := TRQLPostgreSQLCompiler;
end;
function TMVCSQLGeneratorPostgreSQL.CreateDeleteSQL(const TableName: string; const Map: TDictionary<TRttiField, string>;
const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions; const PrimaryKeyValue: Int64): string;
begin
Result := 'DELETE FROM ' + TableName.QuotedString('"') + ' WHERE ' + PKFieldName + '= ' + IntToStr(PrimaryKeyValue);
end;
initialization
TMVCSQLGeneratorRegistry.Instance.RegisterSQLGenerator('postgresql', TMVCSQLGeneratorPostgreSQL);
finalization
TMVCSQLGeneratorRegistry.Instance.UnRegisterSQLGenerator('postgresql');
end.

2
sources/dmvcframeworkbuildconsts.inc
View File

@ -1,2 +1,2 @@
const
DMVCFRAMEWORK_VERSION = '3.1.0 (lithium)';
DMVCFRAMEWORK_VERSION = '3.1.1 (beryllium) RC1';