Simple JSON parsing

[shineworld 73]

Hi all.

I'm new to JSON frameworks and I'm getting lost in a spoonful of water.

 

In the Sydney help I've found this code:

JSONValue := TJSONObject.ParseJSONValue('{"colors":[{"name":"red", "hex":"#f00"}]}');

Memo1.Lines.Add('READER:');
if JSONValue is TJSONArray then
  //... 
else if JSONVAlue is TJSONObject then
  Memo1.Lines.Add('colors');
  Memo1.Lines.Add('name: '+ JSONValue.GetValue<string>('colors[0].name'));
  Memo1.Lines.Add('hex: '+ JSONValue.GetValue<string>('colors[0].hex'));

Now this works fine but I need to read a client request so formatted:
 

var
      Text: string;
      Command: string;
      JsonValue: TJSONValue;
      JsonValueArg: TJSONValue;
begin
      // parse json
      JSONValue := TJSONObject.ParseJSONValue('{"cmd":"program.add.text", "txt":"for I := 0 to 100 do"}');
      if not (JSONValue is TJSONObject) then Exit;

      // gets command type (in Command I've found the "cmd" value "program.add.text". ALL RIGHT!!!)
      if JSONValue.TryGetValue('cmd', Command) then Exit;

      // gets command argument txt (does not found the "txt" value and program EXITS!!!)
      if JSONValue.TryGetValue('txt', Text) then Exit;

	//... 

I can't change the JSON request string to contain an array as well as in the Embarcardero sample because reach from a customer program and I've checked with only JSON validator and seem to be fine.

 

What was I've mistaken?

Thank you in advance for your replies.

 

[Lajos Juhász 293]

You're missing not in the if statement (you would like to continue in case when the JSON is correct):

 

var
      Text: string;
      Command: string;
      JsonValue: TJSONValue;
      JsonValueArg: TJSONValue;
begin
      // parse json
      JSONValue := TJSONObject.ParseJSONValue('{"cmd":"program.add.text", "txt":"for I := 0 to 100 do"}');
      if not (JSONValue is TJSONObject) then Exit;

      // gets command type (in Command I've found the "cmd" value "program.add.text". ALL RIGHT!!!)
      if not JSONValue.TryGetValue('cmd', Command) then Exit;

      // gets command argument txt (does not found the "txt" value and program EXITS!!!)
      if not JSONValue.TryGetValue('txt', Text) then Exit;

	//... 

 

[shineworld 73]

You are RIGHT !!!

Very sorry for this typo....

Edited December 2, 2021 by shineworld

[Rollo62 536]

Well, don't worry, that happens from time to time to all of us

 

[Remy Lebeau 1398]

On 12/2/2021 at 5:06 AM, shineworld said:

// parse json
JSONValue := TJSONObject.ParseJSONValue('{"cmd":"program.add.text", "txt":"for I := 0 to 100 do"}');
if not (JSONValue is TJSONObject) then Exit;

Note that you are responsible for freeing the TJSONValue returned by ParseJSONValue(), so you should use a try..finally for that:

// parse json
JSONValue := TJSONObject.ParseJSONValue('{"cmd":"program.add.text", "txt":"for I := 0 to 100 do"}');
try
  if not (JSONValue is TJSONObject) then Exit;
  ...
finally
  JSONValue.Free;
end;

 

Edited December 3, 2021 by Remy Lebeau

[shineworld 73]

Yes Remy, I've made

 

procedure TIPCTCPServerContext.Execute;
type
  TRequestType = ( rqtpCmd, rqtpGet, rqtpSet );
var
  ArgS: string;
  ArgI: Integer;
  Command: string;
  Request: string;
  Response: string;
  JsonValue: TJSONValue;
  RequestType: TRequestType;
