asp-classic-unified-framework/scripts/runMigrations.vbs

'=======================================================================================================================
' MIGRATION RUNNER (Standalone VBScript)
'=======================================================================================================================
' Runs database migrations directly via VBScript without requiring IIS/ASP.
'
' Usage:
'   cscript //nologo scripts\runMigrations.vbs [command]
'
' Commands:
'   up              - Apply all pending migrations (default)
'   down            - Rollback the last migration
'   status          - Show migration status
'   apply <file>    - Apply a specific migration file
'   rollback <file> - Rollback a specific migration file
'
' Examples:
'   cscript //nologo scripts\runMigrations.vbs
'   cscript //nologo scripts\runMigrations.vbs up
'   cscript //nologo scripts\runMigrations.vbs down
'   cscript //nologo scripts\runMigrations.vbs status
'

Option Explicit

Dim fso, scriptDir, projectRoot, webConfigPath, migrationsPath
Dim connectionString, command, argument

Set fso = CreateObject("Scripting.FileSystemObject")

' Get paths
scriptDir = fso.GetParentFolderName(WScript.ScriptFullName)
projectRoot = fso.GetAbsolutePathName(scriptDir & "\..")
webConfigPath = projectRoot & "\public\web.config"
migrationsPath = projectRoot & "\db\migrations"

' Parse arguments
command = "up"  ' default command
If WScript.Arguments.Count > 0 Then
    command = LCase(WScript.Arguments(0))
End If

If WScript.Arguments.Count > 1 Then
    argument = WScript.Arguments(1)
End If

' Validate command
Select Case command
    Case "up", "down", "status", "apply", "rollback"
        ' Valid command
    Case Else
        ShowUsage
        WScript.Quit 1
End Select

' Load connection string from web.config
connectionString = GetConnectionString(webConfigPath)
If connectionString = "" Then
    WScript.Echo "Error: Could not read connection string from web.config"
    WScript.Quit 1
End If

' Execute the command
On Error Resume Next
Select Case command
    Case "up"
        ApplyAllPending
    Case "down"
        RollbackLast
    Case "status"
        ShowStatus
    Case "apply"
        If argument = "" Then
            WScript.Echo "Error: No migration file specified"
            WScript.Echo "Usage: cscript //nologo scripts\runMigrations.vbs apply <filename>"
            WScript.Quit 1
        End If
        ApplyMigration argument
    Case "rollback"
        If argument = "" Then
            WScript.Echo "Error: No migration file specified"
            WScript.Echo "Usage: cscript //nologo scripts\runMigrations.vbs rollback <filename>"
            WScript.Quit 1
        End If
        RollbackMigration argument
End Select

If Err.Number <> 0 Then
    WScript.Echo ""
    WScript.Echo "ERROR: " & Err.Description
    WScript.Echo "Number: " & Err.Number
    WScript.Echo "Source: " & Err.Source
    WScript.Quit 1
End If

WScript.Quit 0

'=======================================================================================================================
' MIGRATION FUNCTIONS
'=======================================================================================================================

Sub ApplyAllPending()
    WScript.Echo "=============================================================="
    WScript.Echo "APPLYING PENDING MIGRATIONS"
    WScript.Echo "=============================================================="
    WScript.Echo ""

    EnsureSchemaMigrationsTable

    Dim pending, version, versions(), i, j, temp
    Set pending = GetPendingMigrations()

    If pending.Count = 0 Then
        WScript.Echo "No pending migrations."
        WScript.Echo ""
        WScript.Echo "=============================================================="
        WScript.Echo "DONE"
        WScript.Echo "=============================================================="
        Exit Sub
    End If

    ' Sort versions
    ReDim versions(pending.Count - 1)
    i = 0
    For Each version In pending.Keys
        versions(i) = version
        i = i + 1
    Next

    ' Simple bubble sort (string comparison works for YYYYMMDDHHMMSS format)
    For i = 0 To UBound(versions) - 1
        For j = i + 1 To UBound(versions)
            If versions(i) > 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

    WScript.Echo ""
    WScript.Echo "=============================================================="
    WScript.Echo "DONE"
    WScript.Echo "=============================================================="
End Sub

