Skip to content

Commit

Permalink
Implement schema filter
Browse files Browse the repository at this point in the history 
This allows you to filter to only export a subset of the database objects. (Note that this still pulls a full list of objects from the SQL server, but only actually exports the ones that match the filter.) #415
  • Loading branch information
@joyfullservice
joyfullservice committed Jul 21, 2023
1 parent ab10ba0 commit 36ef901
Show file tree
Hide file tree
Showing 5 changed files with 225 additions and 72 deletions.
139 changes: 103 additions & 36 deletions Version Control.accda.src/forms/frmVCSDatabase.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -394,7 +394,7 @@ Begin Form
LayoutCachedHeight =6120
Begin
Begin Label
OverlapFlags =85
OverlapFlags =93
Left =720
Top =4380
Width =4620
Expand Down Expand Up @@ -677,36 +677,55 @@ Begin Form
ForeThemeColorIndex =-1
ForeTint =100.0
End
Begin CheckBox
Visible = NotDefault
OverlapFlags =85
Left =5640
Top =4410
Begin CommandButton
FontUnderline = NotDefault
TabStop = NotDefault
OverlapFlags =87
Left =5340
Top =4440
Width =1140
Height =240
FontSize =10
TabIndex =8
Name ="chkRegExFilter"
Name ="cmdTest"
Caption ="Test Filter..."
OnClick ="[Event Procedure]"
LeftPadding =135
TopPadding =135
RightPadding =150
BottomPadding =150
HorizontalAnchor =1
BackStyle =0

LayoutCachedLeft =5640
LayoutCachedTop =4410
LayoutCachedWidth =5900
LayoutCachedHeight =4650
Begin
Begin Label
OverlapFlags =247
Left =5870
Top =4380
Width =735
Height =315
ForeColor =5324600
Name ="Label255"
Caption ="RegEx"
LayoutCachedLeft =5870
LayoutCachedTop =4380
LayoutCachedWidth =6605
LayoutCachedHeight =4695
ForeThemeColorIndex =-1
ForeTint =100.0
End
End
CursorOnHover =1
LayoutCachedLeft =5340
LayoutCachedTop =4440
LayoutCachedWidth =6480
LayoutCachedHeight =4680
Alignment =1
ForeThemeColorIndex =10
ForeTint =100.0
Gradient =0
BackColor =5324600
BackThemeColorIndex =-1
BackTint =100.0
OldBorderStyle =0
BorderColor =15321539
BorderThemeColorIndex =-1
BorderTint =100.0
HoverThemeColorIndex =10
HoverTint =100.0
PressedThemeColorIndex =10
PressedShade =100.0
HoverForeThemeColorIndex =10
HoverForeTint =100.0
PressedForeThemeColorIndex =10
PressedForeTint =100.0
WebImagePaddingLeft =9
WebImagePaddingTop =9
WebImagePaddingRight =10
WebImagePaddingBottom =10
Overlaps =1
End
End
End
Expand Down Expand Up @@ -815,11 +834,26 @@ End Sub
'---------------------------------------------------------------------------------------
'
Private Sub cmdSaveAndClose_Click()
If SaveConnection Then
Form_frmVCSOptions.RefreshSchemaList
DoCmd.Close acForm, Me.Name
End If
End Sub


'---------------------------------------------------------------------------------------
' Procedure : SaveConnection
' Author : Adam Waller
' Date : 7/21/2023
' Purpose : Save the current connection, return true if successful.
'---------------------------------------------------------------------------------------
'
Private Function SaveConnection() As Boolean

Dim dSchema As Dictionary
Dim strKey As String

If Not PassedValidation Then Exit Sub
If Not PassedValidation Then Exit Function

If IsLoaded(acForm, "frmVCSOptions") Then
With Form_frmVCSOptions.DatabaseSchemas
Expand All @@ -845,16 +879,13 @@ Private Sub cmdSaveAndClose_Click()
' Save connection string to .env file
SaveConnectionString

' Refresh list
Form_frmVCSOptions.RefreshSchemaList

