AI-ASP-CLASSIC/Core/Router.asp

<%
Class Router
    Private m_Routes

    Private Sub Class_Initialize()
        Set m_Routes = Server.CreateObject("Scripting.Dictionary")
    End Sub

    Private Sub Class_Terminate()
        If IsObject(m_Routes) Then
            Set m_Routes = Nothing
        End If
    End Sub

    Public Sub AddRoute(ByVal pattern, ByVal controllerName)
        Dim routeInfo
        Dim normalizedPattern

        If Len(Trim(CStr(pattern))) = 0 Then
            Err.Raise vbObjectError + 1200, "Router.AddRoute", "pattern is required."
        End If

        If Len(Trim(CStr(controllerName))) = 0 Then
            Err.Raise vbObjectError + 1201, "Router.AddRoute", "controllerName is required."
        End If

        normalizedPattern = NormalizePath(CStr(pattern))

        Set routeInfo = Server.CreateObject("Scripting.Dictionary")
        routeInfo.Add "Segments", SplitPath(normalizedPattern)
        routeInfo.Add "ControllerName", CStr(controllerName)

        m_Routes.Add m_Routes.Count, routeInfo
    End Sub

    ' Returns a Dictionary with "ControllerName" and "Params" (a Dictionary of
    ' captured {name}-style segments), or Nothing if no registered pattern matches.
    Public Function Match(ByVal route)
        Dim routeSegments
        Dim routeKey
        Dim routeInfo
        Dim patternSegments
        Dim params
        Dim isMatch
        Dim segmentIndex
        Dim result

        routeSegments = SplitPath(NormalizePath(CStr(route)))

        For Each routeKey In m_Routes.Keys
            Set routeInfo = m_Routes.Item(routeKey)
            patternSegments = routeInfo.Item("Segments")

            If UBound(patternSegments) = UBound(routeSegments) Then
                Set params = Server.CreateObject("Scripting.Dictionary")
                isMatch = True

                For segmentIndex = 0 To UBound(patternSegments)
                    If IsParamSegment(patternSegments(segmentIndex)) Then
                        params.Add ParamName(patternSegments(segmentIndex)), routeSegments(segmentIndex)
                    ElseIf LCase(patternSegments(segmentIndex)) <> LCase(routeSegments(segmentIndex)) Then
                        isMatch = False
                        Exit For
                    End If
                Next

                If isMatch Then
                    Set result = Server.CreateObject("Scripting.Dictionary")
                    result.Add "ControllerName", routeInfo.Item("ControllerName")
                    result.Add "Params", params
                    Set Match = result
                    Exit Function
                End If
            End If
        Next

        Set Match = Nothing
    End Function

    Private Function IsParamSegment(ByVal segment)
        IsParamSegment = (Left(segment, 1) = "{" And Right(segment, 1) = "}")
    End Function

    Private Function ParamName(ByVal segment)
        ParamName = Mid(segment, 2, Len(segment) - 2)
    End Function

    Private Function NormalizePath(ByVal path)
        Dim result
        result = Trim(CStr(path))

        If Len(result) = 0 Then
            result = "/"
        End If

        If Left(result, 1) <> "/" Then
            result = "/" & result
        End If

        If Len(result) > 1 And Right(result, 1) = "/" Then
            result = Left(result, Len(result) - 1)
        End If

        NormalizePath = result
    End Function

    Private Function SplitPath(ByVal path)
        Dim trimmedPath
        trimmedPath = path

        If Left(trimmedPath, 1) = "/" Then
            trimmedPath = Mid(trimmedPath, 2)
        End If

        SplitPath = Split(trimmedPath, "/")
    End Function
End Class
%>