unit uRODBSessionManager;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Provided by Niko Schoemaker (niko.schoemaker@teamro.remobjects.com)        }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses Classes, uROSessions, DB;

type
  TConvertGUIDEvent = function(Sender: TROCustomSessionManager; const aGUID: TGUID): string of object;
  TRODBSessionManagerDatasetGetParams = function(Sender: TROCustomSessionManager; aDataset: TDataset): TParams of object;
  TRODBSessionManagerDatasetSetParams = procedure(Sender: TROCustomSessionManager; aDataset: TDataset; aParams: TParams) of object;
  TRODBSessionManagerDatasetExecute = procedure(Sender: TROCustomSessionManager; aDataset: TDataset) of object;

  {$IFDEF FPC}
  IProviderSupport = interface
    procedure PSExecute;
    function PSGetParams: TParams;
    procedure PSSetParams(AParams: TParams);
  end;
  {$ENDIF}

  { TRODBSessionManager }
  TRODBSessionManager = class(TROCustomSessionManager)
  private
    fInsertDataset,
    fDeleteDataset,
    fUpdateDataset,
    fSelectDataset,
    fGetCountDataset,
    fClearSessionsDataset,
    fSelectAllDataset : TDataset;

    fFieldNameSessionID,
    fFieldNameCreated,
    fFieldNameLastAccessed,
    fFieldNameData: string;
    fClearSessionsOnDestroy: boolean;
    fClearSessionsOnCreate: boolean;
    fOnConvertGUID: TConvertGUIDEvent;
    fOnDatasetExecute: TRODBSessionManagerDatasetExecute;
    fOnDatasetGetParams: TRODBSessionManagerDatasetGetParams;
    fOnDatasetSetParams: TRODBSessionManagerDatasetSetParams;

    function GetProvider(aDataset: TDataset): IProviderSupport;
    procedure SetClearSessionsDataset(const Value: TDataset);
    procedure SetDeleteDataset(const Value: TDataset);
    procedure SetGetCountDataset(const Value: TDataset);
    procedure SetInsertDataset(const Value: TDataset);
    procedure SetSelectDataset(const Value: TDataset);
    procedure SetUpdateDataset(const Value: TDataset);
    procedure SetSelectAllDataset(const Value: TDataSet);
    function DoDatasetGetParams(aDataset: TDataset; aProvider: IProviderSupport): TParams;
    procedure DoDatasetSetParams(aDataset: TDataset; aProvider: IProviderSupport; AParams: TParams);
    procedure DoDatasetExecute(aDataset: TDataset; aProvider: IProviderSupport);
  protected
    // TROCustomSessionManager
    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;
    // Internals
    procedure  Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;

  public
    constructor Create(aOwner : TComponent); override;
    destructor Destroy; override;
    procedure CheckProperties;
  published
    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 InsertDataset : TDataset read fInsertDataset write SetInsertDataset;
    property DeleteDataset : TDataset read fDeleteDataset write SetDeleteDataset;
    property UpdateDataset : TDataset read fUpdateDataset write SetUpdateDataset;
    property SelectDataset : TDataset read fSelectDataset write SetSelectDataset;
    property GetCountDataset : TDataset read fGetCountDataset write SetGetCountDataset;
    {$WARNINGS OFF}
    property ClearSessionsDataset : TDataset read fClearSessionsDataset write SetClearSessionsDataset;
    {$WARNINGS ON}
    property SelectAllDataset : TDataSet read fSelectAllDataset write SetSelectAllDataset;

    property ClearSessionsOnCreate : boolean read fClearSessionsOnCreate write fClearSessionsOnCreate default true;
    property ClearSessionsOnDestroy : boolean read fClearSessionsOnDestroy write fClearSessionsOnDestroy default true;
    property OnConvertGUID: TConvertGUIDEvent read fOnConvertGUID write fOnConvertGUID;
    property SessionDuration;
    property SessionCheckInterval;
    property OnDatasetGetParams: TRODBSessionManagerDatasetGetParams read fOnDatasetGetParams write fOnDatasetGetParams;
    property OnDatasetSetParams: TRODBSessionManagerDatasetSetParams read fOnDatasetSetParams write fOnDatasetSetParams;
    property OnDatasetExecute : TRODBSessionManagerDatasetExecute read fOnDatasetExecute write fOnDatasetExecute;

  end;