begin
  try
    // sets default response
    Response := RES_NULL;

    // extracts request from tcp stack
    Request := Trim(Connection.IOHandler.ReadLn);

    // gets request type
    JSONValue := TJSONObject.ParseJSONValue(Request);
    try
      if not (JSONValue is TJSONObject) then AbortFast;
      while True do
      begin
        if JSONValue.TryGetValue(REQ_CMD, Command) then
        begin
          RequestType := rqtpCmd;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_GET, Command) then
        begin
          RequestType := rqtpGet;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_SET, Command) then
        begin
          RequestType := rqtpSet;
          Break;
        end;
        AbortFast;
      end;

      // evaluates request type
      case RequestType of
        rqtpCmd:
        begin
          if Command = 'cnc.homing' then
          begin
            if not JSONValue.TryGetValue<Integer>('["axes.mask"]', ArgI) then AbortFast;
            Response := DoCmdCNCHoming(ArgI);
          end
          else if Command = 'cnc.mdi.command' then
          begin
            if not JSONValue.TryGetValue('command', ArgS) then AbortFast;
            Response := DoCmdCNCMDICommand(ArgS);
          end
          else if Command = 'cnc.pause' then
            Response := DoCmdCNCPause
          else if Command = 'cnc.resume.after.pause' then
            Response := DoCmdCNCResumeAfterPause
          else if Command = 'cnc.resume.after.stop' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCResumeAfterStop(ArgI)
            else
              Response := DoCmdCNCResumeAfterStop(0);
          end
          else if Command = 'cnc.start' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCStart(ArgI)
            else
              Response := DoCmdCNCStart(0);
          end
          else if Command = 'cnc.stop' then
            Response := DoCmdCNCStop
          else if Command = 'program.analysis' then
          begin
            if JSONValue.TryGetValue('mode', ArgS) then
              Response := DoCmdProgramAnalysis(ArgS)
            else
              Response := DoCmdProgramAnalysis('');
          end
          else if Command = 'program.analysis.abort' then
            Response := DoCmdProgramAnalysisAbort
          else if Command = 'program.gcode.add.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then AbortFast;
            Response := DoCmdProgramGCodeAddText(ArgS);
          end
          else if Command = 'program.gcode.clear' then
            Response := DoCmdProgramGCodeClear
          else if Command = 'program.gcode.set.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then AbortFast;
            Response := DoCmdProgramGCodeSetText(ArgS);
          end
          else if Command = 'program.load' then
          begin
            if not JSONValue.TryGetValue('name', ArgS) then AbortFast;
            Response := DoCmdProgramLoad(ArgS);
          end
          else if Command = 'program.new' then
            Response := DoCmdProgramNew
          else if Command = 'program.save' then
          begin
            if JSONValue.TryGetValue('name', ArgS) then
              Response := DoCmdProgramSave(ArgS)
            else
              Response := DoCmdProgramSave('')
          end
          else
            AbortFast;
        end;
        rqtpGet:
        begin
          if Command = 'system.info' then
            Response := DoGetSystemInfo
          else if Command = 'axes.info' then
            Response := DoGetAxesInfo
          else
            AbortFast;
        end;
        rqtpSet:
        begin
          //##
        end;
      end;
    finally
      JSONValue.Free;
    end;

    // sends response as json contents
    Connection.IOHandler.WriteLn(Response);
  except
    try Connection.IOHandler.WriteLn(Response) except end;
  end;
end;

 

[Remy Lebeau 1398]

On 12/3/2021 at 11:15 PM, shineworld said:

  try
    ...
    // sends response as json contents
    Connection.IOHandler.WriteLn(Response);
  except
    try Connection.IOHandler.WriteLn(Response) except end;
  end;

 

That is an unusual thing to do.  This is really no better than a try..finally:

  try
    ...
  finally
    // sends response as json contents
    Connection.IOHandler.WriteLn(Response);
  end;

But, what if it is the last WriteLn() that raises the exception? Then you try the same WriteLn() again?  I would use this instead:

  try
    ...
  finally
    try
      // sends response as json contents
      Connection.IOHandler.WriteLn(Response);
    except
    end;
  end;

Though, are you really sure you want to catch an exception at all? You are going to leave the connection in an unstable state.  You may as well just let the exception propagate up the call stack uncaught, and let the server catch it and close the connection for you.

[shineworld 73]

12 hours ago, Remy Lebeau said:

 

Though, are you really sure you want to catch an exception at all? You are going to leave the connection in an unstable state.  You may as well just let the exception propagate up the call stack uncaught, and let the server catch it and close the connection for you.

I'm not aware of that, I'm an occasional user of Indy classes.

So on TIdTTCPServerContex.Execute is better do not manage exceptions on WriteLn because are correctly managed in TidTCPServer.Execute caller?

To be honest I've got some issues during close application when I do TIdTCPServer.Active := False and TIdTCPServer.Free; with connected clients...
Could be because I catch the exceptions on Execute().... and the caller doesn't manage the right closing states.

 

I've changed to:
 

procedure TIPCTCPServerContext.Execute;
type
  TRequestType = ( rqtpCmd, rqtpGet, rqtpSet );
var
  ArgS: string;
  ArgI: Integer;
  Command: string;
  Request: string;
  Response: string;
  JsonValue: TJSONValue;
  RequestType: TRequestType;