Sub RollbackLast()
    WScript.Echo "=============================================================="
    WScript.Echo "ROLLING BACK LAST MIGRATION"
    WScript.Echo "=============================================================="
    WScript.Echo ""

    EnsureSchemaMigrationsTable

    Dim applied, available, version, lastVersion, filename
    Set applied = GetAppliedMigrations()

    If applied.Count = 0 Then
        WScript.Echo "No migrations to rollback."
        WScript.Echo ""
        WScript.Echo "=============================================================="
        WScript.Echo "DONE"
        WScript.Echo "=============================================================="
        Exit Sub
    End If

    ' Find the last version (string comparison works for YYYYMMDDHHMMSS format)
    lastVersion = ""
    For Each version In applied.Keys
        If lastVersion = "" Or version > lastVersion Then
            lastVersion = version
        End If
    Next

    ' Find the filename
    Set available = GetAvailableMigrations()
    If available.Exists(lastVersion) Then
        filename = available(lastVersion)
        RollbackMigration filename
    Else
        WScript.Echo "Error: Migration file not found for version: " & lastVersion
        WScript.Quit 1
    End If

    WScript.Echo ""
    WScript.Echo "=============================================================="
    WScript.Echo "DONE"
    WScript.Echo "=============================================================="
End Sub

Sub ShowStatus()
    WScript.Echo "=============================================================="
    WScript.Echo "MIGRATION STATUS"
    WScript.Echo "=============================================================="
    WScript.Echo ""

    EnsureSchemaMigrationsTable

    Dim applied, pending, available, version
    Set applied = GetAppliedMigrations()
    Set pending = GetPendingMigrations()
    Set available = GetAvailableMigrations()

    WScript.Echo "Applied migrations: " & applied.Count
    If applied.Count > 0 Then
        For Each version In applied.Keys
            If available.Exists(version) Then
                WScript.Echo "  [X] " & available(version)
            Else
                WScript.Echo "  [X] " & version & " (file not found)"
            End If
        Next
    End If

    WScript.Echo ""
    WScript.Echo "Pending migrations: " & pending.Count
    If pending.Count > 0 Then
        For Each version In pending.Keys
            WScript.Echo "  [ ] " & pending(version)
        Next
    End If

    WScript.Echo ""
    WScript.Echo "=============================================================="
End Sub

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
        WScript.Echo "Migration " & version & " already applied. Skipping."
        Exit Sub
    End If

    WScript.Echo "Applying migration: " & filename & "..."

    ' Execute the migration
    ' NOTE: Access/Jet does NOT support DDL (CREATE TABLE, etc.) inside transactions
    ' So we run without transaction wrapper and rely on error checking instead
    Dim conn, migrationSuccess
    Set conn = GetConnection()

    On Error Resume Next
    migrationSuccess = ExecuteMigrationFile(filename, "Up", conn)

    If Err.Number <> 0 Then
        WScript.Echo "ERROR: Migration failed - " & Err.Description
        WScript.Echo "Error Number: " & Err.Number
        conn.Close
        Err.Raise vbObjectError + 2, "Migrator", "Migration failed: " & Err.Description
    End If
    On Error GoTo 0

    ' Check if migration had SQL errors
    If Not migrationSuccess Then
        WScript.Echo ""
        WScript.Echo "ERROR: Migration failed due to SQL errors (see above)."
        WScript.Echo "Migration NOT recorded. Please fix the migration and try again."
        conn.Close
        WScript.Quit 1
    End If

    ' Record the migration
    On Error Resume Next
    Dim cmd
    Set cmd = CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = conn
    cmd.CommandText = "INSERT INTO schema_migrations (version, applied_at) VALUES (?, ?)"
    cmd.Execute , Array(version, Now())

    If Err.Number <> 0 Then
        WScript.Echo "ERROR: Failed to record migration - " & Err.Description
        conn.Close
        Err.Raise vbObjectError + 3, "Migrator", "Failed to record migration: " & Err.Description
    End If
    On Error GoTo 0

    conn.Close
    WScript.Echo "Migration " & version & " applied successfully."
