2
2
/// This class installs and removes <!-- @echo package.printableName -->. Once the class is
3
3
/// compiled, the application will be installed into Caché system. Then open the web-application
4
4
/// [host]/<!-- @echo config.webApplicationName -->/ (slash at the end is required).
5
- Class VisualEditor .Installer Extends %Projection .AbstractProjection [ CompileAfter = (<!-- @echo compileAfter -->) ]
5
+ Class VisualEditor .Installer Extends %Projection .AbstractProjection [ Not ProcedureBlock , CompileAfter = (<!-- @echo compileAfter -->) ]
6
6
{
7
7
8
8
Projection Reference As Installer ;
@@ -11,26 +11,36 @@ Parameter DispatchClass = "VisualEditor.Router";
11
11
12
12
Parameter RESTAppName = " /<!-- @echo config.webApplicationName -->" ;
13
13
14
+ ClassMethod Init ()
15
+ {
16
+ set installLog = " "
17
+ set errorOccurred = 0
18
+ }
19
+
14
20
/// This method creates a new web application by the given spec.
15
21
ClassMethod RegisterWebApplication (name As %String , spec ) As %Status
16
22
{
23
+ $$$log(" Moving to %SYS." )
17
24
new $Namespace
18
25
set $Namespace = " %SYS"
19
26
set st = $$$OK
20
27
if ('##class (Security.Applications ).Exists (name )) {
21
- write !, " Creating WEB application " " " _name _" " " ..."
28
+ $$$log( " Creating WEB application " " " _name _" " " ..." )
22
29
set st = ##class (Security.Applications ).Create (name , .spec )
23
30
if ($$$ISOK(st )) {
24
- write !, " WEB application " " " _name _" " " is created."
31
+ $$$log(" WEB application " " " _name _" " " is created." )
32
+ } else {
33
+ $$$log(" Unable to create WEB-application " " " _name _" " " !" )
34
+ set st = $$$ERROR()
25
35
}
26
36
} else {
37
+ $$$log(" WEB-application " " " _name _" " " already exists, checking it's DispatchClass..." )
27
38
do ##class (Security.Applications ).Get (name , .props )
28
39
if (props (" DispatchClass" ) '= ..#DispatchClass) && (name = ..#RESTAppName) {
29
- write !, " WARNING! WEB application " " " _name _" " " exists but does not refer to " ,
30
- ..#DispatchClass, " ." , !, " Please, set correct dispatch class for this " ,
31
- " application or create a terminal WEB-application manually."
40
+ $$$log(" WARNING! WEB application " " " _name _" " " exists but does not refer to " _ ..#DispatchClass _ " . Please, set correct dispatch class for this " _ " application or create the WEB-application manually." )
41
+ set st = $$$ERROR()
32
42
} else {
33
- write !, " WEB application " " " _name _" " " already exists, so it should be ready to use."
43
+ $$$log( " WEB application " " " _name _" " " already exists, so it should be ready to use." )
34
44
}
35
45
}
36
46
return st
@@ -39,52 +49,96 @@ ClassMethod RegisterWebApplication(name As %String, spec) As %Status
39
49
/// This method removes web application by app name.
40
50
ClassMethod DeleteWebApplication (name As %String )
41
51
{
52
+ $$$log(" Moving to %SYS." )
42
53
new $Namespace
43
54
set $Namespace = " %SYS"
44
55
if (##class (Security.Applications ).Exists (name )) {
45
56
do ##class (Security.Applications ).Get (name , .props )
46
57
if (props (" DispatchClass" ) '= ..#DispatchClass) && (name = ..#RESTAppName) {
47
- write !, " Won't delete web-application " " " _name _" " " because it does not refer to " ,
48
- " dispatch class anymore."
58
+ $$$log(" Won't delete web-application " " " _name _" " " because it does not refer to " _ " dispatch class anymore." )
49
59
} else {
50
- write !, " Deleting WEB application " " " _name _" " " ..."
60
+ $$$log( " Deleting WEB application " " " _name _" " " ..." )
51
61
do ##class (Security.Applications ).Delete (name )
52
- write !, " WEB application " " " _name _" " " is deleted."
62
+ $$$log( " WEB application " " " _name _" " " is deleted." )
53
63
}
54
64
} else {
55
- write !, " Unable to remove web-application " " " _name _" " " as it does not exists."
65
+ $$$log( " Unable to delete web-application " " " _name _" " " as it does not exists." )
56
66
}
57
67
return $$$OK
58
68
}
59
69
60
70
/// This method is invoked when a class is compiled.
61
71
ClassMethod CreateProjection (cls As %String , ByRef params ) As %Status
62
72
{
63
- write !, " Installing <!-- @echo package.printableName --> to " _ $Namespace
73
+ do ..Init ()
74
+ #define log (%s ) set installLog = installLog _ $case (installLog = " " , 1 : " " , :$C (10 )) _ %s write !, %s
75
+ #define testError (%e ) if ($$$ISERR (%e )) { set errorOccurred = 1 }
76
+
77
+ $$$log(" Installing <!-- @echo package.printableName --> to " _ $Namespace )
64
78
65
79
set cspProperties (" AutheEnabled" ) = $$$AutheCache
66
80
set cspProperties (" NameSpace" ) = $Namespace
67
81
set cspProperties (" Description" ) = " A web application for <!-- @echo config.webApplicationName -->."
68
82
set cspProperties (" IsNameSpaceDefault" ) = $$$NO
69
83
set cspProperties (" DispatchClass" ) = ..#DispatchClass
70
84
set st = ..RegisterWebApplication (..#RESTAppName, .cspProperties )
71
- if ($$$ISERR(st )) {
72
- return st
85
+ $$$testError(st )
86
+ if ('$$$ISERR(st )) {
87
+ $$$log(" Installation is complete!" )
73
88
}
74
-
75
- write !, " Installation is complete!"
89
+ do ..Stats ()
76
90
77
91
return $$$OK
78
92
}
79
93
80
94
/// This method is invoked when a class is 'uncompiled'.
81
95
ClassMethod RemoveProjection (cls As %String , ByRef params , recompile As %Boolean ) As %Status
82
96
{
83
- write !, " Uninstalling <!-- @echo package.printableName --> from " _ $Namespace
97
+ do ..Init ()
98
+ #define log (%s ) set installLog = installLog _ $case (installLog = " " , 1 : " " , :$C (10 )) _ %s write !, %s
99
+ #define testError (%e ) if ($$$ISERR (%e )) { set errorOccurred = 1 }
100
+
101
+ $$$log(" Uninstalling <!-- @echo package.printableName --> from " _ $Namespace )
84
102
85
103
do ..DeleteWebApplication (..#RESTAppName)
86
104
87
- write !, " Uninstalling is complete!"
105
+ $$$log(" Uninstalling is complete!" )
106
+
107
+ return $$$OK
108
+ }
109
+
110
+ /// This method sends anonymous statistics about installation process to
111
+ /// <!-- @echo package.printableName --> developer.
112
+ ClassMethod Stats () As %Status {
113
+ if ($get (installLog ) = " " ) { return $$$OK }
114
+
115
+ #define checkErr (%e ) if $$$ISERR (%e ) { do $SYSTEM .Status .DisplayError (%e ) return %e }
116
+
117
+ set sid = $ZD ($H ,3 )
118
+ set key = " x8AlP" _$E (sid ,1 ,1 )_" tq"
119
+
120
+ set body = ##class (%ZEN.proxyObject ).%New ()
121
+ set body .cacheVersion = $ZVERSION
122
+ set body .version = " <!-- @echo package.version -->"
123
+ set body .success = 'errorOccurred
124
+ set body .sid = sid
125
+ if (errorOccurred ) { set body .log = installLog }
126
+
127
+ set req = ##class (%Net.HttpRequest ).%New ()
128
+ set req .ContentType = " application/json"
129
+ set req .Server = " stats.zitros.tk"
130
+ do ##class (%ZEN.Auxiliary.jsonProvider ).%WriteJSONStreamFromObject (.jsonStream , body )
131
+ do req .EntityBody .CopyFrom (jsonStream )
132
+ $$$checkErr(req .Post (" /?key=" _key _" &sid=" _sid ))
133
+
134
+ set content = $case ($isobject (req .HttpResponse .Data ),
135
+ 1 : req .HttpResponse .Data .Read ($$$MaxStringLength),
136
+ :req .HttpResponse .Data )
137
+ set content = $ZCVT (content , " I" , " UTF8" )
138
+ $$$checkErr(##class (%ZEN.Auxiliary.jsonProvider ).%ConvertJSONToObject (content , , .obj , 1 ))
139
+ if (obj .error '= " " ) {
140
+ $$$checkErr($$$ERROR($$$GeneralError, " Unable to collect statistics: " _ obj .error ))
141
+ }
88
142
89
143
return $$$OK
90
144
}
0 commit comments