From 4363c0b2292dd11aee5a1cbfb12c9853329bad1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Fri, 3 Nov 2023 17:09:28 +0100 Subject: [PATCH] * Add system.analytics for Delphi compatibility --- packages/vcl-compat/fpmake.pp | 1 + packages/vcl-compat/src/system.analytics.pp | 166 +++++++++++++ packages/vcl-compat/tests/testcompat.lpi | 4 + packages/vcl-compat/tests/testcompat.lpr | 2 +- packages/vcl-compat/tests/utcanalytics.pas | 256 ++++++++++++++++++++ 5 files changed, 428 insertions(+), 1 deletion(-) create mode 100755 packages/vcl-compat/src/system.analytics.pp create mode 100644 packages/vcl-compat/tests/utcanalytics.pas diff --git a/packages/vcl-compat/fpmake.pp b/packages/vcl-compat/fpmake.pp index f8d0f45964..55b0209035 100644 --- a/packages/vcl-compat/fpmake.pp +++ b/packages/vcl-compat/fpmake.pp @@ -43,6 +43,7 @@ begin T:=P.Targets.AddUnit('system.ioutils.pp'); T.ResourceStrings := True; T:=P.Targets.AddUnit('system.devices.pp'); + T:=P.Targets.AddUnit('system.analytics.pp'); {$ifndef ALLPACKAGES} diff --git a/packages/vcl-compat/src/system.analytics.pp b/packages/vcl-compat/src/system.analytics.pp new file mode 100755 index 0000000000..0c56416630 --- /dev/null +++ b/packages/vcl-compat/src/system.analytics.pp @@ -0,0 +1,166 @@ +unit System.Analytics; + +{$MODE OBJFPC} +{$SCOPEDENUMS ON} + +interface + +{$IFDEF FPC_DOTTEDUNITS} +uses + System.SysUtils, System.Contnrs, System.Classes; +{$ELSE} +uses + sysutils, contnrs, classes; +{$ENDIF} + + +type + IApplicationActivityCacheManager = interface ['{6145E812-8ECA-4B69-994C-26A81B2A84DC}'] + function GetCacheCount: Integer; + procedure PersistData(const Wait: Boolean); + procedure ClearData; + procedure Log(const AMessage: string); + procedure RemoveEventAtIndex(const Index: Integer); + function GetEventAtIndex(const Index: Integer): string; + procedure SetOnDataCacheFull(const AValue: TNotifyEvent); + function GetOnDataCacheFull: TNotifyEvent; + procedure SetMaxCacheSize(const AValue: Integer); + function GetMaxCacheSize: Integer; + property CacheCount: Integer read GetCacheCount; + property MaxCacheSize: Integer read GetMaxCacheSize write SetMaxCacheSize; + property Event[const Index: Integer]: string read GetEventAtIndex; + property OnDataCacheFull: TNotifyEvent read GetOnDataCacheFull write SetOnDataCacheFull; + end; + + IAppAnalyticsStartupDataRecorder = interface ['{783ED8DB-86BC-41C7-BBD3-443C19468FF1}'] + procedure AddEnvironmentField(const AKey, AValue: string); + end; + + + IApplicationActivityListener = interface ['{A67DE237-F274-4028-AAC8-DA0BDA0D5D78}'] + procedure TrackAppStart(const aTimeStamp: TDateTime); + procedure TrackAppExit(const aTimeStamp: TDateTime); + procedure TrackControlFocused(const aTimeStamp: TDateTime; const aSender: TObject); + procedure TrackWindowActivated(const aTimeStamp: TDateTime; const aSender: TObject); + procedure TrackEvent(const aTimeStamp: TDateTime; const aSender, aContext: TObject); + procedure TrackException(const aTimeStamp: TDateTime; const E: Exception); + end; + + + TAppActivity = (AppStart, AppExit, ControlFocused, WindowActivated, Exception, Custom); + TAppActivityOptions = set of TAppActivity; + + TAnalyticsManager = class + private + FClients: TInterfaceList; + function GetTrackingEnabled: Boolean; + function GetClientCount : Integer; + function GetClient(aIndex : Integer) : IApplicationActivityListener; + Protected + Property Clients[aIndex : Integer] : IApplicationActivityListener Read GetClient; + Property ClientCount : Integer Read GetClientCount; + public + destructor Destroy; override; + procedure RegisterActivityListener(const aListener: IApplicationActivityListener); + procedure UnregisterActivityListener(const aListener: IApplicationActivityListener); + procedure RecordActivity(const aActivity: TAppActivity); overload; + procedure RecordActivity(const aActivity: TAppActivity; const aSender: TObject); overload; + procedure RecordActivity(const aActivity: TAppActivity; const aSender: TObject; const aContext: TObject); overload; + property TrackingEnabled: Boolean read GetTrackingEnabled; + end; + + EAnalyticsInitializationFailed = class(Exception); + +implementation + +{ TAnalyticsManager } + +destructor TAnalyticsManager.Destroy; +begin + FreeAndNil(FClients); + inherited; +end; + +function TAnalyticsManager.GetClientCount : Integer; + +begin + if not assigned(FClients) then + Result:=0 + else + Result:=FClients.Count; +end; + +function TAnalyticsManager.GetClient(aIndex : Integer) : IApplicationActivityListener; + +begin + if not Assigned(FClients) then + Raise EListError.Create('Index (%d) out of bounds'); + Result:=(FClients[aIndex]) as IApplicationActivityListener; +end; + +procedure TAnalyticsManager.RecordActivity(const aActivity: TAppActivity); +begin + RecordActivity(aActivity,nil,nil); +end; + +procedure TAnalyticsManager.RecordActivity(const aActivity: TAppActivity; const aSender: TObject); +begin + RecordActivity(aActivity,aSender,nil); +end; + +function TAnalyticsManager.GetTrackingEnabled: Boolean; +begin + Result:=(ClientCount>0) +end; + +procedure TAnalyticsManager.RecordActivity(const aActivity: TAppActivity; const aSender,aContext: TObject); + +var + I : Integer; + TS : TDateTime; + A : IApplicationActivityListener; + +begin + if ClientCount=0 then + exit; + TS:=Now; + for I:=0 to ClientCount-1 do + begin + A:=Clients[I]; + case aActivity of + TAppActivity.AppStart: + A.TrackAppStart(Ts); + TAppActivity.AppExit: + A.TrackAppExit(Ts); + TAppActivity.ControlFocused: + A.TrackControlFocused(Ts,aSender); + TAppActivity.WindowActivated: + A.TrackWindowActivated(Ts,aSender); + TAppActivity.Exception: + if aSender is Exception then + A.TrackException(Ts,Exception(aSender)); + TAppActivity.Custom: + A.TrackEvent(Ts,aSender,aContext); + end; + A:=Nil; + end; +end; + +procedure TAnalyticsManager.RegisterActivityListener(const aListener: IApplicationActivityListener); + +begin + if Not Assigned(FClients) then + FClients:=TInterfaceList.Create + else if FClients.IndexOf(aListener)<>-1 then + Exit; + FClients.Add(aListener); +end; + + +procedure TAnalyticsManager.UnregisterActivityListener(const aListener: IApplicationActivityListener); +begin + if Assigned(FClients) then + FClients.Remove(aListener); +end; + +end. diff --git a/packages/vcl-compat/tests/testcompat.lpi b/packages/vcl-compat/tests/testcompat.lpi index 42f8e80675..261899dd4f 100644 --- a/packages/vcl-compat/tests/testcompat.lpi +++ b/packages/vcl-compat/tests/testcompat.lpi @@ -44,6 +44,10 @@ + + + + diff --git a/packages/vcl-compat/tests/testcompat.lpr b/packages/vcl-compat/tests/testcompat.lpr index fc920ad293..fdb42100e0 100644 --- a/packages/vcl-compat/tests/testcompat.lpr +++ b/packages/vcl-compat/tests/testcompat.lpr @@ -4,7 +4,7 @@ program testcompat; uses {$IFDEF UNIX}cwstring,{$ENDIF} - Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices; + Classes, consoletestrunner, tcnetencoding, tciotuils, utmessagemanager, utcdevices, utcanalytics; type diff --git a/packages/vcl-compat/tests/utcanalytics.pas b/packages/vcl-compat/tests/utcanalytics.pas new file mode 100644 index 0000000000..aafb64ec44 --- /dev/null +++ b/packages/vcl-compat/tests/utcanalytics.pas @@ -0,0 +1,256 @@ +unit utcanalytics; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testutils, testregistry, system.analytics; + +type + + { TListener } + + TListener = Class(TInterfacedObject,IApplicationActivityListener) + private + FLastActivity: TAppActivity; + FLastContext: TObject; + FLastSender: TObject; + FLastTimeStamp: TDateTime; + Protected + procedure TrackAppStart(const TimeStamp: TDateTime); + procedure TrackAppExit(const TimeStamp: TDateTime); + procedure TrackControlFocused(const TimeStamp: TDateTime; const Sender: TObject); + procedure TrackWindowActivated(const TimeStamp: TDateTime; const Sender: TObject); + procedure TrackEvent(const TimeStamp: TDateTime; const Sender, Context: TObject); + procedure TrackException(const TimeStamp: TDateTime; const E: Exception); + Public + Procedure Reset; + Property LastTimestamp : TDateTime Read FLastTimeStamp; + Property LastActivity : TAppActivity Read FLastActivity; + Property LastSender : TObject Read FLastSender; + Property LastContext : TObject Read FLastContext; + end; + + { TTestAnalytics } + + TTestAnalytics= class(TTestCase) + private + FListener: TListener; + FListener2: TListener; + FListenerIntf : IApplicationActivityListener; + FListener2Intf : IApplicationActivityListener; + FManager: TAnalyticsManager; + FTime: TDateTime; + protected + procedure SetUp; override; + procedure TearDown; override; + Procedure Register; + Procedure AssertEquals(const Msg : String; aExpected, aActual : TAppActivity); overload; + procedure AssertEvent(const Msg: String; aListener: TListener; + aActivity: TAppActivity; aSender: TObject = Nil; aContext: TObject = Nil); + property Manager : TAnalyticsManager Read FManager; + Property Listener : TListener Read FListener; + Property Listener2 : TListener Read FListener2; + published + procedure TestHookUp; + procedure TestRegister; + Procedure TestAppStart; + procedure TestAppExit; + procedure TestFocused; + procedure TestWindowActivated; + procedure TestEvent; + procedure TestException; + procedure TestUnRegister; + end; + +implementation + +uses typinfo; + +{ TListener } + +procedure TListener.TrackAppStart(const TimeStamp: TDateTime); +begin + FLastTimeStamp:=TimeStamp; + FLastActivity:=TAppActivity.AppStart; +end; + +procedure TListener.TrackAppExit(const TimeStamp: TDateTime); +begin + FLastTimeStamp:=TimeStamp; + FLastActivity:=TAppActivity.AppExit; +end; + +procedure TListener.TrackControlFocused(const TimeStamp: TDateTime; + const Sender: TObject); +begin + FLastTimeStamp:=TimeStamp; + FLastActivity:=TAppActivity.ControlFocused; + FLastSender:=Sender; + FLastContext:=Nil; +end; + +procedure TListener.TrackWindowActivated(const TimeStamp: TDateTime; + const Sender: TObject); +begin + FLastTimeStamp:=TimeStamp; + FLastActivity:=TAppActivity.WindowActivated; + FLastSender:=Sender; + FLastContext:=Nil; +end; + +procedure TListener.TrackEvent(const TimeStamp: TDateTime; const Sender, + Context: TObject); +begin + FLastTimeStamp:=TimeStamp; + FLastActivity:=TAppActivity.Custom; + FLastSender:=Sender; + FLastContext:=Context; +end; + +procedure TListener.TrackException(const TimeStamp: TDateTime; + const E: Exception); +begin + FLastTimeStamp:=TimeStamp; + FLastActivity:=TAppActivity.Exception; + FLastSender:=E; + FLastContext:=Nil; +end; + +procedure TListener.Reset; +begin + FLastActivity:=Default(TAppActivity); + FLastContext:=Default(TObject); + FLastSender:=Default(TObject); + FLastTimeStamp:=Default(TDateTime); +end; + +procedure TTestAnalytics.TestHookUp; +begin + AssertNotNull('Have manager',Manager); + AssertNotNull('Have listener',Listener); +end; + +procedure TTestAnalytics.TestRegister; +begin + Register; + AssertTrue('Tracking enabled',Manager.TrackingEnabled); +end; + +procedure TTestAnalytics.TestAppStart; +begin + Register; + Manager.RecordActivity(TAppActivity.AppStart); + AssertEvent('Listener 1',Listener,TAppActivity.AppStart); + AssertEvent('Listener 2',Listener2,TAppActivity.AppStart); +end; + +procedure TTestAnalytics.TestAppExit; +begin + Register; + Manager.RecordActivity(TAppActivity.AppExit); + AssertEvent('Listener 1',Listener,TAppActivity.AppExit); + AssertEvent('Listener 2',Listener2,TAppActivity.AppExit); +end; + +procedure TTestAnalytics.TestFocused; +begin + Register; + Manager.RecordActivity(TAppActivity.ControlFocused,Self); + AssertEvent('Listener 1',Listener,TAppActivity.ControlFocused,Self,Nil); + AssertEvent('Listener 2',Listener2,TAppActivity.ControlFocused,Self,Nil); +end; + +procedure TTestAnalytics.TestWindowActivated; +begin + Register; + Manager.RecordActivity(TAppActivity.WindowActivated,Self,Nil); + AssertEvent('Listener 1',Listener,TAppActivity.WindowActivated,Self,Nil); + AssertEvent('Listener 2',Listener2,TAppActivity.WindowActivated,Self,Nil); +end; + +procedure TTestAnalytics.TestEvent; +begin + Register; + Manager.RecordActivity(TAppActivity.Custom,Self,Listener); + AssertEvent('Listener 1',Listener,TAppActivity.Custom,Self,Listener); + AssertEvent('Listener 2',Listener2,TAppActivity.Custom,Self,Listener); +end; + +procedure TTestAnalytics.TestException; + +var + E : Exception; + +begin + Register; + E:=Exception.Create('Soso'); + try + Manager.RecordActivity(TAppActivity.Exception,E); + AssertEvent('Listener 1',Listener,TAppActivity.Exception,E); + AssertEvent('Listener 2',Listener2,TAppActivity.Exception,E); + finally + E.Free; + end; +end; + +procedure TTestAnalytics.TestUnRegister; +begin + Register; + Manager.RecordActivity(TAppActivity.AppExit); + AssertEvent('Listener 1',Listener,TAppActivity.AppExit); + AssertEvent('Listener 2',Listener2,TAppActivity.AppExit); + Manager.UnregisterActivityListener(FListener2Intf); + Listener2.Reset; + Manager.RecordActivity(TAppActivity.AppExit); + AssertEvent('Listener 1',Listener,TAppActivity.AppExit); + AssertEquals('Listener2',0,Listener2.LastTimestamp); +end; + +procedure TTestAnalytics.SetUp; +begin + FManager:=TAnalyticsManager.Create; + FListener:=TListener.Create; + FListenerIntf:=FListener as IApplicationActivityListener; + FListener2:=TListener.Create; + FListener2Intf:=FListener2 as IApplicationActivityListener; +end; + +procedure TTestAnalytics.TearDown; +begin + FreeAndNil(FManager); + // FreeAndNil(FListener); + FListenerIntf:=Nil; // Will free + FListener:=nil; + FListener2Intf:=Nil; // Will free + FListener2:=nil; +end; + +procedure TTestAnalytics.Register; +begin + Manager.RegisterActivityListener(Listener as IApplicationActivityListener); + Manager.RegisterActivityListener(Listener2 as IApplicationActivityListener); + FTime:=Now; +end; + +procedure TTestAnalytics.AssertEquals(const Msg: String; aExpected, aActual: TAppActivity); +begin + AssertEquals(Msg,GetEnumName(TypeInfo(TAppActivity),Ord(aExpected)), + GetEnumName(TypeInfo(TAppActivity),Ord(aActual))); +end; + +procedure TTestAnalytics.AssertEvent(const Msg: String; aListener: TListener; + aActivity: TAppActivity; aSender: TObject; aContext: TObject); +begin + AssertEquals(Msg+' activity',aActivity,aListener.LastActivity); + AssertTrue(Msg+' timestamp',aListener.LastTimestamp>=FTime); + AssertSame(Msg+' sender',aSender,aListener.LastSender); + AssertSame(Msg+' context',aContext,aListener.LastContext); +end; + +initialization + + RegisterTest(TTestAnalytics); +end. +