From 525b42106946e4d0cf9bc7f497afc80e36cb9111 Mon Sep 17 00:00:00 2001 From: Nano Date: Sun, 3 May 2026 09:33:07 -0400 Subject: [PATCH] Add AI content generation for admin posts --- app/controllers/AdminController.asp | 136 ++++++++++++++++++++++++ app/controllers/PostsController.asp | 38 +++---- app/repositories/CommentsRepository.asp | 46 ++++---- app/views/Admin/categories.asp | 10 +- app/views/Admin/index.asp | 4 +- app/views/Admin/posts.asp | 15 +-- app/views/Categories/edit.asp | 6 +- app/views/Categories/index.asp | 6 +- app/views/Categories/new.asp | 4 +- app/views/Categories/show.asp | 10 +- app/views/Home/index.asp | 4 +- app/views/Posts/edit.asp | 15 +-- app/views/Posts/index.asp | 16 +-- app/views/Posts/new.asp | 4 +- app/views/Posts/show.asp | 59 ++++++++-- app/views/shared/header.asp | 6 +- core/helpers.asp | 67 +++++++++++- core/router.wsc | 54 +++++++++- public/Default.asp | 1 + public/web.config | 9 ++ 20 files changed, 410 insertions(+), 100 deletions(-) diff --git a/app/controllers/AdminController.asp b/app/controllers/AdminController.asp index 9d6859a..8e4f1b0 100644 --- a/app/controllers/AdminController.asp +++ b/app/controllers/AdminController.asp @@ -107,6 +107,142 @@ Class AdminController_Class Response.Redirect "/admin/posts" End Sub + '--------------------------------------------------------------- + ' Action: GenerateAIContent + '--------------------------------------------------------------- + Public Sub GenerateAIContent(ByVal id) + Dim post + On Error Resume Next + Set post = PostsRepository().FindByID(id) + If Err.Number <> 0 Then + Err.Clear + On Error GoTo 0 + Flash().AddError "Post not found." + Response.Redirect "/admin/posts" + Exit Sub + End If + On Error GoTo 0 + + Dim generatedSummary, generatedBody + On Error Resume Next + GeneratePostContentFromAI post, generatedSummary, generatedBody + If Err.Number <> 0 Then + Flash().AddError "AI content generation failed: " & Err.Description + Err.Clear + On Error GoTo 0 + Response.Redirect PostEditUrl(post.PostID) + Exit Sub + End If + On Error GoTo 0 + + If Len(Trim(generatedSummary)) = 0 Or Len(Trim(generatedBody)) = 0 Then + Flash().AddError "AI content generation returned empty content." + Response.Redirect PostEditUrl(post.PostID) + Exit Sub + End If + + post.Summary = generatedSummary + post.Body = generatedBody + post.UpdatedDate = Now() + + PostsRepository().Update post + Flash().Success = "AI content generated." + Response.Redirect PostEditUrl(post.PostID) + End Sub + + Private Sub GeneratePostContentFromAI(ByRef post, ByRef generatedSummary, ByRef generatedBody) + Dim apiKey : apiKey = Trim(CStr(GetAppSetting("AbacusApiKey"))) + If Len(apiKey) = 0 Or LCase(apiKey) = "nothing" Then + Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API key is not configured." + End If + + Dim baseUrl : baseUrl = Trim(CStr(GetAppSetting("AbacusApiBaseUrl"))) + If Len(baseUrl) = 0 Or LCase(baseUrl) = "nothing" Then baseUrl = "https://routellm.abacus.ai/v1" + If Right(baseUrl, 1) = "/" Then baseUrl = Left(baseUrl, Len(baseUrl) - 1) + + Dim modelName : modelName = Trim(CStr(GetAppSetting("AbacusModel"))) + If Len(modelName) = 0 Or LCase(modelName) = "nothing" Then modelName = "route-llm" + + Dim systemPrompt, userPrompt, payload, responseText, parsed, choices, choice, message, content, contentJson + systemPrompt = "You write clear, engaging blog post content for a classic ASP blog. Return only valid JSON with two keys: summary and body. Summary must be 1 to 2 sentences. Body must be 3 to 5 short paragraphs separated by blank lines. Do not use markdown fences, bullets, or code blocks." + + userPrompt = "Create blog content for this post title: " & SafeText(post.Title) & vbCrLf & _ + "Existing summary: " & SafeText(post.Summary) & vbCrLf & _ + "Existing body: " & SafeText(post.Body) & vbCrLf & _ + "Keep the title unchanged. Make the content readable and helpful for a general audience." + + payload = "{""model"":""" & JsonEscape(modelName) & """,""messages"":[{""role"":""system"",""content"":""" & JsonEscape(systemPrompt) & """},{""role"":""user"",""content"":""" & JsonEscape(userPrompt) & """}],""temperature"":0.7}" + + responseText = HttpPostJson(baseUrl & "/chat/completions", apiKey, payload) + + Set parsed = json() + parsed.loadJSON responseText + + If Not parsed.data.Exists("choices") Then + Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include choices." + End If + + Set choices = parsed.data.Item("choices") + If choices.Count = 0 Then + Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API returned no choices." + End If + + Set choice = choices.Item(0) + If Not choice.Exists("message") Then + Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include a message." + End If + + Set message = choice.Item("message") + If Not message.Exists("content") Then + Err.Raise 1, "AdminController.GeneratePostContentFromAI", "Abacus API response did not include content." + End If + + content = Trim(CStr(message.Item("content"))) + contentJson = ExtractJsonObject(content) + + Set parsed = json() + parsed.loadJSON contentJson + + If parsed.data.Exists("summary") Then generatedSummary = Trim(CStr(parsed.data.Item("summary"))) + If parsed.data.Exists("body") Then generatedBody = Trim(CStr(parsed.data.Item("body"))) + End Sub + + Private Function HttpPostJson(ByVal url, ByVal apiKey, ByVal payload) + Dim http + Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0") + http.setTimeouts 10000, 10000, 10000, 30000 + http.open "POST", url, False + http.setRequestHeader "Content-Type", "application/json" + http.setRequestHeader "Authorization", "Bearer " & apiKey + http.send payload + + If http.status < 200 Or http.status >= 300 Then + Err.Raise IIf(http.status > 0, http.status, 1), "AdminController.HttpPostJson", "Abacus API returned HTTP " & http.status & ": " & Left(CStr(http.responseText), 500) + End If + + HttpPostJson = http.responseText + End Function + + Private Function ExtractJsonObject(ByVal text) + Dim startPos, endPos + startPos = InStr(text, "{") + endPos = InStrRev(text, "}") + + If startPos > 0 And endPos > startPos Then + ExtractJsonObject = Mid(text, startPos, endPos - startPos + 1) + Else + ExtractJsonObject = text + End If + End Function + + Private Function SafeText(ByVal value) + If IsNull(value) Or IsEmpty(value) Then + SafeText = "" + Else + SafeText = CStr(value) + End If + End Function + End Class Dim AdminController_Class__Singleton diff --git a/app/controllers/PostsController.asp b/app/controllers/PostsController.asp index f4e165e..5492777 100644 --- a/app/controllers/PostsController.asp +++ b/app/controllers/PostsController.asp @@ -48,27 +48,27 @@ Class PostsController_Class '--------------------------------------------------------------- ' Action: Show '--------------------------------------------------------------- - Public Sub Show(ByVal slug) - Dim matches - Set matches = PostsRepository().Find(Array("Slug", slug, "IsPublished", 1), Empty) - - If matches.Count = 0 Then - Response.Status = "404 Not Found" - %> - + Public Sub Show(ByVal slug) + Dim matches + Set matches = PostsRepository().Find(Array("Slug", slug, "IsPublished", 1), Empty) + + If matches.Count = 0 Then + Response.Status = "404 Not Found" + %> + <% Exit Sub - End If - - Dim post - Set post = matches.Front() - - Dim comments - Set comments = CommentsRepository().Find(Array("PostID", post.PostID, "IsApproved", 1), Array("CreatedDate")) - %> - - <% - End Sub + End If + + Dim post + Set post = matches.Front() + + Dim comments + Set comments = CommentsRepository().Find(Array("PostID", post.PostID, "IsApproved", 1), "CreatedDate") + %> + + <% + End Sub '--------------------------------------------------------------- ' Action: New diff --git a/app/repositories/CommentsRepository.asp b/app/repositories/CommentsRepository.asp index 6cfea23..a7dfc95 100644 --- a/app/repositories/CommentsRepository.asp +++ b/app/repositories/CommentsRepository.asp @@ -27,29 +27,29 @@ Class CommentsRepository_Class Set GetAll = Find(Empty, orderBy) End Function - Public Function Find(where_kvarray, order_string_or_array) - Dim sql : sql = "Select [AuthorEmail], [AuthorName], [Body], [CommentID], [CreatedDate], [IsApproved], [PostID] FROM [Comments]" - Dim where_keys, where_values, i - If Not IsEmpty(where_kvarray) Then - KVUnzip where_kvarray, where_keys, where_values - If Not IsEmpty(where_keys) Then - sql = sql & " WHERE " - For i = 0 To UBound(where_keys) - If i > 0 Then sql = sql & " AND " - sql = sql & " " & QI(where_keys(i)) & " = ?" - Next - End If - End If - sql = sql & BuildOrderBy(order_string_or_array, "[CommentID]") - Dim rs : Set rs = DAL.Query(sql, where_values) - Dim list : Set list = new LinkedList_Class - Do Until rs.EOF - list.Push Automapper.AutoMap(rs, "POBO_Comments") - rs.MoveNext - Loop - Set Find = list - Destroy rs - End Function + Public Function Find(where_kvarray, order_string_or_array) + Dim sql : sql = "Select [AuthorEmail], [AuthorName], [Body], [CommentID], [CreatedDate], [IsApproved], [PostID] FROM [Comments]" + Dim where_keys, where_values, i + If Not IsEmpty(where_kvarray) Then + KVUnzip where_kvarray, where_keys, where_values + If Not IsEmpty(where_keys) Then + sql = sql & " WHERE " + For i = 0 To UBound(where_keys) + If i > 0 Then sql = sql & " AND " + sql = sql & " " & QI(where_keys(i)) & " = ?" + Next + End If + End If + sql = sql & BuildOrderBy(order_string_or_array, "[CommentID]") + Dim rs : Set rs = DAL.Query(sql, where_values) + Dim list : Set list = new LinkedList_Class + Do Until rs.EOF + list.Push Automapper.AutoMap(rs, "POBO_Comments") + rs.MoveNext + Loop + Set Find = list + Destroy rs + End Function Public Function FindPaged(where_kvarray, order_string_or_array, per_page, page_num, ByRef page_count, ByRef record_count) Dim sql : sql = "Select [AuthorEmail], [AuthorName], [Body], [CommentID], [CreatedDate], [IsApproved], [PostID] FROM [Comments]" diff --git a/app/views/Admin/categories.asp b/app/views/Admin/categories.asp index 78b1adc..9e38bb7 100644 --- a/app/views/Admin/categories.asp +++ b/app/views/Admin/categories.asp @@ -3,11 +3,11 @@

