ASPBlogBrainOrdure/app/controllers/AdminController.asp

<%
Class AdminController_Class
    Private m_useLayout
    Private m_title

    Private Sub Class_Initialize()
        m_useLayout = True
        m_title = "Admin"
    End Sub

    Public Property Get useLayout
        useLayout = m_useLayout
    End Property

    Public Property Let useLayout(v)
        m_useLayout = v
    End Property

    Public Property Get Title
        Title = m_title
    End Property

    Public Property Let Title(v)
        m_title = v
    End Property

    '---------------------------------------------------------------
    ' Action: Index
    '---------------------------------------------------------------
    Public Sub Index()
        m_title = "Admin Dashboard"
    %>
    <!--#include file="../views/Admin/index.asp" -->
    <%
    End Sub

    '---------------------------------------------------------------
    ' Action: Posts
    '---------------------------------------------------------------
    Public Sub Posts()
        m_title = "Manage Posts"
        Dim posts
        Set posts = PostsRepository().FindAllWhere(Empty, "CreatedDate DESC", 0, 0)
    %>
    <!--#include file="../views/Admin/posts.asp" -->
    <%
    End Sub

    '---------------------------------------------------------------
    ' Action: Categories
    '---------------------------------------------------------------
    Public Sub Categories()
        m_title = "Manage Categories"
        Dim categories
        Set categories = CategoriesRepository().FindAll
    %>
    <!--#include file="../views/Admin/categories.asp" -->
    <%
    End Sub

    '---------------------------------------------------------------
    ' Action: Comments
    '---------------------------------------------------------------
    Public Sub Comments()
        m_title = "Manage Comments"
        Dim comments
        Set comments = CommentsRepository().Find(Empty, "CreatedDate")
    %>
    <!--#include file="../views/Admin/comments.asp" -->
    <%
    End Sub

    '---------------------------------------------------------------
    ' Action: AIPrompt
    '---------------------------------------------------------------
    Public Sub AIPrompt()
        m_title = "AI Prompt Settings"
        Dim promptTemplate : promptTemplate = GetGenerationPromptTemplate()
    %>
    <!--#include file="../views/Admin/ai-prompt.asp" -->
    <%
    End Sub

    '---------------------------------------------------------------
    ' Action: UpdateAIPrompt
    '---------------------------------------------------------------
    Public Sub UpdateAIPrompt()
        Dim promptTemplate : promptTemplate = Trim(Request.Form("PromptTemplate"))
        If Len(promptTemplate) = 0 Then
            Flash().AddError "Prompt template cannot be empty."
            Response.Redirect "/admin/ai-prompt"
            Exit Sub
        End If

        On Error Resume Next
        UpdateAppSetting "AbacusGenerationPrompt", promptTemplate
        If Err.Number <> 0 Then
            Flash().AddError "Unable to save prompt template: " & Err.Description
            Err.Clear
            On Error GoTo 0
            Response.Redirect "/admin/ai-prompt"
            Exit Sub
        End If
        On Error GoTo 0

        Flash().Success = "AI prompt template saved."
        Response.Redirect "/admin/ai-prompt"
    End Sub

    '---------------------------------------------------------------
    ' Action: PublishPost
    '---------------------------------------------------------------
    Public Sub PublishPost(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

        post.IsPublished = 1
        If Not IsDate(post.PublishedDate) Or CDate(post.PublishedDate) <= #1/1/1970# Then
            post.PublishedDate = Now()
        End If
        post.UpdatedDate = Now()
        PostsRepository().Update post
        Flash().Success = "Post published."
        Response.Redirect "/admin/posts"
    End Sub

    '---------------------------------------------------------------
    ' Action: UnpublishPost
    '---------------------------------------------------------------
    Public Sub UnpublishPost(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

        post.IsPublished = 0
        post.UpdatedDate = Now()
        PostsRepository().Update post
        Flash().Success = "Post unpublished."
        Response.Redirect "/admin/posts"
    End Sub

    '---------------------------------------------------------------
    ' Action: ApproveComment
    '---------------------------------------------------------------
    Public Sub ApproveComment(ByVal id)
        UpdateCommentApproval id, 1, "Comment approved."
    End Sub

    '---------------------------------------------------------------
    ' Action: UnapproveComment
    '---------------------------------------------------------------
    Public Sub UnapproveComment(ByVal id)
        UpdateCommentApproval id, 0, "Comment unapproved."
    End Sub

    '---------------------------------------------------------------
    ' Action: DeleteComment
    '---------------------------------------------------------------
    Public Sub DeleteComment(ByVal id)
        Dim comment
        On Error Resume Next
        Set comment = CommentsRepository().FindByID(id)
        If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
            Flash().AddError "Comment not found."
            Response.Redirect "/admin/comments"
            Exit Sub
        End If
        On Error GoTo 0

        CommentsRepository().Delete id
        Flash().Success = "Comment deleted."
        Response.Redirect "/admin/comments"
    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, generatedImagePrompt, generatedImageHtml
        On Error Resume Next
        GeneratePostContentFromAI post, generatedSummary, generatedBody, generatedImagePrompt
        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

        generatedImageHtml = BuildGeneratedImageHtml(generatedImagePrompt, post.Title, generatedSummary)

        post.Summary = generatedSummary
        post.Body = generatedImageHtml & 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, ByRef generatedImagePrompt)
        Dim apiKey : apiKey = Trim(CStr(GetSecureSetting("AbacusApiKey", "ABACUS_API_KEY")))
        If Len(apiKey) = 0 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 three keys: summary, image_prompt, and body. Summary must be 1 to 2 sentences. image_prompt must be a concise visual description suitable for an AI image generator and should not mention markdown. Body must be 3 to 5 short paragraphs of HTML with simple semantic tags like p, strong, em, ul, ol, and h2. Do not use markdown fences or code blocks."

        userPrompt = BuildGenerationPrompt(post) & vbCrLf & vbCrLf & _
                     "Also return an image_prompt field that describes a magazine-style feature image for this post."

        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")))
        If parsed.data.Exists("image_prompt") Then generatedImagePrompt = Trim(CStr(parsed.data.Item("image_prompt")))
        If Len(Trim(generatedImagePrompt)) = 0 And parsed.data.Exists("images") Then
            generatedImagePrompt = BuildImagePromptFromSuggestions(parsed.data.Item("images"))
        End If
    End Sub

    Private Sub UpdateCommentApproval(ByVal id, ByVal isApproved, ByVal successMessage)
        Dim comment
        On Error Resume Next
        Set comment = CommentsRepository().FindByID(id)
        If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
            Flash().AddError "Comment not found."
            Response.Redirect "/admin/comments"
            Exit Sub
        End If
        On Error GoTo 0

        comment.IsApproved = isApproved
        CommentsRepository().Update comment
        Flash().Success = successMessage
        Response.Redirect "/admin/comments"
    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 BuildGeneratedImageHtml(ByVal imagePrompt, ByVal titleText, ByVal summaryText)
        Dim promptText, altText, imageUrl
        promptText = Trim(CStr(imagePrompt))

        If Len(promptText) = 0 Then
            BuildGeneratedImageHtml = ""
            Exit Function
        End If

        altText = Trim(CStr(summaryText))
        If Len(altText) = 0 Then altText = Trim(CStr(titleText))
        If Len(altText) = 0 Then altText = "Feature image"

        imageUrl = GetOrCreateAiImageUrl(promptText)
        BuildGeneratedImageHtml = "<figure class=""post-feature-image mb-4"">" & _
                                  "<img class=""img-fluid rounded-4"" src=""" & Server.HTMLEncode(imageUrl) & """ alt=""" & Server.HTMLEncode(altText) & """ />" & _
                                  "</figure>"
    End Function

    Private Function BuildImagePromptFromSuggestions(ByVal imagesData)
        Dim key, imageItem, textParts, part, candidate
        candidate = ""

        On Error Resume Next
        If TypeName(imagesData) = "Dictionary" Then
            For Each key In imagesData.Keys
                Set imageItem = imagesData.Item(key)
                candidate = ""
                If TypeName(imageItem) = "Dictionary" Then
                    If imageItem.Exists("search_query") Then candidate = Trim(CStr(imageItem.Item("search_query")))
                    If Len(candidate) = 0 And imageItem.Exists("caption") Then candidate = Trim(CStr(imageItem.Item("caption")))
                    If Len(candidate) = 0 And imageItem.Exists("alt_text") Then candidate = Trim(CStr(imageItem.Item("alt_text")))
                    If Len(candidate) > 0 Then Exit For
                Else
                    candidate = Trim(CStr(imageItem))
                    If Len(candidate) > 0 Then Exit For
                End If
            Next
        Else
            candidate = Trim(CStr(imagesData))
        End If
        On Error GoTo 0

        If Len(candidate) = 0 Then
            BuildImagePromptFromSuggestions = ""
        Else
            BuildImagePromptFromSuggestions = candidate
        End If
    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

End Class

Dim AdminController_Class__Singleton
Function AdminController()
    If IsEmpty(AdminController_Class__Singleton) Then
        Set AdminController_Class__Singleton = New AdminController_Class
    End If
    Set AdminController = AdminController_Class__Singleton
End Function
%>