From 3213c0c46a152e709772f0818a9281f5ce0e1988 Mon Sep 17 00:00:00 2001
From: Alan Pearce
Date: Fri, 10 Oct 2014 16:23:32 +0100
Subject: Normalise parsed URLs

---
 src/microformats/parser.clj | 47 ++++++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 22 deletions(-)

(limited to 'src')

diff --git a/src/microformats/parser.clj b/src/microformats/parser.clj
index e29ca9b..0b26372 100644
--- a/src/microformats/parser.clj
+++ b/src/microformats/parser.clj
@@ -146,10 +146,10 @@
   (let [el (z/node loc)]
     (str/trim (or (find-value-class el)
                   (case (:tag el)
-                    :a (-> el :attrs :href)
-                    :area (-> el :attrs :href)
-                    :img (-> el :attrs :src)
-                    :object (-> el :attrs :data)
+                    :a (normalise-url (z/root loc) (-> el :attrs :href))
+                    :area (normalise-url (z/root loc) (-> el :attrs :href))
+                    :img (normalise-url (z/root loc) (-> el :attrs :src))
+                    :object (normalise-url (z/root loc) (-> el :attrs :data))
                     (get-p-value loc))
                   (node-to-text (:content el))
                   ""))))
@@ -246,27 +246,30 @@
 (defn- parse-implied-url
   [loc]
   (let [element (z/node loc)]
-    (case (:tag element)
-      :a (-> element :attrs :href)
-      (if-let [% (first (html/select element [html/root :> [:a (html/attr? :href) html/only-of-type (html/but-node (html/attr-contains :class "h-"))]]))]
-        (-> % :attrs :href)))))
+    (some->>
+     (case (:tag element)
+       :a (-> element :attrs :href)
+       (if-let [% (first (html/select element [html/root :> [:a (html/attr? :href) html/only-of-type (html/but-node (html/attr-contains :class "h-"))]]))]
+         (-> % :attrs :href)))
+     (normalise-url (z/root loc)))))
 
 (defn- parse-implied-photo
   [loc]
   (let [element (z/node loc)]
-    (case (:tag element)
-      :img (-> element :attrs :src)
-      :object (-> element :attrs :data)
-      (anacond
-       (first (html/select element [html/root :> [:img (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
-       (-> % :attrs :src)
-       (first (html/select element [html/root :> [:object (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
-       (-> % :attrs :data)
-       (first (html/select element [html/root :> html/only-child :> [:img (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
-       (-> % :attrs :src)
-       (first (html/select element [html/root :> html/only-child :> [:object (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
-       (-> % :attrs :data)
-       ))))
+    (some->>
+     (case (:tag element)
+       :img (-> element :attrs :src)
+       :object (-> element :attrs :data)
+       (anacond
+        (first (html/select element [html/root :> [:img (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
+        (-> % :attrs :src)
+        (first (html/select element [html/root :> [:object (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
+        (-> % :attrs :data)
+        (first (html/select element [html/root :> html/only-child :> [:img (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
+        (-> % :attrs :src)
+        (first (html/select element [html/root :> html/only-child :> [:object (html/but-node (html/attr-contains :class "h-")) html/only-of-type]]))
+        (-> % :attrs :data)))
+     (normalise-url (z/root loc)))))
 
 (def empty-ish
   #(not (str/blank? (first (second %)))))
@@ -322,7 +325,7 @@
        z/node
        element-to-rels
        (map keyword)
-       (map #(hash-map % [(-> loc z/node :attrs :href)]))
+       (map #(hash-map % [(normalise-url (z/root loc) (-> loc z/node :attrs :href))]))
        (into {})))
 
 (defn select-rels
-- 
cgit 1.4.1