begin
  // sets default response
  Response := RES_NULL;

  // extracts request from tcp stack
  Request := Trim(Connection.IOHandler.ReadLn);
  try
    // gets request type
    JSONValue := TJSONObject.ParseJSONValue(Request);
    try
      if not (JSONValue is TJSONObject) then Exit;
      while True do
      begin
        if JSONValue.TryGetValue(REQ_CMD, Command) then
        begin
          RequestType := rqtpCmd;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_GET, Command) then
        begin
          RequestType := rqtpGet;
          Break;
        end;
        if JSONValue.TryGetValue(REQ_SET, Command) then
        begin
          RequestType := rqtpSet;
          Break;
        end;
        Exit;
      end;

      // evaluates request type
      case RequestType of
        rqtpCmd:
        begin
          if Command = 'cnc.homing' then
          begin
            if not JSONValue.TryGetValue<Integer>('["axes.mask"]', ArgI) then Exit;
            Response := DoCmdCNCHoming(ArgI);
          end
          else if Command = 'cnc.mdi.command' then
          begin
            if not JSONValue.TryGetValue('command', ArgS) then Exit;
            Response := DoCmdCNCMDICommand(ArgS);
          end
          else if Command = 'cnc.pause' then
            Response := DoCmdCNCPause
          else if Command = 'cnc.resume.after.pause' then
            Response := DoCmdCNCResumeAfterPause
          else if Command = 'cnc.resume.after.stop' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCResumeAfterStop(ArgI)
            else
              Response := DoCmdCNCResumeAfterStop(0);
          end
          else if Command = 'cnc.start' then
          begin
            if JSONValue.TryGetValue<Integer>('line', ArgI) then
              Response := DoCmdCNCStart(ArgI)
            else
              Response := DoCmdCNCStart(0);
          end
          else if Command = 'cnc.stop' then
            Response := DoCmdCNCStop
          else if Command = 'program.analysis' then
          begin
            if JSONValue.TryGetValue('mode', ArgS) then
              Response := DoCmdProgramAnalysis(ArgS)
            else
              Response := DoCmdProgramAnalysis('');
          end
          else if Command = 'program.analysis.abort' then
            Response := DoCmdProgramAnalysisAbort
          else if Command = 'program.gcode.add.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then Exit;
            Response := DoCmdProgramGCodeAddText(ArgS);
          end
          else if Command = 'program.gcode.clear' then
            Response := DoCmdProgramGCodeClear
          else if Command = 'program.gcode.set.text' then
          begin
            if not JSONValue.TryGetValue('text', ArgS) then Exit;
            Response := DoCmdProgramGCodeSetText(ArgS);
          end
          else if Command = 'program.load' then
          begin
            if not JSONValue.TryGetValue('name', ArgS) then Exit;
            Response := DoCmdProgramLoad(ArgS);
          end
          else if Command = 'program.new' then
            Response := DoCmdProgramNew
          else if Command = 'program.save' then
          begin
            if JSONValue.TryGetValue('name', ArgS) then
              Response := DoCmdProgramSave(ArgS)
            else
              Response := DoCmdProgramSave('')
          end
          else
            Exit;
        end;
        rqtpGet:
        begin
          if Command = 'axes.info' then
            Response := DoGetAxesInfo
          else if Command = 'cnc.info' then
            Response := DoGetCNCInfo
          else if Command = 'compile.info' then
            Response := DoGetCompileInfo
          else if Command = 'system.info' then
            Response := DoGetSystemInfo
          else
            Exit;
        end;
        rqtpSet:
        begin
          //##
        end;
      end;
    finally
      JSONValue.Free;
    end;
  finally
    Connection.IOHandler.WriteLn(Response);
  end;
end;

Should be more right now...

Edited December 7, 2021 by shineworld

[Remy Lebeau 1398]

14 hours ago, shineworld said:

I'm not aware of that, I'm an occasional user of Indy classes.

So on TIdTTCPServerContex.Execute is better do not manage exceptions on WriteLn because are correctly managed in TidTCPServer.Execute caller?

If you catch a socket exception and discard it, you don't know on WHICH BYTE the exception was raised on, so how do you expect to recover your communications from that?  In general, DON'T discard any exception you can't recover from. If you need to act on an exception (ie, to log it, etc), then catch it, but you should re-raise it when finished.  Only discard exceptions you can recover from (socket exceptions are rarely ever recoverable, since the I/O state is typically dead/invalid at that point).

14 hours ago, shineworld said:

To be honest I've got some issues during close application when I do TIdTCPServer.Active := False and TIdTCPServer.Free; with connected clients...

The most common reason for that (but certainly not the only reason) is when a deadlock occurs while a server thread is performing an operation that is synchronized with the same thread that is trying to deactivate the server.  For instance, trying to update the UI from a server thread while the UI thread is blocked waiting on the server to close.

14 hours ago, shineworld said:

Could be because I catch the exceptions on Execute()....

Possibly, yes.  Indy relies on exceptions for error reporting, and certain exceptions, particularly socket-related ones, are important to tell the server when a client connection has been closed and its managing thread should stop running.  So, if you just blindly catch and discard exceptions, the server might not shut down properly.  So, at the very least, if you catch any exception that is derived from EIdException, re-raise it, let the server handle it.