' Close form
DoCmd.Close acForm, Me.Name
' Return success
SaveConnection = True
Else
MsgBox2 "Options form not found", "The Options form must be open to save changes to external database connections", , vbExclamation
End If

End Sub
End Function


'---------------------------------------------------------------------------------------
Expand All @@ -881,3 +912,39 @@ Private Function PassedValidation() As Boolean
End If

End Function


'---------------------------------------------------------------------------------------
' Procedure : cmdTest_Click
' Author : Adam Waller
' Date : 7/21/2023
' Purpose : Test the current filter and return the number of objects found.
'---------------------------------------------------------------------------------------
'
Private Sub cmdTest_Click()

Dim cSchema As IDbSchema
Dim lngCount As Long
Dim dblStart As Double
Dim dParams As Dictionary

If Not SaveConnection Then Exit Sub

Select Case cboType
Case eDatabaseServerType.estMsSql
Set cSchema = New clsSchemaMsSql
'Case eDatabaseServerType.estMsSql
End Select

' Retrieve object count from server.
If Not cSchema Is Nothing Then
Set dParams = GetSchemaInitParams(Nz(txtName))
dParams("Filter") = Nz(txtFilter)
cSchema.Initialize dParams
dblStart = Perf.MicroTimer
lngCount = cSchema.ObjectCount(False)
MsgBox2 lngCount & " Objects Found", "A total of " & lngCount & " database objects were retrieved in " & _
Round(Perf.MicroTimer - dblStart, 2) & " seconds.", , vbInformation
End If

End Sub
8 changes: 4 additions & 4 deletions Version Control.accda.src/modules/IDbSchema.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,14 +35,14 @@ End Sub


'---------------------------------------------------------------------------------------
' Procedure : GetChangeCount
' Procedure : ObjectCount
' Author : Adam Waller
' Date : 7/21/2023
' Purpose : Return a count of how many changes were found between the database
' : objects and the current index file.
' Purpose : Return a count of total objects, or how many changes were found between
' : the database server objects and the current index file.
'---------------------------------------------------------------------------------------
'
Public Function GetChangeCount() As Long
Public Function ObjectCount(blnModifiedOnly As Boolean) As Long
End Function


Expand Down
101 changes: 79 additions & 22 deletions Version Control.accda.src/modules/clsSchemaMsSql.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ Private Type udtThis
strConnect As String
strUserID As String
strPassword As String
varFilters As Variant
End Type
Private this As udtThis

Expand Down Expand Up @@ -219,6 +220,42 @@ Private Sub UpdateIndex(strItem As String, dObject As Dictionary)
End Sub


'---------------------------------------------------------------------------------------
' Procedure : PassesFilter
' Author : Adam Waller
' Date : 7/21/2023
' Purpose : Returns true if this item passed any user-defined filter rules.
' : The current implementation processes rules sequentially, applying each
' : rule in order. Last matching rule will apply to the object.
'---------------------------------------------------------------------------------------
'
Private Function PassesFilter(strItem As String) As Boolean

Dim blnPass As Boolean
Dim lngRule As Long
Dim strRule As String

' Loop through rules
For lngRule = 0 To UBound(this.varFilters)
strRule = Trim(this.varFilters(lngRule))
Select Case Left(strRule, 1)
Case "#", vbNullString
' Ignore comments and blank lines
Case "!"
' Negative rule (do not include)
If strItem Like Mid(strRule, 2) Then blnPass = False
Case Else
' Positive rule
If strItem Like strRule Then blnPass = True
End Select
Next lngRule

' Return final result
PassesFilter = blnPass

End Function


'---------------------------------------------------------------------------------------
' Procedure : ScanDatabaseObjects
' Author : Adam Waller
Expand Down Expand Up @@ -277,26 +314,30 @@ Private Sub ScanDatabaseObjects()
strItem = Nz(!Folder) & PathSep & GetSafeFileName(Nz(!Name)) & ".sql"
strPath = this.strBaseFolder & strItem

' Add all objects to full collection
Set dItem = New Dictionary
dItem("LastModified") = Nz(!last_modified)
m_AllItems.Add strItem, dItem

' Reset flag
blnModified = True

