Skip to content

Commit 11daa46

Browse files
author
Rubens F. N. da Silva
committed
Introduced the FakeAgent utility, improvements over stack selection
1 parent 6715aa4 commit 11daa46

File tree

10 files changed

+265
-161
lines changed

10 files changed

+265
-161
lines changed

‎cls/Frontier/Context.cls‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,11 +43,14 @@ Property StrictQueryParameters As %Boolean [ InitialExpression = 1 ];
4343

4444
Property RouteParameters As %String [ InitialExpression = 0, MultiDimensional ];
4545

46-
Method %OnNew(session As %CSP.Session, request As %CSP.Request, response As %CSP.Response) As %Status
46+
Property Debug As %Boolean [ InitialExpression = 0, Internal, ReadOnly ];
47+
48+
Method %OnNew(session As %CSP.Session, request As %CSP.Request, response As %CSP.Response, debug As %Boolean = 0) As %Status
4749
{
4850
set ..Session = session
4951
set ..Request = request
5052
set ..Response = response
53+
set i%Debug = debug
5154
set i%SQL = ##class(Frontier.SQL).%New()
5255
set i%ReporterManager = ##class(Frontier.Reporter.Manager).%New($this)
5356
set i%AuthenticationManager = ##class(Frontier.Authentication.Manager).%New(..Session, ..Request, ..Response)

‎cls/Frontier/DevTools/FakeAgent.cls‎

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
Class Frontier.DevTools.FakeAgent Extends %RegisteredObject
2+
{
3+
4+
Property Cache As %String;
5+
6+
Property Namespace As %String;
7+
8+
Method %OnNew() As %Status
9+
{
10+
set ..Namespace = $namespace
11+
set ..Cache = "^|"""_..Namespace_"""|Frontier.DevTools.FakeAgent"
12+
return $$$OK
13+
}
14+
15+
Method %OnClose() As %Status
16+
{
17+
kill @i%Cache
18+
return $$$OK
19+
}
20+
21+
ClassMethod EnsureRequestExists(Output request As Frontier.UnitTest.FakeRequest, url As %String, method As %String, payload As %DynamicObject, auth As %String = "Basic Zm9vOmJhcg==") As %Status [ Internal, Private ]
22+
{
23+
do ##class(%Net.URLParser).Parse(url, .components)
24+
do ParseQueryString(components("query"), .data)
25+
26+
if '$data(request) || ($data(request) && '$isobject(request)) {
27+
set request = ##class(Frontier.DevTools.FakeRequest).%New()
28+
}
29+
30+
set request.URL = components("path")
31+
set request.CgiEnvs("CONTENT_LENGTH") = 0
32+
set request.CgiEnvs("CONTENT_TYPE") = "application/json; charset=utf-8"
33+
set request.CgiEnvs("HTTP_ACCEPT") = "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
34+
set request.CgiEnvs("HTTP_ACCEPT_ENCODING") = "gzip, deflate"
35+
set request.CgiEnvs("HTTP_ACCEPT_LANGUAGE") = "en-US;q=0.8,en;q=0.7"
36+
set request.CgiEnvs("HTTP_AUTHORIZATION") = auth
37+
set request.CgiEnvs("HTTP_HOST") = "localhost:57772"
38+
set request.CgiEnvs("HTTP_USER_AGENT") = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/65.0.3325.181 Safari/537.36 FakeAgent/1.0"
39+
set request.CgiEnvs("QUERY_STRING") = $get(components("query"))
40+
set request.CgiEnvs("REQUEST_METHOD") = $$$ucase(method)
41+
set request.CgiEnvs("REQUEST_SCHEME") = "http"
42+
set request.CgiEnvs("REQUEST_URI") = components("path")
43+
set request.CgiEnvs("SERVER_NAME") = "localhost"
44+
set request.CgiEnvs("SERVER_PORT") = 57772
45+
set request.CgiEnvs("SERVER_PROTOCOL") = "HTTP/1.1"
46+
set request.Content = ##class(%Stream.GlobalCharacter).%New()
47+
if $isobject(payload) do request.Content.Write(payload.%ToJSON())
48+
if $order(data("")) '= "" merge request.Data = data
49+
50+
return $$$OK
51+
52+
ParseQueryString(qs, data)
53+
if qs = "" quit
54+
55+
set qp = $lfs(qs, "&")
56+
57+
for i=1:1:$ll(qp) {
58+
set key = $piece($lg(qp, i), "=", 1)
59+
set value = $piece($lg(qp, i), "=", 2)
60+
if key '= "" && (value '= "") set data(key, 1) = value
61+
}
62+
quit
63+
}
64+
65+
ClassMethod DispatchRequestAndRespondToStream(dispatcherClass As %String, url As %String, httpMethod As %String, Output str As %Stream.Object) As %Status [ Internal, Private, ProcedureBlock = 0 ]
66+
{
67+
68+
new %frontier
69+
set %frontier = ##class(Frontier.Context).%New(%session, %request, %response, 1)
70+
71+
new oldMnemonic, alreadyRedirected, sc
72+
73+
set sc = $$$OK
74+
set isRedirected = 0
75+
76+
set str = ##class(%Stream.GlobalCharacter).%New()
77+
set alreadyRedirected = ##class(%Device).ReDirectIO()
78+
set oldMnemonic = "^"_##class(%Device).GetMnemonicRoutine()
79+
set initIO = $io
80+
81+
try {
82+
use $io::("^"_$zname)
83+
84+
do ##class(%Device).ReDirectIO(1)
85+
set isRedirected = 1
86+
set sc = $classmethod(dispatcherClass, "DispatchRequest", url, httpMethod)
87+
do str.Rewind()
88+
} catch ex {
89+
set str = ""
90+
set sc = ex.AsStatus()
91+
}
92+
93+
94+
if oldMnemonic '= "" {
95+
use initIO::(oldMnemonic)
96+
} else {
97+
use oldMnemonic
98+
}
99+
100+
do ##class(%Device).ReDirectIO(alreadyRedirected)
101+
102+
return sc
103+
104+
wstr(s) Do str.Write(s) Quit
105+
wchr(a) Do str.Write($char(a)) Quit
106+
wnl Do str.Write($char(13,10)) Quit
107+
wff Do str.Write($char(13,10,13,10)) Quit
108+
wtab(n) Do str.Write($c(9)) Quit
109+
rstr(len,time) Quit ""
110+
rchr(time) Quit ""
111+
}
112+
113+
Method ForgeRequest(url As %String, method As %String = "GET", payload As %DynamicAbstractObject = {{}}, auth As %String = "", Output sc As %Status = {$$$OK}) As %Stream.GlobalBinary [ PublicList = (%session, %response) ]
114+
{
115+
116+
new %request, %session, %response
117+
118+
// Makes sure that any attempts to change the namespace internally ends up in the original one.
119+
set fromNamespace = ..Namespace
120+
set str = ""
121+
122+
set %session = ##class(%CSP.Session).%New(-1, 0)
123+
set %response = ##class(%CSP.Response).%New()
124+
125+
try {
126+
set urlWithInitialSlash = $select($extract(url) '= "/" : "/"_url, 1: url)
127+
set appInfo = ..GetApplicationInfoFromUrl(urlWithInitialSlash)
128+
do ..EnsureRequestExists(.%request, url, method, payload, auth)
129+
set %request.Application = appInfo.Name
130+
$$$ThrowOnError(..DispatchRequestAndRespondToStream(appInfo.DispatchClass, %request.URL, method, .str))
131+
} catch ex {
132+
set sc = ex.AsStatus()
133+
set ^mtempFrontier("err", $i(i)) = sc
134+
if '$isobject(str) set str = ##class(%Stream.GlobalBinary).%New()
135+
}
136+
kill %request, %session, %response
137+
138+
set $namespace = fromNamespace
139+
140+
return str
141+
}
142+
143+
Method GetApplicationInfoFromUrl(url As %String) As %DynamicObject
144+
{
145+
146+
#define APPCACHE @i%Cache
147+
148+
// Cache matches to prevent roundtrips to %SYS.
149+
if $data($$$APPCACHE) {
150+
set index = $lf($$$APPCACHE, url)
151+
if index > 0 return $$ListToJSON(index)
152+
}
153+
154+
set $namespace = "%SYS"
155+
156+
set result = {}
157+
158+
// Revert the ordering so that longer are considered first, note that the longer the path is higher is similarity with the url.
159+
set rows = ##class(%SQL.Statement).%ExecDirect(, "SELECT TOP 1 Name, DispatchClass FROM SECURITY.APPLICATIONS WHERE ? %STARTSWITH Name ORDER BY LEN(Name) DESC", url)
160+
if rows.%Next() {
161+
set $list($$$APPCACHE, *+1) = url
162+
set index = $ll($$$APPCACHE)
163+
set $list($$$APPCACHE, *+1) = rows.%Get("Name")
164+
set $list($$$APPCACHE, *+1) = rows.%Get("DispatchClass")
165+
set result = $$ListToJSON(index)
166+
}
167+
168+
set $namespace = ..Namespace
169+
170+
return result
171+
172+
ListToJSON(urlIndex)
173+
return {
174+
"Name": ($lg($$$APPCACHE, urlIndex + 1)),
175+
"DispatchClass": ($lg($$$APPCACHE, urlIndex + 2))
176+
}
177+
}
178+
179+
ClassMethod Request(url As %String, method As %String = "GET", payload As %DynamicAbstractObject = {{}}, auth As %String = "", outputToDevice As %Boolean = 0, Output sc As %Status = {$$$OK}) As %Stream.GlobalBinary
180+
{
181+
set agent = ..%New()
182+
if outputToDevice = 1 {
183+
set str = agent.ForgeRequest(url, method, payload, auth, .sc)
184+
do str.OutputToDevice()
185+
} else {
186+
return agent.ForgeRequest(url, method, payload, auth, .sc)
187+
}
188+
return str
189+
}
190+
191+
}
192+

‎cls/Frontier/DevTools/FakeRequest.cls‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
Class Frontier.DevTools.FakeRequest Extends %RegisteredObject
2+
{
3+
4+
Property Data As %String [ MultiDimensional ];
5+
6+
Property CgiEnvs As %String [ MultiDimensional ];
7+
8+
Property URL As %String;
9+
10+
Property Method As %String;
11+
12+
Property Application As %String;
13+
14+
Property Content As %Stream.Object;
15+
16+
Method GetCgiEnv(name As %String) As %String
17+
{
18+
return $get(i%CgiEnvs(name))
19+
}
20+
21+
Method Get(name As %String, default As %String = "") As %String
22+
{
23+
return $get(i%Data(name), default)
24+
}
25+
26+
}
27+

‎cls/Frontier/Exception.cls‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ ClassMethod ToDynamicObject(exception As Frontier.Exception) As %DynamicObject
3434
set de.error = graph
3535
} elseif graph.%IsA("%DynamicArray") {
3636
set de.errors = graph
37-
}
37+
}
3838
return de
3939
}
4040

@@ -86,17 +86,17 @@ TraverseException(payload, ex)
8686
return $$$OK
8787
}
8888

89-
ClassMethod CaptureStack(Output stackText As %Stream.GlobalCharacter = "") As %String
89+
ClassMethod CaptureStack(Output stackText As %Stream.GlobalCharacter = "", from As %Integer = {($stack - $estack) + 1}, to As %Integer = {$stack +1}) As %Status
9090
{
9191
set stackText = ##class(%Stream.GlobalCharacter).%New()
9292

93-
do stackText.WriteLine("Runtime exception ")
94-
set max = $stack(-1)
95-
for loop=max:-1:1 {
96-
set sc = stackText.WriteLine($char(9)_" at "_$stack(loop, "PLACE")_$stack(loop, "MCODE"))
97-
if $$$ISERR(sc) return sc
98-
}
99-
return stackText.Read()
93+
do stackText.WriteLine("Runtime exception")
94+
for loop=to:-1:from {
95+
do stackText.WriteLine(" at "_$stack(loop, "PLACE"))
96+
do stackText.WriteLine(" "_$stack(loop, "MCODE"))
97+
}
98+
do stackText.Rewind()
99+
return $$$OK
100100
}
101101

102102
}

‎cls/Frontier/Router.cls‎

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ Parameter CONVERTINPUTSTREAM = 1;
1111

1212
ClassMethod Page(skipheader As %Boolean = 1) As %Status [ ProcedureBlock = 0 ]
1313
{
14+
1415
new %frontier
1516
set %frontier = ##class(Frontier.Context).%New(%session, %request, %response)
1617
set %session.Data("%frontier") = %frontier
@@ -21,7 +22,7 @@ ClassMethod Page(skipheader As %Boolean = 1) As %Status [ ProcedureBlock = 0 ]
2122
ClassMethod DispatchMap(index As %Integer) As %String [ CodeMode = objectgenerator, Final, Internal ]
2223
{
2324

24-
// Don't generate patterns if target class is super.
25+
// Don't try to generate patterns if the target class is Frontier.Router.
2526
if %compiledclass.Name = "Frontier.Router" return $$$OK
2627

2728
$$$ThrowOnError(##class(Frontier.Schema.Util).Parse(%compiledclass.Name, .routes))
@@ -91,7 +92,7 @@ ClassMethod DispatchRequest(url As %String, httpMethod As %String, forwarded As
9192
set strictRouteParameters = $case(matchType, "R": $lg(mapEntry, 9), : $lg(mapEntry, 5))
9293

9394
set %frontier.RequestURL = %request.URL
94-
set %frontier.ClassName = $classname()
95+
set %frontier.ClassName = $classname()
9596

9697
set %frontier.Method = "OnDataSet"
9798
$$$ThrowOnError(..OnDataSet(%frontier.Data))
@@ -163,7 +164,10 @@ ClassMethod DispatchRequest(url As %String, httpMethod As %String, forwarded As
163164

164165
// Executes the method and retrives its value. The method MUST return a value or a
165166
// <COMMAND> will be issued.
166-
$$$ThrowOnError(publicMethod.Invoke(.methodReturn))
167+
set sc = publicMethod.Invoke(.methodReturn, .stack)
168+
set %frontier.Stack = stack
169+
170+
$$$ThrowOnError(sc)
167171

168172
// Now we serialize and output the result back to the agent.
169173
$$$ThrowOnError(..DispatchResponse(methodReturn, .tReturnParameters))
@@ -199,8 +203,12 @@ ClassMethod DispatchRequest(url As %String, httpMethod As %String, forwarded As
199203
return $$$OK
200204
} catch ex {
201205
set exceptionPayload = ..HandleException(ex)
202-
do ##class(Frontier.Dynamic.Serializer).SerializeToStream(.stream, exceptionPayload, 1, %frontier.PropertyFormatter)
203-
do stream.OutputToDevice()
206+
if %frontier.Debug = 1 {
207+
do ##class(Frontier.Dynamic.Serializer).Serialize(exceptionPayload, 1, %frontier.PropertyFormatter)
208+
} else {
209+
do ##class(Frontier.Dynamic.Serializer).SerializeToStream(.stream, exceptionPayload, 1, %frontier.PropertyFormatter)
210+
do stream.OutputToDevice()
211+
}
204212
}
205213
return $$$OK
206214

@@ -274,20 +282,14 @@ ClassMethod HandleException(exception As %Exception.AbstractException) As %Dynam
274282
set exceptionJSON = ##class(Exception).ToDynamicObject(exception)
275283
set exceptionJSON.responseCode = responseCode
276284
set sc = exception.AsStatus()
277-
set stack = ""
285+
set stack = %frontier.Stack
278286

279287
if '%frontier.ThrownByApplication && ($$$GETERRORCODE(sc) '= $$$GeneralError) {
280288
set %frontier.Error = sc
281-
set %frontier.IncludeStack = 1
282-
}
283-
284-
if %frontier.IncludeStack {
285-
do ##class(Exception).CaptureStack(.stack)
286-
}
289+
}
287290

288-
if stack '= "" {
289-
set exceptionJSON.stack = stack
290-
set %frontier.Stack = stack
291+
if stack '= "" && (%frontier.IncludeStack = 1) {
292+
set exceptionJSON.stack = %frontier.Stack
291293
}
292294

293295
set %response.OutputSessionToken = 0
@@ -330,7 +332,7 @@ ClassMethod DispatchResponse(returnedData As %CacheString, method As Frontier.Ro
330332

331333
// We must use a custom serializer because the current %ToJSON implementation cannot serialize
332334
// mixed instances.
333-
if %frontier.DirectWrite = 1 {
335+
if %frontier.DirectWrite = 1 || (%frontier.Debug = 1) {
334336
return ##class(Frontier.Dynamic.Serializer).Serialize(response, 1, %frontier.PropertyFormatter)
335337
} else {
336338
$$$QuitOnError(##class(Frontier.Dynamic.Serializer).SerializeToStream(.stream, response, 1, %frontier.PropertyFormatter))

‎cls/Frontier/UnitTest/Fixtures/Class.cls‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ Storage Default
2929
<Selectivity>1</Selectivity>
3030
</Property>
3131
<Property name="Plate">
32-
<AverageFieldSize>4.7</AverageFieldSize>
32+
<AverageFieldSize>4.9</AverageFieldSize>
3333
<Selectivity>10.0000%</Selectivity>
3434
</Property>
3535
<SQLMap name="IDKEY">

‎cls/Frontier/UnitTest/Fixtures/Student.cls‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -53,10 +53,10 @@ Storage Default
5353
</Property>
5454
<Property name="Class">
5555
<AverageFieldSize>1.1</AverageFieldSize>
56-
<Selectivity>16.6667%</Selectivity>
56+
<Selectivity>12.5000%</Selectivity>
5757
</Property>
5858
<Property name="Name">
59-
<AverageFieldSize>16.9</AverageFieldSize>
59+
<AverageFieldSize>16.6</AverageFieldSize>
6060
<Selectivity>10.0000%</Selectivity>
6161
</Property>
6262
<Property name="SomeValue">

0 commit comments

Comments
 (0)