{ This file is part of the Pas2JS run time library. Copyright (c) 2023 by Michael Van Canneyt Low-level Pas2JS resource handling. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$IFNDEF FPC_DOTTEDUNITS} unit p2jsres; {$ENDIF} {$mode objfpc} {$h+} {$modeswitch externalclass} interface {$IFDEF FPC_DOTTEDUNITS} uses System.Types; {$ELSE} uses types; {$ENDIF} Type TResourceSource = (rsJS,rsHTML); TResourceInfo = record name : string; encoding : string; resourceunit : string; format : string; data : string; end; TResourceEnumCallBack = Reference to function(const resName : string) : boolean; TResourcesLoadedEnumCallBack = Reference to Procedure(const LoadedResources : Array of String); TResourcesLoadErrorCallBack = Reference to Procedure(const aError : string); Function SetResourceSource(aSource : TResourceSource) : TResourceSource; Function GetResourceNames : TStringDynArray; Function GetResourceNames(aSource : TResourceSource) : TStringDynArray; Function EnumResources(aCallback : TResourceEnumCallBack) : Integer; Function EnumResources(aSource : TResourceSource; aCallback : TResourceEnumCallBack) : Integer; Function GetResourceInfo(Const aName : String; var aInfo : TResourceInfo) : Boolean; Function GetResourceInfo(aSource : TResourceSource; Const aName : String; var aInfo : TResourceInfo) : Boolean; Procedure LoadHTMLLinkResources(const aURL : String; OnLoad : TResourcesLoadedEnumCallBack = Nil; OnError : TResourcesLoadErrorCallBack = Nil); implementation Uses {$IFDEF FPC_DOTTEDUNITS} System.SysUtils, JSApi.JS, BrowserApi.Web; {$ELSE} sysutils, js, web; {$ENDIF} var gMode: TResourceSource; { --------------------------------------------------------------------- Global entry points ---------------------------------------------------------------------} Function SeTResourceSource(aSource : TResourceSource) : TResourceSource; begin Result:=gMode; gMode:=aSource; end; Function GetResourceNames : TStringDynArray; begin Result:=GetResourceNames(gMode); end; Function EnumResources(aCallback : TResourceEnumCallBack) : Integer; begin Result:=EnumResources(gMode,aCallback); end; Function GetResourceInfo(Const aName : String; var aInfo : TResourceInfo) : Boolean; begin Result:=GetResourceInfo(gMode,aName,aInfo); end; { --------------------------------------------------------------------- JS resources ---------------------------------------------------------------------} Type TRTLResourceInfo = class external name 'Object' (TJSObject) name : string; encoding : string; resourceunit : string; external name 'unit'; format : string; data : string; end; function rtlGetResourceList : TStringDynArray; external name 'rtl.getResourceList'; function rtlGetResource(const aName : string) : TRTLResourceInfo; external name 'rtl.getResource'; Function GetRTLResourceInfo(Const aName : String; var aInfo : TResourceInfo) : Boolean; Var RTLInfo : TRTLResourceInfo; begin RTLInfo:=rtlGetResource(lowercase(aName)); Result:=Assigned(RTLInfo); if Result then begin aInfo.name:=RTLinfo.name; aInfo.encoding:=RTLinfo.encoding; aInfo.format:=RTLinfo.format; aInfo.resourceunit:=RTLinfo.resourceunit; aInfo.data:=RTLinfo.data; end; end; { --------------------------------------------------------------------- HTML resources ---------------------------------------------------------------------} Const IDPrefix = 'resource-'; Function IsResourceLink(L : TJSHTMLLinkElement) : Boolean; begin Result:=(Copy(L.id,1,Length(IDPrefix))=IDPrefix) and (isDefined(L.Dataset['unit'])) and (Copy(L.href,1,4)='data') end; Function GetHTMLResources : TStringDynArray; Var LC : TJSHTMLCollection; L : TJSHTMLLinkElement; I : Integer; ID : String; begin SetLength(Result,0); if not isDefined(document) then // If called in Node... exit; // No cache, we do this dynamically: it's possible to add link nodes at runtime. LC:=document.getElementsByTagName('link'); For I:=0 to LC.length-1 do begin L:=TJSHTMLLinkElement(LC[i]); ID:=L.ID; if IsResourceLink(L) then begin Delete(ID,1,Length(IDPrefix)); if (ID<>'') then TJSArray(Result).Push(ID); end; end; end; Function GetHTMLResourceInfo(Const aName : String; var aInfo : TResourceInfo) : Boolean; Var el : TJSElement; L : TJSHTMLLinkElement absolute el; S : String; I : Integer; begin Result:=False; if not isDefined(document) then // If called in Node... exit; El:=document.getElementByID(IDPrefix+lowercase(aName)); Result:=assigned(el) and SameText(el.tagName,'link'); if not Result then exit; ainfo.name:=lowercase(aName); ainfo.Resourceunit:=String(L.Dataset['unit']); S:=L.href; S:=Copy(S,6,Length(S)-5); // strip data; I:=Pos(',',S); aInfo.data:=Copy(S,I+1,Length(S)-1); S:=copy(S,1,I-1); I:=Pos(';',S); if I=0 then aInfo.encoding:='' else begin aInfo.encoding:=Copy(S,I+1,Length(S)-1); S:=Copy(S,1,I-1); end; aInfo.Format:=S; end; Function HasTemplate : Boolean; begin asm return ('content' in document.createElement('template')) end; Result:=false; end; Procedure LoadHTMLLinkResources(const aURL : String; OnLoad : TResourcesLoadedEnumCallBack = Nil; OnError : TResourcesLoadErrorCallBack = Nil); function FetchOK(Res : JSValue) : JSValue; var Response : TJSResponse absolute res; begin Result:=Nil; if not Response.ok then begin if Assigned(OnError) then Raise TJSError.New('HTTP Error for URL aURL, status = '+IntToStr(Response.status)+' : '+Response.statusText) end else Result:=Response.Text(); end; function BlobOK(Res : JSValue) : JSValue; Var aText : String absolute res; ID : String; Tmpl : TJSHTMLTemplateElement; El : TJSHTMLElement; L : TJSHTMLLinkElement absolute El; Arr : TStringDynArray; aParent : TJSHTMLElement; begin Result:=Nil; aParent:=TJSHTMLElement(document.head); if aParent=Nil then aParent:=TJSHTMLElement(document.body); SetLength(Arr,0); Tmpl:=TJSHTMLTemplateElement(Document.createElement('template')); Tmpl.innerhtml:=TJSString(aText).trim; el:=TJSHTMLElement(Tmpl.Content.firstElementChild); While El<>Nil do begin if SameText(El.tagName,'link') and IsResourceLink(L) then begin aParent.Append(TJSHTMLElement(document.importNode(l,true))); ID:=L.ID; Delete(ID,1,Length(IDPrefix)); if (ID<>'') then TJSArray(Arr).Push(ID); end; el:=TJSHTMLElement(el.nextElementSibling); end; if Assigned(OnLoad) then OnLoad(Arr); end; function DoError (aValue : JSValue) : JSValue; Var aErr : TJSError absolute aValue; begin Result:=Nil; if Assigned(OnError) then if aErr=Nil then OnError('Error: ' + aErr.message) end; begin if not HasTemplate then begin if Assigned(OnError) then OnError('No template support in this browser') end else window.fetch(aURL)._then(@FetchOK)._then(@BlobOK).catch(@doError); end; { --------------------------------------------------------------------- Global entries, specifying resource mode ---------------------------------------------------------------------} Function GetResourceNames(aSource : TResourceSource) : TStringDynArray; begin case aSource of rsJS : Result:=rtlGetResourceList; rsHTML : Result:=GetHTMLResources; end; end; Function EnumResources(aSource : TResourceSource; aCallback : TResourceEnumCallBack) : Integer; Var RL : TStringDynArray; I : Integer; ContinueEnum : Boolean; begin Result:=0; RL:=GetResourceNames(aSource); I:=0; Result:=Length(RL); ContinueEnum:=True; While (I