diff --git a/.gitattributes b/.gitattributes
index 1fef288b49..4ecd152889 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -16953,10 +16953,14 @@ utils/pas2jni/readme.txt svneol=native#text/plain
utils/pas2jni/writer.pas svneol=native#text/plain
utils/pas2js/Makefile svneol=native#text/plain
utils/pas2js/Makefile.fpc svneol=native#text/plain
+utils/pas2js/compileserver.lpi svneol=native#text/plain
+utils/pas2js/compileserver.pp svneol=native#text/plain
+utils/pas2js/dirwatch.pp svneol=native#text/plain
utils/pas2js/dist/rtl.js svneol=native#text/plain
utils/pas2js/docs/translation.html svneol=native#text/html
utils/pas2js/fpmake.lpi svneol=native#text/plain
utils/pas2js/fpmake.pp svneol=native#text/plain
+utils/pas2js/httpcompiler.pp svneol=native#text/plain
utils/pas2js/pas2js.cfg svneol=native#text/plain
utils/pas2js/pas2js.lpi svneol=native#text/plain
utils/pas2js/pas2js.pp svneol=native#text/plain
diff --git a/utils/pas2js/compileserver.lpi b/utils/pas2js/compileserver.lpi
new file mode 100644
index 0000000000..984cf4c256
--- /dev/null
+++ b/utils/pas2js/compileserver.lpi
@@ -0,0 +1,66 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/utils/pas2js/compileserver.pp b/utils/pas2js/compileserver.pp
new file mode 100644
index 0000000000..1f70a44a56
--- /dev/null
+++ b/utils/pas2js/compileserver.pp
@@ -0,0 +1,19 @@
+program compileserver;
+
+{$mode objfpc}
+{$h+}
+
+uses
+ {$IFDEF UNIX}cthreads,{$ENDIF} httpcompiler;
+
+
+Var
+ Application : THTTPCompilerApplication;
+
+begin
+ Application:=THTTPCompilerApplication.Create(Nil);
+ Application.Initialize;
+ Application.Run;
+ Application.Free;
+end.
+
diff --git a/utils/pas2js/dirwatch.pp b/utils/pas2js/dirwatch.pp
new file mode 100644
index 0000000000..3b3892acd4
--- /dev/null
+++ b/utils/pas2js/dirwatch.pp
@@ -0,0 +1,624 @@
+unit dirwatch;
+{$IFDEF LINUX}
+{$DEFINE USEINOTIFY}
+{$ELSE}
+{$DEFINE USEGENERIC}
+{$ENDIF}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils,
+{$IFDEF UNIX}
+ baseunix,
+{$IFDEF USEINOTIFY}
+ ctypes,
+ linux,
+{$ENDIF}
+{$ENDIF}
+ contnrs;
+
+
+
+Type
+ TFileEvent = (feModify,feAttrib,feCreate,feDelete);
+ TFileEvents = set of TFileEvent;
+
+ { TDirectoryEntry }
+ TDirectoryEntry = Class(TCollectionItem)
+ private
+ FEvents: TFileEvents;
+ FName: String;
+ FAttributes: Integer;
+{$IFDEF UNIX}
+ FGroup: gid_t;
+ FMode: mode_t;
+ FOwner: uid_t;
+{$ENDIF}
+ FSize: Int64;
+ FTimeStamp: TDateTime;
+ Protected
+{$IFDEF USEGENERIC}
+ procedure InitWatch(ABaseDir: String; AList: TFPStringHashTable);
+{$ENDIF}
+ Public
+ Property TimeStamp : TDateTime Read FTimeStamp Write FTimeStamp;
+ Property Size : Int64 Read FSize Write FSize;
+ Property Attributes : Integer Read FAttributes Write FAttributes;
+{$IFDEF UNIX}
+ Property Mode : mode_t Read FMode Write FMode;
+ Property Owner : uid_t Read FOwner Write FOwner;
+ Property Group : gid_t Read FGroup Write FGroup;
+{$ENDIF}
+ Published
+ Property Name : String Read FName Write FName;
+ Property Events : TFileEvents Read FEvents Write FEvents;
+ end;
+
+ { TDirectoryEntries }
+
+ TDirectoryEntries = Class(TCollection)
+ private
+ function GetE(AIndex : Integer): TDirectoryEntry;
+ procedure SetE(AIndex : Integer; AValue: TDirectoryEntry);
+ Public
+ Function IndexOfEntry(Const AName : String) : Integer;
+ Function EntryByName(Const AName : String) : TDirectoryEntry;
+ Function AddEntry(Const AName : String) : TDirectoryEntry;
+ Property Entries[AIndex : Integer] : TDirectoryEntry Read GetE Write SetE; default;
+ end;
+
+ TFileEventHandler = procedure (Sender : TObject; aEntry : TDirectoryEntry; AEvents : TFileEvents) of Object;
+
+ { TDirwatch }
+
+ TDirwatch = Class(TComponent)
+ private
+ FIdleInterval: Cardinal;
+ FOnIdle: TNotifyEvent;
+ FOnIdleNotify: TNotifyEvent;
+ FTerminated: Boolean;
+ FThreaded: Boolean;
+ FWatches: TDirectoryEntries;
+ FBaseDir: String;
+ FOnChange: TFileEventHandler;
+{$IFDEF USEGENERIC}
+ FReference : TFPStringHashTable;
+ FOldReference : TFPStringHashTable;
+ procedure DoCheckItem(Item: String; const Key: string; var Continue: Boolean);
+ procedure DoDeletedItem(Item: String; const Key: string; var Continue: Boolean);
+{$ENDIF}
+{$IFDEF USEINOTIFY}
+ FINotifyFD : Cint;
+{$ENDIF}
+ function DirectoryEntryForFileName(S: String): TDirectoryEntry;
+ procedure DoChangeEvent(Entry: TDirectoryEntry; Events: TFileEvents);
+ procedure SetBaseDir(AValue: String);
+ Protected
+ procedure DoIdle; virtual;
+ procedure Check; virtual;
+ procedure DoneWatch; virtual;
+ procedure DoStartWatch; virtual;
+ procedure InitWatch;virtual;
+ Public
+ Constructor Create(AOWner : TComponent); override;
+ Destructor Destroy; override;
+ Procedure StartWatch;
+ Procedure AddWatch(const aFileName : string; aEvents : TFileEvents);
+ Procedure Terminate;
+ Property Terminated : Boolean Read FTerminated;
+ Published
+ Property BaseDir : String read FBaseDir Write SetBaseDir;
+ Property OnChange : TFileEventHandler Read FOnChange Write FOnChange;
+ Property Threaded : Boolean Read FThreaded Write FThreaded;
+ Property Watches : TDirectoryEntries Read FWatches Write FWatches;
+ Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdleNotify;
+ Property IdleInterval : Cardinal Read FIdleInterval Write FIdleInterval;
+ end;
+
+Const
+ EventNames : Array[TFileEvent] of string = ('Modify','Attrib','Create','Delete');
+ AllEvents = [feModify,feAttrib,feCreate,feDelete];
+
+Function FileEventsToStr(Events : TFileEvents) : String;
+
+implementation
+
+
+Function FileEventsToStr(Events : TFileEvents) : String;
+
+Var
+ E : TFileEvent;
+
+begin
+ Result:='';
+ for E in Events do
+ begin
+ if Result<>'' then
+ Result:=Result+',';
+ Result:=Result+EventNames[E];
+ end;
+
+end;
+
+{ TDirwatch }
+Type
+
+ { TDirwatchThread }
+
+ TDirwatchThread = class(TThread)
+ Private
+ FDir:TDirWatch;
+ Public
+ Constructor Create(ADirwatch : TDirWatch);
+ Procedure Execute; override;
+ end;
+
+{ TDirectoryEntry }
+
+Function SearchRecToString(Info : TSearchRec; AEvents : TFileEvents) : String;
+
+begin
+ if feAttrib in AEvents then
+ Result:=IntToStr(Info.Attr)
+ else
+ Result:='';
+ Result:=Result+';'+IntToStr(Info.Size)+';'+IntToStr(Info.Time);
+end;
+
+{$IFDEF USEGENERIC}
+procedure TDirectoryEntry.InitWatch(ABaseDir: String; AList: TFPStringHashTable);
+
+Var
+ Info : TSearchRec;
+ FN : String;
+
+begin
+ if (ABaseDir<>'') then
+ FN:=IncludeTrailingPathDelimiter(ABaseDir)+Name
+ else
+ FN:=Name;
+ if FindFirst(FN,faAnyFile,Info)=0 then
+ begin
+ if (faDirectory and Info.Attr) = 0 then
+ begin
+ AList.Add(FN,SearchRecToString(Info,Self.Events))
+ end
+ else
+ begin
+ FindClose(Info);
+ FN:=IncludeTrailingPathDelimiter(FN);
+ if FindFirst(FN+AllFilesMask,0,Info)=0 then
+ Repeat
+ if (info.Name<>'.') and (Info.Name<>'..') then
+ AList.Add(FN+Info.Name,SearchRecToString(Info,Self.Events));
+ until (FindNext(Info)<>0)
+ end;
+ FindClose(Info);
+ end
+end;
+
+{$ENDIF}
+{$IFDEF USEINOTIFY}
+
+{$ENDIF}
+{ TDirwatchThread }
+
+constructor TDirwatchThread.Create(ADirwatch: TDirWatch);
+
+begin
+ FDir:=ADirWatch;
+ FreeOnTerminate:=True;
+ inherited create(False);
+end;
+
+procedure TDirwatchThread.Execute;
+begin
+ FDir.DoStartWatch;
+end;
+
+
+procedure TDirwatch.SetBaseDir(AValue: String);
+begin
+ if FBaseDir=AValue then Exit;
+ FBaseDir:=AValue;
+ FWatches.Clear;
+end;
+
+constructor TDirwatch.Create(AOWner: TComponent);
+begin
+ inherited Create(AOWner);
+ FWatches:=TDirectoryEntries.Create(TDirectoryEntry);
+ FidleInterval:=100;
+end;
+
+destructor TDirwatch.Destroy;
+begin
+ FreeAndNil(FWatches);
+ inherited Destroy;
+end;
+
+Type
+ { TDirwatchChange }
+ TDirwatchChange = Class
+ FEntry : TDirectoryEntry;
+ FEvents : TFileEvents;
+ FDirWatch : TDirWatch;
+ Constructor Create(AEntry : TDirectoryEntry;aEvents : TFileEvents;ADirWatch : TDirWatch);
+ Procedure DoEvent;
+ end;
+
+{ TDirwatchChange }
+
+constructor TDirwatchChange.Create(AEntry: TDirectoryEntry; aEvents: TFileEvents; ADirWatch: TDirWatch);
+
+begin
+ FEntry:=AEntry;
+ FEvents:=AEvents;
+ FDirWatch:=ADirWatch;
+end;
+
+procedure TDirwatchChange.DoEvent;
+begin
+ FDirwatch.FonChange(FDirwatch,FEntry,FEvents);
+end;
+
+Procedure TDirwatch.DoChangeEvent(Entry : TDirectoryEntry; Events : TFileEvents);
+
+Var
+ W : TDirWatchChange;
+
+begin
+ try
+ if Assigned(FOnChange) then
+ if Not Threaded then
+ FonChange(Self,Entry,Events)
+ else
+ begin
+ W:=TDirWatchChange.Create(Entry,Events,Self);
+ try
+ TThread.Synchronize(TThread.CurrentThread,@W.DoEvent)
+ finally
+ W.Free;
+ end;
+ end
+ Finally
+ // Specially created
+ if Entry.Collection=Nil then
+ FreeAndNil(Entry);
+ end;
+end;
+
+
+procedure TDirwatch.DoIdle;
+
+begin
+ if Assigned(FOnIdle) then
+ FOnIdle(Self);
+end;
+
+Function TDirwatch.DirectoryEntryForFileName(S : String) : TDirectoryEntry;
+
+begin
+ Result:=FWatches.EntryByName(S);
+ if (Result=Nil) then
+ Result:=FWatches.EntryByName(ExtractFilePath(S));
+ if (Result=Nil) then
+ begin
+ Result:=TDirectoryEntry.Create(Nil);
+ Result.Name:=S;
+ end;
+end;
+
+{$IFDEF USEGENERIC}
+procedure TDirwatch.DoneWatch;
+
+begin
+ FreeAndNil(FReference);
+end;
+
+procedure TDirwatch.InitWatch;
+
+Var
+ I : Integer;
+
+begin
+ FReference:=TFPStringHashTable.Create;
+ For I:=0 to FWatches.Count-1 do
+ FWatches[i].InitWatch(BaseDir,FReference);
+end;
+
+procedure TDirwatch.DoDeletedItem(Item: String; const Key: string; var Continue: Boolean);
+
+Var
+ DE : TDirectoryEntry;
+
+begin
+ DE:=FWatches.EntryByName(Key);
+ if (DE=Nil) then
+ DE:=FWatches.EntryByName(ExtractFilePath(Key));
+ if (DE=Nil) then
+ begin
+ DE:=TDirectoryEntry.Create(Nil);
+ DE.Name:=Key;
+ end;
+ DoChangeEvent(DE,[feDelete]);
+ Continue:=False;
+end;
+
+procedure TDirwatch.DoCheckItem(Item: String; const Key: string; var Continue: Boolean);
+
+Var
+ S : String;
+ E : TFileEvents;
+ DE : TDirectoryEntry;
+
+begin
+// Writeln('check file: ',key,' attrs : ',Item);
+ E:=[];
+ S:=FOldReference[Key];
+ if (S='') then
+ E:=[feCreate]
+ else
+ begin
+ FOldReference.Delete(Key);
+ if (S<>Item) then
+ E:=[feAttrib];
+ end;
+ if E<>[] then
+ begin
+ DE:=DirectoryEntryForFileName(Key);
+ DoChangeEvent(DE,E);
+ Continue:=False;
+ end;
+end;
+
+procedure TDirwatch.Check;
+
+begin
+ FOldReference:=FReference;
+ try
+ FReference:=TFPStringHashTable.Create;
+ InitWatch;
+ FReference.Iterate(@doCheckItem);
+ if FoldReference.Count>0 then
+ FReference.Iterate(@doDeletedItem);
+ // Deleted files
+ Sleep(IdleInterval);
+ finally
+ FreeAndNil(FoldReference);
+ end;
+end;
+{$ENDIF}
+
+{$IFDEF USEINOTIFY}
+Procedure WatchDirectory(d : string);
+
+Const
+ Events = IN_MODIFY or IN_ATTRIB or IN_CREATE or IN_DELETE;
+
+Var
+ fd, wd,fnl,len : cint;
+ fds : tfdset;
+ e : ^inotify_event;
+ buf : Array[0..1023*4] of Byte; // 4K Buffer
+ fn : string;
+ p : pchar;
+
+begin
+ fd:=inotify_init;
+ try
+ wd:=inotify_add_watch(fd,pchar(d),Events);
+ fpFD_Zero(fds);
+ fpFD_SET(fd,fds);
+ While (fpSelect(fd+1,@fds,nil,nil,nil)>=0) do
+ begin
+ len:=fpRead(fd,buf,sizeof(buf));
+ e:=@buf;
+ While ((pchar(e)-@buf)0) then
+ begin
+ p:=@e^.name+fnl-1;
+ While (p^=#0) do
+ begin
+ dec(p);
+ dec(fnl);
+ end;
+ end;
+ setlength(fn,fnl);
+ if (fnl>0) then
+ move(e^.name,fn[1],fnl);
+ Writeln('Change ',e^.mask,' (',
+// InotifyEventsToString(e^.mask),
+ ') detected for file "',fn,'"');
+ ptrint(e):=ptrint(e)+sizeof(inotify_event)+e^.len-1;
+ end;
+ end;
+ finally
+ fpClose(fd);
+ end;
+end;
+
+procedure TDirwatch.DoneWatch;
+
+begin
+ fpClose(FInotifyFD);
+end;
+
+procedure TDirwatch.InitWatch;
+
+Const
+ NativeEvents : Array[TFileEvent] of cint = (IN_Modify,IN_Attrib,IN_Create,IN_Delete);
+
+Var
+ WD,I,NEvents : Integer;
+ E : TFileEvent;
+ BD,FN : String;
+
+begin
+ BD:=BaseDir;
+ if BD<>'' then
+ BD:=IncludeTrailingPathDelimiter(BD);
+ FINotifyFD:=inotify_init;
+ For I:=0 to FWatches.Count-1 do
+ begin
+ NEvents:=0;
+ for E in FWatches[i].Events do
+ NEvents:=NEvents OR NativeEvents[E];
+ FN:=BD+FWatches[i].Name;
+ wd:=inotify_add_watch(FINotifyFD,PChar(FN),NEvents);
+ end;
+end;
+
+Function NativeEventsToEvents(Native : cint) : TFileEvents;
+
+ Procedure MA(C : cint; AEvent : TFileEvent);
+
+ begin
+ if (Native and C)<>0 then
+ Include(Result,AEvent);
+ end;
+
+begin
+ Result:=[];
+ MA(IN_ACCESS,feAttrib);
+ MA(IN_MODIFY,feModify);
+ MA(IN_ATTRIB,feAttrib);
+ MA(IN_CLOSE_WRITE,feAttrib);
+ MA(IN_CLOSE_NOWRITE,feAttrib);
+ MA(IN_OPEN,feAttrib);
+ MA(IN_MOVED_FROM,feCreate);
+ MA(IN_MOVED_TO,feDelete);
+ MA(IN_CREATE,feCreate);
+ Ma(IN_DELETE,feDelete);
+ Ma(IN_DELETE_SELF,feDelete);
+ Ma(IN_MOVE_SELF,feDelete);
+ Ma(IN_UNMOUNT,feDelete);
+ // IN_Q_OVERFLOW
+ // IN_IGNORED
+
+end;
+
+procedure TDirwatch.Check;
+
+Var
+ fnl,len : cint;
+ e : ^inotify_event;
+ buf : Array[0..1023*4] of Byte; // 4K Buffer
+ fn : string;
+ p : pchar;
+ fds : tfdset;
+ Timeout : ttimeval;
+
+begin
+ fpFD_Zero(fds);
+ fpFD_SET(FINotifyFD,fds);
+ timeout.tv_sec:=FIdleInterval div 1000;
+ timeout.tv_usec:=(FIdleInterval mod 1000)*1000;
+ if (fpSelect(FINotifyFD+1,@fds,nil,nil,@Timeout)<=0) then
+ exit;
+ len:=fpRead(FINotifyFD,buf,sizeof(buf));
+ e:=@buf;
+ While ((pchar(e)-@buf)0) then
+ begin
+ p:=@e^.name+fnl-1;
+ While (p^=#0) do
+ begin
+ dec(p);
+ dec(fnl);
+ end;
+ end;
+ setlength(fn,fnl);
+ if (fnl>0) then
+ move(e^.name,fn[1],fnl);
+ DoChangeEvent(DirectoryEntryForFileName(FN),NativeEventsToEvents(E^ .mask));
+ ptrint(e):=ptrint(e)+sizeof(inotify_event)+e^.len-1;
+ end;
+end;
+{$ENDIF}
+
+procedure TDirwatch.DoStartWatch;
+
+begin
+ InitWatch;
+ try
+ While not Terminated do
+ begin
+ Check;
+ if Threaded then
+ TThread.Synchronize(TThread.CurrentThread,@DoIdle)
+ else
+ DoIdle;
+ end;
+ Finally
+ DoneWatch;
+ end;
+end;
+
+procedure TDirwatch.StartWatch;
+
+begin
+ If Threaded then
+ TDirwatchThread.Create(Self).WaitFor
+ else
+ DoStartWatch;
+end;
+
+procedure TDirwatch.AddWatch(const aFileName: string; aEvents: TFileEvents);
+begin
+ FWatches.AddEntry(AFileName).Events:=AEvents;
+end;
+
+procedure TDirwatch.Terminate;
+begin
+ FTerminated:=True;
+end;
+
+{ TDirectoryEntries }
+
+function TDirectoryEntries.GetE(AIndex : Integer): TDirectoryEntry;
+begin
+ Result:=TDirectoryEntry(Items[AIndex]);
+end;
+
+procedure TDirectoryEntries.SetE(AIndex : Integer; AValue: TDirectoryEntry);
+begin
+ Items[AIndex]:=AValue;
+end;
+
+function TDirectoryEntries.IndexOfEntry(const AName: String): Integer;
+
+begin
+ Result:=Count-1;
+ While (Result>=0) and (GetE(Result).Name<>AName) do
+ Dec(Result);
+end;
+
+function TDirectoryEntries.EntryByName(const AName: String): TDirectoryEntry;
+
+Var
+ I : Integer;
+
+begin
+ I:=IndexOfEntry(AName);
+ If (I=-1) then
+ Result:=Nil
+ else
+ Result:=GetE(I);
+end;
+
+function TDirectoryEntries.AddEntry(Const AName: String): TDirectoryEntry;
+begin
+ Result:=Add as TDirectoryEntry;
+ Result.Name:=AName;
+end;
+
+end.
+
diff --git a/utils/pas2js/fpmake.pp b/utils/pas2js/fpmake.pp
index 44b032cc2d..422ab71130 100644
--- a/utils/pas2js/fpmake.pp
+++ b/utils/pas2js/fpmake.pp
@@ -30,8 +30,12 @@ begin
P.Dependencies.Add('fcl-js');
P.Dependencies.Add('fcl-passrc');
P.Dependencies.Add('pastojs');
+ P.Dependencies.Add('fcl-web');
PT:=P.Targets.AddProgram('pas2js.pp');
PT:=P.Targets.AddLibrary('pas2jslib.pp');
+ PT:=P.Targets.AddUnit('httpcompiler.pp');
+ PT:=P.Targets.AddProgram('compileserver.pp');
+ PT.Dependencies.AddUnit('httpcompiler');
end;
end;
diff --git a/utils/pas2js/httpcompiler.pp b/utils/pas2js/httpcompiler.pp
new file mode 100644
index 0000000000..cdc4417ecb
--- /dev/null
+++ b/utils/pas2js/httpcompiler.pp
@@ -0,0 +1,528 @@
+unit httpcompiler;
+
+{$mode objfpc}
+{$H+}
+
+interface
+
+uses
+ sysutils, classes, fpjson, contnrs, syncobjs, custhttpapp, fpwebfile, httproute,
+ pas2jscompiler, httpdefs, dirwatch;
+
+Const
+ nErrTooManyThreads = -1;
+
+Type
+ TDirWatcher = Class;
+ THTTPCompilerApplication = Class;
+
+ { TCompileItem }
+
+ TCompileItem = Class(TCollectionItem)
+ private
+ FBaseDir: string;
+ FConfigFile: String;
+ FFileName: string;
+ FOutput : TStrings;
+ FOptions : TStrings;
+ FSuccess: Boolean;
+ FThread: TThread;
+ function GetOptions: TStrings;
+ function GetOutput: TStrings;
+ Public
+ Destructor Destroy; override;
+ Property BaseDir : string Read FBaseDir Write FBaseDir;
+ Property FileName : string Read FFileName Write FFileName;
+ Property ConfigFile: String Read FConfigFile Write FConfigFile;
+ Property Options : TStrings Read GetOptions;
+ Property Output : TStrings Read GetOutput;
+ Property Thread : TThread Read FThread;
+ Property Success : Boolean Read FSuccess;
+ end;
+
+ { TCompiles }
+
+ TCompiles = Class(TCollection)
+ private
+ function GetC(AIndex : Integer): TCompileItem;
+ Public
+ Property Compiles[AIndex : Integer] : TCompileItem Read GetC; default;
+ end;
+
+
+ { TCompileThread }
+
+ TCompileThread = class(TThread)
+ private
+ FApp : THTTPCompilerApplication;
+ FItem: TCompileItem;
+ procedure DoCompilerLog(Sender: TObject; const Msg: String);
+ procedure SetItem(AValue: TCompileItem);
+ Public
+ Constructor create(App : THTTPCompilerApplication; aItem : TCompileItem);
+ Procedure Execute; override;
+ Property Item : TCompileItem read FItem write SetItem;
+ end;
+
+ { TDirWatcher }
+
+ TDirWatcher = Class(TComponent)
+ Private
+ FApp : THTTPCompilerApplication;
+ FDW : TDirWatch;
+ procedure DoChange(Sender: TObject; aEntry: TDirectoryEntry; AEvents: TFileEvents);
+ Public
+ Constructor Create(App : THTTPCompilerApplication; ADir : String);overload;
+ Destructor Destroy; override;
+ end;
+
+ { THTTPCompilerApplication }
+
+ THTTPCompilerApplication = Class(TCustomHTTPApplication)
+ private
+ FBaseDir: String;
+ FConfigFile: String;
+ FProjectFile: String;
+ FStatusLock : TCriticalSection;
+ FQuiet: Boolean;
+ FWatch: Boolean;
+ FDW : TDirWatcher;
+ FStatusList : TFPObjectList;
+ FCompiles : TCompiles;
+ procedure AddToStatus(O: TJSONObject);
+ Procedure ReportBuilding(AItem : TCompileItem);
+ Procedure ReportBuilt(AItem : TCompileItem);
+ Procedure AddToStatus(AEntry : TDirectoryEntry; AEvents : TFileEvents);
+ procedure DoStatusRequest(ARequest: TRequest; AResponse: TResponse);
+ procedure DoRecompile(ARequest: TRequest; AResponse: TResponse);
+ function ScheduleCompile(const aProjectFile: String; Options : TStrings = Nil): Integer;
+ procedure StartWatch(ADir: String);
+ procedure Usage(Msg: String);
+ public
+ Constructor Create(AOWner : TComponent); override;
+ Destructor Destroy; override;
+ procedure DoLog(EventType: TEventType; const Msg: String); override;
+ Procedure DoRun; override;
+ property Quiet : Boolean read FQuiet Write FQuiet;
+ Property Watch : Boolean Read FWatch Write FWatch;
+ Property ProjectFile : String Read FProjectFile Write FProjectFile;
+ Property ConfigFile : String Read FConfigFile Write FConfigFile;
+ Property BaseDir : String Read FBaseDir;
+ end;
+
+Implementation
+
+{ TCompileThread }
+
+procedure TCompileThread.SetItem(AValue: TCompileItem);
+begin
+ if FItem=AValue then Exit;
+ FItem:=AValue;
+end;
+
+procedure TCompileThread.DoCompilerLog(Sender: TObject; const Msg: String);
+begin
+ If Assigned(Item) then
+ Item.Output.Add(Msg);
+end;
+
+constructor TCompileThread.create(App: THTTPCompilerApplication; aItem: TCompileItem);
+
+begin
+ FItem:=aItem;
+ FApp:=App;
+ FreeOnTerminate:=True;
+ inherited create(False);
+end;
+
+procedure TCompileThread.Execute;
+
+Var
+ C : TPas2jsCompiler;
+ L : TStrings;
+
+begin
+ L:=Nil;
+ C:=TPas2jsCompiler.Create;
+ Try
+ FApp.ReportBuilding(Item);
+ L:=TStringList.Create;
+ L.Assign(Item.Options);
+ if (Item.ConfigFile<>'') then
+ L.Add('@'+Item.ConfigFile);
+ L.Add(Item.FileName);
+ C.Log.OnLog:=@DoCompilerLog;
+ try
+ C.Run(ParamStr(0),Item.BaseDir,L,True);
+ Item.FSuccess:=True;
+ except
+ On E : Exception do
+ Item.Output.Add(Format('Error %s compiling %s: %s',[E.ClassName,Item.FileName,E.Message]));
+ end;
+ FApp.ReportBuilt(Item);
+ Finally
+ C.Free;
+ L.Free;
+ end;
+ Item.FThread:=Nil;
+end;
+
+{ TCompiles }
+
+function TCompiles.GetC(AIndex : Integer): TCompileItem;
+begin
+ Result:=Items[Aindex] as TCompileItem;
+end;
+
+{ TCompileItem }
+
+function TCompileItem.GetOutput: TStrings;
+begin
+ If (FOutput=Nil) then
+ FOutput:=TStringList.Create;
+ Result:=FOutput;
+end;
+
+function TCompileItem.GetOptions: TStrings;
+begin
+ If (FOptions=Nil) then
+ FOptions:=TStringList.Create;
+ Result:=FOptions;
+end;
+
+destructor TCompileItem.Destroy;
+begin
+ FreeAndNil(FOutput);
+ FreeAndNil(FOptions);
+ inherited Destroy;
+end;
+
+
+{ TDirWatcher }
+
+procedure TDirWatcher.DoChange(Sender: TObject; aEntry: TDirectoryEntry; AEvents: TFileEvents);
+begin
+ if Assigned(FApp) then
+ FApp.AddToStatus(AEntry,AEvents);
+end;
+
+constructor TDirWatcher.Create(App: THTTPCompilerApplication; ADir: String);
+begin
+ Inherited create(APP);
+ FApp:=App;
+ FDW:=TDirwatch.Create(Self);
+ FDW.AddWatch(ADir,allEvents);
+ FDW.OnChange:=@DoChange;
+ TThread.ExecuteInThread(@FDW.StartWatch);
+end;
+
+destructor TDirWatcher.Destroy;
+begin
+ FApp:=Nil;
+ FDW.Terminate;
+ FreeAndNil(FDW);
+ inherited Destroy;
+end;
+
+{ THTTPCompilerApplication }
+
+procedure THTTPCompilerApplication.DoLog(EventType: TEventType; const Msg: String);
+begin
+ if Quiet then
+ exit;
+ if IsConsole then
+ Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
+ else
+ inherited DoLog(EventType, Msg);
+end;
+
+procedure THTTPCompilerApplication.Usage(Msg : String);
+
+begin
+ if (Msg<>'') then
+ Writeln('Error: ',Msg);
+ Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
+ Writeln('Where options is one or more of : ');
+ Writeln('-d --directory=dir Base directory from which to serve files.');
+ Writeln(' Default is current working directory: ',GetCurrentDir);
+ Writeln('-h --help This help text');
+ Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
+ Writeln('-n --noindexpage Do not allow index page.');
+ Writeln('-p --port=NNNN TCP/IP port to listen on (default is 3000)');
+ 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');
+ Halt(Ord(Msg<>''));
+end;
+
+constructor THTTPCompilerApplication.Create(AOWner: TComponent);
+begin
+ inherited Create(AOWner);
+ FStatusLock:=TCriticalSection.Create;
+ FStatusList:=TFPObjectList.Create(False);
+ FCompiles:=TCompiles.Create(TCompileItem);
+end;
+
+destructor THTTPCompilerApplication.Destroy;
+begin
+ FStatusLock.Enter;
+ try
+ FreeAndNil(FCompiles);
+ FreeAndNil(FStatusList);
+ finally
+ FStatusLock.Leave;
+ end;
+ FreeAndNil(FStatusLock);
+ inherited Destroy;
+end;
+
+procedure THTTPCompilerApplication.StartWatch(ADir : String);
+
+begin
+ FDW:=TDirWatcher.Create(Self,ADir);
+end;
+
+procedure THTTPCompilerApplication.ReportBuilding(AItem: TCompileItem);
+
+Var
+ O : TJSONObject;
+
+begin
+ O:=TJSONObject.Create(['action','building','compileID',AItem.ID,'project',AItem.FileName,'config',AItem.ConfigFile]);
+ AddToStatus(O);
+end;
+
+procedure THTTPCompilerApplication.ReportBuilt(AItem: TCompileItem);
+
+Var
+ O : TJSONObject;
+ A : TJSONArray;
+ I : Integer;
+
+begin
+ A:=TJSONArray.Create;
+ For I:=0 to AItem.Output.Count-1 do
+ A.Add(AItem.Output[i]);
+ O:=TJSONObject.Create(['action','built','compileID',AItem.ID,'project',AItem.FileName,'config',AItem.ConfigFile,'output',A,'success',AItem.Success]);
+ AddToStatus(O);
+end;
+
+procedure THTTPCompilerApplication.AddToStatus(O : TJSONObject);
+
+begin
+ FStatusLock.Enter;
+ try
+ Writeln('Adding to status ',Assigned(O),' : ',O.ClassName);
+ FStatusList.Add(O);
+ finally
+ FStatusLock.Leave;
+ end;
+end;
+
+procedure THTTPCompilerApplication.AddToStatus(AEntry: TDirectoryEntry; AEvents: TFileEvents);
+
+Var
+ O : TJSONObject;
+ FN : String;
+
+begin
+ Log(etDebug,'File change detected: %s (%s)',[AEntry.name,FileEventsToStr(AEvents)]);
+ O:=TJSONObject.Create(['action','file','name',AEntry.name,'events',FileEventsToStr(AEvents)]);
+ if Pos(ExtractFileExt(AEntry.Name),'.lpr.pas.pp.inc.dpr')>0 then
+ FN:=AEntry.Name;
+ if (FN<>'') then
+ O.Add('recompile',true);
+ AddToStatus(O);
+ if (FN<>'') then
+ begin
+ Log(etDebug,'File change forces recompile: %s',[AEntry.name]);
+ ScheduleCompile('',Nil);
+ end;
+end;
+
+procedure THTTPCompilerApplication.DoStatusRequest(ARequest : TRequest; AResponse : TResponse);
+
+Var
+ R,O : TJSONObject;
+ A : TJSONArray;
+ I : integer;
+begin
+ Log(etDebug,'Status request from: %s',[ARequest.RemoteAddress]);
+ R:=Nil;
+ try
+ FStatusLock.Enter;
+ try
+ if (FStatusList.Count=0) then
+ R:=TJSONObject.Create(['ping',True])
+ else
+ begin
+ Writeln(FStatusList[0].ClassName);
+ O:=FStatusList[0] as TJSONObject;
+ FStatusList.Delete(0);
+ if O.Get('action','')<>'file' then
+ R:=O
+ else
+ begin
+ // If first event is file event, then add and delete all file events in list.
+ A:=TJSONArray.Create([O]);
+ O.Delete('action');
+ R:=TJSONObject.Create(['action','sync','files',A]);
+ For I:=FStatusList.Count-1 downto 0 do
+ begin
+ O:=FStatusList[I] as TJSONObject;
+ if (O.Get('action','')='file') then
+ begin
+ A.Add(O);
+ O.Delete('action');
+ FStatusList.Delete(I);
+ end;
+ end;
+ end
+ end;
+ finally
+ FStatusLock.Leave;
+ end;
+ AResponse.ContentType:='application/json';
+ AResponse.Content:=R.AsJSON;
+ AResponse.SendResponse;
+ finally
+ R.Free;
+ end;
+end;
+
+Function THTTPCompilerApplication.ScheduleCompile(const aProjectFile : String; Options : TStrings = Nil) : Integer;
+
+Var
+ CI : TCompileItem;
+ I,TC : Integer;
+
+begin
+ TC:=0;
+ For I:=0 to FCompiles.Count-1 do
+ if Assigned(FCompiles[I].THread) then
+ Inc(TC);
+ if TC>10 then
+ begin
+ Log(etError,'Refusing compile of file "%s" using config file "%s"',[AProjectFile, ConfigFile]);
+ Exit(nErrTooManyThreads);
+ end;
+ CI:=FCompiles.Add as TCompileItem;
+ Log(etInfo,'Scheduling compile ID %d of file "%s" using config file "%s"',[CI.ID,AProjectFile, ConfigFile]);
+ CI.BaseDir:=BaseDir;
+ CI.FileName:=AProjectFile;
+ CI.ConfigFile:=ConfigFile;
+ if Assigned(Options) then
+ CI.Options.Assign(Options);
+ TCompileThread.Create(Self,CI);
+ Result:=CI.ID;
+end;
+
+procedure THTTPCompilerApplication.DoRecompile(ARequest: TRequest; AResponse: TResponse);
+
+Var
+ ID : Integer;
+ PF,CL : String;
+ Options: TStrings;
+
+begin
+ PF:=ARequest.ContentFields.Values['ProjectFile'];
+ CL:=ARequest.ContentFields.Values['CompileOptions'];
+ if PF='' then
+ PF:=ProjectFile;
+ If (PF='') then
+ begin
+ AResponse.Code:=404;
+ AResponse.CodeText:='No project file';
+ AResponse.ContentType:='application/json';
+ AResponse.Content:='{ "success" : false, "message": "no project file set or provided" }';
+ end
+ else
+ begin
+ Options:=Nil;
+ try
+ if CL<>'' then
+ begin
+ Options:=TStringList.Create;
+ Options.Text:=Cl;
+ end;
+ ID:=ScheduleCompile(PF,Options);
+ finally
+ FreeAndNil(Options);
+ end;
+ if ID=nErrTooManyThreads then
+ begin
+ AResponse.Code:=403;
+ AResponse.CodeText:='Too many compiles';
+ AResponse.ContentType:='application/json';
+ AResponse.Content:='{ "success" : false, "message": "Too many compiles running" }';
+ end
+ else
+ begin
+ AResponse.Code:=200;
+ AResponse.ContentType:='application/json';
+ AResponse.Content:=Format('{ "success" : true, "file": "%s", "commandLine" : "%s", "compileID": %d }',[StringToJSONString(PF),StringToJSONString(CL),ID]);
+ end
+ end;
+ AResponse.SendResponse;
+end;
+
+procedure THTTPCompilerApplication.DoRun;
+
+Var
+ S,IndexPage,D : String;
+
+begin
+ S:=Checkoptions('hqd:ni:p:wP::c',['help','quiet','noindexpage','directory:','port:','indexpage:','watch','project::','config:']);
+ if (S<>'') or HasOption('h','help') then
+ usage(S);
+ Quiet:=HasOption('q','quiet');
+ Watch:=HasOption('w','watch');
+ Port:=StrToIntDef(GetOptionValue('p','port'),3000);
+ D:=GetOptionValue('d','directory');
+ if D='' then
+ D:=GetCurrentDir;
+ Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+{$ifdef unix}
+ MimeTypesFile:='/etc/mime.types';
+{$endif}
+ if Hasoption('P','project') then
+ begin
+ ProjectFile:=GetOptionValue('P','project');
+ if ProjectFile='' then
+ ProjectFile:=IncludeTrailingPathDelimiter(D)+'app.lpr';
+ If Not FileExists(ProjectFile) then
+ begin
+ Terminate;
+ Log(etError,'Project file "%s" does not exist, aborting.',[ProjectFile]);
+ Exit;
+ end;
+ ConfigFile:=GetOptionValue('c','config');
+ if (ConfigFile='') then
+ ConfigFile:=ChangeFileExt(Projectfile,'.cfg');
+ if not FileExists(ConfigFile) then
+ ConfigFile:='';
+ end;
+ if Watch then
+ begin
+ if (ProjectFile='') then
+ Log(etWarning,'No project file specified, disabling watch.') ;
+ StartWatch(D);
+ end;
+ FBaseDir:=D;
+ TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
+ TSimpleFileModule.OnLog:=@Log;
+ If not HasOption('n','noindexpage') then
+ begin
+ IndexPage:=GetOptionValue('i','indexpage');
+ if (IndexPage='') then
+ IndexPage:='index.html';
+ Log(etInfo,'Using index page %s',[IndexPage]);
+ TSimpleFileModule.IndexPageName:=IndexPage;
+ end;
+ httprouter.RegisterRoute('$sys/compile',rmPost,@DoRecompile);
+ httprouter.RegisterRoute('$sys/status',rmGet,@DoStatusRequest);
+ TSimpleFileModule.RegisterDefaultRoute;
+ inherited;
+end;
+
+end.