kam-mobile/code/GameDiagnosticsFileIO.pas

unit GameDiagnosticsFileIO;

{$mode objfpc}{$H+}

interface

procedure RunFileIODiagnostic;

implementation

uses
  Classes, SysUtils, GameSelectedMap, GameDiagnosticsReport, KaMResourceInput,
  KM_CommonClasses;

procedure InitializeResult(out AResult: TFileIODiagnosticResult);
var
  Stage: TDiagnosticStageId;
begin
  FillChar(AResult, SizeOf(AResult), 0);
  AResult.Status := dsNotRun;
  for Stage := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
    AResult.Stages[Stage] := dsNotRun;
end;

procedure FailStage(var AResult: TFileIODiagnosticResult;
  const AStage: TDiagnosticStageId; const AMessage: string;
  const AException: Exception = nil);
begin
  AResult.Stages[AStage] := dsFail;
  AResult.Status := dsFail;
  AResult.FailureStage.HasValue := True;
  AResult.FailureStage.Value := AStage;
  AResult.Error.Present := True;
  AResult.Error.MessageText.HasValue := True;
  AResult.Error.MessageText.Value := AMessage;
  if AException <> nil then
  begin
    AResult.Error.ClassName.HasValue := True;
    AResult.Error.ClassName.Value := AException.ClassName;
  end;
end;

procedure FailException(var AResult: TFileIODiagnosticResult;
  const AStage: TDiagnosticStageId; const AException: Exception);
begin
  FailStage(AResult, AStage, AException.Message, AException);
end;

function RunResourceExists(const AMapUrl: string;
  var AResult: TFileIODiagnosticResult): Boolean;
begin
  try
    Result := KaMResourceExists(AMapUrl);
    if Result then
      AResult.Stages[dsiResourceExists] := dsPass
    else
      FailStage(AResult, dsiResourceExists,
        'Selected resource is not present');
  except
    on E: Exception do
    begin
      FailException(AResult, dsiResourceExists, E);
      Result := False;
    end;
  end;
end;

function RunResourceOpen(const AMapUrl: string;
  var AResult: TFileIODiagnosticResult): Boolean;
var
  Source: TStream;
begin
  Result := False;
  Source := nil;
  try
    try
      Source := KaMOpenResourceStream(AMapUrl);
      if Source = nil then
      begin
        FailStage(AResult, dsiResourceOpen, 'Resource open returned no stream');
        Exit;
      end;
      Source.Free;
      Source := nil;
      AResult.Stages[dsiResourceOpen] := dsPass;
      Result := True;
    except
      on E: Exception do
        FailException(AResult, dsiResourceOpen, E);
    end;
  finally
    if Source <> nil then
      try
        Source.Free;
      except
        on E: Exception do
          if AResult.Status <> dsFail then
            FailException(AResult, dsiResourceOpen, E);
      end;
  end;
end;

function RunCallerStreamLoad(const AMapUrl: string;
  var AStream: TKMemoryStreamBinary; var AResult: TFileIODiagnosticResult): Boolean;
begin
  Result := False;
  try
    AStream := TKMemoryStreamBinary.Create;
    AStream.LoadFromFile(AMapUrl);
    AResult.Stages[dsiCallerStreamLoad] := dsPass;
    Result := True;
  except
    on E: Exception do
      FailException(AResult, dsiCallerStreamLoad, E);
  end;
end;

function RunStreamState(const AStream: TKMemoryStreamBinary;
  var AResult: TFileIODiagnosticResult): Boolean;
begin
  Result := False;
  try
    AResult.Stream.Size.Value := AStream.Size;
    AResult.Stream.Size.HasValue := True;
    AResult.Stream.PositionAfterLoad.Value := AStream.Position;
    AResult.Stream.PositionAfterLoad.HasValue := True;
    if AStream.Size <= 0 then
      FailStage(AResult, dsiStreamState, 'Loaded stream is empty')
    else if AStream.Position <> 0 then
      FailStage(AResult, dsiStreamState, 'Loaded stream position is not zero')
    else
    begin
      AResult.Stages[dsiStreamState] := dsPass;
      Result := True;
    end;
  except
    on E: Exception do
      FailException(AResult, dsiStreamState, E);
  end;
end;

function RunSeekReadConsistency(const AStream: TKMemoryStreamBinary;
  var AResult: TFileIODiagnosticResult): Boolean;
var
  Requested, FirstCount, SecondCount, ExpectedPosition, RestoredPosition: LongInt;
  FirstBytes, SecondBytes: array of Byte;
  I: Integer;