implementation

uses
  {$IFDEF DELPHI5}ComObj,{$ENDIF}
  SysUtils, uROClasses;

{ TRODBSessionManager }

constructor TRODBSessionManager.Create(aOwner: TComponent);
begin
  inherited;

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

destructor TRODBSessionManager.Destroy;
begin
  InsertDataset := nil;
  DeleteDataset := nil;
  UpdateDataset := nil;
  SelectDataset := nil;
  GetCountDataset := nil;
  ClearSessionsDataset := nil;
  inherited;
end;

function TRODBSessionManager.GetProvider(aDataset : TDataset) : IProviderSupport;
begin
  {$IFDEF FPC}
    if aDataset = nil then Result := nil else // prevent FPC warning
    Result := nil;
  {$ELSE}
    {$IFDEF DELPHI7UP}
      result := aDataset as IProviderSupport;
    {$ELSE}
      result := IProviderSupport(aDataset);
    {$ENDIF}
  {$ENDIF FPC}
end;

procedure TRODBSessionManager.DoClearSessions(OnlyExpired: boolean);
const HoursPerDay = 24;
      MinsPerDay  = HoursPerDay * 60;
var params, lparams : TParams;
    provider : IProviderSupport;
    lLastAccessed: TDateTime;
begin
  CheckProperties;
  provider := GetProvider(fClearSessionsDataset);
  params := DoDatasetGetParams(fClearSessionsDataset,provider);
  lparams:= TParams.Create;
  try
    lparams.Assign(params);
    if OnlyExpired then
      lLastAccessed := ((Now*MinsPerDay) - SessionDuration) / MinsPerDay
    else
      lLastAccessed := Now+30; // 30 days from now. Enough to say all! <G>
    lparams.ParamByName(fFieldNameLastAccessed).AsDateTime := lLastAccessed;
//    lparams.ParamByName(fFieldNameLastAccessed).AsSQLTimeStamp := DateTimeToSQLTimeStamp(lLastAccessed);
    DoDatasetSetParams(fClearSessionsDataset,provider,lparams);
  finally
    lparams.Free;
  end;
  DoDatasetExecute(fClearSessionsDataset,provider);
  provider := nil;
end;

procedure TRODBSessionManager.DoDeleteSession(const aSessionID: TGUID;
  IsExpired: boolean);
var params,lParams : TParams;
    provider : IProviderSupport;
begin
  CheckProperties;
  provider := GetProvider(fDeleteDataset);
  params := DoDatasetGetParams(fDeleteDataset, provider);

  lParams:=TParams.Create;
  try
    lParams.Assign(Params);
    lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSessionID);
    DoDatasetSetParams(fDeleteDataset, provider, lParams);
  finally
    lParams.Free;
  end;
  DoDatasetExecute(fDeleteDataset, provider);
  provider := nil;
end;

function TRODBSessionManager.DoFindSession(const aSessionID: TGUID; aUpdateTime: Boolean): TROSession;
var params,lParams : TParams;
    data : TStream;
    datafld : TBlobField;
    provider : IProviderSupport;
