<% '======================================================================================================================= ' MIGRATION SYSTEM '======================================================================================================================= ' Provides database migration capabilities for version-controlled schema changes. ' ' Features: ' - Sequential migration versioning (timestamp-based) ' - Up/Down migration support ' - Migration tracking in schema_migrations table ' - Transaction support for atomic migrations ' - Migration status checking ' ' Usage: ' Set migrator = Migrator() ' migrator.ApplyMigration "20260109120000_create_users_table.asp" ' migrator.RollbackMigration "20260109120000_create_users_table.asp" ' pending = migrator.GetPendingMigrations() ' applied = migrator.GetAppliedMigrations() ' Class Migrator_Class Private m_db Private m_migrations_path Private m_schema_table '------------------------------------------------------------------------------------------------------------------- Private Sub Class_Initialize() Set m_db = DAL() m_schema_table = "schema_migrations" m_migrations_path = Server.MapPath("../db/migrations/") End Sub '------------------------------------------------------------------------------------------------------------------- ' Ensure the schema_migrations table exists '------------------------------------------------------------------------------------------------------------------- Public Sub EnsureSchemaMigrationsTable() On Error Resume Next ' Try to query the table - if it doesn't exist, create it Dim rs Set rs = m_db.Query("SELECT TOP 1 version FROM " & m_schema_table, empty) If Err.Number <> 0 Then ' Table doesn't exist, create it Err.Clear On Error GoTo 0 Dim createSQL createSQL = "CREATE TABLE " & m_schema_table & " (" & _ "version VARCHAR(14) PRIMARY KEY, " & _ "applied_at DATETIME NOT NULL)" m_db.Execute createSQL, empty Else If Not rs Is Nothing Then rs.Close Set rs = Nothing End If End If On Error GoTo 0 End Sub '------------------------------------------------------------------------------------------------------------------- ' Get all applied migration versions '------------------------------------------------------------------------------------------------------------------- Public Function GetAppliedMigrations() EnsureSchemaMigrationsTable Dim rs, versions, version Set versions = Server.CreateObject("Scripting.Dictionary") Set rs = m_db.Query("SELECT version FROM " & m_schema_table & " ORDER BY version", empty) Do While Not rs.EOF version = Trim(rs("version")) versions.Add version, True rs.MoveNext Loop rs.Close Set rs = Nothing Set GetAppliedMigrations = versions End Function '------------------------------------------------------------------------------------------------------------------- ' Get all available migration files '------------------------------------------------------------------------------------------------------------------- Public Function GetAvailableMigrations() Dim fso, folder, files, file Set fso = Server.CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(m_migrations_path) Then Set GetAvailableMigrations = Server.CreateObject("Scripting.Dictionary") Exit Function End If Set folder = fso.GetFolder(m_migrations_path) Set files = folder.Files Dim migrations Set migrations = Server.CreateObject("Scripting.Dictionary") For Each file In files If LCase(fso.GetExtensionName(file.Name)) = "asp" Then Dim version version = GetVersionFromFilename(file.Name) If version <> "" Then migrations.Add version, file.Name End If End If Next Set GetAvailableMigrations = migrations End Function '------------------------------------------------------------------------------------------------------------------- ' Get pending migrations (available but not applied) '------------------------------------------------------------------------------------------------------------------- Public Function GetPendingMigrations() Dim applied, available, pending, version Set applied = GetAppliedMigrations() Set available = GetAvailableMigrations() Set pending = Server.CreateObject("Scripting.Dictionary") For Each version In available.Keys If Not applied.Exists(version) Then pending.Add version, available(version) End If Next Set GetPendingMigrations = pending End Function '------------------------------------------------------------------------------------------------------------------- ' Extract version from migration filename ' Expected format: YYYYMMDDHHMMSS_description.asp '------------------------------------------------------------------------------------------------------------------- Private Function GetVersionFromFilename(filename) Dim parts parts = Split(filename, "_") If UBound(parts) >= 0 Then Dim version version = parts(0) ' Validate it's a 14-digit timestamp If Len(version) = 14 And IsNumeric(version) Then GetVersionFromFilename = version Exit Function End If End If GetVersionFromFilename = "" End Function '------------------------------------------------------------------------------------------------------------------- ' Apply a migration (run the Up method) '------------------------------------------------------------------------------------------------------------------- Public Sub ApplyMigration(filename) Dim version version = GetVersionFromFilename(filename) If version = "" Then Err.Raise vbObjectError + 1, "Migrator", "Invalid migration filename format: " & filename End If ' Check if already applied Dim applied Set applied = GetAppliedMigrations() If applied.Exists(version) Then Response.Write "Migration " & version & " already applied. Skipping." & vbCrLf Exit Sub End If Response.Write "Applying migration: " & filename & "..." & vbCrLf ' Begin transaction m_db.BeginTransaction On Error Resume Next ' Execute the migration file ExecuteMigrationFile filename, "Up" If Err.Number <> 0 Then Dim errMsg errMsg = "Migration failed: " & Err.Description m_db.RollbackTransaction Err.Raise vbObjectError + 2, "Migrator", errMsg End If ' Record the migration m_db.Execute "INSERT INTO " & m_schema_table & " (version, applied_at) VALUES (?, ?)", _ Array(version, Now()) If Err.Number <> 0 Then Dim recordErr recordErr = "Failed to record migration: " & Err.Description m_db.RollbackTransaction Err.Raise vbObjectError + 3, "Migrator", recordErr End If ' Commit transaction m_db.CommitTransaction On Error GoTo 0 Response.Write "Migration " & version & " applied successfully." & vbCrLf End Sub '------------------------------------------------------------------------------------------------------------------- ' Rollback a migration (run the Down method) '------------------------------------------------------------------------------------------------------------------- Public Sub RollbackMigration(filename) Dim version version = GetVersionFromFilename(filename) If version = "" Then Err.Raise vbObjectError + 1, "Migrator", "Invalid migration filename format: " & filename End If ' Check if applied Dim applied Set applied = GetAppliedMigrations() If Not applied.Exists(version) Then Response.Write "Migration " & version & " not applied. Skipping." & vbCrLf Exit Sub End If Response.Write "Rolling back migration: " & filename & "..." & vbCrLf ' Begin transaction m_db.BeginTransaction On Error Resume Next ' Execute the migration file ExecuteMigrationFile filename, "Down" If Err.Number <> 0 Then Dim errMsg errMsg = "Rollback failed: " & Err.Description m_db.RollbackTransaction Err.Raise vbObjectError + 4, "Migrator", errMsg End If ' Remove the migration record m_db.Execute "DELETE FROM " & m_schema_table & " WHERE version = ?", version If Err.Number <> 0 Then Dim recordErr recordErr = "Failed to remove migration record: " & Err.Description m_db.RollbackTransaction Err.Raise vbObjectError + 5, "Migrator", recordErr End If ' Commit transaction m_db.CommitTransaction On Error GoTo 0 Response.Write "Migration " & version & " rolled back successfully." & vbCrLf End Sub '------------------------------------------------------------------------------------------------------------------- ' Execute a migration file's Up or Down method '------------------------------------------------------------------------------------------------------------------- Private Sub ExecuteMigrationFile(filename, direction) Dim migrationPath migrationPath = m_migrations_path & filename Dim fso Set fso = Server.CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(migrationPath) Then Err.Raise vbObjectError + 6, "Migrator", "Migration file not found: " & migrationPath End If ' Create a migration context that the file can use Dim migration Set migration = New MigrationContext_Class Set migration.DB = m_db ' Include and execute the migration file Server.Execute(migrationPath) ' Call the appropriate method (Up or Down) If direction = "Up" Then Execute "Call Migration_Up(migration)" ElseIf direction = "Down" Then Execute "Call Migration_Down(migration)" End If End Sub '------------------------------------------------------------------------------------------------------------------- ' Apply all pending migrations '------------------------------------------------------------------------------------------------------------------- Public Sub ApplyAllPending() Dim pending, version, versions() Set pending = GetPendingMigrations() If pending.Count = 0 Then Response.Write "No pending migrations." & vbCrLf Exit Sub End If ' Sort versions ReDim versions(pending.Count - 1) Dim i : i = 0 For Each version In pending.Keys versions(i) = version i = i + 1 Next ' Simple bubble sort for versions Dim j, temp For i = 0 To UBound(versions) - 1 For j = i + 1 To UBound(versions) If CLng(versions(i)) > CLng(versions(j)) Then temp = versions(i) versions(i) = versions(j) versions(j) = temp End If Next Next ' Apply in order For i = 0 To UBound(versions) ApplyMigration pending(versions(i)) Next End Sub '------------------------------------------------------------------------------------------------------------------- ' Rollback the last applied migration '------------------------------------------------------------------------------------------------------------------- Public Sub RollbackLast() Dim applied, version, lastVersion Set applied = GetAppliedMigrations() If applied.Count = 0 Then Response.Write "No migrations to rollback." & vbCrLf Exit Sub End If ' Find the last version lastVersion = "" For Each version In applied.Keys If lastVersion = "" Or CLng(version) > CLng(lastVersion) Then lastVersion = version End If Next ' Find the filename Dim available Set available = GetAvailableMigrations() If available.Exists(lastVersion) Then RollbackMigration available(lastVersion) Else Err.Raise vbObjectError + 7, "Migrator", "Migration file not found for version: " & lastVersion End If End Sub End Class '======================================================================================================================= ' MIGRATION CONTEXT '======================================================================================================================= ' Provides helper methods for use within migration files ' Class MigrationContext_Class Public DB ' Reference to DAL '------------------------------------------------------------------------------------------------------------------- ' Execute raw SQL '------------------------------------------------------------------------------------------------------------------- Public Sub ExecuteSQL(sql) DB.Execute sql, empty End Sub '------------------------------------------------------------------------------------------------------------------- ' Create a table '------------------------------------------------------------------------------------------------------------------- Public Sub CreateTable(tableName, columns) Dim sql sql = "CREATE TABLE " & tableName & " (" & columns & ")" ExecuteSQL sql End Sub '------------------------------------------------------------------------------------------------------------------- ' Drop a table '------------------------------------------------------------------------------------------------------------------- Public Sub DropTable(tableName) ExecuteSQL "DROP TABLE " & tableName End Sub '------------------------------------------------------------------------------------------------------------------- ' Add a column to a table '------------------------------------------------------------------------------------------------------------------- Public Sub AddColumn(tableName, columnName, columnType) ExecuteSQL "ALTER TABLE " & tableName & " ADD COLUMN " & columnName & " " & columnType End Sub '------------------------------------------------------------------------------------------------------------------- ' Drop a column from a table '------------------------------------------------------------------------------------------------------------------- Public Sub DropColumn(tableName, columnName) ExecuteSQL "ALTER TABLE " & tableName & " DROP COLUMN " & columnName End Sub '------------------------------------------------------------------------------------------------------------------- ' Create an index '------------------------------------------------------------------------------------------------------------------- Public Sub CreateIndex(indexName, tableName, columns) ExecuteSQL "CREATE INDEX " & indexName & " ON " & tableName & " (" & columns & ")" End Sub '------------------------------------------------------------------------------------------------------------------- ' Drop an index '------------------------------------------------------------------------------------------------------------------- Public Sub DropIndex(indexName, tableName) ExecuteSQL "DROP INDEX " & indexName & " ON " & tableName End Sub End Class '======================================================================================================================= ' SINGLETON '======================================================================================================================= Dim Migrator__Singleton : Set Migrator__Singleton = Nothing Function Migrator() If Migrator__Singleton Is Nothing Then Set Migrator__Singleton = New Migrator_Class End If Set Migrator = Migrator__Singleton End Function %>