From da9f94abf16782d0e3868fb87f0b17b01d17c003 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Mon, 6 Nov 2023 16:11:33 -0600 Subject: [PATCH] Don't auto split layout/VBA for existing projects For existing projects in git repositories, form and report layouts should not be automatically split from the VBA code classes. There is another process that will allow us to split the files while preserving history in both files, but this involves a couple commits and requires a clean branch. For existing projects, this is a manual upgrade (option changes). For new projects, it can happen by default. --- .../modules/clsGitIntegration.cls | 81 +++++++++++++++---- .../modules/clsOptions.cls | 60 ++++++++++++++ 2 files changed, 124 insertions(+), 17 deletions(-) diff --git a/Version Control.accda.src/modules/clsGitIntegration.cls b/Version Control.accda.src/modules/clsGitIntegration.cls index 5d59acd3..ace9583d 100644 --- a/Version Control.accda.src/modules/clsGitIntegration.cls +++ b/Version Control.accda.src/modules/clsGitIntegration.cls @@ -35,11 +35,12 @@ Private Enum eGitCommand egcGetUntrackedFiles egcGetHeadCommit egcGetBranchName - egcSetTaggedCommit egcGetReproPath egcGetRevision egcGetStatusPorcelain + egcIsInsideTree ' Action commands + egcSetTaggedCommit egcInitialize egcAddAll egcCommit @@ -101,6 +102,7 @@ Private Function RunGitCommand(intCmd As eGitCommand, Optional strArgument As St Case egcCheckoutNewBranch: strCmd = "git checkout -b {MyArg}" Case egcCheckoutHeadToCurrent: strCmd = "git checkout HEAD~ ." Case egcDeleteBranch: strCmd = "git branch --delete {MyArg}" + Case egcIsInsideTree: strCmd = "git rev-parse --is-inside-work-tree" Case Else Log.Error eelError, "Unrecognized Git Command Enum: " & intCmd Stop @@ -111,7 +113,7 @@ Private Function RunGitCommand(intCmd As eGitCommand, Optional strArgument As St ' Run command, and get result Perf.OperationStart "Git Command (id:" & intCmd & ")" - strResult = ShellRun(strCmd) + strResult = ShellRun(strCmd, intCmd) Perf.OperationEnd ' Trim any trailing vbLf @@ -170,7 +172,7 @@ End Function ' Purpose : Returns the path to the root of the repository. '--------------------------------------------------------------------------------------- ' -Public Function GetRepositoryRoot() As String +Public Function GetRepositoryRoot(Optional blnFallBackToWorking As Boolean = True) As String Static strLastFolder As String ' Working folder Static strLastRoot As String ' Repository Root @@ -180,6 +182,12 @@ Public Function GetRepositoryRoot() As String ' Determine the current working folder strWorking = GetWorkingFolder + ' Make sure git is actually installed + If Not Me.GitInstalled Then + If blnFallBackToWorking Then GetRepositoryRoot = strWorking + Exit Function + End If + ' On first call, we will attempt to get the repository root from the working ' folder, or the export folder if a working folder is not specified. If strLastRoot = vbNullString Or (strLastFolder <> strWorking) Then @@ -189,16 +197,20 @@ Public Function GetRepositoryRoot() As String strLastFolder = strWorking strLastRoot = vbNullString ' Recursively call this function to verify the path with git - GetRepositoryRoot = GetRepositoryRoot() + GetRepositoryRoot = GetRepositoryRoot(blnFallBackToWorking) Else ' Run git command from last folder strLastRoot = strLastFolder ' Use Git to look up root folder in repository. strLastRoot = Replace(RunGitCommand(egcGetReproPath), "/", PathSep) & PathSep If strLastRoot = PathSep Then - ' Might not be in a git repository. Fall back to working folder. - GetRepositoryRoot = strWorking - strLastRoot = strWorking + If blnFallBackToWorking Then + ' Might not be in a git repository. Fall back to working folder. + GetRepositoryRoot = strWorking + strLastRoot = strWorking + Else + GetRepositoryRoot = vbNullString + End If Else ' Found the root folder. Return to caller. GetRepositoryRoot = strLastRoot @@ -221,7 +233,20 @@ End Function '--------------------------------------------------------------------------------------- ' Private Function GetWorkingFolder() As String - GetWorkingFolder = StripSlash(Nz2(Me.WorkingFolder, Options.GetExportFolder)) & PathSep + + Dim strWorking As String + + ' Avoid calling Options if the working folder is already defined to prevent + ' a possible stack overflow. (That's why we don't use Nz2() here) + If Len(Me.WorkingFolder) Then + strWorking = Me.WorkingFolder + Else + strWorking = Options.GetExportFolder + End If + + ' Return path in consistent format + GetWorkingFolder = StripSlash(strWorking) & PathSep + End Function @@ -229,11 +254,28 @@ End Function ' Procedure : Version ' Author : Adam Waller ' Date : 3/10/2023 -' Purpose : Return git version +' Purpose : Return git version (Cached between calls) '--------------------------------------------------------------------------------------- ' Public Function Version() As String - Version = Replace(RunGitCommand(egcGetVersion), "git version ", vbNullString) + Static strVersion As String + If strVersion = vbNullString Then strVersion = Replace(RunGitCommand(egcGetVersion), "git version ", vbNullString) + Version = strVersion +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : IsInsideRepository +' Author : Adam Waller +' Date : 11/6/2023 +' Purpose : Returns true if the current working folder is inside a git repository. +'--------------------------------------------------------------------------------------- +' +Public Function IsInsideRepository() As Boolean + Dim strResult As String + If Me.GitInstalled Then + IsInsideRepository = (RunGitCommand(egcIsInsideTree) = "true") + End If End Function @@ -356,7 +398,7 @@ End Sub ' Purpose : Pass a git command to this function to return the result as a string. '--------------------------------------------------------------------------------------- ' -Private Function ShellRun(strCmd As String) As String +Private Function ShellRun(strCmd As String, intCmd As eGitCommand) As String Dim oShell As WshShell Dim strFile As String @@ -366,10 +408,16 @@ Private Function ShellRun(strCmd As String) As String ' Build command line string With New clsConcat - ' Open command prompt in repository folder - .Add "cmd.exe /c cd ", GetRepositoryRoot - ' Run git command - .Add " & ", strCmd + Select Case intCmd + Case egcGetVersion + ' Run independent of repository + .Add "cmd.exe /c ", strCmd + Case Else + ' Open command prompt in repository folder + .Add "cmd.exe /c cd ", GetRepositoryRoot + ' Run git command + .Add " & ", strCmd + End Select ' Output to temp file .Add " > """, strFile, """" ' Execute command @@ -478,8 +526,7 @@ End Function '--------------------------------------------------------------------------------------- ' Public Function GitInstalled() As Boolean - ' Expecting something like "git version 2.29.2.windows.2" - GitInstalled = InStr(1, RunGitCommand(egcGetVersion), "git version ") = 1 + GitInstalled = (Len(Me.Version)) End Function diff --git a/Version Control.accda.src/modules/clsOptions.cls b/Version Control.accda.src/modules/clsOptions.cls index 4f091b0b..3368b3e5 100644 --- a/Version Control.accda.src/modules/clsOptions.cls +++ b/Version Control.accda.src/modules/clsOptions.cls @@ -275,6 +275,9 @@ End Sub ' Private Sub Upgrade(ByRef dOptions As Dictionary) + Dim dFiles As Dictionary + Dim strPath As String + ' 6/16/2021 ' Aggressive sanitize to sanitize levels If dOptions.Exists("AggressiveSanitize") Then @@ -287,9 +290,66 @@ Private Sub Upgrade(ByRef dOptions As Dictionary) End If End If + ' 11/3/2023 + ' Check option to split VBA from object layout + If Not dOptions.Exists("SplitLayoutFromVBA") Then + ' The existing options file does not have this option defined. + ' See if we have any source files from previous exports. + If HasUnifiedLayoutFilesInGit(Me.GetExportFolder) Then + ' Set the option as false by default, and let the user + ' turn it on explicitly for this project. + ' (That way they are not forced to make a decision immediately) + Me.SplitLayoutFromVBA = False + Else + ' If we already have split files, or if this project is + ' being exported for the first time, leave the option at + ' the default setting. + End If + End If + End Sub +'--------------------------------------------------------------------------------------- +' Procedure : HasUnifiedLayoutFilesInGit +' Author : Adam Waller +' Date : 11/3/2023 +' Purpose : Returns true if the current project seems to have existing form or report +' : source files AND appears to be in a .git repository. +' : (This function is used when determining the default for splitting VBA +' : from layout files in new projects.) +' : For performance reasons this is not a fully comprehensive check of every +' : possible source file, but should be a pretty good indication of whether +' : existing source files need to be split in git to preserve the history in +' : both source files. +'--------------------------------------------------------------------------------------- +' +Private Function HasUnifiedLayoutFilesInGit(strExportPath As String) As Boolean + + Dim blnHasFiles As Boolean + Dim strFolder As String + + ' See if we have any ".bas" files, but no corresponding ".cls" files in the + ' forms and reports export folders. + ' Hard-coding the folder names to avoid calling options. + If GetFileList(BuildPath2(strExportPath, "forms"), "*.bas").Count > 0 Then + blnHasFiles = (GetFileList(BuildPath2(strExportPath, "forms"), "*.cls").Count = 0) + ElseIf GetFileList(BuildPath2(strExportPath, "reports"), "*.bas").Count > 0 Then + blnHasFiles = (GetFileList(BuildPath2(strExportPath, "reports"), "*.cls").Count = 0) + End If + + If blnHasFiles Then + ' Check to see if this folder is in a git repository + If Git.GitInstalled Then + ' Check export path + Git.WorkingFolder = strExportPath + HasUnifiedLayoutFilesInGit = Git.IsInsideRepository + End If + End If + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : LoadProjectOptions ' Author : Adam Waller