Skip to content

Commit

Permalink
Don't auto split layout/VBA for existing projects
Browse files Browse the repository at this point in the history 
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.
  • Loading branch information
@joyfullservice
joyfullservice committed Nov 6, 2023
1 parent 2d21eb6 commit da9f94a
Show file tree
Hide file tree
Showing 2 changed files with 124 additions and 17 deletions.
81 changes: 64 additions & 17 deletions Version Control.accda.src/modules/clsGitIntegration.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,11 +35,12 @@ Private Enum eGitCommand
egcGetUntrackedFiles
egcGetHeadCommit
egcGetBranchName
egcSetTaggedCommit
egcGetReproPath
egcGetRevision
egcGetStatusPorcelain
egcIsInsideTree
' Action commands
egcSetTaggedCommit
egcInitialize
egcAddAll
egcCommit
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -221,19 +233,49 @@ 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


'---------------------------------------------------------------------------------------
' 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


Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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


Expand Down
60 changes: 60 additions & 0 deletions Version Control.accda.src/modules/clsOptions.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit da9f94a

Please sign in to comment.