Fix podcast identifying data

Still need to test episode data, but it is thought-fixed as well

src/MyWebLog/Handlers/Feed.fs

@@ -23,28 +23,37 @@ type FeedType =
 /// Derive the type of RSS feed requested
 let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
     let webLog    = ctx.WebLog
+    let debug     = debug "Feed" ctx
     let name      = $"/{webLog.rss.feedName}"
     let postCount = defaultArg webLog.rss.itemsInFeed webLog.postsPerPage
+    debug (fun () -> $"Considering potential feed for {feedPath} (configured feed name {name})")
     // Standard feed
     match webLog.rss.feedEnabled && feedPath = name with
-    | true  -> Some (StandardFeed feedPath, postCount)
+    | true  ->
+        debug (fun () -> "Found standard feed")
+        Some (StandardFeed feedPath, postCount)
     | false ->
         // Category feed
         match CategoryCache.get ctx |> Array.tryFind (fun cat -> cat.slug = feedPath.Replace (name, "")) with
-        | Some cat -> Some (CategoryFeed (CategoryId cat.id, feedPath), postCount)
+        | Some cat ->
+            debug (fun () -> "Found category feed")
+            Some (CategoryFeed (CategoryId cat.id, feedPath), postCount)
         | None ->
             // Tag feed
             match feedPath.StartsWith "/tag/" with
-            | true  -> Some (TagFeed (feedPath.Replace("/tag/", "").Replace(name, ""), feedPath), postCount)
+            | true  ->
+                debug (fun () -> "Found tag feed")
+                Some (TagFeed (feedPath.Replace("/tag/", "").Replace(name, ""), feedPath), postCount)
             | false ->
                 // Custom feed
                 match webLog.rss.customFeeds
-                      |> List.tryFind (fun it -> (Permalink.toString it.path).EndsWith feedPath) with
+                      |> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.path)) with
                 | Some feed ->
+                    debug (fun () -> "Found custom feed")
                     Some (Custom (feed, feedPath),
                           feed.podcast |> Option.map (fun p -> p.itemsInFeed) |> Option.defaultValue postCount)
                 | None ->
-                    // No feed
+                    debug (fun () -> $"No matching feed found")
                     None
 
 /// Determine the function to retrieve posts for the given feed
@@ -61,6 +70,25 @@ let private getFeedPosts (webLog : WebLog) feedType =
 /// Strip HTML from a string
 let private stripHtml text = Regex.Replace (text, "<(.|\n)*?>", "")
 
+/// XML namespaces for building RSS feeds
+[<RequireQualifiedAccess>]
+module private Namespace = 
+    
+    /// Enables encoded (HTML) content
+    let content = "http://purl.org/rss/1.0/modules/content/"
+
+    /// The dc XML namespace
+    let dc = "http://purl.org/dc/elements/1.1/"
+
+    /// iTunes elements
+    let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd"
+
+    /// Enables chapters
+    let psc = "http://podlove.org/simple-chapters/"
+
+    /// Enables another "subscribe" option
+    let rawVoice = "http://www.rawvoice.com/rawvoiceRssModule/"
+
 /// Create a feed item from the given post    
 let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[]) (tagMaps : TagMap list)
             (post : Post) =
@@ -78,7 +106,7 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
     
     let encoded =
         post.text.Replace("src=\"/", $"src=\"{webLog.urlBase}/").Replace ("href=\"/", $"href=\"{webLog.urlBase}/")
