mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-22 19:09:40 +02:00
fcl-base: added serviceworkerapp.pas
This commit is contained in:
mattias
parent
0a0e7a11a1
commit
03efe9d17b
@ -30,6 +30,9 @@
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="fcl_base_pas2js"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="pas2js_rtl"/>
|
||||
</Item>
|
||||
|
||||
@ -3,14 +3,30 @@ program ServiceWorker;
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
JS, Web, Types;
|
||||
JS, Web, Types, ServiceWorkerApp;
|
||||
|
||||
const
|
||||
CacheName = 'v5';
|
||||
YourCacheName = 'v5';
|
||||
|
||||
FallbackURL = '/images/error.png';
|
||||
type
|
||||
|
||||
Resources: array[0..12] of string = (
|
||||
{ TApplication }
|
||||
|
||||
TApplication = class(TServiceWorkerApplication)
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
end;
|
||||
|
||||
var
|
||||
App: TApplication;
|
||||
|
||||
{ TApplication }
|
||||
|
||||
procedure TApplication.DoRun;
|
||||
begin
|
||||
FCacheName:=YourCacheName;
|
||||
FResources:=[
|
||||
'/index.html',
|
||||
'/css/style.css',
|
||||
'/SimplePWA1.js',
|
||||
@ -23,112 +39,12 @@ const
|
||||
'/images/Eta.png',
|
||||
'/images/Theta.png',
|
||||
'/images/Iota.png',
|
||||
'/images/error.png'
|
||||
);
|
||||
|
||||
procedure PutInCache(Request: TJSRequest; Response: TJSResponse); async;
|
||||
var
|
||||
Cache: TJSCache;
|
||||
begin
|
||||
Cache := await(TJSCache,Caches.open(CacheName));
|
||||
await(TJSCache,Cache.put(Request, Response));
|
||||
end;
|
||||
|
||||
function CacheFirst(Request: TJSRequest; PreloadResponsePromise: TJSPromise;
|
||||
FallbackUrl: string): jsvalue; async;
|
||||
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;
|
||||
|
||||
// Enable navigation preload
|
||||
function EnableNavigationPreload: jsvalue; async;
|
||||
begin
|
||||
Result:=nil;
|
||||
if jsvalue(serviceWorker.registration.navigationPreload) then
|
||||
// Enable navigation preloads!
|
||||
await(serviceWorker.registration.navigationPreload.enable());
|
||||
end;
|
||||
|
||||
procedure DeleteCache(key: string); async;
|
||||
begin
|
||||
await(boolean,caches.delete(key));
|
||||
end;
|
||||
|
||||
function DeleteOldCaches: jsvalue; async;
|
||||
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))));
|
||||
'/images/error.png' ];
|
||||
FallbackURL := '/images/error.png';
|
||||
inherited DoRun;
|
||||
end;
|
||||
|
||||
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);
|
||||
App:=TApplication.Create(nil);
|
||||
App.Run;
|
||||
end.
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<Package Version="5">
|
||||
<Name Value="fcl_base_pas2js"/>
|
||||
<Type Value="RunTimeOnly"/>
|
||||
<Author Value="Mattias Gaertner"/>
|
||||
@ -30,7 +30,7 @@
|
||||
Port to pas2js."/>
|
||||
<License Value="Modified LGPL-2"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="4">
|
||||
<Files Count="5">
|
||||
<Item1>
|
||||
<Filename Value="custapp.pas"/>
|
||||
<UnitName Value="custapp"/>
|
||||
@ -47,7 +47,12 @@ Port to pas2js."/>
|
||||
<Filename Value="fpexprpars.pas"/>
|
||||
<UnitName Value="fpexprpars"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="serviceworkerapp.pas"/>
|
||||
<UnitName Value="ServiceWorkerApp"/>
|
||||
</Item5>
|
||||
</Files>
|
||||
<CompatibilityMode Value="True"/>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
|
||||
271
packages/fcl-base/serviceworkerapp.pas
Normal file
271
packages/fcl-base/serviceworkerapp.pas
Normal file
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user