asp-classic-unified-framework/core/lib.Migrations.asp

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