unit uDAServerLog;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  Classes, Contnrs, SysUtils, uROSessions, SyncObjs, uROTypes, uDAInterfaces,
  uROXMLIntf, uROXMLSerializer;

const
  EmptyGUID: TGUID = '{00000000-0000-0000-0000-000000000000}';

type
  TDAServerLog = class;

  { TDALogItem }
  TDALogItem = class(TROComplexType)
  private
    fServerLog: TDAServerLog;
    fCreationTime: TDateTime;
    fSessionID: TGUID;
    function GetSessionIDAsString: string;

  protected
    procedure AssignSession(aSession: TROSession); virtual;

  public
    constructor Create(aServerLog: TDAServerLog; aSession: TROSession); reintroduce;
    destructor Destroy; override;

    property ServerLog: TDAServerLog read fServerLog;
    {$IFDEF FPC}
    property SessionID: TGUID read fSessionID;
    {$ENDIF}

  published
    {$IFNDEF FPC}
    property SessionID: TGUID read fSessionID;
    {$ENDIF}
    property SessionIDAsString: string read GetSessionIDAsString;
    property CreationTime: TDateTime read fCreationTime;
  end;

  { TDASessionLog }
  TDASessionLog = class(TDALogItem)
  private
    fLoginInfo: TROComplexType;

  protected
    procedure AssignLoginInfo(aLoginInfo: TROComplexType); virtual;

  public
    constructor Create(aServerLog: TDAServerLog; aSession: TROSession; aLoginInfo: TROComplexType);
    destructor Destroy; override;

  published
    property LoginInfo: TROComplexType read fLoginInfo;
  end;

  TDASessionLogClass = class of TDASessionLog;

  { TDASQLCommandLog }
  TDASQLCommandLog = class(TDALogItem)
  private
    fActualSQLText: string;
    fElapsedMilliseconds: Cardinal;
    fOriginalSQLText: string;
    fParams: TDAParamCollection;
  protected
  public
    constructor Create(aServerLog: TDAServerLog; aSession: TROSession;
                       const aCommand: IDASQLCommand;
                       aActualSQLText: string; aElapsedMilliseconds: Cardinal);
    destructor Destroy; override;

    property Params: TDAParamCollection read fParams;

  published

    property OriginalSQLText: string read fOriginalSQLText;
    property ActualSQLText: string read fActualSQLText;
    property ElapsedMilliseconds: cardinal read fElapsedMilliseconds;
  end;

  TDASQLCommandLogClass = class of TDASQLCommandLog;

  { TDASQLErrorLog }
  TDASQLErrorLog = class(TDASQLCommandLog)
  private
    fErrorMessage: string;
  protected
  public
    constructor Create(aServerLog: TDAServerLog; aSession: TROSession;
                       aError: Exception; const aCommand: IDASQLCommand;
                       aActualSQLText: string);

    property ErrorMessage: string read fErrorMessage;
  end;

  TDASQLErrorLogClass = class of TDASQLErrorLog;

  { Events }
  TDASessionLogEvent = procedure(Sender: TDAServerLog; SessionLog: TDASessionLog) of object;
  TDASessionLogRemoveEvent = procedure(Sender: TDAServerLog; SessionLog: TDASessionLog; var RemoveRelatedLogs: boolean) of object;
  TDASQLCommandLogEvent = procedure(Sender: TDAServerLog; SQLCommandLog: TDASQLCommandLog) of object;
  TDASQLErrorLogEvent = procedure(Sender: TDAServerLog; SQLErrorLog: TDASQLErrorLog) of object;
  TDALogClassesDefinitionEvent = procedure(Sender: TDAServerLog;
                                         var aSessionLogClass: TDASessionLogClass;
                                         var aSQLCommandLogClass: TDASQLCommandLogClass;
                                         var aSQLErrorLogClass: TDASQLErrorLogClass) of object;

  { TDAServerLog }
  TDAServerLog = class(TComponent)
  private
    fSessionsLogs: TStringList;
    fSQLCommandLogs,
    fSQLErrorsLogs: TObjectList;
    fOnAddSQLCommandLog: TDASQLCommandLogEvent;
    fOnAddSQLErrorLog: TDASQLErrorLogEvent;
    fOnAddSessionLog: TDASessionLogEvent;
    fActive: boolean;
    fOnRemoveSessionLog: TDASessionLogRemoveEvent;

    fCriticalSessions,
    fCriticalSQLCommands,
    fCriticalSQLErrors: TCriticalSection;
    fOnLogClassesDefinition: TDALogClassesDefinitionEvent;

    fSessionLogClass: TDASessionLogClass;
    fSQLCommandLogClass: TDASQLCommandLogClass;
    fSQLErrorLogClass: TDASQLErrorLogClass;

    function GetSQLCommandLogsCount: integer;
    function GetSQLCommandLogs(Index: integer): TDASQLCommandLog;
    function GetSQLErrorLogs(Index: integer): TDASQLErrorLog;
    function GetSessionLogsCount: integer;
    function GetSessionLogs(Index: integer): TDASessionLog;
    function GetSQLErrorLogsCount: integer;

  protected
    procedure RegisterLogServer;
    procedure UnRegisterLogServer;

    procedure Loaded; override;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    procedure SaveToXML(aFileName: string); overload;
    procedure SaveToXML(const aXMLDocument: IXMLDocument); overload; virtual;

    { Session logs }
    function FindSessionLog(aSession: TROSession): TDASessionLog; overload;
    function FindSessionLog(aSessionID: TGUID): TDASessionLog; overload;

    function AddSessionLog(aSession: TROSession; aLoginInfo: TROComplexType): TDASessionLog;
    procedure RemoveSessionLog(aSessionID: TGUID; aRemoveRelatedLogs: boolean); overload;
    procedure RemoveSessionLog(aSession: TROSession; aRemoveRelatedLogs: boolean); overload;
    procedure ClearSessionLogs(aRemoveRelatedLogs: boolean);

    { SQL command logs }
    function AddSQLCommandLog(aSession: TROSession; const aCommand: IDASQLCommand;
                              anActualSQLText: string; aElapsedMilliseconds: Cardinal): TDASQLCommandLog;
    procedure ClearSQLCommandLogs; overload;
    procedure ClearSQLCommandLogs(aSessionID: TGUID); overload;

    { SQL error logs }
    function AddSQLErrorLog(aSession: TROSession; aError: Exception; const aCommand: IDASQLCommand;
                            aActualSQLText: string): TDASQLErrorLog;
    procedure ClearSQLErrorLogs; overload;
    procedure ClearSQLErrorLogs(aSessionID: TGUID); overload;

    { Properties }
    property SessionLogs[Index: integer]: TDASessionLog read GetSessionLogs;
    property SessionLogsCount: integer read GetSessionLogsCount;

    property SQLCommandLogs[Index: integer]: TDASQLCommandLog read GetSQLCommandLogs;
    property SQLCommandLogsCount: integer read GetSQLCommandLogsCount;

    property SQLErrorLogs[Index: integer]: TDASQLErrorLog read GetSQLErrorLogs;
    property SQLErrorLogsCount: integer read GetSQLErrorLogsCount;

  published
    property Active: boolean read fActive write fActive;

    property OnAddSessionLog: TDASessionLogEvent read fOnAddSessionLog write fOnAddSessionLog;
    property OnRemoveSessionLog: TDASessionLogRemoveEvent read fOnRemoveSessionLog write fOnRemoveSessionLog;
    property OnAddSQLCommandLog: TDASQLCommandLogEvent read fOnAddSQLCommandLog write fOnAddSQLCommandLog;
    property OnAddSQLErrorLog: TDASQLErrorLogEvent read fOnAddSQLErrorLog write fOnAddSQLErrorLog;
    property OnLogClassesDefinition: TDALogClassesDefinitionEvent read fOnLogClassesDefinition write fOnLogClassesDefinition;
  end;