begin
  CheckProperties;
  result := NIL;
  provider := GetProvider(fSelectDataset);

  params := DoDatasetGetParams(fSelectDataset, provider);
  lParams:=TParams.Create;
  try
    lParams.Assign(params);
    lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSessionID);
    DoDatasetSetParams(fSelectDataset, provider, lParams);
  finally
    lParams.Free;
  end;
  provider:=nil;

  data := nil;
  fSelectDataset.Open;
  try
    if (fSelectDataset.bof and fSelectDataset.eof) then Exit;
    data := TMemoryStream.Create;

    //result := TROSession.Create(aSessionID);
    result := DoCreateSession(aSessionID);
    result.Created := fSelectDataset.FieldByName(fFieldNameCreated).AsDateTime;
    result.LastAccessed := fSelectDataset.FieldByName(fFieldNameLastAccessed).AsDateTime;

    datafld := TBlobField(fSelectDataset.FieldByName(fFieldNameData));
    datafld.SaveToStream(data);
    data.Position := 0;
    result.LoadFromStream(data, TRUE);
  finally
    fSelectDataset.Close;
    data.Free;
  end;
end;

function TRODBSessionManager.DoGetSessionCount: integer;
begin
  CheckProperties;
  fGetCountDataset.Open;
  try
    result := fGetCountDataset.Fields[0].AsInteger;
  finally
    fGetCountDataset.Close;
  end;
end;
  
procedure TRODBSessionManager.DoReleaseSession(aSession: TROSession; NewSession : boolean);
var params,lparams : TParams;
    data : TStream;
    provider : IProviderSupport;
begin
  CheckProperties;
  inherited;
  data := TMemoryStream.Create;
  try
    if NewSession then begin
      provider := GetProvider(fInsertDataset);

      params := DoDatasetGetParams(fInsertDataset, provider);
      lparams:=TParams.Create;
      try
        lparams.Assign(params);
        lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSession.SessionID);
        lparams.ParamByName(fFieldNameLastAccessed).AsDateTime := aSession.LastAccessed;
        //lparams.ParamByName(fFieldNameLastAccessed).AsSQLTimeStamp := DateTimeToSQLTimeStamp(aSession.LastAccessed);
        lparams.ParamByName(fFieldNameCreated).AsDateTime := aSession.Created;
        //lparams.ParamByName(fFieldNameCreated).AsSQLTimeStamp := DateTimeToSQLTimeStamp(aSession.Created);

        aSession.SaveToStream(data, TRUE);
        data.Position := 0;
        lparams.ParamByName(fFieldNameData).LoadFromStream(data, ftBlob);

        DoDatasetSetParams(fInsertDataset, provider, lparams);
      finally
        lParams.Free;
      end;
      DoDatasetExecute(fInsertDataset, provider);
    end
    else begin
      provider := GetProvider(fUpdateDataset);

      params := DoDatasetGetParams(fUpdateDataset, provider);
      lparams:=TParams.Create;
      try
        lparams.Assign(params);
        lparams.ParamByName(fFieldNameSessionID).Value := DoConvertGUID(aSession.SessionID);
        lparams.ParamByName(fFieldNameLastAccessed).AsDateTime := aSession.LastAccessed;
        //lparams.ParamByName(fFieldNameLastAccessed).AsSQLTimeStamp := DateTimeToSQLTimeStamp(aSession.LastAccessed);

        aSession.SaveToStream(data, TRUE);
        lparams.ParamByName(fFieldNameData).LoadFromStream(data, ftBlob);
        DoDatasetsetParams(fUpdateDataset, provider, lparams);
      finally
        lParams.Free;
      end;
      DoDatasetExecute(fUpdateDataset, provider);
    end;
    provider := nil;
  finally
    data.Free;
  end;
  aSession.Free();
end;

procedure TRODBSessionManager.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) then begin
   if (AComponent=fInsertDataset) then fInsertDataset := NIL
   else if (AComponent=fDeleteDataset) then fDeleteDataset := NIL
   else if (AComponent=fUpdateDataset) then fUpdateDataset := NIL
   else if (AComponent=fSelectDataset) then fSelectDataset := NIL
   else if (AComponent=fGetCountDataset) then fGetCountDataset := NIL
   else if (AComponent=fSelectAllDataset) then fSelectAllDataset := nil
   else if (AComponent=fClearSessionsDataset) then begin

     if (csDestroying in ComponentState) and ClearSessionsOnDestroy then begin
       // Cleans up after itself. If you get an AV related to the dataset's connection
       // be aware of the fact that the dataset's creation order MUST BE after its relative
       // connection. To see your form's Creation Order simply right click on it and select
       // the relative menu item.

       DoClearSessions(false);
     end;

     fClearSessionsDataset := NIL
   end;
  end;