Manage Categories

All categories — edit or delete.

- New Category + New Category <% If categories.Count = 0 Then %> -
No categories yet. Create the first one.
+
No categories yet. Create the first one.
<% Else %>
@@ -27,14 +27,14 @@ %> diff --git a/app/views/Admin/index.asp b/app/views/Admin/index.asp index 6f88aae..8deb19a 100644 --- a/app/views/Admin/index.asp +++ b/app/views/Admin/index.asp @@ -7,7 +7,7 @@
- + <%= H(adminCatItem.Name) %> <%= H(adminCatItem.Description) %> - Edit -
+ Edit +
@@ -44,17 +44,20 @@ <%= H(FormatDateTime(adminPostItem.CreatedDate, vbShortDate)) %> diff --git a/app/views/Categories/edit.asp b/app/views/Categories/edit.asp index a81b018..62e6b97 100644 --- a/app/views/Categories/edit.asp +++ b/app/views/Categories/edit.asp @@ -4,7 +4,7 @@

Edit Category

-
+
@@ -22,11 +22,11 @@
- Cancel + Cancel
-
+
diff --git a/app/views/Categories/index.asp b/app/views/Categories/index.asp index 1547374..e449eaa 100644 --- a/app/views/Categories/index.asp +++ b/app/views/Categories/index.asp @@ -3,7 +3,7 @@