function ServerLog: TDAServerLog;

implementation

var _ServerLog: TDAServerLog;

function ServerLog: TDAServerLog;
begin
  if not Assigned(_ServerLog)
    then raise Exception.Create('No TDAServerLog have been registered');

  result := _ServerLog;
end;

{ TDALogItem }

procedure TDALogItem.AssignSession(aSession: TROSession);
begin
  if Assigned(aSession)
    then fSessionID := aSession.SessionID
    else fSessionID := EmptyGUID;
end;

constructor TDALogItem.Create(aServerLog: TDAServerLog; aSession: TROSession);
begin
  fCreationTime := Now;
  fServerLog := aServerLog;
  AssignSession(aSession);
end;

destructor TDALogItem.Destroy;
begin
  inherited;
end;

function TDALogItem.GetSessionIDAsString: string;
begin
  result := GUIDToString(fSessionID)
end;

{ TDASessionLog }

procedure TDASessionLog.AssignLoginInfo(aLoginInfo: TROComplexType);
begin
  fLoginInfo := TROComplexTypeClass(aLoginInfo.ClassType).Create;
  fLoginInfo.Assign(aLoginInfo);
end;

constructor TDASessionLog.Create(aServerLog: TDAServerLog; aSession: TROSession; aLoginInfo: TROComplexType);
begin
  inherited Create(aServerLog, aSession);

  AssignLoginInfo(aLoginInfo);