end;

procedure TRODBSessionManager.SetClearSessionsDataset(const Value: TDataset);
begin
  fClearSessionsDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

procedure TRODBSessionManager.SetDeleteDataset(const Value: TDataset);
begin
  fDeleteDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

procedure TRODBSessionManager.SetGetCountDataset(const Value: TDataset);
begin
  fGetCountDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

procedure TRODBSessionManager.SetInsertDataset(const Value: TDataset);
begin
  fInsertDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

procedure TRODBSessionManager.SetSelectDataset(const Value: TDataset);
begin
  fSelectDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

procedure TRODBSessionManager.SetUpdateDataset(const Value: TDataset);
begin
  fUpdateDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

procedure TRODBSessionManager.Loaded;
begin
  inherited;

  if not (csDesigning in ComponentState) and ClearSessionsOnCreate
    then DoClearSessions(false);
end;

procedure TRODBSessionManager.DoGetAllSessions(Dest: TStringList);
begin
  CheckProperties;
  fSelectAllDataset.Open;
  try
    fSelectAllDataset.First;
    while not fSelectAllDataset.Eof do begin
      Dest.Add(fSelectAllDataset.Fields[0].Value);
      fSelectAllDataset.Next;
    end;
  finally
    fSelectAllDataset.Close;
  end;
end;

procedure TRODBSessionManager.SetSelectAllDataset(const Value: TDataSet);
begin
  fSelectAllDataset := Value;
  if (Value<>NIL) then Value.FreeNotification(Self);
end;

function TRODBSessionManager.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 TRODBSessionManager.CheckProperties;
begin
  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(InsertDataset = nil, Name + '.InsertDataset must be assigned.');
  Check(DeleteDataset = nil, Name + '.DeleteDataset must be assigned.');
  Check(UpdateDataset = nil, Name + '.UpdateDataset must be assigned.');
  Check(SelectDataset = nil, Name + '.SelectDataset must be assigned.');
  Check(GetCountDataset = nil, Name + '.GetCountDataset must be assigned.');
  Check(ClearSessionsDataset = nil, Name + '.ClearSessionsDataset must be assigned.');
  Check(SelectAllDataset = nil, Name + '.SelectAllDataset must be assigned.');
end;

procedure TRODBSessionManager.DoDatasetExecute(aDataset: TDataset;
  aProvider: IProviderSupport);
begin
  if Assigned(fOnDatasetExecute) then
    fOnDatasetExecute(Self,aDataset)
  else if aProvider <> nil then
    aProvider.PSExecute
  else
    raise Exception.CreateFmt('The %s.OnDatasetExecute event must be defined or %s should support IProviderSupport interface',[Self.Name, aDataset.Name]);
end;

function TRODBSessionManager.DoDatasetGetParams(aDataset: TDataset;
  aProvider: IProviderSupport): TParams;
begin
  if Assigned(fOnDatasetGetParams) then
    Result := fOnDatasetGetParams(Self, aDataset)
  else if aProvider <> nil then
    Result := aProvider.PSGetParams
  else
    raise Exception.CreateFmt('The %s.OnDatasetGetParams event must be defined or %s should support IProviderSupport interface',[Self.Name, aDataset.Name]);
end;

procedure TRODBSessionManager.DoDatasetSetParams(aDataset: TDataset;
  aProvider: IProviderSupport; AParams: TParams);
begin
  if Assigned(fOnDatasetSetParams) then
    fOnDatasetSetParams(Self, aDataset, AParams)
  else if aProvider <> nil then
    aProvider.PSSetParams(AParams)
  else
    raise Exception.CreateFmt('The %s.OnDatasetSetParams event must be defined or %s should support IProviderSupport interface',[Self.Name, aDataset.Name]);
end;

end.