paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 23:28:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

pas2js: compileserver: fall back mime.types

Browse Source 
git-svn-id: trunk@41666 -
This commit is contained in:
Mattias Gaertner 2019-03-10 08:11:33 +00:00
parent fa87f8870c
commit f52ea868dd
2 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
utils/pas2js/compileserver.pp
View File

@ -6,7 +6,6 @@ program compileserver;
uses
{$IFDEF UNIX}cthreads,{$ENDIF} httpcompiler;
Var
Application : THTTPCompilerApplication;

42
utils/pas2js/httpcompiler.pp
View File

@ -6,9 +6,8 @@ unit httpcompiler;
interface
uses
sysutils, classes, fpjson, contnrs, syncobjs, custhttpapp, fpwebfile, httproute,
httpdefs, dirwatch,
Pas2JSFSCompiler, Pas2JSCompilerCfg;
sysutils, classes, fpjson, contnrs, syncobjs, fpmimetypes, custhttpapp,
fpwebfile, httproute, httpdefs, dirwatch, Pas2JSFSCompiler, Pas2JSCompilerCfg;
Const
nErrTooManyThreads = -1;
@ -101,8 +100,10 @@ Type
procedure DoRecompile(ARequest: TRequest; AResponse: TResponse);
function ScheduleCompile(const aProjectFile: String; Options : TStrings = Nil): Integer;
procedure StartWatch(ADir: String);
procedure Usage(Msg: String);
function GetDefaultMimetypes: string;
protected
procedure Usage(Msg: String); virtual;
function GetDefaultMimeTypesFile: string; virtual;
procedure LoadDefaultMimeTypes; virtual;
public
Constructor Create(AOWner : TComponent); override;
Destructor Destroy; override;
@ -262,13 +263,13 @@ begin
Writeln('-q --quiet Do not write diagnostic messages');
Writeln('-w --watch Watch directory for changes');
Writeln('-c --compile[=proj] Recompile project if pascal files change. Default project is app.lpr');
Writeln('-m --mimetypes=file filename of mimetypes. Default is ',GetDefaultMimetypes);
Writeln('-m --mimetypes=file filename of mimetypes. Default is ',GetDefaultMimeTypesFile);
Writeln('-s --simpleserver Only serve files, do not enable compilation.');
Halt(Ord(Msg<>''));
{AllowWriteln-}
end;
function THTTPCompilerApplication.GetDefaultMimetypes: string;
function THTTPCompilerApplication.GetDefaultMimeTypesFile: string;
begin
{$ifdef unix}
Result:='/etc/mime.types';
@ -281,6 +282,22 @@ begin
{$endif}
end;
procedure THTTPCompilerApplication.LoadDefaultMimeTypes;
begin
MimeTypes.AddType('application/xhtml+xml','xhtml;xht');
MimeTypes.AddType('text/html','htmll;htm');
MimeTypes.AddType('text/plain','txt');
MimeTypes.AddType('application/javascript','js');
MimeTypes.AddType('text/plain','map');
MimeTypes.AddType('application/json','json');
MimeTypes.AddType('image/png','png');
MimeTypes.AddType('image/jpeg','jpeg;jpg');
MimeTypes.AddType('image/gif','gif');
MimeTypes.AddType('image/jp2','jp2');
MimeTypes.AddType('image/tiff','tiff;tif');
MimeTypes.AddType('application/pdf','pdf');
end;
constructor THTTPCompilerApplication.Create(AOWner: TComponent);
begin
inherited Create(AOWner);
@ -547,8 +564,15 @@ begin
if HasOption('m','mimetypes') then
MimeTypesFile:=GetOptionValue('m','mimetypes');
if MimeTypesFile='' then
MimeTypesFile:=GetDefaultMimetypes;
if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
begin
MimeTypesFile:=GetDefaultMimeTypesFile;
if not FileExists(MimeTypesFile) then
begin
MimeTypesFile:='';
LoadDefaultMimeTypes;
end;
end
else if not FileExists(MimeTypesFile) then
Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
FBaseDir:=D;
if not ServeOnly then