|
@@ -0,0 +1,271 @@
|
|
|
+unit ServiceWorkerApp;
|
|
|
+
|
|
|
+{$mode objfpc}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+uses
|
|
|
+ Classes, SysUtils, Types, JS, web, CustApp;
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ { TServiceWorkerApplication }
|
|
|
+
|
|
|
+ TServiceWorkerApplication = class(TCustomApplication)
|
|
|
+ private
|
|
|
+ FFallbackURL: string;
|
|
|
+ protected
|
|
|
+ FCacheName: string;
|
|
|
+ FResources: TStringDynArray;
|
|
|
+ procedure PutInCache(Request: TJSRequest; Response: TJSResponse); async; virtual;
|
|
|
+ function CacheFirst(Request: TJSRequest; PreloadResponsePromise: TJSPromise;
|
|
|
+ FallbackUrl: string): jsvalue; async; virtual;
|
|
|
+ function EnableNavigationPreload: jsvalue; async; virtual;
|
|
|
+ procedure DeleteCache(key: string); async; virtual;
|
|
|
+ function DeleteOldCaches: jsvalue; async; virtual;
|
|
|
+ procedure SetFallbackURL(const AValue: string); virtual;
|
|
|
+ procedure DoRun; override;
|
|
|
+
|
|
|
+ function GetConsoleApplication: boolean; override;
|
|
|
+ function LogGetElementErrors : Boolean; virtual;
|
|
|
+ function GetLocation: String; override;
|
|
|
+ public
|
|
|
+ procedure GetEnvironmentList(List: TStrings; NamesOnly: Boolean); override;
|
|
|
+ procedure ShowException(E: Exception); override;
|
|
|
+ procedure HandleException(Sender: TObject); override;
|
|
|
+
|
|
|
+ property CacheName: string read FCacheName;
|
|
|
+ property FallbackURL: string read FFallbackURL write SetFallbackURL;
|
|
|
+ property Resources: TStringDynArray read FResources;
|
|
|
+ end;
|
|
|
+
|
|
|
+procedure ReloadEnvironmentStrings;
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+var
|
|
|
+ EnvNames: TJSObject;
|
|
|
+
|
|
|
+procedure ReloadEnvironmentStrings;
|
|
|
+
|
|
|
+var
|
|
|
+ I : Integer;
|
|
|
+ S,N : String;
|
|
|
+ A,P : TStringDynArray;
|
|
|
+begin
|
|
|
+ if Assigned(EnvNames) then
|
|
|
+ FreeAndNil(EnvNames);
|
|
|
+ EnvNames:=TJSObject.new;
|
|
|
+ S:=Window.Location.search;
|
|
|
+ S:=Copy(S,2,Length(S)-1);
|
|
|
+ A:=TJSString(S).split('&');
|
|
|
+ for I:=0 to Length(A)-1 do
|
|
|
+ begin
|
|
|
+ P:=TJSString(A[i]).split('=');
|
|
|
+ N:=LowerCase(decodeURIComponent(P[0]));
|
|
|
+ if Length(P)=2 then
|
|
|
+ EnvNames[N]:=decodeURIComponent(P[1])
|
|
|
+ else if Length(P)=1 then
|
|
|
+ EnvNames[N]:=''
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function MyGetEnvironmentVariable(Const EnvVar: String): String;
|
|
|
+
|
|
|
+Var
|
|
|
+ aName : String;
|
|
|
+
|
|
|
+begin
|
|
|
+ aName:=Lowercase(EnvVar);
|
|
|
+ if EnvNames.hasOwnProperty(aName) then
|
|
|
+ Result:=String(EnvNames[aName])
|
|
|
+ else
|
|
|
+ Result:='';
|
|
|
+end;
|
|
|
+
|
|
|
+function MyGetEnvironmentVariableCount: Integer;
|
|
|
+begin
|
|
|
+ Result:=length(TJSOBject.getOwnPropertyNames(envNames));
|
|
|
+end;
|
|
|
+
|
|
|
+function MyGetEnvironmentString(Index: Integer): String;
|
|
|
+begin
|
|
|
+ Result:=String(EnvNames[TJSOBject.getOwnPropertyNames(envNames)[Index]]);
|
|
|
+end;
|
|
|
+
|
|
|
+{ TServiceWorkerApplication }
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.SetFallbackURL(const AValue: string);
|
|
|
+begin
|
|
|
+ if FFallbackURL=AValue then Exit;
|
|
|
+ FFallbackURL:=AValue;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.PutInCache(Request: TJSRequest;
|
|
|
+ Response: TJSResponse);
|
|
|
+var
|
|
|
+ Cache: TJSCache;
|
|
|
+begin
|
|
|
+ Cache := await(TJSCache,Caches.open(CacheName));
|
|
|
+ await(TJSCache,Cache.put(Request, Response));
|
|
|
+end;
|
|
|
+
|
|
|
+function TServiceWorkerApplication.CacheFirst(Request: TJSRequest;
|
|
|
+ PreloadResponsePromise: TJSPromise; FallbackUrl: string): jsvalue;
|
|
|
+var
|
|
|
+ ResponseFromCache, PreloadResponse, ResponseFromNetwork, FallbackResponse: TJSResponse;
|
|
|
+begin
|
|
|
+ Result:=nil;
|
|
|
+
|
|
|
+ // First try to get the resource from the cache
|
|
|
+ ResponseFromCache := await(TJSResponse,caches.match(Request));
|
|
|
+ if Assigned(ResponseFromCache) then
|
|
|
+ exit(ResponseFromCache);
|
|
|
+
|
|
|
+ // Next try to use (and cache) the preloaded response, if it's there
|
|
|
+ PreloadResponse := await(TJSResponse,PreloadResponsePromise);
|
|
|
+ if Assigned(PreloadResponse) then
|
|
|
+ begin
|
|
|
+ console.info('using preload response: '+String(JSValue(PreloadResponse)));
|
|
|
+ putInCache(Request, PreloadResponse.clone());
|
|
|
+ exit(PreloadResponse);
|
|
|
+ end;
|
|
|
+
|
|
|
+ // Next try to get the resource from the network
|
|
|
+ try
|
|
|
+ ResponseFromNetwork := await(TJSResponse,window.fetch(Request));
|
|
|
+ // response may be used only once
|
|
|
+ // we need to save clone to put one copy in cache
|
|
|
+ // and serve second one
|
|
|
+ PutInCache(Request, ResponseFromNetwork.clone());
|
|
|
+ exit(ResponseFromNetwork);
|
|
|
+ except
|
|
|
+ FallbackResponse := await(TJSResponse,caches.match(FallbackUrl));
|
|
|
+ if Assigned(FallbackResponse) then
|
|
|
+ exit(FallbackResponse);
|
|
|
+
|
|
|
+ // when even the fallback response is not available,
|
|
|
+ // there is nothing we can do, but we must always
|
|
|
+ // return a Response object
|
|
|
+ Result:=TJSResponse.new('Network error happened', js.new([
|
|
|
+ 'status', 408,
|
|
|
+ 'headers',
|
|
|
+ js.new(['Content-Type', 'text/plain' ])
|
|
|
+ ]) );
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TServiceWorkerApplication.EnableNavigationPreload: jsvalue;
|
|
|
+begin
|
|
|
+ Result:=nil;
|
|
|
+ if jsvalue(serviceWorker.registration.navigationPreload) then
|
|
|
+ // Enable navigation preloads!
|
|
|
+ await(serviceWorker.registration.navigationPreload.enable());
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.DeleteCache(key: string);
|
|
|
+begin
|
|
|
+ await(boolean,caches.delete(key));
|
|
|
+end;
|
|
|
+
|
|
|
+function TServiceWorkerApplication.DeleteOldCaches: jsvalue;
|
|
|
+var
|
|
|
+ CacheKeepList: TStringDynArray;
|
|
|
+ CachesToDelete, KeyList: TJSArray;
|
|
|
+begin
|
|
|
+ CacheKeepList := [CacheName];
|
|
|
+ KeyList := await(TJSArray,caches.keys());
|
|
|
+ CachesToDelete := keyList.filter(
|
|
|
+ function (key: JSValue; index: NativeInt; anArray : TJSArray) : Boolean
|
|
|
+ begin
|
|
|
+ Result:=not TJSArray(CacheKeepList).includes(key);
|
|
|
+ end);
|
|
|
+ Result:=await(jsvalue,TJSPromise.all(CachesToDelete.map(TJSArrayMapEvent(@DeleteCache))));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.DoRun;
|
|
|
+begin
|
|
|
+ ServiceWorker.addEventListener('activate', procedure(Event: TJSExtendableEvent)
|
|
|
+ begin
|
|
|
+ Event.waitUntil(EnableNavigationPreload());
|
|
|
+ Event.waitUntil(DeleteOldCaches());
|
|
|
+ end);
|
|
|
+
|
|
|
+ ServiceWorker.addEventListener('install', procedure(Event: TJSExtendableEvent)
|
|
|
+ begin
|
|
|
+ Event.waitUntil(
|
|
|
+ Caches.Open(CacheName)._then(
|
|
|
+ TJSPromiseResolver(procedure(Cache: TJSCache)
|
|
|
+ begin
|
|
|
+ Cache.addAll(Resources);
|
|
|
+ end))
|
|
|
+ );
|
|
|
+ end);
|
|
|
+
|
|
|
+ ServiceWorker.addEventListener('fetch', procedure(FetchEvent: TJSFetchEvent)
|
|
|
+ begin
|
|
|
+ FetchEvent.RespondWith(CacheFirst(FetchEvent.request,
|
|
|
+ FetchEvent.PreloadResponse,FallbackURL) );
|
|
|
+ end);
|
|
|
+end;
|
|
|
+
|
|
|
+function TServiceWorkerApplication.GetConsoleApplication: boolean;
|
|
|
+begin
|
|
|
+ Result:=true;
|
|
|
+end;
|
|
|
+
|
|
|
+function TServiceWorkerApplication.LogGetElementErrors: Boolean;
|
|
|
+begin
|
|
|
+ Result:=True;
|
|
|
+end;
|
|
|
+
|
|
|
+function TServiceWorkerApplication.GetLocation: String;
|
|
|
+begin
|
|
|
+ Result:='';
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.GetEnvironmentList(List: TStrings;
|
|
|
+ NamesOnly: Boolean);
|
|
|
+var
|
|
|
+ Names: TStringDynArray;
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ Names:=TJSObject.getOwnPropertyNames(EnvNames);
|
|
|
+ for i:=0 to length(Names)-1 do
|
|
|
+ begin
|
|
|
+ if NamesOnly then
|
|
|
+ List.Add(Names[i])
|
|
|
+ else
|
|
|
+ List.Add(Names[i]+'='+String(EnvNames[Names[i]]));
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.ShowException(E: Exception);
|
|
|
+
|
|
|
+Var
|
|
|
+ S : String;
|
|
|
+
|
|
|
+begin
|
|
|
+ if (E<>nil) then
|
|
|
+ S:=E.ClassName+': '+E.Message
|
|
|
+ else if ExceptObjectJS then
|
|
|
+ s:=TJSObject(ExceptObjectJS).toString;
|
|
|
+ window.alert('Unhandled exception caught:'+S);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TServiceWorkerApplication.HandleException(Sender: TObject);
|
|
|
+begin
|
|
|
+ if ExceptObject is Exception then
|
|
|
+ ShowException(ExceptObject);
|
|
|
+ inherited HandleException(Sender);
|
|
|
+end;
|
|
|
+
|
|
|
+initialization
|
|
|
+ IsConsole:=true;
|
|
|
+ ReloadEnvironmentStrings;
|
|
|
+ OnGetEnvironmentVariable:=@MyGetEnvironmentVariable;
|
|
|
+ OnGetEnvironmentVariableCount:=@MyGetEnvironmentVariableCount;
|
|
|
+ OnGetEnvironmentString:=@MyGetEnvironmentString;
|
|
|
+
|
|
|
+end.
|
|
|
+
|