mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 08:28:09 +02:00
* Added business processor component
git-svn-id: trunk@41573 -
This commit is contained in:
michael
parent
92429997b5
commit
604e8f03f8
@ -22,7 +22,7 @@ uses
|
||||
Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
|
||||
|
||||
Type
|
||||
TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS);
|
||||
TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS,rdoAccessCheckNeedsDB);
|
||||
TRestDispatcherOptions = set of TRestDispatcherOption;
|
||||
|
||||
Const
|
||||
@ -227,6 +227,10 @@ Type
|
||||
function ExtractRestOperation(aRequest: TRequest;AccessControl : Boolean = false): TRestoperation; virtual;
|
||||
function FindRestResource(aResource: UTF8String): TSQLDBRestResource; virtual;
|
||||
function AllowRestResource(aIO : TRestIO): Boolean; virtual;
|
||||
function AllowRestOperation(aIO: TRestIO): Boolean; virtual;
|
||||
// Called twice: once before connection is established, once after.
|
||||
// checks rdoAccessCheckNeedsDB and availability of connection
|
||||
function CheckResourceAccess(IO: TRestIO): Boolean;
|
||||
function ExtractRestResourceName(IO: TRestIO): UTF8String; virtual;
|
||||
// Override if you want to create non-sqldb based resources
|
||||
function CreateSpecialResourceDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
|
||||
@ -634,10 +638,10 @@ begin
|
||||
Result:=IO.Request.QueryFields.Values[Strings.ResourceParam];
|
||||
end;
|
||||
|
||||
function TSQLDBRestDispatcher.AllowRestResource( aIO: TRestIO): Boolean;
|
||||
function TSQLDBRestDispatcher.AllowRestResource(aIO: TRestIO): Boolean;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
Result:=aIO.Resource.AllowResource(aIO.RestContext);
|
||||
if Assigned(FOnAllowResource) then
|
||||
FOnAllowResource(Self,aIO.Request,aIO.ResourceName,Result);
|
||||
end;
|
||||
@ -1188,6 +1192,8 @@ begin
|
||||
Try
|
||||
if not AuthenticateRequest(IO,True) then
|
||||
exit;
|
||||
if Not CheckResourceAccess(IO) then
|
||||
exit;
|
||||
DoHandleEvent(True,IO);
|
||||
H:=CreateDBHandler(IO);
|
||||
if IsSpecialResource(IO.Resource) then
|
||||
@ -1265,6 +1271,33 @@ begin
|
||||
Result:=TSQLDBRestSchemaList.Create(TSQLDBRestSchemaRef);
|
||||
end;
|
||||
|
||||
function TSQLDBRestDispatcher.AllowRestOperation(aIO: TRestIO): Boolean;
|
||||
|
||||
begin
|
||||
Result:=(aIO.Operation in aIO.Resource.GetAllowedOperations(aIO.RestContext));
|
||||
end;
|
||||
|
||||
Function TSQLDBRestDispatcher.CheckResourceAccess(IO : TRestIO) : Boolean;
|
||||
|
||||
Var
|
||||
NeedDB : Boolean;
|
||||
|
||||
begin
|
||||
NeedDB:=(rdoAccessCheckNeedsDB in DispatchOptions);
|
||||
Result:=NeedDB<>Assigned(IO.Connection);
|
||||
if Result then
|
||||
exit;
|
||||
Result:=AllowRestResource(IO);
|
||||
if not Result then
|
||||
CreateErrorContent(IO,403,'Forbidden')
|
||||
else
|
||||
begin
|
||||
Result:=AllowRestOperation(IO);
|
||||
if not Result then
|
||||
CreateErrorContent(IO,405,'Method not allowed')
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestDispatcher.DoHandleRequest(IO : TRestIO);
|
||||
|
||||
var
|
||||
@ -1290,8 +1323,6 @@ begin
|
||||
Resource:=FindRestResource(ResourceName);
|
||||
if Resource=Nil then
|
||||
CreateErrorContent(IO,404,'Invalid resource')
|
||||
else if Not (Operation in Resource.AllowedOperations) then
|
||||
CreateErrorContent(IO,405,'Method not allowed')
|
||||
else
|
||||
begin
|
||||
IO.SetResource(Resource);
|
||||
@ -1303,9 +1334,7 @@ begin
|
||||
else
|
||||
CreateErrorContent(IO,500,Format(SErrNoconnection,[GetConnectionName(IO)]));
|
||||
end
|
||||
else if not AllowRestResource(IO) then
|
||||
CreateErrorContent(IO,403,'Forbidden')
|
||||
else
|
||||
else if CheckResourceAccess(IO) then
|
||||
if Operation=roOptions then
|
||||
HandleCORSRequest(Connection,IO)
|
||||
else
|
||||
|
||||
@ -532,7 +532,7 @@ Var
|
||||
i : Integer;
|
||||
|
||||
begin
|
||||
Result:=IO.Resource.AllowRecord(D);
|
||||
Result:=IO.Resource.AllowRecord(IO.RestContext,D);
|
||||
if not Result then
|
||||
exit;
|
||||
O.StartRow;
|
||||
@ -598,7 +598,7 @@ begin
|
||||
if (Result=Nil) then
|
||||
begin
|
||||
GetLimitOffset(aLimit,aOffset);
|
||||
Result:=FResource.GetDataset(aFieldList,GetOrderByFieldArray,aLimit,aOffset);
|
||||
Result:=FResource.GetDataset(IO.RestContext,aFieldList,GetOrderByFieldArray,aLimit,aOffset);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -731,7 +731,7 @@ begin
|
||||
D.Free;
|
||||
end;
|
||||
// Give user a chance to look at it.
|
||||
FResource.CheckParams(roPost,aParams);
|
||||
FResource.CheckParams(io.RestContext,roPost,aParams);
|
||||
// Save so it can be used in GetWHereID for return
|
||||
FPostParams:=TParams.Create(TParam);
|
||||
FPostParams.Assign(aParams);
|
||||
@ -797,7 +797,7 @@ begin
|
||||
S.SQL.Text:=SQL;
|
||||
SetPostParams(S.Params,OldData.Fields);
|
||||
// Give user a chance to look at it.
|
||||
FResource.CheckParams(roPut,S.Params);
|
||||
FResource.CheckParams(io.RestContext,roPut,S.Params);
|
||||
S.Execute;
|
||||
S.Transaction.Commit;
|
||||
finally
|
||||
|
||||
@ -21,10 +21,8 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, fpjson, sqldb, db, httpdefs, sqldbrestschema;
|
||||
|
||||
Type
|
||||
TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader);
|
||||
TVariableSources = Set of TVariableSource;
|
||||
|
||||
Type
|
||||
TRestOutputOption = (ooMetadata,ooSparse,ooHumanReadable);
|
||||
TRestOutputOptions = Set of TRestOutputOption;
|
||||
|
||||
@ -37,6 +35,8 @@ Const
|
||||
|
||||
|
||||
Type
|
||||
TRestIO = Class;
|
||||
|
||||
TRestStringProperty = (rpDateFormat,
|
||||
rpDateTimeFormat,
|
||||
rpTimeFormat,
|
||||
@ -192,6 +192,17 @@ Type
|
||||
end;
|
||||
TRestOutputStreamerClass = class of TRestOutputStreamer;
|
||||
|
||||
{ TRestContext }
|
||||
|
||||
TRestContext = Class(TBaseRestContext)
|
||||
Private
|
||||
FIO : TRestIO;
|
||||
Protected
|
||||
property IO : TRestIO Read FIO;
|
||||
Public
|
||||
Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; override;
|
||||
end;
|
||||
|
||||
{ TRestIO }
|
||||
|
||||
TRestIO = Class
|
||||
@ -205,11 +216,13 @@ Type
|
||||
FResource: TSQLDBRestResource;
|
||||
FResourceName: UTF8String;
|
||||
FResponse: TResponse;
|
||||
FRestContext: TRestContext;
|
||||
FRestStrings: TRestStringsConfig;
|
||||
FSchema: UTF8String;
|
||||
FTrans: TSQLTransaction;
|
||||
FContentStream : TStream;
|
||||
FUserID: String;
|
||||
function GetUserID: String;
|
||||
procedure SetUserID(AValue: String);
|
||||
Protected
|
||||
Public
|
||||
Constructor Create(aRequest : TRequest; aResponse : TResponse); virtual;
|
||||
@ -229,6 +242,7 @@ Type
|
||||
function GetRequestOutputOptions(aDefault: TRestOutputOptions): TRestOutputOptions;
|
||||
function GetLimitOffset(aEnforceLimit: Int64; out aLimit, aOffset: Int64): boolean;
|
||||
// Create error response in output
|
||||
function CreateRestContext: TRestContext; virtual;
|
||||
Procedure CreateErrorResponse;
|
||||
Property Operation : TRestOperation Read FOperation;
|
||||
// Not owned by TRestIO
|
||||
@ -242,11 +256,12 @@ Type
|
||||
Property RESTInput : TRestInputStreamer read FInput;
|
||||
Property RESTOutput : TRestOutputStreamer read FOutput;
|
||||
Property RequestContentStream : TStream Read FContentStream;
|
||||
Property RestContext : TRestContext Read FRestContext;
|
||||
// For informative purposes
|
||||
Property ResourceName : UTF8String Read FResourceName;
|
||||
Property Schema : UTF8String Read FSchema;
|
||||
Property ConnectionName : UTF8String Read FCOnnection;
|
||||
Property UserID : String Read FUserID Write FUserID;
|
||||
Property UserID : String Read GetUserID Write SetUserID;
|
||||
end;
|
||||
TRestIOClass = Class of TRestIO;
|
||||
|
||||
@ -344,6 +359,13 @@ Const
|
||||
'datapacket' { rpXMLDocumentRoot}
|
||||
);
|
||||
|
||||
{ TRestContext }
|
||||
|
||||
function TRestContext.GetVariable(const aName: UTF8String; aSources : TVariableSources; out aValue: UTF8String): Boolean;
|
||||
begin
|
||||
Result:=FIO.GetVariable(aName,aValue,aSources)<>vsNone;
|
||||
end;
|
||||
|
||||
{ TStreamerDefList }
|
||||
|
||||
function TStreamerDefList.GetD(aIndex : integer): TStreamerDef;
|
||||
@ -713,15 +735,29 @@ begin
|
||||
GetVariable(aName,aVal);
|
||||
end;
|
||||
|
||||
procedure TRestIO.SetUserID(AValue: String);
|
||||
begin
|
||||
if (UserID=AValue) then Exit;
|
||||
FRestContext.UserID:=AValue;
|
||||
end;
|
||||
|
||||
function TRestIO.GetUserID: String;
|
||||
begin
|
||||
Result:=FRestContext.UserID;
|
||||
end;
|
||||
|
||||
constructor TRestIO.Create(aRequest: TRequest; aResponse: TResponse);
|
||||
begin
|
||||
FRequest:=aRequest;
|
||||
FResponse:=aResponse;
|
||||
FContentStream:=TStringStream.Create(aRequest.Content);
|
||||
FRestContext:=CreateRestContext;
|
||||
FRestContext.FIO:=Self;
|
||||
end;
|
||||
|
||||
destructor TRestIO.Destroy;
|
||||
begin
|
||||
FreeAndNil(FRestContext);
|
||||
if Assigned(FInput) then
|
||||
Finput.FOnGetVar:=Nil;
|
||||
if Assigned(Foutput) then
|
||||
@ -732,6 +768,12 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TRestIO.CreateRestContext : TRestContext;
|
||||
|
||||
begin
|
||||
Result:=TRestContext.Create;
|
||||
end;
|
||||
|
||||
function TRestIO.GetVariable(const aName: UTF8String; out aVal: UTF8String;
|
||||
AllowedSources: TVAriableSources): TVariableSource;
|
||||
|
||||
@ -780,7 +822,8 @@ begin
|
||||
Result:=GetVariable(aName+FRestStrings.GetRestString(FilterStrings[aFilter]),aValue,[vsQuery]);
|
||||
end;
|
||||
|
||||
Class function TRestIO.StrToNullBoolean(S: String; Strict: Boolean): TNullBoolean;
|
||||
class function TRestIO.StrToNullBoolean(S: String; Strict: Boolean
|
||||
): TNullBoolean;
|
||||
|
||||
begin
|
||||
result:=nbNone;
|
||||
@ -810,7 +853,8 @@ begin
|
||||
Result:=StrToNullBoolean(S,aStrict);
|
||||
end;
|
||||
|
||||
Function TRestIO.GetRequestOutputOptions(aDefault : TRestOutputOptions) : TRestOutputOptions;
|
||||
function TRestIO.GetRequestOutputOptions(aDefault: TRestOutputOptions
|
||||
): TRestOutputOptions;
|
||||
|
||||
Procedure CheckParam(aName : String; aOption: TRestOutputOption);
|
||||
begin
|
||||
|
||||
@ -22,7 +22,6 @@ uses
|
||||
Classes, SysUtils, db, sqldb, fpjson;
|
||||
|
||||
Type
|
||||
|
||||
TRestFieldType = (rftUnknown,rftInteger,rftLargeInt,rftFloat,rftDate,rftTime,rftDateTime,rftString,rftBoolean,rftBlob);
|
||||
TRestFieldTypes = set of TRestFieldType;
|
||||
|
||||
@ -41,6 +40,8 @@ Type
|
||||
TFieldListKind = (flSelect,flInsert,flInsertParams,flUpdate,flWhereKey,flFilter,flOrderby);
|
||||
TFieldListKinds = set of TFieldListKind;
|
||||
|
||||
TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader);
|
||||
TVariableSources = Set of TVariableSource;
|
||||
|
||||
Const
|
||||
AllRestOperations = [Succ(Low(TRestOperation))..High(TRestOperation)];
|
||||
@ -51,6 +52,22 @@ Const
|
||||
|
||||
Type
|
||||
|
||||
{ TBaseRestContext }
|
||||
|
||||
TBaseRestContext = Class(TObject)
|
||||
private
|
||||
FData: TObject;
|
||||
FUserID: UTF8String;
|
||||
Public
|
||||
// Call this to get a HTTP Query variable, header,...
|
||||
Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; virtual; abstract;
|
||||
// This will be set when calling.
|
||||
Property UserID : UTF8String Read FUserID Write FUserID;
|
||||
// You can attach data to this if you want to. It will be kept for the duration of the request.
|
||||
// You are responsible for freeing this data, though.
|
||||
Property Data : TObject Read FData Write FData;
|
||||
end;
|
||||
|
||||
{ ESQLDBRest }
|
||||
|
||||
ESQLDBRest = Class(Exception)
|
||||
@ -68,7 +85,8 @@ Type
|
||||
end;
|
||||
|
||||
TSQLDBRestSchema = Class;
|
||||
|
||||
TSQLDBRestCustomBusinessProcessor = Class;
|
||||
TSQLDBRestBusinessProcessor = Class;
|
||||
|
||||
{ TSQLDBRestField }
|
||||
|
||||
@ -131,21 +149,26 @@ Type
|
||||
TSQLDBRestFieldListClass = Class of TSQLDBRestFieldList;
|
||||
|
||||
{ TSQLDBRestResource }
|
||||
TSQLDBRestGetDatasetEvent = Procedure (aSender : TObject; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64; Var aDataset : TDataset) of object;
|
||||
TSQLDBRestCheckParamsEvent = Procedure (aSender : TObject; aOperation : TRestOperation; Params : TParams) of object;
|
||||
TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aDataSet : TDataset; var allowRecord : Boolean) of object;
|
||||
TSQLDBRestGetDatasetEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64; Var aDataset : TDataset) of object;
|
||||
TSQLDBRestCheckParamsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aOperation : TRestOperation; Params : TParams) of object;
|
||||
TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aDataSet : TDataset; var allowRecord : Boolean) of object;
|
||||
TSQLDBRestAllowResourceEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var allowResource : Boolean) of object;
|
||||
TSQLDBRestAllowedOperationsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var aOperations : TRestOperations) of object;
|
||||
TProcessIdentifier = Function (const S: UTF8String): UTF8String of object;
|
||||
|
||||
TSQLDBRestResource = class(TCollectionItem)
|
||||
private
|
||||
FBusinessProcessor: TSQLDBRestCustomBusinessProcessor;
|
||||
FAllowedOperations: TRestOperations;
|
||||
FConnectionName: UTF8String;
|
||||
FEnabled: Boolean;
|
||||
FFields: TSQLDBRestFieldList;
|
||||
FInMetadata: Boolean;
|
||||
FOnAllowedOperations: TSQLDBRestAllowedOperationsEvent;
|
||||
FOnAllowRecord: TSQLDBRestAllowRecordEvent;
|
||||
FOnCheckParams: TSQLDBRestCheckParamsEvent;
|
||||
FOnGetDataset: TSQLDBRestGetDatasetEvent;
|
||||
FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
|
||||
FResourceName: UTF8String;
|
||||
FTableName: UTF8String;
|
||||
FSQL : Array[TSQLKind] of TStrings;
|
||||
@ -165,18 +188,21 @@ Type
|
||||
Public
|
||||
Constructor Create(ACollection: TCollection); override;
|
||||
Destructor Destroy; override;
|
||||
Procedure CheckParams(aOperation : TRestoperation; P : TParams);
|
||||
Function GetDataset(aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset;
|
||||
Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams);
|
||||
Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset;
|
||||
Function GetSchema : TSQLDBRestSchema;
|
||||
function GenerateDefaultSQL(aKind: TSQLKind): UTF8String; virtual;
|
||||
Procedure Assign(Source: TPersistent); override;
|
||||
Function AllowRecord(aDataset : TDataset) : Boolean;
|
||||
Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean;
|
||||
Function AllowResource(aContext : TBaseRestContext) : Boolean;
|
||||
Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations;
|
||||
Function GetHTTPAllow : String; virtual;
|
||||
function GetFieldList(aListKind: TFieldListKind): UTF8String;
|
||||
function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
|
||||
Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
|
||||
Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
|
||||
Property SQL [aKind : TSQLKind] : TStrings Read GetSQLTyped;
|
||||
Property BusinessProcessor : TSQLDBRestCustomBusinessProcessor Read FBusinessProcessor;
|
||||
Published
|
||||
Property Fields : TSQLDBRestFieldList Read FFields Write SetFields;
|
||||
Property Enabled : Boolean Read FEnabled Write FEnabled default true;
|
||||
@ -189,6 +215,8 @@ Type
|
||||
Property SQLInsert : TStrings Index 1 Read GetSQL Write SetSQL;
|
||||
Property SQLUpdate : TStrings Index 2 Read GetSQL Write SetSQL;
|
||||
Property SQLDelete : TStrings Index 3 Read GetSQL Write SetSQL;
|
||||
Property OnResourceAllowed : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed;
|
||||
Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations;
|
||||
Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset;
|
||||
Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams;
|
||||
Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
|
||||
@ -222,14 +250,21 @@ Type
|
||||
private
|
||||
FConnectionName: UTF8String;
|
||||
FResources: TSQLDBRestResourceList;
|
||||
FProcessors : TFPList;
|
||||
procedure SetResources(AValue: TSQLDBRestResourceList);
|
||||
Protected
|
||||
function CreateResourceList: TSQLDBRestResourceList; virtual;
|
||||
function GetPrimaryIndexFields(Q: TSQLQuery): TStringArray; virtual;
|
||||
function ProcessIdentifier(const S: UTF8String): UTF8String; virtual;
|
||||
Function AttachProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor) : Boolean; Virtual;
|
||||
Function DetachProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor) : Boolean; Virtual;
|
||||
Procedure AttachAllProcessors; virtual;
|
||||
Procedure DetachAllProcessors; virtual;
|
||||
Public
|
||||
Constructor Create(AOwner: TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
Procedure RemoveBusinessProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor);
|
||||
Procedure AddBusinessProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor);
|
||||
Procedure SaveToFile(Const aFileName : UTF8String);
|
||||
Procedure SaveToStream(Const aStream : TStream);
|
||||
function AsJSON(const aPropName: UTF8String=''): TJSONData;
|
||||
@ -247,6 +282,54 @@ Type
|
||||
TCustomViewResource = Class(TSQLDBRestResource)
|
||||
end;
|
||||
|
||||
{ TSQLDBRestCustomBusinessProcessor }
|
||||
|
||||
TSQLDBRestCustomBusinessProcessor = Class(TComponent)
|
||||
private
|
||||
FResource: TSQLDBRestResource;
|
||||
FResourceName: UTF8String;
|
||||
procedure SetResourceName(AValue: UTF8String);
|
||||
Protected
|
||||
Function GetSchema : TSQLDBRestSchema; virtual;
|
||||
Function GetAllowedOperations(aContext : TBaseRestContext; aDefault : TRestOperations) : TRestOperations; virtual; abstract;
|
||||
Function AllowResource(aContext : TBaseRestContext) : Boolean; virtual; abstract;
|
||||
Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); virtual; abstract;
|
||||
Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; virtual;abstract;
|
||||
Function AllowRecord(aContext : TBaseRestContext;aDataset : TDataset) : Boolean; virtual; abstract;
|
||||
Public
|
||||
Property Resource : TSQLDBRestResource Read FResource;
|
||||
Property ResourceName : UTF8String Read FResourceName Write SetResourceName;
|
||||
end;
|
||||
|
||||
{ TSQLDBRestBusinessProcessor }
|
||||
TOnGetHTTPAllow = Procedure(Sender : TObject; Var aHTTPAllow) of object;
|
||||
|
||||
TSQLDBRestBusinessProcessor = class(TSQLDBRestCustomBusinessProcessor)
|
||||
private
|
||||
FOnAllowedOperations: TSQLDBRestAllowedOperationsEvent;
|
||||
FOnAllowRecord: TSQLDBRestAllowRecordEvent;
|
||||
FOnCheckParams: TSQLDBRestCheckParamsEvent;
|
||||
FOnGetDataset: TSQLDBRestGetDatasetEvent;
|
||||
FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
|
||||
FSchema: TSQLDBRestSchema;
|
||||
procedure SetSchema(AValue: TSQLDBRestSchema);
|
||||
Protected
|
||||
Function GetSchema : TSQLDBRestSchema; override;
|
||||
Function AllowResource(aContext : TBaseRestContext) : Boolean; override;
|
||||
Function GetAllowedOperations(aContext : TBaseRestContext; aDefault : TRestOperations) : TRestOperations; override;
|
||||
Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); override;
|
||||
Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; override;
|
||||
Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean; override;
|
||||
Published
|
||||
Property Schema : TSQLDBRestSchema Read GetSchema Write SetSchema;
|
||||
Property ResourceName;
|
||||
Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset;
|
||||
Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams;
|
||||
Property OnAllowResource : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed;
|
||||
Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations;
|
||||
Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
|
||||
end;
|
||||
|
||||
Const
|
||||
TypeNames : Array[TRestFieldType] of string = ('?','int','bigint','float','date','time','datetime','string','bool','blob');
|
||||
|
||||
@ -254,6 +337,95 @@ implementation
|
||||
|
||||
uses strutils, fpjsonrtti,dbconst, sqldbrestconst;
|
||||
|
||||
{ TSQLDBRestCustomBusinessProcessor }
|
||||
|
||||
procedure TSQLDBRestCustomBusinessProcessor.SetResourceName(AValue: UTF8String);
|
||||
|
||||
Var
|
||||
S : TSQLDBRestSchema;
|
||||
|
||||
begin
|
||||
if FResourceName=AValue then Exit;
|
||||
// Reregister, so the attachment happens to the correct resource
|
||||
S:=GetSchema;
|
||||
If (FResourceName<>'') and Assigned(S) then
|
||||
S.RemoveBusinessProcessor(Self);
|
||||
FResourceName:=AValue;
|
||||
S:=GetSchema;
|
||||
If (FResourceName<>'') and Assigned(S) then
|
||||
S.AddBusinessProcessor(Self);
|
||||
end;
|
||||
|
||||
function TSQLDBRestCustomBusinessProcessor.GetSchema: TSQLDBRestSchema;
|
||||
|
||||
begin
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
{ TSQLDBRestBusinessProcessor }
|
||||
|
||||
procedure TSQLDBRestBusinessProcessor.SetSchema(AValue: TSQLDBRestSchema);
|
||||
begin
|
||||
if FSchema=AValue then Exit;
|
||||
if Assigned(FSchema) and (ResourceName<>'') then
|
||||
begin
|
||||
FSchema.RemoveBusinessProcessor(Self);
|
||||
FSchema.RemoveFreeNotification(Self);
|
||||
end;
|
||||
FSchema:=AValue;
|
||||
if Assigned(FSchema) and (ResourceName<>'') then
|
||||
begin
|
||||
FSchema.AddBusinessProcessor(Self);
|
||||
FSchema.FreeNotification(Self);
|
||||
end
|
||||
end;
|
||||
|
||||
function TSQLDBRestBusinessProcessor.GetSchema: TSQLDBRestSchema;
|
||||
begin
|
||||
Result:=FSchema;
|
||||
end;
|
||||
|
||||
function TSQLDBRestBusinessProcessor.AllowResource(aContext: TBaseRestContext
|
||||
): Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
if Assigned(FOnResourceAllowed) then
|
||||
FOnResourceAllowed(Self,aContext,Result);
|
||||
|
||||
end;
|
||||
|
||||
function TSQLDBRestBusinessProcessor.GetAllowedOperations(
|
||||
aContext: TBaseRestContext; aDefault: TRestOperations): TRestOperations;
|
||||
begin
|
||||
Result:=aDefault;
|
||||
if Assigned(FOnAllowedOperations) then
|
||||
FOnAllowedOperations(Self,aContext,Result);
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestBusinessProcessor.CheckParams(aContext: TBaseRestContext;
|
||||
aOperation: TRestoperation; P: TParams);
|
||||
begin
|
||||
if Assigned(FOnCheckParams) then
|
||||
FOnCheckParams(Self,aContext,aOperation,P);
|
||||
end;
|
||||
|
||||
function TSQLDBRestBusinessProcessor.GetDataset(aContext : TBaseRestContext;
|
||||
aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit,
|
||||
aOffset: Int64): TDataset;
|
||||
begin
|
||||
Result:=nil;
|
||||
if Assigned(FOnGetDataset) then
|
||||
FOnGetDataset(Self,aContext,aFieldList,aOrderBy,aLimit,aOffset,Result);
|
||||
end;
|
||||
|
||||
function TSQLDBRestBusinessProcessor.AllowRecord(aContext : TBaseRestContext; aDataset: TDataset): Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
if Assigned(FOnAllowRecord) then
|
||||
FOnAllowRecord(Self,acontext,aDataset,Result);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{ ESQLDBRest }
|
||||
|
||||
@ -285,9 +457,10 @@ constructor TSQLDBRestSchema.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FResources:=CreateResourceList;
|
||||
FProcessors:=TFPList.Create;
|
||||
end;
|
||||
|
||||
Function TSQLDBRestSchema.CreateResourceList : TSQLDBRestResourceList;
|
||||
function TSQLDBRestSchema.CreateResourceList: TSQLDBRestResourceList;
|
||||
|
||||
begin
|
||||
Result:=TSQLDBRestResourceList.Create(Self,TSQLDBRestResource);
|
||||
@ -295,10 +468,26 @@ end;
|
||||
|
||||
destructor TSQLDBRestSchema.Destroy;
|
||||
begin
|
||||
FreeAndNil(FProcessors);
|
||||
FreeAndNil(FResources);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestSchema.RemoveBusinessProcessor(
|
||||
aProcessor: TSQLDBRestCustomBusinessProcessor);
|
||||
|
||||
begin
|
||||
DetachProcessor(aProcessor);
|
||||
FProcessors.Remove(aProcessor);
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestSchema.AddBusinessProcessor(
|
||||
aProcessor: TSQLDBRestCustomBusinessProcessor);
|
||||
begin
|
||||
FProcessors.Remove(aProcessor);
|
||||
AttachProcessor(aProcessor);
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestSchema.SaveToFile(const aFileName: UTF8String);
|
||||
Var
|
||||
F : TFileStream;
|
||||
@ -371,16 +560,69 @@ begin
|
||||
J:=aData as TJSONObject;
|
||||
Resources.FromJSON(J,JSONResourcesRoot);
|
||||
ConnectionName:=J.Get(aPropName,'');
|
||||
AttachAllProcessors;
|
||||
end;
|
||||
|
||||
Function TSQLDBRestSchema.ProcessIdentifier(Const S : UTF8String) : UTF8String;
|
||||
function TSQLDBRestSchema.ProcessIdentifier(const S: UTF8String): UTF8String;
|
||||
|
||||
begin
|
||||
Result:=S;
|
||||
end;
|
||||
|
||||
function TSQLDBRestSchema.AttachProcessor(aProcessor: TSQLDBRestCustomBusinessProcessor): Boolean;
|
||||
|
||||
Function TSQLDBRestSchema.GetPrimaryIndexFields(Q : TSQLQuery) : TStringArray;
|
||||
Var
|
||||
Res : TSQLDBRestResource;
|
||||
|
||||
begin
|
||||
if aProcessor.ResourceName='' then
|
||||
exit;
|
||||
Res:=FResources.FindResourceByName(aProcessor.ResourceName);
|
||||
Result:=Assigned(Res);
|
||||
if Result then
|
||||
begin
|
||||
Res.FBusinessProcessor:=aProcessor;
|
||||
aProcessor.FResource:=Res;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSQLDBRestSchema.DetachProcessor(aProcessor: TSQLDBRestCustomBusinessProcessor): Boolean;
|
||||
Var
|
||||
Res : TSQLDBRestResource;
|
||||
|
||||
begin
|
||||
if aProcessor.ResourceName='' then
|
||||
exit;
|
||||
Res:=FResources.FindResourceByName(aProcessor.ResourceName);
|
||||
Result:=Assigned(Res);
|
||||
if Result then
|
||||
begin
|
||||
Res.FBusinessProcessor:=Nil;
|
||||
aProcessor.FResource:=Nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestSchema.AttachAllProcessors;
|
||||
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FProcessors.Count-1 do
|
||||
AttachProcessor(TSQLDBRestCustomBusinessProcessor(FProcessors[i]));
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestSchema.DetachAllProcessors;
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
For I:=0 to FProcessors.Count-1 do
|
||||
DetachProcessor(TSQLDBRestCustomBusinessProcessor(FProcessors[i]));
|
||||
end;
|
||||
|
||||
|
||||
function TSQLDBRestSchema.GetPrimaryIndexFields(Q: TSQLQuery): TStringArray;
|
||||
|
||||
Var
|
||||
C,I : Integer;
|
||||
@ -434,7 +676,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection; aTables : Array of string; aMinFieldOpts : TRestFieldOptions = []);
|
||||
procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection;
|
||||
aTables: array of string; aMinFieldOpts: TRestFieldOptions);
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
@ -676,6 +919,7 @@ begin
|
||||
Result:=FSQL[aKind];
|
||||
end;
|
||||
|
||||
|
||||
procedure TSQLDBRestResource.SetFields(AValue: TSQLDBRestFieldList);
|
||||
begin
|
||||
if FFields=AValue then Exit;
|
||||
@ -713,23 +957,29 @@ Var
|
||||
K : TSQLKind;
|
||||
|
||||
begin
|
||||
If Assigned(FBusinessProcessor) then
|
||||
FBusinessProcessor.FResource:=Nil;
|
||||
FreeAndNil(FFields);
|
||||
for K in TSQLKind do
|
||||
FreeAndNil(FSQL[K]);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSQLDBRestResource.CheckParams(aOperation: TRestoperation; P: TParams);
|
||||
procedure TSQLDBRestResource.CheckParams(aContext : TBaseRestContext; aOperation: TRestoperation; P: TParams);
|
||||
begin
|
||||
if Assigned(FOnCheckParams) then
|
||||
FOnCheckParams(Self,aOperation,P);
|
||||
FOnCheckParams(Self,aContext,aOperation,P)
|
||||
else if Assigned(FBusinessProcessor) then
|
||||
FBusinessProcessor.CheckParams(aContext,aOperation,P)
|
||||
end;
|
||||
|
||||
function TSQLDBRestResource.GetDataset(aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, aOffset: Int64): TDataset;
|
||||
function TSQLDBRestResource.GetDataset(aContext : TBaseRestContext; aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, aOffset: Int64): TDataset;
|
||||
begin
|
||||
Result:=Nil;
|
||||
If Assigned(FOnGetDataset) then
|
||||
FOnGetDataset(Self,aFieldList,aOrderBy,aLimit,aOffset,Result);
|
||||
FOnGetDataset(Self,aContext,aFieldList,aOrderBy,aLimit,aOffset,Result)
|
||||
else if Assigned(FBusinessProcessor) then
|
||||
Result:=FBusinessProcessor.GetDataset(aContext,aFieldList,aOrderBy,aLimit,aOffset);
|
||||
end;
|
||||
|
||||
function TSQLDBRestResource.GetSchema: TSQLDBRestSchema;
|
||||
@ -763,11 +1013,32 @@ begin
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
function TSQLDBRestResource.AllowRecord(aDataset: TDataset): Boolean;
|
||||
function TSQLDBRestResource.AllowRecord(aContext : TBaseRestContext; aDataset: TDataset): Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
if Assigned(FOnAllowRecord) then
|
||||
FOnAllowRecord(Self,aDataset,Result);
|
||||
FOnAllowRecord(Self,aContext,aDataset,Result)
|
||||
else if Assigned(FBusinessProcessor) then
|
||||
Result:=FBusinessProcessor.AllowRecord(aContext,aDataset);
|
||||
end;
|
||||
|
||||
function TSQLDBRestResource.AllowResource(aContext : TBaseRestContext): Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
If Assigned(FOnResourceAllowed) then
|
||||
FOnResourceAllowed(Self,aContext,Result)
|
||||
else If Assigned(FBusinessProcessor) then
|
||||
Result:=FBusinessProcessor.AllowResource(aContext);
|
||||
end;
|
||||
|
||||
function TSQLDBRestResource.GetAllowedOperations(aContext: TBaseRestContext
|
||||
): TRestOperations;
|
||||
begin
|
||||
Result:=AllowedOperations;
|
||||
if Assigned(FOnAllowedOperations) then
|
||||
FOnAllowedOperations(Self,aContext,Result)
|
||||
else if Assigned(FBusinessProcessor) then
|
||||
Result:=FBusinessProcessor.GetAllowedOperations(aContext,Result);
|
||||
end;
|
||||
|
||||
function TSQLDBRestResource.GetHTTPAllow: String;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user