begin
  Result := False;
  try
    try
    AResult.Stream.ReadOffset.Value := 0;
    AResult.Stream.ReadOffset.HasValue := True;
    Requested := 32;
    if AStream.Size < Requested then Requested := LongInt(AStream.Size);
    AResult.Stream.RequestedReadCount.Value := Requested;
    AResult.Stream.RequestedReadCount.HasValue := True;
    SetLength(FirstBytes, Requested);
    SetLength(SecondBytes, Requested);

    FirstCount := AStream.Read(FirstBytes[0], Requested);
    AResult.Stream.FirstReadCount.Value := FirstCount;
    AResult.Stream.FirstReadCount.HasValue := True;
    AResult.Stream.PositionAfterFirstRead.Value := AStream.Position;
    AResult.Stream.PositionAfterFirstRead.HasValue := True;
    ExpectedPosition := FirstCount;
    if (FirstCount <> Requested) or (AStream.Position <> ExpectedPosition) then
    begin
      FailStage(AResult, dsiSeekReadConsistency, 'First read did not advance as required');
      Exit;
    end;

    AResult.Stream.SeekBackPosition.Value := AStream.Seek(0, soBeginning);
    AResult.Stream.SeekBackPosition.HasValue := True;
    if (AResult.Stream.SeekBackPosition.Value <> 0) or (AStream.Position <> 0) then
    begin
      FailStage(AResult, dsiSeekReadConsistency, 'Seek back did not return to zero');
      Exit;
    end;

    SecondCount := AStream.Read(SecondBytes[0], Requested);
    AResult.Stream.SecondReadCount.Value := SecondCount;
    AResult.Stream.SecondReadCount.HasValue := True;
    AResult.Stream.PositionAfterSecondRead.Value := AStream.Position;
    AResult.Stream.PositionAfterSecondRead.HasValue := True;
    ExpectedPosition := SecondCount;
    if (SecondCount <> Requested) or (AStream.Position <> ExpectedPosition) then
    begin
      FailStage(AResult, dsiSeekReadConsistency, 'Second read did not advance as required');
      Exit;
    end;

    AResult.Stream.RepeatEqual.Value := True;
    AResult.Stream.RepeatEqual.HasValue := True;
    for I := 0 to Requested - 1 do
      if FirstBytes[I] <> SecondBytes[I] then
      begin
        AResult.Stream.RepeatEqual.Value := False;
        Break;
      end;
    if not AResult.Stream.RepeatEqual.Value then
    begin
      FailStage(AResult, dsiSeekReadConsistency, 'Repeated reads differ');
      Exit;
    end;

  except
    on E: Exception do
      FailException(AResult, dsiSeekReadConsistency, E);
    end;
  finally
    try
      RestoredPosition := AStream.Seek(AResult.Stream.PositionAfterLoad.Value, soBeginning);
      if ((RestoredPosition <> AResult.Stream.PositionAfterLoad.Value) or
          (AStream.Position <> AResult.Stream.PositionAfterLoad.Value)) and
         (AResult.Status <> dsFail) then
      begin
        FailStage(AResult, dsiSeekReadConsistency, 'Could not restore stream position');
        Result := False;
      end;
    except
      on E: Exception do
        if AResult.Status <> dsFail then
        begin
          FailException(AResult, dsiSeekReadConsistency, E);
          Result := False;
        end;
    end;
  end;
  if AResult.Status <> dsFail then
  begin
    AResult.Stages[dsiSeekReadConsistency] := dsPass;
    AResult.Status := dsPass;
    Result := True;
  end;
end;

procedure RunFileIODiagnostic;
var
  ResultData: TFileIODiagnosticResult;
  MapUrl: string;
  Stream: TKMemoryStreamBinary;
begin
  InitializeResult(ResultData);
  Stream := nil;
  MapUrl := SelectedMapUrl;
  try
    if RunResourceExists(MapUrl, ResultData) and
       RunResourceOpen(MapUrl, ResultData) and
       RunCallerStreamLoad(MapUrl, Stream, ResultData) and
       RunStreamState(Stream, ResultData) then
      RunSeekReadConsistency(Stream, ResultData);
  finally
    try
      Stream.Free;
    except
      on E: Exception do
        if ResultData.Status <> dsFail then
          FailException(ResultData, dsiSeekReadConsistency, E);
    end;
  end;
  ReplaceFileIODiagnosticResult(ResultData);
end;

end.