fcl-base: added serviceworkerapp.pas

demo/pwa/ServiceWorker.lpi

@@ -30,6 +30,9 @@
       <FormatVersion Value="2"/>
     </RunParams>
     <RequiredPackages>
+      <Item>
+        <PackageName Value="fcl_base_pas2js"/>
+      </Item>
       <Item>
         <PackageName Value="pas2js_rtl"/>
       </Item>

demo/pwa/ServiceWorker.lpr

@@ -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'
+    '/images/error.png' ];
-    );
+  FallbackURL := '/images/error.png';
-
+  inherited DoRun;
-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))));
 end;
 
 begin
-  ServiceWorker.addEventListener('activate', procedure(Event: TJSExtendableEvent)
+  App:=TApplication.Create(nil);
-    begin
+  App.Run;
-      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.

packages/fcl-base/fcl_base_pas2js.lpk

@@ -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>

packages/fcl-base/serviceworkerapp.pas

@@ -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.
+