Skip to content

Commit ed6845d

Browse files
isc-tleavittisc-tleavitt
committed
feat: support IPM v0.9.0+
1 parent 558b491 commit ed6845d

File tree

2 files changed

+178
-6
lines changed

2 files changed

+178
-6
lines changed

‎cls/SourceControl/Git/PackageManagerContext.cls

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
Class SourceControl.Git.PackageManagerContext Extends %ZPM.PackageManager.Core.Singleton
1+
Class SourceControl.Git.PackageManagerContext Extends SourceControl.Git.Util.Singleton
22
{
33

44
Property InternalName As %String;
@@ -7,22 +7,24 @@ Property IsInDefaultPackage As %Boolean [ InitialExpression = 0 ];
77

88
Property IsInGitEnabledPackage As %Boolean [ InitialExpression = 0 ];
99

10-
/// Really is a %ZPM.PackageManager.Developer.Module
10+
/// Really is a %ZPM.PackageManager.Developer.Module / %IPM.Storage.Module
1111
Property Package As %RegisteredObject [ InitialExpression = {$$$NULLOREF} ];
1212

13-
// Really is a %ZPM.PackageManager.Developer.ResourceReference
14-
13+
/// Really is a %ZPM.PackageManager.Developer.ResourceReference / %IPM.Storage.ResourceReference
1514
Property ResourceReference As %RegisteredObject [ InitialExpression = {$$$NULLOREF} ];
1615

1716
Method InternalNameSet(InternalName As %String = "") As %Status
1817
{
1918
set InternalName = ##class(SourceControl.Git.Utils).NormalizeInternalName(InternalName)
2019
if (InternalName '= i%InternalName) {
2120
set i%InternalName = InternalName
22-
if '$$$comClassDefined("%ZPM.PackageManager.Developer.Extension.Utils") {
21+
if $$$comClassDefined("%IPM.ExtensionBase.Utils") {
22+
set ..Package = ##class(%IPM.ExtensionBase.Utils).FindHomeModule(InternalName,,.resourceReference)
23+
} elseif $$$comClassDefined("%ZPM.PackageManager.Developer.Extension.Utils") {
24+
set ..Package = ##class(%ZPM.PackageManager.Developer.Extension.Utils).FindHomeModule(InternalName,,.resourceReference)
25+
} else {
2326
quit $$$OK
2427
}
25-
set ..Package = ##class(%ZPM.PackageManager.Developer.Extension.Utils).FindHomeModule(InternalName,,.resourceReference)
2628
set ..ResourceReference = resourceReference
2729
set ..IsInGitEnabledPackage = $isobject(..Package) && ##class(%Library.File).Exists(##class(%Library.File).NormalizeFilename(".git",..Package.Root))
2830
set ..IsInDefaultPackage = $isobject(..Package) && (##class(%Library.File).NormalizeDirectory(..Package.Root) = ##class(%Library.File).NormalizeDirectory(##class(SourceControl.Git.Utils).DefaultTempFolder()))

‎cls/SourceControl/Git/Util/Singleton.cls

Lines changed: 170 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,170 @@
1+
/// General class to extend to add a "singleton" interface to any registered or persistent class.
2+
/// For persistent classes, requires that the class has a unique index defined on a read-only property with an InitialExpression.
3+
/// Copied from %ZPM.PackageManager.Core.Singleton to support upgrade to IPM; at some point, can fall back to IPM equivalent.
4+
Class SourceControl.Git.Util.Singleton Extends %RegisteredObject [ Abstract ]
5+
{
6+
7+
/// If set to 1, calls to %Get must return an instance of this class created in the current namespace; a new instance will be created if none exists.
8+
Parameter NAMESPACESCOPE As BOOLEAN = 0;
9+
10+
/// PPG in which to track references to the instance of this class
11+
Parameter PPG As STRING = "^||%ZPM.Singleton";
12+
13+
/// Internal property to track the namespace in which this instance was created.
14+
Property %namespace As %String [ InitialExpression = {$Namespace}, Private, Transient ];
15+
16+
/// This method finds the existing instance of an object of a current class (created in the namespace if ..#NAMESPACESCOPE is 1) if it exists in the current process.
17+
/// Exceptions are caught by calling code.
18+
ClassMethod GetInMemoryInstance() As SourceControl.Git.Util.Singleton [ CodeMode = objectgenerator, Private ]
19+
{
20+
Set tClass = %class.Name
21+
Set tPPG = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"PPG",$$$cPARAMdefault)
22+
Set tIncludeNS = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"NAMESPACESCOPE",$$$cPARAMdefault)
23+
Set tPPGRef = tPPG_"("_$$$QUOTE(tClass)_$Select(tIncludeNS:",$Namespace",1:"")_")"
24+
Do %code.WriteLine(" Set tReturnValue = $$$NULLOREF")
25+
Do %code.WriteLine(" If $Data("_tPPGRef_",tObjInt) {")
26+
Do %code.WriteLine(" Set tInstance = $$$objIntToOref(tObjInt)")
27+
Do %code.WriteLine(" If $IsObject(tInstance) && ($classname(tInstance) = "_$$$QUOTE(tClass)_") {")
28+
Do %code.WriteLine(" Set tReturnValue = tInstance")
29+
Do %code.WriteLine(" }")
30+
Do %code.WriteLine(" }")
31+
Do %code.WriteLine(" Quit tReturnValue")
32+
Quit $$$OK
33+
}
34+
35+
/// Return the single per-process/namespace instance of this class, or create a new one.
36+
/// For persistent classes, may open the existing single record by its unique index.
37+
ClassMethod %Get(Output pSC As %Status) As SourceControl.Git.Util.Singleton [ CodeMode = objectgenerator, Final ]
38+
{
39+
Set tSC = $$$OK
40+
Try {
41+
Set tThisClass = %class.Name
42+
Set tGenPersistent = 0
43+
44+
// No-op for abstract classes.
45+
If $$$comClassKeyGet(tThisClass,$$$cCLASSabstract) {
46+
Quit
47+
}
48+
49+
// Validation for persistent classes.
50+
If ($$$comClassKeyGet(tThisClass,$$$cCLASSclasstype) = $$$cCLASSCLASSTYPEPERSISTENT) {
51+
Set tGenPersistent = 1
52+
53+
// Find a candidate index.
54+
Set tInitialExpression = ""
55+
Set tIndex = ""
56+
For {
57+
Set tIndex = $$$comMemberNext(tThisClass,$$$cCLASSindex,tIndex)
58+
If (tIndex = "") {
59+
Quit
60+
}
61+
62+
// Is the index unique?
63+
If '$$$comMemberKeyGet(tThisClass,$$$cCLASSindex,tIndex,$$$cINDEXunique) {
64+
Continue
65+
}
66+
67+
// Is the index on one property?
68+
If ($$$comMemberKeyGet(tThisClass,$$$cCLASSindex,tIndex,$$$cINDEXproperty) '= 1) {
69+
Continue
70+
}
71+
72+
// Get that one property.
73+
Set tProperty = $$$comSubMemberKeyGet(tThisClass,$$$cCLASSindex,tIndex,$$$cINDEXproperty,1,$$$cINDEXPROPproperty)
74+
If (tProperty = "") {
75+
Continue
76+
}
77+
78+
// Is that property read-only?
79+
If '$$$comMemberKeyGet(tThisClass,$$$cCLASSproperty,tProperty,$$$cPROPreadonly) {
80+
Continue
81+
}
82+
83+
// Get the property's initial expression.
84+
Set tInitialExpression = $$$comMemberKeyGet(tThisClass,$$$cCLASSproperty,tProperty,$$$cPROPinitialexpression)
85+
If (tInitialExpression = "") {
86+
Continue
87+
}
88+
89+
// If we got this far, we have a match, and tIndex won't be empty.
90+
Quit
91+
}
92+
93+
If (tIndex = "") {
94+
// If we found no results...
95+
Set tMsg = "Class '%1' that extends %ZPM.PackageManager.Core.Singleton must define a unique index on a read-only property with an InitialExpression defined."
96+
Set tSC = $$$ERROR($$$GeneralError,$$$FormatText(tMsg,tThisClass))
97+
Quit
98+
}
99+
}
100+
101+
Do %code.WriteLine(" Set tInstance = $$$NULLOREF")
102+
Do %code.WriteLine(" Set pSC = $$$OK")
103+
Do %code.WriteLine(" Try {")
104+
Do %code.WriteLine(" Set tInstance = ..GetInMemoryInstance()")
105+
If tGenPersistent {
106+
// Support opening an existing object by its unique index on a read-only property with an initial expression
107+
Do %code.WriteLine(" If (tInstance = $$$NULLOREF) && .."_tIndex_"Exists("_tInitialExpression_") {")
108+
Do %code.WriteLine(" Set tInstance = .."_tIndex_"Open("_tInitialExpression_",,.pSC)")
109+
// If we found an existing instance, ensure that we have changes that another process may have made
110+
Do %code.WriteLine(" } ElseIf $IsObject(tInstance) && (tInstance.%Id() '= """") {")
111+
Do %code.WriteLine(" Set pSC = tInstance.%Reload()")
112+
Do %code.WriteLine(" } ElseIf (tInstance = $$$NULLOREF) {")
113+
} Else {
114+
Do %code.WriteLine(" If (tInstance = $$$NULLOREF) {")
115+
}
116+
Do %code.WriteLine(" Set tInstance = ..%New()")
117+
Do %code.WriteLine(" }")
118+
119+
Do %code.WriteLine(" } Catch e { ")
120+
Do %code.WriteLine(" Set tInstance = $$$NULLOREF")
121+
Do %code.WriteLine(" Set pSC = e.AsStatus()")
122+
Do %code.WriteLine(" }")
123+
Do %code.WriteLine(" Quit tInstance")
124+
} Catch e {
125+
Set tSC = e.AsStatus()
126+
}
127+
Quit tSC
128+
}
129+
130+
/// Tracks the OREF of this instance in a PPG for later reference.
131+
/// Subclasses of %ZPM.PackageManager.Core.Singleton that override this method *MUST* call ##super().
132+
Method %OnNew() As %Status [ Private, ServerOnly = 1 ]
133+
{
134+
Quit ..%RecordOref()
135+
}
136+
137+
/// Removes the OREF of this instance from PPG.
138+
/// Subclasses of %ZPM.PackageManager.Core.Singleton that override this method *MUST* call ##super().
139+
Method %OnClose() As %Status [ Private, ServerOnly = 1 ]
140+
{
141+
Quit ..%RemoveOref()
142+
}
143+
144+
Method %RecordOref() As %Status [ CodeMode = objectgenerator, Final, Internal, Private ]
145+
{
146+
Set tClass = %class.Name
147+
Set tPPG = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"PPG",$$$cPARAMdefault)
148+
Set tIncludeNS = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"NAMESPACESCOPE",$$$cPARAMdefault)
149+
Set tPPGRef = tPPG_"("_$$$QUOTE(tClass)_$Select(tIncludeNS:",..%namespace",1:"")_")"
150+
Do %code.WriteLine(" If $Data("_tPPGRef_") {")
151+
Do %code.WriteLine(" Quit $$$ERROR($$$GeneralError,""Instance of "_tClass_" already created for this process."")")
152+
Do %code.WriteLine(" }")
153+
Do %code.WriteLine(" Set "_tPPGRef_" = +$This")
154+
Do %code.WriteLine(" Quit $$$OK")
155+
Quit $$$OK
156+
}
157+
158+
Method %RemoveOref() As %Status [ CodeMode = objectgenerator, Final, Internal, Private ]
159+
{
160+
Set tClass = %class.Name
161+
Set tPPG = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"PPG",$$$cPARAMdefault)
162+
Set tIncludeNS = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"NAMESPACESCOPE",$$$cPARAMdefault)
163+
Set tPPGRef = tPPG_"("_$$$QUOTE(tClass)_$Select(tIncludeNS:",..%namespace",1:"")_")"
164+
Do %code.WriteLine(" Kill "_tPPGRef)
165+
Do %code.WriteLine(" Quit $$$OK")
166+
Quit $$$OK
167+
}
168+
169+
}
170+

0 commit comments

Comments
 (0)