end;

destructor TDASessionLog.Destroy;
begin
  FreeAndNIL(fLoginInfo);
  inherited;
end;

{ TDASQLCommandLog }

constructor TDASQLCommandLog.Create(aServerLog: TDAServerLog; aSession: TROSession;
  const aCommand: IDASQLCommand; aActualSQLText: string; aElapsedMilliseconds: Cardinal);
begin
  inherited Create(aServerLog, aSession);

  fElapsedMilliseconds := aElapsedMilliseconds;
  fOriginalSQLText := aCommand.SQL;
  fActualSQLText := aActualSQLText;
  fParams := TDAParamCollection.Create(NIL);
  if (aCommand.Params.Count>0)
    then fParams.Assign(aCommand.Params);
end;

destructor TDASQLCommandLog.Destroy;
begin
  FreeAndNIL(fParams);
  inherited;
end;

{ TDASQLErrorLog }

constructor TDASQLErrorLog.Create(aServerLog: TDAServerLog; aSession: TROSession;
  aError: Exception; const aCommand: IDASQLCommand; aActualSQLText: string);
begin
  inherited Create(aServerLog, aSession, aCommand, aActualSQLText, 0);

  fErrorMessage := aError.Message;
end;

{ TDAServerLog }
constructor TDAServerLog.Create(aOwner: TComponent);
begin
  inherited;

  fCriticalSessions := TCriticalSection.Create;
  fCriticalSQLCommands := TCriticalSection.Create;
  fCriticalSQLErrors := TCriticalSection.Create;

  fSessionsLogs := TStringList.Create;
  fSessionsLogs.Sorted := TRUE;

  fSQLCommandLogs := TObjectList.Create;
  fSQLErrorsLogs := TObjectList.Create;
end;

destructor TDAServerLog.Destroy;
begin
  if not (csDesigning in ComponentState) then UnRegisterLogServer;

  ClearSessionLogs(FALSE);
  FreeAndNIL(fSessionsLogs);

  ClearSQLCommandLogs;
  FreeAndNIL(fSQLCommandLogs);

  ClearSQLErrorLogs;
  FreeAndNIL(fSQLErrorsLogs);

  FreeAndNIL(fCriticalSessions);
  FreeAndNIL(fCriticalSQLCommands);
  FreeAndNIL(fCriticalSQLErrors);

  inherited;
end;

procedure TDAServerLog.Loaded;
begin
  if (csDesigning in ComponentState) then Exit;

  RegisterLogServer;

  fSessionLogClass := TDASessionLog;
  fSQLCommandLogClass := TDASQLCommandLog;
  fSQLErrorLogClass := TDASQLErrorLog;

  if Assigned(fOnLogClassesDefinition)
    then fOnLogClassesDefinition(Self, fSessionLogClass, fSQLCommandLogClass, fSQLErrorLogClass);
end;

function TDAServerLog.AddSQLCommandLog(aSession: TROSession; const aCommand: IDASQLCommand;
                           anActualSQLText: string; aElapsedMilliseconds: Cardinal): TDASQLCommandLog;
