mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 01:09:31 +02:00
* 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 -
This commit is contained in:
michael
parent
20fd2d692f
commit
af63b5466b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
164
packages/fcl-web/fptemplate.txt
Normal file
164
packages/fcl-web/fptemplate.txt
Normal file
@ -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.
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
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
|
||||
TS:=P;
|
||||
P:=SP+SLen
|
||||
end
|
||||
else
|
||||
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);
|
||||
P:=TE+Length(FEndDelimiter);
|
||||
TS:=P;
|
||||
end;
|
||||
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);
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user