+ added more unit tests

+ topic property is now correctly rendered in the message json when read
+ updated dmvcframework
+ added (an hugly) icon
This commit is contained in:
Daniele Teti 2021-10-07 10:10:25 +02:00
parent 8d44ac5e05
commit cda0651182
3 changed files with 83 additions and 46 deletions

View File

@ -2748,39 +2748,42 @@ var
begin
lUnitOfWork := TMVCUnitOfWork<T>.Create;
lUnitOfWork.RegisterDelete(CurrentList);
lPKType := NewList[i].GetPrimaryKeyFieldType;
for i := 0 to NewList.Count - 1 do
if NewList.Count > 0 then
begin
if NewList[i].PKIsNull then
lPKType := NewList[0].GetPrimaryKeyFieldType;
for i := 0 to NewList.Count - 1 do
begin
lUnitOfWork.RegisterInsert(NewList[i]);
continue;
end;
if NewList[i].PKIsNull then
begin
lUnitOfWork.RegisterInsert(NewList[i]);
continue;
end;
case lPKType of
ftString:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsString(CurrentList,
NewList[i].GetPK.AsString, lFoundAtIndex);
end;
ftInteger:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt(CurrentList,
NewList[i].GetPK.AsInteger, lFoundAtIndex);
end;
ftLargeInt:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt64(CurrentList,
NewList[i].GetPK.AsInt64, lFoundAtIndex);
end;
else
raise EMVCActiveRecord.Create('Invalid primary key type');
end;
case lPKType of
ftString:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsString(CurrentList,
NewList[i].GetPK.AsString, lFoundAtIndex);
end;
ftInteger:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt(CurrentList,
NewList[i].GetPK.AsInteger, lFoundAtIndex);
end;
ftLargeInt:
begin
lNeedsToBeUpdated := TMVCUnitOfWork<T>.KeyExistsInt64(CurrentList,
NewList[i].GetPK.AsInt64, lFoundAtIndex);
end;
else
raise EMVCActiveRecord.Create('Invalid primary key type');
end;
if lNeedsToBeUpdated then
lUnitOfWork.RegisterUpdate(NewList[i])
else
lUnitOfWork.RegisterInsert(NewList[i]);
if lNeedsToBeUpdated then
lUnitOfWork.RegisterUpdate(NewList[i])
else
lUnitOfWork.RegisterInsert(NewList[i]);
end;
end;
Result := lUnitOfWork as IMVCMultiExecutor<T>;
end;
@ -3148,7 +3151,7 @@ end;
procedure TMVCUnitOfWork<T>.Apply(const ItemApplyAction: TMVCItemApplyAction<T>);
var
i: UInt32;
i: Integer;
lHandled: Boolean;
begin
for i := 0 to fListToInsert.Count - 1 do
@ -3166,7 +3169,7 @@ begin
DoItemApplyAction(fListToUpdate[i], eaUpdate, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToUpdate[i].Update;
fListToUpdate[i].Update(True);
end;
end;
for i := 0 to fListToDelete.Count - 1 do
@ -3175,7 +3178,7 @@ begin
DoItemApplyAction(fListToDelete[i], eaDelete, ItemApplyAction, lHandled);
if not lHandled then
begin
fListToDelete[i].Delete;
fListToDelete[i].Delete(True);
end;
end;
end;
@ -3246,7 +3249,7 @@ begin
Result := false;
for i := 0 to NewList.Count - 1 do
begin
if NewList[i].GetPK.AsInt64 = KeyValue then
if (not NewList[i].PKIsNull) and (NewList[i].GetPK.AsInt64 = KeyValue) then
begin
Index := i;
Exit(True);

View File

@ -80,9 +80,9 @@ var
lItem: string;
lRespCompressionType: TMVCCompressionType;
lTmpItem: string;
{$IF not Defined(ALEXANDRIAORBETTER)}
{.$IF not Defined(ALEXANDRIAORBETTER)}
lZStream: TZCompressionStream;
{$ENDIF}
{.$ENDIF}
begin
if IsLibrary then
begin
@ -107,16 +107,16 @@ begin
lTmpItem := lItem.Trim;
if lTmpItem = 'gzip' then
begin
{$IF Defined(ALEXANDRIAORBETTER)}
{.$IF Defined(ALEXANDRIAORBETTER)}
{
There is a bug in 11 Alexandria with TZCompressionStream, so the gzip compression
is not available until the fix.
The issue has been created on https://quality.embarcadero.com/browse/RSP-35516
}
{$ELSE}
{.$ELSE}
lRespCompressionType := TMVCCompressionType.ctGZIP;
break;
{$ENDIF}
{.$ENDIF}
end
else if lTmpItem = 'deflate' then
begin
@ -133,21 +133,31 @@ begin
// begin
lMemStream := TMemoryStream.Create;
try
{$IF Defined(ALEXANDRIAORBETTER)}
ZCompressStream(lContentStream, lMemStream);
{.$IF Defined(ALEXANDRIAORBETTER)}
//ZCompressStream(lContentStream, lMemStream);
// use it only for deflate, ZCompressStream (Delphi 11.0) cannot
// create gzip compliant streams
{$ELSE}
{.$ELSE}
lZStream := TZCompressionStream.Create(lMemStream,
TZCompressionLevel.zcDefault, MVC_COMPRESSION_ZLIB_WINDOW_BITS
[lRespCompressionType]);
try
lContentStream.Position := 0;
lZStream.CopyFrom(lContentStream, 0)
// WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING!
// WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING!
// WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING!
// There is a bug in 11 Alexandria with TZCompressionStream, this bug
// raises an exception here and the debugger catches it, but it its "normal" behavior.
// The gzip stream is correctly created. Please, vote for its resolution.
// https://quality.embarcadero.com/browse/RSP-35516
// WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING!
// WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING!
// WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING!
lZStream.CopyFrom(lContentStream, 0);
finally
lZStream.Free;
end;
{$ENDIF}
{.$ENDIF}
except
lMemStream.Free;
raise;

View File

@ -319,6 +319,8 @@ type
public
constructor Create(const AParamName: string); overload;
constructor Create(const AParamName: string; const DefaultAsString: string); overload;
constructor Create(const AParamName: string; const DefaultAsInteger: Int64); overload;
constructor Create(const AParamName: string; const DefaultAsBoolean: Boolean); overload;
property ParamName: string read FParamName;
property DefaultValueAsString: string read FDefaultValueAsString;
property CanBeUsedADefaultValue: Boolean read FCanBeUsedADefaultValue;
@ -525,8 +527,8 @@ type
FIsSessionStarted: Boolean;
FSessionMustBeClose: Boolean;
FLoggedUser: TUser;
FData: TDictionary<string, string>;
FWebSession: TWebSession;
FData: TMVCStringDictionary;
function GetWebSession: TWebSession;
function GetLoggedUser: TUser;
function GetParamsTable: TMVCRequestParamsTable;
@ -538,6 +540,7 @@ type
function SendSessionCookie(const AContext: TWebContext): string;
function AddSessionToTheSessionList(const ASessionType, ASessionId: string;
const ASessionTimeout: Integer): TWebSession;
function GetData: TMVCStringDictionary;
public
constructor Create(const ARequest: TWebRequest; const AResponse: TWebResponse;
const AConfig: TMVCConfig; const ASerializers: TDictionary<string, IMVCSerializer>);
@ -557,7 +560,7 @@ type
property Response: TMVCWebResponse read FResponse;
property Session: TWebSession read GetWebSession;
property Config: TMVCConfig read FConfig;
property Data: TDictionary<string, string> read FData;
property Data: TMVCStringDictionary read GetData;
property ParamsTable: TMVCRequestParamsTable read GetParamsTable write SetParamsTable;
end;
@ -1151,6 +1154,18 @@ begin
FCanBeUsedADefaultValue := False;
end;
constructor MVCInjectableParamAttribute.Create(const AParamName: string;
const DefaultAsInteger: Int64);
begin
Create(AParamName, DefaultAsInteger.ToString);
end;
constructor MVCInjectableParamAttribute.Create(const AParamName: string;
const DefaultAsBoolean: Boolean);
begin
Create(AParamName, iif(DefaultAsBoolean,'true','false'));
end;
{ MVCProducesAttribute }
constructor MVCProducesAttribute.Create(const AValue, ACharset: string);
@ -1918,7 +1933,7 @@ begin
FResponse := TMVCWebResponse.Create(AResponse);
FConfig := AConfig;
FSerializers := ASerializers;
FData := TDictionary<string, string>.Create;
FData := nil;
FLoggedUser := nil;
end;
@ -1949,6 +1964,15 @@ begin
FResponse.Flush;
end;
function TWebContext.GetData: TMVCStringDictionary;
begin
if fData = nil then
begin
fData := TMVCStringDictionary.Create;
end;
Result := fData;
end;
function TWebContext.GetHostingFrameworkType: TMVCHostingFrameworkType;
begin
{$IFDEF WEBAPACHEHTTP}