-    item.ElementExtensions.Add ("encoded", "http://purl.org/rss/1.0/modules/content/", encoded)
+    item.ElementExtensions.Add ("encoded", Namespace.content, encoded)
     item.Authors.Add (SyndicationPerson (
         Name = (authors |> List.find (fun a -> a.name = WebLogUserId.toString post.authorId)).value))
     [ post.categoryIds
@@ -122,26 +150,25 @@ let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : Syndicat
             |> ExplicitRating.toString
         with :? ArgumentException -> ExplicitRating.toString podcast.explicit
     
-    let encXml = XmlDocument ()
+    let xmlDoc    = XmlDocument ()
-    let encElt = encXml.CreateElement "enclosure"
+    let enclosure = xmlDoc.CreateElement "enclosure"
-    encElt.SetAttribute ("url", epMediaUrl)
+    enclosure.SetAttribute ("url", epMediaUrl)
-    meta "length" |> Option.iter (fun it -> encElt.SetAttribute ("length", it.value))
+    meta "length" |> Option.iter (fun it  -> enclosure.SetAttribute ("length", it.value))
-    epMediaType |> Option.iter (fun typ -> encElt.SetAttribute ("type", typ))
+    epMediaType   |> Option.iter (fun typ -> enclosure.SetAttribute ("type", typ))
-    item.ElementExtensions.Add ("enclosure", "", encXml)
+    item.ElementExtensions.Add enclosure
     
-    item.ElementExtensions.Add ("creator", "dc", podcast.displayedAuthor)
+    item.ElementExtensions.Add ("creator",  Namespace.dc,     podcast.displayedAuthor)
-    item.ElementExtensions.Add ("author", "itunes", podcast.displayedAuthor)
+    item.ElementExtensions.Add ("author",   Namespace.iTunes, podcast.displayedAuthor)
-    meta "subtitle" |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", "itunes", it.value))
+    item.ElementExtensions.Add ("summary",  Namespace.iTunes, stripHtml post.text)
-    item.ElementExtensions.Add ("summary", "itunes", stripHtml post.text)
+    item.ElementExtensions.Add ("image",    Namespace.iTunes, epImageUrl)
-    item.ElementExtensions.Add ("image", "itunes", epImageUrl)
+    item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
-    item.ElementExtensions.Add ("explicit", "itunes", epExplicit)
+    meta "subtitle" |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it.value))
-    meta "duration" |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", "itunes", it.value))
+    meta "duration" |> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.value))
     
     if post.metadata |> List.exists (fun it -> it.name = "chapter") then
         try
-            let chapXml = XmlDocument ()
+            let chapters = xmlDoc.CreateElement ("psc", "chapters", Namespace.psc)
-            let chapsElt = chapXml.CreateElement ("psc", "chapters", "")
+            chapters.SetAttribute ("version", "1.2")
-            chapsElt.SetAttribute ("version", "1.2")
             
             post.metadata
             |> List.filter (fun it -> it.name = "chapter")
@@ -149,13 +176,12 @@ let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : Syndicat
                 TimeSpan.Parse (it.value.Split(" ")[0]), it.value.Substring (it.value.IndexOf(" ") + 1))
             |> List.sortBy fst
             |> List.iter (fun chap ->
-                let chapElt = chapXml.CreateElement ("psc", "chapter", "")
+                let chapter = xmlDoc.CreateElement ("psc", "chapter", Namespace.psc)
-                chapElt.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
+                chapter.SetAttribute ("start", (fst chap).ToString "hh:mm:ss")
-                chapElt.SetAttribute ("title", snd chap)
+                chapter.SetAttribute ("title", snd chap)
-                chapsElt.AppendChild chapElt |> ignore)
+                chapters.AppendChild chapter |> ignore)
             
-            chapXml.AppendChild chapsElt |> ignore
+            item.ElementExtensions.Add chapters
-            item.ElementExtensions.Add ("chapters", "psc", chapXml)
         with _ -> ()
     item
     
@@ -165,10 +191,12 @@ let private addNamespace (feed : SyndicationFeed) alias nsUrl =
 
 /// Add items to the top of the feed required for podcasts
 let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
-    let addChild (doc : XmlDocument) name prefix value =
+    let addChild (doc : XmlDocument) ns prefix name value (elt : XmlElement) =
-        let child = doc.CreateElement (name, prefix, "") |> doc.AppendChild
+        let child =
-        child.Value <- value
+            if ns = "" then doc.CreateElement name else doc.CreateElement (prefix, name, ns)
-        doc
+            |> elt.AppendChild
+        child.InnerText <- value
+        elt
     
     let podcast  = Option.get feed.podcast
     let feedUrl  = WebLog.absoluteUrl webLog feed.path
@@ -177,43 +205,42 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
         | Permalink link when link.StartsWith "http" -> link
         | Permalink _ -> WebLog.absoluteUrl webLog podcast.imageUrl
     
-    let categoryXml = XmlDocument ()
+    let xmlDoc = XmlDocument ()
-    let catElt = categoryXml.CreateElement ("itunes", "category", "")
-    catElt.SetAttribute ("text", podcast.iTunesCategory)
-    podcast.iTunesSubcategory
-    |> Option.iter (fun subCat ->
-        let subCatElt = categoryXml.CreateElement ("itunes", "category", "")
-        subCatElt.SetAttribute ("text", subCat)
-        catElt.AppendChild subCatElt |> ignore)
-    categoryXml.AppendChild catElt |> ignore
     
