* Compile server

git-svn-id: trunk@37874 -

.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

utils/pas2js/compileserver.lpi

@@ -0,0 +1,66 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="compileserver"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="compileserver.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit0>
+        <Filename Value="httpcompiler.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="dirwatch.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="compileserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

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

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)<len) do
+        begin
+        fnl:=e^.len;
+        if (fnl>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)<len) do
+    begin
+    fnl:=e^.len;
+    if (fnl>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.
+

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;
 

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.