commit 2b493538360c26af8f9edf370358dfb7d968febd Author: Daniel Covington Date: Thu Jul 9 17:40:45 2026 -0400 First Commit diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000..0f78d0f --- /dev/null +++ b/AGENTS.md @@ -0,0 +1,129 @@ +# AGENTS.md + +## Purpose +This repository is maintained as if the agent were operating with the combined judgment of **150 senior engineers** specializing in: +- Classic ASP +- VBScript +- IIS hosting and deployment +- Object-oriented design patterns adapted for Classic ASP +- MVC-style separation of concerns for legacy web applications +- Refactoring and modernizing legacy ASP codebases safely + +The agent should behave like a disciplined team of expert ASP Classic architects and implementers: careful, consistent, pragmatic, and deeply experienced with legacy Microsoft web stacks. + +## Core Role +When working in this repository, act as a team of elite: +- Classic ASP developers +- VBScript developers +- IIS configuration and troubleshooting specialists +- Legacy application modernization engineers +- OOP and MVC design specialists for ASP Classic environments + +The goal is to produce code and guidance that is robust, maintainable, production-safe, and realistic for Classic ASP applications running on IIS. + +## Operating Principles +- Prefer **safe, minimal, targeted changes** over broad rewrites. +- Respect legacy behavior unless the task explicitly requires behavior changes. +- Preserve compatibility with Classic ASP and VBScript runtime constraints. +- Favor readability and maintainability over cleverness. +- Assume the code may run in older IIS-hosted environments unless the repository clearly states otherwise. +- Treat every change as production-sensitive. + +## Technical Standards + +### Classic ASP and VBScript +- Write valid, idiomatic Classic ASP and VBScript. +- Use `Option Explicit` in VBScript files wherever practical and consistent with the file. +- Prefer clear variable names; avoid one-letter names. +- Keep business logic out of presentation markup when possible. +- Reuse shared includes, helper modules, and utility functions rather than duplicating logic. +- Be careful with VBScript type coercion, `Null`, `Empty`, and string/number comparisons. +- Guard against common runtime issues such as: + - object not set + - type mismatch + - null propagation + - response already sent + - unclosed recordsets or connections + +### OOP and MVC Style +Classic ASP does not provide native full OOP/MVC frameworks, so apply these patterns pragmatically. + +- Separate responsibilities into clear layers when the project structure allows: + - presentation/view + - request handling/controller logic + - business/domain logic + - data access +- Encapsulate repeated logic in classes or include-based modules where appropriate. +- Avoid mixing SQL, HTML, and request-processing logic in one large file when making substantial updates. +- Prefer incremental refactoring toward modular design instead of risky rewrites. +- Maintain consistent naming for controllers, models, services, repositories, and helpers if those patterns exist. +- Try to make classes and objects as generic as possiable + +### IIS and Hosting Awareness +- Assume deployment on IIS unless told otherwise. +- Be mindful of: + - application paths + - virtual directories + - session/application state + - request/response buffering + - COM component usage + - permissions for file access + - ADO connection lifecycles + - 32-bit vs 64-bit IIS compatibility when relevant +- When suggesting config-related fixes, prefer solutions realistic for Classic ASP on IIS. + +## Database and ADO Guidance +- Use parameterized commands when the codebase pattern supports them. +- Close and release ADO objects properly. +- Minimize connection lifetime. +- Avoid inline SQL duplication where shared data-access helpers exist. +- Be conservative when changing SQL behavior in legacy applications. +- Watch for SQL injection, null handling, and recordset cursor/lock assumptions. + +## Debugging and Reliability +- Diagnose root causes instead of masking errors. +- Preserve existing behavior where possible while improving reliability. +- Add defensive checks around request values, session state, objects, and database calls. +- When handling errors, keep the implementation consistent with the app�s current error strategy. +- Do not introduce modern dependencies that are unrealistic for a Classic ASP/IIS environment unless explicitly requested. + +## Refactoring Expectations +- Refactor only to the degree necessary for the task. +- Keep file structure and include patterns stable unless there is a clear reason to change them. +- If improving architecture, do so in small, reversible steps. +- Avoid unnecessary framework-style abstractions that do not fit Classic ASP. + +## Style Guidelines +- Match the repository�s existing formatting and naming conventions. +- Keep functions and procedures focused and cohesive. +- Prefer explicitness over hidden side effects. +- Use comments sparingly and only where they add real maintenance value. +- Do not remove legacy patterns unless they are part of the requested change or clearly harmful. + +## What the Agent Should Optimize For +- Correctness in Classic ASP/VBScript execution +- IIS deployment realism +- Maintainability for legacy teams +- Clear separation of concerns +- Low-risk modernization +- Production-safe debugging and fixes + +## What to Avoid +- Do not rewrite working legacy code just to make it look modern. +- Do not introduce unsupported language features or platform assumptions. +- Do not break existing includes, global state expectations, or IIS path assumptions without necessity. +- Do not over-engineer abstractions beyond what Classic ASP can support cleanly. + +## Preferred Mindset +Think and act like a coordinated panel of 150 top-tier experts in: +- ASP Classic +- VBScript +- IIS +- ADO/database-backed web applications +- MVC-inspired architecture for legacy systems +- pragmatic object-oriented design in constrained environments + +Every recommendation and code change should reflect senior-level judgment, legacy-platform realism, and respect for production stability. + +- Before writing code tell the user what you plan to do and ask if there should be any changes + diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..185e9c9 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,281 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## What this is + +A minimal Classic ASP / VBScript application hosted on IIS Express, structured as a front-controller +MVC-ish app. There is no build step, package manager, or test suite — this is raw `.asp` served +directly by IIS. + +## Running the site + +The IIS Express site config is generated, not hand-maintained. `applicationhost.config` at the repo +root is regenerated from your machine's installed IIS Express base config every time you launch — +do not hand-edit it; edit `build-iisexpress-config.ps1` instead if the site definition needs to change. + +- Start: `./run-iisexpress.ps1` (or `run-iisexpress.cmd`) +- Start with IIS request tracing: `./run-iisexpress.ps1 -TraceErrors` (or `run-iisexpress.cmd trace`) +- Stop: `./stop-iisexpress.ps1` (kills any running `iisexpress` process) +- URL: `http://localhost:8080` + +Requirements: IIS Express installed locally with the Classic ASP feature enabled. The site's physical +root is `Public/` (see `build-iisexpress-config.ps1`'s `-PhysicalPath`), not the repo root. + +There's no build/lint step, but there is an object-level test suite (see **Tests** below) — run it +before and after any change to `Core/*.asp`. View rendering and end-to-end wiring are still verified +manually: run the site and hit it in a browser or `curl http://localhost:8080/...`. + +## Tests + +`tests/` holds a standalone VBScript test harness for the classes in `Core/` (not the `Public/` +views — see why below). Run it with: + +- `tests/run-tests.ps1` (or `tests/run-tests.cmd`) +- Exits non-zero if any test fails, so it's safe to gate on. + +**Why a separate harness instead of testing through IIS:** spinning up IIS Express per test would be +far too slow for a TDD loop, and `Core/App.asp`, `Router.asp`, `HttpRequest.asp`, `ClockService.asp`, +and the `Core/Controllers/*.asp` files are all pure `<% Class ... End Class %>` blocks with no HTML — +no reason they can't run in plain `cscript.exe`. `tests/RunTests.vbs` reads each of those files, strips +the `<%`/`%>` wrapper, and runs the remaining VBScript through `ExecuteGlobal` — this loads the *real* +class definitions (no separate copy to drift out of sync), just outside IIS. This only works because +those files never declare their own `Option Explicit` (same reason as the `#include` note above) and +contain nothing but class definitions — don't add top-level executable statements to them, or the +strip-and-execute loader breaks. `Core/IncludeAll.asp` and `Core/Bootstrap.asp` are deliberately *not* +in this list — they're front-controller wiring, not reusable classes, and `Bootstrap.asp` in particular +is exactly the executable code this loader can't handle. Those two are only exercised by the manual +live-IIS checks described above. + +`tests/TestSupport.vbs` provides everything `cscript` doesn't have natively: +- `AssertEquals` / `AssertTrue` / `AssertFalse` / `AssertIsNothing` / `AssertNotNothing`, plus + `RunTest(name, procNameAsString)` which invokes the named zero-arg test Sub via `Execute + procName & "()"` (VBScript has no clean first-class function reference for this — `GetRef` exists + but is really meant for event binding, so a name string + `Execute` is the reliable option) and + records pass/fail. +- `FakeServer` / `FakeResponse` stand in for the ASP `Server`/`Response` intrinsics that don't exist + outside IIS — they're assigned to plain global variables literally named `Server` and `Response` + before any `Core/*.asp` file is loaded, so `Server.CreateObject(...)` / `Response.Status = ...` in + the real code resolve to the fakes without the production files knowing the difference. +- `FakeAspRequest` stands in for the real ASP `Request` object that `HttpRequest.Bind()` expects + (`SetServerVariable`/`SetQueryString`/`SetForm`/`SetCookie` to seed it per test). +- `FakeService` is just a neutral dummy object for tests that need "some object" to register. + +Each `Core` class/concept gets its own suite (`RouterTests.vbs`, `AppTests.vbs`, +`HttpRequestTests.vbs`, `ControllerTests.vbs`, `DispatcherTests.vbs`) — a suite is just a `.vbs` file of `Sub Test_*()` +procedures followed by explicit `RunTest "description", "Test_ProcName"` calls at the bottom (no +auto-discovery/reflection — VBScript doesn't have a clean way to enumerate procedures at runtime). +`tests/RunTests.vbs` is the entry point that wires the framework, fakes, `Core/*.asp` classes, and +suites together in order and prints a summary. + +**A real bug this harness caught immediately:** `IsObject(Nothing)` returns `True` in VBScript — it +only tells you the variable is *object-typed*, not that it holds an actual object. Every +`If Not IsObject(m_X) Then Err.Raise ...`-style "has this been set yet" guard in `App`, `HttpRequest`, +and `GreetController` was silently broken because of this — they'd never raise, even when nothing had +been bound/set. Manual IIS testing never caught it because `Default.asp` always binds/sets things +correctly before use. Fixed by checking `m_X Is Nothing` instead (or `(Not IsObject(x)) Or +(x Is Nothing)` when validating a caller-supplied argument that could be a non-object, not just +`Nothing`). If you add a similar "was this ever assigned" guard, use `Is Nothing`, not `IsObject`. + +## Architecture + +**`Core/` lives outside the web root on purpose.** The IIS physical root is `Public/`, and +`Core/*.asp` sits one level up at the repo root — so those class files can never be requested +directly over HTTP, only pulled in via server-side `#include`. This only works because +`build-iisexpress-config.ps1` sets `enableParentPaths="true"` for the site, which permits `..` in +`file=` include paths. Keep new core/business-logic classes in `Core/`, not `Public/`, and never add +`Option Explicit` to a file that gets `#include`d — `Default.asp` already declares it once at the top +of the merged script, and VBScript raises a syntax error on a second `Option Explicit` later in the +same compiled page. + +**`Public/Default.asp` pulls in every `Core/*.asp` class via one ``**, rather than listing each file itself. `Core/IncludeAll.asp` is nothing but a +flat list of sibling `#include`s (`App.asp`, `ClockService.asp`, `HttpRequest.asp`, `Router.asp`, +`Dispatcher.asp`, `DynamicIncludes.asp`, `Controllers/*.asp`) — IIS's SSI preprocessor expands nested +`#include`s recursively, resolving each one relative to the file that contains it, so paths inside +`IncludeAll.asp` are written relative to `Core/` (no `../` needed) even though `Default.asp` itself +reaches `IncludeAll.asp` with one. Add a new `Core/*.asp` class's `#include` line here, not to +`Default.asp` — `IncludeAll.asp` only loads class *definitions*, nothing executable. + +**`Core/` also holds front-controller plumbing that isn't a class**, for the same "keep it out of the +web root" reason as everything else in `Core/` — not everything there is a reusable service. Alongside +`IncludeAll.asp` (loads class definitions), `Core/Bootstrap.asp` is the actual construction/wiring step +that used to live directly in `Default.asp`: it sets `Response.Buffer`/`ContentType`, `Dim`s every +page-level variable, `New`s up `App`/`ClockService`/`HttpRequest`/`Router`/`Dispatcher`, registers +routes and the `clockService`, binds the request, and calls `Boot`. Both are included right after each +other from `Default.asp` (`IncludeAll.asp` first, since `Bootstrap.asp`'s `New App` etc. need the class +definitions already loaded). **`Bootstrap.asp` turns `On Error Resume Next` on and deliberately leaves +it on** — `Default.asp`'s `Match`/`Dispatch` calls run under that same error-handling mode before +`Default.asp` itself checks `Err.Number` and calls `On Error Goto 0`. This works because `#include` +(and this nested pair of them) all splice into one compiled script, same as everywhere else in this +file — but it means you can't understand `Default.asp`'s error handling by reading `Default.asp` alone. + +**Front controller.** `Public/web.config` rewrites every request that isn't a real file or directory +to `Public/Default.asp` (preserving the query string). `Default.asp` is therefore the single entry +point for the whole app, and now holds only the per-request flow - class loading and object wiring +both live in the two `Core/` includes above: + +``` +Default.asp + ' loads every Core/*.asp class definition + ' New's + wires everything, AddRoute's, Binds, Boots, + ' and leaves On Error Resume Next switched on + → oRouter.Match(oApplication.Route) ' -> Dictionary{ControllerName, Params} or Nothing + → oDispatcher.Dispatch app, routeMatch, controllerKey, oController ' ByRef outputs - see Dispatcher below + → check Err.Number, then On Error Goto 0 ' closes out the Resume Next opened in Bootstrap.asp + → viewName = "Error" (if Err.Number <> 0) or controllerKey (otherwise) + → Require "../Core/Views/" & viewName & ".asp" ' runtime-picked view - see DynamicIncludes below +``` + +**Routing.** `Core/Router.asp` (`Router` class) holds registered routes and matches a request path +against them: `AddRoute(pattern, controllerName)` / `Match(route)`. Patterns are split on `/`; a +segment written `{name}` captures whatever's in that position into a `Params` dictionary, everything +else must match literally (case-insensitive). `Match` returns a `Dictionary` with `ControllerName` +and `Params`, or `Nothing` if no pattern fits — first registered match wins, so register more specific +patterns before catch-alls. `Router` deliberately knows nothing about concrete controller types (that's +why `RouterTests.vbs` can exercise it with made-up controller-name strings) — see `Dispatcher` below +for where matching a key turns into an actual running controller. + +**Patterns support multiple `{param}` segments** (e.g. `/greet/{name}/{id}` captures both `name` and +`id`), and two patterns that only differ in segment count can safely map to the same controller — they +never both match the same request, since `Match` requires an exact segment-count match before it even +looks at individual segments (`/greet/{name}` and `/greet/{name}/{id}` for `Greet` is the live example: +`Bootstrap.asp` registers both, and `GreetController.HasId` is only `True` when the longer one +matched). **What `Router`/patterns do *not* give you**: a generic ASP.NET-MVC-style +`{controller}/{action}/{id}` catch-all that dispatches to *any* controller/action pair. VBScript can't +instantiate a script-defined `Class` from a string, so even a wildcard pattern still needs `Dispatcher` +to hard-map each real controller name to a `New XController` call — a catch-all route would change the +pattern, not remove that mapping. Query strings are unrelated to routing entirely: `App.ResolveRoute()` +strips everything after `?` before a route is ever matched, and a controller reads query args +separately via `app.HttpRequest.QueryString("key")`. + +**Dispatching.** `Core/Dispatcher.asp` (`Dispatcher` class, single method `Dispatch(ByRef app, ByRef +routeMatch, ByRef controllerKey, ByRef controller)`) is the one place that turns a `Router.Match` +result into a running controller. It resolves `controllerKey` (`"NotFound"` if `routeMatch` is +`Nothing`, or if the matched key isn't one of its known `Case`s), constructs the matching controller, +and calls `Init`/`Execute` on it — reporting the resolved key and the controller instance back to the +caller via the `ByRef` parameters. **Important VBScript limitation:** script-defined `Class`es can't +be instantiated dynamically from a string (no `CreateObject("HomeController")`), so `Dispatcher` still +needs a static `Select Case controllerKey → New Controller` internally — this limitation is +unavoidable regardless of which file holds it, but it's confined to `Dispatcher` alone now (this +limitation does NOT apply to picking the *view*, which is dynamic — see `DynamicIncludes` below). +Adding a route means: new controller in `Core/Controllers/`, new view in `Core/Views/` named to match +the controller key, one `AddRoute` call in `Default.asp`, one `Case` branch in `Dispatcher.Dispatch`. + +**`App.Route` depends on `HTTP_X_ORIGINAL_URL`, not `PATH_INFO`.** Because `Public/web.config` +internally rewrites every request to `Default.asp`, `PATH_INFO` inside the page is always empty — +it reflects the rewritten target, never what was actually requested. IIS's URL Rewrite module stores +the real pre-rewrite path in the `HTTP_X_ORIGINAL_URL` server variable, so `App.ResolveRoute()` reads +that first and only falls back to `PATH_INFO` if it's absent (e.g. a direct hit on `Default.asp` +itself, bypassing the rewrite). If routes ever stop resolving correctly, check this first before +suspecting the `Router`. + +**Views live in `Core/Views/` and are picked at runtime via `Core/DynamicIncludes.asp`, not a static +`#include` chain.** Classic ASP's `` is resolved at parse time, so it normally can't +pick a file based on a runtime-computed route. `DynamicIncludes.asp` works around this: `Require(path)` +reads a file's raw text directly (`Server.MapPath` + `FileSystemObject`, bypassing the SSI +preprocessor entirely), compiles it into equivalent VBScript (HTML becomes `Response.Write` calls, +`<%= %>` becomes `Response.Write`, and any `` *inside* that file becomes a nested +`Require(...)` call), and runs the result via `ExecuteGlobal` — so the path can be a runtime string. +`Default.asp` computes `viewName` from the `controllerKey` that `Dispatcher.Dispatch` resolved (or +`"Error"` on failure) and calls `Require "../Core/Views/" & viewName & ".asp"` once. Since this still +runs via `ExecuteGlobal` in the same script as `Default.asp`, the loaded view can reference +`Default.asp`'s single generic `oController` variable (whatever `Dispatcher.Dispatch` produced) and +`errorDescription` directly — no `Session`-stashing needed. Every view accesses its controller through +that same `oController` name, not a type-specific one (`Home.asp` uses `oController.App.Route` and +`oController.ServiceSummary`; `Greet.asp` uses `oController.Name`) — this is what lets `Default.asp` +stay generic instead of needing a `Select Case` to pick which named variable a view should see. +`Home.asp` renders the diagnostic/welcome page via `HomeController`; `Greet.asp` renders +`GreetController`'s `{name}` param; `NotFound.asp` renders when the router has no match (and +`NotFoundController.Execute` sets a real `404` `Response.Status`); `Error.asp` is the friendly fallback +shown when `Boot` or a controller raises. **Convention: a view's filename must match its controller +key exactly** (`Home` → `Home.asp`) since `Default.asp` derives one from the other - there's no +separate mapping table. + +**`Core/DynamicIncludes.asp` internals and gotchas**, since three real bugs were found and fixed while +wiring this in (this file predates and wasn't written as part of this session's other work, so verify +any further changes to it live rather than trusting a read-through): +- `ExecuteFile` tracks `DynamicInclude_CurrentPath` so nested `#include`-turned-`Require` calls inside + a loaded file resolve relative to *that file's* directory. It originally (a) appended the *full* + path (directory included) on top of an already-updated `DynamicInclude_CurrentPath`, duplicating the + directory segment, and (b) restored `DynamicInclude_CurrentPath` to the hardcoded global default + after each call instead of the caller's own baseline — which broke a parent file that includes two + siblings in sequence (exactly what every view does: `_Header.asp` then `_Footer.asp`). Both are + fixed now: only the bare filename is appended to `DynamicInclude_CurrentPath`, and the caller's + baseline is explicitly saved and restored. +- `ReadFile` normalizes whatever line endings it finds in the source file to `vbNewLine`. This isn't + cosmetic: `ParseFile` splices literal HTML line breaks into generated code as `" & vbNewLine & "` by + searching for `vbNewLine` (CRLF) specifically — files saved with bare LF endings (as this repo's + files are) would leave a raw, unconverted newline embedded inside a generated `Response.Write "..."` + string literal, which fails to compile. This surfaced as a `200 OK` with a completely empty body and + no error message (a compile error in `ExecuteGlobal`'d code isn't caught by `Require`'s own + `On Error Resume Next`) — if that symptom shows up again, dump `ParseFile`'s raw output for the view + in question and read it before assuming the bug is elsewhere. +- Before calling `Require` for a *new* top-level render (not a nested one), reset + `DynamicInclude_CurrentPath = vbNullString` first, as `Default.asp` does. Its resting default + (`DI_CurrentFolder = "../"`) is baked in for a different calling convention than ours and would + double up the `../` prefix on top of a full relative path like `"../Core/Views/Home.asp"`. +- `Err.Raise 53, "DynamicIncludes.ReadFile", "..."` — the fix from before this file was wired in + (originally passed the message as `Source` instead of `Description`) — and the three debug + `Response.Write` leftovers are already removed; don't reintroduce either pattern. +- No caching: every `Require`/`Include` re-reads the file from disk and re-runs several regex passes + over it on every call. Fine at this app's scale; worth knowing if it ever needs to matter. + +The shared page chrome (``/CSS/card wrapper) lives in `Core/Views/_Header.asp` and +`Core/Views/_Footer.asp` — every view sets `pageTitle`, `badgeClass` (`"ok"` or `"bad"`), and +`badgeText` right before `#include`-ing `_Header.asp`, then closes with `#include _Footer.asp`. +These three variables are `Dim`'d once in `Default.asp` (not in the view files) for the same reason +`Option Explicit` can only be declared once — `Home.asp` and `Error.asp` both get compiled into the +same merged script (only one branch executes, but both are always parsed), so a second `Dim` of the +same name in either view would be a redeclaration error. Add any new shared chrome variable to +`Default.asp`'s `Dim` block, not to a view file. + +**`Core/App.asp` (`App` class)** is the composition root / mini service container — pure app/request +infrastructure, no view- or route-specific logic: +- Holds a `Scripting.Dictionary` (`m_Services`) as a service locator — `RegisterInstance` / + `Resolve` / `HasService` / `ServiceNames()`. `InjectInto` uses `CallByName` to push itself onto any + object exposing a `SetApp` method (best-effort — errors are swallowed via `On Error Resume Next`). +- Never touches the raw ASP `Request` object directly — it goes through the injected `HttpRequest` + wrapper (`SetRequest` / `EnsureRequest`), so route resolution and server variables are testable + independent of IIS. +- `ResolveRoute()` derives the route (see the `HTTP_X_ORIGINAL_URL` note above), normalizing + `/Default.asp` to `/`. + +**`Core/Controllers/*.asp`** each follow the same shape: `Init(app, routeParams)` to receive the +`App` instance and the router's captured params, `Execute()` to run any per-request logic, an `App` +property for the view to reach request context through, plus whatever controller-specific data the +view needs (e.g. `HomeController.ServiceSummary` turns `App.ServiceNames()` into the HTML-encoded, +comma-joined text the old `App` class used to build itself — that formatting belongs to the +controller/view, not the DI container). This uniform `Init`/`Execute`/`App` shape is what lets +`Dispatcher.Dispatch` treat every controller identically. + +**`Core/HttpRequest.asp` (`HttpRequest` class)** wraps the ASP intrinsic `Request` object +(`Bind`) and proxies `Item`, `QueryString`, `Form`, `ServerVariable`, `Cookie`, `ClientCertificate`, +`TotalBytes`, `BinaryRead`. Every accessor calls `EnsureBound` first and raises a custom error +(`vbObjectError + 110x`) if `Bind` was never called. Always `Bind` before use. + +**`Core/ClockService.asp`** is a trivial example service (`GetNowText`) showing the +register/resolve pattern — not core infrastructure, just a template for adding new services. + +## Conventions (from AGENTS.md) + +This repo is meant to be treated as production-sensitive legacy code, not a scratch project. Key rules +that aren't obvious from the code alone: + +- **Ask before writing code.** State the plan and check in before making changes. +- Prefer small, targeted diffs over rewrites; don't modernize working code just to make it look nicer. +- Avoid one-letter variable names. (`Option Explicit` belongs only in `Default.asp` — see the + architecture note above on why it can't also live in `#include`d files.) +- Keep business logic out of markup; route new logic through classes/services (extend the + `App` service-locator pattern) rather than duplicating it inline in `.asp` pages. +- New services follow the `ClockService` shape: a plain class, registered into `App` via + `RegisterInstance` in `Default.asp`, resolved via `App.Resolve("name")` where needed. + Objects that need the container can implement `SetApp` and be wired via `App.InjectInto`. +- Be deliberate about VBScript's `Null`/`Empty` coercion and type comparisons; guard against + "object not set", type mismatch, and unclosed ADO recordsets/connections if/when data access is added. +- No ORM/framework — if SQL or ADO is introduced, use parameterized commands and minimize + connection lifetime. +- New logic in `Core/` gets a test in `tests/` (see **Tests** above) — write the failing test first + where practical, then make it pass. Keep `Core/*.asp` files pure class definitions (no top-level + executable code, no `Option Explicit`) so the test harness's strip-and-`ExecuteGlobal` loader keeps + working. diff --git a/Core/App.asp b/Core/App.asp new file mode 100644 index 0000000..b4e594a --- /dev/null +++ b/Core/App.asp @@ -0,0 +1,164 @@ +<% +Class App + Private m_Route + Private m_Method + Private m_ServerName + Private m_ServerPort + Private m_PhysicalRoot + Private m_StartedAt + Private m_Services + Private m_Request + + Private Sub Class_Initialize() + m_Route = "/" + m_Method = "GET" + m_ServerName = "" + m_ServerPort = "" + m_PhysicalRoot = "" + m_StartedAt = Now() + Set m_Services = Server.CreateObject("Scripting.Dictionary") + m_Services.CompareMode = 1 + Set m_Request = Nothing + End Sub + + Private Sub Class_Terminate() + Set m_Request = Nothing + Set m_Services = Nothing + End Sub + + Public Sub SetRequest(ByRef requestObject) + ' IsObject(Nothing) is True in VBScript, so it can't detect "no object" + ' on its own - it must be paired with an explicit "Is Nothing" check. + If (Not IsObject(requestObject)) Or (requestObject Is Nothing) Then + Err.Raise vbObjectError + 1003, "App.SetRequest", "requestObject must be an object." + End If + + Set m_Request = requestObject + End Sub + + Public Sub Boot() + EnsureRequest + m_Method = m_Request.ServerVariable("REQUEST_METHOD") + m_ServerName = m_Request.ServerVariable("SERVER_NAME") + m_ServerPort = m_Request.ServerVariable("SERVER_PORT") + m_PhysicalRoot = Server.MapPath("/") + m_Route = ResolveRoute() + End Sub + + Public Sub RegisterInstance(ByVal serviceName, ByRef serviceInstance) + If Len(Trim(CStr(serviceName))) = 0 Then + Err.Raise vbObjectError + 1000, "App.RegisterInstance", "serviceName is required." + End If + + If m_Services.Exists(CStr(serviceName)) Then + m_Services.Remove CStr(serviceName) + End If + + Set m_Services.Item(CStr(serviceName)) = serviceInstance + End Sub + + Public Function Resolve(ByVal serviceName) + If Not m_Services.Exists(CStr(serviceName)) Then + Err.Raise vbObjectError + 1001, "App.Resolve", "Service not registered: " & CStr(serviceName) + End If + + Set Resolve = m_Services.Item(CStr(serviceName)) + End Function + + Public Function HasService(ByVal serviceName) + HasService = m_Services.Exists(CStr(serviceName)) + End Function + + Public Sub InjectInto(ByRef targetObject) + If (Not IsObject(targetObject)) Or (targetObject Is Nothing) Then + Err.Raise vbObjectError + 1002, "App.InjectInto", "targetObject must be an object." + End If + + On Error Resume Next + CallByName targetObject, "SetApp", VbMethod, Me + On Error GoTo 0 + End Sub + + Public Property Get Route() + Route = m_Route + End Property + + Public Property Get RequestMethod() + RequestMethod = m_Method + End Property + + Public Property Get ServerName() + ServerName = m_ServerName + End Property + + Public Property Get ServerPort() + ServerPort = m_ServerPort + End Property + + Public Property Get PhysicalRoot() + PhysicalRoot = m_PhysicalRoot + End Property + + Public Property Get StartedAt() + StartedAt = m_StartedAt + End Property + + Public Property Get HttpRequest() + EnsureRequest + Set HttpRequest = m_Request + End Property + + Public Function ServiceNames() + ServiceNames = m_Services.Keys + End Function + + Private Function ResolveRoute() + Dim originalUrl + Dim pathInfo + Dim queryIndex + + EnsureRequest + + ' Public/web.config rewrites every request to Default.asp, so PATH_INFO + ' inside this page is always empty/"/Default.asp" - it never reflects what + ' was actually requested. IIS's URL Rewrite module stores the real request + ' path in HTTP_X_ORIGINAL_URL before rewriting, so prefer that when present. + originalUrl = Trim(CStr(m_Request.ServerVariable("HTTP_X_ORIGINAL_URL"))) + + If Len(originalUrl) > 0 Then + queryIndex = InStr(originalUrl, "?") + If queryIndex > 0 Then + originalUrl = Left(originalUrl, queryIndex - 1) + End If + + If LCase(originalUrl) = "/default.asp" Then + ResolveRoute = "/" + Else + ResolveRoute = originalUrl + End If + + Exit Function + End If + + pathInfo = Trim(CStr(m_Request.ServerVariable("PATH_INFO"))) + + If Len(pathInfo) = 0 Then + ResolveRoute = "/" + Exit Function + End If + + If LCase(pathInfo) = "/default.asp" Then + ResolveRoute = "/" + Exit Function + End If + + ResolveRoute = pathInfo + End Function + + Private Sub EnsureRequest() + If m_Request Is Nothing Then + Err.Raise vbObjectError + 1004, "App.EnsureRequest", "No request object has been injected into the app." + End If + End Sub +End Class +%> diff --git a/Core/Bootstrap.asp b/Core/Bootstrap.asp new file mode 100644 index 0000000..b7222e9 --- /dev/null +++ b/Core/Bootstrap.asp @@ -0,0 +1,43 @@ +<% +Response.Buffer = True +Response.ContentType = "text/html" + +Dim oApplication +Dim oClockService +Dim oRequest +Dim oRouter +Dim oDispatcher +Dim routeMatch +Dim controllerKey +Dim oController +Dim requestFailed +Dim errorDescription +Dim pageTitle +Dim badgeClass +Dim badgeText +Dim viewName + +requestFailed = False +errorDescription = "" +controllerKey = "" + +Set oApplication = New App +Set oClockService = New ClockService +Set oRequest = New HttpRequest +Set oRouter = New Router +Set oDispatcher = New Dispatcher + +oRouter.AddRoute "/", "Home" +oRouter.AddRoute "/greet/{name}", "Greet" +oRouter.AddRoute "/greet/{name}/{id}", "Greet" + +' Left switched on deliberately - Default.asp's Match/Dispatch call runs +' under this same On Error Resume Next before checking Err.Number itself. +On Error Resume Next + +Call oRequest.Bind(Request) + +oApplication.RegisterInstance "clockService", oClockService +oApplication.SetRequest oRequest +oApplication.Boot +%> diff --git a/Core/ClockService.asp b/Core/ClockService.asp new file mode 100644 index 0000000..03eca01 --- /dev/null +++ b/Core/ClockService.asp @@ -0,0 +1,7 @@ +<% +Class ClockService + Public Function GetNowText() + GetNowText = CStr(Now()) + End Function +End Class +%> diff --git a/Core/Controllers/GreetController.asp b/Core/Controllers/GreetController.asp new file mode 100644 index 0000000..96849d3 --- /dev/null +++ b/Core/Controllers/GreetController.asp @@ -0,0 +1,48 @@ +<% +Class GreetController + Private m_App + Private m_Name + Private m_Id + + Public Sub Init(ByRef app, ByRef routeParams) + Set m_App = app + + ' IsObject(Nothing) is True in VBScript, so it can't detect "no object" + ' on its own - it must be paired with an explicit "Is Nothing" check. + If Not (routeParams Is Nothing) Then + If routeParams.Exists("name") Then + m_Name = Trim(CStr(routeParams.Item("name"))) + End If + If routeParams.Exists("id") Then + m_Id = Trim(CStr(routeParams.Item("id"))) + End If + End If + + If Len(m_Name) = 0 Then + m_Name = "there" + End If + End Sub + + Public Sub Execute() + ' Nothing further to prepare - the name/id are already resolved in Init. + End Sub + + Public Property Get App() + Set App = m_App + End Property + + Public Property Get Name() + Name = m_Name + End Property + + Public Property Get Id() + Id = m_Id + End Property + + ' True only when the route matched /greet/{name}/{id} - the shorter + ' /greet/{name} pattern never captures an "id". + Public Property Get HasId() + HasId = (Len(m_Id) > 0) + End Property +End Class +%> diff --git a/Core/Controllers/HomeController.asp b/Core/Controllers/HomeController.asp new file mode 100644 index 0000000..6719b9b --- /dev/null +++ b/Core/Controllers/HomeController.asp @@ -0,0 +1,41 @@ +<% +Class HomeController + Private m_App + + Public Sub Init(ByRef app, ByRef routeParams) + Set m_App = app + End Sub + + Public Sub Execute() + ' Nothing to prepare beyond what App already exposes. + End Sub + + Public Property Get App() + Set App = m_App + End Property + + Public Property Get ServiceSummary() + Dim serviceNames + Dim output + Dim index + + serviceNames = m_App.ServiceNames() + + If UBound(serviceNames) < 0 Then + ServiceSummary = "None" + Exit Property + End If + + output = "" + + For index = 0 To UBound(serviceNames) + If Len(output) > 0 Then + output = output & ", " + End If + output = output & Server.HTMLEncode(CStr(serviceNames(index))) + Next + + ServiceSummary = output + End Property +End Class +%> diff --git a/Core/Controllers/NotFoundController.asp b/Core/Controllers/NotFoundController.asp new file mode 100644 index 0000000..539f4fe --- /dev/null +++ b/Core/Controllers/NotFoundController.asp @@ -0,0 +1,17 @@ +<% +Class NotFoundController + Private m_App + + Public Sub Init(ByRef app, ByRef routeParams) + Set m_App = app + End Sub + + Public Sub Execute() + Response.Status = "404 Not Found" + End Sub + + Public Property Get App() + Set App = m_App + End Property +End Class +%> diff --git a/Core/Dispatcher.asp b/Core/Dispatcher.asp new file mode 100644 index 0000000..c281b76 --- /dev/null +++ b/Core/Dispatcher.asp @@ -0,0 +1,34 @@ +<% +Class Dispatcher + ' Given a Router.Match(...) result (or Nothing), resolves the controller + ' key - falling back to "NotFound" when nothing matched, or when the + ' matched key doesn't map to a known controller - then constructs, Inits, + ' and Executes the corresponding controller. controllerKey and controller + ' are ByRef outputs: Select Case controllerKey after calling this to pick + ' the matching view (its filename must equal the resolved key). + Public Sub Dispatch(ByRef app, ByRef routeMatch, ByRef controllerKey, ByRef controller) + Dim routeParams + + If routeMatch Is Nothing Then + controllerKey = "NotFound" + Set routeParams = Nothing + Else + controllerKey = routeMatch.Item("ControllerName") + Set routeParams = routeMatch.Item("Params") + End If + + Select Case controllerKey + Case "Home" + Set controller = New HomeController + Case "Greet" + Set controller = New GreetController + Case Else + controllerKey = "NotFound" + Set controller = New NotFoundController + End Select + + controller.Init app, routeParams + controller.Execute + End Sub +End Class +%> diff --git a/Core/DynamicIncludes.asp b/Core/DynamicIncludes.asp new file mode 100644 index 0000000..9a0d245 --- /dev/null +++ b/Core/DynamicIncludes.asp @@ -0,0 +1,208 @@ +<% +' Self-explained Constant +Const DI_CurrentFolder = "../" + +' ASP block tags +Private DI_CloseTag : DI_CloseTag = Chr(37)&Chr(62) +Private DI_OpenTag : DI_OpenTag = Chr(60)&Chr(37) +Private DI_OpenClose : DI_OpenClose = DI_OpenTag & DI_CloseTag +Private DI_OpenBreakClose : DI_OpenBreakClose = DI_OpenTag & (vbNewLine & DI_CloseTag) +Private DI_CloseOpen : DI_CloseOpen = DI_CloseTag & DI_OpenTag +Private DI_CloseBreakOpen : DI_CloseBreakOpen = DI_CloseTag & (vbNewLine & DI_OpenTag) + +' ASP write block tags +Private DI_WriteTag : DI_WriteTag = DI_OpenTag & "=" +Private DI_ResponseWrite : DI_ResponseWrite = DI_OpenTag & " Response.Write " +Private DI_Require : DI_Require = DI_OpenTag & (" Require($1) " & DI_CloseTag) + +' Public variables for file inclusion +Public DynamicInclude_PreviousPath : DynamicInclude_PreviousPath = vbNullString +Public DynamicInclude_CurrentPath : DynamicInclude_CurrentPath = DI_CurrentFolder +Public DynamicInclude_TrimHtml : DynamicInclude_TrimHtml = false +Public DynamicInclude_TrimNewlines : DynamicInclude_TrimNewlines = false + +' Executes an imported file in the global namespace +Sub ExecuteFile(ByVal File) + Const DI_Bar = "/" + Const DI_ReverseBar = "\" + + Dim BarIndex, Parsed, Path, FileName, CallerPath + + Path = Replace(File, DI_ReverseBar, DI_Bar) + BarIndex = InStrRev(Path, DI_Bar) + FileName = IIf(IsNull(BarIndex) Or BarIndex = 0, Path, Mid(Path, BarIndex + 1)) + Path = IIf(IsNull(BarIndex) Or BarIndex = 0, vbNullString, Mid(Path, 1, BarIndex)) + + ' Update paths for recursive imports, remembering the caller's own + ' baseline so it can be restored (not clobbered to the global default) + ' once this file - and anything it recursively includes - has run. + CallerPath = DynamicInclude_CurrentPath + DynamicInclude_PreviousPath = DynamicInclude_CurrentPath + DynamicInclude_CurrentPath = DynamicInclude_CurrentPath & Path + + ' Parse and execute the file - only the bare filename is appended here, + ' since the directory portion is already folded into DynamicInclude_CurrentPath. + Parsed = ParseFile(DynamicInclude_CurrentPath & FileName) + ExecuteGlobal Trim(Parsed) + + ' Restore the caller's baseline so sibling #include's in the same parent + ' file (e.g. a header then a footer) keep resolving correctly. + DynamicInclude_CurrentPath = CallerPath + DynamicInclude_PreviousPath = vbNullString +End Sub + +' Reads and parses an ASP file +Function ParseFile(ByRef File) + Const DI_LineJoin = """ & vbNewLine & """ + Const DI_Space = " " + Const DI_Quote = """" + Const DI_DoubleQuote = """""" + + Dim LineArray(4), KeepLeft, KeepRight, Match, Rows, PlainRow, Regex + + ' Read the file content + ParseFile = ReadFile(File) + + ' Replace tags and write commands + ParseFile = Replace(ParseFile, DI_CloseOpen, DI_CloseBreakOpen) + ParseFile = Replace(ParseFile, DI_OpenClose, DI_OpenBreakClose) + ParseFile = Replace(ParseFile, DI_WriteTag, DI_ResponseWrite) + + ' Convert ASP imports to Require calls + Set Regex = New RegExp + With Regex + .Global = True + .MultiLine = True + .IgnoreCase = True + .Pattern = "" + End With + ParseFile = Regex.Replace(ParseFile, DI_Require) + + ' Ensure proper ASP tags are present + If Left(ParseFile, 2) <> DI_OpenTag Then + ParseFile = (DI_OpenClose & vbNewLine) & ParseFile + End If + If Right(ParseFile, 2) <> DI_CloseTag Then + ParseFile = ParseFile & (vbNewLine & DI_OpenClose) + End If + + ' Trim the first open tag and last close tag + ParseFile = Mid(ParseFile, 3, Len(ParseFile) - 4) + ParseFile = Replace(ParseFile, "%", "%") + ParseFile = Replace(ParseFile, "<%", DI_OpenTag) + ParseFile = Replace(ParseFile, "%>", DI_CloseTag) + + ' Trim HTML if required + If DynamicInclude_TrimHtml Then + Regex.Pattern = "([^%]>)\s+(<[^%]\/?)" + ParseFile = Regex.Replace(ParseFile, "$1$2") + Regex.Pattern = "([^%](?!pre)>)\s*([^\s]+)\s*(<[^%](?!pre))" + ParseFile = Regex.Replace(ParseFile, "$1$2$3") + End If + + ' Insert plain texts in Response.write commands + Regex.Pattern = (DI_CloseTag & "([^%])+") & DI_OpenTag + Set Rows = Regex.Execute(ParseFile) + LineArray(0) = vbNewLine + LineArray(1) = "Response.write """ + LineArray(3) = DI_Quote + LineArray(4) = vbNewLine + + For Each Match In Rows + PlainRow = Mid(Match.Value, 3, Len(Match.Value) - 4) + If (Left(PlainRow, 2) = vbNewLine) Then + PlainRow = Right(PlainRow, Len(PlainRow) - 2) + End If + PlainRow = Replace(PlainRow, DI_Quote, DI_DoubleQuote) + PlainRow = Replace(PlainRow, vbNewLine, DI_LineJoin) + If (Right(PlainRow, Len(DI_LineJoin)) = DI_LineJoin) Then + PlainRow = Left(PlainRow, Len(PlainRow) - Len(DI_LineJoin)) + End If + If DynamicInclude_TrimHtml Then + KeepLeft = (Left(PlainRow, 1) = DI_Space) + KeepRight = (Right(PlainRow, 1) = DI_Space) + PlainRow = Trim(PlainRow) + If KeepLeft Then + PlainRow = DI_Space & PlainRow + End If + If KeepRight Then + PlainRow = PlainRow & DI_Space + End If + End If + LineArray(2) = PlainRow + ParseFile = Replace(ParseFile, Match.Value, Join(LineArray, vbNullString)) + Next + + ' Clean up + Set Rows = Nothing + Set Match = Nothing + Erase LineArray + + ' Remove empty Response.write commands and duplicate new lines + ParseFile = Replace(ParseFile, "Response.write """"" & vbNewLine, vbNullString) + If DynamicInclude_TrimNewlines Then + Regex.Pattern = "(?:\s+\n)+" + ParseFile = Regex.Replace(ParseFile, vbNewLine) + End If + ParseFile = Replace(ParseFile, "%", "%") + + Set Regex = Nothing +End Function + +' Reads a file as plain text +Function ReadFile(ByRef File) + Dim System : Set System = Server.CreateObject("Scripting.FileSystemObject") + Dim Path, FileData + + If File = vbNullString Then + File = DI_CurrentFolder + End If + + Path = Server.MapPath(File) + + If System.FileExists(Path) Then + Set FileData = System.OpenTextFile(Path, 1) + ReadFile = FileData.ReadAll + Set FileData = Nothing + + ' Normalize line endings to vbNewLine regardless of how the file was + ' saved. ParseFile's plain-text-to-Response.write splicing searches + ' for vbNewLine specifically - a lone LF left unconverted embeds a + ' raw newline inside a generated string literal, breaking it. + ReadFile = Replace(ReadFile, Chr(13) & Chr(10), Chr(10)) + ReadFile = Replace(ReadFile, Chr(10), vbNewLine) + Else + Err.Raise 53, "DynamicIncludes.ReadFile", "File '" & File & "' was not found." + End If + + Set System = Nothing +End Function + +' Tries to include a file silently +Sub Include(ByVal File) + On Error Resume Next + ExecuteFile File + On Error GoTo 0 +End Sub + +' Tries to include a file and stops execution on error +Sub Require(ByVal File) + On Error Resume Next + ExecuteFile File + If Err.Number > 0 Then + Response.Write "---FATAL ERROR: while trying to execute " & File & "---
" & _ + "---Error description: " & Err.Description & "
" & _ + "---Error Source: " & Err.Source & "
" & _ + "---Error Line: " & Err.Line & "
" + Response.End + End If + On Error GoTo 0 +End Sub +Function IIf(expr, truePart, falsePart) + If CBool(expr) Then + IIf = truePart + Else + IIf = falsePart + End If +End Function +%> \ No newline at end of file diff --git a/Core/HttpRequest.asp b/Core/HttpRequest.asp new file mode 100644 index 0000000..9b07459 --- /dev/null +++ b/Core/HttpRequest.asp @@ -0,0 +1,69 @@ +<% +Class HttpRequest + Private m_Request + + Private Sub Class_Initialize() + Set m_Request = Nothing + End Sub + + Public Sub Bind(ByRef aspRequest) + ' IsObject(Nothing) is True in VBScript, so it can't detect "no object" + ' on its own - it must be paired with an explicit "Is Nothing" check. + If (Not IsObject(aspRequest)) Or (aspRequest Is Nothing) Then + Err.Raise vbObjectError + 1100, "HttpRequest.Bind", "aspRequest must be an object." + End If + + Set m_Request = aspRequest + End Sub + + Public Property Get IsBound() + IsBound = Not (m_Request Is Nothing) + End Property + + Public Function Item(ByVal key) + EnsureBound "Item" + Item = m_Request(CStr(key)) + End Function + + Public Function QueryString(ByVal key) + EnsureBound "QueryString" + QueryString = m_Request.QueryString(CStr(key)) + End Function + + Public Function Form(ByVal key) + EnsureBound "Form" + Form = m_Request.Form(CStr(key)) + End Function + + Public Function ServerVariable(ByVal key) + EnsureBound "ServerVariable" + ServerVariable = m_Request.ServerVariables(CStr(key)) + End Function + + Public Function Cookie(ByVal key) + EnsureBound "Cookie" + Cookie = m_Request.Cookies(CStr(key)) + End Function + + Public Function ClientCertificate(ByVal key) + EnsureBound "ClientCertificate" + ClientCertificate = m_Request.ClientCertificate(CStr(key)) + End Function + + Public Property Get TotalBytes() + EnsureBound "TotalBytes" + TotalBytes = m_Request.TotalBytes + End Property + + Public Function BinaryRead(ByVal count) + EnsureBound "BinaryRead" + BinaryRead = m_Request.BinaryRead(CLng(count)) + End Function + + Private Sub EnsureBound(ByVal memberName) + If m_Request Is Nothing Then + Err.Raise vbObjectError + 1101, "HttpRequest." & CStr(memberName), "ASP Request object has not been bound." + End If + End Sub +End Class +%> diff --git a/Core/IncludeAll.asp b/Core/IncludeAll.asp new file mode 100644 index 0000000..38d99d7 --- /dev/null +++ b/Core/IncludeAll.asp @@ -0,0 +1,9 @@ + + + + + + + + + diff --git a/Core/Router.asp b/Core/Router.asp new file mode 100644 index 0000000..f1be5a4 --- /dev/null +++ b/Core/Router.asp @@ -0,0 +1,118 @@ +<% +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 +%> diff --git a/Core/Views/Error.asp b/Core/Views/Error.asp new file mode 100644 index 0000000..b3649ab --- /dev/null +++ b/Core/Views/Error.asp @@ -0,0 +1,12 @@ +<% +pageTitle = "Classic ASP App - Error" +badgeClass = "bad" +badgeText = "Something went wrong" +%> + +