-    [ "dc",       "http://purl.org/dc/elements/1.1/"
+    [ "dc", Namespace.dc; "itunes", Namespace.iTunes; "psc", Namespace.psc; "rawvoice", Namespace.rawVoice ]
-      "itunes",   "http://www.itunes.com/dtds/podcast-1.0.dtd"
-      "psc",      "http://podlove.org/simple-chapters/"
-      "rawvoice", "http://www.rawvoice.com/rawvoiceRssModule/"
-    ]
     |> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
     
-    rssFeed.ElementExtensions.Add
+    let categorization =
-        ("image", "",
+        let it = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
+        it.SetAttribute ("text", podcast.iTunesCategory)
+        podcast.iTunesSubcategory
+        |> Option.iter (fun subCat ->
+            let subCatElt = xmlDoc.CreateElement ("itunes", "category", Namespace.iTunes)
+            subCatElt.SetAttribute ("text", subCat)
+            it.AppendChild subCatElt |> ignore)
+        it
+    let image = 
         [ "title", podcast.title
           "url",   imageUrl
           "link",  feedUrl
         ]
-            |> List.fold (fun doc (name, value) -> addChild doc name "" value) (XmlDocument ()))
+        |> List.fold (fun elt (name, value) -> addChild xmlDoc "" "" name value elt) (xmlDoc.CreateElement "image")
-    rssFeed.ElementExtensions.Add ("summary", "itunes", podcast.summary)
+    let owner =
-    rssFeed.ElementExtensions.Add ("author",  "itunes", podcast.displayedAuthor)
-    podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", "itunes", sub))
-    rssFeed.ElementExtensions.Add
-        ("owner", "itunes",
         [ "name", podcast.displayedAuthor
           "email", podcast.email
         ]
-            |> List.fold (fun doc (name, value) -> addChild doc name "itunes" value) (XmlDocument ()))
+        |> List.fold (fun elt (name, value) -> addChild xmlDoc Namespace.iTunes "itunes" name value elt)
-    rssFeed.ElementExtensions.Add ("image",     "itunes",   imageUrl)
+                     (xmlDoc.CreateElement ("itunes", "owner", Namespace.iTunes))
-    rssFeed.ElementExtensions.Add ("category",  "itunes",   categoryXml)
+    
-    rssFeed.ElementExtensions.Add ("explicit",  "itunes",   ExplicitRating.toString podcast.explicit)
+    rssFeed.ElementExtensions.Add image
-    rssFeed.ElementExtensions.Add ("subscribe", "rawvoice", feedUrl)
+    rssFeed.ElementExtensions.Add owner
+    rssFeed.ElementExtensions.Add categorization
+    rssFeed.ElementExtensions.Add ("summary",   Namespace.iTunes,   podcast.summary)
+    rssFeed.ElementExtensions.Add ("author",    Namespace.iTunes,   podcast.displayedAuthor)
+    rssFeed.ElementExtensions.Add ("image",     Namespace.iTunes,   imageUrl)
+    rssFeed.ElementExtensions.Add ("explicit",  Namespace.iTunes,   ExplicitRating.toString podcast.explicit)
+    rssFeed.ElementExtensions.Add ("subscribe", Namespace.rawVoice, feedUrl)
+    podcast.subtitle |> Option.iter (fun sub -> rssFeed.ElementExtensions.Add ("subtitle", Namespace.iTunes, sub))
 
 /// Get the feed's self reference and non-feed link
 let private selfAndLink webLog feedType =
@@ -233,16 +260,20 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
     let! tagMaps    = Post.getTagMappings webLog posts conn
     let  cats       = CategoryCache.get ctx
     let  podcast    = match feedType with Custom (feed, _) when Option.isSome feed.podcast -> Some feed | _ -> None
+    let  self, link = selfAndLink webLog feedType
     
     let toItem post =
         let item = toFeedItem webLog authors cats tagMaps post
         match podcast with
         | Some feed when post.metadata |> List.exists (fun it -> it.name = "media") ->
             addEpisode webLog feed post item
+        | Some _ ->
+            warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media"
+            item
         | _ -> item
         
     let feed = SyndicationFeed ()
-    addNamespace feed "content" "http://purl.org/rss/1.0/modules/content/"
+    addNamespace feed "content" Namespace.content
     
     feed.Title           <- TextSyndicationContent webLog.name
     feed.Description     <- TextSyndicationContent <| defaultArg webLog.subtitle webLog.name
