diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 8f542716..4db8e140 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/Version Control.accda.src/dbs-properties.json @@ -41,7 +41,7 @@ "Type": 10 }, "AppVersion": { - "Value": "4.0.17", + "Value": "4.0.18", "Type": 10 }, "Auto Compact": { diff --git a/Version Control.accda.src/forms/frmVCSDatabase.bas b/Version Control.accda.src/forms/frmVCSDatabase.bas index df3dc243..6a74d4e9 100644 --- a/Version Control.accda.src/forms/frmVCSDatabase.bas +++ b/Version Control.accda.src/forms/frmVCSDatabase.bas @@ -845,6 +845,7 @@ Begin Form TabIndex =12 Name ="cmdExamples" Caption ="Examples..." + OnClick ="[Event Procedure]" LeftPadding =135 TopPadding =135 RightPadding =150 @@ -988,6 +989,18 @@ Private Sub cmdCancel_Click() End Sub +'--------------------------------------------------------------------------------------- +' Procedure : cmdExamples_Click +' Author : Adam Waller +' Date : 8/2/2023 +' Purpose : Show syntax examples on the Wiki +'--------------------------------------------------------------------------------------- +' +Private Sub cmdExamples_Click() + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : cmdSaveAndClose_Click ' Author : Adam Waller @@ -1018,31 +1031,38 @@ Private Function SaveConnection() As Boolean If Not PassedValidation Then Exit Function If IsLoaded(acForm, "frmVCSOptions") Then - With Form_frmVCSOptions.DatabaseSchemas - - ' Get a reference to dictionary object - strKey = Nz(txtName) - If Not .Exists(strKey) Then - ' Could be a rename - Set dSchema = New Dictionary - .Add strKey, dSchema - ' Remove any previous entry - If Len(m_strOriginalName) Then - If .Exists(m_strOriginalName) Then .Remove m_strOriginalName + With Form_frmVCSOptions + + ' Make sure we have a dictionary object + If .DatabaseSchemas Is Nothing Then Set .DatabaseSchemas = New Dictionary + + ' Save to options form + With .DatabaseSchemas + + ' Get a reference to dictionary object + strKey = Nz(txtName) + If Not .Exists(strKey) Then + ' Could be a rename + Set dSchema = New Dictionary + .Add strKey, dSchema + ' Remove any previous entry + If Len(m_strOriginalName) Then + If .Exists(m_strOriginalName) Then .Remove m_strOriginalName + End If End If - End If - ' Load form values - SetParamsFromForm .Item(strKey) + ' Load form values + SetParamsFromForm .Item(strKey) - ' Connection string - If chkSaveDotEnv Then - CheckGitignoreDotEnv - ' Save connection string to .env file - SaveConnectionStringToFile - ' Remove connect parameter from dictionary - If .Item(strKey).Exists("Connect") Then .Item(strKey).Remove "Connect" - End If + ' Connection string + If chkSaveDotEnv Then + CheckGitignoreDotEnv + ' Save connection string to .env file + SaveConnectionStringToFile + ' Remove connect parameter from dictionary + If .Item(strKey).Exists("Connect") Then .Item(strKey).Remove "Connect" + End If + End With End With ' Return success @@ -1144,7 +1164,8 @@ Private Sub cmdTest_Click() Select Case cboType Case eDatabaseServerType.estMsSql Set cSchema = New clsSchemaMsSql - 'Case eDatabaseServerType.estMsSql + Case eDatabaseServerType.estMySql + Set cSchema = New clsSchemaMySql End Select ' Retrieve object count from server. diff --git a/Version Control.accda.src/modules/clsSchemaMsSql.cls b/Version Control.accda.src/modules/clsSchemaMsSql.cls index 2f9d236c..9c26cc88 100644 --- a/Version Control.accda.src/modules/clsSchemaMsSql.cls +++ b/Version Control.accda.src/modules/clsSchemaMsSql.cls @@ -359,42 +359,6 @@ Private Function GetTableDefFallback(strTable As String, oConn As ADODB.Connecti End Function -'--------------------------------------------------------------------------------------- -' 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 @@ -423,7 +387,7 @@ Private Sub ScanDatabaseObjects() ' Open database connection Set conn = GetNewOpenConnection If conn Is Nothing Then Exit Sub - + ' Return list of objects from the server Perf.OperationStart "Retrieve SQL Objects" Set rstObjects = conn.Execute(CodeDb.QueryDefs("qryMsSqlServerObjects").SQL) @@ -444,7 +408,7 @@ Private Sub ScanDatabaseObjects() strPath = this.strBaseFolder & strItem ' See if we pass the filter - If PassesFilter(strItem) Then + If PassesSchemaFilter(strItem, this.varFilters) Then ' Add all objects to full collection m_AllItems.Add strItem, Nz(!last_modified) @@ -493,7 +457,7 @@ End Sub Private Function GetNewOpenConnection() As ADODB.Connection Dim oConn As ADODB.Connection - + Set oConn = New ADODB.Connection With oConn LogUnhandledErrors @@ -504,7 +468,7 @@ Private Function GetNewOpenConnection() As ADODB.Connection .Open this.strConnect End If End With - + ' Check for any connection error If CatchAny(eelError, "Unable to connect to " & this.strName, ModuleName(Me)) Then Log.Add "Connection string: " & this.strConnect, False @@ -512,7 +476,7 @@ Private Function GetNewOpenConnection() As ADODB.Connection ' Return open connection Set GetNewOpenConnection = oConn End If - + End Function diff --git a/Version Control.accda.src/modules/clsSchemaMySql.cls b/Version Control.accda.src/modules/clsSchemaMySql.cls new file mode 100644 index 00000000..ef5813d8 --- /dev/null +++ b/Version Control.accda.src/modules/clsSchemaMySql.cls @@ -0,0 +1,581 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsSchemaMySql" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : This class extends the IDbSchema class to perform the specific +' : operations required by this particular object type. +' : (I.e. The specific way you export or import this component.) +'--------------------------------------------------------------------------------------- +Option Compare Database +Option Explicit + + +' Handle local variables +Private Type udtThis + blnInitialized As Boolean + strName As String + strBaseFolder As String + strConnect As String + blnUtcTime As Boolean + strUserID As String + strPassword As String + varFilters As Variant +End Type +Private this As udtThis + +' Dictionaries representing modified items, and all items +Private m_Files As Dictionary +Private m_AllItems As Dictionary +Private m_ModifiedItems As Dictionary + +' This requires us to use all the public methods and properties of the implemented class +' which keeps all the server classes consistent in how they are used in the export +' process. The implemented functions should be kept private as they are called +' from the implementing class, not this class. +Implements IDbSchema + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_Export +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Export DDL representations of the external database objects. +'--------------------------------------------------------------------------------------- +' +Private Sub IDbSchema_Export(blnFullExport As Boolean, Optional strAlternatePath As String) + + Dim conn As ADODB.Connection + Dim strItem As String + Dim dItem As Dictionary + Dim varItem As Variant + Dim dblStart As Double + Dim strPath As String + Dim blnChanges As Boolean + Dim dFolders As Dictionary + + ' Make sure we initialize before running the export + If Not this.blnInitialized Then Exit Sub + + ' Make sure we have already performed a scan of the database objects + If m_Files Is Nothing Then ScanFiles + If m_AllItems Is Nothing Then ScanDatabaseObjects + + ' If there are no new changes found, we may not need to export anything + If (m_ModifiedItems.Count = 0) And (m_Files.Count = m_AllItems.Count) Then + ' Database matches the current set of files + Else + blnChanges = True + If m_ModifiedItems.Count = 0 Then + Log.Add " Verifying files...", , , , , True + Else + Log.Add " Exporting " & m_ModifiedItems.Count & " objects...", , , , , True + Log.ProgMax = m_ModifiedItems.Count + Log.Flush + End If + + ' Open database connection + Set conn = GetNewOpenConnection + If conn Is Nothing Then Exit Sub + + ' -------------------------------------------------- + ' FIRST PASS - Export changed/new database objects + ' -------------------------------------------------- + For Each varItem In m_ModifiedItems.Keys + + ' Time the export of each item + dblStart = Perf.MicroTimer + Set dItem = m_ModifiedItems(varItem) + strItem = varItem + ExportObject dItem("folder"), dItem("schema"), dItem("name"), dItem("last_modified"), dItem("hash"), CStr(varItem), conn + Log.Add " Exported " & varItem & " in " & Round(Perf.MicroTimer - dblStart, 2) & " seconds.", Options.ShowDebug + Log.Increment + ' Check for canceled operation + If Log.ErrorLevel = eelCritical Then Exit For + Next varItem + + ' Close database connection + conn.Close + Set conn = Nothing + End If + + ' -------------------------------------------------- + ' SECOND PASS - Remove orphaned files + ' -------------------------------------------------- + Perf.OperationStart "Clear Orphaned Schema Files" + For Each varItem In m_Files + If Not m_AllItems.Exists(varItem) Then + strPath = this.strBaseFolder & varItem + If FSO.FileExists(strPath) Then + Log.Add " - Removed orphaned file: " & varItem, False + DeleteFile strPath + blnChanges = True + End If + End If + Next varItem + Perf.OperationEnd + + ' -------------------------------------------------- + ' THIRD PASS - Remove empty source folders + ' -------------------------------------------------- + If blnChanges Then + Set dFolders = GetBaseFolders + For Each varItem In dFolders + strPath = this.strBaseFolder & varItem + If FSO.FolderExists(strPath) Then + If FSO.GetFolder(strPath).Files.Count = 0 Then + ' Remove empty component subfolders + FSO.DeleteFolder strPath + End If + End If + Next varItem + End If + + ' Save updated index + SaveUpdatedIndex + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ExportObject +' Author : Adam Waller +' Date : 7/18/2023 +' Purpose : Export the object definition to a file +'--------------------------------------------------------------------------------------- +' +Private Function ExportObject(strType, strSchema As String, strName As String, dteModified As Date, strHash As String, strFile As String, ByRef oConn As ADODB.Connection) As String + + Dim strSqlDef + Dim strDefinition As String + Dim rst As ADODB.Recordset + Dim strFullName As String + Dim cmd As ADODB.Command + Dim intField As Integer + Dim strPath As String + + ' Build full name of SQL object + strFullName = "`" & strSchema & "`.`" & strName & "`" + + ' Determine how to export this type of object + Select Case strType + Case "tables": strSqlDef = "show create table " & strFullName + Case "views": strSqlDef = "show create view " & strFullName + Case "procedures": strSqlDef = "show create procedure " & strFullName + Case "functions": strSqlDef = "show create function " & strFullName + Case "triggers": strSqlDef = "show create trigger " & strFullName + Case Else + ' Unsupported type + Log.Error eelError, "Unsupported object type: " & strType, ModuleName(Me) & ".ExportObject" + Exit Function + End Select + + ' Sanity check + If Len(strSqlDef) Then + Perf.OperationStart "Get DDL for " & strType + Set cmd = New ADODB.Command + With cmd + Set .ActiveConnection = oConn + .CommandText = strSqlDef + Set rst = .Execute + End With + + ' Look up definition from recordset + With rst + If Not .EOF Then + ' Definition might be in second or third column + For intField = 1 To 2 + If StartsWith(.Fields(intField).Name, "Create ") Then + strDefinition = Nz(.Fields(intField)) + Exit For + End If + Next intField + End If + .Close + End With + + ' Write object definition to file + strPath = this.strBaseFolder & strFile + If strDefinition = vbNullString Then + If FSO.FileExists(strPath) Then DeleteFile strPath + Else + ' Export to file + WriteFile strDefinition, strPath + If strType = "views" Then + ' Use hash index + m_AllItems(strFile) = strHash + Else + ' Set file modified date to match SQL object + SetFileDate strPath, dteModified, Not this.blnUtcTime + End If + End If + + Perf.OperationEnd + End If + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : ScanDatabaseObjects +' Author : Adam Waller +' Date : 7/21/2023 +' Purpose : Scan the database objects for any changed items +'--------------------------------------------------------------------------------------- +' +Private Sub ScanDatabaseObjects() + + Dim rstObjects As ADODB.Recordset + Dim conn As ADODB.Connection + Dim strItem As String + Dim strSchema As String + Dim strPath As String + Dim blnModified As Boolean + Dim dItem As Dictionary + Dim lngCount As Long + Dim strHash As String + + ' Clear module level objects + Set m_AllItems = Nothing + Set m_ModifiedItems = Nothing + + ' Make sure we initialize before running the scan + If Not this.blnInitialized Then Exit Sub + + ' Open database connection + Set conn = GetNewOpenConnection + If conn Is Nothing Then Exit Sub + + ' Return list of objects from the server + Perf.OperationStart "Retrieve SQL Objects" + Set rstObjects = conn.Execute(CodeDb.QueryDefs("qryMySqlServerObjects").SQL) + Perf.OperationEnd + + ' Initialize dictionaries + Set m_AllItems = New Dictionary + Set m_ModifiedItems = New Dictionary + + ' Loop through objects, building dictionary of items that match our filter. + Perf.OperationStart "Loop through MySQL objects" + With rstObjects + Do While Not .EOF + + ' Build item path and full path to source file + strSchema = Nz(!schema, "schema") & "." + strItem = Nz(!Folder) & PathSep & GetSafeFileName(strSchema & Nz(!Name)) & ".sql" + strPath = this.strBaseFolder & strItem + strHash = vbNullString + + ' See if we pass the filter + If PassesSchemaFilter(strItem, this.varFilters) Then + + ' Use modified date to match file, if possible. + ' Some objects don't store a modified date, so use a hash for those. + If Nz(!last_modified) = vbNullString Then + ' Create hash from definition + strHash = "hash:" & GetStringHash(Nz(!definition)) + End If + + ' Check for modification/new item + If m_Files.Exists(strItem) Then + ' Flag as modified if the dates or hash don't match + blnModified = (Nz2(strHash, Nz(!last_modified)) <> CStr(m_Files(strItem))) + Else + ' File does not yet exist + blnModified = True + End If + + ' Add all objects to full collection + m_AllItems.Add strItem, Nz2(strHash, Nz(!last_modified)) + + ' Build dictionary of modified objects + If blnModified Then + Set dItem = New Dictionary + dItem("folder") = Nz(!Folder) + dItem("schema") = Nz(!schema) + dItem("name") = Nz(!Name) + dItem("hash") = strHash + dItem("last_modified") = CDate(Nz(!last_modified, 0)) + m_ModifiedItems.Add strItem, dItem + End If + End If + + ' Move to next object + lngCount = lngCount + 1 + .MoveNext + Loop + .Close + End With + Perf.OperationEnd lngCount + + ' Close connection + conn.Close + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : SaveUpdatedIndex +' Author : Adam Waller +' Date : 8/7/2023 +' Purpose : Save an updated version of the index (after scanning for changes and +' : exporting any changed objects) +'--------------------------------------------------------------------------------------- +' +Private Function SaveUpdatedIndex() + + Dim varKey As Variant + Dim strValue As String + Dim dIndex As Dictionary + Dim strPath As String + + ' Only run this if we actually have an index to process + If m_AllItems Is Nothing Then Exit Function + + ' Loop through all items, building a dictionary of hashed items. + ' (These items don't have modified dates in MySQL, and must be tracked via hash.) + Set dIndex = New Dictionary + For Each varKey In m_AllItems.Keys + strValue = m_AllItems(varKey) + If StartsWith(strValue, "hash:") Then + ' Add to index + dIndex(varKey) = strValue + End If + Next varKey + + ' Update the saved index file + strPath = this.strBaseFolder & "vcs-index.json" + If dIndex.Count = 0 Then + ' Remove index when no longer needed. + If FSO.FileExists(strPath) Then DeleteFile strPath + Else + ' Save the rebuilt index + WriteFile BuildJsonFile(TypeName(Me), dIndex, "Version Control System Schema Index for MySQL"), strPath + End If + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : GetNewOpenConnection +' Author : Adam Waller +' Date : 8/3/2023 +' Purpose : Return a new, open ADODB connection +'--------------------------------------------------------------------------------------- +' +Private Function GetNewOpenConnection() As ADODB.Connection + + Dim oConn As ADODB.Connection + + Set oConn = New ADODB.Connection + With oConn + LogUnhandledErrors + On Error Resume Next + If Len(this.strUserID) Then + .Open this.strConnect, this.strUserID, this.strPassword + Else + .Open this.strConnect + End If + End With + + ' Check for any connection error + If CatchAny(eelError, "Unable to connect to " & this.strName, ModuleName(Me)) Then + Log.Add "Connection string: " & this.strConnect, False + Else + ' Return open connection + Set GetNewOpenConnection = oConn + End If + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : ScanFiles +' Author : Adam Waller +' Date : 7/28/2023 +' Purpose : Scan the files to get a list of source files that should match the current +' : database objects. For performance reasons, we won't apply the filter here +' : but will check the filter later when removing orphaned objects. +'--------------------------------------------------------------------------------------- +' +Private Function ScanFiles() + + Dim oFld As Scripting.Folder + Dim dBaseFolders As Dictionary + Dim dFiles As Dictionary + Dim varKey As Variant + Dim strKey As String + Dim strValue As String + Dim strFolder As String + Dim dFile As Dictionary + Dim dIndex As Dictionary + Dim strPath As String + + ' Reset module-level dictionary + Set m_Files = New Dictionary + + ' Load any existing index file of hashes for object that don't store modified dates. + strPath = this.strBaseFolder & "vcs-index.json" + If FSO.FileExists(strPath) Then + Set dFile = ReadJsonFile(strPath) + If Not dFile Is Nothing Then Set dIndex = dFile("Items") + End If + If dIndex Is Nothing Then Set dIndex = New Dictionary + + ' Build a collection of subfolders and files with modified dates + ' (Using the Windows API for faster scanning and more accurate dates) + Set dBaseFolders = GetBaseFolders + If FSO.FolderExists(this.strBaseFolder) Then + For Each oFld In FSO.GetFolder(this.strBaseFolder).SubFolders + strFolder = oFld.Name + If dBaseFolders.Exists(strFolder) Then + ' Get dictionary of files with modified dates + Set dFiles = GetFileList(oFld.Path, "*.sql", Not this.blnUtcTime) + ' Loop through files, adding to index + For Each varKey In dFiles.Keys + strKey = strFolder & "\" & varKey + ' For most objects, the key value will be the modified date. + ' For objects (like views) that don't have a modified date, look up + ' the hash from the index. (Or fall back to the file date, if no + ' index entry is found.) + If dIndex.Exists(strKey) Then + strValue = dIndex(strKey) + Else + ' Use modified date from file + strValue = dFiles(varKey) + End If + ' Add each file with a key that matches the database object, and the + ' file modified date as the value for each item. + m_Files.Add strKey, strValue + Next varKey + End If + Next oFld + End If + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : GetBaseFolders +' Author : Adam Waller +' Date : 7/31/2023 +' Purpose : Return a dictionary of base folders used for component types +'--------------------------------------------------------------------------------------- +' +Private Function GetBaseFolders() As Dictionary + Set GetBaseFolders = New Dictionary + With GetBaseFolders + .CompareMode = TextCompare + .Add "tables", Null + .Add "views", Null + .Add "procedures", Null + .Add "functions", Null + .Add "triggers", Null + '.Add "indexes", Null + End With +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_GetChangeCount +' Author : Adam Waller +' Date : 7/21/2023 +' Purpose : Return count of modified objects +'--------------------------------------------------------------------------------------- +' +Private Function IDbSchema_ObjectCount(blnModifiedOnly As Boolean) As Long + If m_Files Is Nothing Then ScanFiles + If m_AllItems Is Nothing Then ScanDatabaseObjects + If m_AllItems Is Nothing Then Exit Function + IDbSchema_ObjectCount = IIf(blnModifiedOnly, m_ModifiedItems.Count, m_AllItems.Count) +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_Initialize +' Author : Adam Waller +' Date : 7/18/2023 +' Purpose : Initialize the database schema +'--------------------------------------------------------------------------------------- +' +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 + + ' Set class values + With this + .strName = dNZ(dInstance, "Name") + .strConnect = dNZ(dInstance, "Connect") + .strBaseFolder = Options.GetExportFolder & "databases\" & GetSafeFileName(.strName) & PathSep + .varFilters = varRules + If dInstance.Exists("UtcDateTime") Then .blnUtcTime = dInstance("UtcDateTime") + .blnInitialized = (Len(.strConnect)) + End With + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_BaseFolder +' Author : Adam Waller +' Date : 8/2/2023 +' Purpose : Return base folder for this schema export +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbSchema_BaseFolder() As String + IDbSchema_BaseFolder = this.strBaseFolder +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_Name +' Author : Adam Waller +' Date : 8/2/2023 +' Purpose : Return the name of this schema +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbSchema_Name() As String + IDbSchema_Name = this.strName +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_ServerType +' Author : Adam Waller +' Date : 7/14/2023 +' Purpose : Return server type +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbSchema_ServerType() As eDatabaseServerType + IDbSchema_ServerType = estMySql +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : IDbSchema_TypeDescription +' Author : Adam Waller +' Date : 8/2/2023 +' Purpose : Return type description +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbSchema_TypeDescription() As Variant + IDbSchema_TypeDescription = "MySQL Server" +End Property diff --git a/Version Control.accda.src/modules/modFunctions.bas b/Version Control.accda.src/modules/modFunctions.bas index 642ae6fa..b57ac44e 100644 --- a/Version Control.accda.src/modules/modFunctions.bas +++ b/Version Control.accda.src/modules/modFunctions.bas @@ -716,7 +716,6 @@ End Function ' Public Function InArray(varArray, varValue, Optional intCompare As VbCompareMethod = vbBinaryCompare) As Boolean - Dim varItem As Variant Dim lngCnt As Long ' Guard clauses diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index bc1c397f..2b00a23c 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -624,7 +624,7 @@ Public Sub ExportSchemas(blnFullExport As Boolean) Set cSchema = New clsSchemaMsSql Case eDatabaseServerType.estMySql strType = " (MySQL)" - 'Set cSchema = New clsSchemaMySql + Set cSchema = New clsSchemaMySql End Select Log.Add " - " & strName & strType Perf.CategoryStart strName & strType diff --git a/Version Control.accda.src/modules/modVCSUtility.bas b/Version Control.accda.src/modules/modVCSUtility.bas index aea8fd25..7533e1f9 100644 --- a/Version Control.accda.src/modules/modVCSUtility.bas +++ b/Version Control.accda.src/modules/modVCSUtility.bas @@ -924,3 +924,39 @@ Public Function GetSchemaInitParams(strName As String) As Dictionary Set GetSchemaInitParams = dParams End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : PassesSchemaFilter +' 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. +'--------------------------------------------------------------------------------------- +' +Public Function PassesSchemaFilter(strItem As String, varFilterArray As Variant) As Boolean + + Dim blnPass As Boolean + Dim lngRule As Long + Dim strRule As String + + ' Loop through rules + For lngRule = 0 To UBound(varFilterArray) + strRule = Trim(varFilterArray(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 + PassesSchemaFilter = blnPass + +End Function diff --git a/Version Control.accda.src/queries/qryMySqlServerObjects.bas b/Version Control.accda.src/queries/qryMySqlServerObjects.bas new file mode 100644 index 00000000..705d34a4 --- /dev/null +++ b/Version Control.accda.src/queries/qryMySqlServerObjects.bas @@ -0,0 +1,29 @@ +dbMemo "SQL" ="-- On MySQL Server, return a listing of all parent level objects\015\012\015\012" + "-- Tables\015\012SELECT \015\012\011`TABLE_SCHEMA` AS `schema`,\015\012 `TABL" + "E_NAME` AS `name`,\015\012 coalesce(`UPDATE_TIME`, `CREATE_TIME`) AS `last_mo" + "dified`,\015\012 'tables' as `folder`,\015\012 null as `definition`\015\012" + "FROM information_schema.tables\015\012where TABLE_TYPE = 'BASE TABLE'\015\012and" + " TABLE_SCHEMA NOT IN ('information_schema', 'mysql', 'performance_schema')\015\012" + "\015\012-- Views\015\012UNION SELECT\015\012\011`TABLE_SCHEMA` AS `schema`,\015\012" + " `TABLE_NAME` AS `name`,\015\012 null AS `last_modified`,\015\012 'view" + "s' as `folder`,\015\012 `VIEW_DEFINITION` as `definition`\015\012FROM informa" + "tion_schema.views\015\012where 1=1\015\012and TABLE_SCHEMA NOT IN ('mysql')\015\012" + "\015\012-- Functions\015\012UNION SELECT\015\012\011`ROUTINE_SCHEMA` AS `schema`" + ",\015\012 `ROUTINE_NAME` AS `name`,\015\012 coalesce(`LAST_ALTERED`, `CREA" + "TED`) AS `last_modified`,\015\012 'functions' as `folder`,\015\012 null as" + " `definition`\015\012FROM information_schema.routines\015\012where ROUTINE_TYPE " + "= 'FUNCTION'\015\012and ROUTINE_SCHEMA NOT IN ('mysql')\015\012\015\012-- Stored" + " Procedures\015\012UNION SELECT\015\012\011`ROUTINE_SCHEMA` AS `schema`,\015\012" + " `ROUTINE_NAME` AS `name`,\015\012 coalesce(`LAST_ALTERED`, `CREATED`) AS " + "`last_modified`,\015\012 'procedures' as `folder`,\015\012 null as `defini" + "tion`\015\012FROM information_schema.routines\015\012where ROUTINE_TYPE = 'PROCE" + "DURE'\015\012and ROUTINE_SCHEMA NOT IN ('mysql')\015\012\015\012-- Triggers\015\012" + "UNION SELECT\015\012\011`TRIGGER_SCHEMA` AS `schema`,\015\012 `TRIGGER_NAME` " + "AS `name`,\015\012 `CREATED` AS `last_modified`,\015\012 'triggers' as `fo" + "lder`,\015\012 `ACTION_STATEMENT` as `definition`\015\012FROM information_sch" + "ema.triggers\015\012where 1=1\015\012" +dbMemo "Connect" ="ODBC;" +dbBoolean "ReturnsRecords" ="-1" +dbInteger "ODBCTimeout" ="60" +dbBoolean "LogMessages" ="0" +dbByte "Orientation" ="0" diff --git a/Version Control.accda.src/queries/qryMySqlServerObjects.sql b/Version Control.accda.src/queries/qryMySqlServerObjects.sql new file mode 100644 index 00000000..e7c3a855 --- /dev/null +++ b/Version Control.accda.src/queries/qryMySqlServerObjects.sql @@ -0,0 +1,55 @@ +-- On MySQL Server, return a listing of all parent level objects + +-- Tables +SELECT + `TABLE_SCHEMA` AS `schema`, + `TABLE_NAME` AS `name`, + coalesce(`UPDATE_TIME`, `CREATE_TIME`) AS `last_modified`, + 'tables' as `folder`, + null as `definition` +FROM information_schema.tables +where TABLE_TYPE = 'BASE TABLE' +and TABLE_SCHEMA NOT IN ('information_schema', 'mysql', 'performance_schema') + +-- Views +UNION SELECT + `TABLE_SCHEMA` AS `schema`, + `TABLE_NAME` AS `name`, + null AS `last_modified`, + 'views' as `folder`, + `VIEW_DEFINITION` as `definition` +FROM information_schema.views +where 1=1 +and TABLE_SCHEMA NOT IN ('mysql') + +-- Functions +UNION SELECT + `ROUTINE_SCHEMA` AS `schema`, + `ROUTINE_NAME` AS `name`, + coalesce(`LAST_ALTERED`, `CREATED`) AS `last_modified`, + 'functions' as `folder`, + null as `definition` +FROM information_schema.routines +where ROUTINE_TYPE = 'FUNCTION' +and ROUTINE_SCHEMA NOT IN ('mysql') + +-- Stored Procedures +UNION SELECT + `ROUTINE_SCHEMA` AS `schema`, + `ROUTINE_NAME` AS `name`, + coalesce(`LAST_ALTERED`, `CREATED`) AS `last_modified`, + 'procedures' as `folder`, + null as `definition` +FROM information_schema.routines +where ROUTINE_TYPE = 'PROCEDURE' +and ROUTINE_SCHEMA NOT IN ('mysql') + +-- Triggers +UNION SELECT + `TRIGGER_SCHEMA` AS `schema`, + `TRIGGER_NAME` AS `name`, + `CREATED` AS `last_modified`, + 'triggers' as `folder`, + `ACTION_STATEMENT` as `definition` +FROM information_schema.triggers +where 1=1