* Bugfixes from Attila Borka:

  - Bug fix in the template parser. Bug0012095
  - Fixed: CGI applications did not create and populate contentfields (caused AV if someone 
    tried to access it) for the http request, both the query and content parameters were put 
    into the queryfields list
  - Bug0012094 fix: CGI applications AllowDefaultModule=true did not work for Delphi style calls (it is ok 
    for querystring parameter passed module names)
  - fptemplate.pp->TTemplateParser: Added support for template tag parameters. 

git-svn-id: trunk@11747 -

.gitattributes

@@ -1608,6 +1608,7 @@ packages/fcl-res/xml/winpeimagereader.xml svneol=native#text/plain
 packages/fcl-web/Makefile svneol=native#text/plain
 packages/fcl-web/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/fpmake.pp svneol=native#text/plain
+packages/fcl-web/fptemplate.txt svneol=native#text/plain
 packages/fcl-web/src/README svneol=native#text/plain
 packages/fcl-web/src/cgiapp.pp svneol=native#text/plain
 packages/fcl-web/src/custcgi.pp svneol=native#text/plain

packages/fcl-web/fptemplate.txt

@@ -0,0 +1,164 @@
+fptemplate.pp
+
+implements template support
+
+Default behaviour:
+In the basic default version the TFPTemplate object can handle simple template 
+tags ex. {templatetagname} and requires the replacement strings in a Values 
+array before the parsing starts. An OnGetParam:TGetParamEvent event can be 
+triggered if it is set, when a value is not found in the Values list.
+
+The template tag start and end delimiters can be set with the StartDelimiter 
+and EndDelimiter properties (defaults are '{' and '}' for now).
+
+The parsing happens recursively so a replace text string can contain further 
+tags in it.
+
+
+Recent improvements:
+With the recent improvements the template tag handling got more close to the 
+traditional Delphi way of handling templates.
+By setting the AllowTagParams property to True this new parsing method will be 
+activated and it is possible to pass parameters to the processing program from 
+the template tags.
+
+Other than the two original StartDelimiter and EndDelimiter properties to 
+specify the boundaries of a template tag, there are 3 more delimiters to 
+define these parameters. 
+    ParamStartDelimiter (default is '[-')
+    ParamEndDelimiter   (default is '-]')
+    ParamValueSeparator (default is '=')
+
+Some examples for tags with these above, StartDelimiter:='{+' and 
+EndDelimiter:='+}' 
+(the default '{' and '}' is not good when processing HTML templates with 
+JavaSript in them):
+
+{+ATagHere+}
+
+{+AnotherTagHere  [-paramname1=paramvalue1-]+}
+
+{+HereIsATagToo //with param 
+ [-param1=param1value-]    //some text here to ignore
+//this text is ignored too
+ [-param2=param2value which
+                      is multi line something
+text ending here
+-] 
+ [-param3=param3value-] 
++}
+
+If we want something close to the Delphi tag delimiters, we can set the 
+  StartDelimiter := '<#';
+  EndDelimiter := '>';
+  ParamStartDelimiter := ' ';
+  ParamEndDelimiter := '"';
+  ParamValueSeparator := '="';
+
+This allows the use of Dephi-like tags like these:
+
+<#input type="text" name="foo1"        value="" caption="bar" checked="false">
+<#input type="RadioButton" name="foo2" 
+			     value="" 
+			     caption="bar" checked="false" >
+<#fieldvalue fieldname="FIRSTNAME">
+
+Of course, the above setting requires at least one space before the parameter 
+names. Cannot just use tabs for example to separate them. Also, Delphi (and its
+emulation here) cannot handle any HTML code within the tag parameters because
+some might contain characters indicating tag-param-end or tag-end.
+
+When the tags are processed, for each tag a 
+
+TReplaceTagEvent = Procedure(Sender : TObject; Const TagString : String;
+ TagParams:TStringList; Out ReplaceText : String) Of Object;
+
+will be called with the parameters passed in TagParams:TStringList so it has 
+to be assigned to such a procedure.
+
+Example:
+
+procedure TFPWebModule1.func1callRequest(Sender: TObject; ARequest: TRequest;
+  AResponse: TResponse; var Handled: Boolean);
+var s:String;
+begin     //Template:TFPTemplate is a property of the web Action
+  Template.FileName := 'pathtotemplate\mytemplate.html';
+  Template.AllowTagParams := true;
+  Template.StartDelimiter := '{+';
+  Template.EndDelimiter := '+}';
+  Template.OnReplaceTag := @func1callReplaceTag;
+  s := Template.GetContent;
+
+  //lets use some Delphi style tags too and re-run the parser
+  Template.StartDelimiter := '<#';
+  Template.EndDelimiter := '>';
+  Template.ParamStartDelimiter := ' ';
+  Template.ParamEndDelimiter := '"';
+  Template.ParamValueSeparator := '="';
+  Template.FileName := '';
+  Template.Template := s;
+
+  AResponse.Content := Template.GetContent;
+
+  Handled := true;
+end;
+
+procedure TFPWebModule1.func1callReplaceTag(Sender: TObject; const TagString: 
+  String; TagParams: TStringList; Out ReplaceText: String);
+begin
+  if AnsiCompareText(TagString, 'TagName1') = 0 then
+  begin
+    ReplaceText := 'text to replace this tag, using the TagParams if needed';
+  end else begin
+.
+.snip
+.
+//Not found value for tag -> TagString
+  end;
+end;
+
+
+With these improvements it is easily possible to separate the web page design 
+and the web server side programming. For example to generate a table record 
+list the web designer can use the following Tag in a template:
+
+.
+.snip
+.
+<table class="beautify1"><tr class="beautify2"><td class="beautify3">
+  {+REPORTRESULT 
+   [-HEADER=
+    <table bordercolorlight="#6699CC" bordercolordark="#E1E1E1" class="Label">
+     <tr class="Label" align=center bgcolor="#6699CC">
+      <th><font color="white">~Column1</font></th>
+      <th><font color="white">~Column2</font></th>
+     </tr>
+   -]
+   [- ONEROW =
+     <tr bgcolor="#F2F2F2" class="Label3" align="center">
+      <td>~Column1Value</td><td>~Column2value</td>
+     </tr>
+   -]
+.
+.snip, and so on more parameters
+.
+   [- NOTFOUND=
+    <tr class="Error"><td>There are no entries found.</td></tr> 
+   -]
+   [-FOOTER=</table>-]
+  +}
+</table>
+.
+.snip
+.
+
+
+I know, I know its ugly html progamming and who uses tables and font html tags 
+nowadays, etc. ... but you get the idea.
+The OnReplaceTag event handler just need to replace the whole REPORTRESULT 
+template tag with the ~Column1, ~Column2 for the HEADER parameter, and the 
+~Column1Value, ~Column2Value in the ONEROW parameter while looping through a 
+sql query result set.
+Or if there is nothing to list, just use the NOTFOUND parameter as a replace 
+text for the whole RESULT template tag.
+

