- messages and subscription expiring

- refactoring
- fixing border-case bugs
This commit is contained in:
Daniele Teti 2021-10-20 11:12:57 +02:00
parent cda0651182
commit 18ae4a86f9
5 changed files with 48 additions and 21 deletions

View File

@ -439,7 +439,8 @@ type
['{7B87473C-1784-489F-A838-925E7DDD0DE2}']
procedure AddConnection(const aName: string; const aConnection: TFDConnection;
const Owns: Boolean = false);
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false);
procedure AddDefaultConnection(const aConnection: TFDConnection; const Owns: Boolean = false); overload;
procedure AddDefaultConnection(const aConnectionDefName: String); overload;
procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
procedure SetCurrent(const aName: string);
@ -467,7 +468,8 @@ type
destructor Destroy; override;
procedure AddConnection(const aName: string; const aConnection: TFDConnection;
const aOwns: Boolean = false);
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false);
procedure AddDefaultConnection(const aConnection: TFDConnection; const aOwns: Boolean = false); overload;
procedure AddDefaultConnection(const aConnectionDefName: String); overload;
procedure RemoveConnection(const aName: string; const RaiseExceptionIfNotAvailable: Boolean = True);
procedure RemoveDefaultConnection(const RaiseExceptionIfNotAvailable: Boolean = True);
procedure SetCurrent(const aName: string);
@ -716,6 +718,24 @@ begin
AddConnection('default', aConnection, aOwns);
end;
procedure TMVCConnectionsRepository.AddDefaultConnection(
const aConnectionDefName: String);
var
lConn: TFDConnection;
begin
lConn := TFDConnection.Create(nil);
try
lConn.ConnectionDefName := aConnectionDefName;
AddDefaultConnection(lConn, True);
except
on E: Exception do
begin
lConn.Free;
raise;
end;
end;
end;
constructor TMVCConnectionsRepository.Create;
begin
inherited;

View File

@ -139,7 +139,7 @@ begin
// create gzip compliant streams
{.$ELSE}
lZStream := TZCompressionStream.Create(lMemStream,
TZCompressionLevel.zcDefault, MVC_COMPRESSION_ZLIB_WINDOW_BITS
TZCompressionLevel.zcMax, MVC_COMPRESSION_ZLIB_WINDOW_BITS
[lRespCompressionType]);
try
lContentStream.Position := 0;

View File

@ -40,7 +40,7 @@ uses
MVCFramework.Serializer.Intf,
MVCFramework.Commons,
MVCFramework.Serializer.Commons,
Data.DB;
Data.DB, JsonDataObjects;
type
IMVCRESTResponse = interface;
@ -459,6 +459,8 @@ type
function ContentRawBytes: TBytes;
procedure SaveContentToStream(aStream: TStream);
procedure SaveContentToFile(const aFileName: string);
function ToJSONObject: TJDOJsonObject;
function ToJSONArray: TJDOJsonArray;
end;
implementation

View File

@ -46,7 +46,7 @@ uses
MVCFramework.RESTClient.Commons,
MVCFramework.Serializer.Intf,
MVCFramework.Serializer.Commons,
Data.DB;
Data.DB, JsonDataObjects;
type
/// <summary>
@ -506,6 +506,8 @@ type
function ContentRawBytes: TBytes;
procedure SaveContentToStream(aStream: TStream);
procedure SaveContentToFile(const aFileName: string);
function ToJSONObject: TJDOJsonObject;
function ToJSONArray: TJDOJsonArray;
end;
implementation
@ -1761,6 +1763,16 @@ end;
{ TMVCRESTResponse }
function TMVCRESTResponse.ToJSONArray: TJDOJsonArray;
begin
Result := StrTOJSONArray(fContent, True);
end;
function TMVCRESTResponse.ToJSONObject: TJDOJsonObject;
begin
Result := StrTOJSONObject(fContent, True);
end;
function TMVCRESTResponse.Content: string;
begin
Result := fContent;

View File

@ -1085,18 +1085,18 @@ uses
MVCFramework.Serializer.HTML, MVCFramework.Serializer.Abstract;
var
_IsShuttingDown: Int64 = 0;
_MVCGlobalActionParamsCache: TMVCStringObjectDictionary<TMVCActionParamCacheItem> = nil;
_HostingFramework: TMVCHostingFrameworkType = hftUnknown;
gIsShuttingDown: Int64 = 0;
gMVCGlobalActionParamsCache: TMVCStringObjectDictionary<TMVCActionParamCacheItem> = nil;
gHostingFramework: TMVCHostingFrameworkType = hftUnknown;
function IsShuttingDown: Boolean;
begin
Result := TInterlocked.Read(_IsShuttingDown) = 1
Result := TInterlocked.Read(gIsShuttingDown) = 1
end;
procedure EnterInShutdownState;
begin
TInterlocked.Add(_IsShuttingDown, 1);
TInterlocked.Add(gIsShuttingDown, 1);
end;
function CreateResponse(const StatusCode: UInt16; const ReasonString: string;
@ -2333,7 +2333,7 @@ begin
try
DefineDefaultResponseHeaders(lContext);
lHandled := False;
lRouter := TMVCRouter.Create(FConfig, _MVCGlobalActionParamsCache);
lRouter := TMVCRouter.Create(FConfig, gMVCGlobalActionParamsCache);
try // finally
lSelectedController := nil;
try // only for lSelectedController
@ -4087,21 +4087,14 @@ begin
FFormat := AFormat;
end;
{ TMVCHackHTTPAppRequest }
// function TMVCHackHTTPAppRequest.GetHeaders: TStringList;
// begin
// Result := FRequestInfo.RawHeaders;
// end;
initialization
_IsShuttingDown := 0;
gIsShuttingDown := 0;
_MVCGlobalActionParamsCache := TMVCStringObjectDictionary<TMVCActionParamCacheItem>.Create;
gMVCGlobalActionParamsCache := TMVCStringObjectDictionary<TMVCActionParamCacheItem>.Create;
finalization
FreeAndNil(_MVCGlobalActionParamsCache);
FreeAndNil(gMVCGlobalActionParamsCache);
end.