intersystems · isc-tleavitt · May 30, 2024 · Apr 30, 2024 · Apr 30, 2024
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -5,6 +5,11 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [2.4.0] - Unreleased
+
+### Added
+- Pre-release support for IPM v0.9.0+
+
 ## [2.3.1] - 2024-04-30
 
 ### Fixed

diff --git a/cls/SourceControl/Git/PackageManagerContext.cls b/cls/SourceControl/Git/PackageManagerContext.cls
@@ -1,4 +1,4 @@
-Class SourceControl.Git.PackageManagerContext Extends %ZPM.PackageManager.Core.Singleton
+Class SourceControl.Git.PackageManagerContext Extends SourceControl.Git.Util.Singleton
 {
 
 Property InternalName As %String;
@@ -7,22 +7,24 @@ Property IsInDefaultPackage As %Boolean [ InitialExpression = 0 ];
 
 Property IsInGitEnabledPackage As %Boolean [ InitialExpression = 0 ];
 
-/// Really is a %ZPM.PackageManager.Developer.Module
+/// Really is a %ZPM.PackageManager.Developer.Module / %IPM.Storage.Module
 Property Package As %RegisteredObject [ InitialExpression = {$$$NULLOREF} ];
 
-// Really is a %ZPM.PackageManager.Developer.ResourceReference
-
+/// Really is a %ZPM.PackageManager.Developer.ResourceReference / %IPM.Storage.ResourceReference
 Property ResourceReference As %RegisteredObject [ InitialExpression = {$$$NULLOREF} ];
 
 Method InternalNameSet(InternalName As %String = "") As %Status
 {
     set InternalName = ##class(SourceControl.Git.Utils).NormalizeInternalName(InternalName)
     if (InternalName '= i%InternalName) {
         set i%InternalName = InternalName
-        if '$$$comClassDefined("%ZPM.PackageManager.Developer.Extension.Utils") {
+        if $$$comClassDefined("%IPM.ExtensionBase.Utils") {
+            set ..Package = ##class(%IPM.ExtensionBase.Utils).FindHomeModule(InternalName,,.resourceReference)
+        } elseif $$$comClassDefined("%ZPM.PackageManager.Developer.Extension.Utils") {
+            set ..Package = ##class(%ZPM.PackageManager.Developer.Extension.Utils).FindHomeModule(InternalName,,.resourceReference)
+        } else {
             quit $$$OK
         }
-        set ..Package = ##class(%ZPM.PackageManager.Developer.Extension.Utils).FindHomeModule(InternalName,,.resourceReference)
         set ..ResourceReference = resourceReference
         set ..IsInGitEnabledPackage = $isobject(..Package) && ##class(%Library.File).Exists(##class(%Library.File).NormalizeFilename(".git",..Package.Root))
         set ..IsInDefaultPackage = $isobject(..Package) && (##class(%Library.File).NormalizeDirectory(..Package.Root) = ##class(%Library.File).NormalizeDirectory(##class(SourceControl.Git.Utils).DefaultTempFolder()))

diff --git a/cls/SourceControl/Git/Util/Singleton.cls b/cls/SourceControl/Git/Util/Singleton.cls
@@ -0,0 +1,170 @@
+/// General class to extend to add a "singleton" interface to any registered or persistent class.
+/// For persistent classes, requires that the class has a unique index defined on a read-only property with an InitialExpression.
+/// Copied from %ZPM.PackageManager.Core.Singleton to support upgrade to IPM; at some point, can fall back to IPM equivalent.
+Class SourceControl.Git.Util.Singleton Extends %RegisteredObject [ Abstract ]
+{
+
+/// 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.
+Parameter NAMESPACESCOPE As BOOLEAN = 0;
+
+/// PPG in which to track references to the instance of this class
+Parameter PPG As STRING = "^||%ZPM.Singleton";
+
+/// Internal property to track the namespace in which this instance was created.
+Property %namespace As %String [ InitialExpression = {$Namespace}, Private, Transient ];
+
+/// 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.
+/// Exceptions are caught by calling code.
+ClassMethod GetInMemoryInstance() As SourceControl.Git.Util.Singleton [ CodeMode = objectgenerator, Private ]
+{
+	Set tClass = %class.Name
+	Set tPPG = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"PPG",$$$cPARAMdefault)
+	Set tIncludeNS = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"NAMESPACESCOPE",$$$cPARAMdefault)
+	Set tPPGRef = tPPG_"("_$$$QUOTE(tClass)_$Select(tIncludeNS:",$Namespace",1:"")_")"
+	Do %code.WriteLine(" Set tReturnValue = $$$NULLOREF")
+	Do %code.WriteLine(" If $Data("_tPPGRef_",tObjInt) {")
+	Do %code.WriteLine("  Set tInstance = $$$objIntToOref(tObjInt)")
+	Do %code.WriteLine("  If $IsObject(tInstance) && ($classname(tInstance) = "_$$$QUOTE(tClass)_") {")
+	Do %code.WriteLine("   Set tReturnValue = tInstance")
+	Do %code.WriteLine("  }")
+	Do %code.WriteLine(" }")
+	Do %code.WriteLine(" Quit tReturnValue")
+	Quit $$$OK
+}
+
+/// Return the single per-process/namespace instance of this class, or create a new one.
+/// For persistent classes, may open the existing single record by its unique index.
+ClassMethod %Get(Output pSC As %Status) As SourceControl.Git.Util.Singleton [ CodeMode = objectgenerator, Final ]
+{
+	Set tSC = $$$OK
+	Try {
+		Set tThisClass = %class.Name
+		Set tGenPersistent = 0
+
+		// No-op for abstract classes.
+		If $$$comClassKeyGet(tThisClass,$$$cCLASSabstract) {
+			Quit
+		}
+
+		// Validation for persistent classes.
+		If ($$$comClassKeyGet(tThisClass,$$$cCLASSclasstype) = $$$cCLASSCLASSTYPEPERSISTENT) {
+			Set tGenPersistent = 1
+
+			// Find a candidate index.
+			Set tInitialExpression = ""
+			Set tIndex = ""
+			For {
+				Set tIndex = $$$comMemberNext(tThisClass,$$$cCLASSindex,tIndex)
+				If (tIndex = "") {
+					Quit
+				}
+
+				// Is the index unique?
+				If '$$$comMemberKeyGet(tThisClass,$$$cCLASSindex,tIndex,$$$cINDEXunique) {
+					Continue
+				}
+
+				// Is the index on one property?
+				If ($$$comMemberKeyGet(tThisClass,$$$cCLASSindex,tIndex,$$$cINDEXproperty) '= 1) {
+					Continue
+				}
+
+				// Get that one property.
+				Set tProperty = $$$comSubMemberKeyGet(tThisClass,$$$cCLASSindex,tIndex,$$$cINDEXproperty,1,$$$cINDEXPROPproperty)
+				If (tProperty = "") {
+					Continue
+				}
+
+				// Is that property read-only?
+				If '$$$comMemberKeyGet(tThisClass,$$$cCLASSproperty,tProperty,$$$cPROPreadonly) {
+					Continue
+				}
+
+				// Get the property's initial expression.
+				Set tInitialExpression = $$$comMemberKeyGet(tThisClass,$$$cCLASSproperty,tProperty,$$$cPROPinitialexpression)
+				If (tInitialExpression = "") {
+					Continue
+				}
+
+				// If we got this far, we have a match, and tIndex won't be empty.
+				Quit
+			}
+
+			If (tIndex = "") {
+				// If we found no results...
+				Set tMsg = "Class '%1' that extends %ZPM.PackageManager.Core.Singleton must define a unique index on a read-only property with an InitialExpression defined."
+				Set tSC = $$$ERROR($$$GeneralError,$$$FormatText(tMsg,tThisClass))
+				Quit
+			}
+		}
+
+		Do %code.WriteLine(" Set tInstance = $$$NULLOREF")
+		Do %code.WriteLine(" Set pSC = $$$OK")
+		Do %code.WriteLine(" Try {")
+		Do %code.WriteLine("  Set tInstance = ..GetInMemoryInstance()")
+		If tGenPersistent {
+			// Support opening an existing object by its unique index on a read-only property with an initial expression
+			Do %code.WriteLine("  If (tInstance = $$$NULLOREF) && .."_tIndex_"Exists("_tInitialExpression_") {")
+			Do %code.WriteLine("   Set tInstance = .."_tIndex_"Open("_tInitialExpression_",,.pSC)")
+			// If we found an existing instance, ensure that we have changes that another process may have made
+			Do %code.WriteLine("  } ElseIf $IsObject(tInstance) && (tInstance.%Id() '= """") {")
+			Do %code.WriteLine("   Set pSC = tInstance.%Reload()")
+			Do %code.WriteLine("  } ElseIf (tInstance = $$$NULLOREF) {")
+		} Else {
+			Do %code.WriteLine("  If (tInstance = $$$NULLOREF) {")
+		}
+		Do %code.WriteLine("   Set tInstance = ..%New()")
+		Do %code.WriteLine("  }")
+
+		Do %code.WriteLine(" } Catch e { ")
+		Do %code.WriteLine("  Set tInstance = $$$NULLOREF")
+		Do %code.WriteLine("  Set pSC = e.AsStatus()")
+		Do %code.WriteLine(" }")
+		Do %code.WriteLine(" Quit tInstance")
+	} Catch e {
+		Set tSC = e.AsStatus()
+	}
+	Quit tSC
+}
+
+/// Tracks the OREF of this instance in a PPG for later reference.
+/// Subclasses of %ZPM.PackageManager.Core.Singleton that override this method *MUST* call ##super().
+Method %OnNew() As %Status [ Private, ServerOnly = 1 ]
+{
+	Quit ..%RecordOref()
+}
+
+/// Removes the OREF of this instance from PPG.
+/// Subclasses of %ZPM.PackageManager.Core.Singleton that override this method *MUST* call ##super().
+Method %OnClose() As %Status [ Private, ServerOnly = 1 ]
+{
+	Quit ..%RemoveOref()
+}
+
+Method %RecordOref() As %Status [ CodeMode = objectgenerator, Final, Internal, Private ]
+{
+	Set tClass = %class.Name
+	Set tPPG = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"PPG",$$$cPARAMdefault)
+	Set tIncludeNS = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"NAMESPACESCOPE",$$$cPARAMdefault)
+	Set tPPGRef = tPPG_"("_$$$QUOTE(tClass)_$Select(tIncludeNS:",..%namespace",1:"")_")"
+	Do %code.WriteLine(" If $Data("_tPPGRef_") {")
+	Do %code.WriteLine("  Quit $$$ERROR($$$GeneralError,""Instance of "_tClass_" already created for this process."")")
+	Do %code.WriteLine(" }")
+	Do %code.WriteLine(" Set "_tPPGRef_" = +$This")
+	Do %code.WriteLine(" Quit $$$OK")
+	Quit $$$OK
+}
+
+Method %RemoveOref() As %Status [ CodeMode = objectgenerator, Final, Internal, Private ]
+{
+	Set tClass = %class.Name
+	Set tPPG = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"PPG",$$$cPARAMdefault)
+	Set tIncludeNS = $$$comMemberKeyGet(tClass,$$$cCLASSparameter,"NAMESPACESCOPE",$$$cPARAMdefault)
+	Set tPPGRef = tPPG_"("_$$$QUOTE(tClass)_$Select(tIncludeNS:",..%namespace",1:"")_")"
+	Do %code.WriteLine(" Kill "_tPPGRef)
+	Do %code.WriteLine(" Quit $$$OK")
+	Quit $$$OK
+}
+
+}
+
diff --git a/module.xml b/module.xml
@@ -3,7 +3,7 @@
   <Document name="git-source-control.ZPM">
     <Module>
       <Name>git-source-control</Name>
-      <Version>2.3.1</Version>
+      <Version>2.4.0</Version>
       <Description>Server-side source control extension for use of Git on InterSystems platforms</Description>
       <Keywords>git source control studio vscode</Keywords>
       <Packaging>module</Packaging>