End Sub

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
        WScript.Echo "Migration " & version & " not applied. Skipping."
        Exit Sub
    End If

    WScript.Echo "Rolling back migration: " & filename & "..."

    ' Execute the migration
    ' NOTE: Access/Jet does NOT support DDL (DROP TABLE, etc.) inside transactions
    Dim conn, rollbackSuccess
    Set conn = GetConnection()

    On Error Resume Next
    rollbackSuccess = ExecuteMigrationFile(filename, "Down", conn)

    If Err.Number <> 0 Then
        WScript.Echo "ERROR: Rollback failed - " & Err.Description
        WScript.Echo "Error Number: " & Err.Number
        conn.Close
        Err.Raise vbObjectError + 4, "Migrator", "Rollback failed: " & Err.Description
    End If
    On Error GoTo 0

    ' Check if rollback had SQL errors
    If Not rollbackSuccess Then
        WScript.Echo ""
        WScript.Echo "ERROR: Rollback failed due to SQL errors (see above)."
        WScript.Echo "Migration record NOT removed. Please fix the issue manually."
        conn.Close
        WScript.Quit 1
    End If

    ' Remove migration record
    On Error Resume Next
    Dim cmd
    Set cmd = CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = conn
    cmd.CommandText = "DELETE FROM schema_migrations WHERE version = ?"
    cmd.Execute , Array(version)

    If Err.Number <> 0 Then
        WScript.Echo "ERROR: Failed to remove migration record - " & Err.Description
        conn.Close
        Err.Raise vbObjectError + 5, "Migrator", "Failed to remove migration record: " & Err.Description
    End If
    On Error GoTo 0

    conn.Close
    WScript.Echo "Migration " & version & " rolled back successfully."
End Sub

'=======================================================================================================================
' HELPER FUNCTIONS
'=======================================================================================================================

Sub ShowUsage()
    WScript.Echo "Usage: cscript //nologo scripts\runMigrations.vbs [command]"
    WScript.Echo ""
    WScript.Echo "Commands:"
    WScript.Echo "  up              - Apply all pending migrations (default)"
    WScript.Echo "  down            - Rollback the last migration"
    WScript.Echo "  status          - Show migration status"
    WScript.Echo "  apply <file>    - Apply a specific migration file"
    WScript.Echo "  rollback <file> - Rollback a specific migration file"
    WScript.Echo ""
    WScript.Echo "Examples:"
    WScript.Echo "  cscript //nologo scripts\runMigrations.vbs"
    WScript.Echo "  cscript //nologo scripts\runMigrations.vbs up"
    WScript.Echo "  cscript //nologo scripts\runMigrations.vbs down"
    WScript.Echo "  cscript //nologo scripts\runMigrations.vbs status"
End Sub

Function GetConnectionString(configPath)
    If Not fso.FileExists(configPath) Then
        GetConnectionString = ""
        Exit Function
    End If

    Dim xmlDoc, node
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.async = False
    xmlDoc.load configPath

    Set node = xmlDoc.selectSingleNode("//appSettings/add[@key='ConnectionString']/@value")
    If node Is Nothing Then
        GetConnectionString = ""
    Else
        GetConnectionString = node.text
    End If
End Function

Function GetConnection()
    Dim conn
    Set conn = CreateObject("ADODB.Connection")
    conn.Open connectionString
    Set GetConnection = conn
End Function

Sub EnsureSchemaMigrationsTable()
    Dim conn, rs
    Set conn = GetConnection()

    On Error Resume Next
    Set rs = conn.Execute("SELECT TOP 1 version FROM schema_migrations")

    If Err.Number <> 0 Then
        ' Table doesn't exist, create it
        Err.Clear
        On Error GoTo 0

        conn.Execute "CREATE TABLE schema_migrations (" & _
                    "version VARCHAR(14) PRIMARY KEY, " & _
                    "applied_at DATETIME NOT NULL)"
    Else
        If Not rs Is Nothing Then
            If Not rs.EOF Then rs.Close
        End If
    End If

    conn.Close
    On Error GoTo 0
End Sub

Function GetAppliedMigrations()
    Dim conn, rs, versions, version
    Set conn = GetConnection()
    Set versions = CreateObject("Scripting.Dictionary")

    Set rs = conn.Execute("SELECT version FROM schema_migrations ORDER BY version")

    Do While Not rs.EOF
        version = Trim(rs("version"))
        versions.Add version, True
        rs.MoveNext
    Loop

    rs.Close
    conn.Close

    Set GetAppliedMigrations = versions
End Function