We hit a problem handling your request

+

Please try again. If this keeps happening, contact the site administrator.

+<% If Len(errorDescription) > 0 Then %> +

<%= Server.HTMLEncode(errorDescription) %>

+<% End If %> + diff --git a/Core/Views/Greet.asp b/Core/Views/Greet.asp new file mode 100644 index 0000000..21b5451 --- /dev/null +++ b/Core/Views/Greet.asp @@ -0,0 +1,14 @@ +<% +pageTitle = "Classic ASP App - Greet" +badgeClass = "ok" +badgeText = "Route matched with a parameter" +%> + +

Hello, <%= Server.HTMLEncode(oController.Name) %>!

+<% If oController.HasId Then %> +

Visit reference: <%= Server.HTMLEncode(oController.Id) %>

+<% End If %> +

This page is rendered by GreetController, matched from the pattern +/greet/{name} or /greet/{name}/{id}.

+

Back home

+ diff --git a/Core/Views/Home.asp b/Core/Views/Home.asp new file mode 100644 index 0000000..f8e676a --- /dev/null +++ b/Core/Views/Home.asp @@ -0,0 +1,20 @@ +<% +pageTitle = "Classic ASP App" +badgeClass = "ok" +badgeText = "App class bootstrapped" +%> + +

Welcome to your ASP Classic application

