mORMot Open Source

Hello Arnaud, there is a small bug inside the method TSqlDBPostgresStatement.ColumnToJson() (unit mormot.db.sql.postgres; latest version of mORMot2). Values from PostgreSQL columns of type boolean are getting written as t and f instead of true and false, leading to invalid JSON.
An example of a call to the method ISqlDBStatement.ExecutePreparedAndFetchAllAsJson(), which internally calls ColumnToJson(), that shows this bug is

'{"fieldCount":1,"values":["autolinked",f,f,f,f,f,f],"rowCount":6}'

whereas it should be

'{"fieldCount":1,"values":["autolinked",false,false,false,false,false,false],"rowCount":6}'

The problem results from the fact, that the boolean column is seen as a column of type ftInt64 inside of ColumnToJson(),
so that the PostgreSQL value is wrongly written verbatim into the JSON. This can be fixed quickly by checking the real column type (as shown below), but maybe this is not an optimal solution, since this check is repeated for every row:

case ColumnType of
  ...
  
  ftInt64,
  ftDouble,
  ftCurrency:
    begin
    if PQ.ftype(fRes, Col) = BOOLOID then begin
      if putf8char(P)^ = 't' then
        W.AddNoJsonEscapeUtf8('true')
      else
        W.AddNoJsonEscapeUtf8('false');
    end else
      // note: StrLen is slightly faster than PQ.GetLength for small content
      W.AddNoJsonEscape(P, StrLen(P));
    end;

  ...

Kind regards
Michael

Hello Arnaud,

I’ve been recently faced with the task to show the first error in an invalid JSON string and I came up with the following solution.

1. In mormot.core.json I put a “var” in front of the parameter of the function TJsonGotoEndParser.GotoEnd() so that the index of the character that triggered the parser error gets returned:

   function TJsonGotoEndParser.GotoEnd(var P: PUtf8Char): PUtf8Char;

2. Again in mormot.core.json I added an overloaded version of the function IsValidJsonBuffer() that returns the index of the erroneous JSON character in the third parameter:

   function IsValidJsonBuffer(P: PUtf8Char; strict: boolean; var ErrorPosition: uint64): boolean;
   var
     parser: TJsonGotoEndParser;
     pstart: putf8char;
   begin
     {%H-}parser.Init(strict, nil);
     pstart := P;
     result := parser.GotoEnd(P) <> nil;
     if not result then
       ErrorPosition := P - pstart;
   end;

3. These small changes made it possible to write the following code that shows a small portion of the JSON surrounding the erroneous character as well as a marker pointing at that character:

   class function TJsonValidator.ValidateFile(const JsonFileName: string): boolean;
   var
     content: putf8char;
     mapping: THandle;
     fileSize: uint64;
     res: boolean;
     errPos, excStartPos, excEndPos: uint64;
     excerpt, marker: utf8string;
   begin
     content := MapFile(CommandLineParams.JsonFile, mapping, fileSize);
     result := IsValidJsonBuffer(pointer(content), true, errPos);
     WriteLn('');
     if result then
       WriteLn('File contains valid JSON.')
     else begin
       WriteLn('File contains invalid JSON:');
       excStartPos := Max(errPos - 20, 0);
       excEndPos := Min(errPos + 20, fileSize);
       SetLength(excerpt, excEndPos - excStartPos + 1);
       if Length(excerpt) > 0 then begin
         WriteLn('');
         Move((content + excStartPos)^, excerpt[1], Length(excerpt));
         WriteLn(Utf8ToString(excerpt));
         marker := StringOfChar(ansichar(' '), Length(excerpt));
         marker[errPos - excStartPos + 1] := '^';
         WriteLn(Utf8ToString(marker));
       end;
     end;
   end;
   
   class function TJsonValidator.MapFile(const FileName: string; out Mapping: THandle; out Size: uint64): putf8char;
   var
     fileHandle: THandle;
     lFileSize: LARGE_INTEGER;
     content: putf8char;
   begin
     if not FileExists(FileName) then
       raise Exception.Create('File not found');
     fileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyWrite);
     Win32Check(fileHandle <> 0);
     try
       lFileSize.LowPart := GetFileSize(fileHandle, @lFileSize.HighPart);
       Size := puint64(@lFileSize)^;
       if Size = 0 then
         raise Exception.Create('File is empty');
       Mapping := CreateFileMapping(fileHandle, nil, PAGE_READONLY, 0, 0, nil);
       Win32Check(Mapping <> 0);
     finally
       FileClose(fileHandle);
     end;
     result := MapViewOfFile(Mapping, FILE_MAP_READ, 0, 0, 0);
     Win32Check(result <> nil);
   end;
   
   class procedure TJsonValidator.UnmapFile(Mapping: THandle; Buffer: putf8char);
   begin
     UnmapViewOfFile(Buffer);
     CloseHandle(Mapping);
   end;

Do you think this would be a helpful addition to mORMot?

Hello,

I'm working on an application in Lazarus (latest version for Windows available from www.getlazarus.org, i.e. with FPC 3.1.1, Rev. 49965) and noticed a crash when accessing a newly created DocVariant. To reproduce the problem please run the following code:

program project1;

{$IFDEF FPC}
{$mode delphi}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}

uses
  SynCommons;

var
  j: variant;

begin
  j := TDocVariant.New;
  j.Add('abc');
  WriteLn(VariantSaveJson(j));
  ReadLn;
end.       

In Delphi the expected JSON result is shown, while Lazarus throws an "External: SIGSEGV" exception when executing the .Add().

Does the framework provide a built-in function for creating unique indexes on multiple columns?
I tried to use the overloaded version of CreateSQLIndex() that takes an array of field names as its second parameter, but instead of a multi-column index it created a separate index for each of the specified fields.

Example:

  CreateSQLIndex(TUsers, ['Surname', 'Name', 'Email'], true)

results in the three SQL commands

  CREATE UNIQUE INDEX IndexUsersSurname ON Users(Surname)
  CREATE UNIQUE INDEX IndexUsersName ON Users(Name)
  CREATE UNIQUE INDEX IndexUsersEmail ON Users(Email)

instead of the one that I expected:

  CREATE UNIQUE INDEX IndexUsers_Surname_Name_Email ON Users(Surname,Name,Email)

Did I overlook something?

Regards