Function GetAvailableMigrations()
    Dim folder, files, file, migrations, version
    Set migrations = CreateObject("Scripting.Dictionary")

    If Not fso.FolderExists(migrationsPath) Then
        Set GetAvailableMigrations = migrations
        Exit Function
    End If

    Set folder = fso.GetFolder(migrationsPath)
    Set files = folder.Files

    For Each file In files
        If LCase(fso.GetExtensionName(file.Name)) = "asp" Then
            version = GetVersionFromFilename(file.Name)
            If version <> "" Then
                migrations.Add version, file.Name
            End If
        End If
    Next

    Set GetAvailableMigrations = migrations
End Function

Function GetPendingMigrations()
    Dim applied, available, pending, version
    Set applied = GetAppliedMigrations()
    Set available = GetAvailableMigrations()
    Set pending = 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

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

' Global variable to hold migration context for error checking
Dim g_migrationContext

Function ExecuteMigrationFile(filename, direction, conn)
    Dim migrationPath, fileContent, migration
    migrationPath = migrationsPath & "\" & filename

    If Not fso.FileExists(migrationPath) Then
        Err.Raise vbObjectError + 6, "Migrator", "Migration file not found: " & migrationPath
    End If

    ' Create migration context
    Set migration = New MigrationContext
    Set migration.Connection = conn
    Set g_migrationContext = migration  ' Store globally for error checking

    ' Read and execute the migration file
    Dim stream
    Set stream = fso.OpenTextFile(migrationPath, 1)
    fileContent = stream.ReadAll
    stream.Close

    ' Remove ASP tags
    fileContent = Replace(fileContent, "<%", "")
    fileContent = Replace(fileContent, "%>", "")

    ' Execute the migration code
    ExecuteGlobal fileContent

    ' Call the appropriate method
    If direction = "Up" Then
        Migration_Up migration
    ElseIf direction = "Down" Then
        Migration_Down migration
    End If

    ' Return True if successful, False if error
    ExecuteMigrationFile = Not migration.HasError
End Function

'=======================================================================================================================
' MIGRATION CONTEXT CLASS
'=======================================================================================================================
Class MigrationContext
    Public Connection
    Public HasError
    Public LastErrorMessage
    Public LastErrorNumber

    Private Sub Class_Initialize()
        HasError = False
        LastErrorMessage = ""
        LastErrorNumber = 0
    End Sub

    Public Sub ExecuteSQL(sql)
        If HasError Then Exit Sub  ' Skip if previous error occurred

        On Error Resume Next
        Connection.Execute sql
        If Err.Number <> 0 Then
            HasError = True
            LastErrorNumber = Err.Number
            LastErrorMessage = "SQL Error: " & Err.Description & " (Error " & Err.Number & ")" & vbCrLf & "SQL: " & sql
            WScript.Echo "  ERROR executing SQL: " & Err.Description
            WScript.Echo "  Error Number: " & Err.Number
            WScript.Echo "  SQL: " & sql
            Err.Clear
        End If
        On Error GoTo 0
    End Sub

    Public Sub CreateTable(tableName, columns)
        If HasError Then Exit Sub
        WScript.Echo "  Creating table: " & tableName
        ExecuteSQL "CREATE TABLE " & tableName & " (" & columns & ")"
    End Sub

    Public Sub DropTable(tableName)
        If HasError Then Exit Sub
        WScript.Echo "  Dropping table: " & tableName
        ExecuteSQL "DROP TABLE " & tableName
    End Sub

    Public Sub AddColumn(tableName, columnName, columnType)
        If HasError Then Exit Sub
        WScript.Echo "  Adding column: " & tableName & "." & columnName
        ExecuteSQL "ALTER TABLE " & tableName & " ADD COLUMN " & columnName & " " & columnType
    End Sub

    Public Sub DropColumn(tableName, columnName)
        If HasError Then Exit Sub
        WScript.Echo "  Dropping column: " & tableName & "." & columnName
        ExecuteSQL "ALTER TABLE " & tableName & " DROP COLUMN " & columnName
    End Sub

    Public Sub CreateIndex(indexName, tableName, columns)
        If HasError Then Exit Sub
        WScript.Echo "  Creating index: " & indexName & " on " & tableName
        ExecuteSQL "CREATE INDEX " & indexName & " ON " & tableName & " (" & columns & ")"
    End Sub

    Public Sub DropIndex(indexName, tableName)
        If HasError Then Exit Sub
        WScript.Echo "  Dropping index: " & indexName & " on " & tableName
        ExecuteSQL "DROP INDEX " & indexName & " ON " & tableName
    End Sub

    Public Function DB()
        Set DB = Me
    End Function
End Class