+

The request is now being handled by Core/Controllers/HomeController.asp.

+ + + + + + + + +
Resolved Route<%= Server.HTMLEncode(oController.App.Route) %>
Request Method<%= Server.HTMLEncode(oController.App.RequestMethod) %>
Server Name<%= Server.HTMLEncode(oController.App.ServerName) %>
Server Port<%= Server.HTMLEncode(oController.App.ServerPort) %>
Physical Root<%= Server.HTMLEncode(oController.App.PhysicalRoot) %>
Started At<%= Server.HTMLEncode(CStr(oController.App.StartedAt)) %>
Registered Services<%= oController.ServiceSummary %>
+

Try a pattern route: /greet/World +or /greet/World/42

+ diff --git a/Core/Views/NotFound.asp b/Core/Views/NotFound.asp new file mode 100644 index 0000000..74edfaa --- /dev/null +++ b/Core/Views/NotFound.asp @@ -0,0 +1,10 @@ +<% +pageTitle = "Classic ASP App - Not Found" +badgeClass = "bad" +badgeText = "404 Not Found" +%> + +

We couldn't find that page

+

No route matches <%= Server.HTMLEncode(oController.App.Route) %>.

+

Back home

+ diff --git a/Core/Views/_Footer.asp b/Core/Views/_Footer.asp new file mode 100644 index 0000000..9943ff0 --- /dev/null +++ b/Core/Views/_Footer.asp @@ -0,0 +1,3 @@ + + + diff --git a/Core/Views/_Header.asp b/Core/Views/_Header.asp new file mode 100644 index 0000000..5b18806 --- /dev/null +++ b/Core/Views/_Header.asp @@ -0,0 +1,22 @@ + + + + +<%= Server.HTMLEncode(pageTitle) %> + + + +
+
<%= Server.HTMLEncode(badgeText) %>
diff --git a/Public/Default.asp b/Public/Default.asp new file mode 100644 index 0000000..4b425a0 --- /dev/null +++ b/Public/Default.asp @@ -0,0 +1,36 @@ +<% Option Explicit %> + + +<% +Set routeMatch = oRouter.Match(oApplication.Route) +oDispatcher.Dispatch oApplication, routeMatch, controllerKey, oController + +If Err.Number <> 0 Then + requestFailed = True + errorDescription = Err.Description + Err.Clear +End If + +On Error Goto 0 +%> +<% +' The matched controller key doubles as its view's filename (Home/Greet/ +' NotFound), so the view is picked at runtime via DynamicIncludes.asp's +' Require instead of a static per-view #include chain - see CLAUDE.md. +If requestFailed Then + viewName = "Error" +Else + viewName = controllerKey +End If + +DynamicInclude_CurrentPath = vbNullString +Require "../Core/Views/" & viewName & ".asp" +%> +<% +Set oDispatcher = Nothing +Set oRouter = Nothing +Set oController = Nothing +Set oRequest = Nothing +Set oClockService = Nothing +Set oApplication = Nothing +%> diff --git a/Public/web.config b/Public/web.config new file mode 100644 index 0000000..64eaff2 --- /dev/null +++ b/Public/web.config @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/RUNNING.md b/RUNNING.md new file mode 100644 index 0000000..8ea3d08 --- /dev/null +++ b/RUNNING.md @@ -0,0 +1,19 @@ +# Run Helpers + +## IIS Express +Use either launcher from the repository root: + +- PowerShell: `./run-iisexpress.ps1` +- PowerShell with IIS tracing: `./run-iisexpress.ps1 -TraceErrors` +- Command Prompt: `run-iisexpress.cmd` +- Command Prompt with IIS tracing: `run-iisexpress.cmd trace` + +The launcher first rebuilds `applicationhost.config` from your installed IIS Express base config, then starts `AspClassicPublicSite`. + +## URL +Open: `http://localhost:8080` + +## Requirements +- IIS Express installed +- Site content in `Public` +- Classic ASP feature enabled for IIS Express / Windows IIS components diff --git a/applicationhost.config b/applicationhost.config new file mode 100644 index 0000000..7733088 --- /dev/null +++ b/applicationhost.config @@ -0,0 +1,981 @@ + + + + + + +
+
+
+
+
+
+
+
+ + +
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ +
+
+ +
+
+
+
+
+
+ +
+
+
+
+
+ +
+
+
+ +
+
+ +
+
+ +
+
+
+ + +
+
+
+
+
+
+ +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/build-iisexpress-config.ps1 b/build-iisexpress-config.ps1 new file mode 100644 index 0000000..bfecb69 --- /dev/null +++ b/build-iisexpress-config.ps1 @@ -0,0 +1,84 @@ +param( + [string]$OutputPath = "$(Join-Path $PSScriptRoot 'applicationhost.config')", + [string]$BaseConfigPath = "$env:ProgramFiles\IIS Express\AppServer\applicationhost.config", + [string]$SiteName = "AspClassicPublicSite", + [string]$PhysicalPath = "H:\AI - ASP - Classic\Public", + [string]$BindingInformation = "*:8080:localhost" +) + +if (-not (Test-Path -LiteralPath $BaseConfigPath)) { + $BaseConfigPath = "$env:ProgramFiles(x86)\IIS Express\AppServer\applicationhost.config" +} + +if (-not (Test-Path -LiteralPath $BaseConfigPath)) { + Write-Error "IIS Express base applicationhost.config not found." + exit 1 +} + +[xml]$xml = Get-Content -LiteralPath $BaseConfigPath + +$sitesNode = $xml.configuration.'system.applicationHost'.sites +if (-not $sitesNode) { + Write-Error "Base config does not contain system.applicationHost/sites." + exit 1 +} + +$existingSite = $sitesNode.site | Where-Object { $_.name -eq $SiteName } +if ($existingSite) { + [void]$sitesNode.RemoveChild($existingSite) +} + +$siteIds = @($sitesNode.site | ForEach-Object { [int]$_.id }) +$nextId = if ($siteIds.Count -gt 0) { ($siteIds | Measure-Object -Maximum).Maximum + 1 } else { 1 } + +$site = $xml.CreateElement('site') +$site.SetAttribute('name', $SiteName) +$site.SetAttribute('id', [string]$nextId) +$site.SetAttribute('serverAutoStart', 'true') + +$application = $xml.CreateElement('application') +$application.SetAttribute('path', '/') +$application.SetAttribute('applicationPool', 'Clr4IntegratedAppPool') + +$virtualDirectory = $xml.CreateElement('virtualDirectory') +$virtualDirectory.SetAttribute('path', '/') +$virtualDirectory.SetAttribute('physicalPath', $PhysicalPath) +[void]$application.AppendChild($virtualDirectory) + +$bindings = $xml.CreateElement('bindings') +$binding = $xml.CreateElement('binding') +$binding.SetAttribute('protocol', 'http') +$binding.SetAttribute('bindingInformation', $BindingInformation) +[void]$bindings.AppendChild($binding) + +[void]$site.AppendChild($application) +[void]$site.AppendChild($bindings) +[void]$sitesNode.AppendChild($site) + +$oldLocation = @($xml.configuration.location | Where-Object { $_.path -eq $SiteName }) +foreach ($node in $oldLocation) { + [void]$xml.configuration.RemoveChild($node) +} + +$location = $xml.CreateElement('location') +$location.SetAttribute('path', $SiteName) + +$systemWebServer = $xml.CreateElement('system.webServer') + +$directoryBrowse = $xml.CreateElement('directoryBrowse') +$directoryBrowse.SetAttribute('enabled', 'false') + +$asp = $xml.CreateElement('asp') +$asp.SetAttribute('scriptErrorSentToBrowser', 'true') +$asp.SetAttribute('enableParentPaths', 'true') +$limits = $xml.CreateElement('limits') +$limits.SetAttribute('scriptTimeout', '00:10:00') +[void]$asp.AppendChild($limits) + +[void]$systemWebServer.AppendChild($directoryBrowse) +[void]$systemWebServer.AppendChild($asp) +[void]$location.AppendChild($systemWebServer) +[void]$xml.configuration.AppendChild($location) + +$xml.Save($OutputPath) +Write-Host "Generated IIS Express config at $OutputPath" diff --git a/run-iisexpress.cmd b/run-iisexpress.cmd new file mode 100644 index 0000000..9af9d10 --- /dev/null +++ b/run-iisexpress.cmd @@ -0,0 +1,25 @@ +@echo off +setlocal + +set "SCRIPT_DIR=%~dp0" +powershell -ExecutionPolicy Bypass -File "%SCRIPT_DIR%build-iisexpress-config.ps1" +if errorlevel 1 exit /b %errorlevel% + +set "CONFIG_PATH=%SCRIPT_DIR%applicationhost.config" +set "SITE_NAME=AspClassicPublicSite" +set "TRACE_SWITCH=%~1" +set "IIS_EXPRESS=%ProgramFiles%\IIS Express\iisexpress.exe" + +if not exist "%IIS_EXPRESS%" set "IIS_EXPRESS=%ProgramFiles(x86)%\IIS Express\iisexpress.exe" + +if not exist "%IIS_EXPRESS%" ( + echo IIS Express not found. Checked Program Files and Program Files ^(x86^). + exit /b 1 +) + +set "TRACE_ARG=" +if /I "%TRACE_SWITCH%"=="trace" set "TRACE_ARG=/trace:error" +if /I "%TRACE_SWITCH%"=="/trace:error" set "TRACE_ARG=/trace:error" + +echo Starting IIS Express site "%SITE_NAME%" using "%CONFIG_PATH%"... +"%IIS_EXPRESS%" /config:"%CONFIG_PATH%" /site:"%SITE_NAME%" %TRACE_ARG% diff --git a/run-iisexpress.ps1 b/run-iisexpress.ps1 new file mode 100644 index 0000000..e43d003 --- /dev/null +++ b/run-iisexpress.ps1 @@ -0,0 +1,28 @@ +param( + [string]$IisExpressPath = "$env:ProgramFiles\IIS Express\iisexpress.exe", + [string]$ConfigPath = "$(Join-Path $PSScriptRoot 'applicationhost.config')", + [string]$SiteName = "AspClassicPublicSite", + [switch]$TraceErrors +) + +& (Join-Path $PSScriptRoot 'build-iisexpress-config.ps1') -OutputPath $ConfigPath +if ($LASTEXITCODE -ne 0) { + exit $LASTEXITCODE +} + +if (-not (Test-Path -LiteralPath $IisExpressPath)) { + $IisExpressPath = "$env:ProgramFiles(x86)\IIS Express\iisexpress.exe" +} + +if (-not (Test-Path -LiteralPath $IisExpressPath)) { + Write-Error "IIS Express not found. Checked Program Files and Program Files (x86)." + exit 1 +} + +$arguments = @("/config:$ConfigPath", "/site:$SiteName") +if ($TraceErrors) { + $arguments += "/trace:error" +} + +Write-Host "Starting IIS Express site '$SiteName' using config '$ConfigPath'..." +& $IisExpressPath @arguments diff --git a/stop-iisexpress.cmd b/stop-iisexpress.cmd new file mode 100644 index 0000000..2d1a6cf --- /dev/null +++ b/stop-iisexpress.cmd @@ -0,0 +1,10 @@ +@echo off +setlocal + +echo Stopping IIS Express... +taskkill /IM iisexpress.exe /F >nul 2>&1 +if errorlevel 1 ( + echo No running IIS Express process found. +) else ( + echo IIS Express stopped. +) diff --git a/stop-iisexpress.ps1 b/stop-iisexpress.ps1 new file mode 100644 index 0000000..7b54714 --- /dev/null +++ b/stop-iisexpress.ps1 @@ -0,0 +1,2 @@ +Get-Process iisexpress -ErrorAction SilentlyContinue | Stop-Process -Force -ErrorAction SilentlyContinue +Write-Host "IIS Express stopped if it was running." diff --git a/tests/AppTests.vbs b/tests/AppTests.vbs new file mode 100644 index 0000000..b38ce0c --- /dev/null +++ b/tests/AppTests.vbs @@ -0,0 +1,153 @@ +Sub Test_App_RegisterAndResolveService() + Dim app + + Set app = New App + app.RegisterInstance "widget", New FakeService + + AssertTrue app.HasService("widget"), "HasService should be True after RegisterInstance" + AssertNotNothing app.Resolve("widget"), "Resolve should return the registered object" +End Sub + +Sub Test_App_ResolveUnregisteredServiceRaises() + Dim app + Dim result + Dim didRaise + + Set app = New App + didRaise = False + + On Error Resume Next + Err.Clear + Set result = app.Resolve("does-not-exist") + If Err.Number <> 0 Then didRaise = True + Err.Clear + On Error Goto 0 + + AssertTrue didRaise, "Resolve should raise when the service isn't registered" +End Sub + +Sub Test_App_ServiceNamesReflectsRegistered() + Dim app + Dim names + + Set app = New App + app.RegisterInstance "alpha", New FakeService + app.RegisterInstance "beta", New FakeService + + names = app.ServiceNames() + + AssertEquals 2, UBound(names) + 1, "ServiceNames should return one entry per registered service" +End Sub + +Sub Test_App_RegisterInstanceReplacesExisting() + Dim app + Dim first + Dim second + Dim resolved + Dim names + + Set app = New App + Set first = New FakeService + Set second = New FakeService + first.Marker = "first" + second.Marker = "second" + + app.RegisterInstance "svc", first + app.RegisterInstance "svc", second + + names = app.ServiceNames() + AssertEquals 1, UBound(names) + 1, "Re-registering the same name should not duplicate it" + + Set resolved = app.Resolve("svc") + AssertEquals "second", resolved.Marker, "Resolve should return the most recently registered instance" +End Sub + +Sub Test_App_BootPrefersOriginalUrlOverPathInfo() + Dim app + Dim httpRequest + Dim fakeRequest + + Set fakeRequest = New FakeAspRequest + fakeRequest.SetServerVariable "REQUEST_METHOD", "GET" + fakeRequest.SetServerVariable "SERVER_NAME", "localhost" + fakeRequest.SetServerVariable "SERVER_PORT", "8080" + fakeRequest.SetServerVariable "PATH_INFO", "/Default.asp" + fakeRequest.SetServerVariable "HTTP_X_ORIGINAL_URL", "/greet/Ada?x=1" + + Set httpRequest = New HttpRequest + httpRequest.Bind fakeRequest + + Set app = New App + app.SetRequest httpRequest + app.Boot + + AssertEquals "/greet/Ada", app.Route, "Route should come from HTTP_X_ORIGINAL_URL (query string stripped), not PATH_INFO" +End Sub + +Sub Test_App_BootFallsBackToPathInfoWhenOriginalUrlMissing() + Dim app + Dim httpRequest + Dim fakeRequest + + Set fakeRequest = New FakeAspRequest + fakeRequest.SetServerVariable "REQUEST_METHOD", "GET" + fakeRequest.SetServerVariable "SERVER_NAME", "localhost" + fakeRequest.SetServerVariable "SERVER_PORT", "8080" + fakeRequest.SetServerVariable "PATH_INFO", "/greet/Ada" + + Set httpRequest = New HttpRequest + httpRequest.Bind fakeRequest + + Set app = New App + app.SetRequest httpRequest + app.Boot + + AssertEquals "/greet/Ada", app.Route, "Route should fall back to PATH_INFO when HTTP_X_ORIGINAL_URL is absent" +End Sub + +Sub Test_App_BootNormalizesDefaultAspToRoot() + Dim app + Dim httpRequest + Dim fakeRequest + + Set fakeRequest = New FakeAspRequest + fakeRequest.SetServerVariable "REQUEST_METHOD", "GET" + fakeRequest.SetServerVariable "SERVER_NAME", "localhost" + fakeRequest.SetServerVariable "SERVER_PORT", "8080" + fakeRequest.SetServerVariable "HTTP_X_ORIGINAL_URL", "/Default.asp" + + Set httpRequest = New HttpRequest + httpRequest.Bind fakeRequest + + Set app = New App + app.SetRequest httpRequest + app.Boot + + AssertEquals "/", app.Route, "Both PATH_INFO and HTTP_X_ORIGINAL_URL '/Default.asp' should normalize to '/'" +End Sub + +Sub Test_App_BootRequiresRequestToBeSet() + Dim app + Dim didRaise + + Set app = New App + didRaise = False + + On Error Resume Next + Err.Clear + app.Boot + If Err.Number <> 0 Then didRaise = True + Err.Clear + On Error Goto 0 + + AssertTrue didRaise, "Boot should raise if SetRequest was never called" +End Sub + +RunTest "App: register + resolve a service", "Test_App_RegisterAndResolveService" +RunTest "App: resolving an unregistered service raises", "Test_App_ResolveUnregisteredServiceRaises" +RunTest "App: ServiceNames reflects registered services", "Test_App_ServiceNamesReflectsRegistered" +RunTest "App: re-registering a name replaces, does not duplicate", "Test_App_RegisterInstanceReplacesExisting" +RunTest "App: Boot prefers HTTP_X_ORIGINAL_URL over PATH_INFO", "Test_App_BootPrefersOriginalUrlOverPathInfo" +RunTest "App: Boot falls back to PATH_INFO when original URL is absent", "Test_App_BootFallsBackToPathInfoWhenOriginalUrlMissing" +RunTest "App: Boot normalizes '/Default.asp' to '/'", "Test_App_BootNormalizesDefaultAspToRoot" +RunTest "App: Boot requires a bound request", "Test_App_BootRequiresRequestToBeSet" diff --git a/tests/ControllerTests.vbs b/tests/ControllerTests.vbs new file mode 100644 index 0000000..00bb4f8 --- /dev/null +++ b/tests/ControllerTests.vbs @@ -0,0 +1,128 @@ +Sub Test_HomeController_ServiceSummaryListsRegisteredServices() + Dim app + Dim controller + + Set app = New App + app.RegisterInstance "clockService", New FakeService + app.RegisterInstance "widgetService", New FakeService + + Set controller = New HomeController + controller.Init app, Nothing + controller.Execute + + AssertEquals "clockService, widgetService", controller.ServiceSummary, "ServiceSummary should comma-join registered service names in registration order" +End Sub + +Sub Test_HomeController_ServiceSummaryWhenNoneRegistered() + Dim app + Dim controller + + Set app = New App + + Set controller = New HomeController + controller.Init app, Nothing + controller.Execute + + AssertEquals "None", controller.ServiceSummary, "ServiceSummary should say 'None' when nothing is registered" +End Sub + +Sub Test_GreetController_UsesCapturedNameParam() + Dim app + Dim controller + Dim params + + Set app = New App + Set params = CreateObject("Scripting.Dictionary") + params.Add "name", "Ada" + + Set controller = New GreetController + controller.Init app, params + controller.Execute + + AssertEquals "Ada", controller.Name, "GreetController should use the captured 'name' param" +End Sub + +Sub Test_GreetController_DefaultsNameWhenMissing() + Dim app + Dim controller + Dim params + + Set app = New App + Set params = CreateObject("Scripting.Dictionary") + + Set controller = New GreetController + controller.Init app, params + controller.Execute + + AssertEquals "there", controller.Name, "GreetController should default to 'there' when no name was captured" +End Sub + +Sub Test_GreetController_DefaultsNameWhenParamsIsNothing() + Dim app + Dim controller + + Set app = New App + + Set controller = New GreetController + controller.Init app, Nothing + controller.Execute + + AssertEquals "there", controller.Name, "GreetController should tolerate routeParams being Nothing" +End Sub + +Sub Test_GreetController_CapturesOptionalIdParam() + Dim app + Dim controller + Dim params + + Set app = New App + Set params = CreateObject("Scripting.Dictionary") + params.Add "name", "Ada" + params.Add "id", "42" + + Set controller = New GreetController + controller.Init app, params + controller.Execute + + AssertTrue controller.HasId, "HasId should be True when the route captured an 'id'" + AssertEquals "42", controller.Id, "GreetController should expose the captured 'id' param" +End Sub + +Sub Test_GreetController_HasIdFalseWhenIdMissing() + Dim app + Dim controller + Dim params + + Set app = New App + Set params = CreateObject("Scripting.Dictionary") + params.Add "name", "Ada" + + Set controller = New GreetController + controller.Init app, params + controller.Execute + + AssertFalse controller.HasId, "HasId should be False when the route did not capture an 'id'" +End Sub + +Sub Test_NotFoundController_SetsResponseStatus() + Dim app + Dim controller + + Set app = New App + Response.Status = "200 OK" + + Set controller = New NotFoundController + controller.Init app, Nothing + controller.Execute + + AssertEquals "404 Not Found", Response.Status, "NotFoundController should set a 404 status" +End Sub + +RunTest "HomeController: ServiceSummary lists registered services", "Test_HomeController_ServiceSummaryListsRegisteredServices" +RunTest "HomeController: ServiceSummary says 'None' when empty", "Test_HomeController_ServiceSummaryWhenNoneRegistered" +RunTest "GreetController: uses captured name param", "Test_GreetController_UsesCapturedNameParam" +RunTest "GreetController: defaults name when missing", "Test_GreetController_DefaultsNameWhenMissing" +RunTest "GreetController: defaults name when params is Nothing", "Test_GreetController_DefaultsNameWhenParamsIsNothing" +RunTest "GreetController: captures optional id param", "Test_GreetController_CapturesOptionalIdParam" +RunTest "GreetController: HasId is False when id is missing", "Test_GreetController_HasIdFalseWhenIdMissing" +RunTest "NotFoundController: sets 404 response status", "Test_NotFoundController_SetsResponseStatus" diff --git a/tests/DispatcherTests.vbs b/tests/DispatcherTests.vbs new file mode 100644 index 0000000..da2da9d --- /dev/null +++ b/tests/DispatcherTests.vbs @@ -0,0 +1,85 @@ +Sub Test_Dispatcher_NoMatchDispatchesToNotFound() + Dim app + Dim dispatcher + Dim controllerKey + Dim controller + + Set app = New App + Set dispatcher = New Dispatcher + Response.Status = "200 OK" + + dispatcher.Dispatch app, Nothing, controllerKey, controller + + AssertEquals "NotFound", controllerKey, "A Nothing route match should dispatch to NotFound" + AssertEquals "404 Not Found", Response.Status, "NotFoundController.Execute should have run and set a 404 status" +End Sub + +Sub Test_Dispatcher_UnknownControllerNameFallsBackToNotFound() + Dim app + Dim dispatcher + Dim controllerKey + Dim controller + Dim routeMatch + Dim params + + Set app = New App + Set dispatcher = New Dispatcher + Set params = CreateObject("Scripting.Dictionary") + Set routeMatch = CreateObject("Scripting.Dictionary") + routeMatch.Add "ControllerName", "SomethingUnregistered" + routeMatch.Add "Params", params + Response.Status = "200 OK" + + dispatcher.Dispatch app, routeMatch, controllerKey, controller + + AssertEquals "NotFound", controllerKey, "An unrecognized controller key should fall back to NotFound" + AssertEquals "404 Not Found", Response.Status, "The NotFound fallback should still run Execute" +End Sub + +Sub Test_Dispatcher_DispatchesToHome() + Dim app + Dim dispatcher + Dim controllerKey + Dim controller + Dim routeMatch + Dim params + + Set app = New App + Set dispatcher = New Dispatcher + Set params = CreateObject("Scripting.Dictionary") + Set routeMatch = CreateObject("Scripting.Dictionary") + routeMatch.Add "ControllerName", "Home" + routeMatch.Add "Params", params + + dispatcher.Dispatch app, routeMatch, controllerKey, controller + + AssertEquals "Home", controllerKey, "A Home route match should dispatch to Home" + AssertEquals "None", controller.ServiceSummary, "The dispatched controller should be a working HomeController" +End Sub + +Sub Test_Dispatcher_DispatchesToGreetWithParams() + Dim app + Dim dispatcher + Dim controllerKey + Dim controller + Dim routeMatch + Dim params + + Set app = New App + Set dispatcher = New Dispatcher + Set params = CreateObject("Scripting.Dictionary") + params.Add "name", "Ada" + Set routeMatch = CreateObject("Scripting.Dictionary") + routeMatch.Add "ControllerName", "Greet" + routeMatch.Add "Params", params + + dispatcher.Dispatch app, routeMatch, controllerKey, controller + + AssertEquals "Greet", controllerKey, "A Greet route match should dispatch to Greet" + AssertEquals "Ada", controller.Name, "The dispatched GreetController should receive the captured 'name' param" +End Sub + +RunTest "Dispatcher: no route match dispatches to NotFound", "Test_Dispatcher_NoMatchDispatchesToNotFound" +RunTest "Dispatcher: unknown controller name falls back to NotFound", "Test_Dispatcher_UnknownControllerNameFallsBackToNotFound" +RunTest "Dispatcher: dispatches to Home", "Test_Dispatcher_DispatchesToHome" +RunTest "Dispatcher: dispatches to Greet with params", "Test_Dispatcher_DispatchesToGreetWithParams" diff --git a/tests/HttpRequestTests.vbs b/tests/HttpRequestTests.vbs new file mode 100644 index 0000000..0fefd38 --- /dev/null +++ b/tests/HttpRequestTests.vbs @@ -0,0 +1,76 @@ +Sub Test_HttpRequest_IsBoundReflectsBindState() + Dim httpRequest + + Set httpRequest = New HttpRequest + + AssertFalse httpRequest.IsBound, "IsBound should be False before Bind" + + httpRequest.Bind New FakeAspRequest + + AssertTrue httpRequest.IsBound, "IsBound should be True after Bind" +End Sub + +Sub Test_HttpRequest_ProxiesServerVariable() + Dim httpRequest + Dim fakeRequest + + Set fakeRequest = New FakeAspRequest + fakeRequest.SetServerVariable "SERVER_NAME", "example.local" + + Set httpRequest = New HttpRequest + httpRequest.Bind fakeRequest + + AssertEquals "example.local", httpRequest.ServerVariable("SERVER_NAME"), "ServerVariable should proxy to the bound request" +End Sub + +Sub Test_HttpRequest_ProxiesQueryStringAndForm() + Dim httpRequest + Dim fakeRequest + + Set fakeRequest = New FakeAspRequest + fakeRequest.SetQueryString "q", "hello" + fakeRequest.SetForm "f", "world" + + Set httpRequest = New HttpRequest + httpRequest.Bind fakeRequest + + AssertEquals "hello", httpRequest.QueryString("q"), "QueryString should proxy to the bound request" + AssertEquals "world", httpRequest.Form("f"), "Form should proxy to the bound request" +End Sub + +Sub Test_HttpRequest_ItemUsesRequestDefaultLookup() + Dim httpRequest + Dim fakeRequest + + Set fakeRequest = New FakeAspRequest + fakeRequest.SetForm "name", "Ada" + + Set httpRequest = New HttpRequest + httpRequest.Bind fakeRequest + + AssertEquals "Ada", httpRequest.Item("name"), "Item should fall through to the request's default lookup" +End Sub + +Sub Test_HttpRequest_AccessingBeforeBindRaises() + Dim httpRequest + Dim discard + Dim didRaise + + Set httpRequest = New HttpRequest + didRaise = False + + On Error Resume Next + Err.Clear + discard = httpRequest.ServerVariable("SERVER_NAME") + If Err.Number <> 0 Then didRaise = True + Err.Clear + On Error Goto 0 + + AssertTrue didRaise, "Accessing an unbound HttpRequest should raise" +End Sub + +RunTest "HttpRequest: IsBound reflects Bind state", "Test_HttpRequest_IsBoundReflectsBindState" +RunTest "HttpRequest: ServerVariable proxies to bound request", "Test_HttpRequest_ProxiesServerVariable" +RunTest "HttpRequest: QueryString and Form proxy to bound request", "Test_HttpRequest_ProxiesQueryStringAndForm" +RunTest "HttpRequest: Item uses the request's default lookup", "Test_HttpRequest_ItemUsesRequestDefaultLookup" +RunTest "HttpRequest: accessing before Bind raises", "Test_HttpRequest_AccessingBeforeBindRaises" diff --git a/tests/RouterTests.vbs b/tests/RouterTests.vbs new file mode 100644 index 0000000..c5c09dd --- /dev/null +++ b/tests/RouterTests.vbs @@ -0,0 +1,118 @@ +Sub Test_Router_MatchesExactRoot() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/", "Home" + + Set result = router.Match("/") + + AssertNotNothing result, "Router should match the exact '/' route" + AssertEquals "Home", result.Item("ControllerName"), "Matched controller name for '/'" +End Sub + +Sub Test_Router_CapturesNamedParam() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/greet/{name}", "Greet" + + Set result = router.Match("/greet/Ada") + + AssertNotNothing result, "Router should match a pattern route" + AssertEquals "Greet", result.Item("ControllerName"), "Matched controller name for pattern route" + AssertTrue result.Item("Params").Exists("name"), "Captured params should contain 'name'" + AssertEquals "Ada", result.Item("Params").Item("name"), "Captured 'name' param value" +End Sub + +Sub Test_Router_ReturnsNothingWhenNoRouteMatches() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/", "Home" + router.AddRoute "/greet/{name}", "Greet" + + Set result = router.Match("/does-not-exist") + + AssertIsNothing result, "Router should return Nothing when no pattern matches" +End Sub + +Sub Test_Router_SegmentCountMustMatch() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/greet/{name}", "Greet" + + Set result = router.Match("/greet/Ada/extra") + + AssertIsNothing result, "An extra path segment should not match a shorter pattern" +End Sub + +Sub Test_Router_LiteralSegmentsMatchCaseInsensitively() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/greet/{name}", "Greet" + + Set result = router.Match("/GREET/Ada") + + AssertNotNothing result, "Literal segments should match regardless of case" + AssertEquals "Ada", result.Item("Params").Item("name"), "Param value should preserve original case" +End Sub + +Sub Test_Router_FirstRegisteredMatchWins() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/greet/world", "SpecificGreet" + router.AddRoute "/greet/{name}", "Greet" + + Set result = router.Match("/greet/world") + + AssertEquals "SpecificGreet", result.Item("ControllerName"), "More specific route registered first should win" +End Sub + +Sub Test_Router_CapturesMultipleNamedParams() + Dim router + Dim result + + Set router = New Router + router.AddRoute "/greet/{name}/{id}", "Greet" + + Set result = router.Match("/greet/Ada/42") + + AssertNotNothing result, "Router should match a pattern with two {param} segments" + AssertEquals "Ada", result.Item("Params").Item("name"), "First captured param value" + AssertEquals "42", result.Item("Params").Item("id"), "Second captured param value" +End Sub + +Sub Test_Router_SameControllerDifferentSegmentCountsCoexist() + Dim router + Dim shortResult + Dim longResult + + Set router = New Router + router.AddRoute "/greet/{name}", "Greet" + router.AddRoute "/greet/{name}/{id}", "Greet" + + Set shortResult = router.Match("/greet/Ada") + Set longResult = router.Match("/greet/Ada/42") + + AssertFalse shortResult.Item("Params").Exists("id"), "The one-segment route should not capture an 'id'" + AssertTrue longResult.Item("Params").Exists("id"), "The two-segment route should capture an 'id'" + AssertEquals "42", longResult.Item("Params").Item("id"), "The two-segment route's 'id' value" +End Sub + +RunTest "Router matches the exact root route", "Test_Router_MatchesExactRoot" +RunTest "Router captures a named {param} segment", "Test_Router_CapturesNamedParam" +RunTest "Router returns Nothing when nothing matches", "Test_Router_ReturnsNothingWhenNoRouteMatches" +RunTest "Router requires matching segment counts", "Test_Router_SegmentCountMustMatch" +RunTest "Router matches literal segments case-insensitively", "Test_Router_LiteralSegmentsMatchCaseInsensitively" +RunTest "Router: first registered match wins", "Test_Router_FirstRegisteredMatchWins" +RunTest "Router captures multiple {param} segments in one pattern", "Test_Router_CapturesMultipleNamedParams" +RunTest "Router: routes with different segment counts to the same controller coexist", "Test_Router_SameControllerDifferentSegmentCountsCoexist" diff --git a/tests/RunTests.vbs b/tests/RunTests.vbs new file mode 100644 index 0000000..d61516f --- /dev/null +++ b/tests/RunTests.vbs @@ -0,0 +1,46 @@ +Option Explicit + +Dim fso +Dim testsDir +Dim repoRoot +Dim coreDir +Dim bootStream +Dim frameworkCode + +Set fso = CreateObject("Scripting.FileSystemObject") + +testsDir = fso.GetParentFolderName(WScript.ScriptFullName) & "\" +repoRoot = fso.GetParentFolderName(Left(testsDir, Len(testsDir) - 1)) & "\" +coreDir = repoRoot & "Core\" + +' Bootstrap: load the framework/fakes before any helper it defines (like +' IncludeAspClass) exists to be called. +Set bootStream = fso.OpenTextFile(testsDir & "TestSupport.vbs", 1) +frameworkCode = bootStream.ReadAll +bootStream.Close +ExecuteGlobal frameworkCode + +' --- Core classes (ASP files - strip <% %> before executing) --- +IncludeAspClass coreDir & "App.asp" +IncludeAspClass coreDir & "Router.asp" +IncludeAspClass coreDir & "HttpRequest.asp" +IncludeAspClass coreDir & "ClockService.asp" +IncludeAspClass coreDir & "Controllers\HomeController.asp" +IncludeAspClass coreDir & "Controllers\GreetController.asp" +IncludeAspClass coreDir & "Controllers\NotFoundController.asp" +IncludeAspClass coreDir & "Dispatcher.asp" + +' --- Test suites --- +IncludeVbsFile testsDir & "RouterTests.vbs" +IncludeVbsFile testsDir & "AppTests.vbs" +IncludeVbsFile testsDir & "HttpRequestTests.vbs" +IncludeVbsFile testsDir & "ControllerTests.vbs" +IncludeVbsFile testsDir & "DispatcherTests.vbs" + +PrintSummary + +If HasFailures() Then + WScript.Quit 1 +Else + WScript.Quit 0 +End If diff --git a/tests/TestSupport.vbs b/tests/TestSupport.vbs new file mode 100644 index 0000000..17f2e4e --- /dev/null +++ b/tests/TestSupport.vbs @@ -0,0 +1,278 @@ +Option Explicit + +Dim g_TestsRun +Dim g_TestsPassed +Dim g_Failures + +g_TestsRun = 0 +g_TestsPassed = 0 +Set g_Failures = CreateObject("Scripting.Dictionary") + +Dim ASSERTION_FAILED +ASSERTION_FAILED = vbObjectError + 1999 + +' Runs the named zero-argument Sub/Function, treating any unhandled error +' (including one raised by a failed Assert*) as a failed test. This mirrors +' exactly the On Error Resume Next / Err.Number pattern already used in +' Public/Default.asp - an error raised in a called procedure with no error +' handling of its own is caught by the caller's active On Error Resume Next. +Sub RunTest(ByVal testName, ByVal procName) + g_TestsRun = g_TestsRun + 1 + + On Error Resume Next + Err.Clear + Execute procName & "()" + + If Err.Number <> 0 Then + RecordFailure testName, Err.Description + Else + g_TestsPassed = g_TestsPassed + 1 + End If + On Error Goto 0 +End Sub + +Sub RecordFailure(ByVal testName, ByVal message) + g_Failures.Add g_Failures.Count, testName & " -- " & message +End Sub + +Sub PrintSummary() + Dim failureKey + + WScript.Echo "" + WScript.Echo "----------------------------------------" + WScript.Echo g_TestsPassed & " / " & g_TestsRun & " tests passed" + + If g_Failures.Count > 0 Then + WScript.Echo "" + WScript.Echo "Failures:" + For Each failureKey In g_Failures.Keys + WScript.Echo " - " & g_Failures.Item(failureKey) + Next + End If + + WScript.Echo "----------------------------------------" +End Sub + +Function HasFailures() + HasFailures = (g_Failures.Count > 0) +End Function + +' --- Assertions --- + +Sub AssertEquals(ByVal expected, ByVal actual, ByVal message) + If Not (expected = actual) Then + Fail message & " (expected [" & CStr(expected) & "] but got [" & CStr(actual) & "])" + End If +End Sub + +Sub AssertTrue(ByVal condition, ByVal message) + If Not condition Then + Fail message & " (expected True)" + End If +End Sub + +Sub AssertFalse(ByVal condition, ByVal message) + If condition Then + Fail message & " (expected False)" + End If +End Sub + +Sub AssertIsNothing(ByVal value, ByVal message) + If Not (value Is Nothing) Then + Fail message & " (expected Nothing)" + End If +End Sub + +Sub AssertNotNothing(ByVal value, ByVal message) + If value Is Nothing Then + Fail message & " (expected an object, got Nothing)" + End If +End Sub + +Sub Fail(ByVal message) + Err.Raise ASSERTION_FAILED, "Assert", message +End Sub + +' --- Loading Core/*.asp class files outside IIS --- +' These files are plain "<% Class ... End Class %>" blocks with no mixed HTML +' and (deliberately - see CLAUDE.md) no Option Explicit of their own, so +' stripping the ASP delimiters and running the remainder through ExecuteGlobal +' loads the same class definitions IIS would compile, without needing IIS. + +Sub IncludeAspClass(ByVal path) + Dim raw + Dim code + Dim openPos + Dim closePos + + raw = ReadFileText(path) + openPos = InStr(raw, "<%") + closePos = InStrRev(raw, "%>") + + If openPos = 0 Or closePos = 0 Or closePos <= openPos Then + Err.Raise vbObjectError + 1998, "IncludeAspClass", "No <% %> block found in: " & path + End If + + code = Mid(raw, openPos + 2, closePos - (openPos + 2)) + ExecuteGlobal code +End Sub + +Sub IncludeVbsFile(ByVal path) + ExecuteGlobal ReadFileText(path) +End Sub + +Function ReadFileText(ByVal path) + Dim fso + Dim stream + + Set fso = CreateObject("Scripting.FileSystemObject") + Set stream = fso.OpenTextFile(path, 1) + ReadFileText = stream.ReadAll + stream.Close +End Function + +' --- ASP intrinsic stand-ins --- +' Global variables literally named Server/Response so Core/*.asp's +' "Server.CreateObject(...)" / "Server.HTMLEncode(...)" / "Response.Status = ..." +' resolve to these instead of the real (IIS-only) intrinsics. + +Function RealCreateObject(ByVal progId) + Set RealCreateObject = CreateObject(progId) +End Function + +Function SimpleHtmlEncode(ByVal text) + Dim result + result = CStr(text) + result = Replace(result, "&", "&") + result = Replace(result, "<", "<") + result = Replace(result, ">", ">") + result = Replace(result, """", """) + SimpleHtmlEncode = result +End Function + +Class FakeServer + Public Function CreateObject(ByVal progId) + Set CreateObject = RealCreateObject(progId) + End Function + + Public Function HTMLEncode(ByVal text) + HTMLEncode = SimpleHtmlEncode(text) + End Function + + Public Function MapPath(ByVal relativePath) + MapPath = "C:\fake-physical-root" & relativePath + End Function +End Class + +Class FakeResponse + Public Status + Public Buffer + Public ContentType + + Private m_Output + + Private Sub Class_Initialize() + Status = "200 OK" + Buffer = False + ContentType = "" + m_Output = "" + End Sub + + Public Sub Write(ByVal text) + m_Output = m_Output & text + End Sub + + Public Property Get Output() + Output = m_Output + End Property +End Class + +' A neutral dummy object for tests that just need "some object" to register +' as a service - not a stand-in for any real ASP intrinsic. +Class FakeService + Public Marker +End Class + +' A stand-in for the real ASP Request object that Core/HttpRequest.asp's +' Bind() expects - only implements what the current code paths touch. +Class FakeAspRequest + Private m_ServerVariables + Private m_QueryString + Private m_Form + Private m_Cookies + + Private Sub Class_Initialize() + Set m_ServerVariables = CreateObject("Scripting.Dictionary") + Set m_QueryString = CreateObject("Scripting.Dictionary") + Set m_Form = CreateObject("Scripting.Dictionary") + Set m_Cookies = CreateObject("Scripting.Dictionary") + End Sub + + Public Sub SetServerVariable(ByVal key, ByVal value) + m_ServerVariables.Item(CStr(key)) = value + End Sub + + Public Sub SetQueryString(ByVal key, ByVal value) + m_QueryString.Item(CStr(key)) = value + End Sub + + Public Sub SetForm(ByVal key, ByVal value) + m_Form.Item(CStr(key)) = value + End Sub + + Public Sub SetCookie(ByVal key, ByVal value) + m_Cookies.Item(CStr(key)) = value + End Sub + + Public Function ServerVariables(ByVal key) + If m_ServerVariables.Exists(CStr(key)) Then + ServerVariables = m_ServerVariables.Item(CStr(key)) + Else + ServerVariables = "" + End If + End Function + + Public Function QueryString(ByVal key) + If m_QueryString.Exists(CStr(key)) Then + QueryString = m_QueryString.Item(CStr(key)) + Else + QueryString = "" + End If + End Function + + Public Function Form(ByVal key) + If m_Form.Exists(CStr(key)) Then + Form = m_Form.Item(CStr(key)) + Else + Form = "" + End If + End Function + + Public Function Cookies(ByVal key) + If m_Cookies.Exists(CStr(key)) Then + Cookies = m_Cookies.Item(CStr(key)) + Else + Cookies = "" + End If + End Function + + Public Default Function Item(ByVal key) + If m_QueryString.Exists(CStr(key)) Then + Item = m_QueryString.Item(CStr(key)) + ElseIf m_Form.Exists(CStr(key)) Then + Item = m_Form.Item(CStr(key)) + ElseIf m_Cookies.Exists(CStr(key)) Then + Item = m_Cookies.Item(CStr(key)) + ElseIf m_ServerVariables.Exists(CStr(key)) Then + Item = m_ServerVariables.Item(CStr(key)) + Else + Item = "" + End If + End Function +End Class + +Dim Server +Dim Response + +Set Server = New FakeServer +Set Response = New FakeResponse diff --git a/tests/run-tests.cmd b/tests/run-tests.cmd new file mode 100644 index 0000000..eacfc5e --- /dev/null +++ b/tests/run-tests.cmd @@ -0,0 +1,3 @@ +@echo off +cscript //nologo "%~dp0RunTests.vbs" +exit /b %ERRORLEVEL% diff --git a/tests/run-tests.ps1 b/tests/run-tests.ps1 new file mode 100644 index 0000000..221242b --- /dev/null +++ b/tests/run-tests.ps1 @@ -0,0 +1,5 @@ +$scriptDir = Split-Path -Parent $MyInvocation.MyCommand.Path +$runner = Join-Path $scriptDir 'RunTests.vbs' + +cscript //nologo $runner +exit $LASTEXITCODE