Categories

Browse post categories from ASPBlogBrainOrdure.

- New Category + New Category <% @@ -25,12 +25,12 @@ Else diff --git a/app/views/Categories/new.asp b/app/views/Categories/new.asp index 486e478..2c7680d 100644 --- a/app/views/Categories/new.asp +++ b/app/views/Categories/new.asp @@ -4,7 +4,7 @@

New Category

-
+
@@ -22,7 +22,7 @@
- Cancel + Cancel
diff --git a/app/views/Categories/show.asp b/app/views/Categories/show.asp index cfa61fd..1ddd82a 100644 --- a/app/views/Categories/show.asp +++ b/app/views/Categories/show.asp @@ -1,15 +1,15 @@

<%= H(category.Name) %>

<%= H(category.Description) %>

- Edit Category -
+ Edit Category +
@@ -32,14 +32,14 @@
diff --git a/app/views/Home/index.asp b/app/views/Home/index.asp index 24e0562..0aad3b3 100644 --- a/app/views/Home/index.asp +++ b/app/views/Home/index.asp @@ -2,7 +2,7 @@

BrainOrdure

Thoughts, notes, and things worth writing down.

diff --git a/app/views/Posts/edit.asp b/app/views/Posts/edit.asp index 3b0894a..480ccfe 100644 --- a/app/views/Posts/edit.asp +++ b/app/views/Posts/edit.asp @@ -4,7 +4,7 @@

