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 @@
All categories — edit or delete.
- New Category + New Category <% If categories.Count = 0 Then %> -