packages/fcl-web/src/custcgi.pp

@@ -436,9 +436,9 @@ begin
       end;}
     CT:=ContentType;
     if Pos('MULTIPART/FORM-DATA',Uppercase(CT))<>0 then
-      ProcessMultiPart(M,CT)
+      ProcessMultiPart(M,CT, ContentFields)
     else if CompareText('APPLICATION/X-WWW-FORM-URLENCODED',CT)=0 then
-      ProcessUrlEncoded(M)
+      ProcessUrlEncoded(M, ContentFields)
     else
       begin
 {$ifdef CGIDEBUG}
@@ -465,7 +465,7 @@ begin
 {$endif}
   FQueryString:=GetEnvironmentVariable('QUERY_STRING');
   If (FQueryString<>'') then
-    ProcessQueryString(FQueryString);
+    ProcessQueryString(FQueryString, QueryFields);
 {$ifdef CGIDEBUG}
   SendMethodExit('InitGetVars');
 {$endif}

packages/fcl-web/src/fpcgi.pp

@@ -75,12 +75,14 @@ end;
 
 function TCGIApplication.GetModuleName(Arequest: TRequest): string;
 
-
 begin
   If (FModuleVar<>'') then
-    Result:=ARequest.QueryFields.Values[FModuleVar];
+    Result:=ARequest.QueryFields.Values[FModuleVar];//Module name from query parameter using the FModuleVar as parameter name (default is 'Module')
   If (Result='') then
