ASPBlogBrainOrdure/core/router.wsc

<?xml version="1.0"?>
<!--  RouterComponent.wsc  -->
<component>

  <!-- COM registration -->
  <registration
      description = "Classic ASP Router Component"
      progid      = "App.Router"
      version     = "1.0"
      classid     = "{A1FC6EA8-519E-4E34-AC08-77788E3E5E44}" />

  <!-- Public interface -->
  <public>
    <method name="AddRoute"/>
    <method name="Resolve"/>
  </public>
  <!-- Give the component ASP intrinsic objects (Request, Response, Server …) -->
  <implements type="ASP"/>
  <!-- Implementation -->
  <script language="VBScript">
  <![CDATA[
Option Explicit

'------------------------------------------------------------
' Private state
'------------------------------------------------------------
Dim routes : Set routes = CreateObject("Scripting.Dictionary")

'------------------------------------------------------------
' METHOD  AddRoute(method, path, controller, action)
'------------------------------------------------------------
Public Sub AddRoute(method, path, controller, action)
    ' Input validation
    If IsEmpty(method) Or Len(Trim(method)) = 0 Then
        Err.Raise 5, "Router.AddRoute", "HTTP method parameter is required and cannot be empty"
    End If

    If IsEmpty(path) Then
        Err.Raise 5, "Router.AddRoute", "Path parameter is required"
    End If

    If IsEmpty(controller) Or Len(Trim(controller)) = 0 Then
        Err.Raise 5, "Router.AddRoute", "Controller parameter is required and cannot be empty"
    End If

    If IsEmpty(action) Or Len(Trim(action)) = 0 Then
        Err.Raise 5, "Router.AddRoute", "Action parameter is required and cannot be empty"
    End If

    ' Validate HTTP method (allow common methods)
    Dim validMethods, methodUpper, i, isValidMethod
    validMethods = Array("GET", "POST", "PUT", "DELETE", "PATCH", "HEAD", "OPTIONS")
    methodUpper = UCase(Trim(method))
    isValidMethod = False

    For i = 0 To UBound(validMethods)
        If validMethods(i) = methodUpper Then
            isValidMethod = True
            Exit For
        End If
    Next

    If Not isValidMethod Then
        Err.Raise 5, "Router.AddRoute", "Invalid HTTP method: " & method & ". Allowed: GET, POST, PUT, DELETE, PATCH, HEAD, OPTIONS"
    End If

    Dim routeKey
    routeKey = methodUpper & ":" & NormalizePath(path)

    If Not routes.Exists(routeKey) Then
        routes.Add routeKey, Array(Trim(controller), Trim(action))
    End If
End Sub

'------------------------------------------------------------
' METHOD  Resolve(method, path) -> Array(controller, action, params())
'------------------------------------------------------------
Public Function Resolve(method, path)
    Dim routeKey, routeValue, values
    routeKey = UCase(method) & ":" & NormalizePath(path)

    ' Always return a params array (empty by default)
    Dim emptyParams() : ReDim emptyParams(-1)

    ' Exact match first
    If routes.Exists(routeKey) Then
        routeValue = routes(routeKey)
        Resolve = Array(routeValue(0), routeValue(1), emptyParams)
        Exit Function
    End If

    ' Dynamic routes  (e.g. /users/:id)
    Dim r, routeMethod, routePattern
    For Each r In routes.Keys
        routeMethod  = Split(r, ":")(0)
        routePattern = Mid(r, Len(routeMethod) + 2) ' strip "METHOD:"
        If UCase(routeMethod) = UCase(method) Then
            If IsMatch(path, routePattern, values) Then
                routeValue = routes(r)
                Resolve = Array(routeValue(0), routeValue(1), values)
                Exit Function
            End If
        End If
    Next

    ' 404 fallback
    Resolve = Array("ErrorController", "NotFound", emptyParams)
End Function

'------------------------------------------------------------
' INTERNAL  IsMatch(requestPath, routePattern, values())
'           Returns True/False and fills values() with parameters
'------------------------------------------------------------
Private Function IsMatch(requestPath, routePattern, values)
    Dim reqParts, routeParts, i, paramCount
    requestPath = NormalizePath(requestPath)
    routePattern = NormalizePath(routePattern)

    reqParts   = Split(requestPath, "/")
    routeParts = Split(routePattern, "/")

    If UBound(reqParts) <> UBound(routeParts) Then
        IsMatch = False : Exit Function
    End If

    paramCount = 0 : ReDim values(-1)

    For i = 0 To UBound(reqParts)
        If IsDynamicSegment(routeParts(i)) Then
            ReDim Preserve values(paramCount)
            values(paramCount) = reqParts(i)
            paramCount = paramCount + 1
        ElseIf LCase(routeParts(i)) <> LCase(reqParts(i)) Then
            IsMatch = False : Exit Function
        End If
    Next

    If paramCount = 0 Then ReDim values(-1)
    IsMatch = True
End Function

'------------------------------------------------------------
' INTERNAL  NormalizePath(path)
'           Removes query strings, trims whitespace, and normalizes
'           leading/trailing slashes so "/admin" and "/admin/" match.
'------------------------------------------------------------
Private Function NormalizePath(path)
    Dim cleaned
    cleaned = LCase(Trim(CStr(path)))

    If Len(cleaned) = 0 Then
        NormalizePath = ""
        Exit Function
    End If

    If InStr(cleaned, "?") > 0 Then
        cleaned = Left(cleaned, InStr(cleaned, "?") - 1)
    End If

    Do While Left(cleaned, 1) = "/"
        cleaned = Mid(cleaned, 2)
    Loop

    Do While Right(cleaned, 1) = "/" And Len(cleaned) > 0
        cleaned = Left(cleaned, Len(cleaned) - 1)
    Loop

    On Error Resume Next
    Do
        Dim decoded
        decoded = Server.URLDecode(cleaned)
        If Err.Number <> 0 Then
            Err.Clear
            Exit Do
        End If
        If decoded = cleaned Then Exit Do
        cleaned = LCase(decoded)
    Loop
    On Error GoTo 0

    NormalizePath = cleaned
End Function

'------------------------------------------------------------
' INTERNAL  IsDynamicSegment(segment)
'           Supports both ":id" and "{id}" route tokens.
'------------------------------------------------------------
Private Function IsDynamicSegment(segment)
    If Len(segment) = 0 Then
        IsDynamicSegment = False
    ElseIf Left(segment, 1) = ":" Then
        IsDynamicSegment = True
    ElseIf Left(segment, 1) = "{" And Right(segment, 1) = "}" Then
        IsDynamicSegment = True
    Else
        IsDynamicSegment = False
    End If
End Function

'------------------------------------------------------------
' Optional lifecycle hooks
'------------------------------------------------------------
Private Sub Class_Terminate()
    Set routes = Nothing
End Sub
  ]]>
  </script>
</component>