Edit Post

-
+
@@ -25,13 +25,14 @@
-
- - Cancel -
- +
+ + + Cancel +
+ -
+
diff --git a/app/views/Posts/index.asp b/app/views/Posts/index.asp index 6464283..2aeece0 100644 --- a/app/views/Posts/index.asp +++ b/app/views/Posts/index.asp @@ -3,7 +3,7 @@

Posts

Published articles from ASPBlogBrainOrdure.

- New Post + New Post <% @@ -28,9 +28,9 @@ Else

- - <%= H(postItem.Title) %> - + + <%= H(postItem.Title) %> +

<% Dim publishedText @@ -49,10 +49,10 @@ Else %>

<%= H(postItem.Summary) %>

- Read -
- - + Read + + + <% Loop %> diff --git a/app/views/Posts/new.asp b/app/views/Posts/new.asp index 738b40b..7a6510b 100644 --- a/app/views/Posts/new.asp +++ b/app/views/Posts/new.asp @@ -4,7 +4,7 @@

New Post

-
+
@@ -27,7 +27,7 @@
- Cancel + Cancel
diff --git a/app/views/Posts/show.asp b/app/views/Posts/show.asp index fe61f7d..fefba80 100644 --- a/app/views/Posts/show.asp +++ b/app/views/Posts/show.asp @@ -1,7 +1,7 @@

<%= H(post.Title) %>