+  begin
+    if (Pos('/', ARequest.PathInfo[2]) <= 0) and AllowDefaultModule then Exit;//There is only 1 '/' in ARequest.PathInfo -> only ActionName is there -> use default module
     Result:=ARequest.GetNextPathInfo;
+  end;
 end;
 
 function TCGIApplication.FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;

packages/fcl-web/src/fptemplate.pp

@@ -28,14 +28,20 @@ Const
   MaxDelimLength    = 5;
   
 Type
-  TParseDelimiter = String[5];
+  TParseDelimiter = String[MaxDelimLength];
   
 Var
-  DefaultStartDelimiter : TParseDelimiter = '{';
-  DefaultEndDelimiter  : TParseDelimiter = '}';
+  DefaultStartDelimiter : TParseDelimiter = '{';           //Template tag start                  |If you want Delphi-like, set it to '<#'
+  DefaultEndDelimiter  : TParseDelimiter = '}';            //Template tag end                    |                                   '>'
+  DefaultParamStartDelimiter  : TParseDelimiter = '[-';    //Tag parameter start                 |                                   ' '
+  DefaultParamEndDelimiter    : TParseDelimiter = '-]';    //Tag parameter end                   |                                   '"'
+  DefaultParamValueSeparator  : TParseDelimiter = '=';     //Tag parameter name/value separator  |                                   '="'
+                                                           //                                    |for tags like <#TagName paramname1="paramvalue1" paramname2="paramvalue2">
 
 Type
-  TGetParamEvent = Procedure(Sender : TObject; Const ParamName : String; Out AValue : String) Of Object;
+  TGetParamEvent = Procedure(Sender : TObject; Const ParamName : String; Out AValue : String) Of Object;                              //for simple template tag support only (ex: {Name})
+  TReplaceTagEvent = Procedure(Sender : TObject; Const TagString : String; TagParams:TStringList; Out ReplaceText : String) Of Object;//for tags with parameters support
+
 
   { TTemplateParser }
 
@@ -45,9 +51,15 @@ Type
     FMaxParseDepth : Integer;
     FEndDelimiter: TParseDelimiter;
     FStartDelimiter: TParseDelimiter;
-    FRecursive: Boolean;
-    FValues : TStringList;
-    FOnGetParam: TGetParamEvent;
+    FParamStartDelimiter: TParseDelimiter;
+    FParamEndDelimiter: TParseDelimiter;
+    FParamValueSeparator: TParseDelimiter;
+    FAllowTagParams: Boolean; //default is false -> simple template tags allowed only [FValues, FOnGetParam (optional) used];
+                              //if true -> template tags with parameters allowed, [FOnReplaceTag] is used for all tag replacements
+    FRecursive: Boolean;                                   //when only simple tags are used in a template (AllowTagParams=false), the replacement can
+    FValues : TStringList;                                 //contain further tags for recursive processing (only used when no tag params are allowed)
+    FOnGetParam: TGetParamEvent;                           //Event handler to use for templates containing simple tags only (ex: {Name})
+    FOnReplaceTag: TReplaceTagEvent;                       //Event handler to use for templates containing tags with parameters (ex: <#TagName paramname1="paramvalue1" paramname2="paramvalue2">)
     function GetDelimiter(Index: integer): TParseDelimiter;
     function GetValue(Key : String): String;
     procedure SetDelimiter(Index: integer; const AValue: TParseDelimiter);
@@ -56,15 +68,22 @@ Type
     Constructor Create;
     Destructor Destroy; override;
     Procedure Clear;
-    Function GetParam(Const Key : String; Out AValue : String) : Boolean;
+    Function ReplaceTag(const Key: String; TagParams:TStringList; out ReplaceWith: String): Boolean;//used only when AllowTagParams = true
+    Function GetParam(Const Key : String; Out AValue : String) : Boolean;                           //used only when AllowTagParams = false
+    Procedure GetTagParams(var TagName:String; var TagParams : TStringList) ;
     Function ParseString(Src : String) : String;
     Function ParseStream(Src : TStream; Dest : TStream) : Integer; // Wrapper, Returns number of bytes written.