begin
  result := NIL;
  if not Active then Exit;

  result := fSQLCommandLogClass.Create(Self, aSession, aCommand, anActualSQLText, aElapsedMilliseconds);

  fCriticalSQLCommands.Enter;
  try
    fSQLCommandLogs.Add(result);

    if Assigned(fOnAddSQLCommandLog)
      then fOnAddSQLCommandLog(Self, result);
  finally
    fCriticalSQLCommands.Leave;
  end;
end;

function TDAServerLog.AddSQLErrorLog(aSession: TROSession; aError: Exception; const aCommand: IDASQLCommand;
  aActualSQLText: string): TDASQLErrorLog;
begin
  result := NIL;
  if not Active then Exit;

  result := fSQLErrorLogClass.Create(Self, aSession, aError, aCommand, aActualSQLText);
  fCriticalSQLErrors.Enter;
  try
    fSQLErrorsLogs.Add(result);

    if Assigned(OnAddSQLErrorLog)
      then OnAddSQLErrorLog(Self, result);
  finally
    fCriticalSQLErrors.Leave;
  end;
end;

function TDAServerLog.AddSessionLog(aSession: TROSession; aLoginInfo: TROComplexType): TDASessionLog;
begin
  result := NIL;
  if not Active then Exit;

  result := fSessionLogClass.Create(Self, aSession, aLoginInfo);

  fCriticalSessions.Enter;
  try
    fSessionsLogs.AddObject(GUIDToString(aSession.SessionID), result);

    if Assigned(fOnAddSessionLog)
      then fOnAddSessionLog(Self, result);
  finally
    fCriticalSessions.Leave;
  end;
end;

procedure TDAServerLog.RemoveSessionLog(aSessionID: TGUID; aRemoveRelatedLogs: boolean);
var idx: integer;
    removeRelated: boolean;
begin
  fCriticalSessions.Enter;
  try
    idx := fSessionsLogs.IndexOf(GUIDToString(aSessionID));
    if (idx>=0) then begin
      removeRelated := aRemoveRelatedLogs;

      if Assigned(fOnRemoveSessionLog)
        then fOnRemoveSessionLog(Self, TDASessionLog(fSessionsLogs.Objects[idx]), removeRelated);

      fSessionsLogs.Objects[idx].Free;
      fSessionsLogs.Delete(idx);

      { Removes the entries associated to this session in the sql and errors lists }
      if removeRelated then begin
        ClearSQLCommandLogs(aSessionID);
        ClearSQLErrorLogs(aSessionID);
      end;
    end;
  finally
    fCriticalSessions.Leave;
  end;
end;

procedure TDAServerLog.RemoveSessionLog(aSession: TROSession; aRemoveRelatedLogs: boolean);
begin
  RemoveSessionLog(aSession.SessionID, aRemoveRelatedLogs);
end;

function TDAServerLog.GetSQLCommandLogsCount: integer;
begin
  result := fSQLCommandLogs.Count
end;

function TDAServerLog.GetSQLCommandLogs(Index: integer): TDASQLCommandLog;
begin
  result := TDASQLCommandLog(fSQLCommandLogs[Index])
end;

function TDAServerLog.GetSQLErrorLogsCount: integer;
begin
  result := fSQLErrorsLogs.Count
end;

function TDAServerLog.GetSQLErrorLogs(Index: integer): TDASQLErrorLog;
begin
  result := TDASQLErrorLog(fSQLErrorsLogs[Index])
end;

function TDAServerLog.GetSessionLogsCount: integer;
begin
  result := fSessionsLogs.Count
end;

function TDAServerLog.GetSessionLogs(Index: integer): TDASessionLog;
begin
  result := TDASessionLog(fSessionsLogs.Objects[Index])
end;

procedure TDAServerLog.RegisterLogServer;
begin
  if (_ServerLog<>NIL)
    then raise Exception.Create('Only one instance of TDAServerLog is allowed');

  _ServerLog := Self;
end;

procedure TDAServerLog.UnRegisterLogServer;
begin
  _ServerLog := NIL;
end;

procedure TDAServerLog.ClearSQLCommandLogs;
begin
  fCriticalSQLCommands.Enter;
  try
    fSQLCommandLogs.Clear;
  finally
    fCriticalSQLCommands.Leave;
  end;