@@ -34,22 +34,58 @@
-

Comments (<%= comments.Count %>)

+ <% + Dim commentsCount, commentsLoadFailed + commentsCount = 0 + commentsLoadFailed = False - <% If comments.Count = 0 Then %> + On Error Resume Next + If IsObject(comments) Then commentsCount = comments.Count + If Err.Number <> 0 Then + commentsLoadFailed = True + commentsCount = 0 + Err.Clear + End If + On Error GoTo 0 + %> +

Comments (<%= commentsCount %>)

+ + <% If commentsLoadFailed Then %> +
Comments are temporarily unavailable.
+ <% ElseIf commentsCount = 0 Then %>

No comments yet. Be the first to leave one below.

<% Else %> <% Dim commentIter, commentItem + Dim commentsIterFailed + commentsIterFailed = False + + On Error Resume Next Set commentIter = comments.Iterator() - Do While commentIter.HasNext + If Err.Number <> 0 Then + commentsIterFailed = True + Err.Clear + End If + + Do While Not commentsIterFailed And commentIter.HasNext Set commentItem = commentIter.GetNext() + If Err.Number <> 0 Then + commentsIterFailed = True + Err.Clear + Exit Do + End If + + Dim commentDateText + commentDateText = "" + If IsDate(commentItem.CreatedDate) Then + commentDateText = FormatDateTime(commentItem.CreatedDate, vbLongDate) + End If %>
<%= H(commentItem.AuthorName) %> - <%= H(FormatDateTime(commentItem.CreatedDate, vbLongDate)) %> + <%= H(commentDateText) %>
<% Dim commentBody @@ -63,6 +99,17 @@
<% Loop + If Err.Number <> 0 Then + commentsIterFailed = True + Err.Clear + End If + On Error GoTo 0 + + If commentsIterFailed Then + %> +
Some comments could not be displayed.
+ <% + End If %> <% End If %> @@ -70,7 +117,7 @@

Leave a Comment