-    Procedure ParseStrings(Src : TStrings; Dest : TStrings) ; // Wrapper
-    Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam;  // Called if not found in values
-    Property StartDelimiter : TParseDelimiter Index 1 Read GetDelimiter Write SetDelimiter; // Start char/string, default '}'
-    Property EndDelimiter : TParseDelimiter Index 2 Read GetDelimiter Write SetDelimiter;  // end char/string, default '}'
-    Property Values[Key : String] : String Read GetValue Write SetValue; // Contains static values.
-    Property Recursive : Boolean Read FRecursive Write FRecursive;
+    Procedure ParseStrings(Src : TStrings; Dest : TStrings) ;      // Wrapper
+    Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam;               // Called if not found in values  //used only when AllowTagParams = false
+    Property OnReplaceTag : TReplaceTagEvent Read FOnReplaceTag Write FOnReplaceTag;       // Called if a tag found          //used only when AllowTagParams = true
+    Property StartDelimiter : TParseDelimiter Index 1 Read GetDelimiter Write SetDelimiter;// Start char/string, default '}'
+    Property EndDelimiter : TParseDelimiter Index 2 Read GetDelimiter Write SetDelimiter;  // end char/string, default '{'
+    Property ParamStartDelimiter : TParseDelimiter Index 3 Read GetDelimiter Write SetDelimiter;
+    Property ParamEndDelimiter : TParseDelimiter Index 4 Read GetDelimiter Write SetDelimiter;
+    Property ParamValueSeparator : TParseDelimiter Index 5 Read GetDelimiter Write SetDelimiter;
+    Property Values[Key : String] : String Read GetValue Write SetValue; // Contains static values.                          //used only when AllowTagParams = false
+    Property Recursive : Boolean Read FRecursive Write FRecursive;                                                           //used only when AllowTagParams = false
+    Property AllowTagParams : Boolean Read FAllowTagParams Write FAllowTagParams;
   end;
 
   { TFPCustomTemplate }
@@ -73,11 +92,17 @@ Type
   private
     FEndDelimiter: TParseDelimiter;
     FStartDelimiter: TParseDelimiter;
+    FParamStartDelimiter: TParseDelimiter;
+    FParamEndDelimiter: TParseDelimiter;
+    FParamValueSeparator: TParseDelimiter;
     FFileName: String;
     FTemplate: String;
-    FOnGetParam: TGetParamEvent;
+    FOnGetParam: TGetParamEvent;                                                                                             //used only when AllowTagParams = false
+    FOnReplaceTag: TReplaceTagEvent;                                                                                         //used only when AllowTagParams = true
+    FAllowTagParams: Boolean;
   Protected
-    Procedure GetParam(Sender : TObject; Const ParamName : String; Out AValue : String);virtual;
+    Procedure GetParam(Sender : TObject; Const ParamName : String; Out AValue : String);virtual;                             //used only when AllowTagParams = false
+    Procedure ReplaceTag(Sender : TObject; Const TagName: String; TagParams:TStringList; Out AValue: String);virtual;        //used only when AllowTagParams = true
     Function CreateParser : TTemplateParser; virtual;
   Public
     Function HasContent : Boolean;
@@ -85,15 +110,22 @@ Type
     Procedure Assign(Source : TPersistent); override;
     Property StartDelimiter : TParseDelimiter Read FStartDelimiter Write FStartDelimiter;
     Property EndDelimiter : TParseDelimiter Read FEndDelimiter Write FEndDelimiter;
+    Property ParamStartDelimiter : TParseDelimiter Read FParamStartDelimiter Write FParamStartDelimiter;
+    Property ParamEndDelimiter : TParseDelimiter Read FParamEndDelimiter Write FParamEndDelimiter;
+    Property ParamValueSeparator : TParseDelimiter Read FParamValueSeparator Write FParamValueSeparator;
     Property FileName : String Read FFileName Write FFileName;
     Property Template : String Read FTemplate Write FTemplate;
     Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam;
+    Property OnReplaceTag : TReplaceTagEvent Read FOnReplaceTag Write FOnReplaceTag;
+    Property AllowTagParams : Boolean Read FAllowTagParams Write FAllowTagParams;
   end;
   
   TFPTemplate = Class(TFPCustomTemplate)
   Published
     Property FileName;
     Property Template;