' See if this item has been modified
If m_Index.Exists(strItem) Then
blnModified = (dItem("LastModified") <> Nz(!last_modified))
End If

' Build dictionary of modified objects
If blnModified Then
Set dItem = CloneDictionary(dItem)
dItem("type_desc") = Nz(!type_desc)
dItem("schema") = Nz(!schema)
dItem("name") = Nz(!Name)
m_ModifiedItems.Add strItem, dItem
' See if we pass the filter
If PassesFilter(strItem) Then

' Add all objects to full collection
Set dItem = New Dictionary
dItem("LastModified") = Nz(!last_modified)
m_AllItems.Add strItem, dItem

' Reset flag
blnModified = True

' See if this item has been modified
If m_Index.Exists(strItem) Then
blnModified = (dItem("LastModified") <> Nz(!last_modified))
End If

' Build dictionary of modified objects
If blnModified Then
Set dItem = CloneDictionary(dItem)
dItem("type_desc") = Nz(!type_desc)
dItem("schema") = Nz(!schema)
dItem("name") = Nz(!Name)
m_ModifiedItems.Add strItem, dItem
End If
End If

' Move to next object
Expand Down Expand Up @@ -324,9 +365,10 @@ End Function
' Purpose : Return count of modified objects
'---------------------------------------------------------------------------------------
'
Private Function IDbSchema_GetChangeCount() As Long
Private Function IDbSchema_ObjectCount(blnModifiedOnly As Boolean) As Long
If m_AllItems Is Nothing Then ScanDatabaseObjects
IDbSchema_GetChangeCount = m_ModifiedItems.Count
If m_AllItems Is Nothing Then Exit Function
IDbSchema_ObjectCount = IIf(blnModifiedOnly, m_ModifiedItems.Count, m_AllItems.Count)
End Function


Expand All @@ -338,10 +380,25 @@ End Function
'---------------------------------------------------------------------------------------
'
Private Sub IDbSchema_Initialize(dInstance As Scripting.IDictionary)

Dim strFilter As String
Dim varRules As Variant

' Build filters
strFilter = dNZ(dInstance, "Filter")
If Trim(Replace(strFilter, vbCrLf, vbNullString)) = vbNullString Then
' Blank lines, or nothing defined
varRules = Array("*")
Else
' Create array of rules (we will skip comments and blank lines later)
varRules = Split(strFilter, vbCrLf)
End If

With this
.strName = dNZ(dInstance, "Name")
.strConnect = dNZ(dInstance, "Connect")
.strBaseFolder = Options.GetExportFolder & "databases\" & GetSafeFileName(.strName) & PathSep
.varFilters = varRules
.blnInitialized = (Len(.strConnect))
End With
End Sub
Expand Down
13 changes: 3 additions & 10 deletions Version Control.accda.src/modules/modImportExport.bas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -617,22 +617,15 @@ Public Sub ExportSchemas(blnFullExport As Boolean)
Log.Add " - " & strName & strType
Perf.CategoryStart strName & strType
Log.Flush
' Load parameters for initializing the connection
Set dParams = CloneDictionary(Options.SchemaExports(varKey))
dParams("Name") = strName

strFile = BuildPath2(Options.GetExportFolder & "databases", GetSafeFileName(strName), ".env")
If Not FSO.FileExists(strFile) Then
' Load parameters for initializing the connection
Set dParams = GetSchemaInitParams(strName)
If dParams("Connect") = vbNullString Then
Log.Add " No connection string found. (.env)", , , "Red", , True
Log.Error eelWarning, "File not found: " & strFile, ModuleName & ".ExportSchemas"
Log.Add "Set the connection string for this external database connection in VCS options to automatically create this file.", False
Log.Add "(This file may contain authentication credentials and should be excluded from version control.)", False
Else
' Use .env file to initialize connection
With New clsDotEnv
.LoadFromFile strFile
.MergeIntoDictionary dParams, False
End With
cSchema.Initialize dParams
cSchema.Export blnFullExport
End If
Expand Down
Loading

0 comments on commit 36ef901

Please sign in to comment.