-
+
diff --git a/app/views/shared/header.asp b/app/views/shared/header.asp index d5c7ce9..8913f38 100644 --- a/app/views/shared/header.asp +++ b/app/views/shared/header.asp @@ -62,13 +62,13 @@ End If Home
diff --git a/core/helpers.asp b/core/helpers.asp index ca87a1e..f8b3683 100644 --- a/core/helpers.asp +++ b/core/helpers.asp @@ -187,6 +187,71 @@ Function H(s) End If End Function +'------------------------------------------------------------------------------ +' Canonical application URL helpers +' - Categories use numeric IDs +' - Posts use slug permalinks for public links and numeric IDs for admin actions +'------------------------------------------------------------------------------ +Function CategoryUrl(ByVal categoryId) + CategoryUrl = "/categories/" & Server.URLEncode(CStr(categoryId)) +End Function + +Function CategoriesUrl() + CategoriesUrl = "/categories" +End Function + +Function CategoryNewUrl() + CategoryNewUrl = "/categories/new" +End Function + +Function CategoryEditUrl(ByVal categoryId) + CategoryEditUrl = CategoryUrl(categoryId) & "/edit" +End Function + +Function CategoryDeleteUrl(ByVal categoryId) + CategoryDeleteUrl = CategoryUrl(categoryId) & "/delete" +End Function + +Function PostUrl(ByVal slug) + PostUrl = "/posts/" & Server.URLEncode(CStr(slug)) +End Function + +Function PostsUrl() + PostsUrl = "/posts" +End Function + +Function PostNewUrl() + PostNewUrl = "/posts/new" +End Function + +Function PostEditUrl(ByVal postId) + PostEditUrl = "/posts/" & Server.URLEncode(CStr(postId)) & "/edit" +End Function + +Function PostDeleteUrl(ByVal postId) + PostDeleteUrl = "/posts/" & Server.URLEncode(CStr(postId)) & "/delete" +End Function + +Function AdminPostPublishUrl(ByVal postId) + AdminPostPublishUrl = "/admin/posts/" & Server.URLEncode(CStr(postId)) & "/publish" +End Function + +Function AdminPostUnpublishUrl(ByVal postId) + AdminPostUnpublishUrl = "/admin/posts/" & Server.URLEncode(CStr(postId)) & "/unpublish" +End Function + +Function AdminPostAIUrl(ByVal postId) + AdminPostAIUrl = "/admin/posts/" & Server.URLEncode(CStr(postId)) & "/ai" +End Function + +Function AdminUrl() + AdminUrl = "/admin" +End Function + +Function CommentsUrl() + CommentsUrl = "/comments" +End Function + '======================================================================================================================= ' Adapted from Tolerable library @@ -533,4 +598,4 @@ Function FormatDateForSql(vbDate) FormatDateForSql = "'" & yyyy & "-" & mm & "-" & dd & " " & hh & ":" & nn & ":" & ss & "'" End Function -%> \ No newline at end of file +%> diff --git a/core/router.wsc b/core/router.wsc index 2d5401e..ebb65a7 100644 --- a/core/router.wsc +++ b/core/router.wsc @@ -65,7 +65,7 @@ Public Sub AddRoute(method, path, controller, action) End If Dim routeKey - routeKey = methodUpper & ":" & LCase(Trim(path)) + routeKey = methodUpper & ":" & NormalizePath(path) If Not routes.Exists(routeKey) Then routes.Add routeKey, Array(Trim(controller), Trim(action)) @@ -77,7 +77,7 @@ End Sub '------------------------------------------------------------ Public Function Resolve(method, path) Dim routeKey, routeValue, values - routeKey = UCase(method) & ":" & LCase(path) + routeKey = UCase(method) & ":" & NormalizePath(path) ' Always return a params array (empty by default) Dim emptyParams() : ReDim emptyParams(-1) @@ -113,6 +113,9 @@ End Function '------------------------------------------------------------ Private Function IsMatch(requestPath, routePattern, values) Dim reqParts, routeParts, i, paramCount + requestPath = NormalizePath(requestPath) + routePattern = NormalizePath(routePattern) + reqParts = Split(requestPath, "/") routeParts = Split(routePattern, "/") @@ -123,7 +126,7 @@ Private Function IsMatch(requestPath, routePattern, values) paramCount = 0 : ReDim values(-1) For i = 0 To UBound(reqParts) - If Left(routeParts(i), 1) = ":" Then + If IsDynamicSegment(routeParts(i)) Then ReDim Preserve values(paramCount) values(paramCount) = reqParts(i) paramCount = paramCount + 1 @@ -136,6 +139,51 @@ Private Function IsMatch(requestPath, routePattern, values) 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 + + 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 '------------------------------------------------------------ diff --git a/public/Default.asp b/public/Default.asp index 2eda254..340ae9b 100644 --- a/public/Default.asp +++ b/public/Default.asp @@ -35,6 +35,7 @@ router.AddRoute "GET", "/admin/categories", "AdminController", "Categories" router.AddRoute "POST", "/admin/posts/{id}/publish", "AdminController", "PublishPost" router.AddRoute "POST", "/admin/posts/{id}/unpublish", "AdminController", "UnpublishPost" + router.AddRoute "POST", "/admin/posts/{id}/ai", "AdminController", "GenerateAIContent" ' Dispatch the request (resolves route and executes controller action) MVC.DispatchRequest Request.ServerVariables("REQUEST_METHOD"), _ diff --git a/public/web.config b/public/web.config index b917900..11e40d6 100644 --- a/public/web.config +++ b/public/web.config @@ -39,6 +39,15 @@ + + + + + + + + +
- Edit + Edit +
+ +
<% If adminPostItem.IsPublished = 1 Then %> -
+
<% Else %> -
+
<% End If %> -
+