+//    Property AllowTagParams;
+//    Property OnReplaceTag;
   end;
   
   ETemplateParser = Class(Exception);
@@ -128,6 +160,8 @@ begin
   FValue:=AValue;
 end;
 
+{ TTemplateParser }
+
 function TTemplateParser.GetValue(Key : String): String;
 
 Var
@@ -145,10 +179,14 @@ end;
 
 function TTemplateParser.GetDelimiter(Index: integer): TParseDelimiter;
 begin
-  If Index=1 then
-    Result:=FStartDelimiter
-  else
-    Result:=FEndDelimiter;
+  case Index of
+  1: Result:=FStartDelimiter;
+  2: Result:=FEndDelimiter;
+  3: Result:=FParamStartDelimiter;
+  4: Result:=FParamEndDelimiter;
+    else
+     Result:=FParamValueSeparator;
+  end;
 end;
 
 procedure TTemplateParser.SetDelimiter(Index: integer;
@@ -156,10 +194,14 @@ procedure TTemplateParser.SetDelimiter(Index: integer;
 begin
   If Length(AValue)=0 then
     Raise ETemplateParser.Create(SErrNoEmptyDelimiters);
-  If Index=1 then
-    FStartDelimiter:=AValue
-  else
-    FEndDelimiter:=AValue;
+  case Index of
+    1: FStartDelimiter:=AValue;
+    2: FEndDelimiter:=AValue;
+    3: FParamStartDelimiter:=AValue;
+    4: FParamEndDelimiter:=AValue;
+      else
+       FParamValueSeparator:=AValue;
+  end;
 
 end;
 
@@ -167,8 +209,7 @@ procedure TTemplateParser.SetValue(Key : String; const AValue: String);
 
 Var
   I : Integer;
-  SI : TStringItem;
-  
+
 begin
   If (AValue='') then
     begin
@@ -200,9 +241,14 @@ end;
 constructor TTemplateParser.Create;
 
 begin
+  FParseLevel:=0;
   FMaxParseDepth:=MaxParseDepth;
   FStartDelimiter:=DefaultStartDelimiter;
   FEndDelimiter:=DefaultEndDelimiter;
+  FParamStartDelimiter:=DefaultParamStartDelimiter;
+  FParamEndDelimiter:=DefaultParamEndDelimiter;
+  FParamValueSeparator:=DefaultParamValueSeparator;
+  FAllowTagParams := false;
 end;
 
 destructor TTemplateParser.Destroy;
@@ -247,6 +293,13 @@ begin
     AValue:=ParseString(AValue);
 end;
 
+function TTemplateParser.ReplaceTag(const Key: String; TagParams:TStringList; out ReplaceWith: String): Boolean;
+begin
+  Result:=Assigned(FOnReplaceTag);
+  If Result then
+    FOnReplaceTag(Self,Key,TagParams,ReplaceWith);
+end;
+
 Function FindDelimiter(SP : PChar; D : TParseDelimiter; MaxLen : Integer) : PChar; Inline;
 
 Var
@@ -298,62 +351,168 @@ begin
   Move(P^,S[Slen+1],NChars);
 end;
 
+procedure TTemplateParser.GetTagParams(var TagName:String; var TagParams : TStringList) ;
+var
+  I,SLen:Integer;
+  TS,TM,TE,SP,P : PChar;
+  PName, PValue, TP : String;
+  IsFirst:Boolean;
+begin
+  SLen:=Length(TagName);
+  if SLen=0 then exit;
+
+  IsFirst := true;
+  SP:=PChar(TagName);
+  TP := TagName;
+  P:=SP;
+  while (P-SP<SLen) do
+  begin
+    TS:=FindDelimiter(P,FParamStartDelimiter,SLen-(P-SP));
+    if (TS<>Nil) then
+    begin//Found param start delimiter
+      if IsFirst then
+      begin//Get the real Tag name
+        IsFirst := false;
+        I := 1;
+        while not (P[I] in [#0..' ']) do Inc(I);
+        SetLength(TP, I);
+        Move(P^, TP[1], I);
+      end;
+      inc(TS, Length(FParamStartDelimiter));
+      I:=TS-P;//index of param name
+      TM:=FindDelimiter(TS,FParamValueSeparator,SLen-I+1);
+      if (TM<>Nil) then
+      begin//Found param value separator
+        I:=TM-TS;//lenght of param name
+        SetLength(PName, I);
+        Move(TS^, PName[1], I);//param name
+        inc(TS, Length(FParamValueSeparator) + I);
+        I := TS - P;//index of param value
+        TE:=FindDelimiter(TS,FParamEndDelimiter, SLen-I+1);
+        if (TE<>Nil) then
+        begin//Found param end
+          I:=TE-TS;//Param length
+          Setlength(PValue,I);
+          Move(TS^,PValue[1],I);//Param value
+          TagParams.Add(Trim(PName) + '=' + PValue);//Param names cannot contain '='
+          P:=TE+Length(FParamEndDelimiter);
+          TS:=P;
+        end else break;
+      end else break;
+    end else break;
+  end;
+  TagName := Trim(TP);
+end;
+
 function TTemplateParser.ParseString(Src: String): String;
 
 Var
-  PN,PV : String;
-  i,RLen,SLen,STlen : Integer;
+  PN,PV,ReplaceWith : String;
+  i,SLen : Integer;
   TS,TE,SP,P : PChar;
-
+  TagParams:TStringList;
 begin
-  Inc(FParseLevel);
-  If FParseLevel>FMaxParseDepth then
-    Raise ETemplateParser.CreateFmt(SErrParseDepthExceeded,[FMaxParseDepth]);
-  SLen:=Length(Src); // Minimum
-  If SLen=0 then
-    exit;
-  STLen:=Length(FStartDelimiter);
-  Result:='';
-  SP:=PChar(Src);
-  P:=SP;
-  While (P-SP<SLen) do
-    begin
-    TS:=FindDelimiter(P,FStartDelimiter,SLen-(P-SP));
-    If (TS=Nil) then
-      begin
-      TS:=P;
-      P:=SP+SLen
-      end
-    else
+  if FAllowTagParams then
+  begin//template tags with parameters are allowed
+    SLen:=Length(Src);
+    If SLen=0 then
+      exit;
+    Result:='';
+    SP:=PChar(Src);
+    P:=SP;
+    While (P-SP<SLen) do
       begin
-      I:=TS-P;
-      TE:=FindDelimiter(TS,FendDelimiter,SLen-I+1);
-      If (TE=Nil) then
-        begin
+      TS:=FindDelimiter(P,FStartDelimiter,SLen-(P-SP));
+      If (TS=Nil) then
+        begin//Tag Start Delimiter not found
         TS:=P;
         P:=SP+SLen;
         end
       else
         begin
-        // Add text prior to template to result
-        AddToString(Result,P,I);
-        // retrieve template name
-        inc(TS,Length(FendDelimiter));
-        I:=TE-TS;
-        Setlength(PN,I);
-        Move(TS^,PN[1],I);
-        If GetParam(PN,PV) then
+        I:=TS-P;
+        TE:=FindDelimiter(TS,FEndDelimiter,SLen-I+1);
+        If (TE=Nil) then
+          begin//Tag End Delimiter not found
+          TS:=P;
+          P:=SP+SLen;
+          end
+        else//Found start and end delimiters for the Tag
           begin
-          Result:=Result+PV;
+          // Add text prior to template tag to result
+          AddToString(Result,P,I);
+          // Retrieve the full template tag (only tag name if no params specified)
+          inc(TS,Length(FStartDelimiter));//points to first char of Tag name now
+          I:=TE-TS;//full Tag length
+          Setlength(PN,I);
+          Move(TS^,PN[1],I);//full Tag string (only tag name if no params specified)
+          TagParams := TStringList.Create;
+          try
+            TagParams.Sorted := True;
+            GetTagParams(PN, Tagparams);
+            If ReplaceTag(PN,TagParams,ReplaceWith) then
+              Result:=Result+ReplaceWith;
+          finally
+            TagParams.Free;
+          end;
+          P:=TE+Length(FEndDelimiter);
+          TS:=P;
           end;
-        P:=TE+Length(FEndDelimiter);
+        end
+      end;
+    I:=P-TS;
+    If (I>0) then
+      AddToString(Result,TS,I);
+  end else begin//template tags with parameters are not allowed
+    Inc(FParseLevel);
+    If FParseLevel>FMaxParseDepth then
+      Raise ETemplateParser.CreateFmt(SErrParseDepthExceeded,[FMaxParseDepth]);
+    SLen:=Length(Src); // Minimum
+    If SLen=0 then
+      exit;
+//    STLen:=Length(FStartDelimiter);
+    Result:='';
+    SP:=PChar(Src);
+    P:=SP;
+    While (P-SP<SLen) do
+      begin
+      TS:=FindDelimiter(P,FStartDelimiter,SLen-(P-SP));
+      If (TS=Nil) then
+        begin
         TS:=P;
-        end;
-      end
-    end;
-  I:=P-TS;
-  If (I>0) then
-    AddToString(Result,TS,I);
+        P:=SP+SLen
+        end
+      else
+        begin
+        I:=TS-P;
+        TE:=FindDelimiter(TS,FEndDelimiter,SLen-I+1);
+        If (TE=Nil) then
+          begin
+          TS:=P;
+          P:=SP+SLen;
+          end
+        else
+          begin
+          // Add text prior to template to result
+          AddToString(Result,P,I);
+          // retrieve template name
+          inc(TS,Length(FStartDelimiter));
+          I:=TE-TS;
+          Setlength(PN,I);
+          Move(TS^,PN[1],I);
+          If GetParam(PN,PV) then
+            begin
+            Result:=Result+PV;
+            end;
+          P:=TE+Length(FEndDelimiter);
+          TS:=P;
+          end;
+        end
+      end;
+    I:=P-TS;
+    If (I>0) then
+      AddToString(Result,TS,I);
+  end;
 end;
 
 function TTemplateParser.ParseStream(Src: TStream; Dest: TStream): Integer;
@@ -370,6 +529,7 @@ begin
   Finally
     SS.Free;
   end;
+  FParseLevel := 0;
   R:=ParseString(S);
   Result:=Length(R);
   If (Result>0) then
@@ -383,28 +543,48 @@ Var
 
 begin
   For I:=0 to Src.Count-1 do
+  begin
+    FParseLevel := 0;
     Dest.Add(ParseString(Src[i]));
+  end;
 end;
 
 { TFPCustomTemplate }
 
-procedure TFPCustomTemplate.GetParam(Sender: TObject; const ParamName: String;
-  out AValue: String);
+procedure TFPCustomTemplate.GetParam(Sender: TObject; const ParamName: String; out AValue: String);
   
 begin
   If Assigned(FOnGetParam) then
    FOnGetParam(Self,ParamName,AValue);
 end;
 
+procedure TFPCustomTemplate.ReplaceTag(Sender: TObject; const TagName: String; TagParams:TStringList; Out AValue: String);
+
+begin
+  If Assigned(FOnReplaceTag) then
+  begin
+    FOnReplaceTag(Self,TagName,TagParams,AValue);
+  end;
+end;
+
 function TFPCustomTemplate.CreateParser: TTemplateParser;
 
 begin
   Result:=TTemplateParser.Create;
+  Result.FParseLevel := 0;
   If (FStartDelimiter<>'') then
     Result.StartDelimiter:=FStartDelimiter;
   If (FEndDelimiter<>'') then
     Result.EndDelimiter:=FEndDelimiter;
+  If (FParamStartDelimiter<>'') then
+    Result.ParamStartDelimiter:=FParamStartDelimiter;
+  If (FParamEndDelimiter<>'') then
+    Result.ParamEndDelimiter:=FParamEndDelimiter;
+  If (FParamValueSeparator<>'') then
+    Result.ParamValueSeparator:=FParamValueSeparator;
   Result.OnGetParam:=@GetParam;
+  Result.OnReplaceTag:=@ReplaceTag;
+  Result.AllowTagParams:=FAllowTagParams;
 end;
 
 function TFPCustomTemplate.HasContent: Boolean;
@@ -461,9 +641,14 @@ begin
     T:=Source as TFPCustomTemplate;
     FEndDelimiter:=T.EndDelimiter;
     FStartDelimiter:=T.StartDelimiter;
+    FParamEndDelimiter:=T.ParamEndDelimiter;
+    FParamStartDelimiter:=T.ParamStartDelimiter;
+    FParamValueSeparator:=T.ParamValueSeparator;
     FFileName:=T.FileName;
     FTemplate:=T.Template;
     FOnGetParam:=T.OnGetParam;
+    FOnReplaceTag:=T.OnReplaceTag;
+    FAllowTagParams := T.AllowTagParams;
     end
   else
     inherited Assign(Source);

packages/fcl-web/src/httpdefs.pp

@@ -268,9 +268,9 @@ type
     procedure ParseFirstHeaderLine(const line: String);override;
     function GetFirstHeaderLine: String;
   Protected
-    Procedure ProcessMultiPart(Stream : TStream; Const Boundary : String); virtual;
-    Procedure ProcessQueryString(Const FQueryString : String); virtual;
-    procedure ProcessURLEncoded(Stream : TStream); virtual;
+    Procedure ProcessMultiPart(Stream : TStream; Const Boundary : String;SL:TStrings); virtual;
+    Procedure ProcessQueryString(Const FQueryString : String; SL:TStrings); virtual;
+    procedure ProcessURLEncoded(Stream : TStream;SL:TStrings); virtual;
     Function  GetTempUploadFileName : String; virtual;
     Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
   public
@@ -656,6 +656,7 @@ constructor THttpHeader.Create;
 begin
   FCookieFields:=TStringList.Create;
   FQueryFields:=TStringList.Create;
+  FContentFields:=TStringList.Create;
   FHttpVersion := '1.1';
 end;
 
@@ -664,6 +665,7 @@ destructor THttpHeader.Destroy;
 begin
   FreeAndNil(FCookieFields);
   FreeAndNil(FQueryFields);
+  FreeAndNil(FContentFields);
   inherited Destroy;
 end;
 
@@ -935,7 +937,7 @@ begin
     Result := Result + ' HTTP/' + HttpVersion;
 end;
 
-Procedure TRequest.ProcessQueryString(Const FQueryString : String);
+Procedure TRequest.ProcessQueryString(Const FQueryString : String; SL:TStrings);
 
 
 var
@@ -1038,7 +1040,7 @@ begin
     if (QueryItem<>'') then
       begin
       QueryItem:=HTTPDecode(QueryItem);
-      FQueryFields.Add(QueryItem);
+      SL.Add(QueryItem);
       end;
     end;
 {$ifdef CGIDEBUG}SendMethodExit('ProcessQueryString');{$endif CGIDEBUG}
@@ -1050,7 +1052,7 @@ begin
 end;
 
 
-Procedure TRequest.ProcessMultiPart(Stream : TStream; Const Boundary : String);
+Procedure TRequest.ProcessMultiPart(Stream : TStream; Const Boundary : String; SL:TStrings);
 
 Var
   L : TList;
@@ -1129,7 +1131,7 @@ begin
         end;
       FI.Free;
       L[i]:=Nil;
-      QueryFields.Add(Key+'='+Value)
+      SL.Add(Key+'='+Value)
       end;
   Finally
     For I:=0 to L.Count-1 do
@@ -1139,7 +1141,7 @@ begin
 {$ifdef CGIDEBUG}  SendMethodExit('ProcessMultiPart');{$endif CGIDEBUG}
 end;
 
-Procedure TRequest.ProcessURLEncoded(Stream: TStream);
+Procedure TRequest.ProcessURLEncoded(Stream: TStream; SL:TStrings);
 
 var
   S : String;
@@ -1149,7 +1151,7 @@ begin
   SetLength(S,Stream.Size); // Skip added Null.
   Stream.ReadBuffer(S[1],Stream.Size);
 {$ifdef CGIDEBUG}SendDebugFmt('Query string : %s',[s]);{$endif CGIDEBUG}
-  ProcessQueryString(S);
+  ProcessQueryString(S,SL);
 {$ifdef CGIDEBUG} SendMethodEnter('ProcessURLEncoded');{$endif CGIDEBUG}
 end;