diff --git a/tools/releasecreator/Pas2jsReleaseCreator.lpi b/tools/releasecreator/Pas2jsReleaseCreator.lpi
index 4e6f3c2..705fdc6 100644
--- a/tools/releasecreator/Pas2jsReleaseCreator.lpi
+++ b/tools/releasecreator/Pas2jsReleaseCreator.lpi
@@ -38,6 +38,11 @@
+
+
+
+
+
diff --git a/tools/releasecreator/Pas2jsReleaseCreator.lpr b/tools/releasecreator/Pas2jsReleaseCreator.lpr
index 1ffcb6b..6622351 100644
--- a/tools/releasecreator/Pas2jsReleaseCreator.lpr
+++ b/tools/releasecreator/Pas2jsReleaseCreator.lpr
@@ -8,8 +8,8 @@ uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
- LazUTF8, Classes, SysUtils, Types, CustApp, IniFiles, process, LazFileUtils,
- FileUtil, FPCAdds, FindWriteln;
+ Classes, SysUtils, Types, CustApp, IniFiles, process,
+ FindWriteln, PRCUtils;
const
DefaultCfgFilename = 'pas2jsrelease.ini';
@@ -67,7 +67,6 @@ type
function GetDefaultGit: string;
function GetDefaultMake: string;
function GetDefaultZip: string;
- function GetLibExt(TargetOS: string = ''): string;
function GetOption_String(ShortOption: char; const LongOption: string): string;
function GetOption_Directory(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
function GetOption_Executable(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
@@ -560,7 +559,7 @@ procedure TPas2jsReleaseCreator.CopySourceFolders;
Log(etInfo,'Simulate: Copying folder "'+SrcDir+'" -> "'+DestDir+'"');
end else begin
Log(etInfo,'Copying folder "'+SrcDir+'" -> "'+DestDir+'"');
- CopyDirTree(SrcDir,DestDir,[cffCreateDestDirectory,cffPreserveTime]);
+ CopyDirTree(SrcDir,DestDir,[cffCreateDestDirectory,cffPreserveTime,cffExceptionOnError]);
end;
end;
@@ -593,8 +592,7 @@ begin
Log(etInfo,'Simulate: Copying "'+SrcFilename+'" -> "'+DestFilename+'"');
end else begin
Log(etInfo,'Copying "'+SrcFilename+'" -> "'+DestFilename+'"');
- if not CopyFile(SrcFilename,DestFilename,[cffOverwriteFile,cffPreserveTime],false) then
- Err('Unable to copy "'+SrcFilename+'" -> "'+DestFilename+'"');
+ CopyFile(SrcFilename,DestFilename,[cffOverwriteFile,cffPreserveTime,cffExceptionOnError]);
end;
end;
@@ -612,7 +610,7 @@ begin
NeedBuild:=true;
if not FileExists(ExeFilename) then
log(etInfo,'Missing tool createconfig, building ...')
- else if FileAge(SrcFilename)>FileAgeUTF8(ExeFilename) then
+ else if FileAge(SrcFilename)>FileAge(ExeFilename) then
log(etInfo,'createconfig.pp changed, building ...')
else
NeedBuild:=false;
@@ -757,7 +755,7 @@ end;
function TPas2jsReleaseCreator.GetDefaultBuildDir: string;
begin
- Result:=AppendPathDelim(ResolveDots(GetTempDir(false)));
+ Result:=AppendPathDelim(ExpandFileName(GetTempDir(false)));
end;
function TPas2jsReleaseCreator.GetDefaultTool(const Filename: string;
@@ -788,36 +786,6 @@ begin
Result:=GetDefaultTool('zip'+GetExeExt,true);
end;
-function TPas2jsReleaseCreator.GetLibExt(TargetOS: string): string;
-begin
- if TargetOS='' then
- TargetOS:=GetCompiledTargetOS;
- TargetOS:=LowerCase(TargetOS);
- if copy(TargetOS,1,3)='win' then
- Result:='.dll'
- else
- case TargetOS of
- 'darwin',
- 'ios':
- Result:='.dylib';
- 'linux',
- 'android',
- 'freebsd',
- 'openbsd',
- 'netbsd',
- 'dragonfly',
- 'haiku':
- Result:='.so';
- 'browser',
- 'nodejs',
- 'electron',
- 'module':
- Result:='.js';
- else
- Result:='';
- end;
-end;
-
function TPas2jsReleaseCreator.GetOption_String(ShortOption: char;
const LongOption: string): string;
begin
diff --git a/tools/releasecreator/prcutils.pas b/tools/releasecreator/prcutils.pas
new file mode 100644
index 0000000..1a40197
--- /dev/null
+++ b/tools/releasecreator/prcutils.pas
@@ -0,0 +1,488 @@
+unit PRCUtils;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ {$IFDEF UNIX}
+ BaseUnix,
+ {$ENDIF}
+ Classes, SysUtils;
+
+function GetCompiledTargetOS: string;
+function GetCompiledTargetCPU: string;
+function GetExeExt: string;
+function GetLibExt(TargetOS: string = ''): string;
+
+function AppendPathDelim(const Path: string): string;
+function ChompPathDelim(const Path: string): string;
+function FilenameIsAbsolute(const TheFilename: string):boolean;
+function FileIsExecutable(const AFilename: string): boolean;
+function FileSize(const Filename: string): int64; overload;
+function FindDefaultExecutablePath(const Executable: string; const BaseDir: string = ''): string;
+
+// file search
+type
+ TSearchFileInPathFlag = (
+ sffDontSearchInBasePath, // do not search in BasePath, search only in SearchPath.
+ sffSearchLoUpCase,
+ sffFile, // must be file, not directory
+ sffExecutable, // file must be executable
+ sffDequoteSearchPath // ansi dequote
+ );
+ TSearchFileInPathFlags = set of TSearchFileInPathFlag;
+const
+ sffFindProgramInPath = [
+ {$IFDEF Unix}sffDontSearchInBasePath,{$ENDIF}
+ {$IFDEF Windows}sffDequoteSearchPath,{$ENDIF}
+ sffFile,
+ sffExecutable
+ ];
+
+function SearchFileInPath(const Filename, BasePath: string;
+ SearchPath: string; const Delimiter: string;
+ Flags: TSearchFileInPathFlags): string; overload;
+
+
+function ForceDirectory(DirectoryName: string): boolean;
+function DeleteDirectory(const DirectoryName: string; OnlyChildren: boolean): boolean;
+
+
+type
+ TCopyFileFlag = (
+ cffOverwriteFile,
+ cffCreateDestDirectory,
+ cffPreserveTime,
+ cffExceptionOnError
+ );
+ TCopyFileFlags = set of TCopyFileFlag;
+
+function CopyFile(const SrcFilename, DestFilename: string;
+ Flags: TCopyFileFlags=[cffOverwriteFile]): boolean;
+function CopyDirTree(SrcDir, DestDir: string; Flags: TCopyFileFlags): boolean;
+
+implementation
+
+function GetCompiledTargetOS: string;
+begin
+ Result:=lowerCase({$I %FPCTARGETOS%});
+end;
+
+function GetCompiledTargetCPU: string;
+begin
+ Result:=lowerCase({$I %FPCTARGETCPU%});
+end;
+
+function GetExeExt: string;
+begin
+ {$IFDEF WINDOWS}
+ Result:='.exe';
+ {$ELSE}
+ Result:='';
+ {$ENDIF}
+end;
+
+function GetLibExt(TargetOS: string): string;
+begin
+ if TargetOS='' then
+ TargetOS:=GetCompiledTargetOS;
+ TargetOS:=LowerCase(TargetOS);
+ if copy(TargetOS,1,3)='win' then
+ Result:='.dll'
+ else
+ case TargetOS of
+ 'darwin',
+ 'ios':
+ Result:='.dylib';
+ 'linux',
+ 'android',
+ 'freebsd',
+ 'openbsd',
+ 'netbsd',
+ 'dragonfly',
+ 'haiku':
+ Result:='.so';
+ 'browser',
+ 'nodejs',
+ 'electron',
+ 'module':
+ Result:='.js';
+ else
+ Result:='';
+ end;
+end;
+
+function AppendPathDelim(const Path: string): string;
+begin
+ if (Path<>'') and not (Path[length(Path)] in AllowDirectorySeparators) then
+ Result:=Path+PathDelim
+ else
+ Result:=Path;
+end;
+
+function ChompPathDelim(const Path: string): string;
+var
+ Len, MinLen: Integer;
+begin
+ Result:=Path;
+ if Path = '' then
+ exit;
+ Len:=length(Result);
+ if (Result[1] in AllowDirectorySeparators) then begin
+ MinLen := 1;
+ {$IFDEF HasUNCPaths}
+ if (Len >= 2) and (Result[2] in AllowDirectorySeparators) then
+ MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
+ {$ENDIF}
+ end
+ else begin
+ MinLen := 0;
+ {$IFdef MSWindows}
+ if (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z']) and
+ (Result[2] = ':') and (Result[3] in AllowDirectorySeparators)
+ then
+ MinLen := 3;
+ {$ENDIF}
+ end;
+
+ while (Len > MinLen) and (Result[Len] in AllowDirectorySeparators) do dec(Len);
+ if Len'') and (TheFilename[1]='/');
+ {$ELSE}
+ Result:=((length(TheFilename)>=3) and
+ (TheFilename[1] in ['A'..'Z','a'..'z']) and (TheFilename[2]=':') and (TheFilename[3]in AllowDirectorySeparators))
+ or ((length(TheFilename)>=2) and (TheFilename[1] in AllowDirectorySeparators) and (TheFilename[2] in AllowDirectorySeparators))
+ ;
+ {$ENDIF}
+end;
+
+function FileIsExecutable(const AFilename: string): boolean;
+{$IFDEF Unix}
+var
+ Info : Stat;
+{$ENDIF}
+begin
+ {$IFDEF Unix}
+ // first check AFilename is not a directory and then check if executable
+ Result:= (FpStat(AFilename,info{%H-})<>-1) and FPS_ISREG(info.st_mode) and
+ (BaseUnix.FpAccess(AFilename,BaseUnix.X_OK)=0);
+ {$ELSE}
+ Result:=FileExists(AFilename);
+ {$ENDIF}
+end;
+
+function FileSize(const Filename: string): int64;
+{$IFDEF Windows}
+var
+ R: TSearchRec;
+begin
+ if SysUtils.FindFirst(FileName, faAnyFile, R) = 0 then
+ begin
+ Result := R.Size;
+ SysUtils.FindClose(R);
+ end
+ else
+ Result := -1;
+end;
+{$ELSE}
+var
+ st: baseunix.stat;
+begin
+ if not fpstat(pointer(FileName),st{%H-})>=0 then
+ exit(-1);
+ Result := st.st_size;
+end;
+{$ENDIF}
+
+function FindDefaultExecutablePath(const Executable: string;
+ const BaseDir: string): string;
+var
+ Env: string;
+begin
+ if FilenameIsAbsolute(Executable) then begin
+ Result:=Executable;
+ if FileExists(Result) then exit;
+ {$IFDEF Windows}
+ if ExtractFileExt(Result)='' then begin
+ Result:=Result+'.exe';
+ if FileExists(Result) then exit;
+ end;
+ {$ENDIF}
+ end else begin
+ Env:=GetEnvironmentVariable('PATH');
+ Result:=SearchFileInPath(Executable, BaseDir, Env, PathSeparator, sffFindProgramInPath);
+ if Result<>'' then exit;
+ {$IFDEF Windows}
+ if ExtractFileExt(Executable)='' then begin
+ Result:=SearchFileInPath(Executable+'.exe', BaseDir, Env, PathSeparator, sffFindProgramInPath);
+ if Result<>'' then exit;
+ end;
+ {$ENDIF}
+ end;
+ Result:='';
+end;
+
+function SearchFileInPath(const Filename, BasePath: string; SearchPath: string;
+ const Delimiter: string; Flags: TSearchFileInPathFlags): string;
+var
+ p, StartPos, l, QuoteStart: integer;
+ CurPath, Base: string;
+begin
+ if (Filename='') then begin
+ Result:='';
+ exit;
+ end;
+ // check if filename absolute
+ if FilenameIsAbsolute(Filename) then begin
+ if FileExists(Filename) then begin
+ Result:=ExpandFilename(Filename);
+ exit;
+ end else begin
+ Result:='';
+ exit;
+ end;
+ end;
+ Base:=AppendPathDelim(ExpandFileName(BasePath));
+ // search in current directory
+ if (not (sffDontSearchInBasePath in Flags)) then begin
+ Result:=ExpandFilename(Base+Filename);
+ if FileExists(Result) then
+ exit;
+ end;
+ // search in search path
+ StartPos:=1;
+ l:=length(SearchPath);
+ while StartPos<=l do begin
+ p:=StartPos;
+ while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do
+ begin
+ if (SearchPath[p]='"') and (sffDequoteSearchPath in Flags) then
+ begin
+ // For example: Windows allows set path=C:\"a;b c"\d;%path%
+ QuoteStart:=p;
+ repeat
+ inc(p);
+ until (p>l) or (SearchPath[p]='"');
+ if p<=l then
+ begin
+ system.delete(SearchPath,p,1);
+ system.delete(SearchPath,QuoteStart,1);
+ dec(l,2);
+ dec(p,2);
+ end;
+ end;
+ inc(p);
+ end;
+ CurPath:=copy(SearchPath,StartPos,p-StartPos);
+ CurPath:=ExpandFileName(CurPath);
+ StartPos:=p+1;
+ if CurPath='' then continue;
+ if not FilenameIsAbsolute(CurPath) then
+ CurPath:=Base+CurPath;
+ Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename);
+ if not FileExists(Result) then
+ continue;
+ if (sffFile in Flags) and DirectoryExists(Result) then
+ continue;
+ if (sffExecutable in Flags) and not FileIsExecutable(Result) then
+ continue;
+ exit;
+ end;
+ Result:='';
+end;
+
+function ForceDirectory(DirectoryName: string): boolean;
+var
+ i: integer;
+ Dir: string;
+begin
+ DirectoryName:=AppendPathDelim(DirectoryName);
+ i:=1;
+ while i<=length(DirectoryName) do begin
+ if DirectoryName[i] in AllowDirectorySeparators then begin
+ // optimize paths like \foo\\bar\\foobar
+ while (i'') and not DirectoryExists(Dir) then begin
+ Result:=CreateDir(Dir);
+ if not Result then exit;
+ end;
+ end;
+ inc(i);
+ end;
+ Result:=true;
+end;
+
+function DeleteDirectory(const DirectoryName: string; OnlyChildren: boolean): boolean;
+const
+ //Don't follow symlinks on *nix, just delete them
+ DeleteMask = faAnyFile {$ifdef unix} or faSymLink{%H-} {$endif unix};
+var
+ FileInfo: TSearchRec;
+ CurSrcDir: String;
+ CurFilename: String;
+begin
+ Result:=false;
+ CurSrcDir:=AppendPathDelim(ExpandFileName(DirectoryName));
+ if FindFirst(CurSrcDir+AllFilesMask,DeleteMask,FileInfo)=0 then begin
+ try
+ repeat
+ // check if special file
+ if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
+ continue;
+ CurFilename:=CurSrcDir+FileInfo.Name;
+ if ((FileInfo.Attr and faDirectory)>0)
+ {$ifdef unix} and ((FileInfo.Attr and faSymLink{%H-})=0) {$endif unix} then begin
+ if not DeleteDirectory(CurFilename,false) then exit;
+ end else begin
+ if not DeleteFile(CurFilename) then exit;
+ end;
+ until FindNext(FileInfo)<>0;
+ finally
+ FindClose(FileInfo);
+ end;
+ end;
+ if (not OnlyChildren) and (not RemoveDir(CurSrcDir)) then exit;
+ Result:=true;
+end;
+
+function CopyFile(const SrcFilename, DestFilename: string; Flags: TCopyFileFlags
+ ): boolean;
+var
+ SrcHandle: THandle;
+ DestHandle: THandle;
+ Buffer: array[1..4096] of byte;
+ ReadCount, WriteCount, TryCount: LongInt;
+begin
+ Result := False;
+ // check overwrite
+ if (not (cffOverwriteFile in Flags)) and FileExists(DestFileName) then begin
+ if cffExceptionOnError in Flags then
+ raise EWriteError.Create('Destination file already exists: '+DestFilename);
+ exit;
+ end;
+ // check directory
+ if (cffCreateDestDirectory in Flags)
+ and (not DirectoryExists(ExtractFilePath(DestFileName)))
+ and (not ForceDirectories(ExtractFilePath(DestFileName))) then begin
+ if cffExceptionOnError in Flags then
+ raise EWriteError.Create('Unable to create directory: '+ExtractFilePath(DestFileName));
+ exit;
+ end;
+ TryCount := 0;
+ While TryCount <> 3 Do Begin
+ SrcHandle := FileOpen(SrcFilename, fmOpenRead or fmShareDenyWrite);
+ if SrcHandle = feInvalidHandle then Begin
+ Inc(TryCount);
+ Sleep(10);
+ End
+ Else Begin
+ TryCount := 0;
+ Break;
+ End;
+ End;
+ If TryCount > 0 Then
+ begin
+ if cffExceptionOnError in Flags then
+ raise EFOpenError.CreateFmt({SFOpenError}'Unable to open file "%s"', [SrcFilename])
+ else
+ exit;
+ end;
+ try
+ DestHandle := FileCreate(DestFileName);
+ if DestHandle = feInvalidHandle then
+ begin
+ if cffExceptionOnError in Flags then
+ raise EFCreateError.CreateFmt({SFCreateError}'Unable to create file "%s"',[DestFileName])
+ else
+ Exit;
+ end;
+ try
+ repeat
+ ReadCount:=FileRead(SrcHandle,Buffer[1],High(Buffer));
+ if ReadCount<=0 then break;
+ WriteCount:=FileWrite(DestHandle,Buffer[1],ReadCount);
+ if WriteCount0 then continue;
+ {$endif unix}
+ SrcFilename:=SrcDir+FileInfo.Name;
+ DestFilename:=DestDir+FileInfo.Name;
+ if FileInfo.Attr and faDirectory>0 then begin
+ CopyDirTree(SrcFilename,DestFilename,Flags+[cffCreateDestDirectory]);
+ end else begin
+ if not CopyFile(SrcFilename, DestFilename, Flags) then
+ exit;
+ end;
+ until FindNext(FileInfo)<>0;
+ finally
+ FindClose(FileInfo);
+ end;
+ end;
+ Result:=true;
+end;
+
+initialization
+ SetMultiByteConversionCodePage(CP_UTF8);
+ // SetMultiByteFileSystemCodePage(CP_UTF8); not needed, this is the default under Windows
+ SetMultiByteRTLFileSystemCodePage(CP_UTF8);
+
+end.
+