• R/O
  • SSH
  • HTTPS

mantisbtmonitor: Commit


Commit MetaInfo

Revision36 (tree)
Time2017-10-14 06:34:25
Authorderekwildstar

Log Message

- Ajustes para exibição de conteúdo HTML

Change Summary

Incremental Difference

--- trunk/client/prj/MantisNotification.bdsproj (revision 35)
+++ trunk/client/prj/MantisNotification.bdsproj (revision 36)
@@ -150,7 +150,7 @@
150150 <VersionInfo Name="MajorVer">1</VersionInfo>
151151 <VersionInfo Name="MinorVer">2</VersionInfo>
152152 <VersionInfo Name="Release">3</VersionInfo>
153- <VersionInfo Name="Build">847</VersionInfo>
153+ <VersionInfo Name="Build">861</VersionInfo>
154154 <VersionInfo Name="Debug">False</VersionInfo>
155155 <VersionInfo Name="PreRelease">False</VersionInfo>
156156 <VersionInfo Name="Special">False</VersionInfo>
@@ -162,7 +162,7 @@
162162 <VersionInfoKeys>
163163 <VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
164164 <VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
165- <VersionInfoKeys Name="FileVersion">1.2.3.847</VersionInfoKeys>
165+ <VersionInfoKeys Name="FileVersion">1.2.3.861</VersionInfoKeys>
166166 <VersionInfoKeys Name="InternalName"></VersionInfoKeys>
167167 <VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
168168 <VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
--- trunk/client/src/lib/UFunctions.pas (revision 35)
+++ trunk/client/src/lib/UFunctions.pas (revision 36)
@@ -30,8 +30,261 @@
3030
3131 uses
3232 Windows, Classes, SysUtils, ShellApi, EncdDecd, UMNWSWrapperFunctions, Forms,
33- Controls, UConfigurations, IdGlobalProtocols;
33+ Controls, UConfigurations, IdGlobalProtocols {$if RTLVersion >= 22}, RegularExpressionsCore{$else}, KRK.Lib.RegExp.PerlRegEx{$ifend};
3434
35+function RegExMatch(ASubject, APattern: String; AGroup: Byte; out AMatch: String): Boolean;
36+begin
37+ Result := False;
38+ AMatch := '';
39+
40+ with TPerlRegEx.Create do
41+ try
42+ Subject := ASubject;
43+ RegEx := APattern;
44+ if Match then
45+ begin
46+ Result := True;
47+
48+ if AGroup > 0 then
49+ repeat
50+ if AMatch = '' then
51+ AMatch := Groups[AGroup]
52+ else
53+ AMatch := AMatch + ';' + Groups[AGroup];
54+ until not MatchAgain
55+ else
56+ repeat
57+ if AMatch = '' then
58+ AMatch := MatchedText
59+ else
60+ AMatch := AMatch + ';' + MatchedText;
61+ until not MatchAgain
62+ end;
63+ finally
64+ Free;
65+ end;
66+end;
67+
68+function RegExReplaceAll(ASubject, APattern, AReplacement: String; out AResult: String; ASingleLine: Boolean = True; ACaseInsensitive: Boolean = True): Boolean;
69+begin
70+ Result := False;
71+ AResult := '';
72+
73+ with TPerlRegEx.Create do
74+ try
75+ if ASingleLine then
76+ Options := Options + [preSingleLine];
77+ if ACaseInsensitive then
78+ Options := Options + [preCaseLess];
79+
80+ Subject := ASubject;
81+ RegEx := APattern;
82+ Replacement := AReplacement;
83+ if ReplaceAll then
84+ begin
85+ AResult := Subject;
86+ Result := True;
87+ end;
88+ finally
89+ Free;
90+ end;
91+end;
92+// Protege AProtectPattern enquanto realiza a substituição de AOldPattern por
93+// AReplacement, colocando o resultado final em AResult
94+function RegExProtectAndReplace(ASubject, AProtectPattern, AOldPattern, AReplacement: String; AProtectedSingleLine: Boolean = True; AProtectedCaseInsensitive: Boolean = True; AReplaceSingleLine: Boolean = True; AReplaceCaseInsensitive: Boolean = True): String;
95+const
96+ PROTECTEDPLACEHOLDER = '[¯:_:¯]';
97+var
98+ ProtectedTexts: array of string;
99+// -----------------------------------------------------------------------------
100+// Protege o texto substituindo cada ocorrência de APattern por <:protected:> e
101+// salva o texto substitído no array AProtectedTexts
102+function Protect: String;
103+begin
104+ Result := ASubject;
105+
106+ with TPerlRegEx.Create do
107+ try
108+ if AProtectedSingleLine then
109+ Options := Options + [preSingleLine];
110+ if AProtectedCaseInsensitive then
111+ Options := Options + [preCaseLess];
112+
113+ Subject := Result;
114+ RegEx := AProtectPattern;
115+ Replacement := PROTECTEDPLACEHOLDER;
116+
117+ if Match then
118+ begin
119+ repeat
120+ SetLength(ProtectedTexts,Length(ProtectedTexts) + 1);
121+ ProtectedTexts[High(ProtectedTexts)] := MatchedText;
122+ Replace
123+ until not MatchAgain;
124+ end;
125+ Result := Subject;
126+ finally
127+ Free;
128+ end;
129+end;
130+
131+function Replace: String;
132+begin
133+ Result := ASubject;
134+
135+ with TPerlRegEx.Create do
136+ try
137+ if AReplaceSingleLine then
138+ Options := Options + [preSingleLine];
139+ if AReplaceCaseInsensitive then
140+ Options := Options + [preCaseLess];
141+
142+ Subject := Result;
143+ RegEx := AOldPattern;
144+ Replacement := AReplacement;
145+
146+ ReplaceAll;
147+
148+ Result := Subject;
149+ finally
150+ Free;
151+ end;
152+end;
153+
154+function RecoverProtected: String;
155+var
156+ i: Word;
157+begin
158+ Result := ASubject;
159+
160+ i := 0;
161+ while Pos(PROTECTEDPLACEHOLDER,Result) > 0 do
162+ begin
163+ Result := StringReplace(Result,PROTECTEDPLACEHOLDER,ProtectedTexts[i],[]);
164+ Inc(i);
165+ end;
166+end;
167+// -----------------------------------------------------------------------------
168+begin
169+ ASubject := Protect;
170+ ASubject := Replace;
171+ Result := RecoverProtected;
172+end;
173+
174+// No mantis, os textos são tratados antes de serem exibidos como HTML. As
175+// funções de tratamento ficam em core/string_api.php
176+
177+
178+// # Prepare a multiple line string for display to HTML
179+// function string_display( $p_string ) {
180+// $p_string = string_strip_hrefs( $p_string );
181+// $p_string = string_html_specialchars( $p_string );
182+// $p_string = string_restore_valid_html_tags( $p_string, /* multiline = */ true );
183+// $p_string = string_preserve_spaces_at_bol( $p_string );
184+// $p_string = string_nl2br( $p_string );
185+//
186+// return $p_string;
187+// }
188+
189+
190+// # Prepare a string for display to HTML and add href anchors for URLs, emails,
191+// # bug references, and cvs references
192+// function string_display_links( $p_string ) {
193+// $p_string = string_display( $p_string );
194+// $p_string = string_insert_hrefs( $p_string );
195+// $p_string = string_process_bug_link( $p_string );
196+// $p_string = string_process_bugnote_link( $p_string );
197+// $p_string = string_process_cvs_link( $p_string );
198+//
199+// return $p_string;
200+// }
201+//
202+function SanitizeString(AString: String; AFlags: Byte): String;
203+const
204+ ALOWABLETAGS = 'p|li|ul|ol|br|pre|i|b|u|em';
205+var
206+ Subject: String;
207+begin
208+ Result := AString;
209+ Subject := Result;
210+
211+ // Remove links e deixa apenas os texto puro
212+ if AFlags and 1 = 1 then
213+ begin
214+ RegExReplaceAll(Subject,'<a\s[^\>]*href="mailto\:([^\"]+)"[^\>]*>[^\<]*<\/a>','\1',Result);
215+
216+ Subject := Result;
217+
218+ RegExReplaceAll(Subject,'<a\s[^\>]*href="([^\"]+)"[^\>]*>[^\<]*<\/a>','\1',Result);
219+
220+ Subject := Result;
221+ end;
222+
223+ // Transforma todos os tags HTML em texto plano
224+ if AFlags and 2 = 2 then
225+ begin
226+ Result := StringReplace(Subject,'&','&amp;',[rfReplaceAll]);
227+ Result := StringReplace(Result,'"','&quot;',[rfReplaceAll]);
228+ Result := StringReplace(Result,#39,'&apos;',[rfReplaceAll]);
229+ Result := StringReplace(Result,'<','&lt;',[rfReplaceAll]);
230+ Subject := StringReplace(Result,'>','&gt;',[rfReplaceAll]);
231+
232+ Result := Subject;
233+ end;
234+
235+ // Transforma os tags listados que estão em formato de texto plano em tags
236+ // html novamente. Em outras palavras, pega um texto sem os tags html e
237+ // recupera apenas aqueles que são permitidos
238+ if AFlags and 4 = 4 then
239+ begin
240+ RegExReplaceAll(Subject,'&lt;(' + ALOWABLETAGS + ')\s*&gt;','<\1>',Result); // <tagname>
241+
242+ Subject := Result;
243+
244+ RegExReplaceAll(Subject,'&lt;\/(' + ALOWABLETAGS + ')\s*&gt;','</\1>',Result); // </tagname>
245+
246+ Subject := Result;
247+
248+ RegExReplaceAll(Subject,'&lt;(' + ALOWABLETAGS + ')\s*\/&gt;','<\1 />',Result); // <tagname />
249+
250+ Subject := Result;
251+ end;
252+
253+ // Preserva espaços e Tabs. A implementação original era mais complexa porque
254+ // considerava apenas os tabs e espaços no início da linha, no entanto, isso
255+ // só foi feito porque a implementação em PHP não deve gerar mais dados que o
256+ // necessário, para evitar consumo de banda desnecessário. Como aqui estamos
257+ // apenas exibindo na tela, optei por substituir tudo mesmo
258+ if AFlags and 8 = 8 then
259+ begin
260+ Result := StringReplace(Subject,#32,'&nbsp;',[rfReplaceAll]);
261+ Subject := StringReplace(Result,#9,'&nbsp;&nbsp;&nbsp;&nbsp;',[rfReplaceAll]); // 1 tab = 4 espaços
262+
263+ Result := Subject;
264+ end;
265+
266+ // Substitui cada quebra de linha por uma quebra de linha + um <br>, sem
267+ // afetar o conteúdo de tags <pre>
268+ if AFlags and 16 = 16 then
269+ begin
270+ Subject := RegExProtectAndReplace(Subject,'(<pre[^>]*>.*?<\/pre>)',#13#10,'<br>'#13#10);
271+
272+ Result := Subject;
273+ end;
274+
275+ // Detecta urls e e-mails e os transforma novamente em links
276+ if AFlags and 32 = 32 then
277+ begin
278+ RegExReplaceAll(Subject,'(\b(?:https?|ftps?):\/\/[a-z0-9-_.]*\b)','<a href="\1">\1</a> [<a href="\1" target="_blank">^</a>]',Result,False);
279+
280+ Subject := Result;
281+
282+ RegExReplaceAll(Subject,'(\b.*@.*\b)','<a href="mailto:\1">\1</a>',Result,False);
283+
284+ Subject := Result;
285+ end;
286+end;
287+
35288 procedure OpenIssueWithMantis(AIssueNumber: Cardinal);
36289 const
37290 URL = 'https://www.tjpe.jus.br/mantis/view.php?id=%u';
@@ -146,6 +399,8 @@
146399 ABody := StringReplace(UTF8Decode(DecodeString(ABody)),#13#10,'<br>',[rfReplaceAll])
147400 else
148401 ABody := StringReplace(ABody,#13#10,'<br>',[rfReplaceAll]);
402+
403+ ABody := SanitizeString(ABody,2);
149404 Result := Format(HTML,[ABody]);
150405 end;
151406 ////////////////////////////////////////////////////////////////////////////////
Show on old repository browser