end;

procedure TDAServerLog.ClearSQLErrorLogs;
begin
  fCriticalSQLErrors.Enter;
  try
    fSQLErrorsLogs.Clear;
  finally
    fCriticalSQLErrors.Leave;
  end;
end;


procedure TDAServerLog.ClearSQLCommandLogs(aSessionID: TGUID);
var i: integer;
begin
  fCriticalSQLCommands.Enter;
  try
    for i := fSQLCommandLogs.Count-1 downto 0 do
      if IsEqualGUID(TDASQLCommandLog(fSQLCommandLogs[i]).SessionID, aSessionID)
        then fSQLCommandLogs.Delete(i);
  finally
    fCriticalSQLCommands.Leave;
  end;
end;

procedure TDAServerLog.ClearSQLErrorLogs(aSessionID: TGUID);
var i: integer;
begin
  fCriticalSQLErrors.Enter;
  try
    for i := fSQLErrorsLogs.Count-1 downto 0 do
      if IsEqualGUID(TDASQLErrorLog(fSQLErrorsLogs[i]).SessionID, aSessionID)
        then fSQLErrorsLogs.Delete(i);
  finally
    fCriticalSQLErrors.Leave;
  end;
end;

procedure TDAServerLog.ClearSessionLogs(aRemoveRelatedLogs: boolean);
var i: integer;
    thisLog: TDASessionLog;
begin
  fCriticalSessions.Enter;
  try
    for i := 0 to (fSessionsLogs.Count-1) do begin
      thisLog := TDASessionLog(fSessionsLogs.Objects[i]);

      if aRemoveRelatedLogs then begin
        ClearSQLCommandLogs(thisLog.SessionID);
        ClearSQLErrorLogs(thisLog.SessionID);
      end;

      thisLog.Free;
    end;

    fSessionsLogs.Clear;
  finally
    fCriticalSessions.Leave;
  end;
end;


function TDAServerLog.FindSessionLog(aSession: TROSession): TDASessionLog;
begin
  if (aSession<>NIL)
    then result := FindSessionLog(aSession.SessionID)
    else result := NIL;
end;

function TDAServerLog.FindSessionLog(aSessionID: TGUID): TDASessionLog;
var idx: integer;
begin
  result := NIL;
  idx := fSessionsLogs.IndexOf(GUIDToString(aSessionID));
  if (idx>=0) then result := TDASessionLog(fSessionsLogs.Objects[idx]);
end;

procedure TDAServerLog.SaveToXML(aFileName: string);
var doc: IXMLDocument;
begin
  doc := NewROXmlDocument;
  doc.New('Log');
  SaveToXML(doc);
  doc.SaveToFile(aFileName);
end;

procedure TDAServerLog.SaveToXML(const aXMLDocument: IXMLDocument);
var i: integer;
    sessionLog: TDASessionLog;
    sqlLog: TDASQLCommandLog;
    errorLog: TDASQLErrorLog;
begin
  with TROXMLSerializer.Create(pointer(aXMLDocument.DocumentNode)) do try
    SerializationOptions := [xsoSendUntyped];

    for i := 0 to SessionLogsCount-1 do begin
      sessionLog := SessionLogs[i];
      Write(sessionLog.ClassName, sessionLog.ClassInfo, sessionLog);
    end;

    for i := 0 to SQLCommandLogsCount-1 do begin
      sqlLog := SQLCommandLogs[i];
      Write(sqlLog.ClassName, sqlLog.ClassInfo, sqlLog);
    end;

    for i := 0 to SQLErrorLogsCount-1 do begin
      errorLog := SQLErrorLogs[i];
      Write(errorLog.ClassName, errorLog.ClassInfo, errorLog);
    end;

  finally
    Free;
  end;
end;

initialization
  RegisterROClass(TDASessionLog);
  RegisterROClass(TDASQLCommandLog);
  RegisterROClass(TDASQLErrorLog);

finalization
  FreeAndNIL(_ServerLog);

  UnRegisterROClass(TDASessionLog);
  UnRegisterROClass(TDASQLCommandLog);
  UnRegisterROClass(TDASQLErrorLog);

end.