unit uDADBSessionManager;

{----------------------------------------------------------------------------}
{ 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
  {vcl:}SysUtils, Classes,
  {RemObjects: SDK}uROSessions,
  {Data Abstract:}uDAInterfaces, uDAClasses;

type
  TDAConvertGUIDEvent = function(Sender: TROCustomSessionManager; const aGUID: TGUID): string of object;
  TDADBSessionManager = class(TROCustomSessionManager)
  private
    fSchema: TDASchema;
    fDeleteSession: string;
    fUpdateSession: string;
    fInsertSession: string;
    fGetSession: string;
    fClearSessions: string;
    fGetSessionCount: string;
    fConnection: string;
    fFieldNameSessionID: string;
    fFieldNameCreated: string;
    fFieldNameLastAccessed: string;
    fFieldNameData: string;
    fClearSessionsOnCreate: boolean;
    fClearSessionsOnDestroy: boolean;
    fGetAllSessionIDs: string;
    fOnConvertGUID: TDAConvertGUIDEvent;
    FForceTransaction: Boolean;
    FNeedTransactionAction: Boolean;
    procedure SetSchema(const Value: TDASchema);
    { Private declarations }
    procedure BeginTransaction;
    procedure CommitTransaction;
    procedure RollbackTransaction;
    function GetConnection: IDAConnection;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    function DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession; override;
    procedure DoDeleteSession(const aSessionID: TGUID; IsExpired: boolean); override;
    procedure DoClearSessions(OnlyExpired: boolean); override;
    function DoGetSessionCount: integer; override;
    procedure DoReleaseSession(aSession: TROSession; NewSession: boolean); override;
    procedure DoGetAllSessions(Dest: TStringList); override;

    function DoConvertGUID(const aGUID: TGUID): string; virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckProperties;
  published
    property Schema: TDASchema read fSchema write SetSchema;

    property FieldNameSessionID: string read fFieldNameSessionID write fFieldNameSessionID;
    property FieldNameCreated: string read fFieldNameCreated write fFieldNameCreated;
    property FieldNameLastAccessed: string read fFieldNameLastAccessed write fFieldNameLastAccessed;
    property FieldNameData: string read fFieldNameData write fFieldNameData;

    property InsertSessionCommand: string read fInsertSession write fInsertSession;
    property UpdateSessionCommand: string read fUpdateSession write fUpdateSession;
    property DeleteSessionCommand: string read fDeleteSession write fDeleteSession;
    property ClearSessionsCommand: string read fClearSessions write fClearSessions;
    property GetSessionCountDataSet: string read fGetSessionCount write fGetSessionCount;
    property GetSessionDataSet: string read fGetSession write fGetSession;
    property GetAllSessionIDsDataset: string read fGetAllSessionIDs write fGetAllSessionIDs;

    property ClearSessionsOnCreate: boolean read fClearSessionsOnCreate write fClearSessionsOnCreate default true;
    property ClearSessionsOnDestroy: boolean read fClearSessionsOnDestroy write fClearSessionsOnDestroy default true;

    property Connection: string read fConnection write fConnection;
    property OnConvertGUID: TDAConvertGUIDEvent read fOnConvertGUID write fOnConvertGUID;
    property AutoTransaction: Boolean read FForceTransaction write FForceTransaction default false;
  end;

implementation

uses
  uROClasses, uROTypes;

constructor TDADBSessionManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fClearSessionsOnDestroy := TRUE;
  ClearSessionsOnCreate := TRUE;

  fFieldNameSessionID := 'SessionID';
  fFieldNameCreated := 'Created';
  fFieldNameLastAccessed := 'LastAccessed';
  fFieldNameData := 'Data';
end;

destructor TDADBSessionManager.Destroy;
begin
  Schema := nil;
  inherited;
end;

procedure TDADBSessionManager.DoClearSessions(OnlyExpired: boolean);
var
  lCommand: IDASQLCommand;
begin
  inherited;
  CheckProperties;
  lCommand := Schema.NewCommand(GetConnection, ClearSessionsCommand);
  if OnlyExpired then
    lCommand.ParamByName(FieldNameLastAccessed).Value := ((Now * MinsPerDay) + SessionDuration) / MinsPerDay
  else
    lCommand.ParamByName(FieldNameLastAccessed).Value := Now + 30; // 30 days from now. Enough to say all! <G>
  BeginTransaction;
  try
    lCommand.Execute();
  except
    RollbackTransaction;
    Raise;
  end;
  CommitTransaction;
end;

procedure TDADBSessionManager.DoDeleteSession(const aSessionID: TGUID; IsExpired: boolean);
var
  lCommand: IDASQLCommand;
begin
  inherited;
  CheckProperties;
  lCommand := Schema.NewCommand(GetConnection, DeleteSessionCommand);
  lCommand.ParamByName(FieldNameSessionID).Value := DoConvertGUID(aSessionID);
  BeginTransaction;
  try
    lCommand.Execute();
  except
    RollbackTransaction;
    raise;
  end;
  CommitTransaction;
end;

function TDADBSessionManager.DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
var
  lDataSet: IDADataSet;
  lData: Binary;
  lDataField: TDAField;
begin
  inherited;
  result := nil;

  CheckProperties;
  lDataSet := Schema.NewDataset(GetConnection, GetSessionDataSet);
  lDataSet.ParamByName(FieldNameSessionID).AsString := DoConvertGUID(aSessionID);

  BeginTransaction;
  try
    lDataSet.Open;
  except
    RollbackTransaction;
    raise;
  end;
  CommitTransaction;

  try
    if lDataSet.EOF then Exit;

    result := DoCreateSession(aSessionID);
    result.Created := lDataSet.FieldByName(FieldNameCreated).AsDateTime;
    result.LastAccessed := lDataSet.FieldByName(FieldNameLastAccessed).AsDateTime;

    lData := Binary.Create;
    try
      lDataField := lDataSet.FieldByName(fFieldNameData);
      lDataField.SaveToStream(NewROStream(lData, false));
      //lData := BinaryFromVariant(lDataSet.FieldByName(FieldNameData).Value);
      //try
      lData.Seek(0, soFromBeginning);
      result.LoadFromStream(lData, true);
    finally
      lData.Free;
    end;
  finally
    lDataSet.Close();
  end;
end;

procedure TDADBSessionManager.DoGetAllSessions(Dest: TStringList);
var lDataSet: IDADataSet;
begin
  CheckProperties;

  lDataSet := Schema.NewDataset(GetConnection, GetAllSessionIDsDataset);
  BeginTransaction;
  try
    lDataSet.Open;
  except
    RollbackTransaction;
    raise;
  end;
  CommitTransaction;

  try
    while not lDataSet.EOF do try
      Dest.Add(lDataSet.Fields[0].AsString);
    finally
      lDataSet.Next;
    end;
  finally
    lDataSet.Close();
  end;
end;

function TDADBSessionManager.DoGetSessionCount: integer;
var
  lDataSet: IDADataSet;
begin
  inherited;
  CheckProperties;
  lDataSet := Schema.NewDataset(GetConnection, GetSessionCountDataSet);
  BeginTransaction;
  try
    lDataSet.Open;
  except
    RollbackTransaction;
    raise;
  end;
  CommitTransaction;
  try
    result := lDataSet.Fields[0].AsInteger;
  finally
    lDataSet.Close();
  end;
end;

procedure TDADBSessionManager.DoReleaseSession(aSession: TROSession; NewSession: boolean);
var
  lCommand: IDASQLCommand;
  lData: Binary;
begin
  inherited;
  CheckProperties;
  if NewSession then begin
    lCommand := Schema.NewCommand(GetConnection, InsertSessionCommand);
    lCommand.ParamByName(FieldNameCreated).AsDateTime := aSession.Created;
  end
  else begin
    lCommand := Schema.NewCommand(GetConnection, UpdateSessionCommand);
  end;
  lCommand.ParamByName(FieldNameSessionID).AsString := DoConvertGUID(aSession.SessionID);
  lCommand.ParamByName(FieldNameLastAccessed).AsDateTime := aSession.LastAccessed;
  lData := Binary.Create;
  try
    aSession.SaveToStream(lData, TRUE);
    lData.Seek(0, soFromBeginning);
    lCommand.ParamByName(FieldNameData).LoadFromStream(NewROStream(lData, false));
  finally
    lData.Free;
  end;
  BeginTransaction;
  try
    lCommand.Execute();
  except
    RollbackTransaction;
    raise;
  end;
  CommitTransaction;
  if ((NewSession) and (Assigned(OnSessionCreated))) then OnSessionCreated(aSession);
  aSession.Free();
end;

procedure TDADBSessionManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation <> opRemove then exit;
  if AComponent = Schema then Schema := nil;
end;

procedure TDADBSessionManager.SetSchema(const Value: TDASchema);
begin
  if fSchema <> Value then begin
    fSchema := Value;
    if Assigned(Schema) then Schema.FreeNotification(self);
  end;
end;

function TDADBSessionManager.DoConvertGUID(const aGUID: TGUID): string;
begin
  if Assigned(fOnConvertGUID) then
    try
      Result:= fOnConvertGUID(Self, aGUID);
    except
      Result:= GUIDToString(aGUID);
    end
  else
    Result:= GUIDToString(aGUID);
end;

procedure TDADBSessionManager.BeginTransaction;
begin
  with GetConnection do begin
    FNeedTransactionAction := FForceTransaction and not InTransaction;
    if FNeedTransactionAction then BeginTransaction;
  end;
end;

procedure TDADBSessionManager.CommitTransaction;
begin
 if FNeedTransactionAction then GetConnection.CommitTransaction;
end;

procedure TDADBSessionManager.RollbackTransaction;
begin
 if FNeedTransactionAction then GetConnection.RollbackTransaction;
end;

function TDADBSessionManager.GetConnection: IDAConnection;
begin
  CheckProperties;
  Result := Schema.ConnectionManager.NewConnection(Connection);
end;

procedure TDADBSessionManager.CheckProperties;
begin
  Check(Schema = nil, Name+'.Schema must be assigned.');
  Schema.CheckProperties;
  Check(FieldNameSessionID = '', Name + '.FieldNameSessionID must be set.');
  Check(FieldNameCreated = '', Name + '.FieldNameCreated must be set.');
  Check(FieldNameLastAccessed = '', Name + '.FieldNameLastAccessed must be assigned.');
  Check(FieldNameData = '', Name + '.FieldNameData must be set.');
  Check(InsertSessionCommand = '', Name + '.InsertSessionCommand must be set.');
  Check(DeleteSessionCommand = '', Name + '.DeleteSessionCommand must be set.');
  Check(UpdateSessionCommand = '', Name + '.UpdateSessionCommand must be set.');
  Check(ClearSessionsCommand = '', Name + '.ClearSessionsCommand must be set.');
  Check(GetSessionCountDataSet = '', Name + '.GetSessionCountDataSet must be set.');
  Check(GetSessionDataSet = '', Name + '.GetSessionDataSet must be set.');
  Check(GetAllSessionIDsDataset = '', Name + '.GetAllSessionIDsDataset must be set.');
end;

end.