@@ -253,7 +284,6 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
     feed.Id              <- webLog.urlBase
     webLog.rss.copyright |> Option.iter (fun copy -> feed.Copyright <- TextSyndicationContent copy)
     
-    let self, link = selfAndLink webLog feedType
     feed.Links.Add (SyndicationLink (Uri (WebLog.absoluteUrl webLog self), "self", "", "application/rss+xml", 0L))
     feed.ElementExtensions.Add ("link", "", WebLog.absoluteUrl webLog link)
     

src/MyWebLog/Handlers/Helpers.fs

@@ -176,8 +176,15 @@ let private isDebugEnabled (ctx : HttpContext) =
         debugEnabled.Value
 
 /// Log a debug message
-let debug name ctx (msg : unit -> string) =
+let debug (name : string) ctx msg =
     if isDebugEnabled ctx then
         let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
         let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
         log.LogDebug (msg ())
+
+/// Log a warning message
+let warn (name : string) (ctx : HttpContext) msg =
+    let fac = ctx.RequestServices.GetRequiredService<ILoggerFactory> ()
+    let log = fac.CreateLogger $"MyWebLog.Handlers.{name}"
+    log.LogWarning msg
+    

src/MyWebLog/Handlers/Routes.fs

@@ -15,19 +15,21 @@ module CatchAll =
     let private deriveAction (ctx : HttpContext) : HttpHandler seq =
         let webLog   = ctx.WebLog
         let conn     = ctx.Conn
+        let debug    = debug "Routes.CatchAll" ctx
         let textLink =
             let _, extra = WebLog.hostAndPath webLog
             let url      = string ctx.Request.Path
             (if extra = "" then url else url.Substring extra.Length).ToLowerInvariant ()
         let await it = (Async.AwaitTask >> Async.RunSynchronously) it
         seq {
-            debug "Post" ctx (fun () -> $"Considering URL {textLink}")
+            debug (fun () -> $"Considering URL {textLink}")
             // Home page directory without the directory slash 
             if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
             let permalink = Permalink (textLink.Substring 1)
             // Current post
             match Data.Post.findByPermalink permalink webLog.id conn |> await with
             | Some post ->
+                debug (fun () -> $"Found post by permalink")
                 let model = Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 ctx conn |> await
                 model.Add ("page_title", post.title)
                 yield fun next ctx -> themedView "single-post" next ctx model
@@ -35,31 +37,43 @@ module CatchAll =
             // Current page
             match Data.Page.findByPermalink permalink webLog.id conn |> await with
             | Some page ->
+                debug (fun () -> $"Found page by permalink")
                 yield fun next ctx ->
                     Hash.FromAnonymousObject {| page = DisplayPage.fromPage webLog page; page_title = page.title |}
                     |> themedView (defaultArg page.template "single-page") next ctx
             | None -> ()
             // RSS feed
             match Feed.deriveFeedType ctx textLink with
-            | Some (feedType, postCount) -> yield Feed.generate feedType postCount 
+            | Some (feedType, postCount) ->
+                debug (fun () -> $"Found RSS feed")
+                yield Feed.generate feedType postCount 
             | None -> ()
             // Post differing only by trailing slash
             let altLink = Permalink (if textLink.EndsWith "/" then textLink[..textLink.Length - 2] else $"{textLink}/")
             match Data.Post.findByPermalink altLink webLog.id conn |> await with
-            | Some post -> yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
+            | Some post ->
+                debug (fun () -> $"Found post by trailing-slash-agnostic permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog post.permalink)
             | None -> ()
             // Page differing only by trailing slash
             match Data.Page.findByPermalink altLink webLog.id conn |> await with
-            | Some page -> yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
+            | Some page ->
+                debug (fun () -> $"Found page by trailing-slash-agnostic permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog page.permalink)
             | None -> ()
             // Prior post
             match Data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
-            | Some link -> yield redirectTo true (WebLog.relativeUrl webLog link)
+            | Some link ->
+                debug (fun () -> $"Found post by prior permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog link)
             | None -> ()
             // Prior page
             match Data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with
-            | Some link -> yield redirectTo true (WebLog.relativeUrl webLog link)
+            | Some link ->
+                debug (fun () -> $"Found page by prior permalink")
+                yield redirectTo true (WebLog.relativeUrl webLog link)
             | None -> ()
+            debug (fun () -> $"No content found")
         }
 
     // GET {all-of-the-above}