From 2559c4fed717efcd686e78491924a3b43af113e0 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Mon, 7 Aug 2023 17:00:17 -0500 Subject: [PATCH] Add Schema Export support for MySQL databases You can now export basic object definitions from MySQL databases. (Probably far less used than Microsoft SQL Server, but still helpful for some of my projects.) #415 --- Version Control.accda.src/dbs-properties.json | 2 +- .../forms/frmVCSDatabase.bas | 67 +- .../modules/clsSchemaMsSql.cls | 46 +- .../modules/clsSchemaMySql.cls | 581 ++++++++++++++++++ .../modules/modFunctions.bas | 1 - .../modules/modImportExport.bas | 2 +- .../modules/modVCSUtility.bas | 36 ++ .../queries/qryMySqlServerObjects.bas | 29 + .../queries/qryMySqlServerObjects.sql | 55 ++ 9 files changed, 752 insertions(+), 67 deletions(-) create mode 100644 Version Control.accda.src/modules/clsSchemaMySql.cls create mode 100644 Version Control.accda.src/queries/qryMySqlServerObjects.bas create mode 100644 Version Control.accda.src/queries/qryMySqlServerObjects.sql 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