parent
2019b6b929
commit
4babd13dc7
|
|
@ -0,0 +1,109 @@
|
|||
{
|
||||
This file is part of restemplate.
|
||||
|
||||
Copyright (C) 2015 Andreas Schneider
|
||||
|
||||
restemplate is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
restemplate is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with restemplate. If not, see <http://www.gnu.org/licenses/>.
|
||||
}
|
||||
unit UFilter;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$modeswitch advancedrecords}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, RegExpr, fgl;
|
||||
|
||||
type
|
||||
|
||||
{ THighlightFilter }
|
||||
|
||||
THighlightFilter = class
|
||||
Expression: TRegExpr;
|
||||
FGColor: Byte;
|
||||
BGColor: Byte;
|
||||
constructor Create(AString: String);
|
||||
destructor Destroy; override;
|
||||
class var
|
||||
FilterExpression: TRegExpr;
|
||||
ParamExpression: TRegExpr;
|
||||
end;
|
||||
TFilterList = specialize TFPGObjectList<THighlightFilter>;
|
||||
|
||||
{ THighlight }
|
||||
|
||||
THighlight = record
|
||||
FGColor: Byte;
|
||||
BGColor: Byte;
|
||||
Start: Integer;
|
||||
Length: Integer;
|
||||
class operator =(A, B: THighlight): Boolean;
|
||||
end;
|
||||
THighlights = specialize TFPGList<THighlight>;
|
||||
|
||||
function CompareHighlights(const AHL1: THighlight; const AHL2: THighlight): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
{ THighlightFilter }
|
||||
|
||||
constructor THighlightFilter.Create(AString: String);
|
||||
begin
|
||||
FGColor := $FF;
|
||||
BGColor := $FF;
|
||||
if FilterExpression.Exec(AString) then
|
||||
begin
|
||||
Expression := TRegExpr.Create(Copy(AString, 1, FilterExpression.MatchPos[0] - 1));
|
||||
if ParamExpression.Exec(FilterExpression.Match[0]) then
|
||||
repeat
|
||||
if ParamExpression.Match[1] = 'FG' then
|
||||
FGColor := StrToInt(ParamExpression.Match[2])
|
||||
else if ParamExpression.Match[1] = 'BG' then
|
||||
BGColor := StrToInt(ParamExpression.Match[2]);
|
||||
until not ParamExpression.ExecNext;
|
||||
end else
|
||||
Expression := TRegExpr.Create(AString);
|
||||
end;
|
||||
|
||||
destructor THighlightFilter.Destroy;
|
||||
begin
|
||||
Expression.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ THighlight }
|
||||
|
||||
class operator THighlight. = (A, B: THighlight): Boolean;
|
||||
begin
|
||||
Result := (A.Start = B.Start) and (A.Length = B.Length);
|
||||
end;
|
||||
|
||||
function CompareHighlights(const AHL1: THighlight; const AHL2: THighlight): Integer;
|
||||
begin
|
||||
if AHL1.Start = AHL2.Start then
|
||||
begin
|
||||
Result := AHL1.Length - AHL2.Length;
|
||||
end else
|
||||
Result := AHL1.Start - AHL2.Start;
|
||||
end;
|
||||
|
||||
initialization
|
||||
THighlightFilter.FilterExpression := TRegExpr.Create('( (FG|BG)(\d+))*$');
|
||||
THighlightFilter.ParamExpression := TRegExpr.Create('(FG|BG)(\d+)');
|
||||
finalization
|
||||
THighlightFilter.FilterExpression.Free;
|
||||
THighlightFilter.ParamExpression.Free;
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,428 @@
|
|||
{
|
||||
This file is part of restemplate.
|
||||
|
||||
Copyright (C) 2015 Andreas Schneider
|
||||
|
||||
restemplate is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
restemplate is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with restemplate. If not, see <http://www.gnu.org/licenses/>.
|
||||
}
|
||||
unit URestemplateApp;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CustApp,
|
||||
IniFiles, fphttpclient, jsonparser, JTemplate,
|
||||
UFilter;
|
||||
|
||||
type
|
||||
|
||||
{ TRestemplateApplication }
|
||||
|
||||
TRestemplateApplication = class(TCustomApplication)
|
||||
protected
|
||||
FConfigDir: String;
|
||||
FTemplateDir: String;
|
||||
FSessionIni: TIniFile;
|
||||
FTemplateName: String;
|
||||
FParser: TJTemplateParser;
|
||||
FHttp: TFPHTTPClient;
|
||||
FContent: TStringList;
|
||||
FFilters: TFilterList;
|
||||
FBeautify: Boolean;
|
||||
FURL: String;
|
||||
FMethod: String;
|
||||
//Main
|
||||
procedure DoRun; override;
|
||||
//Command processing
|
||||
function ProcessCommand(ALine: String): Boolean;
|
||||
procedure CmdAskUser(AName: String);
|
||||
procedure CmdHeader(AHeader: String);
|
||||
procedure CmdBasicAuth(AData: String);
|
||||
procedure CmdHighlight(AData: String);
|
||||
procedure ProcessCall(AURL: String);
|
||||
//Helper
|
||||
procedure ListProfiles;
|
||||
procedure WriteContent;
|
||||
public
|
||||
constructor Create; overload;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
strutils, crt, UCRTHelper, fpjson, DOM, XMLRead, XMLWrite;
|
||||
|
||||
type
|
||||
TContentType = (ctOther, ctJSON, ctXML);
|
||||
|
||||
function IdentifyContentType(AString: String; out ContentType: TContentType): Boolean;
|
||||
begin
|
||||
if Pos('application/json', AString) > 0 then
|
||||
ContentType := ctJSON
|
||||
else if Pos('application/xml', AString) > 0 then
|
||||
ContentType := ctXML
|
||||
else
|
||||
ContentType := ctOther;
|
||||
|
||||
Result := (ContentType <> ctOther);
|
||||
end;
|
||||
|
||||
{ TRestemplateApplication }
|
||||
|
||||
procedure TRestemplateApplication.DoRun;
|
||||
var
|
||||
templateFile: String;
|
||||
line: String;
|
||||
data: TextFile;
|
||||
commandMode: Boolean;
|
||||
begin
|
||||
templateFile := FTemplateDir + ParamStr(1) + '.rest';
|
||||
|
||||
if ParamCount <> 1 then
|
||||
begin
|
||||
Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' <profile or file>');
|
||||
Writeln;
|
||||
ListProfiles;
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
if FileExists(ParamStr(1)) then
|
||||
begin
|
||||
AssignFile(data, ParamStr(1));
|
||||
FTemplateName := ExtractFileName(ParamStr(1));
|
||||
if AnsiEndsStr('.rest', FTemplateName) then
|
||||
FTemplateName := Copy(FTemplateName, 1, Length(FTemplateName) - 5);
|
||||
end else
|
||||
if FileExists(templateFile) then
|
||||
begin
|
||||
AssignFile(data, templateFile);
|
||||
FTemplateName := ParamStr(1);
|
||||
end else
|
||||
begin
|
||||
writeln('Template not found!');
|
||||
Halt(1);
|
||||
end;
|
||||
Reset(data);
|
||||
|
||||
FBeautify := False; //By default, we don't want to manipulate output.
|
||||
|
||||
commandMode := True;
|
||||
|
||||
try
|
||||
while not EOF(data) do
|
||||
begin
|
||||
ReadLn(data, line);
|
||||
if commandMode and (line <> '') and (line[1] <> '#') and
|
||||
not ProcessCommand(line) then
|
||||
begin
|
||||
commandMode := False;
|
||||
end;
|
||||
|
||||
if not commandMode then
|
||||
FContent.Add(line);
|
||||
end;
|
||||
|
||||
if FURL <> '' then
|
||||
ProcessCall(FURL);
|
||||
|
||||
finally
|
||||
CloseFile(data);
|
||||
end;
|
||||
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
function TRestemplateApplication.ProcessCommand(ALine: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if AnsiStartsStr('Ask ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdAskUser(Copy(ALine, 5, Length(ALine)));
|
||||
end else
|
||||
if AnsiStartsStr('Header ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdHeader(Copy(ALine, 8, Length(ALine)));
|
||||
end else
|
||||
if AnsiStartsStr('Method ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
FMethod := Copy(ALine, 8, Length(ALine));
|
||||
end else
|
||||
// We don't include the space here, since we also interpret this following
|
||||
// char as separator for username and password! (In case the username itself
|
||||
// contains a space.)
|
||||
if AnsiStartsStr('BasicAuth', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdBasicAuth(Copy(ALine, 10, Length(ALine)));
|
||||
end else
|
||||
if ALine = 'Beautify' then
|
||||
begin
|
||||
Result := True;
|
||||
FBeautify := True;
|
||||
end else
|
||||
if AnsiStartsStr('Highlight ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdHighlight(Copy(ALine, 11, Length(ALine)));
|
||||
end else
|
||||
if AnsiStartsStr('Call ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
FURL := Copy(ALine, 6, Length(ALine));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.CmdAskUser(AName: String);
|
||||
var
|
||||
value, default: String;
|
||||
begin
|
||||
default := FSessionIni.ReadString(FTemplateName, AName, '');
|
||||
value := Prompt(AName, default);
|
||||
|
||||
if value = '' then
|
||||
Halt(3); //Cancelled
|
||||
|
||||
FParser.Fields.Add(AName, value);
|
||||
|
||||
FSessionIni.WriteString(FTemplateName, AName, value);
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.CmdHeader(AHeader: String);
|
||||
var
|
||||
i: Integer;
|
||||
varName, varValue: String;
|
||||
begin
|
||||
FParser.Content := AHeader;
|
||||
FParser.Replace;
|
||||
AHeader := FParser.Content;
|
||||
|
||||
i := 1;
|
||||
while (i < Length(AHeader)) and (AHeader[i] <> ':') do
|
||||
Inc(i);
|
||||
|
||||
varName := Trim(Copy(AHeader, 1, i - 1));
|
||||
varValue := Trim(Copy(AHeader, i + 1, Length(AHeader)));
|
||||
|
||||
FHttp.AddHeader(varName, varValue);
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.CmdBasicAuth(AData: String);
|
||||
var
|
||||
separator: Char;
|
||||
i: Integer;
|
||||
begin
|
||||
separator := AData[1];
|
||||
i := 2;
|
||||
while (i < Length(AData)) and (AData[i] <> separator) do
|
||||
Inc(i);
|
||||
|
||||
FHttp.UserName := Copy(AData, 2, i - 2);
|
||||
FHttp.Password := Copy(AData, i + 1, Length(AData));
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.CmdHighlight(AData: String);
|
||||
begin
|
||||
FFilters.Add(THighlightFilter.Create(AData))
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.ProcessCall(AURL: String);
|
||||
var
|
||||
s: String;
|
||||
request, response: TStream;
|
||||
jsonParser: TJSONParser;
|
||||
jsonData: TJSONData;
|
||||
contentType: TContentType;
|
||||
xmlDoc: TXMLDocument;
|
||||
begin
|
||||
FParser.Content := AURL;
|
||||
FParser.Replace;
|
||||
AURL := FParser.Content;
|
||||
writeln('Calling ', AURL);
|
||||
|
||||
response := TMemoryStream.Create;
|
||||
request := nil;
|
||||
|
||||
if FContent.Count > 0 then
|
||||
begin
|
||||
request := TMemoryStream.Create;
|
||||
|
||||
// Variable replacement
|
||||
FParser.Content := FContent.Text;
|
||||
FParser.Replace;
|
||||
FContent.Text := FParser.Content;
|
||||
|
||||
FContent.SaveToStream(request);
|
||||
request.Position := 0;
|
||||
FHttp.RequestBody := request;
|
||||
end;
|
||||
|
||||
try
|
||||
FHttp.HTTPMethod(FMethod, AURL, response, []);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln;
|
||||
writeln('Failed! ', E.Message);
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
writeln;
|
||||
writeln('Status: ', FHttp.ResponseStatusCode, ' (', FHttp.ResponseStatusText, ')');
|
||||
writeln;
|
||||
writeln('Headers:');
|
||||
for s in FHttp.ResponseHeaders do
|
||||
writeln(' ', s);
|
||||
writeln;
|
||||
|
||||
response.Position := 0;
|
||||
|
||||
if FBeautify and IdentifyContentType(FHttp.GetHeader(FHttp.ResponseHeaders, 'Content-Type'), contentType) then
|
||||
begin
|
||||
case contentType of
|
||||
ctJSON:
|
||||
begin
|
||||
jsonParser := TJSONParser.Create(response);
|
||||
jsonData := jsonParser.Parse;
|
||||
FContent.Text := jsonData.FormatJSON;
|
||||
jsonData.Free;
|
||||
jsonParser.Free;
|
||||
WriteContent;
|
||||
end;
|
||||
ctXML:
|
||||
begin
|
||||
ReadXMLFile(xmlDoc, response);
|
||||
response.Size := 0;
|
||||
WriteXMLFile(xmlDoc, response);
|
||||
response.Position := 0;
|
||||
FContent.LoadFromStream(response);
|
||||
WriteContent;
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
FContent.LoadFromStream(response);
|
||||
WriteContent;
|
||||
end;
|
||||
|
||||
response.Free;
|
||||
request.Free;
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.ListProfiles;
|
||||
var
|
||||
sr: TSearchRec;
|
||||
begin
|
||||
Writeln('Known profiles:');
|
||||
if FindFirst(FTemplateDir + '*.rest', faAnyFile, sr) = 0 then
|
||||
begin
|
||||
repeat
|
||||
writeln(' ', Copy(sr.Name, 1, Length(sr.Name) - 5));
|
||||
until FindNext(sr) <> 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TRestemplateApplication.WriteContent;
|
||||
var
|
||||
i: Integer;
|
||||
matchPos, offset, lastPos: Integer;
|
||||
data: String;
|
||||
highlights: THighlights;
|
||||
highlight: THighlight;
|
||||
begin
|
||||
highlights := THighlights.Create;
|
||||
data := FContent.Text;
|
||||
|
||||
offset := 0;
|
||||
lastPos := 1;
|
||||
|
||||
for i := 0 to FFilters.Count - 1 do
|
||||
begin
|
||||
if FFilters[i].Expression.Exec(data) then
|
||||
begin
|
||||
repeat
|
||||
highlight.Start := FFilters[i].Expression.MatchPos[0];
|
||||
highlight.Length := FFilters[i].Expression.MatchLen[0];
|
||||
highlight.FGColor := FFilters[i].FGColor;
|
||||
highlight.BGColor := FFilters[i].BGColor;
|
||||
highlights.Add(highlight);
|
||||
until not FFilters[i].Expression.ExecNext;
|
||||
end;
|
||||
end;
|
||||
|
||||
highlights.Sort(@CompareHighlights);
|
||||
|
||||
// Sanitize highlights
|
||||
for i := 0 to highlights.Count - 2 do
|
||||
begin
|
||||
if (highlights[i].Start + highlights[i].Length) > highlights[i+1].Start then
|
||||
begin
|
||||
highlight := highlights[i];
|
||||
highlight.Length := highlights[i+1].Start - highlights[i].Start;
|
||||
highlights[i] := highlight;
|
||||
end;
|
||||
end;
|
||||
|
||||
for highlight in highlights do
|
||||
begin
|
||||
matchPos := highlight.Start;
|
||||
offset := highlight.Length;
|
||||
write(Copy(data, lastPos, matchPos - lastPos));
|
||||
if highlight.FGColor < $FF then
|
||||
TextColor(highlight.FGColor);
|
||||
if highlight.BGColor < $FF then
|
||||
TextBackground(highlight.BGColor);
|
||||
write(Copy(data, matchPos, offset));
|
||||
NormVideo;
|
||||
lastPos := matchPos + offset;
|
||||
end;
|
||||
|
||||
writeln(Copy(data, lastPos, Length(data)));
|
||||
|
||||
highlights.Free;
|
||||
end;
|
||||
|
||||
constructor TRestemplateApplication.Create;
|
||||
begin
|
||||
inherited Create(nil);
|
||||
StopOnException := True;
|
||||
|
||||
FConfigDir := GetAppConfigDir(False);
|
||||
FTemplateDir := FConfigDir + 'templates' + PathDelim;
|
||||
|
||||
FSessionIni := TIniFile.Create(FConfigDir + 'session.ini');
|
||||
FContent := TStringList.Create;
|
||||
FHttp := TFPHTTPClient.Create(Self);
|
||||
FFilters := TFilterList.Create;
|
||||
FParser := TJTemplateParser.Create;
|
||||
end;
|
||||
|
||||
destructor TRestemplateApplication.Destroy;
|
||||
begin
|
||||
FSessionIni.Free;
|
||||
FContent.Free;
|
||||
FHttp.Free;
|
||||
FFilters.Free;
|
||||
FParser.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -17,7 +17,9 @@
|
|||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
<UseVersionInfo Value="True"/>
|
||||
<MinorVersionNr Value="5"/>
|
||||
<StringTable LegalCopyright="Andreas Schneider" ProductName="restemplate" ProductVersion="0.5"/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="2">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
|
|
@ -55,7 +57,7 @@
|
|||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="2">
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="restemplate.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
|
@ -64,6 +66,14 @@
|
|||
<Filename Value="UCRTHelper.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="UFilter.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="URestemplateApp.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
|
|
|||
436
restemplate.pas
436
restemplate.pas
|
|
@ -20,440 +20,18 @@
|
|||
program restemplate;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$modeswitch advancedrecords}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, strutils, IniFiles, fgl,
|
||||
fphttpclient,
|
||||
JTemplate,
|
||||
fpjson, jsonparser,
|
||||
DOM, XMLRead, XMLWrite,
|
||||
RegExpr, crt, UCRTHelper;
|
||||
URestemplateApp, UFilter, UCRTHelper;
|
||||
|
||||
type
|
||||
TContentType = (ctOther, ctJSON, ctXML);
|
||||
|
||||
{ THighlightFilter }
|
||||
|
||||
THighlightFilter = class
|
||||
Expression: TRegExpr;
|
||||
FGColor: Byte;
|
||||
BGColor: Byte;
|
||||
constructor Create(AString: String);
|
||||
destructor Destroy; override;
|
||||
class var
|
||||
FilterExpression: TRegExpr;
|
||||
ParamExpression: TRegExpr;
|
||||
end;
|
||||
TFilterList = specialize TFPGObjectList<THighlightFilter>;
|
||||
|
||||
{ THighlight }
|
||||
|
||||
THighlight = record
|
||||
FGColor: Byte;
|
||||
BGColor: Byte;
|
||||
Start: Integer;
|
||||
Length: Integer;
|
||||
class operator =(A, B: THighlight): Boolean;
|
||||
end;
|
||||
THighlights = specialize TFPGList<THighlight>;
|
||||
{$R *.res}
|
||||
|
||||
var
|
||||
data: TextFile;
|
||||
line: String;
|
||||
parser: TJTemplateParser;
|
||||
http: TFPHTTPClient;
|
||||
method, url: String;
|
||||
content: TStringList;
|
||||
commandMode: Boolean;
|
||||
configDir, templateDir: String;
|
||||
templateFile, templateName: String;
|
||||
sessionIni: TIniFile;
|
||||
beautify: Boolean;
|
||||
filters: TFilterList;
|
||||
|
||||
{ THighlight }
|
||||
|
||||
class operator THighlight. = (A, B: THighlight): Boolean;
|
||||
Application: TRestemplateApplication;
|
||||
begin
|
||||
Result := (A.Start = B.Start) and (A.Length = B.Length);
|
||||
end;
|
||||
|
||||
|
||||
{ THighlightFilter }
|
||||
|
||||
constructor THighlightFilter.Create(AString: String);
|
||||
begin
|
||||
FGColor := $FF;
|
||||
BGColor := $FF;
|
||||
if FilterExpression.Exec(AString) then
|
||||
begin
|
||||
Expression := TRegExpr.Create(Copy(AString, 1, FilterExpression.MatchPos[0] - 1));
|
||||
if ParamExpression.Exec(FilterExpression.Match[0]) then
|
||||
repeat
|
||||
if ParamExpression.Match[1] = 'FG' then
|
||||
FGColor := StrToInt(ParamExpression.Match[2])
|
||||
else if ParamExpression.Match[1] = 'BG' then
|
||||
BGColor := StrToInt(ParamExpression.Match[2]);
|
||||
until not ParamExpression.ExecNext;
|
||||
end else
|
||||
Expression := TRegExpr.Create(AString);
|
||||
end;
|
||||
|
||||
destructor THighlightFilter.Destroy;
|
||||
begin
|
||||
Expression.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ Main }
|
||||
|
||||
procedure CmdAskUser(AName: String);
|
||||
var
|
||||
value, default: String;
|
||||
begin
|
||||
default := sessionIni.ReadString(templateName, AName, '');
|
||||
value := Prompt(AName, default);
|
||||
|
||||
if value = '' then
|
||||
Halt(3); //Cancelled
|
||||
|
||||
parser.Fields.Add(AName, value);
|
||||
|
||||
sessionIni.WriteString(templateName, AName, value);
|
||||
end;
|
||||
|
||||
procedure CmdHeader(AHeader: String);
|
||||
var
|
||||
i: Integer;
|
||||
name, value: String;
|
||||
begin
|
||||
parser.Content := AHeader;
|
||||
parser.Replace;
|
||||
AHeader := parser.Content;
|
||||
|
||||
i := 1;
|
||||
while (i < Length(AHeader)) and (AHeader[i] <> ':') do
|
||||
Inc(i);
|
||||
|
||||
name := Trim(Copy(AHeader, 1, i - 1));
|
||||
value := Trim(Copy(AHeader, i + 1, Length(AHeader)));
|
||||
|
||||
http.AddHeader(name, value);
|
||||
end;
|
||||
|
||||
function IdentifyContentType(AString: String; out ContentType: TContentType): Boolean;
|
||||
begin
|
||||
if Pos('application/json', AString) > 0 then
|
||||
ContentType := ctJSON
|
||||
else if Pos('application/xml', AString) > 0 then
|
||||
ContentType := ctXML
|
||||
else
|
||||
ContentType := ctOther;
|
||||
|
||||
Result := (ContentType <> ctOther);
|
||||
end;
|
||||
|
||||
function CompareHighlights(const AHL1: THighlight; const AHL2: THighlight): Integer;
|
||||
begin
|
||||
if AHL1.Start = AHL2.Start then
|
||||
begin
|
||||
Result := AHL1.Length - AHL2.Length;
|
||||
end else
|
||||
Result := AHL1.Start - AHL2.Start;
|
||||
end;
|
||||
|
||||
procedure WriteContent;
|
||||
var
|
||||
i: Integer;
|
||||
matchPos, offset, lastPos: Integer;
|
||||
data: String;
|
||||
highlights: THighlights;
|
||||
highlight: THighlight;
|
||||
begin
|
||||
highlights := THighlights.Create;
|
||||
data := content.Text;
|
||||
|
||||
offset := 0;
|
||||
lastPos := 1;
|
||||
|
||||
for i := 0 to filters.Count - 1 do
|
||||
begin
|
||||
if filters[i].Expression.Exec(data) then
|
||||
begin
|
||||
repeat
|
||||
highlight.Start := filters[i].Expression.MatchPos[0];
|
||||
highlight.Length := filters[i].Expression.MatchLen[0];
|
||||
highlight.FGColor := filters[i].FGColor;
|
||||
highlight.BGColor := filters[i].BGColor;
|
||||
highlights.Add(highlight);
|
||||
until not filters[i].Expression.ExecNext;
|
||||
end;
|
||||
end;
|
||||
|
||||
highlights.Sort(@CompareHighlights);
|
||||
|
||||
// Sanitize highlights
|
||||
for i := 0 to highlights.Count - 2 do
|
||||
begin
|
||||
if (highlights[i].Start + highlights[i].Length) > highlights[i+1].Start then
|
||||
begin
|
||||
highlight := highlights[i];
|
||||
highlight.Length := highlights[i+1].Start - highlights[i].Start;
|
||||
highlights[i] := highlight;
|
||||
end;
|
||||
end;
|
||||
|
||||
for highlight in highlights do
|
||||
begin
|
||||
matchPos := highlight.Start;
|
||||
offset := highlight.Length;
|
||||
write(Copy(data, lastPos, matchPos - lastPos));
|
||||
if highlight.FGColor < $FF then
|
||||
TextColor(highlight.FGColor);
|
||||
if highlight.BGColor < $FF then
|
||||
TextBackground(highlight.BGColor);
|
||||
write(Copy(data, matchPos, offset));
|
||||
NormVideo;
|
||||
lastPos := matchPos + offset;
|
||||
end;
|
||||
|
||||
writeln(Copy(data, lastPos, Length(data)));
|
||||
|
||||
highlights.Free;
|
||||
end;
|
||||
|
||||
procedure ProcessCall(AURL: String);
|
||||
var
|
||||
s: String;
|
||||
request, response: TStream;
|
||||
jsonParser: TJSONParser;
|
||||
jsonData: TJSONData;
|
||||
contentType: TContentType;
|
||||
xmlDoc: TXMLDocument;
|
||||
begin
|
||||
parser.Content := AURL;
|
||||
parser.Replace;
|
||||
AURL := parser.Content;
|
||||
writeln('Calling ', AURL);
|
||||
|
||||
response := TMemoryStream.Create;
|
||||
request := nil;
|
||||
|
||||
if content.Count > 0 then
|
||||
begin
|
||||
request := TMemoryStream.Create;
|
||||
|
||||
// Variable replacement
|
||||
parser.Content := content.Text;
|
||||
parser.Replace;
|
||||
content.Text := parser.Content;
|
||||
|
||||
content.SaveToStream(request);
|
||||
request.Position := 0;
|
||||
http.RequestBody := request;
|
||||
end;
|
||||
|
||||
try
|
||||
http.HTTPMethod(method, AURL, response, []);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln;
|
||||
writeln('Failed! ', E.Message);
|
||||
Halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
writeln;
|
||||
writeln('Status: ', http.ResponseStatusCode, ' (', http.ResponseStatusText, ')');
|
||||
writeln;
|
||||
writeln('Headers:');
|
||||
for s in http.ResponseHeaders do
|
||||
writeln(' ', s);
|
||||
writeln;
|
||||
|
||||
response.Position := 0;
|
||||
|
||||
if beautify and IdentifyContentType(http.GetHeader(http.ResponseHeaders, 'Content-Type'), contentType) then
|
||||
begin
|
||||
case contentType of
|
||||
ctJSON:
|
||||
begin
|
||||
jsonParser := TJSONParser.Create(response);
|
||||
jsonData := jsonParser.Parse;
|
||||
content.Text := jsonData.FormatJSON;
|
||||
jsonData.Free;
|
||||
jsonParser.Free;
|
||||
WriteContent;
|
||||
end;
|
||||
ctXML:
|
||||
begin
|
||||
ReadXMLFile(xmlDoc, response);
|
||||
response.Size := 0;
|
||||
WriteXMLFile(xmlDoc, response);
|
||||
response.Position := 0;
|
||||
content.LoadFromStream(response);
|
||||
WriteContent;
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
content.LoadFromStream(response);
|
||||
WriteContent;
|
||||
end;
|
||||
|
||||
response.Free;
|
||||
request.Free;
|
||||
end;
|
||||
|
||||
procedure CmdBasicAuth(AData: String);
|
||||
var
|
||||
separator: Char;
|
||||
i: Integer;
|
||||
begin
|
||||
separator := AData[1];
|
||||
i := 2;
|
||||
while (i < Length(AData)) and (AData[i] <> separator) do
|
||||
Inc(i);
|
||||
|
||||
http.UserName := Copy(AData, 2, i - 2);
|
||||
http.Password := Copy(AData, i + 1, Length(AData));
|
||||
end;
|
||||
|
||||
procedure CmdHighlight(AData: String);
|
||||
begin
|
||||
filters.Add(THighlightFilter.Create(AData));
|
||||
end;
|
||||
|
||||
function ProcessCommand(ALine: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if AnsiStartsStr('Ask ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdAskUser(Copy(ALine, 5, Length(ALine)));
|
||||
end else
|
||||
if AnsiStartsStr('Header ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdHeader(Copy(ALine, 8, Length(ALine)));
|
||||
end else
|
||||
if AnsiStartsStr('Method ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
method := Copy(ALine, 8, Length(ALine));
|
||||
end else
|
||||
// We don't include the space here, since we also interpret this following
|
||||
// char as separator for username and password! (In case the username itself
|
||||
// contains a space.)
|
||||
if AnsiStartsStr('BasicAuth', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdBasicAuth(Copy(ALine, 10, Length(ALine)));
|
||||
end else
|
||||
if ALine = 'Beautify' then
|
||||
begin
|
||||
Result := True;
|
||||
beautify := True;
|
||||
end else
|
||||
if AnsiStartsStr('Highlight ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
CmdHighlight(Copy(ALine, 11, Length(ALine)));
|
||||
end else
|
||||
if AnsiStartsStr('Call ', ALine) then
|
||||
begin
|
||||
Result := True;
|
||||
url := Copy(ALine, 6, Length(ALine));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ListProfiles;
|
||||
var
|
||||
sr: TSearchRec;
|
||||
begin
|
||||
Writeln('Known profiles:');
|
||||
if FindFirst(templateDir + '*.rest', faAnyFile, sr) = 0 then
|
||||
begin
|
||||
repeat
|
||||
writeln(' ', Copy(sr.Name, 1, Length(sr.Name) - 5));
|
||||
until FindNext(sr) <> 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
configDir := GetAppConfigDir(False);
|
||||
templateDir := configDir + 'templates' + PathDelim;
|
||||
|
||||
templateFile := templateDir + ParamStr(1) + '.rest';
|
||||
|
||||
if ParamCount <> 1 then
|
||||
begin
|
||||
Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' <profile or file>');
|
||||
Writeln;
|
||||
ListProfiles;
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
if FileExists(ParamStr(1)) then
|
||||
begin
|
||||
AssignFile(data, ParamStr(1));
|
||||
templateName := ExtractFileName(ParamStr(1));
|
||||
if AnsiEndsStr('.rest', templateName) then
|
||||
templateName := Copy(templateName, 1, Length(templateName) - 5);
|
||||
end else
|
||||
if FileExists(templateFile) then
|
||||
begin
|
||||
AssignFile(data, templateFile);
|
||||
templateName := ParamStr(1);
|
||||
end else
|
||||
begin
|
||||
writeln('Template not found!');
|
||||
Halt(1);
|
||||
end;
|
||||
Reset(data);
|
||||
|
||||
sessionIni := TIniFile.Create(configDir + 'session.ini');
|
||||
|
||||
parser := TJTemplateParser.Create;
|
||||
content := TStringList.Create;
|
||||
beautify := False; //By default, we don't want to manipulate output.
|
||||
filters := TFilterList.Create;
|
||||
THighlightFilter.FilterExpression := TRegExpr.Create('( (FG|BG)(\d+))*$');
|
||||
THighlightFilter.ParamExpression := TRegExpr.Create('(FG|BG)(\d+)');
|
||||
|
||||
http := TFPHttpClient.Create(nil);
|
||||
|
||||
commandMode := True;
|
||||
|
||||
try
|
||||
while not EOF(data) do
|
||||
begin
|
||||
ReadLn(data, line);
|
||||
if commandMode and (line <> '') and (line[1] <> '#') and
|
||||
not ProcessCommand(line) then
|
||||
begin
|
||||
commandMode := False;
|
||||
end;
|
||||
|
||||
if not commandMode then
|
||||
content.Add(line);
|
||||
end;
|
||||
|
||||
if url <> '' then
|
||||
ProcessCall(url);
|
||||
|
||||
finally
|
||||
sessionIni.Free;
|
||||
parser.Free;
|
||||
http.Free;
|
||||
content.Free;
|
||||
filters.Free;
|
||||
THighlightFilter.FilterExpression.Free;
|
||||
THighlightFilter.ParamExpression.Free;
|
||||
|
||||
CloseFile(data);
|
||||
end;
|
||||
Application := TRestemplateApplication.Create;
|
||||
Application.Title := 'restemplate';
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue